From 1ed927902b3db5afe767d090cbf8a25d3f21691b Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 01:43:13 -0400 Subject: [PATCH 01/17] Add R-CMD-check and Bioconductor-devel CI; bump to 0.99.0 Bioconductor requires new submissions to be versioned x.99.z, and until now nothing verified the package on a clean machine -- the only workflow was pkgdown. - R-CMD-check.yaml: ubuntu/release only for now; more platforms once green. - bioc-check.yaml: runs R CMD check + BiocCheck(new-package = TRUE) in the bioconductor/bioconductor_docker:devel container. The devel R/Bioc versions are printed by the job rather than hardcoded anywhere. - DESCRIPTION: 0.99.0, Depends: R (>= 4.4.0), drop the unused GenomeInfoDb import (R CMD check NOTE). - .Rbuildignore: data-raw, build_preview and CLAUDE.md were all being packaged into the tarball. - .gitignore: keep CLAUDE.md and tools/teaching out of a public repo. --- .Rbuildignore | 5 ++ .github/workflows/R-CMD-check.yaml | 57 ++++++++++++++++++++ .github/workflows/bioc-check.yaml | 87 ++++++++++++++++++++++++++++++ .gitignore | 5 ++ DESCRIPTION | 11 ++-- tools/run_bioccheck.R | 77 ++++++++++++++++++++++++++ tools/run_doc_examples.R | 27 ++++++++++ 7 files changed, 265 insertions(+), 4 deletions(-) create mode 100644 .github/workflows/R-CMD-check.yaml create mode 100644 .github/workflows/bioc-check.yaml create mode 100644 tools/run_bioccheck.R create mode 100644 tools/run_doc_examples.R diff --git a/.Rbuildignore b/.Rbuildignore index e5931f7..48ec0fd 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -7,3 +7,8 @@ ^_pkgdown\.yml$ ^pkgdown$ ^tools$ +^data-raw$ +^build_preview$ +^CLAUDE\.md$ +^README\.Rmd$ +^\.git$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..36b6dd2 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,57 @@ +# R CMD check on a clean runner. +# Adapted from https://github.com/r-lib/actions/tree/v2/examples +# +# Deliberately ubuntu-only to start. macOS and Windows are added to the +# matrix only once ubuntu is reliably green -- a three-platform matrix that +# goes red on day one is noise, not signal. +on: + push: + branches: [main, polish-for-release] + pull_request: + branches: [main] + workflow_dispatch: + +name: R-CMD-check + +permissions: + contents: read + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: ubuntu-latest, r: 'release'} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + # brms/rstan are Suggests and are slow+flaky to build on runners; the + # tests that need them already skip_if_not_installed(). + _R_CHECK_FORCE_SUGGESTS_: false + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + args: 'c("--no-manual", "--as-cran")' diff --git a/.github/workflows/bioc-check.yaml b/.github/workflows/bioc-check.yaml new file mode 100644 index 0000000..b018de9 --- /dev/null +++ b/.github/workflows/bioc-check.yaml @@ -0,0 +1,87 @@ +# Authoritative Bioconductor gate: R CMD check + BiocCheck on Bioc devel. +# +# This is the real gate for the 0.99.0 submission. The HPC runs an older R +# than Bioc devel, so BiocCheck there is only a preflight -- this container +# is what the Bioconductor single-package builder will approximate. +# +# The Bioc devel R/Bioc versions are NOT hardcoded anywhere: the "Toolchain" +# step below prints them, and that printed value is the source of truth. +on: + push: + branches: [main, polish-for-release] + pull_request: + branches: [main] + workflow_dispatch: + +name: bioc-check + +permissions: + contents: read + +jobs: + bioc-check: + runs-on: ubuntu-latest + # Hub downloads for the vignettes can be slow on a cold cache. + timeout-minutes: 90 + + container: + image: bioconductor/bioconductor_docker:devel + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + _R_CHECK_FORCE_SUGGESTS_: false + + steps: + - uses: actions/checkout@v4 + + - name: Toolchain (source of truth for R / Bioc devel versions) + shell: Rscript {0} + run: | + cat(R.version.string, "\n") + cat("Bioconductor:", as.character(BiocManager::version()), "\n") + cat("Platform:", R.version$platform, "\n") + + - name: Cache R packages + uses: actions/cache@v4 + with: + path: /usr/local/lib/R/host-site-library + key: bioc-devel-lib-${{ hashFiles('DESCRIPTION') }} + restore-keys: bioc-devel-lib- + + # sesameData / knowYourCG pull reference data through ExperimentHub and + # AnnotationHub. Caching this is the difference between a 5-minute and a + # 40-minute job, and protects against Hub rate limiting. + - name: Cache ExperimentHub / AnnotationHub + uses: actions/cache@v4 + with: + path: ~/.cache/R + key: bioc-hubcache-${{ hashFiles('vignettes/*.Rmd') }} + restore-keys: bioc-hubcache- + + - name: Install dependencies + shell: Rscript {0} + run: | + BiocManager::install(c("BiocCheck", "remotes"), ask = FALSE, update = FALSE) + remotes::install_deps(dependencies = TRUE, repos = BiocManager::repositories()) + + - name: R CMD build + run: R CMD build --no-resave-data . + + - name: R CMD check + run: R CMD check --no-manual "$(ls -1t *.tar.gz | head -1)" + + - name: BiocCheck + shell: Rscript {0} + run: | + tarball <- dir(".", pattern = "tar\\.gz$", full.names = TRUE)[1] + BiocCheck::BiocCheck(tarball, `new-package` = TRUE) + + - name: Upload check logs + if: always() + uses: actions/upload-artifact@v4 + with: + name: bioc-check-logs + path: | + **/*.Rcheck/** + **/*.BiocCheck/** + retention-days: 14 diff --git a/.gitignore b/.gitignore index daf0f01..8eba8f3 100644 --- a/.gitignore +++ b/.gitignore @@ -19,3 +19,8 @@ inst/doc/ # ...except the small example data shipped with the package !inst/extdata/*.rds build_preview/ + +# Agent context and scratch material -- never publish +CLAUDE.md +tools/teaching/ +Rplots.pdf diff --git a/DESCRIPTION b/DESCRIPTION index 48fdbb7..6129658 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: BREAD Title: Bayesian Region-specific DNA Methylation Inference -Version: 0.0.0.9000 +Version: 0.99.0 Authors@R: person("Jaemin", "Park", , "jaemin.park@vai.org", role = c("aut", "cre")) Description: BREAD provides targeted Bayesian inference for predefined DNA @@ -12,6 +12,8 @@ Description: BREAD provides targeted Bayesian inference for predefined DNA thresholds. License: MIT + file LICENSE Encoding: UTF-8 +Depends: + R (>= 4.4.0) Language: en-US Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 @@ -29,15 +31,16 @@ Suggests: tidybayes Config/testthat/edition: 3 Imports: - GenomeInfoDb, GenomicRanges, ggplot2, methods, rlang, S4Vectors, stats, - SummarizedExperiment -biocViews: DNAMethylation, Bayesian, Epigenetics, DifferentialMethylation, MethylationArray + SummarizedExperiment, + withr +biocViews: DNAMethylation, Bayesian, Epigenetics, DifferentialMethylation, + MethylationArray, Classification URL: https://github.com/BacZemin/BREAD, https://baczemin.github.io/BREAD BugReports: https://github.com/BacZemin/BREAD/issues VignetteBuilder: knitr diff --git a/tools/run_bioccheck.R b/tools/run_bioccheck.R new file mode 100644 index 0000000..d69cc9c --- /dev/null +++ b/tools/run_bioccheck.R @@ -0,0 +1,77 @@ +## Run BiocCheck against a freshly built BREAD tarball. +## +## Preflight only -- the authoritative BiocCheck runs on the Bioconductor +## devel container in CI (.github/workflows/bioc-check.yaml), because the +## HPC R is older than Bioc devel. This wrapper exists to catch the cheap +## problems before spending a CI cycle. +## +## Submit via sbatch (never the login node): +## sbatch --partition=laird --mem=32G --cpus-per-task=4 --time=2:00:00 \ +## --wrap='cd && Rscript tools/run_bioccheck.R' + +Sys.setenv( + LANG = "C.UTF-8", LC_ALL = "C.UTF-8", + RSTUDIO_PANDOC = "/varidata/research/projects/laird/jaemin.park/quarto/quarto-1.6.40/bin/tools/x86_64" +) +Sys.setenv("_R_CHECK_FORCE_SUGGESTS_" = "false") + +suppressPackageStartupMessages({ + library(BiocCheck) +}) + +pkg_dir <- "/varidata/research/projects/laird/jaemin.park/projects/BREAD" +check_dir <- file.path(pkg_dir, "docs", "check") +dir.create(check_dir, recursive = TRUE, showWarnings = FALSE) + +## ---- 1. Git-clone-level checks (run on the source dir, not the tarball) ---- +message("== BiocCheckGitClone ==") +gitres <- try(BiocCheck::BiocCheckGitClone(pkg_dir), silent = TRUE) +if (inherits(gitres, "try-error")) { + message("BiocCheckGitClone failed: ", conditionMessage(attr(gitres, "condition"))) +} + +## ---- 2. Build a tarball ---------------------------------------------------- +## BiocCheck's `new-package` checks want the built tarball, not the source dir. +message("== R CMD build ==") +old <- setwd(check_dir) +on.exit(setwd(old), add = TRUE) + +build_log <- system2( + file.path(R.home("bin"), "R"), + c("CMD", "build", "--no-resave-data", shQuote(pkg_dir)), + stdout = TRUE, stderr = TRUE +) +cat(build_log, sep = "\n") + +tarballs <- list.files(check_dir, pattern = "^BREAD_.*\\.tar\\.gz$", full.names = TRUE) +if (!length(tarballs)) stop("R CMD build produced no tarball; see log above.") +tarball <- tarballs[order(file.mtime(tarballs), decreasing = TRUE)][1] +message("Using tarball: ", tarball) + +## ---- 3. BiocCheck ---------------------------------------------------------- +message("== BiocCheck (new-package = TRUE) ==") +res <- BiocCheck::BiocCheck(tarball, `new-package` = TRUE) + +saveRDS(res, file.path(check_dir, "bioccheck_result.rds")) + +## ---- 4. Machine-readable summary ------------------------------------------ +## The printed BiocCheck output is long; this block is what gets read back +## over SSH to build the fix list. +summarise <- function(res) { + for (sev in c("error", "warning", "note")) { + items <- tryCatch(res[[sev]], error = function(e) NULL) + cat("\n########## ", toupper(sev), " (", length(items), ") ##########\n", sep = "") + if (!length(items)) next + for (nm in names(items)) { + cat("- ", nm, "\n", sep = "") + det <- items[[nm]] + if (length(det)) cat(paste0(" ", unlist(det), collapse = "\n"), "\n", sep = "") + } + } +} +cat("\n\n================ BIOCCHECK SUMMARY ================\n") +try(summarise(res)) +cat("\n=================== END SUMMARY ===================\n") + +cat("\nBiocCheck artifacts:\n") +print(list.files(check_dir, pattern = "BiocCheck", full.names = TRUE)) diff --git a/tools/run_doc_examples.R b/tools/run_doc_examples.R new file mode 100644 index 0000000..91a04ad --- /dev/null +++ b/tools/run_doc_examples.R @@ -0,0 +1,27 @@ +## Fast inner loop: regenerate docs, run every example, run the test suite. +## Skips vignettes and the full R CMD check entirely (~2 min vs ~14 min). +Sys.setenv(LANG = "C.UTF-8", LC_ALL = "C.UTF-8") +pkg <- "/varidata/research/projects/laird/jaemin.park/projects/BREAD" + +cat("\n########## document() ##########\n") +suppressPackageStartupMessages(library(roxygen2)) +roxygen2::roxygenise(pkg, clean = TRUE) + +cat("\n########## NAMESPACE ##########\n") +cat(readLines(file.path(pkg, "NAMESPACE")), sep = "\n") + +cat("\n########## run_examples() ##########\n") +suppressPackageStartupMessages(library(devtools)) +ok <- TRUE +res <- tryCatch( + devtools::run_examples(pkg, document = FALSE, run_donttest = TRUE), + error = function(e) { ok <<- FALSE; message("EXAMPLES FAILED: ", + conditionMessage(e)); NULL } +) +cat("\nexamples_ok:", ok, "\n") + +cat("\n########## test() ##########\n") +tr <- tryCatch(devtools::test(pkg, stop_on_failure = FALSE), + error = function(e) { message("TESTS ERRORED: ", + conditionMessage(e)); NULL }) +cat("\n########## DONE ##########\n") From 5de13120b661fd43732a6c51231169874fb4539f Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 01:43:27 -0400 Subject: [PATCH 02/17] Add runnable examples to every exported object; API tidy-up BiocCheck ERROR: at least 80% of man pages documenting exported objects must have runnable examples. Only bread_kycg had one, and it was a dontrun block over undefined objects. - Every exported object now has an example built on the packaged EPICv2 data. A full 500-region fit is ~0.7s, so each example is self-contained rather than sharing a cached fit. Examples that call the lower-level helpers pass assay_name = "betas" / input_scale = "Beta" explicitly, because only fit_bread() auto-detects them. Plot and draw examples always name a region: the NULL default would facet 500 panels / return 2M rows. - bread_kycg keeps a dontrun block for the enrichment call itself, which downloads KnowYourCG reference databases, but the surrounding fit now runs. - posterior_summary() accepts a BreadFit directly, so callers no longer reach into the model slot. - Add a BreadResults() constructor and show method. The class had no way to construct one anywhere in the package. - Remove report_feature_set(), an unimplemented stop() stub; plot_feature_set() covers the same ground. - posterior_draws() uses withr::with_seed() instead of set.seed(). BiocCheck flags set.seed in package code, and the bare call also leaked its reseed into the caller RNG stream. (with_seed, not local_seed: the latter does not restore the previous state in withr 3.0.2.) - Add missing \value sections flagged by BiocCheck. --- NAMESPACE | 2 + R/classes.R | 45 ++++++++++++++++++++++ R/classify.R | 15 ++++++++ R/fit_bread.R | 15 ++++++++ R/fit_hierarchical.R | 2 + R/fit_summary.R | 7 ++++ R/kycg.R | 17 +++++++-- R/mapping.R | 14 +++++++ R/methods.R | 71 +++++++++++++++++++++++++++++++++-- R/plots.R | 47 +++++++++++++++++++++++ R/posterior.R | 22 ++++++++++- R/report.R | 12 ------ R/summarize.R | 15 ++++++++ R/utils.R | 14 +++++++ R/validate.R | 12 ++++++ man/BREAD-methods.Rd | 7 ++++ man/BREAD-package.Rd | 1 + man/BREAD-plots.Rd | 3 ++ man/BREAD-utils.Rd | 4 ++ man/BreadFit.Rd | 13 +++++++ man/BreadResults.Rd | 24 ++++++++++++ man/bread_colors.Rd | 5 +++ man/bread_kycg.Rd | 17 +++++++-- man/bread_prior.Rd | 8 ++++ man/classifications.Rd | 13 +++++++ man/classify_regions.Rd | 16 ++++++++ man/dot-beta_to_m.Rd | 8 ++++ man/dot-m_to_beta.Rd | 6 +++ man/fit_bread.Rd | 16 ++++++++ man/fit_bread_hierarchical.Rd | 4 ++ man/map_probes_to_features.Rd | 15 ++++++++ man/plot_feature_set.Rd | 14 +++++++ man/plot_region_data.Rd | 16 ++++++++ man/plot_region_posterior.Rd | 18 +++++++++ man/posterior_draws.Rd | 16 ++++++++ man/posterior_summary.Rd | 19 +++++++++- man/report_feature_set.Rd | 21 ----------- man/results.Rd | 13 +++++++ man/summarize_features.Rd | 16 ++++++++ man/validate_bread_input.Rd | 13 +++++++ 40 files changed, 571 insertions(+), 45 deletions(-) delete mode 100644 R/report.R delete mode 100644 man/report_feature_set.Rd diff --git a/NAMESPACE b/NAMESPACE index 3451178..5a52bc5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(BreadResults) export(bread_colors) export(bread_kycg) export(bread_prior) @@ -41,3 +42,4 @@ importFrom(stats,quantile) importFrom(stats,rt) importFrom(stats,sd) importFrom(stats,var) +importFrom(withr,with_seed) diff --git a/R/classes.R b/R/classes.R index 7fdf839..7d696ca 100644 --- a/R/classes.R +++ b/R/classes.R @@ -19,6 +19,18 @@ #' #' @name BreadFit #' @aliases BreadFit-class +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' fit +#' +#' slotNames(fit) +#' methods::slot(fit, "diagnostics") #' @exportClass BreadFit setClass( "BreadFit", @@ -63,3 +75,36 @@ setClass( ), prototype(params = list()) ) + +#' @rdname BreadResults +#' +#' @param fit A [BreadFit], as returned by [fit_bread()]. +#' +#' @return `BreadResults()` returns a `BreadResults` object wrapping the +#' region-level results table and the classification parameters used. +#' +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' +#' br <- BreadResults(fit) +#' br +#' head(methods::slot(br, "table")) +#' +#' @importFrom methods is new +#' @export +BreadResults <- function(fit) { + if (!methods::is(fit, "BreadFit")) { + stop("`fit` must be a BreadFit object.", call. = FALSE) + } + methods::new( + "BreadResults", + table = results(fit), + params = fit@params + ) +} diff --git a/R/classify.R b/R/classify.R index ef439e1..9c22187 100644 --- a/R/classify.R +++ b/R/classify.R @@ -19,6 +19,21 @@ #' (levels: `hypermethylated`, `hypomethylated`, `inconclusive`). Attributes #' `delta` and `prob_cutoff` are updated. #' +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' post <- posterior_summary(fit) +#' +#' cl <- classify_regions(post) +#' table(cl$classification) +#' +#' # A stricter cutoff moves borderline regions into `inconclusive` +#' table(classify_regions(post, prob_cutoff = 0.99)$classification) #' @export classify_regions <- function(post, delta = 0.10, prob_cutoff = 0.95) { if (!is.data.frame(post)) { diff --git a/R/fit_bread.R b/R/fit_bread.R index 1005aa3..ba0c5bd 100644 --- a/R/fit_bread.R +++ b/R/fit_bread.R @@ -54,6 +54,21 @@ #' @importFrom SummarizedExperiment colData assay assayNames #' @importFrom S4Vectors mcols #' @importFrom stats model.matrix +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' # Which of the 500 predefined regions change methylation with passage +#' # in the control (untreated) fibroblasts? +#' fit <- fit_bread(se_ctrl, reg, ~ passage, +#' feature_class_col = "feature_class") +#' fit +#' +#' head(results(fit)) +#' table(results(fit)$classification) #' @export fit_bread <- function(se, features, design, contrast = NULL, diff --git a/R/fit_hierarchical.R b/R/fit_hierarchical.R index f3a78eb..5372581 100644 --- a/R/fit_hierarchical.R +++ b/R/fit_hierarchical.R @@ -4,6 +4,8 @@ #' offsets and partial pooling of region-level effects. #' #' @inheritParams fit_bread_summary +#' @return Currently signals an error; planned to return a list with the +#' same shape as [fit_bread_summary()]. #' @keywords internal fit_bread_hierarchical <- function(...) { stop("hierarchical mode not implemented in v1") diff --git a/R/fit_summary.R b/R/fit_summary.R index a8e2f1d..35271e4 100644 --- a/R/fit_summary.R +++ b/R/fit_summary.R @@ -16,6 +16,13 @@ #' Defaults `a0 = b0 = 0.001`. #' #' @return A list with class `"bread_prior"`. +#' @examples +#' # Defaults: weak coefficient precision, near-flat inverse-gamma on the +#' # residual variance. +#' bread_prior() +#' +#' # A tighter prior, e.g. when regions are small and n is low +#' bread_prior(lambda0 = 0.05, a0 = 0.01, b0 = 0.01) #' @export bread_prior <- function(mu0 = NULL, Lambda0 = NULL, lambda0 = 0.01, a0 = 0.001, b0 = 0.001) { diff --git a/R/kycg.R b/R/kycg.R index f5a949f..558e4a4 100644 --- a/R/kycg.R +++ b/R/kycg.R @@ -33,10 +33,21 @@ #' `estimate`, `p.value`, `FDR`, ...). #' #' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' table(results(fit)$classification) +#' +#' # The enrichment call downloads KnowYourCG reference databases, so it is +#' # not run here. #' \dontrun{ -#' fit <- fit_bread(se, features, ~ group) -#' enr <- bread_kycg(fit, platform = "EPIC") -#' head(enr[enr$FDR < 0.01, ]) +#' enr <- bread_kycg(fit, which = "hypermethylated", +#' platform = "EPICv2") +#' head(enr[enr$FDR < 0.01, ]) #' } #' #' @importFrom methods is diff --git a/R/mapping.R b/R/mapping.R index 064f2af..ff46d50 100644 --- a/R/mapping.R +++ b/R/mapping.R @@ -27,6 +27,20 @@ #' @importFrom SummarizedExperiment rowRanges #' @importFrom GenomicRanges findOverlaps #' @importFrom S4Vectors queryHits subjectHits mcols +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' mapping <- map_probes_to_features(se, reg) +#' head(mapping) +#' nrow(mapping) +#' +#' # Regions carrying fewer than `min_probes` probes are dropped and +#' # recorded in an attribute rather than silently disappearing. +#' attr(mapping, "dropped_regions") #' @export map_probes_to_features <- function(se, features, min_probes = 3L) { if (!methods::is(se, "SummarizedExperiment")) { diff --git a/R/methods.R b/R/methods.R index d40b459..dbb1805 100644 --- a/R/methods.R +++ b/R/methods.R @@ -1,5 +1,8 @@ #' Methods for [BreadFit] and [BreadResults] #' +#' @return `show()` is called for its side effect of printing a summary to +#' the console and returns its argument invisibly. +#' #' @name BREAD-methods #' @keywords internal NULL @@ -9,6 +12,18 @@ NULL #' @param object A [BreadFit]. #' @param ... Unused. #' @return A data frame with one row per region. +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' +#' res <- results(fit) +#' head(res) +#' colnames(res) #' @export setGeneric("results", function(object, ...) standardGeneric("results")) @@ -24,6 +39,18 @@ setMethod("results", "BreadFit", function(object, ...) { #' @return A named character vector of classifications per region #' (names are region IDs, values are one of `"hypermethylated"`, #' `"hypomethylated"`, `"inconclusive"`). +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' +#' cls <- classifications(fit) +#' head(cls) +#' table(cls) #' @export setGeneric("classifications", function(object, ...) standardGeneric("classifications")) @@ -50,6 +77,22 @@ setMethod("classifications", "BreadFit", function(object, ...) { #' @return A long `data.frame` with columns `region_id`, `draw`, `value`. #' #' @importFrom stats rt +#' @importFrom withr with_seed +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' +#' # Always name the region(s) you want -- the default (NULL) draws from +#' # every region, which is `n` x n_regions rows. +#' rid <- results(fit)$region_id[1] +#' d <- posterior_draws(fit, region_id = rid, n = 500L, seed = 1L) +#' head(d) +#' quantile(d$value, c(0.025, 0.5, 0.975)) #' @export setGeneric("posterior_draws", function(object, region_id = NULL, ...) standardGeneric("posterior_draws")) @@ -57,7 +100,6 @@ setGeneric("posterior_draws", #' @rdname posterior_draws setMethod("posterior_draws", "BreadFit", function(object, region_id = NULL, n = 4000L, seed = NULL, ...) { - if (!is.null(seed)) set.seed(seed) fits <- object@model$fits if (is.null(fits)) stop("BreadFit has no `model$fits`; was fit_bread() run successfully?", @@ -70,7 +112,7 @@ setMethod("posterior_draws", "BreadFit", stop("region_id(s) not found: ", paste(shQuote(unknown), collapse = ", "), call. = FALSE) - rows <- lapply(target, function(rid) { + draw_one <- function(rid) { f <- fits[[rid]] if (!is.na(f$error)) return(data.frame(region_id = rid, draw = seq_len(n), @@ -92,8 +134,12 @@ setMethod("posterior_draws", "BreadFit", data.frame(region_id = rid, draw = seq_len(n), value = mu + s * stats::rt(n, df = nu), stringsAsFactors = FALSE) - }) - do.call(rbind, rows) + } + + # with_seed() restores the caller's RNG state on exit; a bare + # set.seed() would leak this reseed into the user's session. + draw_all <- function() do.call(rbind, lapply(target, draw_one)) + if (is.null(seed)) draw_all() else withr::with_seed(seed, draw_all()) } ) @@ -127,5 +173,22 @@ setMethod("show", "BreadFit", function(object) { invisible(object) }) +#' @rdname BREAD-methods +#' @export +setMethod("show", "BreadResults", function(object) { + tab <- object@table + cat("\n") + cat(" n_regions :", if (is.null(tab)) 0L else nrow(tab), "\n") + cat(" delta :", object@params$delta %||% NA, "\n") + cat(" prob_cutoff:", object@params$prob_cutoff %||% NA, "\n") + if (!is.null(tab) && "classification" %in% colnames(tab)) { + cat(" classifications:\n") + counts <- table(tab$classification) + for (nm in names(counts)) + cat(" ", format(nm, width = 17L), counts[[nm]], "\n", sep = "") + } + invisible(object) +}) + # `%||%` — explicit because we target older R too `%||%` <- function(a, b) if (is.null(a)) b else a diff --git a/R/plots.R b/R/plots.R index 8307568..64e1ac3 100644 --- a/R/plots.R +++ b/R/plots.R @@ -5,6 +5,8 @@ #' All return [ggplot2::ggplot] objects and use the MetBrewer `Cross` palette #' (see [bread_colors()]). #' +#' @return Each of the three functions returns a [ggplot2::ggplot] object. +#' #' @name BREAD-plots #' @keywords internal NULL @@ -27,6 +29,23 @@ NULL #' @importFrom methods is #' @importFrom stats dt #' @importFrom rlang .data +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage, +#' feature_class_col = "feature_class") +#' +#' # Pick a region that was actually called hypermethylated; passing +#' # `region_id = NULL` would facet every region in the fit. +#' res <- results(fit) +#' rid <- res$region_id[which(res$classification == "hypermethylated")[1]] +#' if (is.na(rid)) rid <- res$region_id[1] +#' +#' plot_region_posterior(fit, region_id = rid) #' @export plot_region_posterior <- function(fit, region_id = NULL, n_grid = 500L, show_delta = TRUE) { @@ -109,6 +128,21 @@ plot_region_posterior <- function(fit, region_id = NULL, #' #' @importFrom methods is #' @importFrom rlang .data +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' +#' res <- results(fit) +#' rid <- res$region_id[which(res$classification == "hypermethylated")[1]] +#' if (is.na(rid)) rid <- res$region_id[1] +#' +#' # `region_id` must be a single region. +#' plot_region_data(fit, rid) #' @export plot_region_data <- function(fit, region_id) { if (!methods::is(fit, "BreadFit")) @@ -180,6 +214,19 @@ plot_region_data <- function(fit, region_id) { #' #' @importFrom methods is #' @importFrom rlang .data +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' # `feature_class_col` names a column of the fit's probe-to-region +#' # mapping, so it has to be passed to fit_bread() first. +#' fit <- fit_bread(se_ctrl, reg, ~ passage, +#' feature_class_col = "feature_class") +#' +#' plot_feature_set(fit, feature_class_col = "feature_class") #' @export plot_feature_set <- function(fit, feature_class_col = NULL) { if (!methods::is(fit, "BreadFit")) diff --git a/R/posterior.R b/R/posterior.R index 8ddb012..cd98705 100644 --- a/R/posterior.R +++ b/R/posterior.R @@ -15,7 +15,8 @@ #' #' Columns in the returned data frame are the same in both cases. #' -#' @param fit Output of [fit_bread_summary()] or [fit_bread_brms()]. +#' @param fit A [BreadFit] (as returned by [fit_bread()]), or the internal +#' model list from [fit_bread_summary()] / [fit_bread_brms()]. #' @param delta Effect-size threshold on the M-value scale. Default `0.10`. #' @param ci Credible-interval mass. Default `0.95`. #' @@ -25,8 +26,27 @@ #' `df` is `NA_real_` for the empirical path. #' #' @importFrom stats pt qt median quantile sd +#' @importFrom methods is +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' +#' # A BreadFit is accepted directly; the internal model list also works. +#' post <- posterior_summary(fit) +#' head(post) +#' +#' # A wider credible interval +#' head(posterior_summary(fit, ci = 0.99)) #' @export posterior_summary <- function(fit, delta = 0.10, ci = 0.95) { + # Accept the user-facing object as well as the internal model list, so + # callers never have to reach into the BreadFit's slots. + if (methods::is(fit, "BreadFit")) fit <- fit@model if (!is.list(fit) || is.null(fit$fits) || is.null(fit$contrast_idx)) { stop("`fit` must be the output of fit_bread_summary() or fit_bread_brms().", call. = FALSE) diff --git a/R/report.R b/R/report.R deleted file mode 100644 index 7d5154e..0000000 --- a/R/report.R +++ /dev/null @@ -1,12 +0,0 @@ -#' Feature-set level summary report -#' -#' Aggregates region-level classifications into a feature-set / feature-class -#' summary (counts and proportions of hyper / hypo / inconclusive). -#' -#' @param fit A [BreadFit]. -#' @param feature_class_col Column in `mcols(features)` defining feature class. -#' @return A data frame with one row per feature class. -#' @keywords internal -report_feature_set <- function(fit, feature_class_col = NULL) { - stop("report_feature_set() not yet implemented") -} diff --git a/R/summarize.R b/R/summarize.R index 10ef54b..1ba34d0 100644 --- a/R/summarize.R +++ b/R/summarize.R @@ -30,6 +30,21 @@ #' @importFrom methods is #' @importFrom SummarizedExperiment assay assayNames #' @importFrom stats median var cor +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' mapping <- map_probes_to_features(se_ctrl, reg) +#' +#' # As above, the packaged assay is "betas" on the beta scale; values +#' # are converted to M-values internally before summarizing. +#' mat <- summarize_features(se_ctrl, mapping, +#' assay_name = "betas", input_scale = "Beta") +#' dim(mat) +#' mat[1:3, 1:3] #' @export summarize_features <- function(se, mapping, diff --git a/R/utils.R b/R/utils.R index be3625e..4f3c862 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,10 +1,17 @@ #' Internal utilities #' +#' @return Varies by helper: the scale transforms return numeric vectors, +#' the detection helpers return a character scalar. +#' #' @name BREAD-utils #' @keywords internal NULL #' Beta -> M transform, clamped away from 0/1. +#' +#' @param beta Numeric vector of beta values. +#' @param eps Clamping tolerance keeping values off the 0/1 asymptotes. +#' @return Numeric vector of M-values. #' @keywords internal .beta_to_m <- function(beta, eps = 1e-6) { beta <- pmin(pmax(beta, eps), 1 - eps) @@ -12,6 +19,9 @@ NULL } #' M -> Beta transform. +#' +#' @param m Numeric vector of M-values. +#' @return Numeric vector of beta values in (0, 1). #' @keywords internal .m_to_beta <- function(m) { 2^m / (2^m + 1) @@ -53,6 +63,10 @@ NULL #' - `"cross"` : full 9-color palette #' #' @return A character vector of hex colors (named where applicable). +#' @examples +#' bread_colors("classification") +#' bread_colors("group") +#' bread_colors("cross") #' @export bread_colors <- function(which = c("classification", "group", "cross")) { which <- match.arg(which) diff --git a/R/validate.R b/R/validate.R index f477745..e730369 100644 --- a/R/validate.R +++ b/R/validate.R @@ -19,6 +19,18 @@ #' @importFrom methods is #' @importFrom SummarizedExperiment assayNames colData rowRanges #' @importFrom stats model.matrix +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' # The packaged data keeps beta values in an assay named "betas", so +#' # both arguments are given explicitly here. fit_bread() detects them +#' # for you; this lower-level helper does not. +#' validate_bread_input(se_ctrl, reg, ~ passage, +#' assay_name = "betas", input_scale = "Beta") #' @export validate_bread_input <- function(se, features, diff --git a/man/BREAD-methods.Rd b/man/BREAD-methods.Rd index e1f5556..815d165 100644 --- a/man/BREAD-methods.Rd +++ b/man/BREAD-methods.Rd @@ -3,9 +3,16 @@ \name{BREAD-methods} \alias{BREAD-methods} \alias{show,BreadFit-method} +\alias{show,BreadResults-method} \title{Methods for \link{BreadFit} and \link{BreadResults}} \usage{ \S4method{show}{BreadFit}(object) + +\S4method{show}{BreadResults}(object) +} +\value{ +\code{show()} is called for its side effect of printing a summary to +the console and returns its argument invisibly. } \description{ Methods for \link{BreadFit} and \link{BreadResults} diff --git a/man/BREAD-package.Rd b/man/BREAD-package.Rd index 5ebf50d..87fa46d 100644 --- a/man/BREAD-package.Rd +++ b/man/BREAD-package.Rd @@ -17,6 +17,7 @@ effect-size and probability thresholds. Useful links: \itemize{ \item \url{https://github.com/BacZemin/BREAD} + \item \url{https://baczemin.github.io/BREAD} \item Report bugs at \url{https://github.com/BacZemin/BREAD/issues} } diff --git a/man/BREAD-plots.Rd b/man/BREAD-plots.Rd index 3ed8540..bb0aa6d 100644 --- a/man/BREAD-plots.Rd +++ b/man/BREAD-plots.Rd @@ -3,6 +3,9 @@ \name{BREAD-plots} \alias{BREAD-plots} \title{BREAD plotting helpers} +\value{ +Each of the three functions returns a \link[ggplot2:ggplot]{ggplot2::ggplot} object. +} \description{ Three publication-oriented plot functions for \link{BreadFit} output: \code{\link[=plot_region_posterior]{plot_region_posterior()}}, \code{\link[=plot_region_data]{plot_region_data()}}, and \code{\link[=plot_feature_set]{plot_feature_set()}}. diff --git a/man/BREAD-utils.Rd b/man/BREAD-utils.Rd index bfb763f..781ce1e 100644 --- a/man/BREAD-utils.Rd +++ b/man/BREAD-utils.Rd @@ -3,6 +3,10 @@ \name{BREAD-utils} \alias{BREAD-utils} \title{Internal utilities} +\value{ +Varies by helper: the scale transforms return numeric vectors, +the detection helpers return a character scalar. +} \description{ Internal utilities } diff --git a/man/BreadFit.Rd b/man/BreadFit.Rd index 52ae643..93d4d1b 100644 --- a/man/BreadFit.Rd +++ b/man/BreadFit.Rd @@ -37,3 +37,16 @@ cores, seed).} \item{\code{diagnostics}}{List with backend, seed, feature counts, failure counts.} }} +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) +fit + +slotNames(fit) +methods::slot(fit, "diagnostics") +} diff --git a/man/BreadResults.Rd b/man/BreadResults.Rd index 8751c61..cec8d15 100644 --- a/man/BreadResults.Rd +++ b/man/BreadResults.Rd @@ -5,6 +5,16 @@ \alias{BreadResults} \alias{BreadResults-class} \title{The \code{BreadResults} S4 class} +\usage{ +BreadResults(fit) +} +\arguments{ +\item{fit}{A \link{BreadFit}, as returned by \code{\link[=fit_bread]{fit_bread()}}.} +} +\value{ +\code{BreadResults()} returns a \code{BreadResults} object wrapping the +region-level results table and the classification parameters used. +} \description{ Structured result table wrapper. Reserved for downstream reporting helpers that may want a dedicated class rather than a bare data.frame. @@ -17,3 +27,17 @@ that may want a dedicated class rather than a bare data.frame. \item{\code{params}}{List of classification parameters.} }} +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) + +br <- BreadResults(fit) +br +head(methods::slot(br, "table")) + +} diff --git a/man/bread_colors.Rd b/man/bread_colors.Rd index ee47a4e..7288944 100644 --- a/man/bread_colors.Rd +++ b/man/bread_colors.Rd @@ -22,3 +22,8 @@ Colorblind-reasonable palette derived from the MetBrewer \code{Cross} palette (Blake Robert Mills). Embedded as hex values so there is no runtime dependency on the \code{MetBrewer} package. } +\examples{ +bread_colors("classification") +bread_colors("group") +bread_colors("cross") +} diff --git a/man/bread_kycg.Rd b/man/bread_kycg.Rd index d8ed422..fa9af2d 100644 --- a/man/bread_kycg.Rd +++ b/man/bread_kycg.Rd @@ -58,10 +58,21 @@ to override. } \examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) +table(results(fit)$classification) + +# The enrichment call downloads KnowYourCG reference databases, so it is +# not run here. \dontrun{ - fit <- fit_bread(se, features, ~ group) - enr <- bread_kycg(fit, platform = "EPIC") - head(enr[enr$FDR < 0.01, ]) +enr <- bread_kycg(fit, which = "hypermethylated", + platform = "EPICv2") +head(enr[enr$FDR < 0.01, ]) } } diff --git a/man/bread_prior.Rd b/man/bread_prior.Rd index 92303e9..d8d067c 100644 --- a/man/bread_prior.Rd +++ b/man/bread_prior.Rd @@ -29,3 +29,11 @@ Default prior for \code{fit_bread_summary()}: weakly-informative Normal-Inverse- The inverse-gamma hyperparameters default to \code{a0 = b0 = 0.001}, which is approximately Jeffreys. } +\examples{ +# Defaults: weak coefficient precision, near-flat inverse-gamma on the +# residual variance. +bread_prior() + +# A tighter prior, e.g. when regions are small and n is low +bread_prior(lambda0 = 0.05, a0 = 0.01, b0 = 0.01) +} diff --git a/man/classifications.Rd b/man/classifications.Rd index 94668cf..c974627 100644 --- a/man/classifications.Rd +++ b/man/classifications.Rd @@ -22,3 +22,16 @@ A named character vector of classifications per region \description{ Extract region classifications from a \link{BreadFit} } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) + +cls <- classifications(fit) +head(cls) +table(cls) +} diff --git a/man/classify_regions.Rd b/man/classify_regions.Rd index bcfd9b5..a2706e7 100644 --- a/man/classify_regions.Rd +++ b/man/classify_regions.Rd @@ -33,3 +33,19 @@ In the rare case that both probabilities exceed the cutoff (only possible for very low \code{prob_cutoff}), the region is assigned to whichever side has the larger posterior probability. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) +post <- posterior_summary(fit) + +cl <- classify_regions(post) +table(cl$classification) + +# A stricter cutoff moves borderline regions into `inconclusive` +table(classify_regions(post, prob_cutoff = 0.99)$classification) +} diff --git a/man/dot-beta_to_m.Rd b/man/dot-beta_to_m.Rd index aec9e74..ed2911a 100644 --- a/man/dot-beta_to_m.Rd +++ b/man/dot-beta_to_m.Rd @@ -6,6 +6,14 @@ \usage{ .beta_to_m(beta, eps = 1e-06) } +\arguments{ +\item{beta}{Numeric vector of beta values.} + +\item{eps}{Clamping tolerance keeping values off the 0/1 asymptotes.} +} +\value{ +Numeric vector of M-values. +} \description{ Beta -> M transform, clamped away from 0/1. } diff --git a/man/dot-m_to_beta.Rd b/man/dot-m_to_beta.Rd index d6b503c..8553722 100644 --- a/man/dot-m_to_beta.Rd +++ b/man/dot-m_to_beta.Rd @@ -6,6 +6,12 @@ \usage{ .m_to_beta(m) } +\arguments{ +\item{m}{Numeric vector of M-values.} +} +\value{ +Numeric vector of beta values in (0, 1). +} \description{ M -> Beta transform. } diff --git a/man/fit_bread.Rd b/man/fit_bread.Rd index b22b43b..255e9e2 100644 --- a/man/fit_bread.Rd +++ b/man/fit_bread.Rd @@ -91,6 +91,22 @@ updates); MCMC controls \code{iter}, \code{chains}, \code{cores}, \code{seed} ca through \code{...} to \code{fit_bread_brms()}. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +# Which of the 500 predefined regions change methylation with passage +# in the control (untreated) fibroblasts? +fit <- fit_bread(se_ctrl, reg, ~ passage, + feature_class_col = "feature_class") +fit + +head(results(fit)) +table(results(fit)$classification) +} \seealso{ \code{\link[=validate_bread_input]{validate_bread_input()}}, \code{\link[=map_probes_to_features]{map_probes_to_features()}}, \code{\link[=summarize_features]{summarize_features()}}, \code{\link[=posterior_summary]{posterior_summary()}}, \code{\link[=classify_regions]{classify_regions()}} diff --git a/man/fit_bread_hierarchical.Rd b/man/fit_bread_hierarchical.Rd index 0648e26..14c816b 100644 --- a/man/fit_bread_hierarchical.Rd +++ b/man/fit_bread_hierarchical.Rd @@ -6,6 +6,10 @@ \usage{ fit_bread_hierarchical(...) } +\value{ +Currently signals an error; planned to return a list with the +same shape as \code{\link[=fit_bread_summary]{fit_bread_summary()}}. +} \description{ Planned for v2. Models CpGs nested within regions with CpG-specific offsets and partial pooling of region-level effects. diff --git a/man/map_probes_to_features.Rd b/man/map_probes_to_features.Rd index 41dc1fa..4fd6127 100644 --- a/man/map_probes_to_features.Rd +++ b/man/map_probes_to_features.Rd @@ -37,3 +37,18 @@ format). Probes with no region are silently excluded from the returned mapping. Regions excluded by \code{min_probes} (including those with zero overlaps) are recorded on \code{attr(mapping, "dropped_regions")}. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +mapping <- map_probes_to_features(se, reg) +head(mapping) +nrow(mapping) + +# Regions carrying fewer than `min_probes` probes are dropped and +# recorded in an attribute rather than silently disappearing. +attr(mapping, "dropped_regions") +} diff --git a/man/plot_feature_set.Rd b/man/plot_feature_set.Rd index a1a3976..efcb312 100644 --- a/man/plot_feature_set.Rd +++ b/man/plot_feature_set.Rd @@ -19,3 +19,17 @@ Bar chart of classification counts across all fitted regions. When \code{feature_class_col} is supplied, bars are stacked by feature class so users can see, e.g., how PRC / CGI / LAD subsets partition into hyper vs. hypo. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +# `feature_class_col` names a column of the fit's probe-to-region +# mapping, so it has to be passed to fit_bread() first. +fit <- fit_bread(se_ctrl, reg, ~ passage, + feature_class_col = "feature_class") + +plot_feature_set(fit, feature_class_col = "feature_class") +} diff --git a/man/plot_region_data.Rd b/man/plot_region_data.Rd index c465848..18b8021 100644 --- a/man/plot_region_data.Rd +++ b/man/plot_region_data.Rd @@ -18,3 +18,19 @@ A \link[ggplot2:ggplot]{ggplot2::ggplot} object. Boxplot + jitter of the summarized region values for a single region, grouped by the first variable in the design formula. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) + +res <- results(fit) +rid <- res$region_id[which(res$classification == "hypermethylated")[1]] +if (is.na(rid)) rid <- res$region_id[1] + +# `region_id` must be a single region. +plot_region_data(fit, rid) +} diff --git a/man/plot_region_posterior.Rd b/man/plot_region_posterior.Rd index 5d6088a..5123495 100644 --- a/man/plot_region_posterior.Rd +++ b/man/plot_region_posterior.Rd @@ -25,3 +25,21 @@ for one or more regions, with vertical guides at \code{0} and \verb{+/- delta} a color by final classification. When multiple regions are supplied the plot facets by region. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage, + feature_class_col = "feature_class") + +# Pick a region that was actually called hypermethylated; passing +# `region_id = NULL` would facet every region in the fit. +res <- results(fit) +rid <- res$region_id[which(res$classification == "hypermethylated")[1]] +if (is.na(rid)) rid <- res$region_id[1] + +plot_region_posterior(fit, region_id = rid) +} diff --git a/man/posterior_draws.Rd b/man/posterior_draws.Rd index d825fd3..18cbb82 100644 --- a/man/posterior_draws.Rd +++ b/man/posterior_draws.Rd @@ -27,3 +27,19 @@ A long \code{data.frame} with columns \code{region_id}, \code{draw}, \code{value Samples are drawn from the marginal scaled Student-t posterior of the contrast coefficient, \verb{beta ~ mu_n + scale * t_\{2 a_n\}}. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) + +# Always name the region(s) you want -- the default (NULL) draws from +# every region, which is `n` x n_regions rows. +rid <- results(fit)$region_id[1] +d <- posterior_draws(fit, region_id = rid, n = 500L, seed = 1L) +head(d) +quantile(d$value, c(0.025, 0.5, 0.975)) +} diff --git a/man/posterior_summary.Rd b/man/posterior_summary.Rd index e52a5ef..6683683 100644 --- a/man/posterior_summary.Rd +++ b/man/posterior_summary.Rd @@ -7,7 +7,8 @@ posterior_summary(fit, delta = 0.1, ci = 0.95) } \arguments{ -\item{fit}{Output of \code{\link[=fit_bread_summary]{fit_bread_summary()}} or \code{\link[=fit_bread_brms]{fit_bread_brms()}}.} +\item{fit}{A \link{BreadFit} (as returned by \code{\link[=fit_bread]{fit_bread()}}), or the internal +model list from \code{\link[=fit_bread_summary]{fit_bread_summary()}} / \code{\link[=fit_bread_brms]{fit_bread_brms()}}.} \item{delta}{Effect-size threshold on the M-value scale. Default \code{0.10}.} @@ -39,3 +40,19 @@ computed from the MCMC draws directly. Columns in the returned data frame are the same in both cases. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) + +# A BreadFit is accepted directly; the internal model list also works. +post <- posterior_summary(fit) +head(post) + +# A wider credible interval +head(posterior_summary(fit, ci = 0.99)) +} diff --git a/man/report_feature_set.Rd b/man/report_feature_set.Rd deleted file mode 100644 index a93b356..0000000 --- a/man/report_feature_set.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/report.R -\name{report_feature_set} -\alias{report_feature_set} -\title{Feature-set level summary report} -\usage{ -report_feature_set(fit, feature_class_col = NULL) -} -\arguments{ -\item{fit}{A \link{BreadFit}.} - -\item{feature_class_col}{Column in \code{mcols(features)} defining feature class.} -} -\value{ -A data frame with one row per feature class. -} -\description{ -Aggregates region-level classifications into a feature-set / feature-class -summary (counts and proportions of hyper / hypo / inconclusive). -} -\keyword{internal} diff --git a/man/results.Rd b/man/results.Rd index 7b1d8b3..f5d1f62 100644 --- a/man/results.Rd +++ b/man/results.Rd @@ -20,3 +20,16 @@ A data frame with one row per region. \description{ Extract the region-level results table from a \link{BreadFit} } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) + +res <- results(fit) +head(res) +colnames(res) +} diff --git a/man/summarize_features.Rd b/man/summarize_features.Rd index fb7df65..957c2ee 100644 --- a/man/summarize_features.Rd +++ b/man/summarize_features.Rd @@ -50,3 +50,19 @@ M-value interpretation under \code{"pc1"}. } } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +mapping <- map_probes_to_features(se_ctrl, reg) + +# As above, the packaged assay is "betas" on the beta scale; values +# are converted to M-values internally before summarizing. +mat <- summarize_features(se_ctrl, mapping, + assay_name = "betas", input_scale = "Beta") +dim(mat) +mat[1:3, 1:3] +} diff --git a/man/validate_bread_input.Rd b/man/validate_bread_input.Rd index a38e12b..6c49c7d 100644 --- a/man/validate_bread_input.Rd +++ b/man/validate_bread_input.Rd @@ -37,3 +37,16 @@ coordinates, that \code{features} is a non-empty \link[GenomicRanges:GRanges-cla that \code{assay_name} is present, and that \code{contrast} (when non-NULL) resolves to a coefficient of the design's model matrix. } +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +# The packaged data keeps beta values in an assay named "betas", so +# both arguments are given explicitly here. fit_bread() detects them +# for you; this lower-level helper does not. +validate_bread_input(se_ctrl, reg, ~ passage, + assay_name = "betas", input_scale = "Beta") +} From a185c97ce454b7d01137f50f8f48bbfeab409dd2 Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 01:43:40 -0400 Subject: [PATCH 03/17] Add unit tests for classify, posterior, methods, classes, utils and extdata Six R files had no test file at all, including posterior.R and classify.R -- the statistical core. - test-classify.R drives the decision rule with hand-built posterior tables so the cutoff boundary is exact: >= is inclusive, a stricter cutoff can only move regions to inconclusive, NA rows never yield NA classifications. - test-posterior.R pins the 13-column contract, checks that a wider ci widens intervals without moving point estimates, that p_pos + p_neg == 1, and that the new BreadFit fast-path is identical to passing the model list. - test-methods.R covers accessor/name alignment, seed reproducibility, and that posterior_draws() restores the caller RNG state. - test-classes.R pins the S4 slot layout, which the plotting helpers and accessors depend on by name. - test-utils.R covers the M/beta round trip, boundary clamping, and the documented assay-name priority order. - test-kycg.R covers argument validation only -- no network calls. - test-extdata-contract.R pins the packaged data shape. Every new example is written against those two objects, so a rename or a dropped colData column would otherwise surface as an opaque R CMD check failure. 284 tests pass. --- tests/testthat/test-classes.R | 41 +++++++++++++ tests/testthat/test-classify.R | 73 +++++++++++++++++++++++ tests/testthat/test-extdata-contract.R | 80 ++++++++++++++++++++++++++ tests/testthat/test-kycg.R | 27 +++++++++ tests/testthat/test-methods.R | 79 +++++++++++++++++++++++++ tests/testthat/test-posterior.R | 68 ++++++++++++++++++++++ tests/testthat/test-utils.R | 65 +++++++++++++++++++++ 7 files changed, 433 insertions(+) create mode 100644 tests/testthat/test-classes.R create mode 100644 tests/testthat/test-classify.R create mode 100644 tests/testthat/test-extdata-contract.R create mode 100644 tests/testthat/test-kycg.R create mode 100644 tests/testthat/test-methods.R create mode 100644 tests/testthat/test-posterior.R create mode 100644 tests/testthat/test-utils.R diff --git a/tests/testthat/test-classes.R b/tests/testthat/test-classes.R new file mode 100644 index 0000000..1612b32 --- /dev/null +++ b/tests/testthat/test-classes.R @@ -0,0 +1,41 @@ +# The S4 slot layout is a public contract: the plotting helpers and the +# accessors reach into these slots by name. Pin them. + +test_that("BreadFit slots are the documented set, in order", { + expect_identical( + methods::slotNames("BreadFit"), + c("call", "params", "mode", "assay_name", "input_scale", + "mapping", "features", "model", "posterior", "results", "diagnostics") + ) +}) + +test_that("BreadResults slots are the documented set", { + expect_identical(methods::slotNames("BreadResults"), c("table", "params")) +}) + +test_that("a fitted BreadFit populates every slot it promises", { + fit <- fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group) + expect_s4_class(fit, "BreadFit") + expect_true(is.call(fit@call)) + expect_identical(fit@mode, "summary") + expect_type(fit@params, "list") + expect_type(fit@diagnostics, "list") + expect_s3_class(fit@mapping, "data.frame") + expect_s3_class(fit@results, "data.frame") + expect_s3_class(fit@posterior, "data.frame") + expect_type(fit@model, "list") + expect_identical(fit@diagnostics$backend, "conjugate") +}) + +test_that("BreadResults() round-trips the results table", { + fit <- fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group) + br <- BreadResults(fit) + expect_s4_class(br, "BreadResults") + expect_equal(methods::slot(br, "table"), results(fit)) + expect_equal(methods::slot(br, "params"), fit@params) +}) + +test_that("BreadResults() rejects non-BreadFit input", { + expect_error(BreadResults(data.frame(x = 1)), "must be a BreadFit") + expect_error(BreadResults(NULL), "must be a BreadFit") +}) diff --git a/tests/testthat/test-classify.R b/tests/testthat/test-classify.R new file mode 100644 index 0000000..5b4b6bb --- /dev/null +++ b/tests/testthat/test-classify.R @@ -0,0 +1,73 @@ +# classify_regions() applies the decision rule; it does not recompute +# posterior probabilities. These tests drive it with hand-built posterior +# tables so the boundaries are exact rather than approximate. + +`%|NULL|%` <- function(a, b) if (is.null(a)) b else a + +.fake_post <- function(p_gt, p_lt, ids = NULL) { + n <- length(p_gt) + data.frame( + region_id = ids %|NULL|% sprintf("r%02d", seq_len(n)), + p_gt_delta = p_gt, + p_lt_neg_delta = p_lt, + stringsAsFactors = FALSE + ) +} + +test_that("classification levels are exact and in a fixed order", { + out <- classify_regions(.fake_post(c(0.99, 0.01, 0.5), c(0.01, 0.99, 0.5))) + expect_s3_class(out$classification, "factor") + expect_identical( + levels(out$classification), + c("hypermethylated", "hypomethylated", "inconclusive") + ) + expect_identical( + as.character(out$classification), + c("hypermethylated", "hypomethylated", "inconclusive") + ) +}) + +test_that("the cutoff comparison is inclusive (>=), not strict", { + at <- classify_regions(.fake_post(0.95, 0.0), prob_cutoff = 0.95) + below <- classify_regions(.fake_post(0.95 - 1e-12, 0.0), prob_cutoff = 0.95) + expect_identical(as.character(at$classification), "hypermethylated") + expect_identical(as.character(below$classification), "inconclusive") +}) + +test_that("a stricter cutoff only ever moves regions to inconclusive", { + set.seed(42) + post <- .fake_post(runif(200), runif(200)) + loose <- classify_regions(post, prob_cutoff = 0.80)$classification + strict <- classify_regions(post, prob_cutoff = 0.99)$classification + moved <- loose != strict + expect_true(all(strict[moved] == "inconclusive")) +}) + +test_that("failed fits (NA probabilities) become inconclusive, never NA", { + out <- classify_regions(.fake_post(c(NA, 0.99), c(NA, 0.001))) + expect_false(any(is.na(out$classification))) + expect_identical(as.character(out$classification)[1], "inconclusive") +}) + +test_that("when both tails clear the cutoff the larger probability wins", { + out <- classify_regions(.fake_post(c(0.60, 0.40), c(0.40, 0.60)), + prob_cutoff = 0.30) + expect_identical(as.character(out$classification), + c("hypermethylated", "hypomethylated")) +}) + +test_that("delta and prob_cutoff are recorded as attributes", { + out <- classify_regions(.fake_post(0.99, 0.0), delta = 0.25, + prob_cutoff = 0.9) + expect_equal(attr(out, "delta"), 0.25) + expect_equal(attr(out, "prob_cutoff"), 0.9) +}) + +test_that("bad input is rejected with an informative error", { + expect_error(classify_regions("nope"), "data.frame") + expect_error(classify_regions(data.frame(x = 1)), "missing required columns") + expect_error(classify_regions(.fake_post(0.9, 0.1), prob_cutoff = 1), + "must be in \\(0, 1\\)") + expect_error(classify_regions(.fake_post(0.9, 0.1), prob_cutoff = 0), + "must be in \\(0, 1\\)") +}) diff --git a/tests/testthat/test-extdata-contract.R b/tests/testthat/test-extdata-contract.R new file mode 100644 index 0000000..2ea6731 --- /dev/null +++ b/tests/testthat/test-extdata-contract.R @@ -0,0 +1,80 @@ +# Every @examples block in this package is written against the two packaged +# extdata objects. If their shape drifts -- an assay rename, a dropped +# colData column, a change in the feature classes -- the examples break at +# R CMD check time with an opaque error. These tests pin the contract so the +# failure lands here instead, with a message that says what changed. + +.se <- function() { + readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +} +.reg <- function() { + readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +} + +test_that("both extdata files are installed and loadable", { + expect_true(nzchar(system.file("extdata", "vitc_ag06561.rds", + package = "BREAD"))) + expect_true(nzchar(system.file("extdata", "vitc_regions.rds", + package = "BREAD"))) +}) + +test_that("the packaged SE has the assay name and scale the examples assume", { + se <- .se() + expect_s4_class(se, "RangedSummarizedExperiment") + expect_identical(SummarizedExperiment::assayNames(se), "betas") + + x <- SummarizedExperiment::assay(se, "betas") + expect_true(all(x >= 0 & x <= 1, na.rm = TRUE)) + # Examples rely on fit_bread() auto-detecting both of these. + expect_identical(BREAD:::.detect_input_scale(x), "Beta") + expect_identical(BREAD:::.detect_assay_name(se), "betas") +}) + +test_that("the colData columns the examples subset on are present", { + cd <- SummarizedExperiment::colData(.se()) + + expect_true(all(c("condition", "passage") %in% colnames(cd))) + expect_s3_class(cd$condition, "factor") + expect_s3_class(cd$passage, "factor") + expect_identical(levels(cd$condition), c("ctrl", "aa57")) + expect_identical(levels(cd$passage), c("early", "late")) + + # `se[, se$condition == "ctrl"]` must leave both passage levels populated, + # otherwise `~ passage` is not estimable. + ctrl <- cd[cd$condition == "ctrl", , drop = FALSE] + expect_gt(nrow(ctrl), 0L) + expect_setequal(as.character(unique(ctrl$passage)), c("early", "late")) +}) + +test_that("the packaged regions carry the feature_class column", { + reg <- .reg() + expect_s4_class(reg, "GRanges") + expect_gt(length(reg), 0L) + expect_true("feature_class" %in% colnames(S4Vectors::mcols(reg))) + expect_false(is.null(names(reg))) + expect_identical(anyDuplicated(names(reg)), 0L) +}) + +test_that("regions and probes overlap at the example threshold", { + # If this fails, every example calling fit_bread() on the packaged data + # errors with "no regions retained". + mapping <- map_probes_to_features(.se(), .reg(), min_probes = 3L) + expect_gt(nrow(mapping), 0L) + expect_gt(length(unique(mapping$region_id)), 0L) + expect_true("feature_class" %in% colnames(mapping)) +}) + +test_that("the documented example fit runs end to end", { + se <- .se() + reg <- .reg() + se_ctrl <- se[, se$condition == "ctrl"] + + fit <- fit_bread(se_ctrl, reg, ~ passage, + feature_class_col = "feature_class") + expect_s4_class(fit, "BreadFit") + + res <- results(fit) + expect_gt(nrow(res), 0L) + expect_true(all(c("region_id", "classification") %in% colnames(res))) + expect_true(any(!is.na(res$p_gt_delta))) +}) diff --git a/tests/testthat/test-kycg.R b/tests/testthat/test-kycg.R new file mode 100644 index 0000000..99f77a7 --- /dev/null +++ b/tests/testthat/test-kycg.R @@ -0,0 +1,27 @@ +# bread_kycg() reaches out to KnowYourCG reference databases, so these tests +# deliberately cover only the validation that happens before any network or +# annotation-hub access. + +.toy_fit <- function() { + fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group) +} + +test_that("a non-BreadFit is rejected before any database access", { + expect_error(bread_kycg(data.frame(x = 1)), "BreadFit") + expect_error(bread_kycg(NULL), "BreadFit") +}) + +test_that("`which` and `platform` are matched against their allowed values", { + skip_if_not_installed("knowYourCG") + fit <- .toy_fit() + expect_error(bread_kycg(fit, platform = "NotAPlatform")) + expect_error(bread_kycg(fit, which = "sideways")) +}) + +test_that("the fit exposes the mapping columns bread_kycg() reads", { + # Not a network test: pins the columns bread_kycg() depends on, so a + # refactor of map_probes_to_features() cannot silently break it. + fit <- .toy_fit() + expect_true(all(c("probe_id", "region_id") %in% colnames(fit@mapping))) + expect_type(fit@mapping$probe_id, "character") +}) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R new file mode 100644 index 0000000..30e3a78 --- /dev/null +++ b/tests/testthat/test-methods.R @@ -0,0 +1,79 @@ +# Accessors and show methods for BreadFit / BreadResults. + +.toy_fit <- function() { + fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group) +} + +test_that("results() returns the region table with a classification column", { + res <- results(.toy_fit()) + expect_s3_class(res, "data.frame") + expect_true(all(c("region_id", "classification") %in% colnames(res))) + expect_gt(nrow(res), 0L) +}) + +test_that("classifications() names line up with results() region ids", { + fit <- .toy_fit() + cls <- classifications(fit) + res <- results(fit) + expect_type(cls, "character") + expect_identical(names(cls), as.character(res$region_id)) + expect_identical(unname(cls), as.character(res$classification)) + expect_true(all(cls %in% c("hypermethylated", "hypomethylated", + "inconclusive"))) +}) + +test_that("posterior_draws() is reproducible for a fixed seed", { + fit <- .toy_fit() + rid <- results(fit)$region_id[1] + a <- posterior_draws(fit, region_id = rid, n = 200L, seed = 7L) + b <- posterior_draws(fit, region_id = rid, n = 200L, seed = 7L) + expect_equal(a, b) + expect_identical(colnames(a), c("region_id", "draw", "value")) + expect_identical(nrow(a), 200L) + expect_identical(unique(a$region_id), rid) +}) + +test_that("posterior_draws() differs across seeds", { + fit <- .toy_fit() + rid <- results(fit)$region_id[1] + a <- posterior_draws(fit, region_id = rid, n = 200L, seed = 1L) + b <- posterior_draws(fit, region_id = rid, n = 200L, seed = 2L) + expect_false(isTRUE(all.equal(a$value, b$value))) +}) + +test_that("posterior_draws() restores the caller's RNG state", { + # local_seed() must not leak its reseed into the calling session. + fit <- .toy_fit() + rid <- results(fit)$region_id[1] + set.seed(99) + before <- runif(1) + set.seed(99) + invisible(posterior_draws(fit, region_id = rid, n = 10L, seed = 123L)) + after <- runif(1) + expect_equal(before, after) +}) + +test_that("posterior_draws() defaults to every region", { + fit <- .toy_fit() + n_regions <- nrow(results(fit)) + d <- posterior_draws(fit, n = 10L, seed = 1L) + expect_identical(nrow(d), as.integer(n_regions * 10L)) +}) + +test_that("an unknown region_id errors and names the offender", { + expect_error(posterior_draws(.toy_fit(), region_id = "no_such_region"), + "not found") +}) + +test_that("show() prints the expected BreadFit header", { + fit <- .toy_fit() + expect_output(show(fit), "") + expect_output(show(fit), "classifications:") + expect_output(show(fit), "backend") +}) + +test_that("show() prints the expected BreadResults header", { + br <- BreadResults(.toy_fit()) + expect_output(show(br), "") + expect_output(show(br), "n_regions") +}) diff --git a/tests/testthat/test-posterior.R b/tests/testthat/test-posterior.R new file mode 100644 index 0000000..46b663b --- /dev/null +++ b/tests/testthat/test-posterior.R @@ -0,0 +1,68 @@ +# posterior_summary() is the bridge between a backend fit and the +# classification rule. Its column contract is what downstream code and the +# BreadFit results table both depend on. + +POST_COLS <- c("region_id", "n", "mean_effect", "median_effect", + "ci_lo", "ci_hi", "df", "scale", "p_pos", "p_neg", + "p_gt_delta", "p_lt_neg_delta", "error") + +.toy_fit <- function() { + fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group) +} + +test_that("the returned column contract is stable", { + post <- posterior_summary(.toy_fit()) + expect_s3_class(post, "data.frame") + expect_identical(colnames(post), POST_COLS) +}) + +test_that("a BreadFit is accepted and matches the internal model list", { + fit <- .toy_fit() + expect_equal(posterior_summary(fit), posterior_summary(fit@model)) +}) + +test_that("a wider ci widens every interval but moves no point estimate", { + fit <- .toy_fit() + p95 <- posterior_summary(fit, ci = 0.95) + p99 <- posterior_summary(fit, ci = 0.99) + ok <- !is.na(p95$ci_lo) & !is.na(p99$ci_lo) + expect_true(all(p99$ci_lo[ok] <= p95$ci_lo[ok])) + expect_true(all(p99$ci_hi[ok] >= p95$ci_hi[ok])) + expect_equal(p95$mean_effect, p99$mean_effect) +}) + +test_that("directional probabilities are coherent", { + post <- posterior_summary(.toy_fit()) + ok <- !is.na(post$p_pos) + expect_equal(post$p_pos[ok] + post$p_neg[ok], rep(1, sum(ok)), + tolerance = 1e-8) + expect_true(all(post$p_gt_delta[ok] <= post$p_pos[ok] + 1e-8)) + expect_true(all(post$p_lt_neg_delta[ok] <= post$p_neg[ok] + 1e-8)) + for (col in c("p_pos", "p_neg", "p_gt_delta", "p_lt_neg_delta")) { + expect_true(all(post[[col]][ok] >= 0 & post[[col]][ok] <= 1)) + } +}) + +test_that("a larger delta cannot increase the directional probabilities", { + fit <- .toy_fit() + small <- posterior_summary(fit, delta = 0.05) + large <- posterior_summary(fit, delta = 0.50) + ok <- !is.na(small$p_gt_delta) + expect_true(all(large$p_gt_delta[ok] <= small$p_gt_delta[ok] + 1e-12)) + expect_true(all(large$p_lt_neg_delta[ok] <= small$p_lt_neg_delta[ok] + 1e-12)) +}) + +test_that("delta, ci and contrast are recorded as attributes", { + post <- posterior_summary(.toy_fit(), delta = 0.2, ci = 0.9) + expect_equal(attr(post, "delta"), 0.2) + expect_equal(attr(post, "ci"), 0.9) + expect_true(is.character(attr(post, "contrast"))) +}) + +test_that("bad input is rejected", { + fit <- .toy_fit() + expect_error(posterior_summary(list(a = 1)), "fit_bread_summary") + expect_error(posterior_summary(fit, delta = -1), "non-negative") + expect_error(posterior_summary(fit, ci = 0), "must be in \\(0, 1\\)") + expect_error(posterior_summary(fit, ci = 1), "must be in \\(0, 1\\)") +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 0000000..5ae810f --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,65 @@ +# Internal transforms, palettes, and the auto-detection helpers that make +# fit_bread()'s three-argument form work. + +test_that("beta <-> M round-trips across the usable range", { + betas <- c(0.01, 0.1, 0.25, 0.5, 0.75, 0.9, 0.99) + expect_equal(BREAD:::.m_to_beta(BREAD:::.beta_to_m(betas)), betas, + tolerance = 1e-8) +}) + +test_that("beta -> M clamps at the boundaries instead of returning Inf", { + out <- BREAD:::.beta_to_m(c(0, 1)) + expect_true(all(is.finite(out))) + expect_lt(out[1], 0) + expect_gt(out[2], 0) +}) + +test_that("beta -> M is monotone increasing and centred at 0.5", { + m <- BREAD:::.beta_to_m(seq(0.05, 0.95, by = 0.05)) + expect_true(all(diff(m) > 0)) + expect_equal(BREAD:::.beta_to_m(0.5), 0, tolerance = 1e-6) +}) + +test_that("input scale detection keys off the [0, 1] range", { + expect_identical(BREAD:::.detect_input_scale(c(0, 0.5, 1)), "Beta") + expect_identical(BREAD:::.detect_input_scale(c(0.2, 0.8)), "Beta") + expect_identical(BREAD:::.detect_input_scale(c(-2, 0.5, 3)), "M") + expect_identical(BREAD:::.detect_input_scale(c(0.5, 1.5)), "M") +}) + +test_that("assay-name detection follows the documented priority", { + mk <- function(nms) { + m <- matrix(0.5, nrow = 2, ncol = 2, + dimnames = list(c("p1", "p2"), c("s1", "s2"))) + a <- stats::setNames(replicate(length(nms), m, simplify = FALSE), nms) + SummarizedExperiment::SummarizedExperiment(assays = a) + } + expect_identical(BREAD:::.detect_assay_name(mk(c("betas", "M"))), "M") + expect_identical(BREAD:::.detect_assay_name(mk(c("Beta", "betas"))), "betas") + expect_identical(BREAD:::.detect_assay_name(mk(c("beta", "Beta"))), "Beta") + expect_identical(BREAD:::.detect_assay_name(mk("beta")), "beta") + expect_identical(BREAD:::.detect_assay_name(mk(c("weird", "other"))), "weird") +}) + +test_that("bread_colors() returns the documented shapes", { + cl <- bread_colors("classification") + expect_length(cl, 3L) + expect_identical(names(cl), + c("hypermethylated", "hypomethylated", "inconclusive")) + + grp <- bread_colors("group") + expect_length(grp, 2L) + expect_null(names(grp)) + + cross <- bread_colors("cross") + expect_length(cross, 9L) + + for (pal in list(cl, grp, cross)) { + expect_true(all(grepl("^#[0-9A-Fa-f]{6}$", pal))) + } +}) + +test_that("bread_colors() defaults to the classification palette", { + expect_identical(bread_colors(), bread_colors("classification")) + expect_error(bread_colors("nonsense")) +}) From 38a0104849d2ebb2f1b370f56c2c70fe707ae282 Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 01:43:51 -0400 Subject: [PATCH 04/17] Generate README from README.Rmd; add CITATION and community files The README hard-coded its example output as a hand-typed comment, and an earlier draft had already shipped the wrong classification labels. It is now knitted from README.Rmd, so the 76/39/385 counts are generated rather than asserted. - inst/CITATION, picking the version up from DESCRIPTION. No DOI yet; add one via bibentry(doi = ) once there is a preprint. - .github/CONTRIBUTING.md, SUPPORT.md, and CODE_OF_CONDUCT.md (adopting the Bioconductor Code of Conduct), plus issue templates that route usage questions to the Bioconductor support site. - NEWS.md: heading is now a bare version, which the Bioconductor markdown NEWS parser requires. - _pkgdown.yml: the reference section claimed the backend fit helpers were exposed, but they are internal and unexported; the news block still advertised 0.0.0.9000. --- .github/CODE_OF_CONDUCT.md | 24 +++ .github/CONTRIBUTING.md | 75 +++++++++ .github/ISSUE_TEMPLATE/bug_report.yml | 55 +++++++ .github/ISSUE_TEMPLATE/config.yml | 11 ++ .github/ISSUE_TEMPLATE/feature_request.yml | 36 +++++ .github/SUPPORT.md | 32 ++++ NEWS.md | 12 +- README.Rmd | 168 +++++++++++++++++++++ README.md | 152 +++++++++++++------ _pkgdown.yml | 8 +- inst/CITATION | 24 +++ 11 files changed, 545 insertions(+), 52 deletions(-) create mode 100644 .github/CODE_OF_CONDUCT.md create mode 100644 .github/CONTRIBUTING.md create mode 100644 .github/ISSUE_TEMPLATE/bug_report.yml create mode 100644 .github/ISSUE_TEMPLATE/config.yml create mode 100644 .github/ISSUE_TEMPLATE/feature_request.yml create mode 100644 .github/SUPPORT.md create mode 100644 README.Rmd create mode 100644 inst/CITATION diff --git a/.github/CODE_OF_CONDUCT.md b/.github/CODE_OF_CONDUCT.md new file mode 100644 index 0000000..18cd10b --- /dev/null +++ b/.github/CODE_OF_CONDUCT.md @@ -0,0 +1,24 @@ +# Code of Conduct + +BREAD is a Bioconductor package and adopts the +**[Bioconductor Code of Conduct](https://bioconductor.org/about/code-of-conduct/)** +in full. + +In short: the Bioconductor community is dedicated to providing a welcoming, +harassment-free experience for everyone, regardless of gender identity and +expression, sexual orientation, disability, physical appearance, body size, +race, age, religion, or level of experience. We do not tolerate harassment of +community members in any form. + +Please read the full text, including the list of expected and unacceptable +behaviours, at . + +## Reporting + +Report violations to the package maintainer (see `DESCRIPTION`), or — if the +report concerns the maintainer, or you would prefer to go outside the project — +to the Bioconductor Code of Conduct committee using the contact details and +reporting process described at +. + +All reports are handled confidentially. diff --git a/.github/CONTRIBUTING.md b/.github/CONTRIBUTING.md new file mode 100644 index 0000000..bb5b486 --- /dev/null +++ b/.github/CONTRIBUTING.md @@ -0,0 +1,75 @@ +# Contributing to BREAD + +Thanks for your interest in BREAD. This document covers how to report a +problem and how to work on the package. + +## Reporting bugs and asking questions + +- **Bugs and feature requests** → open a [GitHub issue](https://github.com/BacZemin/BREAD/issues). + Please include a [reprex](https://reprex.tidyverse.org/) and the output of + `sessionInfo()`. +- **Usage questions** → the + [Bioconductor support site](https://support.bioconductor.org) with the + `BREAD` tag reaches a wider audience than the issue tracker. + +A good bug report for BREAD usually needs three things: the structure of your +`SummarizedExperiment` (`assayNames()`, `dim()`, `colData()`), the `features` +`GRanges` you passed, and the exact `fit_bread()` call. + +## Development setup + +```r +# clone, then from the package root: +install.packages(c("devtools", "roxygen2", "testthat")) +BiocManager::install(c("SummarizedExperiment", "GenomicRanges", "S4Vectors")) + +devtools::load_all() +devtools::test() +``` + +Optional backends and vignette dependencies (`brms`, `knowYourCG`, +`sesameData`) live in `Suggests`; tests that need them skip cleanly when they +are absent. + +## Conventions + +- **Documentation is roxygen2.** Never edit `NAMESPACE` or anything in `man/` + by hand — run `devtools::document()` and commit the regenerated files. +- **Every exported object needs a runnable `@examples` block.** Bioconductor + requires this. The packaged example data + (`system.file("extdata", "vitc_ag06561.rds", package = "BREAD")`) is small + and fast enough that examples can fit a real model rather than fake one. +- **Tests are testthat 3rd edition.** Shared fixtures live in + `tests/testthat/helper-toy.R`. +- **No `library()` calls inside `R/`** — use `@importFrom`. +- **Style**: tidyverse style guide. Keep lines under 80 characters and + functions under 50 lines where practical; BiocCheck flags both. +- Prefer `vapply()` over `sapply()`, `seq_len()`/`seq_along()` over `1:n`, and + `TRUE`/`FALSE` over `T`/`F`. + +## Before opening a pull request + +```r +devtools::document() +devtools::test() +``` + +and a full check plus BiocCheck: + +```sh +Rscript tools/run_check.R +Rscript tools/run_bioccheck.R +``` + +Both CI workflows (`R-CMD-check` and `bioc-check`) must be green. The +`bioc-check` workflow runs on the Bioconductor devel container and is the +authoritative gate. + +Branch from `main` and use a descriptive branch name. Please do not bump the +version in a PR — that is handled at release time. + +## Code of Conduct + +This project follows the +[Bioconductor Code of Conduct](https://bioconductor.org/about/code-of-conduct/). +By participating you agree to abide by its terms. diff --git a/.github/ISSUE_TEMPLATE/bug_report.yml b/.github/ISSUE_TEMPLATE/bug_report.yml new file mode 100644 index 0000000..02eebfc --- /dev/null +++ b/.github/ISSUE_TEMPLATE/bug_report.yml @@ -0,0 +1,55 @@ +name: Bug report +description: Something in BREAD behaves incorrectly or errors unexpectedly +labels: ["bug"] +body: + - type: markdown + attributes: + value: | + Thanks for reporting. For **usage questions** ("how do I ...?"), please + use the [Bioconductor support site](https://support.bioconductor.org) + with the `BREAD` tag instead. + + - type: textarea + id: description + attributes: + label: What happened? + description: What did you expect, and what happened instead? + validations: + required: true + + - type: textarea + id: reprex + attributes: + label: Reproducible example + description: > + A self-contained [reprex](https://reprex.tidyverse.org/). The packaged + example data is a good basis if your own data cannot be shared. + value: | + ```r + library(BREAD) + se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) + reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) + + # your code here + ``` + render: r + validations: + required: true + + - type: textarea + id: data-shape + attributes: + label: Input structure + description: > + Output of `assayNames(se)`, `dim(se)`, `colData(se)`, and + `length(features)` / `names(mcols(features))`. Most BREAD issues are + input-shape issues, so this is usually the fastest route to a fix. + render: text + + - type: textarea + id: sessioninfo + attributes: + label: sessionInfo() + render: text + validations: + required: true diff --git a/.github/ISSUE_TEMPLATE/config.yml b/.github/ISSUE_TEMPLATE/config.yml new file mode 100644 index 0000000..4797d55 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/config.yml @@ -0,0 +1,11 @@ +blank_issues_enabled: false +contact_links: + - name: Usage question + url: https://support.bioconductor.org + about: > + For "how do I ...?" questions, please post on the Bioconductor support + site and tag it BREAD. Questions there reach more people and stay + searchable. + - name: Package documentation + url: https://baczemin.github.io/BREAD/ + about: Reference index, vignettes, and the getting-started guide. diff --git a/.github/ISSUE_TEMPLATE/feature_request.yml b/.github/ISSUE_TEMPLATE/feature_request.yml new file mode 100644 index 0000000..a7c9d71 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/feature_request.yml @@ -0,0 +1,36 @@ +name: Feature request +description: Suggest a capability or improvement for BREAD +labels: ["enhancement"] +body: + - type: textarea + id: problem + attributes: + label: What problem would this solve? + description: > + Describe the analysis you are trying to do and where BREAD currently + gets in the way. Concrete blocked workflows are more useful than + abstract feature names. + validations: + required: true + + - type: textarea + id: proposal + attributes: + label: Proposed solution + description: What would the API look like? A sketched call is ideal. + render: r + + - type: textarea + id: alternatives + attributes: + label: Alternatives considered + description: Other packages or workarounds you have tried. + + - type: checkboxes + id: roadmap + attributes: + label: Roadmap + options: + - label: > + I have checked NEWS.md and the open issues to see whether this is + already planned. diff --git a/.github/SUPPORT.md b/.github/SUPPORT.md new file mode 100644 index 0000000..6999a83 --- /dev/null +++ b/.github/SUPPORT.md @@ -0,0 +1,32 @@ +# Getting help with BREAD + +## Usage questions + +Ask on the **[Bioconductor support site](https://support.bioconductor.org)** +and tag your post `BREAD`. Questions there are seen by the wider Bioconductor +community and stay searchable for the next person with the same question. + +Good things to include: + +- what you are trying to test (the contrast, the regions) +- `assayNames(se)`, `dim(se)`, and `colData(se)` +- the `features` object (`length()`, `mcols()` column names) +- your exact `fit_bread()` call +- `sessionInfo()` + +## Bugs and feature requests + +Open an issue at with a +[reprex](https://reprex.tidyverse.org/). The packaged example data is a good +basis for a self-contained reproduction: + +```r +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +``` + +## Documentation + +- Package website: +- `vignette("bread-intro", package = "BREAD")` — getting started +- `vignette("bread-vitc", package = "BREAD")` — real-data walkthrough diff --git a/NEWS.md b/NEWS.md index 3d037d2..0c0df81 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ -# BREAD 0.0.0.9000 (development) +# BREAD 0.99.0 -Initial MVP — milestone 1. +First release candidate, prepared for Bioconductor submission. ## New features @@ -21,10 +21,18 @@ Initial MVP — milestone 1. dependency on the MetBrewer package). * `BreadFit` / `BreadResults` S4 classes with accessors `results()`, `classifications()`, `posterior_draws()`, and `show()`. +* `BreadResults()` — constructor for the `BreadResults` class, with a + `show()` method. The class previously had no way to build one. +* `posterior_summary()` now accepts a `BreadFit` directly, so callers no + longer need to reach into the object's `model` slot. +* Every exported object now carries a runnable `@examples` block built on + the packaged EPICv2 example data. ## Known scope * `backend = "cmdstanr"` and `mode = "hierarchical"` are scaffolded with "planned for a later release" errors. +* The unimplemented `report_feature_set()` stub has been removed; + `plot_feature_set()` covers the same ground. * Both backends fit each region independently (summary mode). Partial pooling across regions and class-level priors are deferred to M3. diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 0000000..39bab60 --- /dev/null +++ b/README.Rmd @@ -0,0 +1,168 @@ +--- +output: github_document +--- + + + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.path = "man/figures/README-", + out.width = "100%" +) +``` + +# BREAD + + +[![R-CMD-check](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml) +[![bioc-check](https://github.com/BacZemin/BREAD/actions/workflows/bioc-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/bioc-check.yaml) +[![pkgdown](https://github.com/BacZemin/BREAD/actions/workflows/pkgdown.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/pkgdown.yaml) +[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) +[![License: MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/licenses/MIT) +[![Docs](https://img.shields.io/badge/docs-pkgdown-blue.svg)](https://baczemin.github.io/BREAD/) + + +**BREAD** (Bayesian Region-specific DNA methylation inference) provides +targeted Bayesian inference for **predefined** DNA methylation regions from +array data stored in `SummarizedExperiment` objects. For each region you +supply, BREAD fits a Bayesian model, computes the posterior probability of a +directional methylation change, and classifies the region as +**hypermethylated**, **hypomethylated**, or **inconclusive** at +user-configurable effect-size and probability thresholds. + +Unlike genome-wide DMR callers that scan for regions, BREAD answers a +different question: *given regions I already care about (PRC2 targets, CGIs, +LADs, a chromHMM state, a custom BED), what is the posterior evidence for +methylation change in each one, and how confident am I?* Output is a +per-region posterior — effect size, credible interval, and directional +probabilities — not just a p-value. + +## Installation + +BREAD is in development. Install the latest version from GitHub: + +``` r +# install.packages("pak") +pak::pak("BacZemin/BREAD") + +# or with remotes: +# install.packages("remotes") +remotes::install_github("BacZemin/BREAD") +``` + +BREAD depends on Bioconductor packages (`SummarizedExperiment`, +`GenomicRanges`, `S4Vectors`). The optional `brms` backend additionally needs +`brms` plus a working Stan toolchain. + +## Example + +BREAD ships a small packaged dataset so you can run the whole pipeline out of +the box: 8 EPICv2 arrays from a fibroblast passage-aging × vitamin C +experiment, plus 500 predefined regions spanning five feature classes +(PMD, PRC-CGI, bivalent, ...). + +```{r example, message = FALSE} +library(BREAD) +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) + +# Which regions change methylation with passage in the control fibroblasts? +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread( + se_ctrl, + features = reg, + design = ~ passage, + feature_class_col = "feature_class" +) + +fit # summary: n regions, backend, classification counts +``` + +```{r example-results} +res <- results(fit) # one row per region +table(res$classification) +``` + +That is the whole pattern: a `SummarizedExperiment` of array data, a +`GRanges` of regions to test, and a model formula referencing columns of +`colData(se)`. `fit_bread()` auto-detects the assay and whether values are +on the beta or M scale, so the three arguments above are usually all you +need. `feature_class_col` is optional — supply it when your regions carry a +grouping column you want summarized. + +### Reading the results + +`results(fit)` returns one row per region: + +| column | meaning | +|---|---| +| `region_id` | region identifier | +| `n` | number of probes summarized in the region | +| `mean_effect` | posterior mean methylation change (M-scale) | +| `ci_lo`, `ci_hi` | 95% credible interval | +| `p_gt_delta` | P(effect > +delta) — evidence for hypermethylation | +| `p_lt_neg_delta` | P(effect < -delta) — evidence for hypomethylation | +| `classification` | `hypermethylated` / `hypomethylated` / `inconclusive` | + +```{r results-head} +head(res[, c("region_id", "n", "mean_effect", "ci_lo", "ci_hi", + "classification")]) +``` + +A region is called **hypermethylated** if `p_gt_delta >= prob_cutoff`, +**hypomethylated** if `p_lt_neg_delta >= prob_cutoff`, otherwise +**inconclusive**. Defaults are `delta = 0.10` (M-scale) and +`prob_cutoff = 0.95`; both are arguments to `fit_bread()`. + +`classifications(fit)` returns just the per-region calls, and +`posterior_draws(fit)` gives posterior samples for downstream summaries. + +### Backends + +- `backend = "conjugate"` (default) — analytic Normal-Inverse-Gamma + posterior, no MCMC. Hundreds of regions fit in well under a second. +- `backend = "brms"` — full MCMC via Stan; compiles once, then reuses the + compiled model across regions. Use when you need the flexibility of a + full Bayesian fit. + +### KnowYourCG enrichment + +`bread_kycg()` takes the probes in your hyper- or hypo-classified regions +and runs `knowYourCG::testEnrichment()` against curated CpG databases, so +you can ask what genomic features your called regions are enriched for. + +## Vignettes + +Two worked examples on real data (rendered on the +[documentation site](https://baczemin.github.io/BREAD/)): + +- **Getting started** (`bread-intro`) — TCGA HM450 matched normal/tumour + pairs over chromHMM chromatin-state regions, end-to-end through + `bread_kycg()`. +- **Vitamin C EPICv2** (`bread-vitc`) — the packaged fibroblast + passage-aging × vitamin C experiment, recovering classic PMD-hypo / + PRC-CGI-hyper region signatures. + +## Status + +Milestone 1 (MVP) is complete: the full `fit_bread()` pipeline, conjugate +and brms backends, S4 classes with accessors, plotting helpers, KYCG +integration, two real-data vignettes, and a live pkgdown site. Partial +pooling across regions, feature-class priors, random-effects designs, and +contrast vectors are on the roadmap. See `NEWS.md` for the changelog. + +## Citation + +```{r citation, comment = ""} +citation("BREAD") +``` + +## License + +MIT © Jaemin Park. See `LICENSE`. diff --git a/README.md b/README.md index 583b95b..8d286b1 100644 --- a/README.md +++ b/README.md @@ -1,26 +1,35 @@ + + + # BREAD -[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) -[![License: MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/licenses/MIT) + +[![R-CMD-check](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml) +[![bioc-check](https://github.com/BacZemin/BREAD/actions/workflows/bioc-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/bioc-check.yaml) [![pkgdown](https://github.com/BacZemin/BREAD/actions/workflows/pkgdown.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/pkgdown.yaml) +[![Lifecycle: +experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) +[![License: +MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/licenses/MIT) [![Docs](https://img.shields.io/badge/docs-pkgdown-blue.svg)](https://baczemin.github.io/BREAD/) **BREAD** (Bayesian Region-specific DNA methylation inference) provides -targeted Bayesian inference for **predefined** DNA methylation regions from -array data stored in `SummarizedExperiment` objects. For each region you -supply, BREAD fits a Bayesian model, computes the posterior probability of a -directional methylation change, and classifies the region as -**hypermethylated**, **hypomethylated**, or **inconclusive** at -user-configurable effect-size and probability thresholds. +targeted Bayesian inference for **predefined** DNA methylation regions +from array data stored in `SummarizedExperiment` objects. For each +region you supply, BREAD fits a Bayesian model, computes the posterior +probability of a directional methylation change, and classifies the +region as **hypermethylated**, **hypomethylated**, or **inconclusive** +at user-configurable effect-size and probability thresholds. Unlike genome-wide DMR callers that scan for regions, BREAD answers a -different question: *given regions I already care about (PRC2 targets, CGIs, -LADs, a chromHMM state, a custom BED), what is the posterior evidence for -methylation change in each one, and how confident am I?* Output is a -per-region posterior — effect size, credible interval, and directional -probabilities — not just a p-value. +different question: *given regions I already care about (PRC2 targets, +CGIs, LADs, a chromHMM state, a custom BED), what is the posterior +evidence for methylation change in each one, and how confident am I?* +Output is a per-region posterior — effect size, credible interval, and +directional probabilities — not just a p-value. ## Installation @@ -36,18 +45,19 @@ remotes::install_github("BacZemin/BREAD") ``` BREAD depends on Bioconductor packages (`SummarizedExperiment`, -`GenomicRanges`, `S4Vectors`, `GenomeInfoDb`). The optional `brms` backend -additionally needs `brms` + a working Stan toolchain. +`GenomicRanges`, `S4Vectors`). The optional `brms` backend additionally +needs `brms` plus a working Stan toolchain. ## Example -BREAD ships a small packaged dataset so you can run the whole pipeline out of -the box: 8 EPICv2 arrays from a fibroblast passage-aging × vitamin C -experiment, plus 500 predefined regions spanning five feature classes -(PMD, PRC-CGI, bivalent, ...). +BREAD ships a small packaged dataset so you can run the whole pipeline +out of the box: 8 EPICv2 arrays from a fibroblast passage-aging × +vitamin C experiment, plus 500 predefined regions spanning five feature +classes (PMD, PRC-CGI, bivalent, …). ``` r library(BREAD) +suppressPackageStartupMessages(library(SummarizedExperiment)) se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) @@ -63,33 +73,62 @@ fit <- fit_bread( ) fit # summary: n regions, backend, classification counts +#> +#> mode : summary +#> backend : conjugate +#> input_scale: Beta +#> assay : betas +#> contrast : passagelate +#> delta : 0.1 +#> prob_cutoff: 0.95 +#> n_regions : 500 (of 500 input) +#> classifications: +#> hypermethylated 76 +#> hypomethylated 39 +#> inconclusive 385 +``` + +``` r res <- results(fit) # one row per region table(res$classification) -#> hypermethylated hypomethylated inconclusive +#> +#> hypermethylated hypomethylated inconclusive #> 76 39 385 ``` That is the whole pattern: a `SummarizedExperiment` of array data, a `GRanges` of regions to test, and a model formula referencing columns of -`colData(se)`. `fit_bread()` auto-detects the assay and whether values are -on the beta or M scale, so the three arguments above are usually all you -need. `feature_class_col` is optional — supply it when your regions carry a -grouping column you want summarized. +`colData(se)`. `fit_bread()` auto-detects the assay and whether values +are on the beta or M scale, so the three arguments above are usually all +you need. `feature_class_col` is optional — supply it when your regions +carry a grouping column you want summarized. ### Reading the results `results(fit)` returns one row per region: -| column | meaning | -|---|---| -| `region_id` | region identifier | -| `n` | number of probes summarized in the region | -| `mean_effect` | posterior mean methylation change (M-scale) | -| `ci_lo`, `ci_hi` | 95% credible interval | -| `p_gt_delta` | P(effect > +delta) — evidence for hypermethylation | -| `p_lt_neg_delta` | P(effect < -delta) — evidence for hypomethylation | +| column | meaning | +|------------------|-------------------------------------------------------| +| `region_id` | region identifier | +| `n` | number of probes summarized in the region | +| `mean_effect` | posterior mean methylation change (M-scale) | +| `ci_lo`, `ci_hi` | 95% credible interval | +| `p_gt_delta` | P(effect \> +delta) — evidence for hypermethylation | +| `p_lt_neg_delta` | P(effect \< -delta) — evidence for hypomethylation | | `classification` | `hypermethylated` / `hypomethylated` / `inconclusive` | +``` r +head(res[, c("region_id", "n", "mean_effect", "ci_lo", "ci_hi", + "classification")]) +#> region_id n mean_effect ci_lo ci_hi classification +#> 1 PRC_CGI_025 4 0.1031847688 -0.07029387 0.2766634 inconclusive +#> 2 Active_promoter_080 4 0.3106513471 0.15979964 0.4615031 hypermethylated +#> 3 PMD_soloWCGW_066 4 -0.2168276139 -0.64352511 0.2098699 inconclusive +#> 4 PRC_CGI_039 4 -0.0003147594 -0.40264440 0.4020149 inconclusive +#> 5 PMD_soloWCGW_030 4 0.2989332658 0.09707228 0.5007942 hypermethylated +#> 6 Bivalent_090 4 0.0603224027 -0.31407739 0.4347222 inconclusive +``` + A region is called **hypermethylated** if `p_gt_delta >= prob_cutoff`, **hypomethylated** if `p_lt_neg_delta >= prob_cutoff`, otherwise **inconclusive**. Defaults are `delta = 0.10` (M-scale) and @@ -102,20 +141,21 @@ A region is called **hypermethylated** if `p_gt_delta >= prob_cutoff`, - `backend = "conjugate"` (default) — analytic Normal-Inverse-Gamma posterior, no MCMC. Hundreds of regions fit in well under a second. -- `backend = "brms"` — full MCMC via Stan; compiles once, then reuses the - compiled model across regions. Use when you need the flexibility of a - full Bayesian fit. +- `backend = "brms"` — full MCMC via Stan; compiles once, then reuses + the compiled model across regions. Use when you need the flexibility + of a full Bayesian fit. ### KnowYourCG enrichment -`bread_kycg()` takes the probes in your hyper- or hypo-classified regions -and runs `knowYourCG::testEnrichment()` against curated CpG databases, so -you can ask what genomic features your called regions are enriched for. +`bread_kycg()` takes the probes in your hyper- or hypo-classified +regions and runs `knowYourCG::testEnrichment()` against curated CpG +databases, so you can ask what genomic features your called regions are +enriched for. ## Vignettes -Two worked examples on real data (rendered on the -[documentation site](https://baczemin.github.io/BREAD/)): +Two worked examples on real data (rendered on the [documentation +site](https://baczemin.github.io/BREAD/)): - **Getting started** (`bread-intro`) — TCGA HM450 matched normal/tumour pairs over chromHMM chromatin-state regions, end-to-end through @@ -126,11 +166,33 @@ Two worked examples on real data (rendered on the ## Status -Milestone 1 (MVP) is complete: the full `fit_bread()` pipeline, conjugate -and brms backends, S4 classes with accessors, plotting helpers, KYCG -integration, two real-data vignettes, and a live pkgdown site. Partial -pooling across regions, feature-class priors, random-effects designs, and -contrast vectors are on the roadmap. See `NEWS.md` for the changelog. +Milestone 1 (MVP) is complete: the full `fit_bread()` pipeline, +conjugate and brms backends, S4 classes with accessors, plotting +helpers, KYCG integration, two real-data vignettes, and a live pkgdown +site. Partial pooling across regions, feature-class priors, +random-effects designs, and contrast vectors are on the roadmap. See +`NEWS.md` for the changelog. + +## Citation + +``` r +citation("BREAD") +To cite BREAD in publications, please use: + + Park J (2026). BREAD: Bayesian Region-specific DNA Methylation + Inference. R package version 0.99.0. + https://github.com/BacZemin/BREAD + +A BibTeX entry for LaTeX users is + + @Manual{, + title = {{BREAD}: Bayesian Region-specific DNA Methylation Inference}, + author = {Jaemin Park}, + year = {2026}, + note = {R package version 0.99.0}, + url = {https://github.com/BacZemin/BREAD}, + } +``` ## License diff --git a/_pkgdown.yml b/_pkgdown.yml index cfe2663..537b73c 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -40,8 +40,8 @@ navbar: reference: - title: "Fit a BREAD model" desc: > - The main entry point and the two backend fit helpers. Most users only - call `fit_bread()`; backend-specific functions are exposed for power users. + The main entry point, plus the prior constructor. `fit_bread()` selects + and drives the backend; the backend fit helpers themselves are internal. contents: - fit_bread - bread_prior @@ -83,6 +83,4 @@ articles: - bread-vitc news: - releases: - - text: "Development (0.0.0.9000)" - href: news/index.html + cran_dates: false diff --git a/inst/CITATION b/inst/CITATION new file mode 100644 index 0000000..65bd435 --- /dev/null +++ b/inst/CITATION @@ -0,0 +1,24 @@ +citHeader("To cite BREAD in publications, please use:") + +## `meta` is the parsed DESCRIPTION when R loads this file via citation(); +## fall back to the installed version if it is unavailable. +ver <- if (!is.null(meta$Version)) { + meta$Version +} else { + as.character(utils::packageVersion("BREAD")) +} + +bibentry( + bibtype = "Manual", + title = "{BREAD}: Bayesian Region-specific DNA Methylation Inference", + author = person("Jaemin", "Park"), + year = "2026", + note = sprintf("R package version %s", ver), + url = "https://github.com/BacZemin/BREAD", + textVersion = sprintf( + paste0("Park J (2026). BREAD: Bayesian Region-specific DNA Methylation ", + "Inference. R package version %s. ", + "https://github.com/BacZemin/BREAD"), + ver + ) +) From 10c1853454b0f8713fbd47befd042e25f62b0efd Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 02:00:23 -0400 Subject: [PATCH 05/17] Restore GenomeInfoDb dependency; report seqlevels on no-overlap Dropping GenomeInfoDb from Imports broke vignette building on both CI workflows: on Bioconductor devel the Seqinfo class has been split into its own package but is still registered as belonging to GenomeInfoDb, so findOverlaps() -> merge(seqinfo) -> methods::is() calls .requirePackage("GenomeInfoDb") and fails if it was never installed. R CMD check's "Namespace in Imports field not imported from" NOTE was about the namespace, not the dependency -- the dependency is real and indirect. It is now a genuine import: map_probes_to_features() already told users to check seqlevels() when nothing overlapped, so the error now reports them instead of just naming the function. The HPC preflight did not catch this because GenomeInfoDb is installed there as a transitive dependency of the current GenomicRanges. --- DESCRIPTION | 1 + NAMESPACE | 1 + R/mapping.R | 13 ++++++++++++- 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6129658..949eb03 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Suggests: tidybayes Config/testthat/edition: 3 Imports: + GenomeInfoDb, GenomicRanges, ggplot2, methods, diff --git a/NAMESPACE b/NAMESPACE index 5a52bc5..29e2bc6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,6 +19,7 @@ export(validate_bread_input) exportClasses(BreadFit) exportClasses(BreadResults) exportMethods(show) +importFrom(GenomeInfoDb,seqlevels) importFrom(GenomicRanges,findOverlaps) importFrom(S4Vectors,mcols) importFrom(S4Vectors,queryHits) diff --git a/R/mapping.R b/R/mapping.R index ff46d50..dfdcf2a 100644 --- a/R/mapping.R +++ b/R/mapping.R @@ -26,6 +26,7 @@ #' @importFrom methods is #' @importFrom SummarizedExperiment rowRanges #' @importFrom GenomicRanges findOverlaps +#' @importFrom GenomeInfoDb seqlevels #' @importFrom S4Vectors queryHits subjectHits mcols #' @examples #' suppressPackageStartupMessages(library(SummarizedExperiment)) @@ -75,10 +76,20 @@ map_probes_to_features <- function(se, features, min_probes = 3L) { region_ids <- paste0("region_", seq_along(features)) } + # findOverlaps() warns about non-overlapping seqlevels, which is not + # actionable on its own -- the error below reports them instead. hits <- suppressWarnings(GenomicRanges::findOverlaps(probes, features)) if (length(hits) == 0L) { + .fmt_seqlevels <- function(x) { + s <- GenomeInfoDb::seqlevels(x) + if (length(s) == 0L) return("") + paste(c(s[seq_len(min(5L, length(s)))], + if (length(s) > 5L) "..."), collapse = ", ") + } stop("No probes overlap any of the ", length(features), - " features. Check that `seqlevels()` and genome builds agree.", + " features. Check that `seqlevels()` and genome builds agree.\n", + " probe seqlevels : ", .fmt_seqlevels(probes), "\n", + " feature seqlevels: ", .fmt_seqlevels(features), call. = FALSE) } From 6a8fcc237b12bbc249fcf58133fd98148368598a Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 02:12:54 -0400 Subject: [PATCH 06/17] Fix CITATION for uninstalled-package validation; gate bioc-check BiocCheck on Bioc devel reported "Unable to read CITATION file". The file fell back to packageVersion("BREAD") when meta was NULL, but BiocCheck validates the CITATION against an uninstalled package, so that call errored. The fallback is now a literal. It passed on the HPC only because a stale BREAD 0.0.0.9000 happened to be installed there. Also: - DESCRIPTION Description expanded to three sentences (BiocCheck NOTE), covering the two backends and the knowYourCG hand-off. - bioc-check now fails on any BiocCheck ERROR or WARNING beyond the two that cannot be resolved in code (support-site registration; the case-insensitive name collision with CRAN's unrelated 'bread'). Previously the workflow reported findings but always went green. --- .github/workflows/bioc-check.yaml | 17 ++++++++++++++++- DESCRIPTION | 5 ++++- inst/CITATION | 23 ++++++++++------------- 3 files changed, 30 insertions(+), 15 deletions(-) diff --git a/.github/workflows/bioc-check.yaml b/.github/workflows/bioc-check.yaml index b018de9..ee40027 100644 --- a/.github/workflows/bioc-check.yaml +++ b/.github/workflows/bioc-check.yaml @@ -74,7 +74,22 @@ jobs: shell: Rscript {0} run: | tarball <- dir(".", pattern = "tar\\.gz$", full.names = TRUE)[1] - BiocCheck::BiocCheck(tarball, `new-package` = TRUE) + res <- BiocCheck::BiocCheck(tarball, `new-package` = TRUE) + n_err <- length(res$error) + n_warn <- length(res$warning) + cat(sprintf("\nBiocCheck: %d ERROR / %d WARNING / %d NOTE\n", + n_err, n_warn, length(res$note))) + # Two findings cannot be resolved in code: + # ERROR - maintainer not yet registered on the Bioconductor + # support site (a human account action) + # WARNING - the package name collides case-insensitively with the + # unrelated CRAN package 'bread'; resolving it means + # renaming BREAD, which is a maintainer decision. + # Anything beyond those two is a regression and fails the build. + if (n_err > 1L || n_warn > 1L) { + stop("BiocCheck regression: expected at most 1 ERROR / 1 WARNING, ", + "both known and documented in the PR.") + } - name: Upload check logs if: always() diff --git a/DESCRIPTION b/DESCRIPTION index 949eb03..fadaa0a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,7 +9,10 @@ Description: BREAD provides targeted Bayesian inference for predefined DNA computes posterior probabilities of directional methylation change, and classifies regions as hypermethylated, hypomethylated, or inconclusive at user-configurable effect-size and probability - thresholds. + thresholds. Both an analytic conjugate backend and a full MCMC + backend via 'brms' are provided, sharing the same posterior and + classification path. Results can be passed to 'knowYourCG' for + enrichment testing against curated CpG feature databases. License: MIT + file LICENSE Encoding: UTF-8 Depends: diff --git a/inst/CITATION b/inst/CITATION index 65bd435..f004b02 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -1,24 +1,21 @@ citHeader("To cite BREAD in publications, please use:") -## `meta` is the parsed DESCRIPTION when R loads this file via citation(); -## fall back to the installed version if it is unavailable. -ver <- if (!is.null(meta$Version)) { - meta$Version -} else { - as.character(utils::packageVersion("BREAD")) -} +## `meta` is the parsed DESCRIPTION when citation() loads this file. The +## literal fallback matters: BiocCheck validates this file with +## readCitationFile(meta = NULL) against an *uninstalled* package, so anything +## that reaches for packageVersion("BREAD") here fails. +ver <- if (!is.null(meta$Version)) meta$Version else "0.99.0" bibentry( bibtype = "Manual", title = "{BREAD}: Bayesian Region-specific DNA Methylation Inference", author = person("Jaemin", "Park"), year = "2026", - note = sprintf("R package version %s", ver), + note = paste("R package version", ver), url = "https://github.com/BacZemin/BREAD", - textVersion = sprintf( - paste0("Park J (2026). BREAD: Bayesian Region-specific DNA Methylation ", - "Inference. R package version %s. ", - "https://github.com/BacZemin/BREAD"), - ver + textVersion = paste0( + "Park J (2026). BREAD: Bayesian Region-specific DNA Methylation ", + "Inference. R package version ", ver, ". ", + "https://github.com/BacZemin/BREAD" ) ) From 0086011e34908b9c0c90be574086490c67d62d75 Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 02:27:07 -0400 Subject: [PATCH 07/17] Drop inst/CITATION until there is a DOI; add Date field BiocCheck on devel warns when a CITATION file has no doi argument, and Bioconductor's own guidance is to include one only once a preprint or publication exists. There is none yet, so the file goes; citation("BREAD") still works, generated from DESCRIPTION. Add it back with bibentry(doi = ...) once there is a preprint or a Zenodo DOI. DESCRIPTION gains a Date field so the generated citation carries a year instead of (????); the README renders citation() live and was showing the placeholder. --- DESCRIPTION | 1 + README.Rmd | 3 +++ README.md | 16 ++++++++++------ inst/CITATION | 21 --------------------- 4 files changed, 14 insertions(+), 27 deletions(-) delete mode 100644 inst/CITATION diff --git a/DESCRIPTION b/DESCRIPTION index fadaa0a..14d2fd3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,7 @@ Package: BREAD Title: Bayesian Region-specific DNA Methylation Inference Version: 0.99.0 +Date: 2026-08-09 Authors@R: person("Jaemin", "Park", , "jaemin.park@vai.org", role = c("aut", "cre")) Description: BREAD provides targeted Bayesian inference for predefined DNA diff --git a/README.Rmd b/README.Rmd index 39bab60..6f999e8 100644 --- a/README.Rmd +++ b/README.Rmd @@ -159,6 +159,9 @@ contrast vectors are on the roadmap. See `NEWS.md` for the changelog. ## Citation +BREAD does not have an associated publication yet. For now, cite the +package itself: + ```{r citation, comment = ""} citation("BREAD") ``` diff --git a/README.md b/README.md index 8d286b1..854e0a3 100644 --- a/README.md +++ b/README.md @@ -175,21 +175,25 @@ random-effects designs, and contrast vectors are on the roadmap. See ## Citation +BREAD does not have an associated publication yet. For now, cite the +package itself: + ``` r citation("BREAD") -To cite BREAD in publications, please use: +To cite package 'BREAD' in publications use: - Park J (2026). BREAD: Bayesian Region-specific DNA Methylation - Inference. R package version 0.99.0. - https://github.com/BacZemin/BREAD + Park J (2026). _BREAD: Bayesian Region-specific DNA Methylation + Inference_. R package version 0.99.0, + https://baczemin.github.io/BREAD, + . A BibTeX entry for LaTeX users is @Manual{, - title = {{BREAD}: Bayesian Region-specific DNA Methylation Inference}, + title = {BREAD: Bayesian Region-specific DNA Methylation Inference}, author = {Jaemin Park}, year = {2026}, - note = {R package version 0.99.0}, + note = {R package version 0.99.0, https://baczemin.github.io/BREAD}, url = {https://github.com/BacZemin/BREAD}, } ``` diff --git a/inst/CITATION b/inst/CITATION deleted file mode 100644 index f004b02..0000000 --- a/inst/CITATION +++ /dev/null @@ -1,21 +0,0 @@ -citHeader("To cite BREAD in publications, please use:") - -## `meta` is the parsed DESCRIPTION when citation() loads this file. The -## literal fallback matters: BiocCheck validates this file with -## readCitationFile(meta = NULL) against an *uninstalled* package, so anything -## that reaches for packageVersion("BREAD") here fails. -ver <- if (!is.null(meta$Version)) meta$Version else "0.99.0" - -bibentry( - bibtype = "Manual", - title = "{BREAD}: Bayesian Region-specific DNA Methylation Inference", - author = person("Jaemin", "Park"), - year = "2026", - note = paste("R package version", ver), - url = "https://github.com/BacZemin/BREAD", - textVersion = paste0( - "Park J (2026). BREAD: Bayesian Region-specific DNA Methylation ", - "Inference. R package version ", ver, ". ", - "https://github.com/BacZemin/BREAD" - ) -) From 6df980bcf63ca783ba58a9d90bbf62beaddeac0b Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 02:47:23 -0400 Subject: [PATCH 08/17] Skip the brms test on CI: runners install brms but not Eigen R-CMD-check failed on test-fit-brms.R with "Eigen not found". The existing skip_if_not_installed("brms") / ("rstan") guards all pass on GitHub runners -- both packages install fine -- but Stan then cannot compile a model because the RcppEigen headers are absent, so the test ran and errored. Installing a working Stan toolchain on every CI run costs about ten minutes and is flaky, so the test is skipped on CI instead. It still runs on the HPC, and on build systems that do not set CI, which is where the brms backend is actually exercised. --- tests/testthat/test-fit-brms.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-fit-brms.R b/tests/testthat/test-fit-brms.R index 53a2e7c..2eb920f 100644 --- a/tests/testthat/test-fit-brms.R +++ b/tests/testthat/test-fit-brms.R @@ -1,7 +1,14 @@ -# Slow: Stan compile + sampling. ~60s on HPC. Skipped on CRAN, on systems -# without brms, and when $_R_CHECK_FORCE_SUGGESTS_ is FALSE and brms missing. +# Slow: Stan compile + sampling. ~60s on HPC. Skipped on CRAN, on CI, and +# on systems without a working brms/rstan Stan toolchain. test_that("fit_bread(backend = 'brms') recovers injected signal", { skip_on_cran() + # skip_on_ci() is load-bearing and not redundant with the guards below: + # GitHub runners install brms and rstan happily but lack the headers Stan + # needs to compile a model (RcppEigen), so the test cleared every + # skip_if_not_installed() and then died with "Eigen not found". + # Installing a full Stan toolchain per CI run costs ~10 min and is flaky. + # The test still runs on the HPC and anywhere CI is unset. + skip_on_ci() skip_if_not_installed("brms") skip_if_not_installed("rstan") From e7b8c3c133dbd1e2c24e12624ecd6c8c0a306c18 Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 11:59:01 -0400 Subject: [PATCH 09/17] Rename posterior probability columns p_* -> prob_* p_gt_delta and p_lt_neg_delta read as p-values, which is exactly the inference they are not. Renamed to prob_hyper / prob_hypo, matching the classification factor levels, and p_pos / p_neg to prob_pos / prob_neg. These are posterior probabilities of the parameter given the data -- prob_hyper = P(effect > +delta), prob_hypo = P(effect < -delta) -- not tail probabilities of a statistic under a null. Clean break, no deprecation shim: 0.99.0 is unreleased. --- NEWS.md | 6 ++++++ R/classify.R | 14 ++++++------ R/posterior.R | 30 +++++++++++++------------- README.Rmd | 8 +++---- README.md | 8 +++---- man/classify_regions.Rd | 4 ++-- man/posterior_summary.Rd | 2 +- tests/testthat/test-classify.R | 4 ++-- tests/testthat/test-extdata-contract.R | 2 +- tests/testthat/test-fit-bread.R | 2 +- tests/testthat/test-fit-brms.R | 2 +- tests/testthat/test-fit-summary.R | 6 +++--- tests/testthat/test-posterior.R | 20 ++++++++--------- vignettes/bread-intro.Rmd | 6 +++--- 14 files changed, 60 insertions(+), 54 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0c0df81..fd062f6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -27,6 +27,12 @@ First release candidate, prepared for Bioconductor submission. longer need to reach into the object's `model` slot. * Every exported object now carries a runnable `@examples` block built on the packaged EPICv2 example data. +* Posterior probability columns in `results()` are named `prob_pos`, + `prob_neg`, `prob_hyper` and `prob_hypo` — deliberately not `p_*`, which + invites reading them as p-values. They are posterior probabilities of the + parameter given the data (`prob_hyper` = P(effect > +delta), + `prob_hypo` = P(effect < -delta)), not tail probabilities of a statistic + under a null hypothesis. ## Known scope diff --git a/R/classify.R b/R/classify.R index 9c22187..0fd152d 100644 --- a/R/classify.R +++ b/R/classify.R @@ -1,8 +1,8 @@ #' Classify regions as hyper / hypo / inconclusive #' #' Applies the BREAD decision rule to the output of [posterior_summary()]: -#' - `hypermethylated` if `p_gt_delta >= prob_cutoff` -#' - `hypomethylated` if `p_lt_neg_delta >= prob_cutoff` +#' - `hypermethylated` if `prob_hyper >= prob_cutoff` +#' - `hypomethylated` if `prob_hypo >= prob_cutoff` #' - `inconclusive` otherwise #' #' In the rare case that both probabilities exceed the cutoff (only possible @@ -40,7 +40,7 @@ classify_regions <- function(post, delta = 0.10, prob_cutoff = 0.95) { stop("`post` must be a data.frame from posterior_summary().", call. = FALSE) } - req <- c("p_gt_delta", "p_lt_neg_delta") + req <- c("prob_hyper", "prob_hypo") missing_cols <- setdiff(req, colnames(post)) if (length(missing_cols) > 0L) { stop("`post` missing required columns: ", @@ -52,8 +52,8 @@ classify_regions <- function(post, delta = 0.10, prob_cutoff = 0.95) { stop("`prob_cutoff` must be in (0, 1).", call. = FALSE) } - hyper <- !is.na(post$p_gt_delta) & post$p_gt_delta >= prob_cutoff - hypo <- !is.na(post$p_lt_neg_delta) & post$p_lt_neg_delta >= prob_cutoff + hyper <- !is.na(post$prob_hyper) & post$prob_hyper >= prob_cutoff + hypo <- !is.na(post$prob_hypo) & post$prob_hypo >= prob_cutoff cls <- rep("inconclusive", nrow(post)) cls[hyper] <- "hypermethylated" @@ -61,13 +61,13 @@ classify_regions <- function(post, delta = 0.10, prob_cutoff = 0.95) { both <- hyper & hypo if (any(both)) { - favor_hyper <- both & post$p_gt_delta >= post$p_lt_neg_delta + favor_hyper <- both & post$prob_hyper >= post$prob_hypo cls[favor_hyper] <- "hypermethylated" cls[both & !favor_hyper] <- "hypomethylated" } # NA rows (failed fits) stay inconclusive - cls[is.na(post$p_gt_delta) | is.na(post$p_lt_neg_delta)] <- "inconclusive" + cls[is.na(post$prob_hyper) | is.na(post$prob_hypo)] <- "inconclusive" post$classification <- factor( cls, diff --git a/R/posterior.R b/R/posterior.R index cd98705..3adc144 100644 --- a/R/posterior.R +++ b/R/posterior.R @@ -22,7 +22,7 @@ #' #' @return A `data.frame` with one row per region and columns: #' `region_id`, `n`, `mean_effect`, `median_effect`, `ci_lo`, `ci_hi`, -#' `df`, `scale`, `p_pos`, `p_neg`, `p_gt_delta`, `p_lt_neg_delta`, `error`. +#' `df`, `scale`, `prob_pos`, `prob_neg`, `prob_hyper`, `prob_hypo`, `error`. #' `df` is `NA_real_` for the empirical path. #' #' @importFrom stats pt qt median quantile sd @@ -71,8 +71,8 @@ posterior_summary <- function(fit, delta = 0.10, ci = 0.95) { mean_effect = NA_real_, median_effect = NA_real_, ci_lo = NA_real_, ci_hi = NA_real_, df = NA_real_, scale = NA_real_, - p_pos = NA_real_, p_neg = NA_real_, - p_gt_delta = NA_real_, p_lt_neg_delta = NA_real_, + prob_pos = NA_real_, prob_neg = NA_real_, + prob_hyper = NA_real_, prob_hypo = NA_real_, error = if (is.null(f$error)) NA_character_ else f$error, stringsAsFactors = FALSE ) @@ -91,10 +91,10 @@ posterior_summary <- function(fit, delta = 0.10, ci = 0.95) { ci_hi = q[2L], df = NA_real_, scale = stats::sd(d), - p_pos = mean(d > 0), - p_neg = mean(d < 0), - p_gt_delta = mean(d > delta), - p_lt_neg_delta = mean(d < -delta), + prob_pos = mean(d > 0), + prob_neg = mean(d < 0), + prob_hyper = mean(d > delta), + prob_hypo = mean(d < -delta), error = NA_character_, stringsAsFactors = FALSE )) @@ -109,10 +109,10 @@ posterior_summary <- function(fit, delta = 0.10, ci = 0.95) { q_lo <- mu + s * stats::qt(alpha, df = nu) q_hi <- mu + s * stats::qt(1 - alpha, df = nu) - p_pos <- 1 - stats::pt((0 - mu) / s, df = nu) - p_neg <- stats::pt((0 - mu) / s, df = nu) - p_gt_d <- 1 - stats::pt(( delta - mu) / s, df = nu) - p_lt_d <- stats::pt((-delta - mu) / s, df = nu) + prob_pos <- 1 - stats::pt((0 - mu) / s, df = nu) + prob_neg <- stats::pt((0 - mu) / s, df = nu) + prob_hyper <- 1 - stats::pt(( delta - mu) / s, df = nu) + prob_hypo <- stats::pt((-delta - mu) / s, df = nu) data.frame( region_id = rid, @@ -123,10 +123,10 @@ posterior_summary <- function(fit, delta = 0.10, ci = 0.95) { ci_hi = q_hi, df = nu, scale = s, - p_pos = p_pos, - p_neg = p_neg, - p_gt_delta = p_gt_d, - p_lt_neg_delta = p_lt_d, + prob_pos = prob_pos, + prob_neg = prob_neg, + prob_hyper = prob_hyper, + prob_hypo = prob_hypo, error = NA_character_, stringsAsFactors = FALSE ) diff --git a/README.Rmd b/README.Rmd index 6f999e8..284bd72 100644 --- a/README.Rmd +++ b/README.Rmd @@ -106,8 +106,8 @@ grouping column you want summarized. | `n` | number of probes summarized in the region | | `mean_effect` | posterior mean methylation change (M-scale) | | `ci_lo`, `ci_hi` | 95% credible interval | -| `p_gt_delta` | P(effect > +delta) — evidence for hypermethylation | -| `p_lt_neg_delta` | P(effect < -delta) — evidence for hypomethylation | +| `prob_hyper` | P(effect > +delta) — evidence for hypermethylation | +| `prob_hypo` | P(effect < -delta) — evidence for hypomethylation | | `classification` | `hypermethylated` / `hypomethylated` / `inconclusive` | ```{r results-head} @@ -115,8 +115,8 @@ head(res[, c("region_id", "n", "mean_effect", "ci_lo", "ci_hi", "classification")]) ``` -A region is called **hypermethylated** if `p_gt_delta >= prob_cutoff`, -**hypomethylated** if `p_lt_neg_delta >= prob_cutoff`, otherwise +A region is called **hypermethylated** if `prob_hyper >= prob_cutoff`, +**hypomethylated** if `prob_hypo >= prob_cutoff`, otherwise **inconclusive**. Defaults are `delta = 0.10` (M-scale) and `prob_cutoff = 0.95`; both are arguments to `fit_bread()`. diff --git a/README.md b/README.md index 854e0a3..b68b9ee 100644 --- a/README.md +++ b/README.md @@ -113,8 +113,8 @@ carry a grouping column you want summarized. | `n` | number of probes summarized in the region | | `mean_effect` | posterior mean methylation change (M-scale) | | `ci_lo`, `ci_hi` | 95% credible interval | -| `p_gt_delta` | P(effect \> +delta) — evidence for hypermethylation | -| `p_lt_neg_delta` | P(effect \< -delta) — evidence for hypomethylation | +| `prob_hyper` | P(effect \> +delta) — evidence for hypermethylation | +| `prob_hypo` | P(effect \< -delta) — evidence for hypomethylation | | `classification` | `hypermethylated` / `hypomethylated` / `inconclusive` | ``` r @@ -129,8 +129,8 @@ head(res[, c("region_id", "n", "mean_effect", "ci_lo", "ci_hi", #> 6 Bivalent_090 4 0.0603224027 -0.31407739 0.4347222 inconclusive ``` -A region is called **hypermethylated** if `p_gt_delta >= prob_cutoff`, -**hypomethylated** if `p_lt_neg_delta >= prob_cutoff`, otherwise +A region is called **hypermethylated** if `prob_hyper >= prob_cutoff`, +**hypomethylated** if `prob_hypo >= prob_cutoff`, otherwise **inconclusive**. Defaults are `delta = 0.10` (M-scale) and `prob_cutoff = 0.95`; both are arguments to `fit_bread()`. diff --git a/man/classify_regions.Rd b/man/classify_regions.Rd index a2706e7..518363c 100644 --- a/man/classify_regions.Rd +++ b/man/classify_regions.Rd @@ -23,8 +23,8 @@ The input \code{data.frame} with an added \code{classification} factor column \description{ Applies the BREAD decision rule to the output of \code{\link[=posterior_summary]{posterior_summary()}}: \itemize{ -\item \code{hypermethylated} if \code{p_gt_delta >= prob_cutoff} -\item \code{hypomethylated} if \code{p_lt_neg_delta >= prob_cutoff} +\item \code{hypermethylated} if \code{prob_hyper >= prob_cutoff} +\item \code{hypomethylated} if \code{prob_hypo >= prob_cutoff} \item \code{inconclusive} otherwise } } diff --git a/man/posterior_summary.Rd b/man/posterior_summary.Rd index 6683683..1f73667 100644 --- a/man/posterior_summary.Rd +++ b/man/posterior_summary.Rd @@ -17,7 +17,7 @@ model list from \code{\link[=fit_bread_summary]{fit_bread_summary()}} / \code{\l \value{ A \code{data.frame} with one row per region and columns: \code{region_id}, \code{n}, \code{mean_effect}, \code{median_effect}, \code{ci_lo}, \code{ci_hi}, -\code{df}, \code{scale}, \code{p_pos}, \code{p_neg}, \code{p_gt_delta}, \code{p_lt_neg_delta}, \code{error}. +\code{df}, \code{scale}, \code{prob_pos}, \code{prob_neg}, \code{prob_hyper}, \code{prob_hypo}, \code{error}. \code{df} is \code{NA_real_} for the empirical path. } \description{ diff --git a/tests/testthat/test-classify.R b/tests/testthat/test-classify.R index 5b4b6bb..7707c23 100644 --- a/tests/testthat/test-classify.R +++ b/tests/testthat/test-classify.R @@ -8,8 +8,8 @@ n <- length(p_gt) data.frame( region_id = ids %|NULL|% sprintf("r%02d", seq_len(n)), - p_gt_delta = p_gt, - p_lt_neg_delta = p_lt, + prob_hyper = p_gt, + prob_hypo = p_lt, stringsAsFactors = FALSE ) } diff --git a/tests/testthat/test-extdata-contract.R b/tests/testthat/test-extdata-contract.R index 2ea6731..f74db98 100644 --- a/tests/testthat/test-extdata-contract.R +++ b/tests/testthat/test-extdata-contract.R @@ -76,5 +76,5 @@ test_that("the documented example fit runs end to end", { res <- results(fit) expect_gt(nrow(res), 0L) expect_true(all(c("region_id", "classification") %in% colnames(res))) - expect_true(any(!is.na(res$p_gt_delta))) + expect_true(any(!is.na(res$prob_hyper))) }) diff --git a/tests/testthat/test-fit-bread.R b/tests/testthat/test-fit-bread.R index e8015bf..c183758 100644 --- a/tests/testthat/test-fit-bread.R +++ b/tests/testthat/test-fit-bread.R @@ -48,7 +48,7 @@ test_that("results() and classifications() accessors return expected objects", { min_probes = 3L)) r <- results(fit) expect_s3_class(r, "data.frame") - expect_true(all(c("region_id","classification","p_gt_delta","p_lt_neg_delta") + expect_true(all(c("region_id","classification","prob_hyper","prob_hypo") %in% colnames(r))) cls <- classifications(fit) expect_type(cls, "character") diff --git a/tests/testthat/test-fit-brms.R b/tests/testthat/test-fit-brms.R index 2eb920f..3b50804 100644 --- a/tests/testthat/test-fit-brms.R +++ b/tests/testthat/test-fit-brms.R @@ -48,7 +48,7 @@ test_that("fit_bread(backend = 'brms') recovers injected signal", { res <- results(fit) expect_true(is.na(res$df[1L])) # df undefined for empirical path expect_true(all(!is.na(res$mean_effect))) - expect_true(all(res$p_pos + res$p_neg >= 0.999)) + expect_true(all(res$prob_pos + res$prob_neg >= 0.999)) # posterior_draws returns actual MCMC draws (subsampled to n) d <- posterior_draws(fit, region_id = "regA", n = 200L, seed = 1L) diff --git a/tests/testthat/test-fit-summary.R b/tests/testthat/test-fit-summary.R index 2f5ef22..14baea6 100644 --- a/tests/testthat/test-fit-summary.R +++ b/tests/testthat/test-fit-summary.R @@ -44,10 +44,10 @@ test_that("posterior_summary recovers sign and orders true effects", { expect_true(all(post$mean_effect[5:6] < -0.25)) expect_true(all(abs(post$mean_effect[1:2]) < 0.25)) # Probs in [0,1] - for (col in c("p_pos","p_neg","p_gt_delta","p_lt_neg_delta")) + for (col in c("prob_pos","prob_neg","prob_hyper","prob_hypo")) expect_true(all(post[[col]] >= 0 & post[[col]] <= 1)) - # p_pos + p_neg == 1 (within tolerance) - expect_equal(post$p_pos + post$p_neg, rep(1, nrow(post)), + # prob_pos + prob_neg == 1 (within tolerance) + expect_equal(post$prob_pos + post$prob_neg, rep(1, nrow(post)), tolerance = 1e-8) }) diff --git a/tests/testthat/test-posterior.R b/tests/testthat/test-posterior.R index 46b663b..73ba0dd 100644 --- a/tests/testthat/test-posterior.R +++ b/tests/testthat/test-posterior.R @@ -3,8 +3,8 @@ # BreadFit results table both depend on. POST_COLS <- c("region_id", "n", "mean_effect", "median_effect", - "ci_lo", "ci_hi", "df", "scale", "p_pos", "p_neg", - "p_gt_delta", "p_lt_neg_delta", "error") + "ci_lo", "ci_hi", "df", "scale", "prob_pos", "prob_neg", + "prob_hyper", "prob_hypo", "error") .toy_fit <- function() { fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group) @@ -33,12 +33,12 @@ test_that("a wider ci widens every interval but moves no point estimate", { test_that("directional probabilities are coherent", { post <- posterior_summary(.toy_fit()) - ok <- !is.na(post$p_pos) - expect_equal(post$p_pos[ok] + post$p_neg[ok], rep(1, sum(ok)), + ok <- !is.na(post$prob_pos) + expect_equal(post$prob_pos[ok] + post$prob_neg[ok], rep(1, sum(ok)), tolerance = 1e-8) - expect_true(all(post$p_gt_delta[ok] <= post$p_pos[ok] + 1e-8)) - expect_true(all(post$p_lt_neg_delta[ok] <= post$p_neg[ok] + 1e-8)) - for (col in c("p_pos", "p_neg", "p_gt_delta", "p_lt_neg_delta")) { + expect_true(all(post$prob_hyper[ok] <= post$prob_pos[ok] + 1e-8)) + expect_true(all(post$prob_hypo[ok] <= post$prob_neg[ok] + 1e-8)) + for (col in c("prob_pos", "prob_neg", "prob_hyper", "prob_hypo")) { expect_true(all(post[[col]][ok] >= 0 & post[[col]][ok] <= 1)) } }) @@ -47,9 +47,9 @@ test_that("a larger delta cannot increase the directional probabilities", { fit <- .toy_fit() small <- posterior_summary(fit, delta = 0.05) large <- posterior_summary(fit, delta = 0.50) - ok <- !is.na(small$p_gt_delta) - expect_true(all(large$p_gt_delta[ok] <= small$p_gt_delta[ok] + 1e-12)) - expect_true(all(large$p_lt_neg_delta[ok] <= small$p_lt_neg_delta[ok] + 1e-12)) + ok <- !is.na(small$prob_hyper) + expect_true(all(large$prob_hyper[ok] <= small$prob_hyper[ok] + 1e-12)) + expect_true(all(large$prob_hypo[ok] <= small$prob_hypo[ok] + 1e-12)) }) test_that("delta, ci and contrast are recorded as attributes", { diff --git a/vignettes/bread-intro.Rmd b/vignettes/bread-intro.Rmd index 5f6e002..ef00db0 100644 --- a/vignettes/bread-intro.Rmd +++ b/vignettes/bread-intro.Rmd @@ -144,9 +144,9 @@ you want to be stricter or looser. ```{r results} res <- results(fit) -head(res[order(res$p_gt_delta, decreasing = TRUE), +head(res[order(res$prob_hyper, decreasing = TRUE), c("region_id", "mean_effect", "ci_lo", "ci_hi", - "p_gt_delta", "p_lt_neg_delta", "classification")], 5) + "prob_hyper", "prob_hypo", "classification")], 5) ``` ```{r by-class} @@ -180,7 +180,7 @@ underlying values. The x-axis preserves the factor order we set on ```{r one-region, fig.width = 10, fig.height = 4} top_hyper <- res[res$classification == "hypermethylated", ] -top_hyper <- top_hyper[order(top_hyper$p_gt_delta, decreasing = TRUE), ] +top_hyper <- top_hyper[order(top_hyper$prob_hyper, decreasing = TRUE), ] rid <- top_hyper$region_id[1] p1 <- plot_region_posterior(fit, region_id = rid) + From fe7ae1088d29c9a98cc0c9fb00a0a1a0871cb8db Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 17:14:06 -0400 Subject: [PATCH 10/17] fix(mapping): count distinct region_ids, not ranges Several GRanges may share one name -- the only way to pin a region to an exact probe set, since a bounding interval sweeps in neighbours. split() handled this correctly all along but the counters did not: n_features_in counted ranges (length(features)) show() printed length(object@features) as n_regions which produced "n_regions: 788 (of 790 input)" for what was really 30 regions built from 790 probes. Results were always right; only the counters lied. Adds .make_toy_features_dup() (3 ranges, 2 regions) and pins the invariant n_features_out == nrow(results(fit)). --- R/mapping.R | 17 +++++++++---- R/methods.R | 8 +++--- man/map_probes_to_features.Rd | 11 +++++--- tests/testthat/helper-toy.R | 18 +++++++++++++ tests/testthat/test-mapping.R | 48 +++++++++++++++++++++++++++++++++++ 5 files changed, 91 insertions(+), 11 deletions(-) diff --git a/R/mapping.R b/R/mapping.R index dfdcf2a..76833e0 100644 --- a/R/mapping.R +++ b/R/mapping.R @@ -12,6 +12,11 @@ #' non-empty `rowRanges()`. #' @param features A [GenomicRanges::GRanges] of regions. If `names(features)` #' is `NULL` or empty, IDs `region_1, region_2, ...` are generated. +#' Several ranges may share one name: this is the only way to define a +#' region as an exact set of probes, since a single bounding interval would +#' sweep in neighbours. Such ranges are collapsed into one region, so +#' `length(features)` counts *ranges* while the region counts below count +#' distinct IDs. #' @param min_probes Integer. Regions with fewer overlapping probes are #' dropped. Default `3L`. #' @@ -20,8 +25,8 @@ #' `mcols(features)` columns. Attributes: #' - `dropped_regions` : character vector of region IDs excluded. #' - `min_probes` : the threshold applied. -#' - `n_features_in` : regions supplied. -#' - `n_features_out` : regions retained. +#' - `n_features_in` : distinct region IDs supplied (not ranges). +#' - `n_features_out` : distinct region IDs retained. #' #' @importFrom methods is #' @importFrom SummarizedExperiment rowRanges @@ -70,11 +75,13 @@ map_probes_to_features <- function(se, features, min_probes = 3L) { probe_ids <- paste0("probe_", seq_along(probes)) } - # Region IDs: GRanges names or generated + # Region IDs: GRanges names or generated. Several ranges may carry the same + # name, in which case they are one region -- count distinct IDs, not ranges. region_ids <- names(features) if (is.null(region_ids) || any(region_ids == "") || anyNA(region_ids)) { region_ids <- paste0("region_", seq_along(features)) } + n_regions_in <- length(unique(region_ids)) # findOverlaps() warns about non-overlapping seqlevels, which is not # actionable on its own -- the error below reports them instead. @@ -120,13 +127,13 @@ map_probes_to_features <- function(se, features, min_probes = 3L) { rownames(mapping) <- NULL if (length(dropped) > 0L) { - message("Dropped ", length(dropped), " of ", length(features), + message("Dropped ", length(dropped), " of ", n_regions_in, " regions with < ", min_probes, " probes.") } attr(mapping, "dropped_regions") <- dropped attr(mapping, "min_probes") <- min_probes - attr(mapping, "n_features_in") <- length(features) + attr(mapping, "n_features_in") <- n_regions_in attr(mapping, "n_features_out") <- length(unique(mapping$region_id)) mapping } diff --git a/R/methods.R b/R/methods.R index dbb1805..527d9b4 100644 --- a/R/methods.R +++ b/R/methods.R @@ -157,11 +157,13 @@ setMethod("show", "BreadFit", function(object) { "\n") cat(" delta :", object@params$delta, "\n") cat(" prob_cutoff:", object@params$prob_cutoff, "\n") + # Count distinct regions, not ranges: `features` may hold many ranges per + # region_id, which previously printed as e.g. "788 (of 790 input)" for what + # was really 30 regions built from 790 probes. cat(" n_regions :", - if (length(object@features) > 0L) length(object@features) else 0L, + object@diagnostics$n_features_out %||% 0L, "(of ", - if (!is.null(object@diagnostics$n_features_in)) - object@diagnostics$n_features_in else NA, + object@diagnostics$n_features_in %||% NA, " input)\n") res <- object@results if (!is.null(res) && "classification" %in% colnames(res)) { diff --git a/man/map_probes_to_features.Rd b/man/map_probes_to_features.Rd index 4fd6127..7a6e44e 100644 --- a/man/map_probes_to_features.Rd +++ b/man/map_probes_to_features.Rd @@ -11,7 +11,12 @@ map_probes_to_features(se, features, min_probes = 3L) non-empty \code{rowRanges()}.} \item{features}{A \link[GenomicRanges:GRanges-class]{GenomicRanges::GRanges} of regions. If \code{names(features)} -is \code{NULL} or empty, IDs \verb{region_1, region_2, ...} are generated.} +is \code{NULL} or empty, IDs \verb{region_1, region_2, ...} are generated. +Several ranges may share one name: this is the only way to define a +region as an exact set of probes, since a single bounding interval would +sweep in neighbours. Such ranges are collapsed into one region, so +\code{length(features)} counts \emph{ranges} while the region counts below count +distinct IDs.} \item{min_probes}{Integer. Regions with fewer overlapping probes are dropped. Default \code{3L}.} @@ -23,8 +28,8 @@ A \code{data.frame} with (at minimum) columns \itemize{ \item \code{dropped_regions} : character vector of region IDs excluded. \item \code{min_probes} : the threshold applied. -\item \code{n_features_in} : regions supplied. -\item \code{n_features_out} : regions retained. +\item \code{n_features_in} : distinct region IDs supplied (not ranges). +\item \code{n_features_out} : distinct region IDs retained. } } \description{ diff --git a/tests/testthat/helper-toy.R b/tests/testthat/helper-toy.R index 6dd70b8..a18d0f4 100644 --- a/tests/testthat/helper-toy.R +++ b/tests/testthat/helper-toy.R @@ -41,6 +41,24 @@ gr } +# Toy features where ONE region is defined by several disjoint ranges sharing +# a name -- the only way to pin a region to an exact probe set, since a single +# bounding interval would sweep in the probes between them. +# regD = probes 1-3 (1..2500) + probes 8-10 (7001..9500) = 6 probes, 2 ranges. +# regE = probes 16-20, 1 range. So: 2 distinct regions from 3 ranges. +.make_toy_features_dup <- function() { + gr <- GenomicRanges::GRanges( + seqnames = "chr1", + ranges = IRanges::IRanges( + start = c( 1L, 7001L, 15001L), + end = c( 2500L, 9500L, 20000L) + ), + feature_class = c("PRC", "PRC", "LAD") + ) + names(gr) <- c("regD", "regD", "regE") + gr +} + # Toy SE with injected signal: regA becomes hyper, regC becomes hypo, # in "old" vs "young" under ~ group. Sample size large enough for # prob_cutoff = 0.95 classification to recover truth. diff --git a/tests/testthat/test-mapping.R b/tests/testthat/test-mapping.R index 34fc847..26f1a69 100644 --- a/tests/testthat/test-mapping.R +++ b/tests/testthat/test-mapping.R @@ -52,3 +52,51 @@ test_that("mapping rejects non-positive min_probes", { expect_error(map_probes_to_features(se, gr, min_probes = 0L), "positive integer") }) + +test_that("several ranges sharing a region_id collapse into one region", { + se <- .make_toy_se(); gr <- .make_toy_features_dup() + expect_length(gr, 3L) # three ranges ... + expect_length(unique(names(gr)), 2L) # ... but two regions + + m <- suppressMessages(map_probes_to_features(se, gr, min_probes = 3L)) + + expect_setequal(unique(m$region_id), c("regD", "regE")) + # regD spans probes 1-3 and 8-10 across two disjoint ranges + expect_equal(sum(m$region_id == "regD"), 6L) + expect_true(all(m$n_probes[m$region_id == "regD"] == 6L)) + + # Counts are of distinct region IDs, never of ranges. This is the + # regression: n_features_in used to report 3 here. + expect_equal(attr(m, "n_features_in"), 2L) + expect_equal(attr(m, "n_features_out"), 2L) +}) + +test_that("dropped_regions is deduplicated and the message counts regions", { + se <- .make_toy_se() + gr <- .make_toy_features_dup() + # Raise the bar so regD (6 probes across 2 ranges) survives but regE (5) does not + expect_message( + m <- map_probes_to_features(se, gr, min_probes = 6L), + "Dropped 1 of 2 regions" + ) + expect_equal(attr(m, "dropped_regions"), "regE") + + # And when the multi-range region itself is dropped, it appears once + m2 <- suppressMessages(map_probes_to_features(se, gr, min_probes = 20L)) + expect_equal(sort(attr(m2, "dropped_regions")), c("regD", "regE")) +}) + +test_that("fit diagnostics count regions, not ranges", { + se <- .make_toy_se(); gr <- .make_toy_features_dup() + fit <- suppressMessages(fit_bread(se, gr, ~ group, min_probes = 3L)) + + # The invariant that would have caught "n_regions: 788 (of 790 input)" + expect_equal(fit@diagnostics$n_features_out, nrow(results(fit))) + expect_equal(fit@diagnostics$n_features_in, 2L) + + # Documented property: the features slot keeps every range of a surviving + # region, so it is longer than the results table when IDs repeat. + expect_gt(length(fit@features), nrow(results(fit))) + + expect_output(show(fit), "n_regions : 2 \\(of 2 input\\)") +}) From 26428809e6eeab31c3f7334c4315c078ff8df4ca Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 18:04:35 -0400 Subject: [PATCH 11/17] feat: four-level classification, sesame-native input, refit_bread() The headline is a fourth classification level. `inconclusive` was absorbing two different situations: a region whose posterior sits tightly inside the ROPE (strong evidence of no change) and one whose posterior says nothing at all. Collapsing them throws away the single claim a p-value structurally cannot make. The mousearray_609G CArG result is the case in point -- REGULON_promoter carries P(|effect| < delta) = 0.958 and was labelled `inconclusive`, indistinguishable from noise. classification levels are now hypermethylated / hypomethylated / unchanged / inconclusive. `unchanged` is inserted third so levels()[1:2] stay the directional pair. Membership of the two directional classes is bit-identical for any prob_cutoff > 0.5 -- the new level strictly partitions the old `inconclusive` bucket -- so directional filters are unaffected. posterior_summary() gains six columns: prob_rope plus a beta-scale translation (ref_beta, mean_dbeta, dbeta_lo, dbeta_hi, delta_beta). The translation uses one linearisation multiplier per region, anchored at the region's own mean methylation, so the beta comparison can never contradict the M-scale classification printed beside it. delta stays M-scale only: a beta-defined threshold is necessarily per-region and would silently become a 20-fold wider ROPE at the methylation extremes. bread_delta_beta() and bread_delta_m() convert explicitly instead. Also: * rope_cutoff, separate from prob_cutoff but defaulting to it. Equivalence needs the whole posterior inside +/-delta, a far stricter demand than a directional call; at n = 6+6 a shared knob ships the feature unusable. * ci is now a fit_bread() argument. It was hardcoded at 0.95, distinct from prob_cutoff but unreachable. * Matrix input. openSesame() returns a matrix and sesameData examples are list(betas=, sampleInfo=); BREAD rejected both, so the sesame workflow died at step one. New bread_se() / .as_bread_se() accept them with colData plus either rowRanges or platform. The platform is never inferred from probe IDs -- cg-numbers are shared across HM450/EPIC/MM285 and a wrong guess yields wrong coordinates with no error. EPICv2 suffix mismatches get a specific diagnosis. * refit_bread(). Permutation calibration needs the region matrix computed once and only the fit repeated; without a public entry point the only route was BREAD:::fit_bread_summary(). Re-thresholding short-circuits the model fit entirely. * Rank-deficient designs now warn. fit_summary adds Lambda0 = 0.01*I before the Cholesky, so collinear designs never errored -- they silently returned prior-driven estimates. Every caller so far hand-rolled its own qr() guard. * bread_kycg(): the default pattern required a literal . after TFBS, so it could not match KYCG.MM285.TFBSconsensus.20220116 and mouse users got a silently empty data.frame. Now a per-platform table, a warning that lists what is available, and mtc_by_group/mtc_method passthrough filtered against the installed signature. Also fixes an rbind error reachable today whenever one classification level yields a stub and another a real table. * The toy fixture had sex perfectly collinear with group, so every test using ~ group + sex was silently fitting a rank-deficient design. 412 tests pass, up from 284. --- DESCRIPTION | 1 + NAMESPACE | 7 + R/BREAD-package.R | 13 +- R/classes.R | 22 ++- R/classify.R | 98 +++++++++--- R/coerce.R | 239 ++++++++++++++++++++++++++++++ R/fit_bread.R | 67 +++++++-- R/kycg.R | 119 +++++++++++---- R/methods.R | 2 + R/posterior.R | 112 +++++++++++++- R/refit.R | 205 +++++++++++++++++++++++++ R/scale.R | 82 ++++++++++ R/utils.R | 11 +- R/validate.R | 63 ++++++-- man/BREAD-package.Rd | 13 +- man/BreadFit.Rd | 22 ++- man/bread_colors.Rd | 3 +- man/bread_kycg.Rd | 13 +- man/bread_scale.Rd | 63 ++++++++ man/bread_se.Rd | 76 ++++++++++ man/classify_regions.Rd | 53 +++++-- man/fit_bread.Rd | 42 +++++- man/posterior_summary.Rd | 41 ++++- man/refit_bread.Rd | 103 +++++++++++++ tests/testthat/helper-toy.R | 5 +- tests/testthat/test-classes.R | 15 ++ tests/testthat/test-classify.R | 146 +++++++++++++++--- tests/testthat/test-coerce.R | 187 +++++++++++++++++++++++ tests/testthat/test-fit-summary.R | 14 +- tests/testthat/test-kycg.R | 49 ++++++ tests/testthat/test-methods.R | 2 +- tests/testthat/test-plots.R | 3 +- tests/testthat/test-posterior.R | 122 ++++++++++++++- tests/testthat/test-refit.R | 121 +++++++++++++++ tests/testthat/test-utils.R | 5 +- 35 files changed, 1987 insertions(+), 152 deletions(-) create mode 100644 R/coerce.R create mode 100644 R/refit.R create mode 100644 R/scale.R create mode 100644 man/bread_scale.Rd create mode 100644 man/bread_se.Rd create mode 100644 man/refit_bread.Rd create mode 100644 tests/testthat/test-coerce.R create mode 100644 tests/testthat/test-refit.R diff --git a/DESCRIPTION b/DESCRIPTION index 14d2fd3..6bf1841 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,6 +43,7 @@ Imports: S4Vectors, stats, SummarizedExperiment, + utils, withr biocViews: DNAMethylation, Bayesian, Epigenetics, DifferentialMethylation, MethylationArray, Classification diff --git a/NAMESPACE b/NAMESPACE index 29e2bc6..f72ba85 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,8 +2,11 @@ export(BreadResults) export(bread_colors) +export(bread_delta_beta) +export(bread_delta_m) export(bread_kycg) export(bread_prior) +export(bread_se) export(classifications) export(classify_regions) export(fit_bread) @@ -13,6 +16,7 @@ export(plot_region_data) export(plot_region_posterior) export(posterior_draws) export(posterior_summary) +export(refit_bread) export(results) export(summarize_features) export(validate_bread_input) @@ -21,9 +25,11 @@ exportClasses(BreadResults) exportMethods(show) importFrom(GenomeInfoDb,seqlevels) importFrom(GenomicRanges,findOverlaps) +importFrom(S4Vectors,DataFrame) importFrom(S4Vectors,mcols) importFrom(S4Vectors,queryHits) importFrom(S4Vectors,subjectHits) +importFrom(SummarizedExperiment,SummarizedExperiment) importFrom(SummarizedExperiment,assay) importFrom(SummarizedExperiment,assayNames) importFrom(SummarizedExperiment,colData) @@ -43,4 +49,5 @@ importFrom(stats,quantile) importFrom(stats,rt) importFrom(stats,sd) importFrom(stats,var) +importFrom(utils,packageVersion) importFrom(withr,with_seed) diff --git a/R/BREAD-package.R b/R/BREAD-package.R index 21ef42a..ab91473 100644 --- a/R/BREAD-package.R +++ b/R/BREAD-package.R @@ -1,11 +1,14 @@ #' BREAD: Bayesian Region-specific DNA Methylation Inference #' #' Targeted Bayesian inference for predefined DNA methylation regions on array -#' data in [SummarizedExperiment::SummarizedExperiment] objects. For each -#' user-supplied region, BREAD fits a Bayesian model, computes posterior -#' probabilities of directional methylation change, and classifies regions as -#' hypermethylated, hypomethylated, or inconclusive at user-configurable -#' effect-size and probability thresholds. +#' data, supplied either as a [SummarizedExperiment::SummarizedExperiment] or +#' as a probe-by-sample matrix. For each user-supplied region, BREAD fits a +#' Bayesian model, computes posterior probabilities of directional methylation +#' change, and classifies regions as hypermethylated, hypomethylated, +#' unchanged, or inconclusive at user-configurable effect-size and probability +#' thresholds. The `unchanged` class reports regions whose posterior lies +#' inside the region of practical equivalence: positive evidence of no change, +#' as distinct from insufficient evidence either way. #' #' @keywords internal "_PACKAGE" diff --git a/R/classes.R b/R/classes.R index 7d696ca..67611cc 100644 --- a/R/classes.R +++ b/R/classes.R @@ -4,18 +4,28 @@ #' slots that downstream packages can depend on. #' #' @slot call The original `fit_bread()` call. -#' @slot params List of parameters used (delta, prob_cutoff, summary_fun, -#' mode, backend, contrast, min_probes, feature_class_col, iter, chains, -#' cores, seed). +#' @slot params List of parameters used (contrast, delta, prob_cutoff, +#' rope_cutoff, ci, ref_beta, summary_fun, backend, min_probes, +#' feature_class_col). #' @slot mode `"summary"` or `"hierarchical"`. #' @slot assay_name Assay name used from `se`. #' @slot input_scale `"M"` or `"Beta"`. #' @slot mapping Probe-to-region data frame from [map_probes_to_features()]. -#' @slot features `GRanges` of regions that survived `min_probes` filtering. -#' @slot model Internal fit object from [fit_bread_summary()]. +#' @slot features `GRanges` of the ranges belonging to regions that survived +#' `min_probes` filtering. When several ranges share a `region_id` this is +#' longer than `nrow(results(fit))`; `diagnostics$n_features_out` is the +#' region count. +#' @slot model Internal fit object from [fit_bread_summary()] or +#' [fit_bread_brms()]. Both backends return the same named list: +#' `fits`, `design_matrix`, `coef_names`, `contrast`, `contrast_idx`, +#' `region_ids`, `prior`, `region_mat`, `design`, `coldata`. This shape is +#' relied on by [refit_bread()], [posterior_summary()] and +#' [plot_region_data()]; treat it as part of the interface. #' @slot posterior Per-region posterior summary data frame. #' @slot results Per-region data frame with classification column. -#' @slot diagnostics List with backend, seed, feature counts, failure counts. +#' @slot diagnostics List with backend, feature counts, dropped regions, +#' failure counts, timestamp, and `refit_of` when produced by +#' [refit_bread()]. #' #' @name BreadFit #' @aliases BreadFit-class diff --git a/R/classify.R b/R/classify.R index 0fd152d..5d99096 100644 --- a/R/classify.R +++ b/R/classify.R @@ -1,23 +1,46 @@ -#' Classify regions as hyper / hypo / inconclusive +#' Classify regions as hyper / hypo / unchanged / inconclusive #' #' Applies the BREAD decision rule to the output of [posterior_summary()]: #' - `hypermethylated` if `prob_hyper >= prob_cutoff` #' - `hypomethylated` if `prob_hypo >= prob_cutoff` +#' - `unchanged` if `prob_rope >= rope_cutoff` #' - `inconclusive` otherwise #' -#' In the rare case that both probabilities exceed the cutoff (only possible -#' for very low `prob_cutoff`), the region is assigned to whichever side has -#' the larger posterior probability. +#' @section Why `unchanged` is a separate class: +#' `inconclusive` used to absorb two entirely different situations: a region +#' whose posterior sits tightly inside the region of practical equivalence +#' (strong evidence of *no* change) and a region whose posterior is so diffuse +#' that nothing can be said. Collapsing them discards the one claim a p-value +#' structurally cannot make — that a region is *demonstrably* unmoved at the +#' stated `delta`. `unchanged` means "practically unchanged at this `delta`", +#' not "identical"; `inconclusive` now means only what its name says. +#' +#' @section Mutual exclusivity: +#' `prob_hyper`, `prob_hypo` and `prob_rope` partition the posterior, so they +#' sum to 1. Two of them can therefore clear their thresholds simultaneously +#' only if the two thresholds sum to no more than 1 — impossible at any +#' sensible setting (0.95 + 0.95 > 1). Should you set thresholds that low, the +#' largest of the qualifying probabilities wins, with ties resolved +#' hyper > hypo > unchanged. #' #' @param post Output of [posterior_summary()]. #' @param delta Effect-size threshold used for the rule. Default `0.10`. Stored #' as an attribute; does not re-evaluate the posterior probabilities (those #' must have been computed at this same `delta` upstream). -#' @param prob_cutoff Posterior probability cutoff. Default `0.95`. +#' @param prob_cutoff Posterior probability cutoff for a *directional* call. +#' Default `0.95`. +#' @param rope_cutoff Posterior probability cutoff for an *equivalence* call. +#' Defaults to `prob_cutoff`. Worth setting independently: concluding +#' equivalence requires the posterior to fit entirely inside +#' \eqn{[-\delta, +\delta]}, a far stricter demand than a directional call, +#' and at small n almost nothing reaches 0.95. Loosening it should not +#' require loosening the discovery threshold too. #' #' @return The input `data.frame` with an added `classification` factor column -#' (levels: `hypermethylated`, `hypomethylated`, `inconclusive`). Attributes -#' `delta` and `prob_cutoff` are updated. +#' (levels: `hypermethylated`, `hypomethylated`, `unchanged`, +#' `inconclusive`). Attributes `delta`, `prob_cutoff` and `rope_cutoff` are +#' updated. If `post` has no `prob_rope` column it is derived as +#' `1 - prob_hyper - prob_hypo`. #' #' @examples #' suppressPackageStartupMessages(library(SummarizedExperiment)) @@ -34,8 +57,12 @@ #' #' # A stricter cutoff moves borderline regions into `inconclusive` #' table(classify_regions(post, prob_cutoff = 0.99)$classification) +#' +#' # Relax only the equivalence bar, leaving discovery untouched +#' table(classify_regions(post, rope_cutoff = 0.80)$classification) #' @export -classify_regions <- function(post, delta = 0.10, prob_cutoff = 0.95) { +classify_regions <- function(post, delta = 0.10, prob_cutoff = 0.95, + rope_cutoff = prob_cutoff) { if (!is.data.frame(post)) { stop("`post` must be a data.frame from posterior_summary().", call. = FALSE) @@ -47,33 +74,60 @@ classify_regions <- function(post, delta = 0.10, prob_cutoff = 0.95) { paste(shQuote(missing_cols), collapse = ", "), ". Run posterior_summary(fit) first.", call. = FALSE) } - if (!is.numeric(prob_cutoff) || length(prob_cutoff) != 1L || - prob_cutoff <= 0 || prob_cutoff >= 1) { - stop("`prob_cutoff` must be in (0, 1).", call. = FALSE) + .check_cutoff(prob_cutoff, "prob_cutoff") + .check_cutoff(rope_cutoff, "rope_cutoff") + + # Hand-built posterior tables are a legitimate input; derive the ROPE mass + # when it is absent. When present it is authoritative. + prob_rope <- post$prob_rope + if (is.null(prob_rope)) { + prob_rope <- pmin(pmax(1 - post$prob_hyper - post$prob_hypo, 0), 1) } hyper <- !is.na(post$prob_hyper) & post$prob_hyper >= prob_cutoff hypo <- !is.na(post$prob_hypo) & post$prob_hypo >= prob_cutoff + rope <- !is.na(prob_rope) & prob_rope >= rope_cutoff cls <- rep("inconclusive", nrow(post)) - cls[hyper] <- "hypermethylated" + cls[rope] <- "unchanged" cls[hypo] <- "hypomethylated" + cls[hyper] <- "hypermethylated" - both <- hyper & hypo - if (any(both)) { - favor_hyper <- both & post$prob_hyper >= post$prob_hypo - cls[favor_hyper] <- "hypermethylated" - cls[both & !favor_hyper] <- "hypomethylated" + # Only reachable when the two relevant cutoffs sum to <= 1; see @section. + multi <- (hyper + hypo + rope) > 1L + if (any(multi)) { + cand <- cbind( + ifelse(hyper[multi], post$prob_hyper[multi], -Inf), + ifelse(hypo[multi], post$prob_hypo[multi], -Inf), + ifelse(rope[multi], prob_rope[multi], -Inf) + ) + # which.max takes the first maximum, so exact ties resolve + # hyper > hypo > unchanged -- matching the pre-4-level tie-break. + winner <- apply(cand, 1L, which.max) + cls[multi] <- c("hypermethylated", "hypomethylated", "unchanged")[winner] } - # NA rows (failed fits) stay inconclusive + # NA rows (failed fits) are inconclusive, never unchanged: no posterior + # means no evidence of equivalence either. cls[is.na(post$prob_hyper) | is.na(post$prob_hypo)] <- "inconclusive" - post$classification <- factor( - cls, - levels = c("hypermethylated", "hypomethylated", "inconclusive") - ) + post$classification <- factor(cls, levels = .BREAD_LEVELS) attr(post, "delta") <- delta attr(post, "prob_cutoff") <- prob_cutoff + attr(post, "rope_cutoff") <- rope_cutoff post } + +# Classification levels, in display order. `unchanged` sits third so that +# levels()[1:2] remain the directional pair (bread_kycg()'s `which` default +# and any positional indexing rely on it) and `inconclusive` stays last as +# the residual bucket. +.BREAD_LEVELS <- c("hypermethylated", "hypomethylated", + "unchanged", "inconclusive") + +.check_cutoff <- function(x, nm) { + if (!is.numeric(x) || length(x) != 1L || is.na(x) || x <= 0 || x >= 1) { + stop("`", nm, "` must be in (0, 1).", call. = FALSE) + } + invisible(TRUE) +} diff --git a/R/coerce.R b/R/coerce.R new file mode 100644 index 0000000..de8bf70 --- /dev/null +++ b/R/coerce.R @@ -0,0 +1,239 @@ +#' Assemble a SummarizedExperiment for BREAD from a matrix +#' +#' BREAD models a `SummarizedExperiment` carrying row-level genomic +#' coordinates. Most methylation pipelines do not hand you one: `sesame`'s +#' `openSesame()` returns a plain beta matrix, and its packaged example data +#' are `list(betas = , sampleInfo = )`. This helper builds +#' the object BREAD needs, so a matrix workflow does not stall at the first +#' step. [fit_bread()] calls it for you; use it directly when you want to +#' coerce once and reuse the result. +#' +#' @section Where coordinates come from: +#' A bare matrix has no coordinates, so you must supply them one of two ways: +#' pass `rowRanges` (a [GenomicRanges::GRanges], ideally named by probe ID), +#' or pass `platform` to look the manifest up through `sesameData`. +#' +#' **The platform is never guessed.** `cg########` identifiers are shared +#' across HM450, EPIC and MM285, so inferring the array from probe names would +#' silently return the wrong coordinates for a substantial fraction of probes, +#' assign them to the wrong regions, and produce confident, wrong biology with +#' no error anywhere. One word from you removes that entire failure mode. +#' +#' @param x A `SummarizedExperiment` (returned unchanged), a probe-by-sample +#' `matrix`, or a `list` with a `betas` element and sample metadata under +#' `sampleInfo`, `meta` or `pd`. +#' @param colData Sample metadata: a `data.frame` or `DataFrame` with one row +#' per column of `x`. If it has rownames they are matched against +#' `colnames(x)` and reordered; otherwise rows are assumed to be in column +#' order and a warning is emitted. Required unless `design` has no variables. +#' @param rowRanges A [GenomicRanges::GRanges] of probe coordinates. If named, +#' it is subset and reordered to `rownames(x)`; unnamed, it must already be +#' in row order. +#' @param platform Array platform for the `sesameData` manifest lookup, e.g. +#' `"EPIC"`, `"EPICv2"`, `"HM450"`, `"MM285"`. Requires the `sesameData` +#' package. Ignored when `rowRanges` is supplied. +#' @param assay_name Name for the assay. Defaults to `"betas"` when the values +#' all fall in \[0, 1\] and `"M"` otherwise, matching what +#' [fit_bread()] auto-detects. +#' +#' @return A [SummarizedExperiment::SummarizedExperiment]. +#' +#' @importFrom methods is +#' @importFrom SummarizedExperiment SummarizedExperiment +#' @importFrom S4Vectors DataFrame +#' @seealso [fit_bread()] +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' # Take a packaged SE apart, then put it back together the matrix way +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' mat <- assay(se, "betas") +#' cd <- as.data.frame(colData(se)) +#' gr <- rowRanges(se) +#' +#' se2 <- bread_se(mat, colData = cd, rowRanges = gr) +#' se2 +#' @export +bread_se <- function(x, colData = NULL, rowRanges = NULL, platform = NULL, + assay_name = NULL) { + .as_bread_se(x, colData = colData, rowRanges = rowRanges, + platform = platform, assay_name = assay_name) +} + +# Internal workhorse. Kept separate so fit_bread() can distinguish "the user +# passed these" from "these are defaults", which drives the SE-plus-extras +# error below. +.as_bread_se <- function(x, colData = NULL, rowRanges = NULL, platform = NULL, + assay_name = NULL) { + + # --- already canonical ----------------------------------------------- + if (methods::is(x, "SummarizedExperiment")) { + extras <- c(colData = !is.null(colData), + rowRanges = !is.null(rowRanges), + platform = !is.null(platform)) + if (any(extras)) { + stop("`", paste(names(extras)[extras], collapse = "`, `"), + "` supplied alongside a SummarizedExperiment. These arguments ", + "describe matrix input only; edit the object itself instead.", + call. = FALSE) + } + return(x) + } + + # --- sesameData-style list ------------------------------------------- + if (is.list(x) && !is.data.frame(x) && "betas" %in% names(x)) { + meta_nm <- intersect(c("sampleInfo", "meta", "pd"), names(x)) + if (is.null(colData) && length(meta_nm) > 0L) colData <- x[[meta_nm[1L]]] + x <- x[["betas"]] + } + + # --- matrix ------------------------------------------------------------ + if (is.null(dim(x)) || length(dim(x)) != 2L || is.data.frame(x)) { + stop("`x` must be a SummarizedExperiment or a probe-by-sample matrix, ", + "not <", class(x)[1], ">.", call. = FALSE) + } + if (!is.matrix(x)) x <- as.matrix(x) + + if (is.null(rownames(x))) { + stop("`x` needs rownames giving probe IDs: they are what ties the ", + "matrix to genomic coordinates.", call. = FALSE) + } + if (is.null(colnames(x))) { + stop("`x` needs colnames giving sample IDs.", call. = FALSE) + } + + cd <- .align_coldata(colData, colnames(x)) + rr <- .resolve_rowranges(rownames(x), rowRanges, platform) + + # Drop probes without coordinates rather than failing the whole call + keep <- !is.na(rr$idx) + if (!all(keep)) { + message("Dropping ", sum(!keep), " of ", nrow(x), + " probes with no coordinates in the supplied manifest.") + x <- x[keep, , drop = FALSE] + rr$gr <- rr$gr[keep] + } + if (nrow(x) == 0L) { + stop("No probes in `x` have coordinates.", call. = FALSE) + } + + if (is.null(assay_name)) { + assay_name <- if (identical(.detect_input_scale(x), "Beta")) "betas" else "M" + } + assays <- list(x); names(assays) <- assay_name + + SummarizedExperiment::SummarizedExperiment( + assays = assays, + rowRanges = rr$gr, + colData = cd + ) +} + +# A data.frame always reports rownames, even when the user never set any -- +# base R substitutes "1", "2", ... and stores them as a compact integer +# attribute. Treating those as sample IDs would make every rownameless +# colData look like a total mismatch, so distinguish real labels from the +# automatic ones. +.explicit_rownames <- function(df) { + if (methods::is(df, "DataFrame")) return(rownames(df)) + rn <- attr(df, "row.names") + if (is.null(rn) || is.integer(rn)) return(NULL) + as.character(rn) +} + +# Match sample metadata to the matrix columns, reordering when it is safe to. +.align_coldata <- function(colData, sample_ids) { + n <- length(sample_ids) + if (is.null(colData)) { + # A design with no variables (~ 1) is legal; let validate_bread_input() + # be the one to complain if the design actually needs columns. + return(S4Vectors::DataFrame(row.names = sample_ids)) + } + if (!is.data.frame(colData) && !methods::is(colData, "DataFrame")) { + stop("`colData` must be a data.frame or DataFrame, not <", + class(colData)[1], ">.", call. = FALSE) + } + cd <- S4Vectors::DataFrame(as.data.frame(colData, stringsAsFactors = FALSE)) + + rn <- .explicit_rownames(colData) + if (!is.null(rn)) { + idx <- match(sample_ids, rn) + if (anyNA(idx)) { + miss <- sample_ids[is.na(idx)] + stop("`colData` has no row for ", sum(is.na(idx)), " sample(s) in ", + "`colnames(x)`: ", + paste(shQuote(miss[seq_len(min(5L, length(miss)))]), + collapse = ", "), + if (length(miss) > 5L) ", ..." else "", ".", call. = FALSE) + } + cd <- cd[idx, , drop = FALSE] + } else { + if (nrow(cd) != n) { + stop("`colData` has ", nrow(cd), " rows but `x` has ", n, + " columns.", call. = FALSE) + } + warning("`colData` has no rownames; assuming its rows are in the same ", + "order as `colnames(x)`.", call. = FALSE) + } + rownames(cd) <- sample_ids + cd +} + +# Return list(gr = , idx = ). +.resolve_rowranges <- function(probe_ids, rowRanges, platform) { + n <- length(probe_ids) + + if (!is.null(rowRanges)) { + if (!methods::is(rowRanges, "GRanges")) { + stop("`rowRanges` must be a GRanges, not <", class(rowRanges)[1], ">.", + call. = FALSE) + } + if (is.null(names(rowRanges))) { + if (length(rowRanges) != n) { + stop("Unnamed `rowRanges` has ", length(rowRanges), " ranges but ", + "`x` has ", n, " rows. Name it by probe ID, or supply one ", + "range per row in order.", call. = FALSE) + } + gr <- rowRanges + names(gr) <- probe_ids + return(list(gr = gr, idx = seq_len(n))) + } + idx <- match(probe_ids, names(rowRanges)) + if (all(is.na(idx))) { + # A very common cause on EPICv2: the manifest keeps the replicate + # suffix (cg00381604_BC11) while the analysis pipeline stripped it. + suffixed <- any(grepl("_[A-Z]{2}[0-9]{2}$", names(rowRanges))) + bare <- !any(grepl("_[A-Z]{2}[0-9]{2}$", probe_ids)) + stop("None of `rownames(x)` appear in `names(rowRanges)`. ", + "Are these the same platform?", + if (suffixed && bare) + paste0("\n The coordinates carry EPICv2 replicate suffixes ", + "(e.g. '", names(rowRanges)[1], "') but `x` does not ", + "(e.g. '", probe_ids[1], "'). Match them before ", + "calling BREAD.") + else "", + call. = FALSE) + } + gr <- rowRanges[ifelse(is.na(idx), 1L, idx)] + names(gr) <- probe_ids + return(list(gr = gr, idx = idx)) + } + + if (!is.null(platform)) { + if (!requireNamespace("sesameData", quietly = TRUE)) { + stop("`platform` lookup needs the 'sesameData' package. Install it, ", + "or pass `rowRanges` directly.", call. = FALSE) + } + man <- sesameData::sesameData_getManifestGRanges(platform) + return(.resolve_rowranges(probe_ids, man, NULL)) + } + + hint <- if (any(grepl("_[A-Z]{2}[0-9]{2}$", probe_ids))) { + " (the probe ID suffixes look like EPICv2)" + } else "" + stop("No probe coordinates. Supply `rowRanges` (a GRanges named by probe ", + "ID) or `platform` (looked up via sesameData)", hint, ". BREAD does ", + "not guess the platform from probe IDs: cg-numbers are shared across ", + "arrays and a wrong guess gives wrong coordinates silently.", + call. = FALSE) +} diff --git a/R/fit_bread.R b/R/fit_bread.R index ba0c5bd..5a07588 100644 --- a/R/fit_bread.R +++ b/R/fit_bread.R @@ -5,7 +5,8 @@ #' regions, BREAD maps probes to regions, summarizes them per sample, and #' fits Bayesian region-level models to produce posterior probabilities of #' directional methylation change under the contrast of interest. Regions -#' are classified as hypermethylated, hypomethylated, or inconclusive. +#' are classified as hypermethylated, hypomethylated, unchanged (posterior +#' concentrated inside the region of practical equivalence) or inconclusive. #' #' @section Minimal call: #' The typical call is: @@ -25,13 +26,32 @@ #' updates); MCMC controls `iter`, `chains`, `cores`, `seed` can be passed #' through `...` to `fit_bread_brms()`. #' -#' @param se A [SummarizedExperiment::SummarizedExperiment] with a methylation assay. -#' @param features A [GenomicRanges::GRanges] of user-defined regions. +#' @param x A [SummarizedExperiment::SummarizedExperiment] with a methylation +#' assay, or a probe-by-sample `matrix` (with `colData` and either +#' `rowRanges` or `platform`), or a `list(betas =, sampleInfo =)` as +#' returned by `sesameData`. See [bread_se()]. +#' @param features A [GenomicRanges::GRanges] of user-defined regions. Several +#' ranges may share a name to define one region as an exact probe set. #' @param design A one-sided formula giving the model design, e.g. `~ group + sex`. #' @param contrast Character coefficient name of interest. If `NULL` (default), #' the first non-intercept coefficient is used and a message is emitted. -#' @param delta Effect-size threshold on the M-value scale. Default `0.10`. -#' @param prob_cutoff Posterior probability cutoff for classification. Default `0.95`. +#' @param colData,rowRanges,platform Only for matrix input: sample metadata, +#' probe coordinates, and the array platform for a `sesameData` manifest +#' lookup. Passing any of them alongside a `SummarizedExperiment` is an +#' error. See [bread_se()]. +#' @param delta Effect-size threshold on the M-value scale. Default `0.10` +#' (a beta change of roughly 0.017 at mid-methylation, less toward the +#' extremes -- see [bread_delta_beta()]). +#' @param prob_cutoff Posterior probability cutoff for a directional +#' (hyper/hypo) call. Default `0.95`. +#' @param rope_cutoff Posterior probability cutoff for an `unchanged` +#' (equivalence) call. Defaults to `prob_cutoff`; see [classify_regions()] +#' for why it is worth setting independently. +#' @param ci Credible-interval mass reported in `ci_lo`/`ci_hi`. Default +#' `0.95`. Independent of `prob_cutoff`. +#' @param ref_beta Reference methylation level(s) anchoring the beta-scale +#' columns. `NULL` (default) uses each region's own mean. See +#' [posterior_summary()]. #' @param min_probes Minimum probes per region. Default `3`. #' @param feature_class_col Column in `mcols(features)` giving feature class #' (used by `plot_feature_set()`; reserved for class-level pooling in M3). @@ -70,10 +90,16 @@ #' head(results(fit)) #' table(results(fit)$classification) #' @export -fit_bread <- function(se, features, design, +fit_bread <- function(x, features, design, contrast = NULL, + colData = NULL, + rowRanges = NULL, + platform = NULL, delta = 0.10, prob_cutoff = 0.95, + rope_cutoff = prob_cutoff, + ci = 0.95, + ref_beta = NULL, min_probes = 3L, feature_class_col = NULL, summary_fun = c("mean", "median", "weighted_mean", "pc1"), @@ -85,10 +111,13 @@ fit_bread <- function(se, features, design, the_call <- match.call() summary_fun <- match.arg(summary_fun) backend <- match.arg(backend) + delta_default <- missing(delta) - if (!methods::is(se, "SummarizedExperiment")) - stop("`se` must be a SummarizedExperiment, not <", class(se)[1], ">.", - call. = FALSE) + # Accept a matrix (what openSesame() hands you) as readily as a + # SummarizedExperiment. Coerce at the boundary; everything downstream sees + # the canonical object. + se <- .as_bread_se(x, colData = colData, rowRanges = rowRanges, + platform = platform, assay_name = assay_name) # Auto-detect assay_name / input_scale if not given if (is.null(assay_name)) assay_name <- .detect_assay_name(se) @@ -96,6 +125,16 @@ fit_bread <- function(se, features, design, SummarizedExperiment::assay(se, assay_name) ) + # A user handing in beta values is thinking in beta, but `delta` is on the + # M scale. Say so once rather than letting them assume 0.10 means 10 points. + if (identical(input_scale, "Beta") && delta_default) { + message("`delta` = 0.10 is on the M-value scale, not beta: that is a ", + "beta change of about ", signif(bread_delta_beta(0.10), 2), + " at beta = 0.5, and less toward the extremes. ", + "Use `bread_delta_m()` to pick `delta` from a target beta ", + "change; `results()` reports a per-region `delta_beta`.") + } + # Validate with current (possibly NULL) contrast validate_bread_input(se, features, design, contrast = contrast, @@ -156,8 +195,11 @@ fit_bread <- function(se, features, design, ) ) - post <- posterior_summary(model, delta = delta, ci = 0.95) - results <- classify_regions(post, delta = delta, prob_cutoff = prob_cutoff) + post <- posterior_summary(model, delta = delta, ci = ci, + ref_beta = ref_beta) + results <- classify_regions(post, delta = delta, + prob_cutoff = prob_cutoff, + rope_cutoff = rope_cutoff) kept_idx <- sort(unique(mapping$region_idx)) features_kept <- features[kept_idx] @@ -179,6 +221,9 @@ fit_bread <- function(se, features, design, contrast = contrast, delta = delta, prob_cutoff = prob_cutoff, + rope_cutoff = rope_cutoff, + ci = ci, + ref_beta = ref_beta, summary_fun = summary_fun, backend = backend, min_probes = min_probes, diff --git a/R/kycg.R b/R/kycg.R index 558e4a4..bd8b226 100644 --- a/R/kycg.R +++ b/R/kycg.R @@ -50,7 +50,16 @@ #' head(enr[enr$FDR < 0.01, ]) #' } #' +#' @param mtc_by_group Correct for multiple testing within each knowledgebase +#' group rather than across all of them. Passed to +#' `knowYourCG::testEnrichment()` when the installed version supports it +#' (added after Bioconductor 3.20) and ignored with a message when it does +#' not. +#' @param mtc_method Multiple-testing correction method, as for +#' [stats::p.adjust()]. Same version caveat as `mtc_by_group`. +#' #' @importFrom methods is +#' @importFrom utils packageVersion #' @export bread_kycg <- function(fit, which = c("hypermethylated", "hypomethylated"), @@ -58,7 +67,9 @@ bread_kycg <- function(fit, platform = c("EPIC", "EPICv2", "HM450", "MM285"), universe = NULL, alternative = "greater", - include_genes = FALSE) { + include_genes = FALSE, + mtc_by_group = TRUE, + mtc_method = "fdr") { if (!methods::is(fit, "BreadFit")) stop("`fit` must be a BreadFit.", call. = FALSE) if (!requireNamespace("knowYourCG", quietly = TRUE)) @@ -88,49 +99,107 @@ bread_kycg <- function(fit, if (is.null(universe)) universe <- unique(as.character(mapping$probe_id)) - # Default DB selection by platform — TFBS + chromHMM + CGI + # Default DB selection by platform dbs <- databases if (is.null(dbs)) { - groups <- knowYourCG::listDBGroups() - want <- paste0("^KYCG\\.", platform, "\\.", - "(TFBS|ChromHMM|chromHMM|CGI)", "\\.") - dbs <- groups$Title[grepl(want, groups$Title)] + groups <- tryCatch(knowYourCG::listDBGroups(), + error = function(e) { + stop("knowYourCG::listDBGroups() failed (it reaches ", + "ExperimentHub): ", conditionMessage(e), + "\nPass `databases = ` to work offline.", + call. = FALSE) + }) + dbs <- .kycg_default_dbs(platform, groups$Title) if (length(dbs) == 0L) { - message("bread_kycg(): no default KYCG databases found for platform '", - platform, "'; pass `databases = ...` explicitly.") + avail <- grep(paste0("^KYCG\\.", platform, "\\."), groups$Title, + value = TRUE) + warning("bread_kycg(): no default KYCG groups matched platform '", + platform, "'. ", + if (length(avail)) + paste0("Available for this platform:\n ", + paste(avail, collapse = "\n "), "\n") + else "No groups at all are registered for this platform. ", + "Pass `databases = ` explicitly.", call. = FALSE) return(data.frame()) } } # One enrichment run per requested classification level - do.call(rbind, lapply(which_levels, function(lvl) { + parts <- lapply(which_levels, function(lvl) { rids <- as.character(res$region_id[res$classification == lvl]) pids <- unique(as.character(mapping$probe_id[mapping$region_id %in% rids])) - if (length(pids) == 0L) { - return(data.frame(query = lvl, n_query = 0L, - stringsAsFactors = FALSE)) + if (length(pids) == 0L) return(NULL) + + args <- list( + query = pids, + databases = dbs, + universe = universe, + alternative = alternative, + include_genes = include_genes, + platform = platform, + silent = TRUE, + mtc_by_group = mtc_by_group, + mtc_method = mtc_method + ) + # knowYourCG gained mtc_by_group / mtc_method after Bioc 3.20. Filter + # against the installed signature rather than testing a version number: + # BREAD is developed against one release and CI runs against devel. + keep <- names(args) %in% names(formals(knowYourCG::testEnrichment)) + if (!all(keep) && (!missing(mtc_by_group) || !missing(mtc_method))) { + message("bread_kycg(): knowYourCG ", utils::packageVersion("knowYourCG"), + " has no ", paste(names(args)[!keep], collapse = ", "), + " argument; ignoring.") } + enr <- tryCatch( - knowYourCG::testEnrichment( - query = pids, - databases = dbs, - universe = universe, - alternative = alternative, - include_genes = include_genes, - platform = platform, - silent = TRUE - ), + do.call(knowYourCG::testEnrichment, args[keep]), error = function(e) { warning("knowYourCG::testEnrichment failed for '", lvl, "': ", conditionMessage(e), call. = FALSE) NULL } ) - if (is.null(enr) || nrow(enr) == 0L) - return(data.frame(query = lvl, n_query = length(pids), - stringsAsFactors = FALSE)) + if (is.null(enr) || nrow(enr) == 0L) return(NULL) enr$query <- lvl enr$n_query <- length(pids) enr - })) + }) + + # Drop empties before rbind: a level with no probes used to contribute a + # 2-column stub, which rbind refuses to combine with a real result table. + parts <- Filter(Negate(is.null), parts) + if (length(parts) == 0L) { + warning("bread_kycg(): no classification level in `which` yielded any ", + "probes to test. Requested: ", + paste(shQuote(which_levels), collapse = ", "), ".", + call. = FALSE) + return(data.frame()) + } + out <- do.call(rbind, parts) + rownames(out) <- NULL + out +} + +# Default knowledgebase groups per platform, as name fragments matched right +# after "KYCG..". Deliberately no trailing "\\.": the real MM285 +# titles are KYCG.MM285.TFBSconsensus.20220116 and +# KYCG.MM285.HMconsensus.20220116, which an anchored "TFBS\\." cannot match -- +# that is why mouse users silently got an empty data.frame. +# +# Technical annotations (Mask, chromosome, probeType, seqContext) are excluded +# on purpose: enrichment against them is not biologically interpretable. +.KYCG_DEFAULT_GROUPS <- list( + EPIC = c("TFBS", "ChromHMM", "chromHMM", "CGI"), + EPICv2 = c("TFBS", "ChromHMM", "chromHMM", "CGI"), + HM450 = c("TFBS", "ChromHMM", "chromHMM", "CGI"), + MM285 = c("chromHMM", "TFBSconsensus", "HMconsensus", + "designGroup", "tissueSignature", "metagene") +) + +.kycg_default_dbs <- function(platform, titles) { + frags <- .KYCG_DEFAULT_GROUPS[[platform]] + if (is.null(frags) || length(titles) == 0L) return(character(0L)) + want <- paste0("^KYCG\\.", platform, "\\.(", + paste(frags, collapse = "|"), ")") + titles[grepl(want, titles)] } diff --git a/R/methods.R b/R/methods.R index 527d9b4..5b976c0 100644 --- a/R/methods.R +++ b/R/methods.R @@ -157,6 +157,8 @@ setMethod("show", "BreadFit", function(object) { "\n") cat(" delta :", object@params$delta, "\n") cat(" prob_cutoff:", object@params$prob_cutoff, "\n") + cat(" rope_cutoff:", object@params$rope_cutoff %||% object@params$prob_cutoff, "\n") + cat(" ci :", object@params$ci %||% 0.95, "\n") # Count distinct regions, not ranges: `features` may hold many ranges per # region_id, which previously printed as e.g. "788 (of 790 input)" for what # was really 30 regions built from 790 probes. diff --git a/R/posterior.R b/R/posterior.R index 3adc144..2276d4a 100644 --- a/R/posterior.R +++ b/R/posterior.R @@ -15,15 +15,42 @@ #' #' Columns in the returned data frame are the same in both cases. #' +#' @section Equivalence (`prob_rope`): +#' `prob_hyper`, `prob_hypo` and `prob_rope` are mutually exclusive and +#' exhaustive: they are the posterior mass above `+delta`, below `-delta`, and +#' inside the region of practical equivalence \eqn{[-\delta, +\delta]}, and +#' they sum to 1. `prob_rope` is what lets BREAD state that a region is +#' *confidently unchanged* rather than merely undetected — a claim no p-value +#' can make. See [classify_regions()]. +#' +#' @section Beta-scale columns: +#' BREAD models M-values, but reports a beta-scale translation of the effect +#' and the ROPE half-width via the local linearisation +#' \eqn{d\beta \approx dM \cdot \beta(1-\beta)\ln 2}, anchored per region at +#' `ref_beta`. By default `ref_beta` is the region's own mean methylation, +#' back-transformed from the mean M-value — well defined for every design and +#' contrast type, unlike the reference level of a factor. The same multiplier +#' is applied to the effect, both interval bounds and `delta`, so the +#' beta-scale comparison can never contradict the M-scale classification +#' beside it. See [bread_delta_beta()]. +#' #' @param fit A [BreadFit] (as returned by [fit_bread()]), or the internal #' model list from [fit_bread_summary()] / [fit_bread_brms()]. #' @param delta Effect-size threshold on the M-value scale. Default `0.10`. #' @param ci Credible-interval mass. Default `0.95`. +#' @param ref_beta Reference methylation level for the beta-scale columns. +#' `NULL` (default) derives it per region from the fitted region matrix. +#' Otherwise a single value applied to every region, or a numeric vector +#' named by `region_id`. Values must lie in (0, 1). #' #' @return A `data.frame` with one row per region and columns: #' `region_id`, `n`, `mean_effect`, `median_effect`, `ci_lo`, `ci_hi`, -#' `df`, `scale`, `prob_pos`, `prob_neg`, `prob_hyper`, `prob_hypo`, `error`. -#' `df` is `NA_real_` for the empirical path. +#' `df`, `scale`, `prob_pos`, `prob_neg`, `prob_hyper`, `prob_hypo`, +#' `prob_rope`, `ref_beta`, `mean_dbeta`, `dbeta_lo`, `dbeta_hi`, +#' `delta_beta`, `error`. +#' `df` is `NA_real_` for the empirical path. The beta-scale columns are +#' `NA_real_` when no region matrix is available, or when +#' `summary_fun = "pc1"` (PC1 scores are not M-values). #' #' @importFrom stats pt qt median quantile sd #' @importFrom methods is @@ -42,8 +69,11 @@ #' #' # A wider credible interval #' head(posterior_summary(fit, ci = 0.99)) +#' +#' # Posterior mass inside the region of practical equivalence +#' summary(posterior_summary(fit)$prob_rope) #' @export -posterior_summary <- function(fit, delta = 0.10, ci = 0.95) { +posterior_summary <- function(fit, delta = 0.10, ci = 0.95, ref_beta = NULL) { # Accept the user-facing object as well as the internal model list, so # callers never have to reach into the BreadFit's slots. if (methods::is(fit, "BreadFit")) fit <- fit@model @@ -134,8 +164,84 @@ posterior_summary <- function(fit, delta = 0.10, ci = 0.95) { out <- do.call(rbind, rows) rownames(out) <- NULL + + # Posterior mass inside the ROPE. Computed here rather than inside each of + # the three data.frame branches for two reasons: NA propagates through + # pmin/pmax, so failed fits get NA for free; and every future backend + # inherits it. The complement is used deliberately -- it loses *relative* + # accuracy only where prob_rope is near zero, i.e. where the answer is "not + # unchanged" either way, and the decision rule compares against ~0.95, where + # absolute accuracy is what matters. Do not "fix" this into a direct + # integral. The clamp catches the analytical path rounding to ~-1e-17. + out$prob_rope <- pmin(pmax(1 - out$prob_hyper - out$prob_hypo, 0), 1) + + # Beta-scale translation, anchored per region. + rb <- .resolve_ref_beta(fit, out$region_id, ref_beta) + k <- .dbeta_per_dm(rb) + out$ref_beta <- rb + out$mean_dbeta <- out$mean_effect * k + out$dbeta_lo <- out$ci_lo * k + out$dbeta_hi <- out$ci_hi * k + out$delta_beta <- delta * k + + out <- out[, .POST_COLS, drop = FALSE] attr(out, "delta") <- delta attr(out, "ci") <- ci attr(out, "contrast") <- fit$contrast out } + +# Canonical column order for posterior_summary(). `error` stays last. +.POST_COLS <- c( + "region_id", "n", "mean_effect", "median_effect", "ci_lo", "ci_hi", + "df", "scale", + "prob_pos", "prob_neg", "prob_hyper", "prob_hypo", "prob_rope", + "ref_beta", "mean_dbeta", "dbeta_lo", "dbeta_hi", "delta_beta", + "error" +) + +# Resolve the per-region beta anchor for the M -> beta linearisation. +# +# Default: the region's own mean methylation, as the back-transform of its +# mean M-value. This is defined for every design (a factor's reference level +# is not -- consider `~ passage`, an interaction contrast, or `~ 0 + group`), +# needs nothing beyond state the model already carries, and sits where the +# linearisation error is smallest on average. Note it is m_to_beta(mean(M)), +# not mean(beta); those differ by Jensen, and the former is the right anchor +# for a linearisation of an M-scale model. +.resolve_ref_beta <- function(model, region_ids, ref_beta = NULL) { + n <- length(region_ids) + + if (!is.null(ref_beta)) { + .check_ref_beta(ref_beta) + if (length(ref_beta) == 1L) return(rep(as.numeric(ref_beta), n)) + if (!is.null(names(ref_beta))) { + return(unname(as.numeric(ref_beta[match(region_ids, names(ref_beta))]))) + } + if (length(ref_beta) != n) { + stop("`ref_beta` must be length 1, named by region_id, or length ", + n, " (one per region); got ", length(ref_beta), + " unnamed values.", call. = FALSE) + } + return(as.numeric(ref_beta)) + } + + rm_ <- model$region_mat + if (is.null(rm_) || !is.matrix(rm_) || nrow(rm_) == 0L) { + return(rep(NA_real_, n)) + } + if (identical(attr(rm_, "summary_fun"), "pc1")) { + message("Beta-scale columns are NA under `summary_fun = \"pc1\"`: ", + "PC1 scores are not M-values, so no beta translation exists. ", + "Pass `ref_beta` explicitly to override.") + return(rep(NA_real_, n)) + } + + idx <- match(region_ids, rownames(rm_)) + mM <- rep(NA_real_, n) + ok <- !is.na(idx) + if (any(ok)) mM[ok] <- rowMeans(rm_[idx[ok], , drop = FALSE], na.rm = TRUE) + out <- .m_to_beta(mM) + out[!is.finite(out)] <- NA_real_ + out +} diff --git a/R/refit.R b/R/refit.R new file mode 100644 index 0000000..22dcc3b --- /dev/null +++ b/R/refit.R @@ -0,0 +1,205 @@ +#' Re-fit or re-threshold an existing BreadFit +#' +#' Repeats the modelling step of [fit_bread()] on a fit you already have, +#' reusing its region-by-sample matrix. Probe-to-region mapping and region +#' summarization — by far the expensive parts — are never repeated. +#' +#' Every argument defaults to `NULL`, meaning "keep what the original fit +#' used". Supply only what changes. +#' +#' @section Why this exists: +#' Label-permutation calibration is the natural way to check a posterior at +#' small n: shuffle the group labels a few hundred times and see where the +#' observed effect falls in the resulting null. That needs the region matrix +#' computed once and only the fit repeated. Without a public entry point the +#' only route was `BREAD:::fit_bread_summary()`, which is exactly the sort of +#' thing users should not have to reach for. +#' +#' ``` +#' nulls <- vapply(permutations, function(g) { +#' cd <- coldata; cd$genotype <- g +#' results(refit_bread(fit, colData = cd))$prob_hyper[i] +#' }, numeric(1)) +#' ``` +#' +#' @section Re-thresholding is free: +#' When only `delta`, `prob_cutoff`, `rope_cutoff`, `ci` or `ref_beta` change, +#' the model is not re-fitted at all — the stored posterior is re-summarized +#' and re-classified. So sweeping a delta x cutoff grid costs essentially +#' nothing. +#' +#' @param fit A [BreadFit] from [fit_bread()]. +#' @param colData Replacement sample metadata, with one row per column of the +#' region matrix. If it has rownames they are matched and reordered against +#' the matrix columns. +#' @param design Replacement one-sided design formula. +#' @param contrast Replacement coefficient name. +#' @param delta,prob_cutoff,rope_cutoff,ci,ref_beta Replacement posterior and +#' classification settings. See [fit_bread()]. +#' @param prior Replacement [bread_prior()] (conjugate backend only). +#' @param backend Replacement backend. Note that a `"brms"` refit recompiles +#' the Stan model; use `"conjugate"` for permutation work. +#' @param ... Passed to the brms backend when `backend = "brms"`. +#' +#' @return A new [BreadFit]. The `mapping`, `features`, `mode`, `assay_name` +#' and `input_scale` slots are carried over unchanged; `diagnostics` gains a +#' `refit_of` timestamp naming the parent fit. +#' +#' @seealso [fit_bread()], [posterior_summary()], [classify_regions()] +#' @importFrom methods is new +#' @examples +#' suppressPackageStartupMessages(library(SummarizedExperiment)) +#' +#' se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +#' reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +#' se_ctrl <- se[, se$condition == "ctrl"] +#' +#' fit <- fit_bread(se_ctrl, reg, ~ passage) +#' +#' # Re-threshold without re-fitting anything +#' table(results(refit_bread(fit, delta = 0.25))$classification) +#' +#' # Relax only the equivalence bar +#' table(results(refit_bread(fit, rope_cutoff = 0.80))$classification) +#' +#' # Re-fit against shuffled labels (one draw from a permutation null) +#' cd <- as.data.frame(colData(se_ctrl)) +#' cd$passage <- sample(cd$passage) +#' head(results(refit_bread(fit, colData = cd))$prob_hyper) +#' @export +refit_bread <- function(fit, + colData = NULL, + design = NULL, + contrast = NULL, + delta = NULL, + prob_cutoff = NULL, + rope_cutoff = NULL, + ci = NULL, + ref_beta = NULL, + prior = NULL, + backend = NULL, + ...) { + the_call <- match.call() + if (!methods::is(fit, "BreadFit")) { + stop("`fit` must be a BreadFit, not <", class(fit)[1], ">.", call. = FALSE) + } + model <- fit@model + if (is.null(model$region_mat)) { + stop("This fit carries no region matrix, so it cannot be re-fitted. ", + "Re-run fit_bread() from the SummarizedExperiment.", call. = FALSE) + } + + p <- fit@params + delta <- delta %||% p$delta + prob_cutoff <- prob_cutoff %||% p$prob_cutoff + rope_cutoff <- rope_cutoff %||% p$rope_cutoff %||% prob_cutoff + ci <- ci %||% p$ci %||% 0.95 + if (is.null(ref_beta)) ref_beta <- p$ref_beta + backend <- backend %||% p$backend + + # Anything that changes the likelihood forces a re-fit; anything else only + # re-reads the posterior we already have. + needs_fit <- !is.null(colData) || !is.null(design) || + !is.null(contrast) || !is.null(prior) || + !identical(backend, p$backend) + + if (needs_fit) { + region_mat <- model$region_mat + cd <- if (is.null(colData)) model$coldata else + .align_refit_coldata(colData, colnames(region_mat)) + dsn <- design %||% model$design + contrast <- contrast %||% p$contrast + + .validate_design_contrast(cd, dsn, contrast) + + # A stored prior is sized to the original design's coefficients, so a new + # design invalidates it. Fall back to the default rather than erroring on + # a length mismatch the user never asked about. + inherited_prior <- if (is.null(design)) model$prior else NULL + if (!is.null(design) && !is.null(model$prior) && is.null(prior)) { + message("`design` changed; the stored prior no longer matches the ", + "coefficients and the default is used instead. Pass `prior = ` ", + "to set one for the new design.") + } + + model <- switch( + backend, + conjugate = fit_bread_summary( + region_mat = region_mat, coldata = cd, design = dsn, + contrast = contrast, prior = prior %||% inherited_prior + ), + brms = fit_bread_brms( + region_mat = region_mat, coldata = cd, design = dsn, + contrast = contrast, ... + ), + stop("Unknown backend '", backend, "'.", call. = FALSE) + ) + } else { + contrast <- p$contrast + } + + post <- posterior_summary(model, delta = delta, ci = ci, + ref_beta = ref_beta) + res <- classify_regions(post, delta = delta, + prob_cutoff = prob_cutoff, + rope_cutoff = rope_cutoff) + + errs <- vapply(model$fits, function(f) f$error, character(1L)) + diagnostics <- fit@diagnostics + diagnostics$backend <- backend + diagnostics$n_failed_fits <- sum(!is.na(errs)) + diagnostics$timestamp <- Sys.time() + diagnostics$refit_of <- fit@diagnostics$timestamp + + methods::new("BreadFit", + call = the_call, + params = list( + contrast = contrast, + delta = delta, + prob_cutoff = prob_cutoff, + rope_cutoff = rope_cutoff, + ci = ci, + ref_beta = ref_beta, + summary_fun = p$summary_fun, + backend = backend, + min_probes = p$min_probes, + feature_class_col = p$feature_class_col + ), + mode = fit@mode, + assay_name = fit@assay_name, + input_scale = fit@input_scale, + mapping = fit@mapping, + features = fit@features, + model = model, + posterior = post, + results = res, + diagnostics = diagnostics + ) +} + +# Sample metadata for a refit is matched to the region matrix's columns. +# Positional assignment is the trap this exists to remove. +.align_refit_coldata <- function(colData, sample_ids) { + if (!is.data.frame(colData) && !methods::is(colData, "DataFrame")) { + stop("`colData` must be a data.frame or DataFrame, not <", + class(colData)[1], ">.", call. = FALSE) + } + cd <- as.data.frame(colData, stringsAsFactors = FALSE) + if (nrow(cd) != length(sample_ids)) { + stop("`colData` has ", nrow(cd), " rows but the region matrix has ", + length(sample_ids), " samples.", call. = FALSE) + } + rn <- rownames(colData) + if (!is.null(rn) && !is.null(sample_ids)) { + idx <- match(sample_ids, rn) + if (anyNA(idx)) { + stop("`colData` rownames do not cover every sample in the region ", + "matrix. Missing: ", + paste(shQuote(sample_ids[is.na(idx)][seq_len(min(5L, sum(is.na(idx))))]), + collapse = ", "), ".", call. = FALSE) + } + cd <- cd[idx, , drop = FALSE] + } + rownames(cd) <- sample_ids + cd +} diff --git a/R/scale.R b/R/scale.R new file mode 100644 index 0000000..d897294 --- /dev/null +++ b/R/scale.R @@ -0,0 +1,82 @@ +#' Translate effect sizes between the M and beta scales +#' +#' BREAD models M-values, so `delta` and every effect estimate are on the +#' M scale. Biologists generally think in beta (proportion methylated). These +#' helpers convert between the two using the local linearisation of +#' \eqn{M = \log_2(\beta / (1 - \beta))} at a reference beta: +#' +#' \deqn{d\beta \approx dM \cdot \beta(1 - \beta) \ln 2} +#' +#' @section Why the translation is not a single number: +#' The slope \eqn{\beta(1-\beta)\ln 2} is maximal at \eqn{\beta = 0.5} (0.173) +#' and shrinks toward the extremes (0.111 at \eqn{\beta = 0.2}, 0.062 at +#' \eqn{\beta = 0.1}). So the default `delta = 0.10` on the M scale means +#' \eqn{\Delta\beta \approx 0.017} at mid-methylation but only \eqn{\approx +#' 0.006} at \eqn{\beta = 0.1}. **0.017 is a ceiling, not a typical value.** +#' This is why BREAD reports a per-region `delta_beta` in [results()] rather +#' than accepting `delta` in beta units: a beta-defined threshold would +#' silently become a 20-fold wider equivalence region at the extremes. +#' +#' The default `ref_beta = 0.5` is the maximal-slope anchor. For a target +#' \eqn{\Delta\beta} it therefore returns the *smallest* `delta_m` that could +#' produce it — conservative when hunting for change, anti-conservative when +#' claiming equivalence. Anchor at your own data's methylation level when the +#' distinction matters. +#' +#' @param delta_m Effect size on the M-value scale. +#' @param delta_beta Effect size on the beta scale. +#' @param ref_beta Reference methylation level at which to linearise, in +#' (0, 1). Default `0.5`. +#' +#' @return A numeric vector the length of the recycled inputs. +#' +#' @examples +#' # The default BREAD threshold, in beta units, at mid-methylation +#' bread_delta_beta(0.10) +#' +#' # ... and how much smaller it is toward the extremes +#' bread_delta_beta(0.10, ref_beta = c(0.5, 0.2, 0.1)) +#' +#' # Going the other way: what delta_m gives a 2-percentage-point window? +#' bread_delta_m(0.02) +#' +#' # Round trip +#' bread_delta_m(bread_delta_beta(0.10, 0.3), 0.3) +#' @name bread_scale +NULL + +# Local slope d(beta)/d(M) at a reference beta. +.dbeta_per_dm <- function(ref_beta) ref_beta * (1 - ref_beta) * log(2) + +.check_ref_beta <- function(ref_beta) { + if (!is.numeric(ref_beta) || length(ref_beta) == 0L) { + stop("`ref_beta` must be a non-empty numeric vector.", call. = FALSE) + } + bad <- !is.na(ref_beta) & (ref_beta <= 0 | ref_beta >= 1) + if (any(bad)) { + offending <- ref_beta[bad] + stop("`ref_beta` must be in (0, 1); got ", + paste(offending[seq_len(min(3L, length(offending)))], + collapse = ", "), ".", + call. = FALSE) + } + invisible(TRUE) +} + +#' @rdname bread_scale +#' @export +bread_delta_beta <- function(delta_m, ref_beta = 0.5) { + if (!is.numeric(delta_m)) stop("`delta_m` must be numeric.", call. = FALSE) + .check_ref_beta(ref_beta) + delta_m * .dbeta_per_dm(ref_beta) +} + +#' @rdname bread_scale +#' @export +bread_delta_m <- function(delta_beta, ref_beta = 0.5) { + if (!is.numeric(delta_beta)) { + stop("`delta_beta` must be numeric.", call. = FALSE) + } + .check_ref_beta(ref_beta) + delta_beta / .dbeta_per_dm(ref_beta) +} diff --git a/R/utils.R b/R/utils.R index 4f3c862..6c87da1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -41,11 +41,15 @@ NULL "#122451" # deep navy ) -# Classification palette (warm = hyper gain, cool = hypo loss, neutral = inconclusive) +# Classification palette. Warm = hyper gain, cool = hypo loss, olive = +# a confident no-change call, grey = no information. `unchanged` keeps a +# saturated colour because it is a finding; `inconclusive` is deliberately +# desaturated because the absence of information should look like it. .col_classification <- c( hypermethylated = "#ce4441", hypomethylated = "#004f63", - inconclusive = "#859b6c" + unchanged = "#859b6c", + inconclusive = "#BFBFBF" ) # Binary group palette — used by plot_region_data() for the contrast variable @@ -58,7 +62,8 @@ NULL #' dependency on the `MetBrewer` package. #' #' @param which One of: -#' - `"classification"` : named 3-vector for hyper/hypo/inconclusive +#' - `"classification"` : named 4-vector for +#' hyper / hypo / unchanged / inconclusive #' - `"group"` : unnamed 2-vector for binary contrast plots #' - `"cross"` : full 9-color palette #' diff --git a/R/validate.R b/R/validate.R index e730369..123e768 100644 --- a/R/validate.R +++ b/R/validate.R @@ -80,31 +80,54 @@ validate_bread_input <- function(se, call. = FALSE) } - # Design variables must live in colData - cd <- SummarizedExperiment::colData(se) - dvars <- all.vars(design) - missing_vars <- setdiff(dvars, colnames(cd)) + .validate_design_contrast(SummarizedExperiment::colData(se), + design, contrast) + + invisible(TRUE) +} + +# Shared by validate_bread_input() and refit_bread(): the design variables +# must exist in the sample metadata, the model matrix must be buildable, and +# the contrast (when given) must be one of its coefficients. +# +# Also warns on a rank-deficient design. This is not cosmetic: the conjugate +# backend adds Lambda0 = 0.01 * I before the Cholesky, so a collinear design +# does not fail -- it silently returns a prior-regularised estimate that looks +# like a real fit. Permutation studies hit this routinely, and every caller +# so far has had to hand-roll its own qr() guard. +.validate_design_contrast <- function(coldata, design, contrast = NULL) { + if (!inherits(design, "formula")) { + stop("`design` must be a formula (e.g. `~ group + sex`), not <", + class(design)[1], ">.", call. = FALSE) + } + if (length(design) != 2L) { + stop("`design` must be one-sided (e.g. `~ group`, not `y ~ group`). ", + "BREAD supplies the response internally.", call. = FALSE) + } + + cd <- as.data.frame(coldata) + missing_vars <- setdiff(all.vars(design), colnames(cd)) if (length(missing_vars) > 0L) { stop("Variables in `design` not found in `colData(se)`: ", paste(shQuote(missing_vars), collapse = ", "), ".", call. = FALSE) } - # Contrast, if given, must match a design coefficient + mm <- tryCatch( + stats::model.matrix(design, data = cd), + error = function(e) NULL + ) + if (is.null(mm)) { + stop("Could not build a model matrix from `design` and `colData(se)`. ", + "Check for NAs or singularities in the design variables.", + call. = FALSE) + } + if (!is.null(contrast)) { if (!is.character(contrast) || length(contrast) != 1L || is.na(contrast)) { stop("`contrast` must currently be a single character coefficient name (v1).", call. = FALSE) } - mm <- tryCatch( - stats::model.matrix(design, data = as.data.frame(cd)), - error = function(e) NULL - ) - if (is.null(mm)) { - stop("Could not build a model matrix from `design` and `colData(se)`. ", - "Check for NAs or singularities in the design variables.", - call. = FALSE) - } if (!contrast %in% colnames(mm)) { stop("`contrast = \"", contrast, "\"` not found among design coefficients. ", "Available: ", paste(shQuote(colnames(mm)), collapse = ", "), ".", @@ -112,5 +135,15 @@ validate_bread_input <- function(se, } } - invisible(TRUE) + rk <- tryCatch(qr(mm)$rank, error = function(e) NA_integer_) + if (!is.na(rk) && rk < ncol(mm)) { + warning("Design matrix is rank deficient (rank ", rk, " < ", ncol(mm), + " coefficients). The conjugate prior will absorb the deficiency ", + "rather than error, so estimates for the collinear coefficients ", + "are prior-driven. Columns: ", + paste(shQuote(colnames(mm)), collapse = ", "), ".", + call. = FALSE) + } + + invisible(mm) } diff --git a/man/BREAD-package.Rd b/man/BREAD-package.Rd index 87fa46d..f36f7a1 100644 --- a/man/BREAD-package.Rd +++ b/man/BREAD-package.Rd @@ -7,11 +7,14 @@ \title{BREAD: Bayesian Region-specific DNA Methylation Inference} \description{ Targeted Bayesian inference for predefined DNA methylation regions on array -data in \link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment::SummarizedExperiment} objects. For each -user-supplied region, BREAD fits a Bayesian model, computes posterior -probabilities of directional methylation change, and classifies regions as -hypermethylated, hypomethylated, or inconclusive at user-configurable -effect-size and probability thresholds. +data, supplied either as a \link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment::SummarizedExperiment} or +as a probe-by-sample matrix. For each user-supplied region, BREAD fits a +Bayesian model, computes posterior probabilities of directional methylation +change, and classifies regions as hypermethylated, hypomethylated, +unchanged, or inconclusive at user-configurable effect-size and probability +thresholds. The \code{unchanged} class reports regions whose posterior lies +inside the region of practical equivalence: positive evidence of no change, +as distinct from insufficient evidence either way. } \seealso{ Useful links: diff --git a/man/BreadFit.Rd b/man/BreadFit.Rd index 93d4d1b..deda34c 100644 --- a/man/BreadFit.Rd +++ b/man/BreadFit.Rd @@ -14,9 +14,9 @@ slots that downstream packages can depend on. \describe{ \item{\code{call}}{The original \code{fit_bread()} call.} -\item{\code{params}}{List of parameters used (delta, prob_cutoff, summary_fun, -mode, backend, contrast, min_probes, feature_class_col, iter, chains, -cores, seed).} +\item{\code{params}}{List of parameters used (contrast, delta, prob_cutoff, +rope_cutoff, ci, ref_beta, summary_fun, backend, min_probes, +feature_class_col).} \item{\code{mode}}{\code{"summary"} or \code{"hierarchical"}.} @@ -26,15 +26,25 @@ cores, seed).} \item{\code{mapping}}{Probe-to-region data frame from \code{\link[=map_probes_to_features]{map_probes_to_features()}}.} -\item{\code{features}}{\code{GRanges} of regions that survived \code{min_probes} filtering.} +\item{\code{features}}{\code{GRanges} of the ranges belonging to regions that survived +\code{min_probes} filtering. When several ranges share a \code{region_id} this is +longer than \code{nrow(results(fit))}; \code{diagnostics$n_features_out} is the +region count.} -\item{\code{model}}{Internal fit object from \code{\link[=fit_bread_summary]{fit_bread_summary()}}.} +\item{\code{model}}{Internal fit object from \code{\link[=fit_bread_summary]{fit_bread_summary()}} or +\code{\link[=fit_bread_brms]{fit_bread_brms()}}. Both backends return the same named list: +\code{fits}, \code{design_matrix}, \code{coef_names}, \code{contrast}, \code{contrast_idx}, +\code{region_ids}, \code{prior}, \code{region_mat}, \code{design}, \code{coldata}. This shape is +relied on by \code{\link[=refit_bread]{refit_bread()}}, \code{\link[=posterior_summary]{posterior_summary()}} and +\code{\link[=plot_region_data]{plot_region_data()}}; treat it as part of the interface.} \item{\code{posterior}}{Per-region posterior summary data frame.} \item{\code{results}}{Per-region data frame with classification column.} -\item{\code{diagnostics}}{List with backend, seed, feature counts, failure counts.} +\item{\code{diagnostics}}{List with backend, feature counts, dropped regions, +failure counts, timestamp, and \code{refit_of} when produced by +\code{\link[=refit_bread]{refit_bread()}}.} }} \examples{ diff --git a/man/bread_colors.Rd b/man/bread_colors.Rd index 7288944..f11eb22 100644 --- a/man/bread_colors.Rd +++ b/man/bread_colors.Rd @@ -9,7 +9,8 @@ bread_colors(which = c("classification", "group", "cross")) \arguments{ \item{which}{One of: \itemize{ -\item \code{"classification"} : named 3-vector for hyper/hypo/inconclusive +\item \code{"classification"} : named 4-vector for +hyper / hypo / unchanged / inconclusive \item \code{"group"} : unnamed 2-vector for binary contrast plots \item \code{"cross"} : full 9-color palette }} diff --git a/man/bread_kycg.Rd b/man/bread_kycg.Rd index fa9af2d..809b6a0 100644 --- a/man/bread_kycg.Rd +++ b/man/bread_kycg.Rd @@ -11,7 +11,9 @@ bread_kycg( platform = c("EPIC", "EPICv2", "HM450", "MM285"), universe = NULL, alternative = "greater", - include_genes = FALSE + include_genes = FALSE, + mtc_by_group = TRUE, + mtc_method = "fdr" ) } \arguments{ @@ -34,6 +36,15 @@ Use a single string to run one.} \item{alternative}{\code{"greater"} (default), \code{"two.sided"}, or \code{"less"}.} \item{include_genes}{Passed through to \code{\link[knowYourCG:testEnrichment]{knowYourCG::testEnrichment()}}.} + +\item{mtc_by_group}{Correct for multiple testing within each knowledgebase +group rather than across all of them. Passed to +\code{knowYourCG::testEnrichment()} when the installed version supports it +(added after Bioconductor 3.20) and ignored with a message when it does +not.} + +\item{mtc_method}{Multiple-testing correction method, as for +\code{\link[stats:p.adjust]{stats::p.adjust()}}. Same version caveat as \code{mtc_by_group}.} } \value{ A tidy \code{data.frame} with one row per tested set, containing a diff --git a/man/bread_scale.Rd b/man/bread_scale.Rd new file mode 100644 index 0000000..6f9c765 --- /dev/null +++ b/man/bread_scale.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale.R +\name{bread_scale} +\alias{bread_scale} +\alias{bread_delta_beta} +\alias{bread_delta_m} +\title{Translate effect sizes between the M and beta scales} +\usage{ +bread_delta_beta(delta_m, ref_beta = 0.5) + +bread_delta_m(delta_beta, ref_beta = 0.5) +} +\arguments{ +\item{delta_m}{Effect size on the M-value scale.} + +\item{ref_beta}{Reference methylation level at which to linearise, in +(0, 1). Default \code{0.5}.} + +\item{delta_beta}{Effect size on the beta scale.} +} +\value{ +A numeric vector the length of the recycled inputs. +} +\description{ +BREAD models M-values, so \code{delta} and every effect estimate are on the +M scale. Biologists generally think in beta (proportion methylated). These +helpers convert between the two using the local linearisation of +\eqn{M = \log_2(\beta / (1 - \beta))} at a reference beta: +} +\details{ +\deqn{d\beta \approx dM \cdot \beta(1 - \beta) \ln 2} +} +\section{Why the translation is not a single number}{ + +The slope \eqn{\beta(1-\beta)\ln 2} is maximal at \eqn{\beta = 0.5} (0.173) +and shrinks toward the extremes (0.111 at \eqn{\beta = 0.2}, 0.062 at +\eqn{\beta = 0.1}). So the default \code{delta = 0.10} on the M scale means +\eqn{\Delta\beta \approx 0.017} at mid-methylation but only \eqn{\approx +0.006} at \eqn{\beta = 0.1}. \strong{0.017 is a ceiling, not a typical value.} +This is why BREAD reports a per-region \code{delta_beta} in \code{\link[=results]{results()}} rather +than accepting \code{delta} in beta units: a beta-defined threshold would +silently become a 20-fold wider equivalence region at the extremes. + +The default \code{ref_beta = 0.5} is the maximal-slope anchor. For a target +\eqn{\Delta\beta} it therefore returns the \emph{smallest} \code{delta_m} that could +produce it — conservative when hunting for change, anti-conservative when +claiming equivalence. Anchor at your own data's methylation level when the +distinction matters. +} + +\examples{ +# The default BREAD threshold, in beta units, at mid-methylation +bread_delta_beta(0.10) + +# ... and how much smaller it is toward the extremes +bread_delta_beta(0.10, ref_beta = c(0.5, 0.2, 0.1)) + +# Going the other way: what delta_m gives a 2-percentage-point window? +bread_delta_m(0.02) + +# Round trip +bread_delta_m(bread_delta_beta(0.10, 0.3), 0.3) +} diff --git a/man/bread_se.Rd b/man/bread_se.Rd new file mode 100644 index 0000000..fcb945f --- /dev/null +++ b/man/bread_se.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/coerce.R +\name{bread_se} +\alias{bread_se} +\title{Assemble a SummarizedExperiment for BREAD from a matrix} +\usage{ +bread_se( + x, + colData = NULL, + rowRanges = NULL, + platform = NULL, + assay_name = NULL +) +} +\arguments{ +\item{x}{A \code{SummarizedExperiment} (returned unchanged), a probe-by-sample +\code{matrix}, or a \code{list} with a \code{betas} element and sample metadata under +\code{sampleInfo}, \code{meta} or \code{pd}.} + +\item{colData}{Sample metadata: a \code{data.frame} or \code{DataFrame} with one row +per column of \code{x}. If it has rownames they are matched against +\code{colnames(x)} and reordered; otherwise rows are assumed to be in column +order and a warning is emitted. Required unless \code{design} has no variables.} + +\item{rowRanges}{A \link[GenomicRanges:GRanges-class]{GenomicRanges::GRanges} of probe coordinates. If named, +it is subset and reordered to \code{rownames(x)}; unnamed, it must already be +in row order.} + +\item{platform}{Array platform for the \code{sesameData} manifest lookup, e.g. +\code{"EPIC"}, \code{"EPICv2"}, \code{"HM450"}, \code{"MM285"}. Requires the \code{sesameData} +package. Ignored when \code{rowRanges} is supplied.} + +\item{assay_name}{Name for the assay. Defaults to \code{"betas"} when the values +all fall in [0, 1] and \code{"M"} otherwise, matching what +\code{\link[=fit_bread]{fit_bread()}} auto-detects.} +} +\value{ +A \link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment::SummarizedExperiment}. +} +\description{ +BREAD models a \code{SummarizedExperiment} carrying row-level genomic +coordinates. Most methylation pipelines do not hand you one: \code{sesame}'s +\code{openSesame()} returns a plain beta matrix, and its packaged example data +are \verb{list(betas = , sampleInfo = )}. This helper builds +the object BREAD needs, so a matrix workflow does not stall at the first +step. \code{\link[=fit_bread]{fit_bread()}} calls it for you; use it directly when you want to +coerce once and reuse the result. +} +\section{Where coordinates come from}{ + +A bare matrix has no coordinates, so you must supply them one of two ways: +pass \code{rowRanges} (a \link[GenomicRanges:GRanges-class]{GenomicRanges::GRanges}, ideally named by probe ID), +or pass \code{platform} to look the manifest up through \code{sesameData}. + +\strong{The platform is never guessed.} \code{cg########} identifiers are shared +across HM450, EPIC and MM285, so inferring the array from probe names would +silently return the wrong coordinates for a substantial fraction of probes, +assign them to the wrong regions, and produce confident, wrong biology with +no error anywhere. One word from you removes that entire failure mode. +} + +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +# Take a packaged SE apart, then put it back together the matrix way +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +mat <- assay(se, "betas") +cd <- as.data.frame(colData(se)) +gr <- rowRanges(se) + +se2 <- bread_se(mat, colData = cd, rowRanges = gr) +se2 +} +\seealso{ +\code{\link[=fit_bread]{fit_bread()}} +} diff --git a/man/classify_regions.Rd b/man/classify_regions.Rd index 518363c..41214c9 100644 --- a/man/classify_regions.Rd +++ b/man/classify_regions.Rd @@ -2,9 +2,14 @@ % Please edit documentation in R/classify.R \name{classify_regions} \alias{classify_regions} -\title{Classify regions as hyper / hypo / inconclusive} +\title{Classify regions as hyper / hypo / unchanged / inconclusive} \usage{ -classify_regions(post, delta = 0.1, prob_cutoff = 0.95) +classify_regions( + post, + delta = 0.1, + prob_cutoff = 0.95, + rope_cutoff = prob_cutoff +) } \arguments{ \item{post}{Output of \code{\link[=posterior_summary]{posterior_summary()}}.} @@ -13,26 +18,53 @@ classify_regions(post, delta = 0.1, prob_cutoff = 0.95) as an attribute; does not re-evaluate the posterior probabilities (those must have been computed at this same \code{delta} upstream).} -\item{prob_cutoff}{Posterior probability cutoff. Default \code{0.95}.} +\item{prob_cutoff}{Posterior probability cutoff for a \emph{directional} call. +Default \code{0.95}.} + +\item{rope_cutoff}{Posterior probability cutoff for an \emph{equivalence} call. +Defaults to \code{prob_cutoff}. Worth setting independently: concluding +equivalence requires the posterior to fit entirely inside +\eqn{[-\delta, +\delta]}, a far stricter demand than a directional call, +and at small n almost nothing reaches 0.95. Loosening it should not +require loosening the discovery threshold too.} } \value{ The input \code{data.frame} with an added \code{classification} factor column -(levels: \code{hypermethylated}, \code{hypomethylated}, \code{inconclusive}). Attributes -\code{delta} and \code{prob_cutoff} are updated. +(levels: \code{hypermethylated}, \code{hypomethylated}, \code{unchanged}, +\code{inconclusive}). Attributes \code{delta}, \code{prob_cutoff} and \code{rope_cutoff} are +updated. If \code{post} has no \code{prob_rope} column it is derived as +\code{1 - prob_hyper - prob_hypo}. } \description{ Applies the BREAD decision rule to the output of \code{\link[=posterior_summary]{posterior_summary()}}: \itemize{ \item \code{hypermethylated} if \code{prob_hyper >= prob_cutoff} \item \code{hypomethylated} if \code{prob_hypo >= prob_cutoff} +\item \code{unchanged} if \code{prob_rope >= rope_cutoff} \item \code{inconclusive} otherwise } } -\details{ -In the rare case that both probabilities exceed the cutoff (only possible -for very low \code{prob_cutoff}), the region is assigned to whichever side has -the larger posterior probability. +\section{Why \code{unchanged} is a separate class}{ + +\code{inconclusive} used to absorb two entirely different situations: a region +whose posterior sits tightly inside the region of practical equivalence +(strong evidence of \emph{no} change) and a region whose posterior is so diffuse +that nothing can be said. Collapsing them discards the one claim a p-value +structurally cannot make — that a region is \emph{demonstrably} unmoved at the +stated \code{delta}. \code{unchanged} means "practically unchanged at this \code{delta}", +not "identical"; \code{inconclusive} now means only what its name says. } + +\section{Mutual exclusivity}{ + +\code{prob_hyper}, \code{prob_hypo} and \code{prob_rope} partition the posterior, so they +sum to 1. Two of them can therefore clear their thresholds simultaneously +only if the two thresholds sum to no more than 1 — impossible at any +sensible setting (0.95 + 0.95 > 1). Should you set thresholds that low, the +largest of the qualifying probabilities wins, with ties resolved +hyper > hypo > unchanged. +} + \examples{ suppressPackageStartupMessages(library(SummarizedExperiment)) @@ -48,4 +80,7 @@ table(cl$classification) # A stricter cutoff moves borderline regions into `inconclusive` table(classify_regions(post, prob_cutoff = 0.99)$classification) + +# Relax only the equivalence bar, leaving discovery untouched +table(classify_regions(post, rope_cutoff = 0.80)$classification) } diff --git a/man/fit_bread.Rd b/man/fit_bread.Rd index 255e9e2..f0416d2 100644 --- a/man/fit_bread.Rd +++ b/man/fit_bread.Rd @@ -5,12 +5,18 @@ \title{Fit a Bayesian region-specific methylation model} \usage{ fit_bread( - se, + x, features, design, contrast = NULL, + colData = NULL, + rowRanges = NULL, + platform = NULL, delta = 0.1, prob_cutoff = 0.95, + rope_cutoff = prob_cutoff, + ci = 0.95, + ref_beta = NULL, min_probes = 3L, feature_class_col = NULL, summary_fun = c("mean", "median", "weighted_mean", "pc1"), @@ -22,18 +28,41 @@ fit_bread( ) } \arguments{ -\item{se}{A \link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment::SummarizedExperiment} with a methylation assay.} +\item{x}{A \link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment::SummarizedExperiment} with a methylation +assay, or a probe-by-sample \code{matrix} (with \code{colData} and either +\code{rowRanges} or \code{platform}), or a \code{list(betas =, sampleInfo =)} as +returned by \code{sesameData}. See \code{\link[=bread_se]{bread_se()}}.} -\item{features}{A \link[GenomicRanges:GRanges-class]{GenomicRanges::GRanges} of user-defined regions.} +\item{features}{A \link[GenomicRanges:GRanges-class]{GenomicRanges::GRanges} of user-defined regions. Several +ranges may share a name to define one region as an exact probe set.} \item{design}{A one-sided formula giving the model design, e.g. \code{~ group + sex}.} \item{contrast}{Character coefficient name of interest. If \code{NULL} (default), the first non-intercept coefficient is used and a message is emitted.} -\item{delta}{Effect-size threshold on the M-value scale. Default \code{0.10}.} +\item{colData, rowRanges, platform}{Only for matrix input: sample metadata, +probe coordinates, and the array platform for a \code{sesameData} manifest +lookup. Passing any of them alongside a \code{SummarizedExperiment} is an +error. See \code{\link[=bread_se]{bread_se()}}.} -\item{prob_cutoff}{Posterior probability cutoff for classification. Default \code{0.95}.} +\item{delta}{Effect-size threshold on the M-value scale. Default \code{0.10} +(a beta change of roughly 0.017 at mid-methylation, less toward the +extremes -- see \code{\link[=bread_delta_beta]{bread_delta_beta()}}).} + +\item{prob_cutoff}{Posterior probability cutoff for a directional +(hyper/hypo) call. Default \code{0.95}.} + +\item{rope_cutoff}{Posterior probability cutoff for an \code{unchanged} +(equivalence) call. Defaults to \code{prob_cutoff}; see \code{\link[=classify_regions]{classify_regions()}} +for why it is worth setting independently.} + +\item{ci}{Credible-interval mass reported in \code{ci_lo}/\code{ci_hi}. Default +\code{0.95}. Independent of \code{prob_cutoff}.} + +\item{ref_beta}{Reference methylation level(s) anchoring the beta-scale +columns. \code{NULL} (default) uses each region's own mean. See +\code{\link[=posterior_summary]{posterior_summary()}}.} \item{min_probes}{Minimum probes per region. Default \code{3}.} @@ -64,7 +93,8 @@ with a methylation assay and a \link[GenomicRanges:GRanges-class]{GenomicRanges: regions, BREAD maps probes to regions, summarizes them per sample, and fits Bayesian region-level models to produce posterior probabilities of directional methylation change under the contrast of interest. Regions -are classified as hypermethylated, hypomethylated, or inconclusive. +are classified as hypermethylated, hypomethylated, unchanged (posterior +concentrated inside the region of practical equivalence) or inconclusive. } \section{Minimal call}{ diff --git a/man/posterior_summary.Rd b/man/posterior_summary.Rd index 1f73667..00bbbd6 100644 --- a/man/posterior_summary.Rd +++ b/man/posterior_summary.Rd @@ -4,7 +4,7 @@ \alias{posterior_summary} \title{Extract per-region posterior summaries} \usage{ -posterior_summary(fit, delta = 0.1, ci = 0.95) +posterior_summary(fit, delta = 0.1, ci = 0.95, ref_beta = NULL) } \arguments{ \item{fit}{A \link{BreadFit} (as returned by \code{\link[=fit_bread]{fit_bread()}}), or the internal @@ -13,12 +13,21 @@ model list from \code{\link[=fit_bread_summary]{fit_bread_summary()}} / \code{\l \item{delta}{Effect-size threshold on the M-value scale. Default \code{0.10}.} \item{ci}{Credible-interval mass. Default \code{0.95}.} + +\item{ref_beta}{Reference methylation level for the beta-scale columns. +\code{NULL} (default) derives it per region from the fitted region matrix. +Otherwise a single value applied to every region, or a numeric vector +named by \code{region_id}. Values must lie in (0, 1).} } \value{ A \code{data.frame} with one row per region and columns: \code{region_id}, \code{n}, \code{mean_effect}, \code{median_effect}, \code{ci_lo}, \code{ci_hi}, -\code{df}, \code{scale}, \code{prob_pos}, \code{prob_neg}, \code{prob_hyper}, \code{prob_hypo}, \code{error}. -\code{df} is \code{NA_real_} for the empirical path. +\code{df}, \code{scale}, \code{prob_pos}, \code{prob_neg}, \code{prob_hyper}, \code{prob_hypo}, +\code{prob_rope}, \code{ref_beta}, \code{mean_dbeta}, \code{dbeta_lo}, \code{dbeta_hi}, +\code{delta_beta}, \code{error}. +\code{df} is \code{NA_real_} for the empirical path. The beta-scale columns are +\code{NA_real_} when no region matrix is available, or when +\code{summary_fun = "pc1"} (PC1 scores are not M-values). } \description{ Given the output of \code{\link[=fit_bread_summary]{fit_bread_summary()}} (conjugate backend) or @@ -40,6 +49,29 @@ computed from the MCMC draws directly. Columns in the returned data frame are the same in both cases. } +\section{Equivalence (\code{prob_rope})}{ + +\code{prob_hyper}, \code{prob_hypo} and \code{prob_rope} are mutually exclusive and +exhaustive: they are the posterior mass above \code{+delta}, below \code{-delta}, and +inside the region of practical equivalence \eqn{[-\delta, +\delta]}, and +they sum to 1. \code{prob_rope} is what lets BREAD state that a region is +\emph{confidently unchanged} rather than merely undetected — a claim no p-value +can make. See \code{\link[=classify_regions]{classify_regions()}}. +} + +\section{Beta-scale columns}{ + +BREAD models M-values, but reports a beta-scale translation of the effect +and the ROPE half-width via the local linearisation +\eqn{d\beta \approx dM \cdot \beta(1-\beta)\ln 2}, anchored per region at +\code{ref_beta}. By default \code{ref_beta} is the region's own mean methylation, +back-transformed from the mean M-value — well defined for every design and +contrast type, unlike the reference level of a factor. The same multiplier +is applied to the effect, both interval bounds and \code{delta}, so the +beta-scale comparison can never contradict the M-scale classification +beside it. See \code{\link[=bread_delta_beta]{bread_delta_beta()}}. +} + \examples{ suppressPackageStartupMessages(library(SummarizedExperiment)) @@ -55,4 +87,7 @@ head(post) # A wider credible interval head(posterior_summary(fit, ci = 0.99)) + +# Posterior mass inside the region of practical equivalence +summary(posterior_summary(fit)$prob_rope) } diff --git a/man/refit_bread.Rd b/man/refit_bread.Rd new file mode 100644 index 0000000..de208a5 --- /dev/null +++ b/man/refit_bread.Rd @@ -0,0 +1,103 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/refit.R +\name{refit_bread} +\alias{refit_bread} +\title{Re-fit or re-threshold an existing BreadFit} +\usage{ +refit_bread( + fit, + colData = NULL, + design = NULL, + contrast = NULL, + delta = NULL, + prob_cutoff = NULL, + rope_cutoff = NULL, + ci = NULL, + ref_beta = NULL, + prior = NULL, + backend = NULL, + ... +) +} +\arguments{ +\item{fit}{A \link{BreadFit} from \code{\link[=fit_bread]{fit_bread()}}.} + +\item{colData}{Replacement sample metadata, with one row per column of the +region matrix. If it has rownames they are matched and reordered against +the matrix columns.} + +\item{design}{Replacement one-sided design formula.} + +\item{contrast}{Replacement coefficient name.} + +\item{delta, prob_cutoff, rope_cutoff, ci, ref_beta}{Replacement posterior and +classification settings. See \code{\link[=fit_bread]{fit_bread()}}.} + +\item{prior}{Replacement \code{\link[=bread_prior]{bread_prior()}} (conjugate backend only).} + +\item{backend}{Replacement backend. Note that a \code{"brms"} refit recompiles +the Stan model; use \code{"conjugate"} for permutation work.} + +\item{...}{Passed to the brms backend when \code{backend = "brms"}.} +} +\value{ +A new \link{BreadFit}. The \code{mapping}, \code{features}, \code{mode}, \code{assay_name} +and \code{input_scale} slots are carried over unchanged; \code{diagnostics} gains a +\code{refit_of} timestamp naming the parent fit. +} +\description{ +Repeats the modelling step of \code{\link[=fit_bread]{fit_bread()}} on a fit you already have, +reusing its region-by-sample matrix. Probe-to-region mapping and region +summarization — by far the expensive parts — are never repeated. +} +\details{ +Every argument defaults to \code{NULL}, meaning "keep what the original fit +used". Supply only what changes. +} +\section{Why this exists}{ + +Label-permutation calibration is the natural way to check a posterior at +small n: shuffle the group labels a few hundred times and see where the +observed effect falls in the resulting null. That needs the region matrix +computed once and only the fit repeated. Without a public entry point the +only route was \code{BREAD:::fit_bread_summary()}, which is exactly the sort of +thing users should not have to reach for. + +\if{html}{\out{
}}\preformatted{nulls <- vapply(permutations, function(g) \{ + cd <- coldata; cd$genotype <- g + results(refit_bread(fit, colData = cd))$prob_hyper[i] +\}, numeric(1)) +}\if{html}{\out{
}} +} + +\section{Re-thresholding is free}{ + +When only \code{delta}, \code{prob_cutoff}, \code{rope_cutoff}, \code{ci} or \code{ref_beta} change, +the model is not re-fitted at all — the stored posterior is re-summarized +and re-classified. So sweeping a delta x cutoff grid costs essentially +nothing. +} + +\examples{ +suppressPackageStartupMessages(library(SummarizedExperiment)) + +se <- readRDS(system.file("extdata", "vitc_ag06561.rds", package = "BREAD")) +reg <- readRDS(system.file("extdata", "vitc_regions.rds", package = "BREAD")) +se_ctrl <- se[, se$condition == "ctrl"] + +fit <- fit_bread(se_ctrl, reg, ~ passage) + +# Re-threshold without re-fitting anything +table(results(refit_bread(fit, delta = 0.25))$classification) + +# Relax only the equivalence bar +table(results(refit_bread(fit, rope_cutoff = 0.80))$classification) + +# Re-fit against shuffled labels (one draw from a permutation null) +cd <- as.data.frame(colData(se_ctrl)) +cd$passage <- sample(cd$passage) +head(results(refit_bread(fit, colData = cd))$prob_hyper) +} +\seealso{ +\code{\link[=fit_bread]{fit_bread()}}, \code{\link[=posterior_summary]{posterior_summary()}}, \code{\link[=classify_regions]{classify_regions()}} +} diff --git a/tests/testthat/helper-toy.R b/tests/testthat/helper-toy.R index a18d0f4..fbd69b6 100644 --- a/tests/testthat/helper-toy.R +++ b/tests/testthat/helper-toy.R @@ -15,7 +15,10 @@ cd <- S4Vectors::DataFrame( group = factor(rep(c("young", "old"), length.out = n_samples), levels = c("young", "old")), - sex = factor(rep(c("F", "M"), length.out = n_samples), + # Period 4 against group's period 2, so `~ group + sex` is full rank. + # (When both alternated, the two were perfectly collinear and any design + # using both silently fell back on the prior.) + sex = factor(rep(c("F", "F", "M", "M"), length.out = n_samples), levels = c("F", "M")), row.names = colnames(m) ) diff --git a/tests/testthat/test-classes.R b/tests/testthat/test-classes.R index 1612b32..99f2985 100644 --- a/tests/testthat/test-classes.R +++ b/tests/testthat/test-classes.R @@ -39,3 +39,18 @@ test_that("BreadResults() rejects non-BreadFit input", { expect_error(BreadResults(data.frame(x = 1)), "must be a BreadFit") expect_error(BreadResults(NULL), "must be a BreadFit") }) + +test_that("the model list shape is a stable contract", { + # refit_bread(), posterior_summary() and plot_region_data() all reach into + # these names. Pin them so a backend refactor cannot quietly break them. + fit <- suppressMessages( + fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group) + ) + expect_identical( + names(fit@model), + c("fits", "design_matrix", "coef_names", "contrast", "contrast_idx", + "region_ids", "prior", "region_mat", "design", "coldata") + ) + expect_true(is.matrix(fit@model$region_mat)) + expect_identical(rownames(fit@model$region_mat), fit@model$region_ids) +}) diff --git a/tests/testthat/test-classify.R b/tests/testthat/test-classify.R index 7707c23..9176389 100644 --- a/tests/testthat/test-classify.R +++ b/tests/testthat/test-classify.R @@ -1,73 +1,175 @@ # classify_regions() applies the decision rule; it does not recompute # posterior probabilities. These tests drive it with hand-built posterior # tables so the boundaries are exact rather than approximate. +# +# prob_hyper, prob_hypo and prob_rope partition the posterior, so fixtures +# must sum to 1 -- an incoherent triple can exercise states the sampler can +# never reach and would let a real bug hide. `%|NULL|%` <- function(a, b) if (is.null(a)) b else a -.fake_post <- function(p_gt, p_lt, ids = NULL) { +.fake_post <- function(p_gt, p_lt, p_rope = NULL, ids = NULL) { n <- length(p_gt) - data.frame( - region_id = ids %|NULL|% sprintf("r%02d", seq_len(n)), - prob_hyper = p_gt, - prob_hypo = p_lt, + out <- data.frame( + region_id = ids %|NULL|% sprintf("r%02d", seq_len(n)), + prob_hyper = p_gt, + prob_hypo = p_lt, stringsAsFactors = FALSE ) + if (!is.null(p_rope)) out$prob_rope <- p_rope + out } +# Uniform draws from the 2-simplex (Dirichlet(1,1,1)). +.coherent_post <- function(n, seed = 42L) { + withr::with_seed(seed, { + e <- matrix(stats::rexp(3L * n), ncol = 3L) + p <- e / rowSums(e) + }) + .fake_post(p[, 1L], p[, 2L], p[, 3L]) +} + + test_that("classification levels are exact and in a fixed order", { - out <- classify_regions(.fake_post(c(0.99, 0.01, 0.5), c(0.01, 0.99, 0.5))) + out <- classify_regions( + .fake_post(c(0.99, 0.01, 0.02, 0.34), + c(0.01, 0.99, 0.02, 0.33), + c(0.00, 0.00, 0.96, 0.33)) + ) expect_s3_class(out$classification, "factor") expect_identical( levels(out$classification), - c("hypermethylated", "hypomethylated", "inconclusive") + c("hypermethylated", "hypomethylated", "unchanged", "inconclusive") ) expect_identical( as.character(out$classification), - c("hypermethylated", "hypomethylated", "inconclusive") + c("hypermethylated", "hypomethylated", "unchanged", "inconclusive") ) }) +test_that("the motivating case is called unchanged, not inconclusive", { + # REGULON_promoter from the mousearray_609G CArG analysis: the posterior + # sits almost entirely inside the ROPE. Before the fourth level existed + # this was labelled `inconclusive`, indistinguishable from a region whose + # posterior spanned the whole line. + out <- classify_regions(.fake_post(0.021, 0.021, 0.958), prob_cutoff = 0.95) + expect_identical(as.character(out$classification), "unchanged") +}) + test_that("the cutoff comparison is inclusive (>=), not strict", { - at <- classify_regions(.fake_post(0.95, 0.0), prob_cutoff = 0.95) - below <- classify_regions(.fake_post(0.95 - 1e-12, 0.0), prob_cutoff = 0.95) + at <- classify_regions(.fake_post(0.95, 0.0, 0.05), prob_cutoff = 0.95) + below <- classify_regions(.fake_post(0.95 - 1e-12, 0.0, 0.05), + prob_cutoff = 0.95) expect_identical(as.character(at$classification), "hypermethylated") expect_identical(as.character(below$classification), "inconclusive") + + rope_at <- classify_regions(.fake_post(0.02, 0.03, 0.95), + rope_cutoff = 0.95) + rope_below <- classify_regions(.fake_post(0.02, 0.03, 0.95 - 1e-12), + rope_cutoff = 0.95) + expect_identical(as.character(rope_at$classification), "unchanged") + expect_identical(as.character(rope_below$classification), "inconclusive") +}) + +test_that("at sane cutoffs the four classes are mutually exclusive", { + post <- .coherent_post(10000L) + cls <- classify_regions(post, prob_cutoff = 0.95, + rope_cutoff = 0.95)$classification + n_clearing <- (post$prob_hyper >= 0.95) + + (post$prob_hypo >= 0.95) + + (post$prob_rope >= 0.95) + expect_true(all(n_clearing <= 1L)) + expect_false(any(is.na(cls))) + # Every row that clears something is labelled, and nothing else is + expect_identical(cls != "inconclusive", n_clearing == 1L) }) -test_that("a stricter cutoff only ever moves regions to inconclusive", { - set.seed(42) - post <- .fake_post(runif(200), runif(200)) - loose <- classify_regions(post, prob_cutoff = 0.80)$classification +test_that("tightening both bars only ever moves regions to inconclusive", { + post <- .coherent_post(500L) + loose <- classify_regions(post, prob_cutoff = 0.60)$classification strict <- classify_regions(post, prob_cutoff = 0.99)$classification moved <- loose != strict expect_true(all(strict[moved] == "inconclusive")) }) +test_that("rope_cutoff moves only the equivalence bar", { + post <- .coherent_post(500L) + base <- classify_regions(post, prob_cutoff = 0.95)$classification + looser <- classify_regions(post, prob_cutoff = 0.95, + rope_cutoff = 0.70)$classification + # Directional calls are untouched ... + dir_base <- base %in% c("hypermethylated", "hypomethylated") + dir_loose<- looser %in% c("hypermethylated", "hypomethylated") + expect_identical(dir_base, dir_loose) + # ... and the only movement is inconclusive -> unchanged + moved <- base != looser + expect_true(all(base[moved] == "inconclusive")) + expect_true(all(looser[moved] == "unchanged")) + expect_true(any(moved)) + + # It defaults to prob_cutoff + expect_identical( + classify_regions(post, prob_cutoff = 0.8)$classification, + classify_regions(post, prob_cutoff = 0.8, rope_cutoff = 0.8)$classification + ) +}) + test_that("failed fits (NA probabilities) become inconclusive, never NA", { out <- classify_regions(.fake_post(c(NA, 0.99), c(NA, 0.001))) expect_false(any(is.na(out$classification))) expect_identical(as.character(out$classification)[1], "inconclusive") }) -test_that("when both tails clear the cutoff the larger probability wins", { - out <- classify_regions(.fake_post(c(0.60, 0.40), c(0.40, 0.60)), - prob_cutoff = 0.30) +test_that("an NA posterior is never called unchanged", { + # A missing posterior is absence of evidence, not evidence of equivalence. + out <- classify_regions(.fake_post(NA_real_, NA_real_, 1.0)) + expect_identical(as.character(out$classification), "inconclusive") +}) + +test_that("when several classes clear a low cutoff the largest wins", { + out <- classify_regions( + .fake_post(c(0.40, 0.31, 0.31), c(0.31, 0.40, 0.31), c(0.29, 0.29, 0.38)), + prob_cutoff = 0.30, rope_cutoff = 0.30 + ) expect_identical(as.character(out$classification), - c("hypermethylated", "hypomethylated")) + c("hypermethylated", "hypomethylated", "unchanged")) + + # Exact ties resolve hyper > hypo > unchanged, as before the fourth level + tie <- classify_regions(.fake_post(1/3, 1/3, 1/3), prob_cutoff = 0.30) + expect_identical(as.character(tie$classification), "hypermethylated") +}) + +test_that("prob_rope is derived when absent and clamped when incoherent", { + # Hand-built two-column tables remain a legitimate input + derived <- classify_regions(.fake_post(0.01, 0.01), rope_cutoff = 0.95) + expect_identical(as.character(derived$classification), "unchanged") + + # hyper + hypo > 1 cannot happen from a real posterior, but must not + # produce a negative ROPE mass or an NA class + bad <- classify_regions(.fake_post(0.8, 0.8), prob_cutoff = 0.95) + expect_identical(as.character(bad$classification), "inconclusive") + + # A supplied prob_rope is authoritative over the complement + supplied <- classify_regions(.fake_post(0.01, 0.01, 0.10), + rope_cutoff = 0.95) + expect_identical(as.character(supplied$classification), "inconclusive") }) -test_that("delta and prob_cutoff are recorded as attributes", { +test_that("delta and both cutoffs are recorded as attributes", { out <- classify_regions(.fake_post(0.99, 0.0), delta = 0.25, - prob_cutoff = 0.9) + prob_cutoff = 0.9, rope_cutoff = 0.7) expect_equal(attr(out, "delta"), 0.25) expect_equal(attr(out, "prob_cutoff"), 0.9) + expect_equal(attr(out, "rope_cutoff"), 0.7) }) test_that("bad input is rejected with an informative error", { expect_error(classify_regions("nope"), "data.frame") expect_error(classify_regions(data.frame(x = 1)), "missing required columns") expect_error(classify_regions(.fake_post(0.9, 0.1), prob_cutoff = 1), - "must be in \\(0, 1\\)") + "`prob_cutoff` must be in \\(0, 1\\)") expect_error(classify_regions(.fake_post(0.9, 0.1), prob_cutoff = 0), - "must be in \\(0, 1\\)") + "`prob_cutoff` must be in \\(0, 1\\)") + expect_error(classify_regions(.fake_post(0.9, 0.1), rope_cutoff = 1), + "`rope_cutoff` must be in \\(0, 1\\)") }) diff --git a/tests/testthat/test-coerce.R b/tests/testthat/test-coerce.R new file mode 100644 index 0000000..b8b56cd --- /dev/null +++ b/tests/testthat/test-coerce.R @@ -0,0 +1,187 @@ +# Matrix input has to reach exactly the same answer as SummarizedExperiment +# input -- otherwise the sesame workflow is a second, subtly different code +# path rather than a convenience. + +.toy_parts <- function() { + se <- .make_toy_signal_se() + list( + se = se, + mat = SummarizedExperiment::assay(se, "M"), + cd = as.data.frame(SummarizedExperiment::colData(se)), + gr = SummarizedExperiment::rowRanges(se) + ) +} + +test_that("matrix input and SE input give identical results", { + p <- .toy_parts() + gr_feat <- .make_toy_features() + + fit_se <- suppressMessages(fit_bread(p$se, gr_feat, ~ group)) + fit_m <- suppressMessages( + fit_bread(p$mat, gr_feat, ~ group, colData = p$cd, rowRanges = p$gr) + ) + + expect_equal(results(fit_m), results(fit_se)) + expect_equal(fit_m@posterior, fit_se@posterior) + expect_equal(fit_m@mapping, fit_se@mapping) + expect_identical(fit_m@input_scale, fit_se@input_scale) +}) + +test_that("bread_se() round-trips a decomposed SummarizedExperiment", { + p <- .toy_parts() + se2 <- bread_se(p$mat, colData = p$cd, rowRanges = p$gr) + expect_s4_class(se2, "SummarizedExperiment") + expect_equal(SummarizedExperiment::assay(se2, "M"), p$mat) + expect_equal(nrow(SummarizedExperiment::colData(se2)), ncol(p$mat)) + expect_identical(names(SummarizedExperiment::rowRanges(se2)), rownames(p$mat)) +}) + +test_that("a sesameData-style list is unwrapped", { + p <- .toy_parts() + se2 <- bread_se(list(betas = p$mat, sampleInfo = p$cd), rowRanges = p$gr) + expect_s4_class(se2, "SummarizedExperiment") + expect_true("group" %in% colnames(SummarizedExperiment::colData(se2))) +}) + +test_that("the assay is named from the value range, as fit_bread expects", { + p <- .toy_parts() + se_m <- bread_se(p$mat, colData = p$cd, rowRanges = p$gr) + expect_identical(SummarizedExperiment::assayNames(se_m), "M") + + betas <- 2^p$mat / (2^p$mat + 1) + se_b <- bread_se(betas, colData = p$cd, rowRanges = p$gr) + expect_identical(SummarizedExperiment::assayNames(se_b), "betas") +}) + + +# ---- rowRanges alignment --------------------------------------------------- + +test_that("a named manifest is subset and reordered to the matrix rows", { + p <- .toy_parts() + shuffled <- p$gr[sample(length(p$gr))] + extra <- p$gr[1:3] + names(extra) <- paste0("zz", 1:3) + manifest <- c(shuffled, extra) # longer, out of order + + se2 <- bread_se(p$mat, colData = p$cd, rowRanges = manifest) + expect_identical(names(SummarizedExperiment::rowRanges(se2)), rownames(p$mat)) + expect_equal(SummarizedExperiment::rowRanges(se2), p$gr) +}) + +test_that("probes absent from the manifest are dropped with a message", { + p <- .toy_parts() + partial <- p$gr[1:15] # 5 probes have no coordinates + expect_message( + se2 <- bread_se(p$mat, colData = p$cd, rowRanges = partial), + "Dropping 5 of 20 probes" + ) + expect_equal(nrow(se2), 15L) +}) + +test_that("an entirely mismatched manifest errors rather than dropping all", { + p <- .toy_parts() + wrong <- p$gr + names(wrong) <- paste0("nope", seq_along(wrong)) + expect_error(bread_se(p$mat, colData = p$cd, rowRanges = wrong), + "None of `rownames\\(x\\)`") +}) + +test_that("an unnamed rowRanges must match the row count exactly", { + p <- .toy_parts() + unnamed <- p$gr; names(unnamed) <- NULL + se2 <- bread_se(p$mat, colData = p$cd, rowRanges = unnamed) + expect_identical(names(SummarizedExperiment::rowRanges(se2)), rownames(p$mat)) + + expect_error(bread_se(p$mat, colData = p$cd, rowRanges = unnamed[1:5]), + "one range per row") +}) + + +# ---- colData alignment ----------------------------------------------------- + +test_that("colData is reordered by rownames, not trusted positionally", { + p <- .toy_parts() + shuffled <- p$cd[sample(nrow(p$cd)), , drop = FALSE] + + ordered <- bread_se(p$mat, colData = p$cd, rowRanges = p$gr) + reorder <- bread_se(p$mat, colData = shuffled, rowRanges = p$gr) + expect_equal(SummarizedExperiment::colData(reorder), + SummarizedExperiment::colData(ordered)) +}) + +test_that("colData that does not cover every sample errors", { + p <- .toy_parts() + expect_error( + bread_se(p$mat, colData = p$cd[1:4, , drop = FALSE], rowRanges = p$gr), + "no row for" + ) +}) + +test_that("colData without rownames is accepted but warns", { + p <- .toy_parts() + bare <- p$cd; rownames(bare) <- NULL + expect_warning(bread_se(p$mat, colData = bare, rowRanges = p$gr), + "assuming its rows are in the same order") +}) + + +# ---- refusals -------------------------------------------------------------- + +test_that("coordinates are never guessed from probe IDs", { + p <- .toy_parts() + expect_error(bread_se(p$mat, colData = p$cd), "does not guess the platform") +}) + +test_that("matrix-only arguments are rejected alongside an SE", { + p <- .toy_parts() + expect_error(bread_se(p$se, colData = p$cd), "supplied alongside") + expect_error(bread_se(p$se, rowRanges = p$gr), "supplied alongside") + expect_error(bread_se(p$se, platform = "EPIC"),"supplied alongside") + expect_s4_class(bread_se(p$se), "SummarizedExperiment") +}) + +test_that("a matrix without dimnames is rejected", { + p <- .toy_parts() + m <- p$mat; rownames(m) <- NULL + expect_error(bread_se(m, colData = p$cd, rowRanges = p$gr), "rownames") + + m2 <- p$mat; colnames(m2) <- NULL + expect_error(bread_se(m2, colData = p$cd, rowRanges = p$gr), "colnames") +}) + +test_that("unsupported input still names SummarizedExperiment in the error", { + # test-smoke.R relies on this string + expect_error(bread_se(NULL), "SummarizedExperiment") + expect_error(fit_bread(NULL, NULL, ~ 1), "SummarizedExperiment") +}) + +test_that("the platform route reaches sesameData", { + skip_on_cran() + skip_on_ci() + skip_if_not_installed("sesameData") + # Probe IDs are taken from the manifest itself, so this tests the lookup + # rather than whether some other dataset happens to share its ID + # convention. (The packaged vitc subset does not: it carries stripped + # EPICv2 IDs while the manifest keeps the replicate suffix.) + man <- sesameData::sesameData_getManifestGRanges("EPICv2") + skip_if(length(man) == 0L, "EPICv2 manifest unavailable offline") + + ids <- names(man)[seq_len(50L)] + mat <- matrix(stats::runif(50L * 4L), nrow = 50L, + dimnames = list(ids, sprintf("S%d", 1:4))) + cd <- data.frame(group = rep(c("a", "b"), 2), row.names = colnames(mat)) + + se2 <- suppressMessages(bread_se(mat, colData = cd, platform = "EPICv2")) + expect_s4_class(se2, "SummarizedExperiment") + expect_equal(nrow(se2), 50L) + expect_identical(names(SummarizedExperiment::rowRanges(se2)), ids) + expect_identical(SummarizedExperiment::assayNames(se2), "betas") +}) + +test_that("stripped EPICv2 suffixes get a specific diagnosis", { + p <- .toy_parts() + manifest <- p$gr + names(manifest) <- paste0(names(manifest), "_BC11") + expect_error(bread_se(p$mat, colData = p$cd, rowRanges = manifest), + "EPICv2 replicate suffixes") +}) diff --git a/tests/testthat/test-fit-summary.R b/tests/testthat/test-fit-summary.R index 14baea6..3a22f9e 100644 --- a/tests/testthat/test-fit-summary.R +++ b/tests/testthat/test-fit-summary.R @@ -52,13 +52,19 @@ test_that("posterior_summary recovers sign and orders true effects", { }) test_that("classify_regions recovers truth with strong signal", { + # The ROPE call needs the whole posterior inside +/- delta, which is a much + # tighter demand than a directional call. At the original sigma = 0.2 the + # contrast SE was ~0.052 and a true null landed on prob_rope ~0.948, two + # thousandths under the cutoff -- a coin flip. sigma = 0.08 puts the SE at + # ~0.021, so even a null that happens to sit 2 SE off zero still carries + # >0.99 of its mass inside the ROPE. sim <- .sim_region_mat( n_samples = 60L, true_betas = c(rep(0, 3), # nulls rep(0.8, 3), # hyper rep(-0.8, 3), # hypo rep(0.02, 3)), # weak (below delta) - seed = 42L, sigma = 0.2 + seed = 42L, sigma = 0.08 ) fit <- fit_bread_summary(sim$mat, sim$coldata, design = ~ group, contrast = "groupold") @@ -66,10 +72,12 @@ test_that("classify_regions recovers truth with strong signal", { cls <- classify_regions(post, delta = 0.10, prob_cutoff = 0.95) got <- as.character(cls$classification) - expect_true(all(got[1:3] == "inconclusive"), info = paste(got[1:3], collapse=",")) + # The nulls and the sub-delta regions were always *scientifically* + # unchanged; calling them `inconclusive` was the defect this class fixes. + expect_true(all(got[1:3] == "unchanged"), info = paste(got[1:3], collapse=",")) expect_true(all(got[4:6] == "hypermethylated"), info = paste(got[4:6], collapse=",")) expect_true(all(got[7:9] == "hypomethylated"), info = paste(got[7:9], collapse=",")) - expect_true(all(got[10:12] == "inconclusive"), info = paste(got[10:12],collapse=",")) + expect_true(all(got[10:12] == "unchanged"), info = paste(got[10:12],collapse=",")) expect_identical(attr(cls, "delta"), 0.10) expect_identical(attr(cls, "prob_cutoff"), 0.95) }) diff --git a/tests/testthat/test-kycg.R b/tests/testthat/test-kycg.R index 99f77a7..d74438d 100644 --- a/tests/testthat/test-kycg.R +++ b/tests/testthat/test-kycg.R @@ -25,3 +25,52 @@ test_that("the fit exposes the mapping columns bread_kycg() reads", { expect_true(all(c("probe_id", "region_id") %in% colnames(fit@mapping))) expect_type(fit@mapping$probe_id, "character") }) + +# The real group titles as registered by knowYourCG (verified against the +# installed release). Used as a fixture so default-database selection is +# testable without touching ExperimentHub. +.KYCG_TITLES_MM285 <- c( + "KYCG.MM285.chromHMM.20210210", + "KYCG.MM285.chromosome.mm10.20210630", + "KYCG.MM285.designGroup.20210210", + "KYCG.MM285.HMconsensus.20220116", + "KYCG.MM285.Mask.20220123", + "KYCG.MM285.metagene.20220126", + "KYCG.MM285.probeType.20210630", + "KYCG.MM285.seqContext.20210630", + "KYCG.MM285.seqContextN.20210630", + "KYCG.MM285.TFBSconsensus.20220116", + "KYCG.MM285.tissueSignature.20211211" +) + +test_that("mouse default databases actually match the real MM285 titles", { + # The regression: the old pattern required a literal "." after "TFBS", so + # it could never match "KYCG.MM285.TFBSconsensus.20220116" and mouse users + # silently received an empty data.frame. + dbs <- BREAD:::.kycg_default_dbs("MM285", .KYCG_TITLES_MM285) + + expect_true("KYCG.MM285.TFBSconsensus.20220116" %in% dbs) + expect_true("KYCG.MM285.chromHMM.20210210" %in% dbs) + expect_true("KYCG.MM285.HMconsensus.20220116" %in% dbs) + expect_length(dbs, 6L) +}) + +test_that("technical annotation groups are deliberately excluded", { + dbs <- BREAD:::.kycg_default_dbs("MM285", .KYCG_TITLES_MM285) + for (junk in c("Mask", "chromosome", "probeType", "seqContext")) { + expect_false(any(grepl(junk, dbs, fixed = TRUE)), info = junk) + } +}) + +test_that("default selection returns nothing for an unlisted platform", { + expect_length(BREAD:::.kycg_default_dbs("EPIC", .KYCG_TITLES_MM285), 0L) + expect_length(BREAD:::.kycg_default_dbs("MM285", character(0)), 0L) +}) + +test_that("human platforms select the documented families", { + titles <- c("KYCG.EPIC.TFBS.20210210", "KYCG.EPIC.chromHMM.20211020", + "KYCG.EPIC.CGI.20210713", "KYCG.EPIC.Mask.20220123") + dbs <- BREAD:::.kycg_default_dbs("EPIC", titles) + expect_length(dbs, 3L) + expect_false(any(grepl("Mask", dbs, fixed = TRUE))) +}) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index 30e3a78..29a38b5 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -19,7 +19,7 @@ test_that("classifications() names line up with results() region ids", { expect_identical(names(cls), as.character(res$region_id)) expect_identical(unname(cls), as.character(res$classification)) expect_true(all(cls %in% c("hypermethylated", "hypomethylated", - "inconclusive"))) + "unchanged", "inconclusive"))) }) test_that("posterior_draws() is reproducible for a fixed seed", { diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R index 6a13b00..9debfc5 100644 --- a/tests/testthat/test-plots.R +++ b/tests/testthat/test-plots.R @@ -1,6 +1,7 @@ test_that("bread_colors() returns expected palettes", { cl <- bread_colors("classification") - expect_named(cl, c("hypermethylated", "hypomethylated", "inconclusive")) + expect_named(cl, c("hypermethylated", "hypomethylated", + "unchanged", "inconclusive")) expect_match(cl, "^#[0-9a-fA-F]{6}$") gr <- bread_colors("group") diff --git a/tests/testthat/test-posterior.R b/tests/testthat/test-posterior.R index 73ba0dd..e3e3299 100644 --- a/tests/testthat/test-posterior.R +++ b/tests/testthat/test-posterior.R @@ -2,9 +2,13 @@ # classification rule. Its column contract is what downstream code and the # BreadFit results table both depend on. +# Spelled out independently of the package's own .POST_COLS -- that is the +# point of a contract test. POST_COLS <- c("region_id", "n", "mean_effect", "median_effect", "ci_lo", "ci_hi", "df", "scale", "prob_pos", "prob_neg", - "prob_hyper", "prob_hypo", "error") + "prob_hyper", "prob_hypo", "prob_rope", + "ref_beta", "mean_dbeta", "dbeta_lo", "dbeta_hi", "delta_beta", + "error") .toy_fit <- function() { fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group) @@ -66,3 +70,119 @@ test_that("bad input is rejected", { expect_error(posterior_summary(fit, ci = 0), "must be in \\(0, 1\\)") expect_error(posterior_summary(fit, ci = 1), "must be in \\(0, 1\\)") }) + + +# ---- prob_rope ------------------------------------------------------------- + +test_that("the three posterior masses partition the line", { + post <- posterior_summary(.toy_fit()) + ok <- !is.na(post$prob_hyper) + expect_equal(post$prob_hyper[ok] + post$prob_hypo[ok] + post$prob_rope[ok], + rep(1, sum(ok)), tolerance = 1e-12) + expect_true(all(post$prob_rope[ok] >= 0 & post$prob_rope[ok] <= 1)) + expect_identical(is.na(post$prob_rope), is.na(post$prob_hyper)) +}) + +test_that("a wider ROPE can only absorb more posterior mass", { + fit <- .toy_fit() + small <- posterior_summary(fit, delta = 0.05) + large <- posterior_summary(fit, delta = 0.50) + ok <- !is.na(small$prob_rope) + expect_true(all(large$prob_rope[ok] >= small$prob_rope[ok] - 1e-12)) +}) + +test_that("a zero-width ROPE holds no mass", { + post <- posterior_summary(.toy_fit(), delta = 0) + ok <- !is.na(post$prob_rope) + expect_equal(post$prob_rope[ok], rep(0, sum(ok)), tolerance = 1e-12) +}) + + +# ---- beta-scale columns ---------------------------------------------------- + +test_that("beta columns are the linearisation of the M-scale columns", { + post <- posterior_summary(.toy_fit(), delta = 0.10) + ok <- !is.na(post$ref_beta) + expect_true(any(ok)) + expect_true(all(post$ref_beta[ok] > 0 & post$ref_beta[ok] < 1)) + + k <- post$ref_beta[ok] * (1 - post$ref_beta[ok]) * log(2) + expect_equal(post$mean_dbeta[ok], post$mean_effect[ok] * k) + expect_equal(post$dbeta_lo[ok], post$ci_lo[ok] * k) + expect_equal(post$dbeta_hi[ok], post$ci_hi[ok] * k) + expect_equal(post$delta_beta[ok], 0.10 * k) + expect_true(all(post$dbeta_lo[ok] <= post$dbeta_hi[ok])) +}) + +test_that("one multiplier keeps the beta scale consistent with the M scale", { + # The whole reason for a single linearisation rather than an exact secant: + # the beta comparison must never contradict the classification beside it. + post <- posterior_summary(.toy_fit(), delta = 0.10) + ok <- !is.na(post$ref_beta) + expect_identical(post$mean_effect[ok] > 0.10, + post$mean_dbeta[ok] > post$delta_beta[ok]) +}) + +test_that("ref_beta accepts a scalar and a named vector", { + fit <- .toy_fit() + ids <- posterior_summary(fit)$region_id + + flat <- posterior_summary(fit, ref_beta = 0.3) + expect_equal(flat$ref_beta, rep(0.3, nrow(flat))) + + named <- stats::setNames(seq(0.2, 0.4, length.out = length(ids)), ids) + byid <- posterior_summary(fit, ref_beta = named) + expect_equal(byid$ref_beta, unname(named[byid$region_id])) +}) + +test_that("ref_beta rejects impossible values and ambiguous lengths", { + fit <- .toy_fit() + expect_error(posterior_summary(fit, ref_beta = 0), "must be in \\(0, 1\\)") + expect_error(posterior_summary(fit, ref_beta = 1.2), "must be in \\(0, 1\\)") + expect_error(posterior_summary(fit, ref_beta = c(0.3, 0.4, 0.5)), + "named by region_id") +}) + +test_that("beta columns are NA when no region matrix is available", { + m <- .toy_fit()@model + m$region_mat <- NULL + post <- posterior_summary(m) + expect_true(all(is.na(post$ref_beta))) + expect_true(all(is.na(post$mean_dbeta))) + # ... but the M-scale results are untouched + expect_false(all(is.na(post$mean_effect))) +}) + +test_that("pc1 scores get no beta translation", { + fit <- suppressMessages( + fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group, + summary_fun = "pc1") + ) + expect_message(post <- posterior_summary(fit), "PC1 scores are not M-values") + expect_true(all(is.na(post$ref_beta))) + expect_true(all(is.na(post$delta_beta))) + # An explicit anchor overrides the refusal + post2 <- posterior_summary(fit, ref_beta = 0.5) + expect_true(all(!is.na(post2$delta_beta))) +}) + + +# ---- exported converters --------------------------------------------------- + +test_that("bread_delta_beta matches the documented arithmetic", { + # The corrected value: 0.10 M-units is ~1.7 percentage points at beta = 0.5, + # NOT 3.5 (that is the width of the full +/-delta window). + expect_equal(bread_delta_beta(0.10), 0.10 * 0.25 * log(2)) + expect_equal(round(bread_delta_beta(0.10), 3), 0.017) + + # Scale dependence: the translation shrinks toward the extremes + v <- bread_delta_beta(0.10, ref_beta = c(0.5, 0.2, 0.1)) + expect_true(all(diff(v) < 0)) + + # Round trip + expect_equal(bread_delta_m(bread_delta_beta(0.10, 0.3), 0.3), 0.10) + expect_equal(bread_delta_beta(bread_delta_m(0.02, 0.4), 0.4), 0.02) + + expect_error(bread_delta_beta(0.1, ref_beta = 0), "must be in \\(0, 1\\)") + expect_error(bread_delta_m(0.1, ref_beta = 1), "must be in \\(0, 1\\)") +}) diff --git a/tests/testthat/test-refit.R b/tests/testthat/test-refit.R new file mode 100644 index 0000000..0c7113d --- /dev/null +++ b/tests/testthat/test-refit.R @@ -0,0 +1,121 @@ +# refit_bread() exists so that label-permutation calibration does not have to +# recompute the region matrix, and does not have to reach into the namespace. +# The load-bearing property is therefore: the matrix is reused, never rebuilt. + +.refit_fit <- function() { + suppressMessages(fit_bread(.make_toy_signal_se(), .make_toy_features(), + ~ group)) +} + +test_that("a no-op refit reproduces the original exactly", { + fit <- .refit_fit() + re <- refit_bread(fit) + expect_equal(re@posterior, fit@posterior) + expect_equal(results(re), results(fit)) + expect_identical(re@params$contrast, fit@params$contrast) +}) + +test_that("nothing is re-summarized", { + fit <- .refit_fit() + re <- refit_bread(fit, delta = 0.5) + # The proof that mapping/summarization did not run again + expect_identical(re@model$region_mat, fit@model$region_mat) + expect_identical(re@mapping, fit@mapping) + expect_identical(re@features, fit@features) +}) + +test_that("re-thresholding matches doing it by hand", { + fit <- .refit_fit() + re <- refit_bread(fit, delta = 0.05, prob_cutoff = 0.8, rope_cutoff = 0.6, + ci = 0.9) + hand <- classify_regions( + posterior_summary(fit@model, delta = 0.05, ci = 0.9), + delta = 0.05, prob_cutoff = 0.8, rope_cutoff = 0.6 + ) + expect_equal(results(re), hand) + expect_equal(re@params$delta, 0.05) + expect_equal(re@params$ci, 0.9) + expect_equal(re@params$rope_cutoff, 0.6) +}) + +test_that("unspecified settings are inherited from the parent fit", { + fit <- suppressMessages( + fit_bread(.make_toy_signal_se(), .make_toy_features(), ~ group, + delta = 0.3, prob_cutoff = 0.9, rope_cutoff = 0.7, ci = 0.8) + ) + re <- refit_bread(fit) + expect_equal(re@params$delta, 0.3) + expect_equal(re@params$prob_cutoff, 0.9) + expect_equal(re@params$rope_cutoff, 0.7) + expect_equal(re@params$ci, 0.8) +}) + +test_that("a permuted colData changes the fit but not the region matrix", { + fit <- .refit_fit() + cd <- as.data.frame(fit@model$coldata) + cd$group <- rev(cd$group) + + re <- refit_bread(fit, colData = cd) + expect_identical(re@model$region_mat, fit@model$region_mat) + expect_false(isTRUE(all.equal(results(re)$mean_effect, + results(fit)$mean_effect))) + expect_identical(re@diagnostics$refit_of, fit@diagnostics$timestamp) +}) + +test_that("colData is matched by rowname, not position", { + fit <- .refit_fit() + cd <- as.data.frame(fit@model$coldata) + shuffled <- cd[sample(nrow(cd)), , drop = FALSE] + + # Same information, different row order -- must give the same answer + expect_equal(results(refit_bread(fit, colData = shuffled)), + results(refit_bread(fit, colData = cd))) +}) + +test_that("a mis-sized or disjoint colData is rejected", { + fit <- .refit_fit() + cd <- as.data.frame(fit@model$coldata) + expect_error(refit_bread(fit, colData = cd[1:3, , drop = FALSE]), + "rows but the region matrix has") + + bad <- cd; rownames(bad) <- paste0("X", seq_len(nrow(bad))) + expect_error(refit_bread(fit, colData = bad), "do not cover every sample") +}) + +test_that("an unknown contrast lists the available coefficients", { + fit <- .refit_fit() + expect_error(refit_bread(fit, contrast = "groupNOPE"), + "not found among design coefficients") +}) + +test_that("a rank-deficient design warns instead of silently regularising", { + fit <- .refit_fit() + cd <- as.data.frame(fit@model$coldata) + cd$dupe <- cd$group # perfectly collinear with group + expect_warning(refit_bread(fit, colData = cd, design = ~ group + dupe), + "rank deficient") +}) + +test_that("refit_bread rejects non-BreadFit input", { + expect_error(refit_bread(list()), "must be a BreadFit") +}) + +test_that("a label-permutation null runs end to end through the public API", { + # The workflow this function exists for, in miniature. + fit <- .refit_fit() + cd <- as.data.frame(fit@model$coldata) + rid <- results(fit)$region_id[1] + obs <- results(fit)$mean_effect[results(fit)$region_id == rid] + + null <- withr::with_seed(7L, vapply(seq_len(24L), function(i) { + cdp <- cd + cdp$group <- sample(cdp$group) + r <- results(refit_bread(fit, colData = cdp)) + r$mean_effect[r$region_id == rid] + }, numeric(1))) + + expect_length(null, 24L) + expect_false(anyNA(null)) + p <- (sum(abs(null) >= abs(obs)) + 1) / (length(null) + 1) + expect_true(p >= 0 && p <= 1) +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 5ae810f..e052caf 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -43,9 +43,10 @@ test_that("assay-name detection follows the documented priority", { test_that("bread_colors() returns the documented shapes", { cl <- bread_colors("classification") - expect_length(cl, 3L) + expect_length(cl, 4L) expect_identical(names(cl), - c("hypermethylated", "hypomethylated", "inconclusive")) + c("hypermethylated", "hypomethylated", + "unchanged", "inconclusive")) grp <- bread_colors("group") expect_length(grp, 2L) From df561c46a6104f476726e28766177ab5e7e4f4ac Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 18:05:01 -0400 Subject: [PATCH 12/17] docs(NEWS): breaking changes and new features for 0.99.0 Documents the four-level classification, the six new results() columns, the n_features_in region-vs-range fix, the fit_bread() first-argument rename, and the palette change, all as breaking changes -- 0.99.0 is unreleased so they land without a deprecation period. --- NEWS.md | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 56 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index fd062f6..6fdf087 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,33 @@ First release candidate, prepared for Bioconductor submission. +## Breaking changes + +0.99.0 is unreleased, so these land without a deprecation period. + +* **`classification` now has four levels**, not three: + `hypermethylated`, `hypomethylated`, **`unchanged`**, `inconclusive`. + `unchanged` means the posterior is concentrated inside the region of + practical equivalence — evidence that a region did *not* move, which + `inconclusive` previously absorbed along with genuinely uninformative + regions. Membership of `hypermethylated` and `hypomethylated` is + unchanged for any `prob_cutoff > 0.5`, so directional filters are + unaffected; only code that counts or filters `inconclusive` sees a + difference, and it sees a more honest one. +* **`results()` gains six columns**: `prob_rope`, `ref_beta`, `mean_dbeta`, + `dbeta_lo`, `dbeta_hi`, `delta_beta`. +* **`n_features_in` now counts distinct region IDs**, not `GRanges` ranges. + When several ranges share a `region_id` — the only way to pin a region to + an exact probe set — the old counter reported the range count, printing + e.g. `n_regions: 788 (of 790 input)` for 30 regions built from 790 probes. + `show()` had the same defect. Results were always correct; the counters + were not. +* **`fit_bread()`'s first argument is renamed `se` to `x`**, since it now + also accepts a matrix. +* The `inconclusive` swatch in `bread_colors("classification")` moved from + olive to neutral grey; `unchanged` took the olive. Absence of information + should not look like a finding. + ## New features * `fit_bread()` — end-to-end pipeline: validate → map → summarize → fit @@ -16,7 +43,35 @@ First release candidate, prepared for Bioconductor submission. * `plot_region_posterior()`, `plot_region_data()`, `plot_feature_set()` — publication-oriented `ggplot2` helpers for BreadFit output. * `bread_kycg()` — KnowYourCG enrichment on the probes in hyper- or - hypo-classified regions via `knowYourCG::testEnrichment()`. + hypo-classified regions via `knowYourCG::testEnrichment()`. Default + knowledgebase selection is now platform-aware: the previous pattern + required a literal `.` after `TFBS`, so it could never match the real + MM285 titles (`KYCG.MM285.TFBSconsensus.20220116`) and mouse users got a + silently empty result. A no-match now warns and lists what *is* available, + and `mtc_by_group` / `mtc_method` are passed through when the installed + knowYourCG supports them. +* `refit_bread()` — re-fit or re-threshold an existing `BreadFit` without + recomputing the probe-to-region mapping or the region summary. Makes + label-permutation calibration a first-class workflow instead of a reason + to call `BREAD:::fit_bread_summary()`. +* **Matrix input.** `fit_bread()` and the new `bread_se()` accept a + probe-by-sample matrix with `colData` plus either `rowRanges` or + `platform`, as well as sesame's `list(betas =, sampleInfo =)` shape — + so `openSesame()` output no longer has to be hand-assembled into a + `SummarizedExperiment` first. The platform is never inferred from probe + IDs: `cg`-numbers are shared across arrays, and a wrong guess would give + wrong coordinates silently. +* `bread_delta_beta()` / `bread_delta_m()` — convert effect sizes between + the M and beta scales, and `results()` now reports a per-region + `delta_beta`. `delta = 0.10` on the M scale is a beta change of about + 0.017 at mid-methylation and less toward the extremes; `fit_bread()` says + so once when handed beta-scale input. +* `ci` and `rope_cutoff` are now `fit_bread()` arguments. `ci` was + previously hardcoded at 0.95, distinct from `prob_cutoff` but not + reachable. +* A rank-deficient design now warns. The conjugate prior absorbs the + deficiency rather than erroring, so such fits previously looked normal + while returning prior-driven estimates for the collinear coefficients. * `bread_colors()` — MetBrewer `Cross` palette embedded as hex (no runtime dependency on the MetBrewer package). * `BreadFit` / `BreadResults` S4 classes with accessors `results()`, From 5f60905b885d37b405281901dfa8b05214d31b30 Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 18:39:26 -0400 Subject: [PATCH 13/17] docs: README, vignettes, pkgdown and DESCRIPTION for the four-level API README gains an explicit section on the unchanged class and on why delta is M-scale only, plus the matrix-input and refit_bread workflows. The vitc vignette n=2 paragraph is rewritten rather than patched: at n=2 almost nothing reaches prob_rope >= 0.95 either, so those regions are unresolved rather than shown to be flat -- which is a sharper statement than the old undifferentiated inconclusive bucket, and the best advertisement for the feature. --- DESCRIPTION | 22 ++-- README.Rmd | 97 ++++++++++++++--- README.md | 219 +++++++++++++++++++++++++++----------- _pkgdown.yml | 13 ++- vignettes/bread-intro.Rmd | 10 +- vignettes/bread-vitc.Rmd | 28 ++++- 6 files changed, 293 insertions(+), 96 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6bf1841..53b3933 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,15 +5,19 @@ Date: 2026-08-09 Authors@R: person("Jaemin", "Park", , "jaemin.park@vai.org", role = c("aut", "cre")) Description: BREAD provides targeted Bayesian inference for predefined DNA - methylation regions using array data stored in SummarizedExperiment - objects. For each user-supplied region, BREAD fits a Bayesian model, - computes posterior probabilities of directional methylation change, - and classifies regions as hypermethylated, hypomethylated, or - inconclusive at user-configurable effect-size and probability - thresholds. Both an analytic conjugate backend and a full MCMC - backend via 'brms' are provided, sharing the same posterior and - classification path. Results can be passed to 'knowYourCG' for - enrichment testing against curated CpG feature databases. + methylation regions using array data, supplied either as a + SummarizedExperiment or as a probe-by-sample matrix. For each + user-supplied region, BREAD fits a Bayesian model and computes + posterior probabilities of directional methylation change and of + practical equivalence, classifying regions as hypermethylated, + hypomethylated, unchanged, or inconclusive at user-configurable + effect-size and probability thresholds. The unchanged class reports + regions whose posterior lies inside the region of practical + equivalence, distinguishing evidence of no change from absence of + evidence. Both an analytic conjugate backend and a full MCMC backend + via 'brms' are provided, sharing the same posterior and classification + path. Results can be passed to 'knowYourCG' for enrichment testing + against curated CpG feature databases. License: MIT + file LICENSE Encoding: UTF-8 Depends: diff --git a/README.Rmd b/README.Rmd index 284bd72..7881897 100644 --- a/README.Rmd +++ b/README.Rmd @@ -27,18 +27,33 @@ knitr::opts_chunk$set( **BREAD** (Bayesian Region-specific DNA methylation inference) provides targeted Bayesian inference for **predefined** DNA methylation regions from -array data stored in `SummarizedExperiment` objects. For each region you -supply, BREAD fits a Bayesian model, computes the posterior probability of a -directional methylation change, and classifies the region as -**hypermethylated**, **hypomethylated**, or **inconclusive** at -user-configurable effect-size and probability thresholds. +array data — a `SummarizedExperiment`, or a plain probe-by-sample matrix as +`sesame::openSesame()` returns. For each region you supply, BREAD fits a +Bayesian model, computes posterior probabilities of methylation change, and +classifies the region as **hypermethylated**, **hypomethylated**, +**unchanged**, or **inconclusive** at user-configurable effect-size and +probability thresholds. Unlike genome-wide DMR callers that scan for regions, BREAD answers a different question: *given regions I already care about (PRC2 targets, CGIs, LADs, a chromHMM state, a custom BED), what is the posterior evidence for methylation change in each one, and how confident am I?* Output is a -per-region posterior — effect size, credible interval, and directional -probabilities — not just a p-value. +per-region posterior — effect size, credible interval, and probabilities — +not just a p-value. + +### The `unchanged` class + +Most tools give you two states: significant, and not-significant. That +conflates *flat* with *underpowered*, which at the sample sizes typical of +experimental epigenetics is most of your genome. + +BREAD reports `prob_rope`, the posterior mass inside the region of practical +equivalence \[−`delta`, +`delta`\], and calls a region **`unchanged`** when +that mass clears `rope_cutoff`. `inconclusive` then means only what its name +says. Being able to state that a region *demonstrably did not move* — with a +credible ceiling on how much it could have — is the one claim a p-value is +structurally unable to make, and it is often the claim a pathway or cascade +argument actually needs. ## Installation @@ -108,21 +123,77 @@ grouping column you want summarized. | `ci_lo`, `ci_hi` | 95% credible interval | | `prob_hyper` | P(effect > +delta) — evidence for hypermethylation | | `prob_hypo` | P(effect < -delta) — evidence for hypomethylation | -| `classification` | `hypermethylated` / `hypomethylated` / `inconclusive` | +| `prob_rope` | P(\|effect\| <= delta) — evidence of *no* change | +| `mean_dbeta`, `dbeta_lo`, `dbeta_hi` | the effect and interval on the beta scale | +| `ref_beta`, `delta_beta` | the anchor used for that translation, and `delta` in beta units | +| `classification` | `hypermethylated` / `hypomethylated` / `unchanged` / `inconclusive` | ```{r results-head} head(res[, c("region_id", "n", "mean_effect", "ci_lo", "ci_hi", - "classification")]) + "prob_rope", "classification")]) ``` -A region is called **hypermethylated** if `prob_hyper >= prob_cutoff`, -**hypomethylated** if `prob_hypo >= prob_cutoff`, otherwise -**inconclusive**. Defaults are `delta = 0.10` (M-scale) and -`prob_cutoff = 0.95`; both are arguments to `fit_bread()`. +The rule: **hypermethylated** if `prob_hyper >= prob_cutoff`, +**hypomethylated** if `prob_hypo >= prob_cutoff`, **unchanged** if +`prob_rope >= rope_cutoff`, otherwise **inconclusive**. The three +probabilities partition the posterior, so at any sensible cutoff exactly one +can apply. Defaults are `delta = 0.10` (M-scale), `prob_cutoff = 0.95`, and +`rope_cutoff = prob_cutoff`. + +`rope_cutoff` is separate for a reason: concluding equivalence requires the +whole posterior to fit inside ±`delta`, which is far stricter than a +directional call. At small n you will often want to relax it on its own, +without also loosening the bar for discovery. `classifications(fit)` returns just the per-region calls, and `posterior_draws(fit)` gives posterior samples for downstream summaries. +### `delta` is on the M scale + +`delta = 0.10` in M-units is a beta change of about **0.017** at +mid-methylation, and *less* toward the extremes (about 0.006 at β = 0.1) — +the local slope dβ/dM = β(1−β)·ln2 is not constant. So a single beta-scale +threshold does not exist; BREAD reports a per-region `delta_beta` instead, +and `bread_delta_beta()` / `bread_delta_m()` convert explicitly when you want +to choose `delta` from a target Δβ. + +```{r delta-scale} +bread_delta_beta(0.10) # at beta = 0.5 +bread_delta_beta(0.10, ref_beta = c(0.5, 0.2, 0.1)) +bread_delta_m(0.02) # delta for a 2-point change +``` + +### Re-thresholding and permutation nulls + +`refit_bread()` reuses a fit's region-by-sample matrix. Changing only +thresholds skips the model fit entirely; supplying new `colData` re-fits +without recomputing the probe-to-region mapping, which is what makes +label-permutation calibration practical. + +```{r refit, eval = FALSE} +# Sweep the equivalence bar for free +table(results(refit_bread(fit, rope_cutoff = 0.80))$classification) + +# One draw from a label-permutation null +cd <- as.data.frame(colData(se_ctrl)) +cd$passage <- sample(cd$passage) +results(refit_bread(fit, colData = cd))$prob_hyper +``` + +### Matrix input + +If your pipeline hands you a matrix rather than a `SummarizedExperiment` — +`sesame::openSesame()` does — pass it directly with `colData` and either +`rowRanges` or a `platform` to look the manifest up through `sesameData`: + +```{r matrix-input, eval = FALSE} +fit_bread(betas, features = reg, design = ~ condition, + colData = pheno, platform = "EPICv2") +``` + +The platform is never inferred from probe IDs: `cg`-numbers are shared across +HM450, EPIC and MM285, so a wrong guess would give wrong coordinates silently. + ### Backends - `backend = "conjugate"` (default) — analytic Normal-Inverse-Gamma diff --git a/README.md b/README.md index b68b9ee..e3efe86 100644 --- a/README.md +++ b/README.md @@ -1,35 +1,52 @@ +--- +output: github_document +--- + + # BREAD - [![R-CMD-check](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml) [![bioc-check](https://github.com/BacZemin/BREAD/actions/workflows/bioc-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/bioc-check.yaml) [![pkgdown](https://github.com/BacZemin/BREAD/actions/workflows/pkgdown.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/pkgdown.yaml) -[![Lifecycle: -experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) -[![License: -MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/licenses/MIT) +[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) +[![License: MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/licenses/MIT) [![Docs](https://img.shields.io/badge/docs-pkgdown-blue.svg)](https://baczemin.github.io/BREAD/) **BREAD** (Bayesian Region-specific DNA methylation inference) provides -targeted Bayesian inference for **predefined** DNA methylation regions -from array data stored in `SummarizedExperiment` objects. For each -region you supply, BREAD fits a Bayesian model, computes the posterior -probability of a directional methylation change, and classifies the -region as **hypermethylated**, **hypomethylated**, or **inconclusive** -at user-configurable effect-size and probability thresholds. +targeted Bayesian inference for **predefined** DNA methylation regions from +array data — a `SummarizedExperiment`, or a plain probe-by-sample matrix as +`sesame::openSesame()` returns. For each region you supply, BREAD fits a +Bayesian model, computes posterior probabilities of methylation change, and +classifies the region as **hypermethylated**, **hypomethylated**, +**unchanged**, or **inconclusive** at user-configurable effect-size and +probability thresholds. Unlike genome-wide DMR callers that scan for regions, BREAD answers a -different question: *given regions I already care about (PRC2 targets, -CGIs, LADs, a chromHMM state, a custom BED), what is the posterior -evidence for methylation change in each one, and how confident am I?* -Output is a per-region posterior — effect size, credible interval, and -directional probabilities — not just a p-value. +different question: *given regions I already care about (PRC2 targets, CGIs, +LADs, a chromHMM state, a custom BED), what is the posterior evidence for +methylation change in each one, and how confident am I?* Output is a +per-region posterior — effect size, credible interval, and probabilities — +not just a p-value. + +### The `unchanged` class + +Most tools give you two states: significant, and not-significant. That +conflates *flat* with *underpowered*, which at the sample sizes typical of +experimental epigenetics is most of your genome. + +BREAD reports `prob_rope`, the posterior mass inside the region of practical +equivalence \[−`delta`, +`delta`\], and calls a region **`unchanged`** when +that mass clears `rope_cutoff`. `inconclusive` then means only what its name +says. Being able to state that a region *demonstrably did not move* — with a +credible ceiling on how much it could have — is the one claim a p-value is +structurally unable to make, and it is often the claim a pathway or cascade +argument actually needs. ## Installation @@ -45,15 +62,16 @@ remotes::install_github("BacZemin/BREAD") ``` BREAD depends on Bioconductor packages (`SummarizedExperiment`, -`GenomicRanges`, `S4Vectors`). The optional `brms` backend additionally -needs `brms` plus a working Stan toolchain. +`GenomicRanges`, `S4Vectors`). The optional `brms` backend additionally needs +`brms` plus a working Stan toolchain. ## Example -BREAD ships a small packaged dataset so you can run the whole pipeline -out of the box: 8 EPICv2 arrays from a fibroblast passage-aging × -vitamin C experiment, plus 500 predefined regions spanning five feature -classes (PMD, PRC-CGI, bivalent, …). +BREAD ships a small packaged dataset so you can run the whole pipeline out of +the box: 8 EPICv2 arrays from a fibroblast passage-aging × vitamin C +experiment, plus 500 predefined regions spanning five feature classes +(PMD, PRC-CGI, bivalent, ...). + ``` r library(BREAD) @@ -81,81 +99,154 @@ fit # summary: n regions, backend, classification counts #> contrast : passagelate #> delta : 0.1 #> prob_cutoff: 0.95 +#> rope_cutoff: 0.95 +#> ci : 0.95 #> n_regions : 500 (of 500 input) #> classifications: #> hypermethylated 76 #> hypomethylated 39 +#> unchanged 0 #> inconclusive 385 ``` + ``` r res <- results(fit) # one row per region table(res$classification) #> -#> hypermethylated hypomethylated inconclusive -#> 76 39 385 +#> hypermethylated hypomethylated unchanged inconclusive +#> 76 39 0 385 ``` That is the whole pattern: a `SummarizedExperiment` of array data, a `GRanges` of regions to test, and a model formula referencing columns of -`colData(se)`. `fit_bread()` auto-detects the assay and whether values -are on the beta or M scale, so the three arguments above are usually all -you need. `feature_class_col` is optional — supply it when your regions -carry a grouping column you want summarized. +`colData(se)`. `fit_bread()` auto-detects the assay and whether values are +on the beta or M scale, so the three arguments above are usually all you +need. `feature_class_col` is optional — supply it when your regions carry a +grouping column you want summarized. ### Reading the results `results(fit)` returns one row per region: -| column | meaning | -|------------------|-------------------------------------------------------| -| `region_id` | region identifier | -| `n` | number of probes summarized in the region | -| `mean_effect` | posterior mean methylation change (M-scale) | -| `ci_lo`, `ci_hi` | 95% credible interval | -| `prob_hyper` | P(effect \> +delta) — evidence for hypermethylation | -| `prob_hypo` | P(effect \< -delta) — evidence for hypomethylation | -| `classification` | `hypermethylated` / `hypomethylated` / `inconclusive` | +| column | meaning | +|---|---| +| `region_id` | region identifier | +| `n` | number of probes summarized in the region | +| `mean_effect` | posterior mean methylation change (M-scale) | +| `ci_lo`, `ci_hi` | 95% credible interval | +| `prob_hyper` | P(effect > +delta) — evidence for hypermethylation | +| `prob_hypo` | P(effect < -delta) — evidence for hypomethylation | +| `prob_rope` | P(\|effect\| <= delta) — evidence of *no* change | +| `mean_dbeta`, `dbeta_lo`, `dbeta_hi` | the effect and interval on the beta scale | +| `ref_beta`, `delta_beta` | the anchor used for that translation, and `delta` in beta units | +| `classification` | `hypermethylated` / `hypomethylated` / `unchanged` / `inconclusive` | + ``` r head(res[, c("region_id", "n", "mean_effect", "ci_lo", "ci_hi", - "classification")]) -#> region_id n mean_effect ci_lo ci_hi classification -#> 1 PRC_CGI_025 4 0.1031847688 -0.07029387 0.2766634 inconclusive -#> 2 Active_promoter_080 4 0.3106513471 0.15979964 0.4615031 hypermethylated -#> 3 PMD_soloWCGW_066 4 -0.2168276139 -0.64352511 0.2098699 inconclusive -#> 4 PRC_CGI_039 4 -0.0003147594 -0.40264440 0.4020149 inconclusive -#> 5 PMD_soloWCGW_030 4 0.2989332658 0.09707228 0.5007942 hypermethylated -#> 6 Bivalent_090 4 0.0603224027 -0.31407739 0.4347222 inconclusive + "prob_rope", "classification")]) +#> region_id n mean_effect ci_lo ci_hi prob_rope +#> 1 PRC_CGI_025 4 0.1031847688 -0.07029387 0.2766634 0.465241327 +#> 2 Active_promoter_080 4 0.3106513471 0.15979964 0.4615031 0.008120156 +#> 3 PMD_soloWCGW_066 4 -0.2168276139 -0.64352511 0.2098699 0.190635821 +#> 4 PRC_CGI_039 4 -0.0003147594 -0.40264440 0.4020149 0.471851757 +#> 5 PMD_soloWCGW_030 4 0.2989332658 0.09707228 0.5007942 0.023370506 +#> 6 Bivalent_090 4 0.0603224027 -0.31407739 0.4347222 0.458234000 +#> classification +#> 1 inconclusive +#> 2 hypermethylated +#> 3 inconclusive +#> 4 inconclusive +#> 5 hypermethylated +#> 6 inconclusive ``` -A region is called **hypermethylated** if `prob_hyper >= prob_cutoff`, -**hypomethylated** if `prob_hypo >= prob_cutoff`, otherwise -**inconclusive**. Defaults are `delta = 0.10` (M-scale) and -`prob_cutoff = 0.95`; both are arguments to `fit_bread()`. +The rule: **hypermethylated** if `prob_hyper >= prob_cutoff`, +**hypomethylated** if `prob_hypo >= prob_cutoff`, **unchanged** if +`prob_rope >= rope_cutoff`, otherwise **inconclusive**. The three +probabilities partition the posterior, so at any sensible cutoff exactly one +can apply. Defaults are `delta = 0.10` (M-scale), `prob_cutoff = 0.95`, and +`rope_cutoff = prob_cutoff`. + +`rope_cutoff` is separate for a reason: concluding equivalence requires the +whole posterior to fit inside ±`delta`, which is far stricter than a +directional call. At small n you will often want to relax it on its own, +without also loosening the bar for discovery. `classifications(fit)` returns just the per-region calls, and `posterior_draws(fit)` gives posterior samples for downstream summaries. +### `delta` is on the M scale + +`delta = 0.10` in M-units is a beta change of about **0.017** at +mid-methylation, and *less* toward the extremes (about 0.006 at β = 0.1) — +the local slope dβ/dM = β(1−β)·ln2 is not constant. So a single beta-scale +threshold does not exist; BREAD reports a per-region `delta_beta` instead, +and `bread_delta_beta()` / `bread_delta_m()` convert explicitly when you want +to choose `delta` from a target Δβ. + + +``` r +bread_delta_beta(0.10) # at beta = 0.5 +#> [1] 0.01732868 +bread_delta_beta(0.10, ref_beta = c(0.5, 0.2, 0.1)) +#> [1] 0.017328680 0.011090355 0.006238325 +bread_delta_m(0.02) # delta for a 2-point change +#> [1] 0.1154156 +``` + +### Re-thresholding and permutation nulls + +`refit_bread()` reuses a fit's region-by-sample matrix. Changing only +thresholds skips the model fit entirely; supplying new `colData` re-fits +without recomputing the probe-to-region mapping, which is what makes +label-permutation calibration practical. + + +``` r +# Sweep the equivalence bar for free +table(results(refit_bread(fit, rope_cutoff = 0.80))$classification) + +# One draw from a label-permutation null +cd <- as.data.frame(colData(se_ctrl)) +cd$passage <- sample(cd$passage) +results(refit_bread(fit, colData = cd))$prob_hyper +``` + +### Matrix input + +If your pipeline hands you a matrix rather than a `SummarizedExperiment` — +`sesame::openSesame()` does — pass it directly with `colData` and either +`rowRanges` or a `platform` to look the manifest up through `sesameData`: + + +``` r +fit_bread(betas, features = reg, design = ~ condition, + colData = pheno, platform = "EPICv2") +``` + +The platform is never inferred from probe IDs: `cg`-numbers are shared across +HM450, EPIC and MM285, so a wrong guess would give wrong coordinates silently. + ### Backends - `backend = "conjugate"` (default) — analytic Normal-Inverse-Gamma posterior, no MCMC. Hundreds of regions fit in well under a second. -- `backend = "brms"` — full MCMC via Stan; compiles once, then reuses - the compiled model across regions. Use when you need the flexibility - of a full Bayesian fit. +- `backend = "brms"` — full MCMC via Stan; compiles once, then reuses the + compiled model across regions. Use when you need the flexibility of a + full Bayesian fit. ### KnowYourCG enrichment -`bread_kycg()` takes the probes in your hyper- or hypo-classified -regions and runs `knowYourCG::testEnrichment()` against curated CpG -databases, so you can ask what genomic features your called regions are -enriched for. +`bread_kycg()` takes the probes in your hyper- or hypo-classified regions +and runs `knowYourCG::testEnrichment()` against curated CpG databases, so +you can ask what genomic features your called regions are enriched for. ## Vignettes -Two worked examples on real data (rendered on the [documentation -site](https://baczemin.github.io/BREAD/)): +Two worked examples on real data (rendered on the +[documentation site](https://baczemin.github.io/BREAD/)): - **Getting started** (`bread-intro`) — TCGA HM450 matched normal/tumour pairs over chromHMM chromatin-state regions, end-to-end through @@ -166,18 +257,18 @@ site](https://baczemin.github.io/BREAD/)): ## Status -Milestone 1 (MVP) is complete: the full `fit_bread()` pipeline, -conjugate and brms backends, S4 classes with accessors, plotting -helpers, KYCG integration, two real-data vignettes, and a live pkgdown -site. Partial pooling across regions, feature-class priors, -random-effects designs, and contrast vectors are on the roadmap. See -`NEWS.md` for the changelog. +Milestone 1 (MVP) is complete: the full `fit_bread()` pipeline, conjugate +and brms backends, S4 classes with accessors, plotting helpers, KYCG +integration, two real-data vignettes, and a live pkgdown site. Partial +pooling across regions, feature-class priors, random-effects designs, and +contrast vectors are on the roadmap. See `NEWS.md` for the changelog. ## Citation BREAD does not have an associated publication yet. For now, cite the package itself: + ``` r citation("BREAD") To cite package 'BREAD' in publications use: diff --git a/_pkgdown.yml b/_pkgdown.yml index 537b73c..a0df9f6 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -12,10 +12,12 @@ home: title: "BREAD: Bayesian region-specific DNA methylation inference" description: > BREAD provides targeted Bayesian inference for predefined methylation - regions using array-derived data stored in SummarizedExperiment objects. - Instead of only returning p-values, BREAD estimates posterior - probabilities that each region is hypermethylated or hypomethylated - under a contrast of interest. + regions using array-derived data, supplied either as a + SummarizedExperiment or as a plain probe-by-sample matrix. Instead of + only returning p-values, BREAD estimates posterior probabilities that + each region is hypermethylated, hypomethylated, or practically + unchanged under a contrast of interest -- including a positive + statement of no change, which a p-value cannot make. authors: Jaemin Park: @@ -44,6 +46,7 @@ reference: and drives the backend; the backend fit helpers themselves are internal. contents: - fit_bread + - refit_bread - bread_prior - title: "Pipeline building blocks" desc: > @@ -55,6 +58,8 @@ reference: - summarize_features - posterior_summary - classify_regions + - bread_se + - bread_scale - title: "Plotting and palette" contents: - plot_region_posterior diff --git a/vignettes/bread-intro.Rmd b/vignettes/bread-intro.Rmd index ef00db0..04b04ac 100644 --- a/vignettes/bread-intro.Rmd +++ b/vignettes/bread-intro.Rmd @@ -248,14 +248,22 @@ $$ The marginal posterior of the contrast coefficient is a location–scale Student-t with `df = 2 a_n`. BREAD uses `pt()`/`qt()` to compute -$P(\beta > \delta)$ and $P(\beta < -\delta)$ analytically — no MCMC. +$P(\beta > \delta)$, $P(\beta < -\delta)$ and +$P(|\beta| \le \delta)$ analytically — no MCMC. The classification rule is then: - **hypermethylated** if $P(\beta > \delta) \ge$ `prob_cutoff`, - **hypomethylated** if $P(\beta < -\delta) \ge$ `prob_cutoff`, +- **unchanged** if $P(|\beta| \le \delta) \ge$ `rope_cutoff`, - **inconclusive** otherwise. +The three probabilities partition the posterior and sum to 1, so two of them +can clear their thresholds at once only if those thresholds sum to no more +than 1 — impossible at any sensible setting. The `unchanged` class is what +separates *"this region demonstrably did not move by more than $\delta$"* +from *"this region told us nothing"*; both used to be `inconclusive`. + Need partial pooling across regions, non-conjugate priors, or ordered contrasts? Set `backend = "brms"`; everything else stays the same. diff --git a/vignettes/bread-vitc.Rmd b/vignettes/bread-vitc.Rmd index b767bee..c88d575 100644 --- a/vignettes/bread-vitc.Rmd +++ b/vignettes/bread-vitc.Rmd @@ -148,8 +148,23 @@ plot_feature_set(fit_vitc, feature_class_col = "feature_class") + VitC demethylation is broadly distributed but, with only two replicates per arm, most regions land in the `inconclusive` class at `prob_cutoff = 0.95`. -This is BREAD doing its job — it does not claim more certainty than the -sample size supports. + +That word now carries a precise meaning. With n = 2 the posterior is wide, +so almost nothing reaches `prob_rope >= 0.95` either: these regions are not +being called *unchanged*, they are being called *unresolved*. BREAD is +saying it can neither detect a $\delta = 0.10$ effect nor rule one out — +which is the honest answer, and a strictly more informative one than a +non-significant p-value, because the same table tells you which regions +*did* resolve in each direction. + +```{r rope-at-n2} +summary(results(fit_vitc)$prob_rope) +``` + +If most of that distribution sits well below 0.95, the experiment is +underpowered rather than null. Contrast this with a well-powered design, +where regions genuinely unaffected by the treatment accumulate `prob_rope` +near 1 and get called `unchanged` — a positive claim of no effect. ## The biologically interesting intersection @@ -219,9 +234,12 @@ if (length(protected) > 0L) { ## Caveats - **n = 2 per arm.** The credible intervals are wide and many regions - remain `inconclusive`. BREAD's posterior probabilities are the honest - answer given the data; lowering `prob_cutoff` to, say, `0.80` will promote - more regions to `hyper` / `hypo` but also admit more false positives. + remain `inconclusive` — genuinely unresolved, not shown to be flat (see + the `prob_rope` distribution above). BREAD's posterior probabilities are + the honest answer given the data; lowering `prob_cutoff` to, say, `0.80` + will promote more regions to `hyper` / `hypo` but also admit more false + positives. Use `refit_bread(fit, prob_cutoff = 0.80)` to sweep that + without re-fitting anything. - Technical replicates, not biological. Real variance in the `aa57` effect across fibroblast lines is not captured by this experiment and would produce additional dispersion if included. From 4c3c3c077cd6fb1f695db4bfaa041588908d50f9 Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Sun, 9 Aug 2026 18:47:13 -0400 Subject: [PATCH 14/17] docs(README): show that the packaged example certifies zero regions unchanged At n=4 nothing reaches prob_rope >= 0.95, which is the honest result and the concrete argument for rope_cutoff being a separate knob. Better shown than hidden -- it also demonstrates the unresolved-vs-flat distinction the class exists to draw. --- README.Rmd | 19 ++++- README.md | 219 ++++++++++++++++------------------------------------- 2 files changed, 80 insertions(+), 158 deletions(-) diff --git a/README.Rmd b/README.Rmd index 7881897..46cd2e3 100644 --- a/README.Rmd +++ b/README.Rmd @@ -140,10 +140,23 @@ probabilities partition the posterior, so at any sensible cutoff exactly one can apply. Defaults are `delta = 0.10` (M-scale), `prob_cutoff = 0.95`, and `rope_cutoff = prob_cutoff`. -`rope_cutoff` is separate for a reason: concluding equivalence requires the +`rope_cutoff` is separate for a reason, and the example above demonstrates it: +**zero** regions are called `unchanged`. Concluding equivalence requires the whole posterior to fit inside ±`delta`, which is far stricter than a -directional call. At small n you will often want to relax it on its own, -without also loosening the bar for discovery. +directional call, and this packaged dataset has too few samples to certify +anything as flat: + +```{r rope-distribution} +summary(res$prob_rope) +``` + +Those 385 `inconclusive` regions are genuinely *unresolved* — BREAD can +neither detect a `delta = 0.10` effect nor exclude one. That is a more +specific statement than a non-significant q-value, which looks the same +whether the region is flat or the study is underpowered. A shared cutoff +would make the equivalence class unreachable exactly where it is most +wanted, so relax `rope_cutoff` on its own when you want to see the +gradient — without loosening the bar for discovery. `classifications(fit)` returns just the per-region calls, and `posterior_draws(fit)` gives posterior samples for downstream summaries. diff --git a/README.md b/README.md index e3efe86..b68b9ee 100644 --- a/README.md +++ b/README.md @@ -1,52 +1,35 @@ ---- -output: github_document ---- - - # BREAD + [![R-CMD-check](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml) [![bioc-check](https://github.com/BacZemin/BREAD/actions/workflows/bioc-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/bioc-check.yaml) [![pkgdown](https://github.com/BacZemin/BREAD/actions/workflows/pkgdown.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/pkgdown.yaml) -[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) -[![License: MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/licenses/MIT) +[![Lifecycle: +experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) +[![License: +MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/licenses/MIT) [![Docs](https://img.shields.io/badge/docs-pkgdown-blue.svg)](https://baczemin.github.io/BREAD/) **BREAD** (Bayesian Region-specific DNA methylation inference) provides -targeted Bayesian inference for **predefined** DNA methylation regions from -array data — a `SummarizedExperiment`, or a plain probe-by-sample matrix as -`sesame::openSesame()` returns. For each region you supply, BREAD fits a -Bayesian model, computes posterior probabilities of methylation change, and -classifies the region as **hypermethylated**, **hypomethylated**, -**unchanged**, or **inconclusive** at user-configurable effect-size and -probability thresholds. +targeted Bayesian inference for **predefined** DNA methylation regions +from array data stored in `SummarizedExperiment` objects. For each +region you supply, BREAD fits a Bayesian model, computes the posterior +probability of a directional methylation change, and classifies the +region as **hypermethylated**, **hypomethylated**, or **inconclusive** +at user-configurable effect-size and probability thresholds. Unlike genome-wide DMR callers that scan for regions, BREAD answers a -different question: *given regions I already care about (PRC2 targets, CGIs, -LADs, a chromHMM state, a custom BED), what is the posterior evidence for -methylation change in each one, and how confident am I?* Output is a -per-region posterior — effect size, credible interval, and probabilities — -not just a p-value. - -### The `unchanged` class - -Most tools give you two states: significant, and not-significant. That -conflates *flat* with *underpowered*, which at the sample sizes typical of -experimental epigenetics is most of your genome. - -BREAD reports `prob_rope`, the posterior mass inside the region of practical -equivalence \[−`delta`, +`delta`\], and calls a region **`unchanged`** when -that mass clears `rope_cutoff`. `inconclusive` then means only what its name -says. Being able to state that a region *demonstrably did not move* — with a -credible ceiling on how much it could have — is the one claim a p-value is -structurally unable to make, and it is often the claim a pathway or cascade -argument actually needs. +different question: *given regions I already care about (PRC2 targets, +CGIs, LADs, a chromHMM state, a custom BED), what is the posterior +evidence for methylation change in each one, and how confident am I?* +Output is a per-region posterior — effect size, credible interval, and +directional probabilities — not just a p-value. ## Installation @@ -62,16 +45,15 @@ remotes::install_github("BacZemin/BREAD") ``` BREAD depends on Bioconductor packages (`SummarizedExperiment`, -`GenomicRanges`, `S4Vectors`). The optional `brms` backend additionally needs -`brms` plus a working Stan toolchain. +`GenomicRanges`, `S4Vectors`). The optional `brms` backend additionally +needs `brms` plus a working Stan toolchain. ## Example -BREAD ships a small packaged dataset so you can run the whole pipeline out of -the box: 8 EPICv2 arrays from a fibroblast passage-aging × vitamin C -experiment, plus 500 predefined regions spanning five feature classes -(PMD, PRC-CGI, bivalent, ...). - +BREAD ships a small packaged dataset so you can run the whole pipeline +out of the box: 8 EPICv2 arrays from a fibroblast passage-aging × +vitamin C experiment, plus 500 predefined regions spanning five feature +classes (PMD, PRC-CGI, bivalent, …). ``` r library(BREAD) @@ -99,154 +81,81 @@ fit # summary: n regions, backend, classification counts #> contrast : passagelate #> delta : 0.1 #> prob_cutoff: 0.95 -#> rope_cutoff: 0.95 -#> ci : 0.95 #> n_regions : 500 (of 500 input) #> classifications: #> hypermethylated 76 #> hypomethylated 39 -#> unchanged 0 #> inconclusive 385 ``` - ``` r res <- results(fit) # one row per region table(res$classification) #> -#> hypermethylated hypomethylated unchanged inconclusive -#> 76 39 0 385 +#> hypermethylated hypomethylated inconclusive +#> 76 39 385 ``` That is the whole pattern: a `SummarizedExperiment` of array data, a `GRanges` of regions to test, and a model formula referencing columns of -`colData(se)`. `fit_bread()` auto-detects the assay and whether values are -on the beta or M scale, so the three arguments above are usually all you -need. `feature_class_col` is optional — supply it when your regions carry a -grouping column you want summarized. +`colData(se)`. `fit_bread()` auto-detects the assay and whether values +are on the beta or M scale, so the three arguments above are usually all +you need. `feature_class_col` is optional — supply it when your regions +carry a grouping column you want summarized. ### Reading the results `results(fit)` returns one row per region: -| column | meaning | -|---|---| -| `region_id` | region identifier | -| `n` | number of probes summarized in the region | -| `mean_effect` | posterior mean methylation change (M-scale) | -| `ci_lo`, `ci_hi` | 95% credible interval | -| `prob_hyper` | P(effect > +delta) — evidence for hypermethylation | -| `prob_hypo` | P(effect < -delta) — evidence for hypomethylation | -| `prob_rope` | P(\|effect\| <= delta) — evidence of *no* change | -| `mean_dbeta`, `dbeta_lo`, `dbeta_hi` | the effect and interval on the beta scale | -| `ref_beta`, `delta_beta` | the anchor used for that translation, and `delta` in beta units | -| `classification` | `hypermethylated` / `hypomethylated` / `unchanged` / `inconclusive` | - +| column | meaning | +|------------------|-------------------------------------------------------| +| `region_id` | region identifier | +| `n` | number of probes summarized in the region | +| `mean_effect` | posterior mean methylation change (M-scale) | +| `ci_lo`, `ci_hi` | 95% credible interval | +| `prob_hyper` | P(effect \> +delta) — evidence for hypermethylation | +| `prob_hypo` | P(effect \< -delta) — evidence for hypomethylation | +| `classification` | `hypermethylated` / `hypomethylated` / `inconclusive` | ``` r head(res[, c("region_id", "n", "mean_effect", "ci_lo", "ci_hi", - "prob_rope", "classification")]) -#> region_id n mean_effect ci_lo ci_hi prob_rope -#> 1 PRC_CGI_025 4 0.1031847688 -0.07029387 0.2766634 0.465241327 -#> 2 Active_promoter_080 4 0.3106513471 0.15979964 0.4615031 0.008120156 -#> 3 PMD_soloWCGW_066 4 -0.2168276139 -0.64352511 0.2098699 0.190635821 -#> 4 PRC_CGI_039 4 -0.0003147594 -0.40264440 0.4020149 0.471851757 -#> 5 PMD_soloWCGW_030 4 0.2989332658 0.09707228 0.5007942 0.023370506 -#> 6 Bivalent_090 4 0.0603224027 -0.31407739 0.4347222 0.458234000 -#> classification -#> 1 inconclusive -#> 2 hypermethylated -#> 3 inconclusive -#> 4 inconclusive -#> 5 hypermethylated -#> 6 inconclusive + "classification")]) +#> region_id n mean_effect ci_lo ci_hi classification +#> 1 PRC_CGI_025 4 0.1031847688 -0.07029387 0.2766634 inconclusive +#> 2 Active_promoter_080 4 0.3106513471 0.15979964 0.4615031 hypermethylated +#> 3 PMD_soloWCGW_066 4 -0.2168276139 -0.64352511 0.2098699 inconclusive +#> 4 PRC_CGI_039 4 -0.0003147594 -0.40264440 0.4020149 inconclusive +#> 5 PMD_soloWCGW_030 4 0.2989332658 0.09707228 0.5007942 hypermethylated +#> 6 Bivalent_090 4 0.0603224027 -0.31407739 0.4347222 inconclusive ``` -The rule: **hypermethylated** if `prob_hyper >= prob_cutoff`, -**hypomethylated** if `prob_hypo >= prob_cutoff`, **unchanged** if -`prob_rope >= rope_cutoff`, otherwise **inconclusive**. The three -probabilities partition the posterior, so at any sensible cutoff exactly one -can apply. Defaults are `delta = 0.10` (M-scale), `prob_cutoff = 0.95`, and -`rope_cutoff = prob_cutoff`. - -`rope_cutoff` is separate for a reason: concluding equivalence requires the -whole posterior to fit inside ±`delta`, which is far stricter than a -directional call. At small n you will often want to relax it on its own, -without also loosening the bar for discovery. +A region is called **hypermethylated** if `prob_hyper >= prob_cutoff`, +**hypomethylated** if `prob_hypo >= prob_cutoff`, otherwise +**inconclusive**. Defaults are `delta = 0.10` (M-scale) and +`prob_cutoff = 0.95`; both are arguments to `fit_bread()`. `classifications(fit)` returns just the per-region calls, and `posterior_draws(fit)` gives posterior samples for downstream summaries. -### `delta` is on the M scale - -`delta = 0.10` in M-units is a beta change of about **0.017** at -mid-methylation, and *less* toward the extremes (about 0.006 at β = 0.1) — -the local slope dβ/dM = β(1−β)·ln2 is not constant. So a single beta-scale -threshold does not exist; BREAD reports a per-region `delta_beta` instead, -and `bread_delta_beta()` / `bread_delta_m()` convert explicitly when you want -to choose `delta` from a target Δβ. - - -``` r -bread_delta_beta(0.10) # at beta = 0.5 -#> [1] 0.01732868 -bread_delta_beta(0.10, ref_beta = c(0.5, 0.2, 0.1)) -#> [1] 0.017328680 0.011090355 0.006238325 -bread_delta_m(0.02) # delta for a 2-point change -#> [1] 0.1154156 -``` - -### Re-thresholding and permutation nulls - -`refit_bread()` reuses a fit's region-by-sample matrix. Changing only -thresholds skips the model fit entirely; supplying new `colData` re-fits -without recomputing the probe-to-region mapping, which is what makes -label-permutation calibration practical. - - -``` r -# Sweep the equivalence bar for free -table(results(refit_bread(fit, rope_cutoff = 0.80))$classification) - -# One draw from a label-permutation null -cd <- as.data.frame(colData(se_ctrl)) -cd$passage <- sample(cd$passage) -results(refit_bread(fit, colData = cd))$prob_hyper -``` - -### Matrix input - -If your pipeline hands you a matrix rather than a `SummarizedExperiment` — -`sesame::openSesame()` does — pass it directly with `colData` and either -`rowRanges` or a `platform` to look the manifest up through `sesameData`: - - -``` r -fit_bread(betas, features = reg, design = ~ condition, - colData = pheno, platform = "EPICv2") -``` - -The platform is never inferred from probe IDs: `cg`-numbers are shared across -HM450, EPIC and MM285, so a wrong guess would give wrong coordinates silently. - ### Backends - `backend = "conjugate"` (default) — analytic Normal-Inverse-Gamma posterior, no MCMC. Hundreds of regions fit in well under a second. -- `backend = "brms"` — full MCMC via Stan; compiles once, then reuses the - compiled model across regions. Use when you need the flexibility of a - full Bayesian fit. +- `backend = "brms"` — full MCMC via Stan; compiles once, then reuses + the compiled model across regions. Use when you need the flexibility + of a full Bayesian fit. ### KnowYourCG enrichment -`bread_kycg()` takes the probes in your hyper- or hypo-classified regions -and runs `knowYourCG::testEnrichment()` against curated CpG databases, so -you can ask what genomic features your called regions are enriched for. +`bread_kycg()` takes the probes in your hyper- or hypo-classified +regions and runs `knowYourCG::testEnrichment()` against curated CpG +databases, so you can ask what genomic features your called regions are +enriched for. ## Vignettes -Two worked examples on real data (rendered on the -[documentation site](https://baczemin.github.io/BREAD/)): +Two worked examples on real data (rendered on the [documentation +site](https://baczemin.github.io/BREAD/)): - **Getting started** (`bread-intro`) — TCGA HM450 matched normal/tumour pairs over chromHMM chromatin-state regions, end-to-end through @@ -257,18 +166,18 @@ Two worked examples on real data (rendered on the ## Status -Milestone 1 (MVP) is complete: the full `fit_bread()` pipeline, conjugate -and brms backends, S4 classes with accessors, plotting helpers, KYCG -integration, two real-data vignettes, and a live pkgdown site. Partial -pooling across regions, feature-class priors, random-effects designs, and -contrast vectors are on the roadmap. See `NEWS.md` for the changelog. +Milestone 1 (MVP) is complete: the full `fit_bread()` pipeline, +conjugate and brms backends, S4 classes with accessors, plotting +helpers, KYCG integration, two real-data vignettes, and a live pkgdown +site. Partial pooling across regions, feature-class priors, +random-effects designs, and contrast vectors are on the roadmap. See +`NEWS.md` for the changelog. ## Citation BREAD does not have an associated publication yet. For now, cite the package itself: - ``` r citation("BREAD") To cite package 'BREAD' in publications use: From e3b5fe519c7059a369ccd4b9e86188fc9042cb88 Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Mon, 10 Aug 2026 17:25:52 -0400 Subject: [PATCH 15/17] docs: correct the `n` column, quantify the beta linearisation, rebuild README - README described `n` as the probe count per region; it is the number of samples contributing to the fit after NA-dropping. Probe counts are in `mapping$n_probes`. Say so in posterior_summary()'s @return too, which had listed `n` without defining it. - Document how far the first-order beta translation drifts from an exact back-transform: median 0.0005 and p99 0.021 in beta units on the packaged vitamin C example, ~2% relative below |dM| 0.25 rising to ~10% above 0.5. No classification is affected, but mean_dbeta should not be quoted to three decimals for a strongly changing region. - README.md was stale: it still documented the three-level API and none of prob_rope / unchanged / the beta columns, because 5f60905 and 4c3c3c0 edited README.Rmd without rerunning build_readme(). Rebuilt. - ROPE interval was written \[-delta, +delta\]; pandoc read the escaped brackets as LaTeX and emitted $$..$$ display math into the GFM output. Reworded to avoid the brackets. --- R/posterior.R | 14 ++++ README.Rmd | 4 +- README.md | 162 ++++++++++++++++++++++++++++++++------- man/posterior_summary.Rd | 14 ++++ 4 files changed, 163 insertions(+), 31 deletions(-) diff --git a/R/posterior.R b/R/posterior.R index 2276d4a..2fbb587 100644 --- a/R/posterior.R +++ b/R/posterior.R @@ -34,6 +34,17 @@ #' beta-scale comparison can never contradict the M-scale classification #' beside it. See [bread_delta_beta()]. #' +#' Being a first-order expansion, this is exact only in the limit of small +#' effects, and it overstates `|mean_dbeta|` for large ones. Measured on +#' the packaged vitamin C example (493 regions), the deviation from an +#' exact back-transform of the same posterior mean has median 0.0005 and +#' 99th percentile 0.021 in beta units; relative error is ~2% for +#' `|mean_effect| < 0.25` but ~10% above 0.5. Regions whose effects are +#' that large are unambiguous on the M scale anyway, so the approximation +#' does not affect any call -- but do not quote `mean_dbeta` to three +#' decimal places for a strongly changing region. Back-transform the +#' endpoints yourself when the exact beta magnitude is the claim. +#' #' @param fit A [BreadFit] (as returned by [fit_bread()]), or the internal #' model list from [fit_bread_summary()] / [fit_bread_brms()]. #' @param delta Effect-size threshold on the M-value scale. Default `0.10`. @@ -48,6 +59,9 @@ #' `df`, `scale`, `prob_pos`, `prob_neg`, `prob_hyper`, `prob_hypo`, #' `prob_rope`, `ref_beta`, `mean_dbeta`, `dbeta_lo`, `dbeta_hi`, #' `delta_beta`, `error`. +#' `n` is the number of **samples** contributing to the region's fit +#' after dropping NAs -- not the number of probes, which is carried +#' per region in the `n_probes` column of the fit's `mapping`. #' `df` is `NA_real_` for the empirical path. The beta-scale columns are #' `NA_real_` when no region matrix is available, or when #' `summary_fun = "pc1"` (PC1 scores are not M-values). diff --git a/README.Rmd b/README.Rmd index 46cd2e3..2eb8e6e 100644 --- a/README.Rmd +++ b/README.Rmd @@ -48,7 +48,7 @@ conflates *flat* with *underpowered*, which at the sample sizes typical of experimental epigenetics is most of your genome. BREAD reports `prob_rope`, the posterior mass inside the region of practical -equivalence \[−`delta`, +`delta`\], and calls a region **`unchanged`** when +equivalence spanning −`delta` to +`delta`, and calls a region **`unchanged`** when that mass clears `rope_cutoff`. `inconclusive` then means only what its name says. Being able to state that a region *demonstrably did not move* — with a credible ceiling on how much it could have — is the one claim a p-value is @@ -118,7 +118,7 @@ grouping column you want summarized. | column | meaning | |---|---| | `region_id` | region identifier | -| `n` | number of probes summarized in the region | +| `n` | samples contributing to the fit (non-NA); probe counts per region live in `fit@mapping$n_probes` | | `mean_effect` | posterior mean methylation change (M-scale) | | `ci_lo`, `ci_hi` | 95% credible interval | | `prob_hyper` | P(effect > +delta) — evidence for hypermethylation | diff --git a/README.md b/README.md index b68b9ee..0812e8e 100644 --- a/README.md +++ b/README.md @@ -18,18 +18,33 @@ MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/ **BREAD** (Bayesian Region-specific DNA methylation inference) provides targeted Bayesian inference for **predefined** DNA methylation regions -from array data stored in `SummarizedExperiment` objects. For each -region you supply, BREAD fits a Bayesian model, computes the posterior -probability of a directional methylation change, and classifies the -region as **hypermethylated**, **hypomethylated**, or **inconclusive** -at user-configurable effect-size and probability thresholds. +from array data — a `SummarizedExperiment`, or a plain probe-by-sample +matrix as `sesame::openSesame()` returns. For each region you supply, +BREAD fits a Bayesian model, computes posterior probabilities of +methylation change, and classifies the region as **hypermethylated**, +**hypomethylated**, **unchanged**, or **inconclusive** at +user-configurable effect-size and probability thresholds. Unlike genome-wide DMR callers that scan for regions, BREAD answers a different question: *given regions I already care about (PRC2 targets, CGIs, LADs, a chromHMM state, a custom BED), what is the posterior evidence for methylation change in each one, and how confident am I?* Output is a per-region posterior — effect size, credible interval, and -directional probabilities — not just a p-value. +probabilities — not just a p-value. + +### The `unchanged` class + +Most tools give you two states: significant, and not-significant. That +conflates *flat* with *underpowered*, which at the sample sizes typical +of experimental epigenetics is most of your genome. + +BREAD reports `prob_rope`, the posterior mass inside the region of +practical equivalence spanning −`delta` to +`delta`, and calls a region +**`unchanged`** when that mass clears `rope_cutoff`. `inconclusive` then +means only what its name says. Being able to state that a region +*demonstrably did not move* — with a credible ceiling on how much it +could have — is the one claim a p-value is structurally unable to make, +and it is often the claim a pathway or cascade argument actually needs. ## Installation @@ -71,6 +86,9 @@ fit <- fit_bread( design = ~ passage, feature_class_col = "feature_class" ) +#> Warning: 496 of 496 fitted region(s) have fewer than 3 residual degrees of +#> freedom (n - p < 3). Intervals there are optimistic; consider df_mode = +#> "residual". fit # summary: n regions, backend, classification counts #> @@ -81,10 +99,13 @@ fit # summary: n regions, backend, classification counts #> contrast : passagelate #> delta : 0.1 #> prob_cutoff: 0.95 +#> rope_cutoff: 0.95 +#> ci : 0.95 #> n_regions : 500 (of 500 input) #> classifications: #> hypermethylated 76 #> hypomethylated 39 +#> unchanged 0 #> inconclusive 385 ``` @@ -92,8 +113,8 @@ fit # summary: n regions, backend, classification counts res <- results(fit) # one row per region table(res$classification) #> -#> hypermethylated hypomethylated inconclusive -#> 76 39 385 +#> hypermethylated hypomethylated unchanged inconclusive +#> 76 39 0 385 ``` That is the whole pattern: a `SummarizedExperiment` of array data, a @@ -107,36 +128,119 @@ carry a grouping column you want summarized. `results(fit)` returns one row per region: -| column | meaning | -|------------------|-------------------------------------------------------| -| `region_id` | region identifier | -| `n` | number of probes summarized in the region | -| `mean_effect` | posterior mean methylation change (M-scale) | -| `ci_lo`, `ci_hi` | 95% credible interval | -| `prob_hyper` | P(effect \> +delta) — evidence for hypermethylation | -| `prob_hypo` | P(effect \< -delta) — evidence for hypomethylation | -| `classification` | `hypermethylated` / `hypomethylated` / `inconclusive` | +| column | meaning | +|----|----| +| `region_id` | region identifier | +| `n` | samples contributing to the fit (non-NA); probe counts per region live in `fit@mapping$n_probes` | +| `mean_effect` | posterior mean methylation change (M-scale) | +| `ci_lo`, `ci_hi` | 95% credible interval | +| `prob_hyper` | P(effect \> +delta) — evidence for hypermethylation | +| `prob_hypo` | P(effect \< -delta) — evidence for hypomethylation | +| `prob_rope` | P(\|effect\| \<= delta) — evidence of *no* change | +| `mean_dbeta`, `dbeta_lo`, `dbeta_hi` | the effect and interval on the beta scale | +| `ref_beta`, `delta_beta` | the anchor used for that translation, and `delta` in beta units | +| `classification` | `hypermethylated` / `hypomethylated` / `unchanged` / `inconclusive` | ``` r head(res[, c("region_id", "n", "mean_effect", "ci_lo", "ci_hi", - "classification")]) -#> region_id n mean_effect ci_lo ci_hi classification -#> 1 PRC_CGI_025 4 0.1031847688 -0.07029387 0.2766634 inconclusive -#> 2 Active_promoter_080 4 0.3106513471 0.15979964 0.4615031 hypermethylated -#> 3 PMD_soloWCGW_066 4 -0.2168276139 -0.64352511 0.2098699 inconclusive -#> 4 PRC_CGI_039 4 -0.0003147594 -0.40264440 0.4020149 inconclusive -#> 5 PMD_soloWCGW_030 4 0.2989332658 0.09707228 0.5007942 hypermethylated -#> 6 Bivalent_090 4 0.0603224027 -0.31407739 0.4347222 inconclusive + "prob_rope", "classification")]) +#> region_id n mean_effect ci_lo ci_hi prob_rope +#> 1 PRC_CGI_025 4 0.1031847688 -0.07029387 0.2766634 0.465241327 +#> 2 Active_promoter_080 4 0.3106513471 0.15979964 0.4615031 0.008120156 +#> 3 PMD_soloWCGW_066 4 -0.2168276139 -0.64352511 0.2098699 0.190635821 +#> 4 PRC_CGI_039 4 -0.0003147594 -0.40264440 0.4020149 0.471851757 +#> 5 PMD_soloWCGW_030 4 0.2989332658 0.09707228 0.5007942 0.023370506 +#> 6 Bivalent_090 4 0.0603224027 -0.31407739 0.4347222 0.458234000 +#> classification +#> 1 inconclusive +#> 2 hypermethylated +#> 3 inconclusive +#> 4 inconclusive +#> 5 hypermethylated +#> 6 inconclusive ``` -A region is called **hypermethylated** if `prob_hyper >= prob_cutoff`, -**hypomethylated** if `prob_hypo >= prob_cutoff`, otherwise -**inconclusive**. Defaults are `delta = 0.10` (M-scale) and -`prob_cutoff = 0.95`; both are arguments to `fit_bread()`. +The rule: **hypermethylated** if `prob_hyper >= prob_cutoff`, +**hypomethylated** if `prob_hypo >= prob_cutoff`, **unchanged** if +`prob_rope >= rope_cutoff`, otherwise **inconclusive**. The three +probabilities partition the posterior, so at any sensible cutoff exactly +one can apply. Defaults are `delta = 0.10` (M-scale), +`prob_cutoff = 0.95`, and `rope_cutoff = prob_cutoff`. + +`rope_cutoff` is separate for a reason, and the example above +demonstrates it: **zero** regions are called `unchanged`. Concluding +equivalence requires the whole posterior to fit inside ±`delta`, which +is far stricter than a directional call, and this packaged dataset has +too few samples to certify anything as flat: + +``` r +summary(res$prob_rope) +#> Min. 1st Qu. Median Mean 3rd Qu. Max. NA's +#> 0.000017 0.045787 0.233455 0.244212 0.376575 0.909569 4 +``` + +Those 385 `inconclusive` regions are genuinely *unresolved* — BREAD can +neither detect a `delta = 0.10` effect nor exclude one. That is a more +specific statement than a non-significant q-value, which looks the same +whether the region is flat or the study is underpowered. A shared cutoff +would make the equivalence class unreachable exactly where it is most +wanted, so relax `rope_cutoff` on its own when you want to see the +gradient — without loosening the bar for discovery. `classifications(fit)` returns just the per-region calls, and `posterior_draws(fit)` gives posterior samples for downstream summaries. +### `delta` is on the M scale + +`delta = 0.10` in M-units is a beta change of about **0.017** at +mid-methylation, and *less* toward the extremes (about 0.006 at β = 0.1) +— the local slope dβ/dM = β(1−β)·ln2 is not constant. So a single +beta-scale threshold does not exist; BREAD reports a per-region +`delta_beta` instead, and `bread_delta_beta()` / `bread_delta_m()` +convert explicitly when you want to choose `delta` from a target Δβ. + +``` r +bread_delta_beta(0.10) # at beta = 0.5 +#> [1] 0.01732868 +bread_delta_beta(0.10, ref_beta = c(0.5, 0.2, 0.1)) +#> [1] 0.017328680 0.011090355 0.006238325 +bread_delta_m(0.02) # delta for a 2-point change +#> [1] 0.1154156 +``` + +### Re-thresholding and permutation nulls + +`refit_bread()` reuses a fit’s region-by-sample matrix. Changing only +thresholds skips the model fit entirely; supplying new `colData` re-fits +without recomputing the probe-to-region mapping, which is what makes +label-permutation calibration practical. + +``` r +# Sweep the equivalence bar for free +table(results(refit_bread(fit, rope_cutoff = 0.80))$classification) + +# One draw from a label-permutation null +cd <- as.data.frame(colData(se_ctrl)) +cd$passage <- sample(cd$passage) +results(refit_bread(fit, colData = cd))$prob_hyper +``` + +### Matrix input + +If your pipeline hands you a matrix rather than a `SummarizedExperiment` +— `sesame::openSesame()` does — pass it directly with `colData` and +either `rowRanges` or a `platform` to look the manifest up through +`sesameData`: + +``` r +fit_bread(betas, features = reg, design = ~ condition, + colData = pheno, platform = "EPICv2") +``` + +The platform is never inferred from probe IDs: `cg`-numbers are shared +across HM450, EPIC and MM285, so a wrong guess would give wrong +coordinates silently. + ### Backends - `backend = "conjugate"` (default) — analytic Normal-Inverse-Gamma diff --git a/man/posterior_summary.Rd b/man/posterior_summary.Rd index 00bbbd6..2ab8327 100644 --- a/man/posterior_summary.Rd +++ b/man/posterior_summary.Rd @@ -25,6 +25,9 @@ A \code{data.frame} with one row per region and columns: \code{df}, \code{scale}, \code{prob_pos}, \code{prob_neg}, \code{prob_hyper}, \code{prob_hypo}, \code{prob_rope}, \code{ref_beta}, \code{mean_dbeta}, \code{dbeta_lo}, \code{dbeta_hi}, \code{delta_beta}, \code{error}. +\code{n} is the number of \strong{samples} contributing to the region's fit +after dropping NAs -- not the number of probes, which is carried +per region in the \code{n_probes} column of the fit's \code{mapping}. \code{df} is \code{NA_real_} for the empirical path. The beta-scale columns are \code{NA_real_} when no region matrix is available, or when \code{summary_fun = "pc1"} (PC1 scores are not M-values). @@ -70,6 +73,17 @@ contrast type, unlike the reference level of a factor. The same multiplier is applied to the effect, both interval bounds and \code{delta}, so the beta-scale comparison can never contradict the M-scale classification beside it. See \code{\link[=bread_delta_beta]{bread_delta_beta()}}. + +Being a first-order expansion, this is exact only in the limit of small +effects, and it overstates \verb{|mean_dbeta|} for large ones. Measured on +the packaged vitamin C example (493 regions), the deviation from an +exact back-transform of the same posterior mean has median 0.0005 and +99th percentile 0.021 in beta units; relative error is ~2\% for +\verb{|mean_effect| < 0.25} but ~10\% above 0.5. Regions whose effects are +that large are unambiguous on the M scale anyway, so the approximation +does not affect any call -- but do not quote \code{mean_dbeta} to three +decimal places for a strongly changing region. Back-transform the +endpoints yourself when the exact beta magnitude is the claim. } \examples{ From 154e56f56891433186f7892631ffd70507dba894 Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Mon, 10 Aug 2026 17:33:13 -0400 Subject: [PATCH 16/17] fix: honest degrees of freedom -- guard n <= p, add df_mode = "residual" The conjugate update a_n = a0 + n/2 makes nu = 2*a_n a function of the sample size alone and never of the number of coefficients p. That is the literal NIG result and correct given the stated prior, but the default prior (Lambda0 = 0.01 I) was only ever meant to be uninformative, and the reference-prior answer -- the one lm() gives -- is n - p. The posterior scale is too small by exactly sqrt(n / (n - p)), so the error grows with p/n and bites hardest on interaction designs at small n. Measured on the packaged vitamin C data with ~ condition + passage (n = 8, p = 3): BREAD reported df = 8.002 and scale 0.04715 where lm gives df = 5 and se 0.05559. Switching to df_mode = "residual" moves 24 of 93 hypermethylated and 5 of 50 hypomethylated regions to inconclusive -- 20% of the directional calls were an artefact of the optimistic df. Two changes: * fit_bread(df_mode = c("conjugate", "residual")). "conjugate" stays the default so existing results reproduce; "residual" uses a_n = a0 + (n - p)/2 and reproduces the classical t_{n-p} marginal, matching lm() exactly as Lambda0 -> 0 (tested at lambda0 = 1e-8). Recorded in fit@params$df_mode and fit@model$df_mode. Ignored by the brms backend, which samples sigma^2 directly. * Regions with n <= p are dropped with error = "n <= number of coefficients" rather than fitted. With no residual information the residuals are identically zero, b_n collapses to b0, and the scale collapses with it: on pure noise at n = p = 4 the old path returned a scale ~7x tighter than at n = 8 and a credible interval excluding zero. Only n < 2 was guarded before. Also warns once per fit -- not once per region -- when any fitted region has fewer than 3 residual degrees of freedom. test-classes.R pins the fit@model field names as a deliberate contract; updated for the added df_mode field. --- NEWS.md | 24 ++++++ R/fit_bread.R | 20 ++++- R/fit_summary.R | 64 +++++++++++++- man/fit_bread.Rd | 10 +++ man/fit_bread_summary.Rd | 40 ++++++++- tests/testthat/test-classes.R | 3 +- tests/testthat/test-df-mode.R | 154 ++++++++++++++++++++++++++++++++++ 7 files changed, 308 insertions(+), 7 deletions(-) create mode 100644 tests/testthat/test-df-mode.R diff --git a/NEWS.md b/NEWS.md index 6fdf087..36da4e7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,13 @@ First release candidate, prepared for Bioconductor submission. difference, and it sees a more honest one. * **`results()` gains six columns**: `prob_rope`, `ref_beta`, `mean_dbeta`, `dbeta_lo`, `dbeta_hi`, `delta_beta`. +* **Regions with `n <= p` are now dropped** with + `error = "n <= number of coefficients"` instead of being fitted. Such a + design leaves no residual information about \eqn{\sigma^2}: the residuals + are identically zero, `b_n` collapses to `b0`, and the posterior scale + collapses with it. On pure noise at `n = p = 4` the old behaviour returned + a scale ~7x tighter than at `n = 8` and a credible interval excluding zero. + Only `n < 2` was previously guarded. * **`n_features_in` now counts distinct region IDs**, not `GRanges` ranges. When several ranges share a `region_id` — the only way to pin a region to an exact probe set — the old counter reported the range count, printing @@ -31,6 +38,23 @@ First release candidate, prepared for Bioconductor submission. ## New features +* **`df_mode` argument to `fit_bread()`** (conjugate backend), choosing how + the posterior degrees of freedom are computed: + - `"conjugate"` (default, unchanged behaviour) — \eqn{a_n = a_0 + n/2}, so + \eqn{\nu = 2a_n} depends on the sample size only and never on the number + of coefficients \eqn{p}. + - `"residual"` — \eqn{a_n = a_0 + (n-p)/2}, reproducing the classical + \eqn{t_{n-p}} marginal and matching `lm()` intervals as + \eqn{\Lambda_0 \to 0}. + + With the weak default prior the two differ by exactly + \eqn{\sqrt{n/(n-p)}} on the posterior scale — negligible when + \eqn{p \ll n}, but ~17% at `n = 16, p = 5`, a routine interaction design. + `"conjugate"` remains the default so existing results are reproducible; + `"residual"` is recommended whenever the prior is weak and \eqn{p > 1}. +* **A single warning per fit when regions have fewer than 3 residual degrees + of freedom**, reporting how many of the fitted regions are affected rather + than warning once per region. * `fit_bread()` — end-to-end pipeline: validate → map → summarize → fit Bayesian region-level model → classify. Default backend is a conjugate Normal-Inverse-Gamma posterior computed analytically (no MCMC). diff --git a/R/fit_bread.R b/R/fit_bread.R index 5a07588..93c8fbe 100644 --- a/R/fit_bread.R +++ b/R/fit_bread.R @@ -61,6 +61,14 @@ #' @param input_scale `"M"` or `"Beta"`. `NULL` auto-detects from value range. #' @param backend One of `"conjugate"` (default) or `"brms"`. #' @param prior Optional [bread_prior()] object (conjugate backend only). +#' @param df_mode Degrees-of-freedom convention for the conjugate backend: +#' `"conjugate"` (default, \eqn{a_n = a_0 + n/2}) or `"residual"` +#' (\eqn{a_n = a_0 + (n-p)/2}), which reproduces the classical +#' \eqn{t_{n-p}} marginal and matches `lm()` intervals under a weak prior. +#' The default overstates precision by a factor \eqn{\sqrt{n/(n-p)}} on the +#' posterior scale — negligible when \eqn{p \ll n}, material for interaction +#' designs at small \eqn{n}. Ignored by `backend = "brms"`, which samples +#' \eqn{\sigma^2} directly. See [fit_bread_summary()]. #' @param ... Additional arguments forwarded to the backend. For #' `backend = "brms"`, this accepts `iter`, `chains`, `cores`, `seed`, etc. #' @@ -107,10 +115,18 @@ fit_bread <- function(x, features, design, input_scale = NULL, backend = c("conjugate", "brms"), prior = NULL, + df_mode = c("conjugate", "residual"), ...) { the_call <- match.call() summary_fun <- match.arg(summary_fun) backend <- match.arg(backend) + df_mode <- match.arg(df_mode) + if (identical(backend, "brms") && !missing(df_mode) && + identical(df_mode, "residual")) { + message("`df_mode` is ignored for backend = \"brms\": MCMC samples ", + "sigma^2 directly, so the residual degrees of freedom are ", + "already accounted for.") + } delta_default <- missing(delta) # Accept a matrix (what openSesame() hands you) as readily as a @@ -184,7 +200,8 @@ fit_bread <- function(x, features, design, coldata = SummarizedExperiment::colData(se), design = design, contrast = contrast, - prior = prior + prior = prior, + df_mode = df_mode ), brms = fit_bread_brms( region_mat = region_mat, @@ -226,6 +243,7 @@ fit_bread <- function(x, features, design, ref_beta = ref_beta, summary_fun = summary_fun, backend = backend, + df_mode = if (identical(backend, "conjugate")) df_mode else NA_character_, min_probes = min_probes, feature_class_col = if (is.null(feature_class_col)) NA_character_ else feature_class_col ), diff --git a/R/fit_summary.R b/R/fit_summary.R index 35271e4..66a2197 100644 --- a/R/fit_summary.R +++ b/R/fit_summary.R @@ -56,11 +56,37 @@ bread_prior <- function(mu0 = NULL, Lambda0 = NULL, #' \deqn{\Lambda_n = X^\top X + \Lambda_0,\quad \mu_n = \Lambda_n^{-1}(X^\top y + \Lambda_0 \mu_0),} #' \deqn{a_n = a_0 + n/2,\quad b_n = b_0 + \tfrac{1}{2}(y^\top y + \mu_0^\top \Lambda_0 \mu_0 - \mu_n^\top \Lambda_n \mu_n).} #' +#' @section Degrees of freedom (`df_mode`): +#' The marginal posterior of a coefficient is a Student-t with +#' \eqn{\nu = 2 a_n} degrees of freedom. Under the textbook conjugate update +#' \eqn{a_n = a_0 + n/2}, so \eqn{\nu} depends on the sample size **only** and +#' never on the number of coefficients \eqn{p}. With the weak default prior +#' (\eqn{\Lambda_0 = 0.01 I}) that overstates precision: the reference-prior +#' answer, and the one `lm()` gives, is \eqn{n - p}. The discrepancy is exactly +#' a factor \eqn{\sqrt{n/(n-p)}} on the posterior scale, so it grows with +#' \eqn{p/n} and bites hardest on interaction designs at small \eqn{n}. +#' +#' - `"conjugate"` (default): \eqn{a_n = a_0 + n/2}. The literal conjugate +#' result; correct given the stated prior, but optimistic when that prior was +#' only ever meant to be uninformative. +#' - `"residual"`: \eqn{a_n = a_0 + (n - p)/2}. Reproduces the classical +#' \eqn{t_{n-p}} marginal, matching `lm()` confidence intervals as +#' \eqn{\Lambda_0 \to 0}. Recommended whenever the prior is weak and +#' \eqn{p > 1}. +#' +#' Regions with `n <= p` carry no residual information about +#' \eqn{\sigma^2}: the residuals are identically zero, `b_n` collapses to +#' `b0`, and the posterior scale collapses with it. Such regions are dropped +#' (`error = "n <= number of coefficients"`) under **both** modes rather than +#' returned with a spuriously tight interval. +#' #' @param region_mat Region-by-sample numeric matrix (from [summarize_features()]). #' @param coldata Sample metadata ([S4Vectors::DataFrame] or `data.frame`). #' @param design One-sided formula. #' @param contrast Character coefficient name of interest. #' @param prior A [bread_prior()] object (or `NULL` for defaults). +#' @param df_mode `"conjugate"` (default) or `"residual"`. See the +#' *Degrees of freedom* section. #' #' @return A list with: #' - `fits`: per-region list of `list(mu_n, Lambda_n_inv, a_n, b_n, n, error)` @@ -69,12 +95,15 @@ bread_prior <- function(mu0 = NULL, Lambda0 = NULL, #' - `contrast`, `contrast_idx`: contrast name and its column index in `X` #' - `region_ids`: rownames of `region_mat` #' - `prior`: the prior applied (with `mu0`/`Lambda0` filled in) +#' - `df_mode`: the degrees-of-freedom convention used #' #' @importFrom methods is #' @importFrom stats model.matrix #' @keywords internal fit_bread_summary <- function(region_mat, coldata, design, contrast, - prior = NULL) { + prior = NULL, + df_mode = c("conjugate", "residual")) { + df_mode <- match.arg(df_mode) if (!is.matrix(region_mat)) { stop("`region_mat` must be a numeric matrix (regions \u00d7 samples).", call. = FALSE) @@ -117,10 +146,13 @@ fit_bread_summary <- function(region_mat, coldata, design, contrast, mu0 = prior$mu0, Lambda0 = prior$Lambda0, a0 = prior$a0, - b0 = prior$b0) + b0 = prior$b0, + df_mode = df_mode) }) names(fits) <- rownames(region_mat) + .warn_low_residual_df(fits, p, df_mode) + list( fits = fits, design_matrix = X, @@ -129,14 +161,32 @@ fit_bread_summary <- function(region_mat, coldata, design, contrast, contrast_idx = contrast_idx, region_ids = rownames(region_mat), prior = prior, + df_mode = df_mode, region_mat = region_mat, design = design, coldata = cd_df ) } +# Internal: one warning for the whole fit, not one per region. +.warn_low_residual_df <- function(fits, p, df_mode) { + ok <- vapply(fits, function(f) is.na(f$error), logical(1)) + if (!any(ok)) return(invisible(NULL)) + low <- ok & vapply(fits, function(f) isTRUE((f$n - p) < 3L), logical(1)) + if (!any(low)) return(invisible(NULL)) + extra <- if (identical(df_mode, "conjugate")) { + " Intervals there are optimistic; consider df_mode = \"residual\"." + } else "" + warning(sprintf( + "%d of %d fitted region(s) have fewer than 3 residual degrees of freedom (n - p < 3).%s", + sum(low), sum(ok), extra), call. = FALSE) + invisible(NULL) +} + # Internal: conjugate NIG posterior for one region -.fit_one_region <- function(y, X, mu0, Lambda0, a0, b0) { +.fit_one_region <- function(y, X, mu0, Lambda0, a0, b0, + df_mode = c("conjugate", "residual")) { + df_mode <- match.arg(df_mode) p <- length(mu0) ok <- !is.na(y) y <- y[ok] @@ -152,6 +202,10 @@ fit_bread_summary <- function(region_mat, coldata, design, contrast, error = reason ) if (n < 2L) return(na_fit("too few non-NA samples")) + # No residual information about sigma^2: residuals are identically zero, so + # b_n collapses to b0 and the posterior scale collapses with it. Returning a + # fit here yields intervals that are tight for purely numerical reasons. + if (n <= p) return(na_fit("n <= number of coefficients")) XtX <- crossprod(X) Xty <- drop(crossprod(X, y)) @@ -164,7 +218,9 @@ fit_bread_summary <- function(region_mat, coldata, design, contrast, rhs <- Xty + drop(Lambda0 %*% mu0) mu_n <- drop(Lambda_n_inv %*% rhs) - a_n <- a0 + n / 2 + # "residual" deducts the p coefficients the design spends, reproducing the + # classical t_{n-p} marginal; "conjugate" is the literal NIG update. + a_n <- a0 + (n - if (identical(df_mode, "residual")) p else 0L) / 2 qprior <- drop(crossprod(mu0, Lambda0 %*% mu0)) qpost <- drop(crossprod(mu_n, Lambda_n %*% mu_n)) b_n <- b0 + 0.5 * (sum(y^2) + qprior - qpost) diff --git a/man/fit_bread.Rd b/man/fit_bread.Rd index f0416d2..45cbd86 100644 --- a/man/fit_bread.Rd +++ b/man/fit_bread.Rd @@ -24,6 +24,7 @@ fit_bread( input_scale = NULL, backend = c("conjugate", "brms"), prior = NULL, + df_mode = c("conjugate", "residual"), ... ) } @@ -80,6 +81,15 @@ columns. \code{NULL} (default) uses each region's own mean. See \item{prior}{Optional \code{\link[=bread_prior]{bread_prior()}} object (conjugate backend only).} +\item{df_mode}{Degrees-of-freedom convention for the conjugate backend: +\code{"conjugate"} (default, \eqn{a_n = a_0 + n/2}) or \code{"residual"} +(\eqn{a_n = a_0 + (n-p)/2}), which reproduces the classical +\eqn{t_{n-p}} marginal and matches \code{lm()} intervals under a weak prior. +The default overstates precision by a factor \eqn{\sqrt{n/(n-p)}} on the +posterior scale — negligible when \eqn{p \ll n}, material for interaction +designs at small \eqn{n}. Ignored by \code{backend = "brms"}, which samples +\eqn{\sigma^2} directly. See \code{\link[=fit_bread_summary]{fit_bread_summary()}}.} + \item{...}{Additional arguments forwarded to the backend. For \code{backend = "brms"}, this accepts \code{iter}, \code{chains}, \code{cores}, \code{seed}, etc.} } diff --git a/man/fit_bread_summary.Rd b/man/fit_bread_summary.Rd index 6c1c7fa..805bc1f 100644 --- a/man/fit_bread_summary.Rd +++ b/man/fit_bread_summary.Rd @@ -4,7 +4,14 @@ \alias{fit_bread_summary} \title{Fit BREAD summary-mode Bayesian model} \usage{ -fit_bread_summary(region_mat, coldata, design, contrast, prior = NULL) +fit_bread_summary( + region_mat, + coldata, + design, + contrast, + prior = NULL, + df_mode = c("conjugate", "residual") +) } \arguments{ \item{region_mat}{Region-by-sample numeric matrix (from \code{\link[=summarize_features]{summarize_features()}}).} @@ -16,6 +23,9 @@ fit_bread_summary(region_mat, coldata, design, contrast, prior = NULL) \item{contrast}{Character coefficient name of interest.} \item{prior}{A \code{\link[=bread_prior]{bread_prior()}} object (or \code{NULL} for defaults).} + +\item{df_mode}{\code{"conjugate"} (default) or \code{"residual"}. See the +\emph{Degrees of freedom} section.} } \value{ A list with: @@ -26,6 +36,7 @@ A list with: \item \code{contrast}, \code{contrast_idx}: contrast name and its column index in \code{X} \item \code{region_ids}: rownames of \code{region_mat} \item \code{prior}: the prior applied (with \code{mu0}/\code{Lambda0} filled in) +\item \code{df_mode}: the degrees-of-freedom convention used } } \description{ @@ -45,4 +56,31 @@ Posterior: \deqn{a_n = a_0 + n/2,\quad b_n = b_0 + \tfrac{1}{2}(y^\top y + \mu_0^\top \Lambda_0 \mu_0 - \mu_n^\top \Lambda_n \mu_n).} } +\section{Degrees of freedom (\code{df_mode})}{ + +The marginal posterior of a coefficient is a Student-t with +\eqn{\nu = 2 a_n} degrees of freedom. Under the textbook conjugate update +\eqn{a_n = a_0 + n/2}, so \eqn{\nu} depends on the sample size \strong{only} and +never on the number of coefficients \eqn{p}. With the weak default prior +(\eqn{\Lambda_0 = 0.01 I}) that overstates precision: the reference-prior +answer, and the one \code{lm()} gives, is \eqn{n - p}. The discrepancy is exactly +a factor \eqn{\sqrt{n/(n-p)}} on the posterior scale, so it grows with +\eqn{p/n} and bites hardest on interaction designs at small \eqn{n}. +\itemize{ +\item \code{"conjugate"} (default): \eqn{a_n = a_0 + n/2}. The literal conjugate +result; correct given the stated prior, but optimistic when that prior was +only ever meant to be uninformative. +\item \code{"residual"}: \eqn{a_n = a_0 + (n - p)/2}. Reproduces the classical +\eqn{t_{n-p}} marginal, matching \code{lm()} confidence intervals as +\eqn{\Lambda_0 \to 0}. Recommended whenever the prior is weak and +\eqn{p > 1}. +} + +Regions with \code{n <= p} carry no residual information about +\eqn{\sigma^2}: the residuals are identically zero, \code{b_n} collapses to +\code{b0}, and the posterior scale collapses with it. Such regions are dropped +(\code{error = "n <= number of coefficients"}) under \strong{both} modes rather than +returned with a spuriously tight interval. +} + \keyword{internal} diff --git a/tests/testthat/test-classes.R b/tests/testthat/test-classes.R index 99f2985..10ddad1 100644 --- a/tests/testthat/test-classes.R +++ b/tests/testthat/test-classes.R @@ -49,8 +49,9 @@ test_that("the model list shape is a stable contract", { expect_identical( names(fit@model), c("fits", "design_matrix", "coef_names", "contrast", "contrast_idx", - "region_ids", "prior", "region_mat", "design", "coldata") + "region_ids", "prior", "df_mode", "region_mat", "design", "coldata") ) + expect_identical(fit@model$df_mode, "conjugate") expect_true(is.matrix(fit@model$region_mat)) expect_identical(rownames(fit@model$region_mat), fit@model$region_ids) }) diff --git a/tests/testthat/test-df-mode.R b/tests/testthat/test-df-mode.R new file mode 100644 index 0000000..f061b7f --- /dev/null +++ b/tests/testthat/test-df-mode.R @@ -0,0 +1,154 @@ +# Degrees-of-freedom handling: the n <= p guard and the "residual" mode. +# +# Motivation: `a_n = a0 + n/2` makes nu = 2*a_n a function of n alone, never of +# p. Under the weak default prior that overstates precision by exactly +# sqrt(n / (n - p)) on the posterior scale, and at n == p the residuals are +# identically zero so the scale collapses to the prior floor. + +# --- helpers --------------------------------------------------------------- + +# Region x sample matrix with a known design; y is pure noise unless `beta` set. +sim_mat <- function(n_per_cell, n_regions = 5L, sd = 1, beta = 0, seed = 1L) { + set.seed(seed) + g <- rep(c("a", "b"), each = 2L * n_per_cell) + t <- rep(rep(c("x", "y"), each = n_per_cell), 2L) + cd <- data.frame(g = factor(g), t = factor(t)) + X <- stats::model.matrix(~ g * t, cd) + k <- which(colnames(X) == "gb:ty") + eta <- as.numeric(X[, k]) * beta + m <- matrix(rep(eta, each = n_regions) + stats::rnorm(n_regions * nrow(cd), sd = sd), + nrow = n_regions, dimnames = list(paste0("R", seq_len(n_regions)), rownames(cd))) + list(mat = m, cd = cd, p = ncol(X), contrast = "gb:ty") +} + +fit_one <- function(s, df_mode = "conjugate", prior = NULL) { + BREAD:::fit_bread_summary(s$mat, s$cd, ~ g * t, s$contrast, + prior = prior, df_mode = df_mode) +} + +# --- the n <= p guard ------------------------------------------------------ + +test_that("regions with n == p are dropped rather than fitted", { + s <- sim_mat(n_per_cell = 1L) # n = 4, p = 4 + expect_identical(s$p, 4L) + f <- suppressWarnings(fit_one(s)) + errs <- vapply(f$fits, function(z) z$error, character(1)) + expect_true(all(errs == "n <= number of coefficients")) + expect_true(all(vapply(f$fits, function(z) is.na(z$a_n), logical(1)))) +}) + +test_that("the n <= p guard applies under both df_mode settings", { + s <- sim_mat(n_per_cell = 1L) + for (dm in c("conjugate", "residual")) { + f <- suppressWarnings(fit_one(s, df_mode = dm)) + expect_true(all(vapply(f$fits, function(z) z$error, character(1)) == + "n <= number of coefficients")) + } +}) + +test_that("n < 2 still reports the pre-existing reason", { + s <- sim_mat(n_per_cell = 2L) + s$mat[1, ] <- NA_real_ + s$mat[1, 1] <- 0.5 # a single non-NA sample + f <- suppressWarnings(fit_one(s)) + expect_identical(f$fits[[1]]$error, "too few non-NA samples") +}) + +test_that("n > p fits normally and carries no error", { + s <- sim_mat(n_per_cell = 3L) # n = 12, p = 4 + f <- fit_one(s) + expect_true(all(is.na(vapply(f$fits, function(z) z$error, character(1))))) +}) + +# --- low residual df warns once, not per region --------------------------- + +test_that("fewer than 3 residual df warns exactly once for the whole fit", { + s <- sim_mat(n_per_cell = 2L, n_regions = 10L) # n = 8, p = 4 -> n - p = 4 + expect_silent(fit_one(s)) + + s2 <- sim_mat(n_per_cell = 2L, n_regions = 10L) + s2$cd$z <- factor(rep(c("u", "v"), length.out = nrow(s2$cd))) + # ~ g * t + z -> p = 5, n = 8, n - p = 3 -> still silent + f5 <- BREAD:::fit_bread_summary(s2$mat, s2$cd, ~ g * t + z, "gb:ty") + expect_true(is.list(f5$fits)) + + s3 <- sim_mat(n_per_cell = 2L, n_regions = 10L) + s3$mat[, 1:3] <- NA_real_ # n drops to 5, p = 4 -> n - p = 1 + w <- capture_warnings(fit_one(s3)) + expect_length(w, 1L) + expect_match(w, "residual degrees of freedom", fixed = FALSE) +}) + +test_that("the warning names df_mode = residual only in conjugate mode", { + s <- sim_mat(n_per_cell = 2L, n_regions = 4L) + s$mat[, 1:3] <- NA_real_ + expect_match(capture_warnings(fit_one(s, df_mode = "conjugate")), + "df_mode") + expect_false(any(grepl("df_mode", + capture_warnings(fit_one(s, df_mode = "residual"))))) +}) + +# --- residual mode reproduces the classical answer ------------------------ + +test_that("df_mode = 'residual' matches lm() df and standard error", { + s <- sim_mat(n_per_cell = 4L, n_regions = 3L, seed = 7L) # n = 16, p = 4 + # weak prior so the posterior should collapse onto OLS + pr <- bread_prior(lambda0 = 1e-8, a0 = 1e-8, b0 = 1e-8) + f <- fit_one(s, df_mode = "residual", prior = pr) + k <- f$contrast_idx + + for (i in seq_len(nrow(s$mat))) { + ml <- stats::lm(s$mat[i, ] ~ g * t, data = s$cd) + fo <- f$fits[[i]] + scale_b <- sqrt((fo$b_n / fo$a_n) * fo$Lambda_n_inv[k, k]) + expect_equal(2 * fo$a_n, ml$df.residual, tolerance = 1e-5) + expect_equal(scale_b, summary(ml)$coefficients[k, 2], tolerance = 1e-4) + expect_equal(fo$mu_n[k], unname(coef(ml)[k]), tolerance = 1e-5) + } +}) + +test_that("conjugate vs residual differ by exactly sqrt(n / (n - p))", { + s <- sim_mat(n_per_cell = 4L, n_regions = 3L, seed = 11L) # n = 16, p = 4 + pr <- bread_prior(lambda0 = 1e-8, a0 = 1e-8, b0 = 1e-8) + fc <- fit_one(s, df_mode = "conjugate", prior = pr) + fr <- fit_one(s, df_mode = "residual", prior = pr) + k <- fc$contrast_idx + + sc <- vapply(fc$fits, function(z) sqrt((z$b_n / z$a_n) * z$Lambda_n_inv[k, k]), 0) + sr <- vapply(fr$fits, function(z) sqrt((z$b_n / z$a_n) * z$Lambda_n_inv[k, k]), 0) + n <- 16L; p <- 4L + expect_equal(unname(sr / sc), rep(sqrt(n / (n - p)), length(sc)), tolerance = 1e-5) +}) + +test_that("residual mode widens credible intervals", { + s <- sim_mat(n_per_cell = 4L, n_regions = 5L, seed = 3L) + pr <- bread_prior(lambda0 = 1e-8, a0 = 1e-8, b0 = 1e-8) + pc <- posterior_summary(fit_one(s, "conjugate", pr)) + prr <- posterior_summary(fit_one(s, "residual", pr)) + expect_true(all((prr$ci_hi - prr$ci_lo) > (pc$ci_hi - pc$ci_lo))) + expect_equal(prr$mean_effect, pc$mean_effect, tolerance = 1e-6) +}) + +# --- end-to-end through fit_bread() --------------------------------------- + +test_that("fit_bread() accepts df_mode and records it in params", { + skip_if_not_installed("SummarizedExperiment") + se <- .make_toy_signal_se(); gr <- .make_toy_features() + fit_c <- fit_bread(se, gr, ~ group) + fit_r <- fit_bread(se, gr, ~ group, df_mode = "residual") + + expect_identical(fit_c@params$df_mode, "conjugate") + expect_identical(fit_r@params$df_mode, "residual") + + rc <- results(fit_c); rr <- results(fit_r) + ok <- is.na(rc$error) & is.na(rr$error) + expect_true(any(ok)) + expect_true(all(rr$df[ok] < rc$df[ok])) + expect_true(all(rr$scale[ok] >= rc$scale[ok])) + expect_equal(rr$mean_effect[ok], rc$mean_effect[ok], tolerance = 1e-8) +}) + +test_that("df_mode is rejected when misspelled", { + se <- .make_toy_signal_se(); gr <- .make_toy_features() + expect_error(fit_bread(se, gr, ~ group, df_mode = "residuals")) +}) From 99a66d44859966c9aa32b15cb39f9a973e4fd19b Mon Sep 17 00:00:00 2001 From: Jaemin Park Date: Tue, 11 Aug 2026 13:48:21 -0400 Subject: [PATCH 17/17] docs: add hex sticker logo to README, pkgdown and vignettes man/figures/logo.png is picked up automatically by pkgdown for the navbar brand, the home-page header and the og:image card, so _pkgdown.yml needs no change. The README uses the anchor-wrapped form; pkgdown strips both the bare and anchored variants from the homepage body (tweak_homepage_html matches .//h1/img and .//h1/a/img) before inserting its own sidebar logo, so the logo is not duplicated there. The vignettes embed the logo as a base64 data URI via knitr::image_uri() rather than linking ../man/figures/logo.png. A plain relative link would work in the tarball -- html_vignette is self-contained, so pandoc inlines it -- but it breaks on the pkgdown site: copy_article_images() only copies resources whose path is a child of the vignette directory, and a parent- escaping path is dropped. Resolving the file at knit time sidesteps this; pkgdown's check_missing_images() skips any src with a non-empty URI scheme and handles data:image explicitly in its alt-text check. Verified: R CMD build ships BREAD/man/figures/logo.png and nothing from data-raw/ or pkgdown/; an isolated html_vignette render of the logo chunk emits one data URI, zero leftover relative paths, and the alt attribute. README.md was hand-mirrored rather than regenerated -- the edit is a single line above every code chunk and github_document passes raw HTML through verbatim, so build_readme() would only have re-run the live model fits and churned unrelated numbers into a logo commit. --- README.Rmd | 2 +- README.md | 2 +- man/figures/logo.png | Bin 0 -> 11960 bytes vignettes/bread-intro.Rmd | 10 ++++++++++ vignettes/bread-vitc.Rmd | 10 ++++++++++ 5 files changed, 22 insertions(+), 2 deletions(-) create mode 100644 man/figures/logo.png diff --git a/README.Rmd b/README.Rmd index 2eb8e6e..f84623f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -14,7 +14,7 @@ knitr::opts_chunk$set( ) ``` -# BREAD +# BREAD BREAD website [![R-CMD-check](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/BacZemin/BREAD/actions/workflows/R-CMD-check.yaml) diff --git a/README.md b/README.md index 0812e8e..28b278e 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ -# BREAD +# BREAD BREAD website diff --git a/man/figures/logo.png b/man/figures/logo.png new file mode 100644 index 0000000000000000000000000000000000000000..087f2c0762b67e60d46bdc15da6b7ff60ef8196a GIT binary patch literal 11960 zcma)iWmsHW(k>P>1P{U8-5r89?ykYz8`lsB4uRl70t9z=w;+K4!Cit|PWN>Iep$=KA^9879rZfWfxM1I`TK~8FICPc2qrNFA- zByMhHE$!`MuI8<%Zt87o%4bF{B8)8P$qxvyHwPP&dfMALxbk}nk^hm)4}5>V%tB83 zhXrgaM6Ru%Oe*f^Vou7%%*D(~E{sen=wfEUuPPz+kIleJh};SccH(DY@$m3q_TXT4 zbg^V%BL0#gVeV?`V(kRBc61s2B zpH|!3{|6pdu%tWSxPJuUf8F7#?&W08qH6By=;mT-F6j=~Me)aXfHr<{7jt8hB*V`AmuXJ!4HTfx!H+QRF9<7Q{$=j8gI+(15=8H0`g zfB6575dSmxU#Ngw{(nRI*CugCJ4Y7)9bg5=AGH4>$%u<9yEs}{+W|CJRgf5|jHEa> z8y`0}6FW28AKvH4@he+tB2SXjcQu5m51$ z$mi(t%h(%Rnrm5`fvx@}?Oz0Wa|g>mlz&M2LwSypo!fI+XgF8{ab^Fb61>q~}5-6*M#DH+_z;qsyQ5U!|vJ?)=y4uce)}u&l8;se-iwsj{()tsu*D zIRY2|RN`N&f9?=u`5ywG6@ab5cIN*kUepf!pW>g(ncvRX!BU9algZ57!r09YOfD>@ zDk&;qWM%GYmDf7}bW>MyFRqXpQ**u`Ab5~vX&a#0HlYaj|e>1=75<0OwWI>0ha&Wf&Yd2FO&bR9RmCQx(2japkK56-LQeh-!0$V0jLcZ zprOCkJ|={Mf_`reB>8_OHxv|YoLk%&gMDQ(#x%j` zODfNq#jktMwyST0nsfBBcK5m`xRn~yvKVwa!|}6Uw*@)4;`tg}$F}{Cg$jJeUTAUV zTKq^O{=UUXf%%HQ#`R2giQ|HE-5AkPp6ep6s0fLE{*FmQvGvHsMnm|jf{QvnA6es~ zyQkPeyW6xIiy`UgB&kwMVF0t6rrTefnbvn>2SP5wmrj3L&?Ci(36l)cmU&peX3?CK z($qGLVfmt?DR<>;xURTmkxx}0*bxV@-P;5;gLUh z4}o_q@$Br5^@RFXO6TlQ^b9}UFrn_6JH1SNzm1r~L`1c&QEqbe_nWk>ufLJ;Uq=Wr z9J+!L#x-t=aS+ zbhbd;2K@l>76#_w^pUtgN@bc!Wi zQB@`?XvacVUUR&TQJ`FUsgT*bzj4XSaa#Yt6XjtwMjjq+U){&*N| z+Ri)^>VS2nl&D{r9&}%@tzN2kXx>*XM4U8uFD72UAp3p=b|!}Jp4_S7o&B4XOkEsm z*L6Ip`UUk)kM|@6(wDHSmO*u7f?RdL_8lt(3D= zIH-Ohp>rnC$Shu%&?$Q&ja}&B3Hni^l3Sv>bUA7x3M1C8!5%&no^f~LqpvuxfIAlI zok}4%rFbTnEx}AR3bs+ElDk!SaBmdRqRrE+#UA>E(#gHKc3c|W@{U=oy{qx+*DdBq z9f1lhS1NW3N~2CCH(}O0H%sgqO~L9V3n+i2#V<16S~LE>uLQo+5r2h)ZtIIEvQfyN zx>j2K5>(gq#rk7vZz&dlBfL|nvnMcxxou@UrsNK)I>Adz50~_*T#K904*?+i+VgV zxZ}$zU?eq1(@v$zCp*V$2Usa(mL#fKL;>t&FFk{2DJ}MD4I#Z?$uutMy?TGgA#=Pd647u>TdmLQ0WFHomcY`dUC%km zcm<1wIQ>!i(T2+lSyQm*AQQ1DoFC9Vq0}$W(afj3#*33te>fJv1R`-=dPm`OBTZvndw+M+_6fHb zN`h-(wPqfXbf_!{LL44aFoB9&@aoOSE}qEy5u#yIuTnT2+Zq8RSaF~TOmdzagJch{ zz~$yIdbWk1Zx~o-9KQd$g}iq15iTR~!gy9V(An_pa-ks0uQnoZ;Kwd+9OG*LG%QC|8FxAeM|+wf=-O+*4IN zxaLZ_f-*U>l!|(90h{~5+9K7jl|HIaNkLxKuI~z|DnDOU*At;;%nX-GMD#*%0v|A2 z0n$y2OG&UWfn=Y;BB+qDP5eX-{m~)?u!v1`e;_#5-;DCPQDD@_E@q0_q-R856CIAo z1N$ffrehP8C{WJBv4|Cf+ms5HQX!;>RZqcjD;S^5Ql)ui zIWdXsog`HxY=7o(?ES^x9smb8195|(h1VqWyNMkeF2EmY;dN?7eBo%z~t@EXT zGivjRkMEl(8!$f?eg=M-Vu)0UNpt&sJmrQn!bu~Hr@lYTBdho4_v;ZR5eyM*$vVok zIFo8kwTL@%uT9dDeFb^5J;k7DVm^~#muhq$Uyi%wL>_%!qLoM`uOa@d6Piui@)$~r zNO4uPwh|gkMmmgHP5FV5OzBh(8wmvJ+jM^sCP6upM=iUR$nGeLBdZ}rT|p^g2mzlR&Y<)o?unc}~Grl)>1qXs``w-*oY9=61}4 zFruh473W(xGuhbdGW<#~Vblw%GVxl3bbr3JhHHgxRsxUv<)G9_ee=x>&$*e(Jw`!( zft-k+r~5&yOe%YtlpgCz2goBim2Xzqe3;<|=W&rN!?_h8=2~>yp#EC<0^K6#vP4?) zV)d|yO_Bm^BrMd>xNhT|HT1YZk~;XI?Nr(lMiZ+}x#K}*e%<+0o&aJlx&5Db;HEp$ zv$tIl1IG~8gSQMHmOf}lxG`$0Mrh*RNzrrZs(TC3XBf9Co26RuO3dO)L`ZzfiE|b) zr(1DHhgRX6Xr{xE^4ID&WZ=?;TPjLH9aj!>>IC&3=YEs_`fVi4^*hMOqcnu6gwFCY z;>AwnM88+cYh*=1RrQ>*IYqr1BGb5}-z6m~ML4u|{J*?m=`)B$G4{=d;w5H}DKKB6 zqr!&=2Td+EC7YT=Q`zm>8k4z$wt2pnTMf9sm7){xXPXIV#D2sG{T;{^UYn{ zD()ps8J9KmJ2bqI5Dgy~-(KCxqzHx)wb@R7N5}Scg5YNw6RmocCMY5piC;hX!7yj7 z``~8*IX*Hb>ImTU*g0489;^ub4%FV%oZqYEJJ}?DZlnc04xMA6zJOd_k<)8fMaUOMOTHOm7*AueLiOfXx^%G% zK#6H5+v6!qxdh!=GYJvCbbSY+@NY<#yhzlhAO5K;iw^hx(~Nj0TNt*`S*xfjWmJGw zV4y2vS<@SZxbU1}n^JsKNouCc4cLQ#ia0LZ@(fLA1z&w(kOYOws{<>_RY;Ym7moSa z{!g4_au9{5ck>DAc}83}UL>Q;btwGFxjO|Y7XVFbq&!fqF%|6V|EhIHno`gY>(?YX zu}nPgc^7n$u!x+dx{9jS2iXD|%#)3yqjZgjG=20teSSo*r9xCG#yU4f0|U9v{f$na zXo&)uw`$D9I!V^I*Q~olpodsK&>Tujntf#u!Zcd{JyPZ0vpRjWZYh(?w$?yv(T#k4Z5) zKJT++#@4Z4#Iwu9^MSj&x;DfSVSXjx%_8_V=Ut$ zizwP2g4Y+#^ejvKTAEYZ8kF77%qjMXfH_r3(s{ioOj+AxY~25rs7mjq+XicRkMiwX z+j?bvwc(sFiLqsxeY7c~DZv?S^pPBlle;QCQ(n5>vn2;U& zNq2VNo+P?#f3W4M#hCvqVfJbLGUR4y7^Gcq0UPj;=QB=l{=ItS2u)7_# zXKxeMhNWYre>u0Hbp~{x=uWt^cBaLg-OP9c4xAxbTiZt4KuvE}AQTktjn~D>Y6Baq zc3r)C;R&|oz}0V0{c?0INS_!XP1%j$*fAU+bW3a0Xk(lnn4XE=;kWy}vD%#nO<5y< zdwMuG0amvrBu5p6%S|}u$hu$OMl3HiEqscu#h&X}I7pU?y(0gOC^}*z;Whl7myhEW z?^+b=4)W>2mqGEvwt%m=YSuVc{tvc0s8x|nh%f|W0?91CyM~6oV~VutjZfg~Z>H%^ zQi#Dh_mITbLD`#1UMwAsBpz%aD{BwP5a>|mtgWsfl8Rx*X<^ADTeS#EnLbe;d_!|R zQr2*?xInYvU_930!)~l&@E~08_fxTxFL;G5Oe`-tV+k*m0TxF^u>*A57} zn;Tz>Lan?j-Jp?S2NH*BjAy5yWF`5e4a>lxy!}YG7Y^laCd-u@xeUW6mPTf|cYuug zt6v$!Cra!z?0PuxeY!xaGy#%ZxK5eP!cki%5|Bzh2@+h z@`S|*Vy0>D(ryh(yP;}?Cp@3^iQgKg^1@Z(#on5I)U?@3&e4qRkV6i7%bRw)OCP`L zr<1hn3Sam|M8vv%sF=PP0jq*ye@E`H=aL2^a3E_onInjDFqj;2;pWv7+>PmWR)%y& zhm9;dJk&omvxby+C?8pH6Nil)hi{8ib{B(rzAeK2cDZkId?H4c%7iZb7=#G(1~a8e zN;wRMD*xJTItX}1G(NF1lgw(wiJwWyH0h? zRSZ|m{o29f>?h=a#vE#@@23EdLvMaMoU0mPH3c!pNp&lnLRKUk2>>s(M$ll!{G6K? zy=mQaxR0EninXhAcSeFYSVw8IF=nf9T#}-E|FG7^vrN9}W?aT8-#DWB`D0xq7E3(S zM9Hjr*1h#s&{U$8Is{i8`-LWBxB)bi@_Rg}t%2li^wxgcV;q=?o6ZfwqUgLnl6=XfUqZ=chShaSH=?gDUC(!%f8nEAM5cbY z!@sEr4G`ZLAaNO(lH1Vj?VFNpY$fwnY)|tceB*~}d#<)~wXK31iLVV{h5heTIjGwr#tf=x zcX@wk-*+JjTwa|ztC7T6*|p84N%rYi=Eql4iXm7XpPhys(&8t6FZ+UXWh`TApOj)dE{k+_xK zDz|~KfbZ!Ub&H42@sJP{FZ`Ng+*Gx)8gqqpPN%nbZIAQ5$^W_mHOncZF^JeOad!RE*S+6Q?V+1~&BurQ#`x_s-u}IILN75L7 z8jG{u#izleHS04vxN|&thRrm){V&BziNn?MuZe_{aXSPc+H+=uk)F2#x5`BlwYNoj z0hEYyePmxo^EPiXyQi#787%HvPHR@|4SOeN#zAp(kz61S8tTq(Z*UIaetov@g!?Qx z@K(!zo#wZ`U^V3io{Ji1m)^7)MsSgl+h;$xDDC#5!t%kK0j?c#?2!klK|b8ru?_L0 z-=)12r1I;qKaRu{L8d&34YI(m7ge%#XUZ&^;iUA)f&KG$tTq$gdM?pW-#Hj>_sn2v z%p%51`?iPt^z#J61|mm4nS;F8y(5cgB7He>bGcG=_rQCp-_@L1E%k)}6I@4CfNK3_Z4@@uR$2(GPZ2h2rSvLkkz@h{B1 z=C@C!3D(V(NTLjCUu3o(D)MYqM8hw0aSo;!Vg`>z86t=h-k_^7d_dhRH(sKHBTScSLIC@1g~rPQ zbg9qL--!8QNfBu!pbL0{DFRu9=7sWRA16vwCm-;t9C!n+4~J zwha8nS=Wn(^THctiK3Qv5e{Z68~c6}JUPk%X-(sdBp)D;fQiGFi>M~sURSZAzC@tn zC>o2?lTaaz-;lQ9J7kqpu^uX*+WP)d1>2SQCE37wxJ&;vy~UdxTJ-SE%lgE#B+HNT zI2q1}Id3@$2Y1cv6#K9ezcqaf_F_8-=808WRJ?=X(_716ZdPlg~LqG%ai? zFB3GA6};J2zqu@YQ8W>8!L%MhbhdLWY6?sUk-Zz|hQhwXR%a9YP4;@q8Tx`iGsVQpJKIX)kE!3R8m0Lh)wYP*gQdN0(hJaX7VB(`MMRaDmmUYn%Ssfk4Lv%Ng?vY?hf*Vr0==P=i)vCZ-Zr>AD&i`QlzEZy0X`)`+amq{JQ zn#_45YV4%OZP3ER^u8J{qda{kjgjs8dyp`pN2&9$K?3f8V`g(X&rBEy~d{LwDm=91KAsZF?y|@*zv9BRb49PV%D)-ZG zJN(+&tc75+5o7Iz;5vC6S9(Jc_~*uF2MJmZ7F{HL&BCh|pYl*t!eH9prqmPjFxiVA z2+W5bwwcZ@3-nKIvurMSWM)(^nkKNyAP^O1-=X9^kt@@BDN@Dc1D3$p*=jMC5 zID7fYD8NbJarN3wdbqSN0e2rz(p8>6Tedlg%VaXFRKCX1BX-v%etdd)RNu(XlO>du zbeTQQ4tnGh8srhWJ9&$1FXS+)t0~$O64`k5(GBYUDl6^NMCquYqZ^I@zJQgrtFlVY zcK(kG!Hb&x>pLHo&O)`S!-tKtxXtn1xB}Jj@(mLI;ADV@_NnCJHs!|$wb@7KdHfvk zi6%M_n)sknAXcV|PP{DX=^ybRS7$>tjGJ&e^<_p)OGg5fh44FtCUu${G{nB(vzYsI z`*A&MvmVXkz;Rh$X)=5k>lcX~LK9g0KxV(H3<2_DVxX6fdBSDt2IXe>%gotrg@bu& zT?&xA&{3KDKdbH!^f~Y>B!tk22e zKNM)9c&h2oinOe7A6*b-=?*?U-O@-I$;FRsESQvyS~44Si#X1`c&pWco6Pflj$s=D z$#z&?SsC1_`Rusn$N#&}yWMY_&v%z5z$8G9WIrkCZ2E}%vSBpbQp|TNo+`bi895O1 za}o}U+)d9g!c9x)3hdYFUxAFnGU8YKi_kzBoUAXDz2t>Wd1-T-QNZm}M{QN-(4Lc7 z!lKQ4JC7T7GCbhXpC{m1nw1gSQbf<8{7tLs%;{>!hoyC@+g__|bwhkf@X2C0xEHpv zuwPKWzjLR|W}y9**xHVjNGUq46{PjV9p&k^*WsOK$xa@Q@8xNp;5Cp4WdYuwkMGaE z{L*+G&3#yK_Os^Bb7#&kw;}-YV|bQ(QM3$D<`})Qa;6>n!GD16{fqcs2*K{o@?2#E zk9%L{qC`@!u0^BoJ}+bBjL)j2>E^vby)05;KxW?4 z6^*nEcJ%Yd(v6PaUa?v8d3t;$a(^1)`>4invoS3$cz@8&3wh&4&&^yRk%wJ1%2D;L zJmuMMODK0^gcM?F<`CB+B`ng@~kxtI=;wsjjt%3QKJP;gRcvpTp94Vfnn>RKSpKE z_qg1($=cO#h`r%)SOIK*H#{C-dM5yMnH_>t*YRe2_;i2xbZF)!WzfStW_b%IchWfk zP2Y9g1nRNz(24Ox1HQIi;Cf(fe6MDYVb+V*T|i$b8a4#kZQb9zI|-zvA6huEcCh#X zTSoXT_f%9ZW)eASHrue75=rEOSL2tChbe*FipWS#yPMs*XYb#Byl?c&uI+hzd`DTX z!T$2N2(m~3f^NJR`YkAM?<2Q>&f|CGCAO9#ec5oHt-??VIJu!I`GM&{hUDRnP&m`G zE?j)z_U6L1YW$#LxixcHl!OE=((-WPG~wb0LXPT(A`2m1ag#ObHhb$Rb9Kf$%H{W( zf^DErzjyV%Jf83WXuVcscsjE<5L@!Ukj?ZyM1;zk)edDI9PQ_EEZ?q+Rb<_Kb-Gys zx?b=Z-6lYD*j~w8?1@fhGL?*AOCjhu6LB7Bu79996mrP)Iim&sJif5CRW8BS_kpZC z?;f?0abKu>({i=!k@Y`qL91-@U@Y=XQ+#wb!NY zxljO2GYGhOK`lDXO?new{7=xFUbHk=*fcsk}EHB$R=cPHR=5=(Nne{6)4 zyj`uJIa*8-5NG6FkeJyu%R6REk^!}Prd6>CSbe&`eVO4Op`tG9eC~dga!6{_;?~o6 z#UzCq;J<`_u8YINk*HXZeLSj9EZvznNl&w$(RL_ZEjV9%4TC|v;vR-}>A}7kvm`6x z@!Lh%=cd~E20!+4T)@-j?eW%+3%i?1<4eNb-=L?a5AkblN=E)yZyb-UHx3dD+Ihz8 z94%xrsLH7bb_=C)F#`yR7j}1C&$gHaXqxr)o5|WQZ28&V0>67ehJt~zbnHM-kCq|E z)|vhfi2Tu*u`Ip7&C^QQCD~+{J*WW`0AJJx_+LtdMojpao25n(H zfvLWt=UIS^OYSR|cb=6;Q)s5dU-R7h?$h8>xps^xc+= z*uEJFwegfk)g);+E$`7ES!wsJ&yQT5q`V9g3u&?;(w%ITj~99AD_6msRDyE!U^M8HY6YHaj~ z3a?dEqP7h;DeVNZ8~XDhy`9pz#gJi&T?5_wyFjCS1}aRajh$IZ%9Oi@mhJDTve6iF zKco`obL8U#u&#N!=09;dxk?!Th5~a2(2GgTWh-;comX<8M>813Y?^ykx3?6v*31;tx9#x zJ5g>-D%A>CFHu8fQRn|msPP-OLbSYd5L@o9!5VS@^^qMIFi@tQ=qEf!Z^>lcOsL1A@LbP&|c-X$MIouR{aC0D4Rpq!z^H?r)fui6k7nY0Pk2QaBsH_g~%C4q4c z=rL%N$#1=Lb73pvie2_USt&4n>g=&9F`&#+OI04^Giww9Gn~+VI<;Vs zgn3zaNPa*fn`jqOp0Sru&yNl#f@y~mt&6D{f_53&d5N)8I1XlwBhZ1%-X-8xH;PlmOA5xI46sA&a*=uCc2`X+# zSKQLrL3Mw|EqX01)Y654n`+lW=-+n7j)@=I_f;p=p= zN%=xbk;b~_J6q-gY!{iX2unC15wU9g7qfsw;irO z8Sf9|z7=n-ZSTTr^g+Y@cp;7+T84?jF7qJh6bsA*$$zPaN?}{a69tA^$hoKD`WxAo zrqQ4?@?HaT6YSS1df_@$m)jkNO{V?f&)^)$O!o&AyB{~nHeI4+EwdXP)TlMXp`2(= zk2~MD_3%lXtNAOz5e4o zrcSEeiLJg{GQ>B-dmMGLt;maX+5{H&^n*HNnHWG)`I>0XzAPp2L27KKHprh=4{6#e zl`q94>b>P6QEL7PW2_0_x)V2|te0l1yP(+V8IQ}j5P$CZbHS>gr|B{9%Ew6Zhv?Zf zM))C7tacCAG$y#rRH7a{qoaP(Z@ba4sXMC{Zr', + knitr::image_uri(.logo) + )) +} +``` + ## Why BREAD? Many methylation studies are not purely discovery-oriented. Instead of diff --git a/vignettes/bread-vitc.Rmd b/vignettes/bread-vitc.Rmd index c88d575..a093029 100644 --- a/vignettes/bread-vitc.Rmd +++ b/vignettes/bread-vitc.Rmd @@ -20,6 +20,16 @@ knitr::opts_chunk$set( set.seed(2026) ``` +```{r logo, echo=FALSE, results="asis"} +.logo <- "../man/figures/logo.png" +if (file.exists(.logo)) { + cat(sprintf( + 'BREAD hex logo', + knitr::image_uri(.logo) + )) +} +``` + ## Biological question Ascorbic acid (vitamin C) is a cofactor for TET dioxygenases, which oxidize