--- title: "5. Case study: confounder audit" author: "Abdelkarim Hani Ghrieb" date: "`r Sys.Date()`" output: BiocStyle::html_document: toc: true toc_float: true vignette: > %\VignetteIndexEntry{5. Case study: confounder audit} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r confounder-setup, include = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` # Status note This is a synthetic-data walkthrough used to verify `design_audit()` behavior on a deliberately confounded cohort. It is a vignette, not a study. The narrative follows the *three-tier* structure used across the case studies: a **naive analysis** first, then **rnaSentry standing guard**, then the **counterfactual**. # Setup We build a cohort of 180 samples with two design variables that are almost interchangeable: - `region` is a 3-level factor derived by cutting a latent normal variable; - `batch` is a *noisy copy* of `region` (80% of samples keep their `region` label; the rest are shuffled). We also plant a real batch effect in expression: six genes are multiplied by a batch-dependent factor. Finally, survival depends on the latent variable (so `region`, and through its overlap `batch`, are genuine survival correlates) -- a realistic setting in which an unadjusted screen can mistake batch-driven genes for prognostic ones. ```{r build-cohort} library(rnaSentry) library(SummarizedExperiment) library(survival) set.seed(12) n <- 180 latent <- rnorm(n) region <- factor(cut(latent, breaks = 3, labels = c("R1", "R2", "R3"))) batch <- as.character(region) flip <- runif(n) < 0.2 batch[flip] <- sample(c("R1", "R2", "R3"), sum(flip), replace = TRUE) batch <- factor(batch) counts <- matrix(rpois(50 * n, lambda = 200), nrow = 50, ncol = n, dimnames = list(paste0("g", seq_len(50)), paste0("S", seq_len(n)))) counts[1:6, ] <- counts[1:6, ] * matrix(1 + 0.6 * as.integer(batch), nrow = 6, ncol = n, byrow = TRUE) event_time <- rexp(n, rate = 0.05 * exp(0.8 * latent)) censor_time <- rexp(n, rate = 0.03) cd <- S4Vectors::DataFrame(batch = batch, region = region, time = pmin(event_time, censor_time), event = as.integer(event_time < censor_time), row.names = colnames(counts)) se <- SummarizedExperiment(assays = list(counts = counts), colData = cd) se ``` # Tier 1: the naive analysis A naive analyst runs univariate Cox regressions for every gene against survival and takes the top hits -- without checking whether the candidate genes are driven by batch, and without auditing the design. ```{r naive-screen, warning = FALSE} lg <- log2(counts + 1) stat <- do.call(rbind, lapply(rownames(lg), function(g) { s <- summary(coxph(Surv(cd$time, cd$event) ~ lg[g, ])) c(beta = s$coefficients[1, 1], p = s$coefficients[1, 5]) })) rownames(stat) <- rownames(lg) naive_top <- head(stat[order(stat[, "p"]), , drop = FALSE], 6) data.frame(gene = rownames(naive_top), planted_batch_effect = rownames(naive_top) %in% paste0("g", 1:6), naive_top) ``` The six genes whose expression we multiplied by the batch factor rank as the most "prognostic" genes in the cohort. An unguarded screen would put exactly these batch artifacts into a signature. A naive model that then includes both of the near-identical design variables compounds the problem by double-counting collinear terms: ```{r double-count} summary(coxph(Surv(time, event) ~ batch + region, data = as.data.frame(cd))) ``` `batch` and `region` carry almost the same information; fitting both inflates standard errors and produces unstable coefficients that look like two "independent" effects when there is really one. # Tier 2: rnaSentry standing guard ## Design audit ```{r design-audit} da <- design_audit(se, design_vars = c("batch", "region"), redundant_effect_size = 0.5) ``` ### Pairwise redundancy ```{r pairwise-table} da$pairwise_table ``` `batch` and `region` are almost interchangeable (Cramer's V = 0.82), and the pair is flagged `redundant`. Including both in a model would double-count nearly the same information. ### Confounder scan ```{r confounder-table} da$confounder_table ``` Both variables are flagged as associated with the expression surrogate: `batch` with eta-squared 0.97, `region` with epsilon-squared 0.55 (it leaks the same signal through its overlap with `batch`). ### What the surrogate gradient looks like The surrogate the confounder scan tests against is the leading principal component of the expression data. `pca_audit()` performs the same scan against a single batch variable, one PC at a time: ```{r pca-batch-tests} pa <- pca_audit(se, batch_col = "batch") pa$batch_tests ``` `batch` is flagged as associated with the leading PCs. Plotting the scores makes the structure visible: the three batches separate along PC1, which is exactly the surrogate gradient `design_audit()` measures: ```{r pca-batch-plot, fig.width = 7, fig.height = 5, fig.align = "center", fig.cap = "PC1-PC2 scatter of the batch-confounded cohort, colored by batch. The three batch clusters separate along PC1 (the surrogate gradient); this is the structure the confounder scan detects."} plot_pca_audit(pa, color_by = "batch") ``` Coloring the same scores by `region` gives a nearly identical picture, because `batch` is a noisy copy of `region`: ```{r pca-region-plot, fig.width = 7, fig.height = 5, fig.align = "center", fig.cap = "The same PC1-PC2 scatter colored by region. The near-identical structure is why the redundancy scan reports Cramer's V = 0.82 and the recommended formula drops `region`."} plot_pca_audit(pa, color_by = "region") ``` The two candidate variables track the same expression structure, so the redundancy scan collapses them: keeping only `batch` in the design captures the shared confound without double-counting collinear terms. ### Recovered design ```{r recovered-design} da$formula_text ``` The audit therefore recommends the minimal formula `~ batch`, dropping the redundant `region` term. This is the behavior verified by the test suite (`confounder-detection` and `design-audit` blocks): a redundant design term is reported, not silently kept. ## Batch-adjusted screening Armed with the recommended design, the guarded discovery run adjusts its univariate screening for `batch`. The batch-driven genes are no longer the top hits: ```{r adj-screen, warning = FALSE} adj <- do.call(rbind, lapply(rownames(lg), function(g) { s <- summary(coxph(Surv(cd$time, cd$event) ~ lg[g, ] + batch, data = as.data.frame(cd))) c(beta = s$coefficients[1, 1], p = s$coefficients[1, 5]) })) rownames(adj) <- rownames(lg) guarded_top <- head(adj[order(adj[, "p"]), , drop = FALSE], 6) data.frame(gene = rownames(guarded_top), planted_batch_effect = rownames(guarded_top) %in% paste0("g", 1:6), guarded_top) ``` Once `batch` is in the model, the planted genes lose their survival association. The pipeline records this decision in the flag ledger: ```{r guarded-sig, warning = TRUE} sig_guarded <- build_signature(se, "time", "event", top_n = 6, repeats = 3, folds = 3, design_terms = "batch", seed = 12) sig_guarded$genes sig_guarded$flags ``` # Tier 3: the counterfactual | | Naive analysis (Tier 1) | rnaSentry (Tier 2) | |---|---|---| | Screening | unadjusted; the 6 batch-driven genes rank as most "prognostic" | adjusted for `batch`; batch-driven genes no longer top hits | | Design | `batch + region` fitted together; collinear terms double-counted | `redundant` flag on the pair (Cramer's V = 0.82); minimal `~ batch` recommended | | Surrogate association | never checked | `batch` eta-squared 0.97, `region` epsilon-squared 0.55 reported | | Ledger | none | `redundant_variable`, `adjusted_screening` recorded | **What a guarded analysis can claim:** without `design_audit()`, this cohort would produce a six-gene "prognostic" signature that is entirely a batch artifact, plus a model reporting two collinear "independent" risk factors. With it, the batch confounder is surfaced with its effect size, the redundant term is dropped, and screening is adjusted so the discovered signature is not a batch echo. # Reading The lesson is that the recommended formula is only as good as the design variables you supply. `design_audit()` will not invent a missing confounder; it audits what it is given. Supply every variable that could plausibly confound expression (batch, plate, sex, subtype), then trust the recommended formula over an ad-hoc pick. # Session info ```{r session-info} sessionInfo() ```