From 2eb3fc64a6665e5b3e5c935dbd6d04366fc60c5c Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Mon, 14 Sep 2026 07:57:12 -0700 Subject: [PATCH 01/10] Gate pkgType = 'source' on ref and set it before configure_bioc (#181) val_pipeline() used to push options(pkgType = 'source') into the parent session before dispatching val_build(), unconditionally and outside the ref gate. That pre-set state changed how configure_bioc_repositories_if_requested() -- which val_build() calls near entry -- resolved its available.packages() cache, so the same val_build(pkg_names = 'logrx', ref = 'source', ...) returned >90% covr_coverage when called directly but ~62% when called through val_pipeline(). Also fixes val_build's broken on.exit(function() options(old)) -- which constructed a function value and threw it away, never restoring the option snapshot, and silently wiped an earlier on.exit(options(old_cfg), add = TRUE) because it lacked add = TRUE. Ownership of the pkgType slot now lives in exactly one place: val_build(), via the extracted apply_val_build_options() helper, gated on ref == 'source' and set BEFORE the bioc-config helper runs. Verified: * devtools::test(filter = 'apply_val_build_options'): 17/17 pass. * devtools::test() full: 1088 pass, 0 fail (1 pre-existing skip). Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- DESCRIPTION | 2 +- NEWS.md | 22 +++++ R/utils.R | 37 ++++++++ R/val_build.R | 31 +++++-- R/val_pipeline.R | 12 ++- tests/testthat/test-apply_val_build_options.R | 92 +++++++++++++++++++ 6 files changed, 185 insertions(+), 11 deletions(-) create mode 100644 tests/testthat/test-apply_val_build_options.R diff --git a/DESCRIPTION b/DESCRIPTION index 101a239..3b8ff26 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: val.pipeline Title: Validation Pipeline Example -Version: 0.1.59 +Version: 0.1.60 Authors@R: c( person( diff --git a/NEWS.md b/NEWS.md index c8e4435..cc3c42b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,25 @@ +# val.pipeline 0.1.60 + +- **Stop `val_pipeline()` from silently regressing covr_coverage on + some source-tier packages.** The outer seam in `val_pipeline()` + pushed `options(pkgType = "source")` into the parent session + before dispatching to `val_build()`, unconditionally and outside + the `ref` gate. That pre-set changed the state + `configure_bioc_repositories_if_requested()` (which + `val_build()` calls at entry) resolved its + `available.packages()` cache under, so the same + `val_build(pkg_names = "logrx", ref = "source", ...)` returned + >90% covr_coverage when called directly but ~62% when called + through `val_pipeline()`. Ownership of the `pkgType` slot now + lives in exactly one place -- `val_build()`, via the new + `apply_val_build_options()` helper -- gated on `ref == "source"` + and set BEFORE the bioc-config helper runs. Also fixes a stale + `on.exit(function() options(old))` in `val_build()` that + constructed a function value and threw it away (never restored + the option snapshot) AND silently wiped the earlier + `on.exit(options(old_cfg), add = TRUE)` because it lacked + `add = TRUE`. (#181) + # val.pipeline 0.1.59 - **Fix `` fallback in the summary report subtitle and a few diff --git a/R/utils.R b/R/utils.R index 2f56a9f..81d3600 100644 --- a/R/utils.R +++ b/R/utils.R @@ -185,6 +185,43 @@ apply_config_path <- function(config_path) { } +#' Set `repos` and (conditionally) `pkgType` for a val_build() scope +#' +#' Sets `options(repos = opt_repos)` and, when `ref == "source"`, also +#' `options(pkgType = "source")`. Returns the previous values in the +#' form returned by [base::options()] so the caller can restore them +#' via `on.exit(options(old), add = TRUE)`. +#' +#' Extracted from `val_build()` so the option-management contract is +#' testable in isolation. The `ref` gate mirrors `val_build()`'s +#' historical intent (source installs only for source-tier assessment) +#' -- see #181 for the covr-coverage regression that motivated +#' extracting this and the paired unconditional-set audit in +#' `val_pipeline()` / `val_prep_pipeline()` / `val_categorize()`. +#' +#' @param ref One of `"source"` or `"remote"`. `pkgType = "source"` is +#' set only when `ref == "source"`; `"remote"` leaves the caller's +#' `pkgType` untouched. +#' @param opt_repos Named character vector of repository URLs, as +#' accepted by `options(repos = ...)`. +#' +#' @return An `options()`-shaped list holding the previous values of +#' the slots we mutated (always includes `repos`; includes `pkgType` +#' only when `ref == "source"`). Suitable for +#' `on.exit(options(old), add = TRUE)`. +#' +#' @keywords internal +apply_val_build_options <- function(ref, opt_repos) { + ref <- match.arg(ref, c("source", "remote")) + if (identical(ref, "source")) { + old <- options(repos = opt_repos, pkgType = "source") + } else { + old <- options(repos = opt_repos) + } + old +} + + #' #' Helper function to determine which repo a package came from diff --git a/R/val_build.R b/R/val_build.R index 17b818b..cfe266c 100644 --- a/R/val_build.R +++ b/R/val_build.R @@ -204,6 +204,28 @@ val_build <- function( stopifnot(is.logical(mem_watchdog), length(mem_watchdog) == 1L, !is.na(mem_watchdog)) apply_verbose(verbose) + + # Establish `options(repos, pkgType)` BEFORE any helper that calls + # `available.packages()` runs (notably + # `configure_bioc_repositories_if_requested()` at the next line, + # which hits `available.packages()` inside its BiocManager repo + # probe). Sequencing this after those helpers means the bioc-repo + # cache lands with whatever pkgType the caller's session happened + # to carry -- and under `val_pipeline()`, that pre-set pkgType + # comes from a prior `options(pkgType = "source")` upstream, so + # the exact same `val_build()` invocation resolves a different + # bioc set depending on how it was entered. That divergence was + # the root cause of the covr_coverage delta between bare + # `val_build()` (>90% on logrx) and `val_pipeline() -> val_build()` + # (62%). See #181. The `on.exit(options(old), add = TRUE)` guard + # restores whichever slots we mutated so the caller session is + # left untouched -- fixes the previous + # `on.exit(function() options(old))` which constructed a function + # and threw it away, never restoring options (also lacked + # `add = TRUE`, silently wiping the earlier config-path on.exit). + old <- apply_val_build_options(ref = ref, opt_repos = opt_repos) + on.exit(options(old), add = TRUE) + configure_bioc_repositories_if_requested(quiet = TRUE) configure_riskmetric_offline_if_requested(quiet = TRUE) @@ -233,15 +255,6 @@ val_build <- function( remote_pkgs <- pull_config(val = "remote_only", rule_type = "default") # opt_repos <- pull_config(val = "opt_repos", rule_type = "default") |> unlist() - old <- options() - on.exit(function() options(old)) - if(ref == 'source') { - options(repos = opt_repos, pkgType = "source") # , rlang_interactive = FALSE - } else { - options(repos = opt_repos) # , rlang_interactive = FALSE - } - # options("repos") - # # ---- Which pkgs, ordered ---- # diff --git a/R/val_pipeline.R b/R/val_pipeline.R index 3c80896..79274d4 100644 --- a/R/val_pipeline.R +++ b/R/val_pipeline.R @@ -281,9 +281,19 @@ val_pipeline <- function( pull_config(val = "decisions_lst", rule_type = "default") # Keep options aligned with the prep run when picking up from disk. + # Note: we intentionally do NOT set `pkgType = "source"` here. That + # was previously set unconditionally at this seam, which meant every + # `val_pipeline() -> val_build()` handoff entered val_build with + # `pkgType = "source"` already live in the parent session -- even + # for `ref = "remote"` runs -- and pushed the state divergence that + # regressed covr_coverage on some source-tier packages (see #181). + # `val_build()` sets `pkgType = "source"` itself, gated on + # `ref == "source"`, at the top of its own body. That single owner + # keeps the option contract consistent whether callers use + # `val_pipeline()` or `val_build()` directly. old <- options() on.exit(options(old), add = TRUE) - options(repos = prep$opt_repos, pkgType = "source", scipen = 999) + options(repos = prep$opt_repos, scipen = 999) # # ---- val_build() ---- diff --git a/tests/testthat/test-apply_val_build_options.R b/tests/testthat/test-apply_val_build_options.R new file mode 100644 index 0000000..bfda6b7 --- /dev/null +++ b/tests/testthat/test-apply_val_build_options.R @@ -0,0 +1,92 @@ +# Contract for apply_val_build_options(): sets `repos` (always) and +# `pkgType = "source"` (only when ref == "source"), and returns the +# previous slot values in an `options()`-shaped list so the caller +# can restore via `on.exit(options(old), add = TRUE)`. Root motivation +# is #181 -- the outer `val_pipeline()` seam used to set +# `pkgType = "source"` unconditionally, diverging parent-session +# state between `val_pipeline() -> val_build()` and bare `val_build()` +# and silently regressing covr_coverage on some source-tier packages. + +test_that("apply_val_build_options(ref = 'source') sets repos AND pkgType", { + withr::with_options( + list(repos = c(CRAN = "https://old.example/cran"), pkgType = "both"), + { + old <- apply_val_build_options( + ref = "source", + opt_repos = c(CRAN = "https://new.example/cran", + BioC = "https://new.example/bioc") + ) + # New state is live. + expect_equal(getOption("repos")[["CRAN"]], + "https://new.example/cran") + expect_equal(getOption("repos")[["BioC"]], + "https://new.example/bioc") + expect_equal(getOption("pkgType"), "source") + # Returned `old` captured both slots verbatim, ready for + # `options(old)`. + expect_setequal(names(old), c("repos", "pkgType")) + expect_equal(old$repos[["CRAN"]], "https://old.example/cran") + expect_equal(old$pkgType, "both") + # Restoring returns state to the with_options snapshot. + options(old) + expect_equal(getOption("pkgType"), "both") + expect_equal(getOption("repos")[["CRAN"]], + "https://old.example/cran") + } + ) +}) + +test_that("apply_val_build_options(ref = 'remote') does NOT touch pkgType", { + withr::with_options( + list(repos = c(CRAN = "https://old.example/cran"), pkgType = "both"), + { + old <- apply_val_build_options( + ref = "remote", + opt_repos = c(CRAN = "https://new.example/cran") + ) + expect_equal(getOption("repos")[["CRAN"]], + "https://new.example/cran") + # pkgType left alone. + expect_equal(getOption("pkgType"), "both") + # Returned `old` should have `repos` only (options() returns just + # the slot(s) the setter mutated). + expect_equal(names(old), "repos") + expect_equal(old$repos[["CRAN"]], "https://old.example/cran") + options(old) + expect_equal(getOption("repos")[["CRAN"]], + "https://old.example/cran") + expect_equal(getOption("pkgType"), "both") + } + ) +}) + +test_that("apply_val_build_options rejects invalid ref", { + expect_error( + apply_val_build_options(ref = "binary", + opt_repos = c(CRAN = "https://x/cran")), + "should be one of" + ) +}) + +test_that( + "apply_val_build_options(ref = 'remote') round-trips through options()", { + # The end-to-end contract we rely on in val_build(): after the + # function's `on.exit(options(old), add = TRUE)` fires, the caller + # session is byte-identical to before the call, even for `ref = + # 'remote'` (i.e. no phantom pkgType slot appears). + withr::with_options( + list(repos = c(CRAN = "https://old.example/cran")), + { + before <- options() + old <- apply_val_build_options( + ref = "remote", + opt_repos = c(CRAN = "https://new.example/cran") + ) + options(old) + after <- options() + # `repos` restored, no new pkgType slot introduced. + expect_equal(after$repos, before$repos) + expect_identical(is.null(before$pkgType), is.null(after$pkgType)) + } + ) +}) From 6d3d7a5a36c8a329697f45997339a268e1abc52f Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Mon, 14 Sep 2026 08:07:45 -0700 Subject: [PATCH 02/10] Restore original ordering: set pkgType AFTER configure_bioc Aaron flagged that essentially every real val.pipeline run uses ref='source' (that's what riskmetric needs to produce R CMD check + covr_coverage), so the ref gate is effectively always-true. That means the previous version of this PR -- which moved the pkgType set to BEFORE configure_bioc -- would have regressed bare val_build to the same 62% coverage that was reported through val_pipeline. The historical bare-val_build ordering (configure_bioc first, then set pkgType) is the state that produced the accurate >90% number on logrx. Preserve that. The fix for the val_pipeline path stays: drop the outer-seam pkgType pre-set so val_pipeline enters val_build with pkgType at the caller's default, matching what bare val_build has always done. Test suite: 1088/1088 pass (0 fail, 1 pre-existing skip). Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- NEWS.md | 21 ++++++++++++--------- R/val_build.R | 41 ++++++++++++++++++----------------------- 2 files changed, 30 insertions(+), 32 deletions(-) diff --git a/NEWS.md b/NEWS.md index cc3c42b..4cbb9cc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,15 +5,18 @@ pushed `options(pkgType = "source")` into the parent session before dispatching to `val_build()`, unconditionally and outside the `ref` gate. That pre-set changed the state - `configure_bioc_repositories_if_requested()` (which - `val_build()` calls at entry) resolved its - `available.packages()` cache under, so the same - `val_build(pkg_names = "logrx", ref = "source", ...)` returned - >90% covr_coverage when called directly but ~62% when called - through `val_pipeline()`. Ownership of the `pkgType` slot now - lives in exactly one place -- `val_build()`, via the new - `apply_val_build_options()` helper -- gated on `ref == "source"` - and set BEFORE the bioc-config helper runs. Also fixes a stale + `configure_bioc_repositories_if_requested()` (which `val_build()` + calls at entry) resolved its `available.packages()` cache under, + so the same `val_build(pkg_names = "logrx", ref = "source", ...)` + returned >90% covr_coverage when called directly but ~62% when + called through `val_pipeline()`. The outer set is now removed; the + `pkgType` slot is owned in exactly one place -- `val_build()`, + via the new `apply_val_build_options()` helper, gated on + `ref == "source"` and set AFTER + `configure_bioc_repositories_if_requested()` so the bioc-config + step still runs under the caller's session `pkgType` (the state + the historical bare-`val_build()` code path resolved bioc under, + which produced the accurate covr numbers). Also fixes a stale `on.exit(function() options(old))` in `val_build()` that constructed a function value and threw it away (never restored the option snapshot) AND silently wiped the earlier diff --git a/R/val_build.R b/R/val_build.R index cfe266c..a56c3b3 100644 --- a/R/val_build.R +++ b/R/val_build.R @@ -204,28 +204,6 @@ val_build <- function( stopifnot(is.logical(mem_watchdog), length(mem_watchdog) == 1L, !is.na(mem_watchdog)) apply_verbose(verbose) - - # Establish `options(repos, pkgType)` BEFORE any helper that calls - # `available.packages()` runs (notably - # `configure_bioc_repositories_if_requested()` at the next line, - # which hits `available.packages()` inside its BiocManager repo - # probe). Sequencing this after those helpers means the bioc-repo - # cache lands with whatever pkgType the caller's session happened - # to carry -- and under `val_pipeline()`, that pre-set pkgType - # comes from a prior `options(pkgType = "source")` upstream, so - # the exact same `val_build()` invocation resolves a different - # bioc set depending on how it was entered. That divergence was - # the root cause of the covr_coverage delta between bare - # `val_build()` (>90% on logrx) and `val_pipeline() -> val_build()` - # (62%). See #181. The `on.exit(options(old), add = TRUE)` guard - # restores whichever slots we mutated so the caller session is - # left untouched -- fixes the previous - # `on.exit(function() options(old))` which constructed a function - # and threw it away, never restoring options (also lacked - # `add = TRUE`, silently wiping the earlier config-path on.exit). - old <- apply_val_build_options(ref = ref, opt_repos = opt_repos) - on.exit(options(old), add = TRUE) - configure_bioc_repositories_if_requested(quiet = TRUE) configure_riskmetric_offline_if_requested(quiet = TRUE) @@ -254,7 +232,24 @@ val_build <- function( decisions <- pull_config(val = "decisions_lst", rule_type = "default") remote_pkgs <- pull_config(val = "remote_only", rule_type = "default") # opt_repos <- pull_config(val = "opt_repos", rule_type = "default") |> unlist() - + + # Establish `options(repos, pkgType)` AFTER + # `configure_bioc_repositories_if_requested()` on purpose: the bioc + # helper's `available.packages()` probe must run under whatever + # `pkgType` the caller's session carried at entry -- pre-poisoning + # it with `pkgType = "source"` produces a different bioc-repo cache + # and silently regressed covr_coverage on some source-tier packages + # (>90% on logrx under bare `val_build()`, ~62% when the same call + # was reached through `val_pipeline()` because the outer seam + # unconditionally pushed `pkgType = "source"` into the parent + # session first). See #181. The `on.exit(options(old), add = TRUE)` + # guard restores whichever slots we mutated -- fixes the previous + # `on.exit(function() options(old))` which constructed a function + # value and threw it away (never restored options) and lacked + # `add = TRUE` (silently wiped the earlier config-path on.exit). + old <- apply_val_build_options(ref = ref, opt_repos = opt_repos) + on.exit(options(old), add = TRUE) + # # ---- Which pkgs, ordered ---- # From ba7ff0b9fa4c46aca3a482cfbde70dfcabb3df22 Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Mon, 14 Sep 2026 08:25:00 -0700 Subject: [PATCH 03/10] Add dev/dev_rerun_low_covr.R for surgical re-run of affected cohort Reads dev/low_covr.rds (gitignored, sensitive) and drives val_build() against a filtered high-yield / low-cost subset (default: covr > 40% AND runtime <= 15 min) with replace = TRUE. Post-run diffs against the prior covr_coverage values and reports which pkgs cleared the 65% threshold. Companion .gitignore entries keep the sensitive rds inputs + generated compare tables out of the tree. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .gitignore | 4 + dev/dev_rerun_low_covr.R | 249 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 253 insertions(+) create mode 100644 dev/dev_rerun_low_covr.R diff --git a/.gitignore b/.gitignore index 82eb690..7bd0ce4 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,7 @@ dev/nfs_smb_latency_probe.txt # run under devtools::test(). Ignore any *-tests/ dir so a stray test # run doesn't accidentally commit hundreds of files. *-tests/ + +# Sensitive per-run artifacts (do not commit) +dev/low_covr.rds +dev/low_covr_rerun_compare_*.rds diff --git a/dev/dev_rerun_low_covr.R b/dev/dev_rerun_low_covr.R new file mode 100644 index 0000000..148fa60 --- /dev/null +++ b/dev/dev_rerun_low_covr.R @@ -0,0 +1,249 @@ +# dev/dev_rerun_low_covr.R +# +# Surgical re-run of the low-covr cohort under the pkgType fix +# (pharmaR/val.pipeline#182). Reads dev/low_covr.rds (the +# qual_metadata + qual_assessments merge for pkgs whose covr_coverage +# came in below the acceptance threshold on the affected run) and +# drives `val_build()` against a filtered high-yield / low-cost +# subset with `replace = TRUE`. +# +# `dev/low_covr.rds` is gitignored (contains internal package +# accounting) -- do NOT commit any downstream artifact derived from +# it either. +# +# USAGE +# ----- +# Source your usual launcher first so `opt_repos`, `out`, +# `metric_pkg`, `ref`, `val_date`, `deps`, `deps_recursive`, and any +# workbench-specific env plumbing are set. Then: +# +# source("dev/dev_rerun_low_covr.R") +# +# Adjust the FILTER CONFIG block below if you want a wider or +# narrower subset. Defaults target the 60-65% band + anything above +# 40% coverage that runs in under 15 min -- the "highest-yield, +# lowest-cost" slice. +# +# Every pkg in the resulting set has `replace = TRUE` in the +# val_build call, so its existing `_meta.rds` / `_assess_record.rds` +# / `_assessments.rds` bundle under `/assessed/` gets +# overwritten in place. Adjust `VAL_DATE_OVERRIDE` if you want to +# land the re-run in a different dated folder than your launcher's +# `val_date`. + +# ============================================================================= +# FILTER CONFIG -- edit here if you want a different slice +# ============================================================================= + +MIN_COVR <- 40 # keep pkgs with existing covr_coverage strictly above this +MAX_RT_MIN <- 15 # ...AND whose prior assessment_runtime_mins is below this +# Optional hard exclusions -- pkgs you already know are legitimately +# under-tested and won't cross threshold no matter what. +EXCLUDE_PKGS <- character(0) # e.g. c("crs", "refund", "lavaan") + +VAL_DATE_OVERRIDE <- NULL # set to as.Date("2026-09-09") etc. to override + +# Optional: cap the set for a first-cut sanity run. Set to NULL to +# drop the cap. +MAX_PKGS <- NULL # e.g. 20 for a quick pilot + +# ============================================================================= +# Load + filter +# ============================================================================= + +suppressPackageStartupMessages({ + library(dplyr) +}) + +lc_path <- "dev/low_covr.rds" +if (!file.exists(lc_path)) { + stop("Can't find ", lc_path, ". Run this from the val.pipeline repo root.") +} +lc <- readRDS(lc_path) +lc$rt_min <- as.numeric(lc$assessment_runtime_mins) + +cohort <- lc |> + filter(covr_coverage > MIN_COVR, + rt_min <= MAX_RT_MIN, + !package %in% EXCLUDE_PKGS) + +if (!is.null(MAX_PKGS) && nrow(cohort) > MAX_PKGS) { + # Prefer the pkgs closest to the 65% threshold first -- best odds of + # crossing it, best signal that the fix worked. + cohort <- cohort |> + arrange(desc(covr_coverage)) |> + slice_head(n = MAX_PKGS) +} + +cat("\n=====================================================\n") +cat("Low-covr re-run cohort selection\n") +cat("=====================================================\n") +cat("Original set (below-threshold pkgs): ", nrow(lc), "\n") +cat("Filter: covr_coverage > ", MIN_COVR, + " AND runtime <= ", MAX_RT_MIN, " min", + if (length(EXCLUDE_PKGS)) paste0(" AND !exclude(", length(EXCLUDE_PKGS), " pkgs)") else "", + if (!is.null(MAX_PKGS)) paste0(" AND top-", MAX_PKGS, " by covr desc") else "", + "\n", sep = "") +cat("Selected cohort: ", nrow(cohort), " pkgs\n\n") + +cat("Coverage band breakdown of selected cohort:\n") +brks <- c(MIN_COVR, 50, 55, 60, 65) +cohort |> + mutate(band = cut(covr_coverage, breaks = brks, include.lowest = FALSE, + right = TRUE)) |> + count(band) |> + print() + +serial_min <- sum(cohort$rt_min, na.rm = TRUE) +cat("\nExpected serial time (sum of prior runtimes): ", + round(serial_min, 1), " min = ", round(serial_min / 60, 1), " hr\n") + +for (w in c(1, 3, 5, 8, 10)) { + naive_hr <- serial_min / w / 60 + cushioned_hr <- naive_hr * 1.2 + floor_hr <- max(cohort$rt_min, na.rm = TRUE) / 60 + cat(sprintf(" workers=%2d -> naive %.1f hr, w/ 20%% cushion %.1f hr (floor: %.1f hr)\n", + w, naive_hr, cushioned_hr, floor_hr)) +} + +# ============================================================================= +# Guardrail: confirm we're on a fix-branch val.pipeline +# ============================================================================= +vp_ver <- as.character(utils::packageVersion("val.pipeline")) +cat("\nval.pipeline version loaded: ", vp_ver, "\n") +cat("val.pipeline install path : ", find.package("val.pipeline"), "\n") +if (utils::compareVersion(vp_ver, "0.1.60") < 0) { + warning("val.pipeline version < 0.1.60. The pkgType fix from #182 is not ", + "loaded; this re-run will reproduce the same bad numbers. ", + "Install the ac-181-gate-pkgtype-on-ref branch first.", + call. = FALSE, immediate. = TRUE) +} + +# ============================================================================= +# Pre-flight: verify launcher globals are in scope +# ============================================================================= +required <- c("opt_repos", "out", "metric_pkg", "ref", + "deps", "deps_recursive") +missing_vars <- required[!vapply(required, exists, logical(1))] +if (length(missing_vars)) { + stop("Launcher globals not set: ", paste(missing_vars, collapse = ", "), + ". Source your launcher first, then re-run this script.") +} +val_date <- if (!is.null(VAL_DATE_OVERRIDE)) VAL_DATE_OVERRIDE else { + if (exists("val_date")) get("val_date") else Sys.Date() +} +workers <- if (exists("workers")) get("workers") else 5L +config_path <- if (exists("config_path")) get("config_path") else file.path(getwd(), "config.yml") + +cat("\nRe-run settings:\n") +cat(" val_date : ", format(val_date), "\n") +cat(" workers : ", workers, "\n") +cat(" ref : ", ref, "\n") +cat(" out : ", out, "\n") +cat(" config_path : ", config_path, "\n\n") + +# ============================================================================= +# GO / NO-GO prompt (interactive sessions only) +# ============================================================================= +if (interactive()) { + ans <- readline("Proceed with val_build() on the selected cohort? [y/N] ") + if (!tolower(trimws(ans)) %in% c("y", "yes")) { + message("Aborted by user.") + return(invisible(NULL)) + } +} + +# ============================================================================= +# Drive val_build() +# ============================================================================= +# Deliberately NOT passing `prep = ...` -- this is a targeted rebuild of a +# hand-picked pkg set, not a full-universe run. `deps = NULL, deps_recursive = +# NULL` matches the pattern in your launcher's "Re-run & re-finalize" block: +# each pkg is assessed on its own without pulling its dep tree back into the +# candidate set (the dep tree is already installed via rv on your setup). +# +# `finalize = FALSE` because report rendering + qualified-list emission are +# val_pipeline()-scope work you'll do separately in a live session once +# happy with the numbers. + +qual_rerun <- val.pipeline::val_build( + pkg_names = cohort$package, + ref = ref, + metric_pkg = metric_pkg, + deps = NULL, + deps_recursive = NULL, + rev_deps = NULL, + rev_deps_recursive = NULL, + val_date = val_date, + out = out, + opt_repos = opt_repos, + replace = TRUE, + workers = workers, + config_path = config_path, + prep = NULL, + propagate_libpaths = TRUE, + mem_watchdog = TRUE, + finalize = FALSE, + verbose = "normal" +) + +cat("\n=====================================================\n") +cat("Re-run complete. Comparing old vs new covr_coverage.\n") +cat("=====================================================\n") + +# ============================================================================= +# Post-run compare: quick before / after table +# ============================================================================= +val_date_txt <- gsub("-", "", format(as.Date(val_date))) +val_dir <- file.path(out, paste0("R_", getRversion()), val_date_txt) +assessed <- file.path(val_dir, "assessed") + +diff_rows <- lapply(seq_len(nrow(cohort)), function(i) { + pkg <- cohort$package[i] + ver <- cohort$version[i] + meta_path <- file.path(assessed, paste0(pkg, "_", ver, "_meta.rds")) + if (!file.exists(meta_path)) { + return(data.frame(package = pkg, version = ver, + covr_before = cohort$covr_coverage[i], + covr_after = NA_real_, + delta = NA_real_, + stringsAsFactors = FALSE)) + } + m <- tryCatch(readRDS(meta_path), error = function(e) NULL) + covr_after <- if (!is.null(m) && "covr_coverage" %in% names(m)) { + as.numeric(m$covr_coverage) + } else NA_real_ + data.frame(package = pkg, version = ver, + covr_before = cohort$covr_coverage[i], + covr_after = covr_after, + delta = covr_after - cohort$covr_coverage[i], + stringsAsFactors = FALSE) +}) +compare_df <- do.call(rbind, diff_rows) |> + arrange(desc(delta)) + +cat("Delta summary (nrow = ", nrow(compare_df), "):\n", sep = "") +print(summary(compare_df$delta)) + +cat("\nCrossed the 65% threshold: ", + sum(compare_df$covr_after > 65, na.rm = TRUE), + " / ", nrow(compare_df), "\n", sep = "") + +cat("\nTop 20 improvements:\n") +compare_df |> head(20) |> print(row.names = FALSE) + +cat("\nRegressions (delta < 0), if any:\n") +regressions <- compare_df |> filter(delta < 0) +if (nrow(regressions) == 0L) { + cat("(none)\n") +} else { + print(regressions, row.names = FALSE) +} + +# Persist the compare df alongside the run for later review. Kept in +# dev/ (gitignored via low_covr.rds sibling entry -- add an +# equivalent line if you want to preserve this file across pulls). +out_path <- file.path("dev", paste0("low_covr_rerun_compare_", + val_date_txt, ".rds")) +saveRDS(compare_df, out_path) +cat("\nSaved before/after compare table to: ", out_path, "\n") From 054894913644b52935c6624a8555ea57834502a4 Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Mon, 14 Sep 2026 10:19:49 -0700 Subject: [PATCH 04/10] Adopt Copilot review: name correct helper, add source-scan tests Three adoptions from Copilot's review of #182: 1. R/val_build.R: rewrite the comment above apply_val_build_options() to accurately name which helper's available.packages() call is pkgType-sensitive. Copilot was right that `configure_bioc_repositories_if_requested()` doesn't call available.packages() -- it only installs a session-scoped `assignInNamespace('repositories', ...)` shim on BiocManager. The offender is the NEXT helper we run, in the same block: `configure_riskmetric_offline_if_requested()`, which does call available.packages() to build its offline cache (R/bioc.R). The fix (setting options AFTER both helpers) is unchanged; only the rationale needed correcting. 2. tests/testthat/test-apply_val_build_options.R: add two source-scan regression tests. The pkgType leak was a call-path bug, not a helper-signature bug -- the pre-existing unit tests can't catch a re-introduction of unconditional `options(pkgType = 'source')` at the val_pipeline() -> val_build() seam. New tests grep the installed R sources and assert: - val_pipeline.R's post-prep options() block does NOT set pkgType. - val_build.R sets options AFTER configure_riskmetric_offline_if_requested(). Test file: 17 -> 22 assertions, all pass. 3. dev/dev_rerun_low_covr.R: fix config_path fallback. Previously defaulted to `file.path(getwd(), 'config.yml')` which errors when the script is run outside a launcher project. Now defaults to NULL, which val_build() resolves to the packaged `inst/config.yml`. Also updated the config_path echo to print '' when NULL, so operators can eyeball what resolution they're getting without opening val_build(). Tests: `devtools::test(filter = 'val_')` -> 218/218 pass. Refs #181, #182. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- R/val_build.R | 24 +++--- dev/dev_rerun_low_covr.R | 5 +- tests/testthat/test-apply_val_build_options.R | 76 +++++++++++++++++++ 3 files changed, 93 insertions(+), 12 deletions(-) diff --git a/R/val_build.R b/R/val_build.R index a56c3b3..aa1bc2f 100644 --- a/R/val_build.R +++ b/R/val_build.R @@ -234,16 +234,20 @@ val_build <- function( # opt_repos <- pull_config(val = "opt_repos", rule_type = "default") |> unlist() # Establish `options(repos, pkgType)` AFTER - # `configure_bioc_repositories_if_requested()` on purpose: the bioc - # helper's `available.packages()` probe must run under whatever - # `pkgType` the caller's session carried at entry -- pre-poisoning - # it with `pkgType = "source"` produces a different bioc-repo cache - # and silently regressed covr_coverage on some source-tier packages - # (>90% on logrx under bare `val_build()`, ~62% when the same call - # was reached through `val_pipeline()` because the outer seam - # unconditionally pushed `pkgType = "source"` into the parent - # session first). See #181. The `on.exit(options(old), add = TRUE)` - # guard restores whichever slots we mutated -- fixes the previous + # `configure_bioc_repositories_if_requested()` + + # `configure_riskmetric_offline_if_requested()` on purpose: the + # bioc helper only installs a `assignInNamespace("repositories", + # ...)` shim (no `available.packages()` call of its own), but the + # riskmetric-offline helper DOES call `available.packages()` (see + # `R/bioc.R`) to build its offline cache. Pre-poisoning the caller + # session with `pkgType = "source"` before that cache is built + # produces a different cache and silently regressed covr_coverage + # on some source-tier packages (>90% on logrx under bare + # `val_build()`, ~62% when the same call was reached through + # `val_pipeline()` because the outer seam unconditionally pushed + # `pkgType = "source"` into the parent session first). See #181. + # The `on.exit(options(old), add = TRUE)` guard restores whichever + # slots we mutated -- fixes the previous # `on.exit(function() options(old))` which constructed a function # value and threw it away (never restored options) and lacked # `add = TRUE` (silently wiped the earlier config-path on.exit). diff --git a/dev/dev_rerun_low_covr.R b/dev/dev_rerun_low_covr.R index 148fa60..2b1fce4 100644 --- a/dev/dev_rerun_low_covr.R +++ b/dev/dev_rerun_low_covr.R @@ -133,14 +133,15 @@ val_date <- if (!is.null(VAL_DATE_OVERRIDE)) VAL_DATE_OVERRIDE else { if (exists("val_date")) get("val_date") else Sys.Date() } workers <- if (exists("workers")) get("workers") else 5L -config_path <- if (exists("config_path")) get("config_path") else file.path(getwd(), "config.yml") +config_path <- if (exists("config_path")) get("config_path") else NULL cat("\nRe-run settings:\n") cat(" val_date : ", format(val_date), "\n") cat(" workers : ", workers, "\n") cat(" ref : ", ref, "\n") cat(" out : ", out, "\n") -cat(" config_path : ", config_path, "\n\n") +cat(" config_path : ", + if (is.null(config_path)) "" else config_path, "\n\n") # ============================================================================= # GO / NO-GO prompt (interactive sessions only) diff --git a/tests/testthat/test-apply_val_build_options.R b/tests/testthat/test-apply_val_build_options.R index bfda6b7..7fbd320 100644 --- a/tests/testthat/test-apply_val_build_options.R +++ b/tests/testthat/test-apply_val_build_options.R @@ -90,3 +90,79 @@ test_that( } ) }) + + +# --------------------------------------------------------------------------- +# Source-scan regression tests (#181) +# +# The pkgType-source leak was a call-path bug, not a helper-signature bug: +# the unit tests above verify apply_val_build_options()'s contract in +# isolation, but they can't catch a re-introduction of an unconditional +# `options(pkgType = "source")` at the val_pipeline() -> val_build() seam +# (which is exactly how the bug shipped originally). These grep-level +# assertions guard the two structural invariants that carry the fix: +# +# 1. val_pipeline.R must NOT set pkgType in the post-prep options() +# block that hands off to val_build(). Any `pkgType = "source"` at +# that seam re-introduces the parent-session divergence. +# 2. val_build.R must set options AFTER +# configure_riskmetric_offline_if_requested() -- the riskmetric- +# offline helper calls available.packages() to build its offline +# cache, and running that under a pre-poisoned pkgType regressed +# covr_coverage on some source-tier packages. +# +# These read source via `system.file(..., package = "val.pipeline")` (test +# targets the *installed* copy of the package, matching devtools::test() +# via load_all()). +# --------------------------------------------------------------------------- + +read_pkg_source <- function(rel_path) { + candidates <- c( + system.file(file.path("..", rel_path), package = "val.pipeline"), + file.path(testthat::test_path(), "..", "..", rel_path) + ) + hit <- candidates[nzchar(candidates) & file.exists(candidates)] + if (length(hit) == 0L) { + skip(paste0("cannot locate ", rel_path, " for source-scan test")) + } + readLines(hit[[1L]], warn = FALSE) +} + +test_that("val_pipeline.R does NOT set pkgType at the post-prep seam (#181)", { + src <- read_pkg_source("R/val_pipeline.R") + # Isolate the block from the last `options(repos = prep$opt_repos, ...)` + # to end of file. That's the post-prep seam that ships state to + # val_build(); any pkgType set here is the regression. + seam_start <- grep("options\\(repos = prep\\$opt_repos", src) + expect_length(seam_start, 1L) + seam <- src[seq(seam_start, length(src))] + # Naked-source regression: any line in the seam that mutates pkgType + # via `options(pkgType = ...)` is the bug. + bad <- grep("options\\([^)]*pkgType\\s*=", seam, value = TRUE) + expect_length(bad, 0L) +}) + +test_that("val_build.R sets options AFTER configure_riskmetric_offline (#181)", { + src <- read_pkg_source("R/val_build.R") + # Structural check: `apply_val_build_options()` (or a direct + # `options(pkgType = ...)`) must appear AFTER + # `configure_riskmetric_offline_if_requested(` in val_build's body. + # The riskmetric-offline helper calls available.packages() to build + # its cache and running that under `pkgType = "source"` diverges the + # cache from the bare-val_build path. + offline_line <- grep( + "configure_riskmetric_offline_if_requested\\(", + src + ) + apply_line <- grep( + "apply_val_build_options\\(", + src + ) + # Expect at least one hit for each. + expect_gte(length(offline_line), 1L) + expect_gte(length(apply_line), 1L) + # The FIRST apply_val_build_options() call (val_build's own top-of-body + # option set) must land AFTER the FIRST configure_riskmetric_offline + # call. + expect_true(apply_line[[1L]] > offline_line[[1L]]) +}) From a57bdc9f343c0b2bc7e3c507d6d62d75b8e68df1 Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Mon, 14 Sep 2026 11:25:26 -0700 Subject: [PATCH 05/10] Force pkgType='both' (not 'source') for source-tier assessment Aaron's empirical result: entering val_build under getOption('pkgType') == 'source' regresses covr_coverage on some source-tier packages (logrx: >90% -> ~62%). Under 'both' or 'binary' the number holds at >90%. Intuition (source-tier assessment => pkgType='source') is exactly wrong. Likely mechanism: configure_riskmetric_offline_if_requested() runs near the top of val_build's body and calls utils::available.packages(), whose default 'type = getOption("pkgType")' filters the offline cache. Under 'source', binary-only pkgs from a PPM-style mirror drop out of the cache and downstream test-time installs fail silently -- the test suite short-circuits and covr reports the resulting partial coverage. 'both' keeps the cache complete (binary-preferred, source fallback) while 'ref = "source"' still drives val.pipeline's own source-tarball assessment path in val_pkg(). Changes: - R/utils.R: apply_val_build_options() sets pkgType='both' when ref='source', not pkgType='source'. Updated roxygen w/ the full rationale. - R/val_build.R: reworded the comment above apply_val_build_options() to explain the 'both, not source' direction and the offline-cache mechanism. - tests/testthat/test-apply_val_build_options.R: updated the primary source-tier test to start from pkgType='binary' (so the helper's mutation is observable) and assert pkgType=='both' post- call. Added a dedicated regression test asserting the helper NEVER sets pkgType='source' under ref='source' -- forces any future attempt to flip this back to the intuitive-but-wrong direction to fail loudly. - NEWS.md: expanded the 0.1.60 bullet to describe both prongs of the fix (removal of val_pipeline's unconditional set + the correction from 'source' to 'both' in val_build). Tests: devtools::test(filter = 'val_') -> 219/219 pass. Refs #181. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- NEWS.md | 46 +++++++++++-------- R/utils.R | 37 +++++++++++---- R/val_build.R | 29 ++++++------ tests/testthat/test-apply_val_build_options.R | 39 ++++++++++++---- 4 files changed, 101 insertions(+), 50 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4cbb9cc..0bf3817 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,26 +1,32 @@ # val.pipeline 0.1.60 - **Stop `val_pipeline()` from silently regressing covr_coverage on - some source-tier packages.** The outer seam in `val_pipeline()` - pushed `options(pkgType = "source")` into the parent session - before dispatching to `val_build()`, unconditionally and outside - the `ref` gate. That pre-set changed the state - `configure_bioc_repositories_if_requested()` (which `val_build()` - calls at entry) resolved its `available.packages()` cache under, - so the same `val_build(pkg_names = "logrx", ref = "source", ...)` - returned >90% covr_coverage when called directly but ~62% when - called through `val_pipeline()`. The outer set is now removed; the - `pkgType` slot is owned in exactly one place -- `val_build()`, - via the new `apply_val_build_options()` helper, gated on - `ref == "source"` and set AFTER - `configure_bioc_repositories_if_requested()` so the bioc-config - step still runs under the caller's session `pkgType` (the state - the historical bare-`val_build()` code path resolved bioc under, - which produced the accurate covr numbers). Also fixes a stale - `on.exit(function() options(old))` in `val_build()` that - constructed a function value and threw it away (never restored - the option snapshot) AND silently wiped the earlier - `on.exit(options(old_cfg), add = TRUE)` because it lacked + some source-tier packages.** Two related fixes for #181: + 1. The outer seam in `val_pipeline()` pushed + `options(pkgType = "source")` into the parent session before + dispatching to `val_build()`, unconditionally and outside the + `ref` gate. That set is now removed; `pkgType` is owned in + exactly one place -- `val_build()`, via the new + `apply_val_build_options()` helper, gated on `ref == "source"`. + 2. For source-tier assessment, `val_build()` now sets + `pkgType = "both"` (NOT `"source"`). Entering `val_build()` + under `getOption('pkgType') == 'source'` was reproducibly + regressing logrx from >90% to ~62% covr_coverage. Likely + mechanism: `configure_riskmetric_offline_if_requested()` + (which `val_build()` calls near entry) uses + `utils::available.packages()`, whose default `type` filter + narrows the offline cache to source-only under + `pkgType == "source"` -- any dependency present only as a + binary in a PPM-style mirror drops out and downstream + test-time installs fail silently. `"both"` keeps the cache + complete (binary-preferred, source fallback) while + `ref = "source"` still drives val.pipeline's own + source-tarball assessment path in `val_pkg()`. + + Also fixes a stale `on.exit(function() options(old))` in + `val_build()` that constructed a function value and threw it away + (never restored the option snapshot) AND silently wiped the + earlier `on.exit(options(old_cfg), add = TRUE)` because it lacked `add = TRUE`. (#181) # val.pipeline 0.1.59 diff --git a/R/utils.R b/R/utils.R index 81d3600..519409b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -188,18 +188,39 @@ apply_config_path <- function(config_path) { #' Set `repos` and (conditionally) `pkgType` for a val_build() scope #' #' Sets `options(repos = opt_repos)` and, when `ref == "source"`, also -#' `options(pkgType = "source")`. Returns the previous values in the +#' `options(pkgType = "both")`. Returns the previous values in the #' form returned by [base::options()] so the caller can restore them #' via `on.exit(options(old), add = TRUE)`. #' +#' # Why `pkgType = "both"` for source-tier assessment (not `"source"`) +#' +#' Intuition would say "source-tier assessment => `pkgType = 'source'`", +#' but that combination is exactly what regressed `covr_coverage` on +#' logrx from >90% to ~62% (see #181). Reproduced empirically: +#' entering `val_build(ref = "source", ...)` under +#' `getOption('pkgType') == 'source'` produces the ~62% number; +#' entering under `"both"` or `"binary"` produces >90%. The likely +#' mechanism: `configure_riskmetric_offline_if_requested()` (which +#' runs near the top of val_build's body) calls +#' `utils::available.packages()`, whose default `type = getOption('pkgType')` +#' filters the resolved cache. Under `"source"` the cache is +#' source-only -- packages available only as binaries in a PPM-style +#' mirror drop out of the offline cache, and downstream install +#' probes for a source-tier package's test-time dependencies fail +#' silently (test suite short-circuits, covr reports the resulting +#' partial coverage). `"both"` returns the fullest cache while still +#' allowing source installs where source is what's actually needed. +#' +#' `ref` still governs val.pipeline's OWN source-vs-remote assessment +#' path (see `val_pkg()`'s tarball fetch) -- `pkgType` here only +#' controls what `install.packages()` / `available.packages()` do +#' for the dependency install probe, which we want as permissive +#' as possible. +#' #' Extracted from `val_build()` so the option-management contract is -#' testable in isolation. The `ref` gate mirrors `val_build()`'s -#' historical intent (source installs only for source-tier assessment) -#' -- see #181 for the covr-coverage regression that motivated -#' extracting this and the paired unconditional-set audit in -#' `val_pipeline()` / `val_prep_pipeline()` / `val_categorize()`. +#' testable in isolation. #' -#' @param ref One of `"source"` or `"remote"`. `pkgType = "source"` is +#' @param ref One of `"source"` or `"remote"`. `pkgType = "both"` is #' set only when `ref == "source"`; `"remote"` leaves the caller's #' `pkgType` untouched. #' @param opt_repos Named character vector of repository URLs, as @@ -214,7 +235,7 @@ apply_config_path <- function(config_path) { apply_val_build_options <- function(ref, opt_repos) { ref <- match.arg(ref, c("source", "remote")) if (identical(ref, "source")) { - old <- options(repos = opt_repos, pkgType = "source") + old <- options(repos = opt_repos, pkgType = "both") } else { old <- options(repos = opt_repos) } diff --git a/R/val_build.R b/R/val_build.R index aa1bc2f..1dcdf25 100644 --- a/R/val_build.R +++ b/R/val_build.R @@ -233,19 +233,22 @@ val_build <- function( remote_pkgs <- pull_config(val = "remote_only", rule_type = "default") # opt_repos <- pull_config(val = "opt_repos", rule_type = "default") |> unlist() - # Establish `options(repos, pkgType)` AFTER - # `configure_bioc_repositories_if_requested()` + - # `configure_riskmetric_offline_if_requested()` on purpose: the - # bioc helper only installs a `assignInNamespace("repositories", - # ...)` shim (no `available.packages()` call of its own), but the - # riskmetric-offline helper DOES call `available.packages()` (see - # `R/bioc.R`) to build its offline cache. Pre-poisoning the caller - # session with `pkgType = "source"` before that cache is built - # produces a different cache and silently regressed covr_coverage - # on some source-tier packages (>90% on logrx under bare - # `val_build()`, ~62% when the same call was reached through - # `val_pipeline()` because the outer seam unconditionally pushed - # `pkgType = "source"` into the parent session first). See #181. + # For `ref == "source"` runs, force `options(pkgType = "both")` -- + # NOT `"source"`. See `apply_val_build_options()` in `R/utils.R` + # for the full mechanism; short version: entering val_build under + # `getOption('pkgType') == 'source'` regressed covr_coverage on + # some source-tier packages (>90% on logrx became ~62%), + # reproduced empirically by Aaron. The likely offender is + # `configure_riskmetric_offline_if_requested()` above -- it calls + # `available.packages()`, whose default `type` filter narrows the + # offline cache to source-only when `pkgType == "source"`, so any + # dep only present as a binary in a PPM-style mirror drops out + # and downstream test-time installs fail silently. + # + # `"both"` keeps the cache complete (binary-preferred, source + # fallback) while `ref = "source"` still governs val.pipeline's + # own source-tarball assessment path in `val_pkg()`. See #181. + # # The `on.exit(options(old), add = TRUE)` guard restores whichever # slots we mutated -- fixes the previous # `on.exit(function() options(old))` which constructed a function diff --git a/tests/testthat/test-apply_val_build_options.R b/tests/testthat/test-apply_val_build_options.R index 7fbd320..3b49abe 100644 --- a/tests/testthat/test-apply_val_build_options.R +++ b/tests/testthat/test-apply_val_build_options.R @@ -1,15 +1,16 @@ # Contract for apply_val_build_options(): sets `repos` (always) and -# `pkgType = "source"` (only when ref == "source"), and returns the +# `pkgType = "both"` (only when ref == "source"), and returns the # previous slot values in an `options()`-shaped list so the caller # can restore via `on.exit(options(old), add = TRUE)`. Root motivation -# is #181 -- the outer `val_pipeline()` seam used to set -# `pkgType = "source"` unconditionally, diverging parent-session -# state between `val_pipeline() -> val_build()` and bare `val_build()` -# and silently regressing covr_coverage on some source-tier packages. +# is #181 -- entering val_build under `getOption('pkgType') == 'source'` +# regressed covr_coverage on some source-tier packages (>90% on logrx +# became ~62%). `"both"` keeps the offline available.packages() cache +# complete for the dependency install probe while `ref = "source"` +# still drives val.pipeline's own source-tarball assessment path. test_that("apply_val_build_options(ref = 'source') sets repos AND pkgType", { withr::with_options( - list(repos = c(CRAN = "https://old.example/cran"), pkgType = "both"), + list(repos = c(CRAN = "https://old.example/cran"), pkgType = "binary"), { old <- apply_val_build_options( ref = "source", @@ -21,21 +22,41 @@ test_that("apply_val_build_options(ref = 'source') sets repos AND pkgType", { "https://new.example/cran") expect_equal(getOption("repos")[["BioC"]], "https://new.example/bioc") - expect_equal(getOption("pkgType"), "source") + # #181: source-tier assessment must force pkgType = "both" + # (NOT "source") so the offline available.packages() cache built + # by configure_riskmetric_offline_if_requested() stays complete. + expect_equal(getOption("pkgType"), "both") # Returned `old` captured both slots verbatim, ready for # `options(old)`. expect_setequal(names(old), c("repos", "pkgType")) expect_equal(old$repos[["CRAN"]], "https://old.example/cran") - expect_equal(old$pkgType, "both") + expect_equal(old$pkgType, "binary") # Restoring returns state to the with_options snapshot. options(old) - expect_equal(getOption("pkgType"), "both") + expect_equal(getOption("pkgType"), "binary") expect_equal(getOption("repos")[["CRAN"]], "https://old.example/cran") } ) }) +test_that("apply_val_build_options(ref = 'source') never sets pkgType='source'", { + # Regression guard for #181: the intuitive-but-wrong direction was + # pkgType = "source" for source-tier assessment. Force any future + # attempt to flip this back to fail loudly here. + withr::with_options( + list(repos = NULL, pkgType = "binary"), + { + old <- apply_val_build_options( + ref = "source", + opt_repos = c(CRAN = "https://new.example/cran") + ) + expect_false(identical(getOption("pkgType"), "source")) + options(old) + } + ) +}) + test_that("apply_val_build_options(ref = 'remote') does NOT touch pkgType", { withr::with_options( list(repos = c(CRAN = "https://old.example/cran"), pkgType = "both"), From 57c31e0c7253b026681c90f079e65c0330487105 Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Mon, 14 Sep 2026 18:31:18 -0700 Subject: [PATCH 06/10] Add dev/dev_probe_run_progress.R: mid-run cohort progress probe Companion helper for the low-covr re-run driver (dev/dev_rerun_low_covr.R) and any other val_build(replace = TRUE) cohort: reports done / remaining / throughput / ETA by filtering assessed/__meta.rds by mtime relative to a caller-supplied run_started timestamp. The mtime filter is necessary because replace = TRUE overwrites metas in place -- a naive file-count is fooled by pre-existing metas from an earlier run. Inputs (via globals in caller's env): - pkgs : the cohort vector passed to val_build(). - run_started : POSIXct or 'YYYY-MM-DD HH:MM:SS' string; the kickoff moment (or Sys.time() - elapsed_hr if only the duration is known). - out, val_date: standard val_build layout knobs; the script derives val_dir = /R_//. Outputs: - Console summary (cohort size, done, remaining, throughput, ETA). - `progress` data.frame in caller env, one row per cohort pkg, status in {done, pre_existing_meta_not_touched, no_meta}. - `remaining_pkgs` vector for follow-up. - Peek: 20 most-recent completions + first 20 remaining. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- dev/dev_probe_run_progress.R | 184 +++++++++++++++++++++++++++++++++++ 1 file changed, 184 insertions(+) create mode 100644 dev/dev_probe_run_progress.R diff --git a/dev/dev_probe_run_progress.R b/dev/dev_probe_run_progress.R new file mode 100644 index 0000000..833f684 --- /dev/null +++ b/dev/dev_probe_run_progress.R @@ -0,0 +1,184 @@ +# dev/dev_probe_run_progress.R +# +# Mid-run progress probe for a val_build() / val_pipeline() invocation. +# +# Motivating scenario: you kicked off a val_build(replace = TRUE, ...) +# rerun on ~N packages a few hours ago and want to know how many are +# done, how many are left, and roughly when it'll finish. Because +# `replace = TRUE` overwrites the assessed/__meta.rds file +# in place, you CAN'T just count files -- pre-existing metas from a +# prior run look identical on disk. This script filters by file +# mtime instead: any meta touched at or after your run kickoff +# counts as "done in this run". +# +# ---- USAGE ---------------------------------------------------------- +# +# Two knobs the script needs; supply them either as objects already in +# your global env before sourcing, or edit the defaults below: +# +# pkgs - character vector, the pkg_names you passed to val_build(). +# run_started - POSIXct or a "YYYY-MM-DD HH:MM:SS" string, the moment +# the run started. If you kicked it off with a launcher +# that echoed a start-time to the log, use that. +# Fallback: `Sys.time() - as.difftime(hrs, units = 'hours')` +# with `hrs` matching your best estimate. +# +# Layout knobs (typically inherited from your launcher's env): +# +# out - top-level output tree, e.g. "/data/pm/riskassessments". +# val_date - Date or "YYYY-MM-DD" string that val_build() used to +# compute its `val_dir` (folder is `R_//`). +# +# ---- WHAT YOU GET --------------------------------------------------- +# +# 1. Console summary: cohort size, done, remaining, throughput, +# linear ETA to finish. +# 2. `progress` data.frame in your global env with per-pkg status +# (done / no_meta / pre_existing_meta_not_touched). +# 3. `remaining_pkgs` vector -- the still-to-run subset. +# +# Note on caveats: +# - A pkg that errored out early enough to skip the meta write shows as +# `no_meta`. Cross-check `val_dir/val_pipeline.log` for skip/error +# lines to tell "crashed" from "queued". +# - If the run has cycled workers between packages faster than mtime +# resolution (unlikely at real-world assessment times), adjacent +# pkgs may share the same second. Not a problem for cohort-level +# counting, just don't over-index on ordering by mtime. +# +# ===================================================================== + +# ---- Defaults / expected inputs ------------------------------------- + +if (!exists("pkgs")) { + stop( + "Set `pkgs` in your global env (the vector you passed to val_build) ", + "before sourcing this script." + ) +} + +if (!exists("run_started")) { + stop( + "Set `run_started` in your global env, e.g.\n", + " run_started <- as.POSIXct('2026-09-14 12:00:00')\n", + "or, if you only know duration:\n", + " run_started <- Sys.time() - as.difftime(6.5, units = 'hours')" + ) +} +if (is.character(run_started)) run_started <- as.POSIXct(run_started) + +if (!exists("out")) { + stop("Set `out` (top-level output tree) in your global env.") +} +if (!exists("val_date")) { + stop("Set `val_date` (the run's val_date) in your global env.") +} + +# ---- Resolve val_dir ------------------------------------------------ + +val_date_txt <- gsub("-", "", format(as.Date(val_date))) +val_dir <- file.path(out, paste0("R_", getRversion()), val_date_txt) +assessed <- file.path(val_dir, "assessed") + +if (!dir.exists(assessed)) { + stop( + "assessed/ dir does not exist: ", assessed, "\n", + "Check `out` and `val_date` -- did the run actually kick off?" + ) +} + +cat("Probing:\n") +cat(" val_dir : ", val_dir, "\n", sep = "") +cat(" run_started : ", format(run_started), "\n", sep = "") +cat(" now : ", format(Sys.time()), "\n", sep = "") +elapsed_hr <- as.numeric(difftime(Sys.time(), run_started, units = "hours")) +cat(" elapsed : ", sprintf("%.2f hr", elapsed_hr), "\n\n", sep = "") + +# ---- Classify each cohort pkg by meta-file mtime -------------------- + +# Build one row per cohort pkg. `meta_path` may be missing (no meta yet +# on disk) or present-but-stale (pre-existing from a prior run). We +# glob rather than reconstruct __meta.rds because we don't +# necessarily know the version pinned for this run's opt_repos here. +progress <- do.call(rbind, lapply(pkgs, function(pkg) { + candidates <- list.files( + assessed, + pattern = paste0("^", gsub("([.^$|()\\\\+*?{}])", "\\\\\\1", pkg), + "_[^_]+_meta\\.rds$"), + full.names = TRUE + ) + if (length(candidates) == 0L) { + return(data.frame( + package = pkg, + status = "no_meta", + meta_path = NA_character_, + meta_mtime = as.POSIXct(NA), + stringsAsFactors = FALSE + )) + } + # Take the newest matching meta -- if a prior run and this run + # produced different versions, we want the freshest. + info <- file.info(candidates) + newest <- rownames(info)[which.max(info$mtime)] + mt <- info[newest, "mtime"] + status <- if (mt >= run_started) "done" else "pre_existing_meta_not_touched" + data.frame( + package = pkg, + status = status, + meta_path = newest, + meta_mtime = mt, + stringsAsFactors = FALSE + ) +})) + +# ---- Summary -------------------------------------------------------- + +n_total <- nrow(progress) +n_done <- sum(progress$status == "done") +n_pre <- sum(progress$status == "pre_existing_meta_not_touched") +n_no_meta <- sum(progress$status == "no_meta") +n_remaining <- n_total - n_done # anything not touched this run + +throughput <- n_done / max(elapsed_hr, 1e-6) # pkgs / hr +eta_hr <- if (throughput > 0) n_remaining / throughput else NA_real_ + +cat("== Cohort progress =====================================\n") +cat(sprintf(" Total in cohort : %d\n", n_total)) +cat(sprintf(" Done this run (touched) : %d\n", n_done)) +cat(sprintf(" Pre-existing meta, not touched: %d\n", n_pre)) +cat(sprintf(" No meta on disk at all : %d\n", n_no_meta)) +cat(sprintf(" Remaining to run : %d\n", n_remaining)) +cat("\n") +cat(sprintf(" Throughput : %.2f pkgs/hr\n", throughput)) +if (!is.na(eta_hr)) { + eta_when <- Sys.time() + as.difftime(eta_hr, units = "hours") + cat(sprintf(" Linear ETA to finish : %.2f hr (%s)\n", + eta_hr, format(eta_when, "%Y-%m-%d %H:%M %Z"))) +} +cat("========================================================\n") + +# ---- Expose vectors for follow-up ----------------------------------- + +remaining_pkgs <- progress$package[progress$status != "done"] + +# 20 most-recently-touched, so you can see "what's the worker on now?" +if (n_done > 0L) { + cat("\nMost recent 20 completions this run:\n") + done_sub <- progress[progress$status == "done", ] + done_sub <- done_sub[order(done_sub$meta_mtime, decreasing = TRUE), ] + print(utils::head( + data.frame( + package = done_sub$package, + mtime = format(done_sub$meta_mtime, "%Y-%m-%d %H:%M:%S"), + stringsAsFactors = FALSE + ), + 20 + ), row.names = FALSE) +} + +if (length(remaining_pkgs) > 0L) { + cat("\nFirst 20 remaining:\n") + print(utils::head(remaining_pkgs, 20)) +} + +invisible(progress) From e2b7f1bdb32b6a35e30cfc833c588fb64e4cbba6 Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Tue, 15 Sep 2026 07:04:18 -0700 Subject: [PATCH 07/10] Add dev/dev_diff_run_assessments.R: before/after covr diff Companion to dev/dev_probe_run_progress.R + dev/dev_rerun_low_covr.R. Motivating scenario: the #181 fix (pkgType='both') lifts covr on some packages but may regress others; we need a thorough per-pkg delta to inspect regressions individually and, ideally, cluster them into a mechanism. Inputs (globals in caller env): - old_qa / new_qa: data.frame OR path to qual_assessments RDS. new_qa may also be a val_dir/ path, in which case the script walks assessed/*_meta.rds and reconstructs a qual_assessments- shaped frame -- important for runs kicked off with finalize = FALSE (top-level qual_assessments.rds not regenerated at end of assessment loop). - old_qm / new_qm: (optional) qual_metadata for decision-category diff. - pkgs: (optional) restrict diff to a cohort. - out_diff: (optional) output path; defaults to dev/covr_diff_.rds (gitignored). Outputs (console): - Cohort membership (old-only / new-only / shared). - Metric column presence diff (catches silent config drift). - Coverage-band shift table (NA/0 through 90-100). - Improved/regressed/unchanged counts w/ +/- 5 pp thresholds. - Top-20 regressions + top-20 improvements. - Decision-category shift table (if qm supplied). Outputs (globals): diff_df, regressed_df, improved_df. .gitignore: add dev/covr_diff_*.rds pattern (output RDS may echo sensitive pkg names / assessment data). Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .gitignore | 1 + dev/dev_diff_run_assessments.R | 310 +++++++++++++++++++++++++++++++++ 2 files changed, 311 insertions(+) create mode 100644 dev/dev_diff_run_assessments.R diff --git a/.gitignore b/.gitignore index 7bd0ce4..63b5c94 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,4 @@ dev/nfs_smb_latency_probe.txt # Sensitive per-run artifacts (do not commit) dev/low_covr.rds dev/low_covr_rerun_compare_*.rds +dev/covr_diff_*.rds diff --git a/dev/dev_diff_run_assessments.R b/dev/dev_diff_run_assessments.R new file mode 100644 index 0000000..806a1e1 --- /dev/null +++ b/dev/dev_diff_run_assessments.R @@ -0,0 +1,310 @@ +# dev/dev_diff_run_assessments.R +# +# Before/after diff for two val_build() runs on an overlapping set of +# packages. Motivating scenario (2026-09-14): a `pkgType = "both"` fix +# is expected to lift covr_coverage on some packages but may regress +# others -- we want a thorough, sortable per-package delta so the +# regressions can be inspected individually and, ideally, clustered +# into a mechanism. +# +# ---- USAGE ---------------------------------------------------------- +# +# Set these in your global env before sourcing: +# +# old_qa - data.frame OR path to old qual_assessments RDS. +# new_qa - data.frame OR path to new qual_assessments RDS, +# OR path to a val_dir/ (the script will walk +# assessed/*_meta.rds and reconstruct a qual_assessments- +# shaped frame). This last form is what you want if you +# ran with `finalize = FALSE` and the top-level +# qual_assessments.rds hasn't been regenerated yet. +# old_qm - (optional) data.frame OR path to old qual_metadata RDS. +# If supplied AND new_qm is too, we also diff +# `final_decision`. +# new_qm - (optional) same shape. +# pkgs - (optional) restrict the diff to this subset of packages. +# If not supplied, we diff the full intersection. +# out_diff - (optional) path to save the joined diff frame as an +# RDS. Defaults to +# `dev/covr_diff_.rds` (gitignored per +# existing pattern in .gitignore). +# +# ---- OUTPUTS -------------------------------------------------------- +# +# Console: +# 1. Cohort sizes (old only / new only / shared). +# 2. Coverage-band shift histogram (old band -> new band). +# 3. Improved / regressed / unchanged counts w/ Delta thresholds. +# 4. Top-20 regressions (largest -delta on covr_coverage). +# 5. Top-20 improvements (largest +delta on covr_coverage). +# 6. Metric column presence diff (any metric column added/dropped +# between the two runs -- catches config drift silently). +# 7. Decision-category shifts (if qm supplied on both sides). +# +# Globals left in your env: +# diff_df - the full per-package joined diff frame. +# regressed_df - subset where covr_coverage dropped by >= 5 pp. +# improved_df - subset where covr_coverage rose by >= 5 pp. +# +# ===================================================================== + +# ---- Load helpers --------------------------------------------------- + +.read_maybe <- function(x, what) { + if (is.null(x)) return(NULL) + if (is.data.frame(x)) return(x) + if (is.character(x) && length(x) == 1L && file.exists(x)) { + return(readRDS(x)) + } + stop("Cannot resolve `", what, "` -- pass a data.frame or path to an RDS.") +} + +.reconstruct_qa_from_assessed <- function(val_dir) { + assessed <- file.path(val_dir, "assessed") + if (!dir.exists(assessed)) { + stop("No assessed/ under: ", val_dir) + } + meta_files <- list.files(assessed, pattern = "_meta\\.rds$", + full.names = TRUE) + if (length(meta_files) == 0L) { + stop("No _meta.rds files under: ", assessed) + } + cat("Reconstructing qual_assessments from ", length(meta_files), + " meta files in ", assessed, " ...\n", sep = "") + rows <- lapply(meta_files, function(f) { + m <- tryCatch(readRDS(f), error = function(e) NULL) + if (is.null(m) || !is.data.frame(m)) return(NULL) + m + }) + rows <- Filter(Negate(is.null), rows) + # dplyr::bind_rows would be nicer but avoid deps; base rbind with + # fill-NA-by-name is the poor man's version. + all_cols <- unique(unlist(lapply(rows, names))) + do.call(rbind, lapply(rows, function(r) { + miss <- setdiff(all_cols, names(r)) + if (length(miss)) r[miss] <- NA + r[, all_cols, drop = FALSE] + })) +} + +# ---- Resolve inputs ------------------------------------------------- + +if (!exists("old_qa")) stop("Set `old_qa` in your global env.") +if (!exists("new_qa")) stop("Set `new_qa` in your global env.") + +old_qa_df <- .read_maybe(old_qa, "old_qa") + +# `new_qa` might be a val_dir path -- detect by looking for assessed/. +new_qa_df <- if (is.character(new_qa) && length(new_qa) == 1L && + dir.exists(new_qa)) { + .reconstruct_qa_from_assessed(new_qa) +} else { + .read_maybe(new_qa, "new_qa") +} + +if (!"package" %in% names(old_qa_df) || !"package" %in% names(new_qa_df)) { + stop("Both frames must have a `package` column.") +} +if (!"covr_coverage" %in% names(old_qa_df) || + !"covr_coverage" %in% names(new_qa_df)) { + stop("Both frames must have a `covr_coverage` column.") +} + +old_qm_df <- if (exists("old_qm")) .read_maybe(old_qm, "old_qm") else NULL +new_qm_df <- if (exists("new_qm")) .read_maybe(new_qm, "new_qm") else NULL + +# Optional cohort filter +if (exists("pkgs") && length(pkgs)) { + old_qa_df <- old_qa_df[old_qa_df$package %in% pkgs, , drop = FALSE] + new_qa_df <- new_qa_df[new_qa_df$package %in% pkgs, , drop = FALSE] +} + +# ---- Cohort membership --------------------------------------------- + +old_pkgs <- unique(old_qa_df$package) +new_pkgs <- unique(new_qa_df$package) +shared <- intersect(old_pkgs, new_pkgs) +only_old <- setdiff(old_pkgs, new_pkgs) +only_new <- setdiff(new_pkgs, old_pkgs) + +cat("== Cohort membership ==================================\n") +cat(sprintf(" In old only : %d\n", length(only_old))) +cat(sprintf(" In new only : %d\n", length(only_new))) +cat(sprintf(" In both (shared) : %d\n", length(shared))) +cat("=======================================================\n\n") + +# ---- Metric column presence diff ----------------------------------- + +old_cols <- setdiff(names(old_qa_df), c("package", "version")) +new_cols <- setdiff(names(new_qa_df), c("package", "version")) +dropped_cols <- setdiff(old_cols, new_cols) +added_cols <- setdiff(new_cols, old_cols) +if (length(dropped_cols) || length(added_cols)) { + cat("== Metric column presence diff ========================\n") + if (length(dropped_cols)) { + cat(" Dropped in new: ", paste(dropped_cols, collapse = ", "), "\n") + } + if (length(added_cols)) { + cat(" Added in new : ", paste(added_cols, collapse = ", "), "\n") + } + cat("=======================================================\n\n") +} + +# ---- Per-package joined diff --------------------------------------- + +pick_latest <- function(df, key = "package") { + # Some packages may appear in >1 row if versions changed across runs. + # Keep the row with the largest `version` per package. + if (!"version" %in% names(df)) return(df) + df$.pkgorder <- package_version(df$version, strict = FALSE) + ord <- order(df$package, df$.pkgorder, decreasing = c(FALSE, TRUE), + method = "radix") + df <- df[ord, , drop = FALSE] + df <- df[!duplicated(df$package), , drop = FALSE] + df$.pkgorder <- NULL + df +} + +old_flat <- pick_latest(old_qa_df) +new_flat <- pick_latest(new_qa_df) + +old_flat <- old_flat[old_flat$package %in% shared, , drop = FALSE] +new_flat <- new_flat[new_flat$package %in% shared, , drop = FALSE] + +# Pull the columns we care about; NA-safe numeric coerce for covr. +to_num <- function(x) suppressWarnings(as.numeric(as.character(x))) + +diff_df <- data.frame( + package = old_flat$package, + version_old = if ("version" %in% names(old_flat)) old_flat$version else NA, + version_new = new_flat$version[match(old_flat$package, new_flat$package)], + covr_old = to_num(old_flat$covr_coverage), + covr_new = to_num(new_flat$covr_coverage[ + match(old_flat$package, new_flat$package) + ]), + stringsAsFactors = FALSE +) +diff_df$version_changed <- !is.na(diff_df$version_old) & + !is.na(diff_df$version_new) & + diff_df$version_old != diff_df$version_new +diff_df$covr_delta <- diff_df$covr_new - diff_df$covr_old +# Categorize (base R, no dplyr dep): +diff_df$covr_status <- ifelse( + is.na(diff_df$covr_new) & is.na(diff_df$covr_old), "both_na", + ifelse(is.na(diff_df$covr_old), "new_only", + ifelse(is.na(diff_df$covr_new), "lost_metric", + ifelse(abs(diff_df$covr_delta) < 1e-6, "unchanged", + ifelse(diff_df$covr_delta > 0, "improved", "regressed")))) +) + +# ---- Band shift ---------------------------------------------------- + +band <- function(x) { + cut(x, breaks = c(-Inf, 0, 40, 65, 80, 90, 100 + 1e-9), + labels = c("NA/0", "0-40", "40-65", "65-80", "80-90", "90-100"), + right = FALSE) +} +diff_df$band_old <- band(diff_df$covr_old) +diff_df$band_new <- band(diff_df$covr_new) + +cat("== Coverage-band shift (rows = old band, cols = new band) =====\n") +band_shift <- table(diff_df$band_old, diff_df$band_new, + useNA = "ifany", dnn = c("old", "new")) +print(band_shift) +cat("\n") + +# ---- Delta summary counts ------------------------------------------ + +thresh <- 5.0 +n_improved_big <- sum(diff_df$covr_delta >= thresh, na.rm = TRUE) +n_improved_small <- sum(diff_df$covr_delta > 0 & + diff_df$covr_delta < thresh, na.rm = TRUE) +n_unchanged <- sum(diff_df$covr_status == "unchanged", na.rm = TRUE) +n_regressed_small<- sum(diff_df$covr_delta < 0 & + diff_df$covr_delta > -thresh, na.rm = TRUE) +n_regressed_big <- sum(diff_df$covr_delta <= -thresh, na.rm = TRUE) +n_new_only <- sum(diff_df$covr_status == "new_only", na.rm = TRUE) +n_lost <- sum(diff_df$covr_status == "lost_metric", na.rm = TRUE) + +cat("== Covr delta summary (shared pkgs) ===================\n") +cat(sprintf(" Improved >= %.0f pp : %d\n", thresh, n_improved_big)) +cat(sprintf(" Improved < %.0f pp : %d\n", thresh, n_improved_small)) +cat(sprintf(" Unchanged : %d\n", n_unchanged)) +cat(sprintf(" Regressed < %.0f pp : %d\n", thresh, n_regressed_small)) +cat(sprintf(" Regressed >= %.0f pp : %d\n", thresh, n_regressed_big)) +cat(sprintf(" Gained metric (NA->#) : %d\n", n_new_only)) +cat(sprintf(" Lost metric (#->NA) : %d\n", n_lost)) +cat("=======================================================\n\n") + +# ---- Top regressions / improvements -------------------------------- + +.disp <- function(df) { + df <- df[, c("package", "version_old", "version_new", + "covr_old", "covr_new", "covr_delta", + "version_changed"), drop = FALSE] + df$covr_old <- round(df$covr_old, 2) + df$covr_new <- round(df$covr_new, 2) + df$covr_delta <- round(df$covr_delta, 2) + df +} + +regressed_df <- diff_df[!is.na(diff_df$covr_delta) & + diff_df$covr_delta <= -thresh, , drop = FALSE] +regressed_df <- regressed_df[order(regressed_df$covr_delta), , drop = FALSE] + +improved_df <- diff_df[!is.na(diff_df$covr_delta) & + diff_df$covr_delta >= thresh, , drop = FALSE] +improved_df <- improved_df[order(-improved_df$covr_delta), , drop = FALSE] + +cat("== Top 20 regressions (largest -delta) ================\n") +if (nrow(regressed_df) == 0L) { + cat(" (none)\n") +} else { + print(.disp(utils::head(regressed_df, 20)), row.names = FALSE) +} +cat("\n") + +cat("== Top 20 improvements (largest +delta) ===============\n") +if (nrow(improved_df) == 0L) { + cat(" (none)\n") +} else { + print(.disp(utils::head(improved_df, 20)), row.names = FALSE) +} +cat("\n") + +# ---- Optional: final_decision shifts ------------------------------- + +if (!is.null(old_qm_df) && !is.null(new_qm_df) && + "final_decision" %in% names(old_qm_df) && + "final_decision" %in% names(new_qm_df)) { + om <- old_qm_df[, c("package", "final_decision"), drop = FALSE] + nm <- new_qm_df[, c("package", "final_decision"), drop = FALSE] + names(om)[2] <- "decision_old" + names(nm)[2] <- "decision_new" + dec <- merge(om, nm, by = "package", all = FALSE) + dec <- dec[dec$package %in% shared, , drop = FALSE] + + cat("== Decision-category shift (old -> new) ===============\n") + dec_tab <- table(dec$decision_old, dec$decision_new, + useNA = "ifany", dnn = c("old", "new")) + print(dec_tab) + cat("=======================================================\n\n") + + # Merge into diff_df for saved output + diff_df <- merge(diff_df, dec, by = "package", all.x = TRUE) +} + +# ---- Persist diff frame -------------------------------------------- + +if (!exists("out_diff")) { + out_diff <- file.path( + "dev", + paste0("covr_diff_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".rds") + ) +} +saveRDS(diff_df, out_diff) +cat("Saved full diff frame to: ", out_diff, "\n", sep = "") +cat(" ", nrow(diff_df), " rows x ", ncol(diff_df), + " cols. Globals: diff_df, regressed_df, improved_df.\n", sep = "") + +invisible(diff_df) From dd1ae20d22268bb7053e0c5110b9cba9c26052cf Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Tue, 15 Sep 2026 07:21:45 -0700 Subject: [PATCH 08/10] Diff script: HTML report + rev-dep-weighted unlocker/blocker views Redesigned dev/dev_diff_run_assessments.R to support two workflow needs Aaron surfaced while inspecting a mid-run cohort: 1. Visual + shareable output. In addition to the console tables, the script now writes a self-contained HTML report to /covr_diff_.html -- inline CSS, no external assets, safe to email or drop in Slack. Green/red-highlighted delta cells; band-shift and decision-shift matrices rendered as HTML tables; per-section notes explaining what each list is for. run_tag defaults to a timestamp; can be overridden. 2. Rev-dep-weighted top-20 lists on top of the raw delta ranks: - UNLOCKERS: pkgs that crossed the 65% threshold UPWARD, ranked by rev-dep count. Highest rev-dep count = largest downstream slice of the qualified set unlocked by this pkg entering the qualified pool. These are the run's leverage wins. - BLOCKERS: pkgs still BELOW 65% after the run (regressed across the line OR were already below and stayed below), ranked by rev-dep count. Biggest downstream blockers surface first -- highest-value investigation targets for follow-up since unblocking them propagates. Rev-dep source priority: reverse_dependencies column on new_qa -> same column on old_qa -> fallback derived from qm's Depends/Imports/LinkingTo columns -> NA w/ friendly warning. Also added: - crossed_up / crossed_down / below_after boolean flags on diff_df so callers can slice however they want. - covr_status categorical ({improved, regressed, unchanged, lost_metric, new_only, both_na}) for easier filtering. - version_changed flag preserved from prior draft -- caller can eyeball which regressions coincide with upstream bumps vs which are pipeline-side. .gitignore: added dev/covr_diff_*.html to the existing rds pattern. Smoke test with synthetic frames: 50 shared pkgs, forced unlocker/regression rows -> HTML renders cleanly (13.4 KB), all five global data.frames populate, band-shift matrix and top-20 tables all print. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .gitignore | 1 + dev/dev_diff_run_assessments.R | 420 +++++++++++++++++++++++++-------- 2 files changed, 319 insertions(+), 102 deletions(-) diff --git a/.gitignore b/.gitignore index 63b5c94..130b2c3 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,4 @@ dev/nfs_smb_latency_probe.txt dev/low_covr.rds dev/low_covr_rerun_compare_*.rds dev/covr_diff_*.rds +dev/covr_diff_*.html diff --git a/dev/dev_diff_run_assessments.R b/dev/dev_diff_run_assessments.R index 806a1e1..b523812 100644 --- a/dev/dev_diff_run_assessments.R +++ b/dev/dev_diff_run_assessments.R @@ -1,55 +1,67 @@ # dev/dev_diff_run_assessments.R # # Before/after diff for two val_build() runs on an overlapping set of -# packages. Motivating scenario (2026-09-14): a `pkgType = "both"` fix -# is expected to lift covr_coverage on some packages but may regress -# others -- we want a thorough, sortable per-package delta so the -# regressions can be inspected individually and, ideally, clustered -# into a mechanism. +# packages. Motivating scenario (2026-09-14): the #181 `pkgType='both'` +# fix is expected to lift covr_coverage on some packages but may +# regress others -- we want: +# +# 1. Console summary (band-shift matrix, delta buckets, top-20 lists). +# 2. Self-contained HTML report to share with colleagues. +# 3. Two rev-dep-weighted views on top of the raw delta lists: +# - "Unlockers": pkgs that CROSSED 65% upward, ranked by rev-dep +# count -- a pkg with many rev-deps that just qualified unlocks +# the biggest downstream slice of the qualified set. +# - "Blockers": pkgs still BELOW 65% (either regressed or never +# crossed), ranked by rev-dep count -- these are the most +# valuable investigation targets because unblocking them +# propagates the most. # # ---- USAGE ---------------------------------------------------------- # # Set these in your global env before sourcing: # -# old_qa - data.frame OR path to old qual_assessments RDS. -# new_qa - data.frame OR path to new qual_assessments RDS, -# OR path to a val_dir/ (the script will walk -# assessed/*_meta.rds and reconstruct a qual_assessments- -# shaped frame). This last form is what you want if you -# ran with `finalize = FALSE` and the top-level -# qual_assessments.rds hasn't been regenerated yet. -# old_qm - (optional) data.frame OR path to old qual_metadata RDS. -# If supplied AND new_qm is too, we also diff -# `final_decision`. -# new_qm - (optional) same shape. -# pkgs - (optional) restrict the diff to this subset of packages. -# If not supplied, we diff the full intersection. -# out_diff - (optional) path to save the joined diff frame as an -# RDS. Defaults to -# `dev/covr_diff_.rds` (gitignored per -# existing pattern in .gitignore). +# old_qa - data.frame OR path to old qual_assessments RDS. +# new_qa - data.frame OR path to new qual_assessments RDS, +# OR path to a val_dir/ (script walks +# assessed/*_meta.rds and reconstructs a +# qual_assessments-shaped frame -- important for runs +# kicked off with `finalize = FALSE`). +# old_qm - (optional) data.frame OR path to old qual_metadata RDS. +# new_qm - (optional) same shape, for decision-category diff. +# pkgs - (optional) restrict diff to this cohort. +# out_dir - (optional) output directory for the HTML + RDS. +# Defaults to `dev/`. +# run_tag - (optional) short string appended to output filenames. +# Defaults to a timestamp. +# +# Rev-dep source (in order): +# 1. `reverse_dependencies` numeric column on new_qa (preferred -- +# it's what val.pipeline itself uses for scheduling and it +# reflects the run's own opt_repos snapshot). +# 2. Same column on old_qa if new_qa doesn't carry it. +# 3. Otherwise, computed on the fly against the union universe by +# counting how many pkgs in qual_assessments list each pkg in +# their Depends / Imports / LinkingTo (requires those columns +# on qm; skipped w/ warning if not present). # # ---- OUTPUTS -------------------------------------------------------- # -# Console: -# 1. Cohort sizes (old only / new only / shared). -# 2. Coverage-band shift histogram (old band -> new band). -# 3. Improved / regressed / unchanged counts w/ Delta thresholds. -# 4. Top-20 regressions (largest -delta on covr_coverage). -# 5. Top-20 improvements (largest +delta on covr_coverage). -# 6. Metric column presence diff (any metric column added/dropped -# between the two runs -- catches config drift silently). -# 7. Decision-category shifts (if qm supplied on both sides). +# Console: cohort membership, column-presence diff, band-shift matrix, +# delta bucket counts, top-20 regressions, top-20 improvements, +# top-20 unlockers, top-20 blockers. +# +# Files: +# /covr_diff_.html - self-contained report. +# /covr_diff_.rds - full diff frame. # -# Globals left in your env: -# diff_df - the full per-package joined diff frame. -# regressed_df - subset where covr_coverage dropped by >= 5 pp. -# improved_df - subset where covr_coverage rose by >= 5 pp. +# Globals: diff_df, regressed_df, improved_df, unlockers_df, blockers_df. # # ===================================================================== # ---- Load helpers --------------------------------------------------- +`%||%` <- function(a, b) if (is.null(a)) b else a + .read_maybe <- function(x, what) { if (is.null(x)) return(NULL) if (is.data.frame(x)) return(x) @@ -77,8 +89,6 @@ m }) rows <- Filter(Negate(is.null), rows) - # dplyr::bind_rows would be nicer but avoid deps; base rbind with - # fill-NA-by-name is the poor man's version. all_cols <- unique(unlist(lapply(rows, names))) do.call(rbind, lapply(rows, function(r) { miss <- setdiff(all_cols, names(r)) @@ -94,7 +104,6 @@ if (!exists("new_qa")) stop("Set `new_qa` in your global env.") old_qa_df <- .read_maybe(old_qa, "old_qa") -# `new_qa` might be a val_dir path -- detect by looking for assessed/. new_qa_df <- if (is.character(new_qa) && length(new_qa) == 1L && dir.exists(new_qa)) { .reconstruct_qa_from_assessed(new_qa) @@ -103,22 +112,25 @@ new_qa_df <- if (is.character(new_qa) && length(new_qa) == 1L && } if (!"package" %in% names(old_qa_df) || !"package" %in% names(new_qa_df)) { - stop("Both frames must have a `package` column.") + stop("Both qa frames must have a `package` column.") } if (!"covr_coverage" %in% names(old_qa_df) || !"covr_coverage" %in% names(new_qa_df)) { - stop("Both frames must have a `covr_coverage` column.") + stop("Both qa frames must have a `covr_coverage` column.") } old_qm_df <- if (exists("old_qm")) .read_maybe(old_qm, "old_qm") else NULL new_qm_df <- if (exists("new_qm")) .read_maybe(new_qm, "new_qm") else NULL -# Optional cohort filter if (exists("pkgs") && length(pkgs)) { old_qa_df <- old_qa_df[old_qa_df$package %in% pkgs, , drop = FALSE] new_qa_df <- new_qa_df[new_qa_df$package %in% pkgs, , drop = FALSE] } +if (!exists("out_dir")) out_dir <- "dev" +if (!exists("run_tag")) run_tag <- format(Sys.time(), "%Y%m%d_%H%M%S") +dir.create(out_dir, showWarnings = FALSE, recursive = TRUE) + # ---- Cohort membership --------------------------------------------- old_pkgs <- unique(old_qa_df$package) @@ -141,24 +153,20 @@ dropped_cols <- setdiff(old_cols, new_cols) added_cols <- setdiff(new_cols, old_cols) if (length(dropped_cols) || length(added_cols)) { cat("== Metric column presence diff ========================\n") - if (length(dropped_cols)) { - cat(" Dropped in new: ", paste(dropped_cols, collapse = ", "), "\n") - } - if (length(added_cols)) { - cat(" Added in new : ", paste(added_cols, collapse = ", "), "\n") - } + if (length(dropped_cols)) cat(" Dropped in new: ", + paste(dropped_cols, collapse = ", "), "\n") + if (length(added_cols)) cat(" Added in new : ", + paste(added_cols, collapse = ", "), "\n") cat("=======================================================\n\n") } # ---- Per-package joined diff --------------------------------------- -pick_latest <- function(df, key = "package") { - # Some packages may appear in >1 row if versions changed across runs. - # Keep the row with the largest `version` per package. +pick_latest <- function(df) { if (!"version" %in% names(df)) return(df) df$.pkgorder <- package_version(df$version, strict = FALSE) - ord <- order(df$package, df$.pkgorder, decreasing = c(FALSE, TRUE), - method = "radix") + ord <- order(df$package, df$.pkgorder, + decreasing = c(FALSE, TRUE), method = "radix") df <- df[ord, , drop = FALSE] df <- df[!duplicated(df$package), , drop = FALSE] df$.pkgorder <- NULL @@ -171,9 +179,55 @@ new_flat <- pick_latest(new_qa_df) old_flat <- old_flat[old_flat$package %in% shared, , drop = FALSE] new_flat <- new_flat[new_flat$package %in% shared, , drop = FALSE] -# Pull the columns we care about; NA-safe numeric coerce for covr. to_num <- function(x) suppressWarnings(as.numeric(as.character(x))) +# Resolve rev-dep count. Preference: new_qa$reverse_dependencies -> +# old_qa$reverse_dependencies -> qm-derived from Depends/Imports. +rev_dep_from_col <- function(df, key = "package") { + if (!"reverse_dependencies" %in% names(df)) return(NULL) + x <- to_num(df$reverse_dependencies) + setNames(x, df[[key]]) +} +rd_map <- rev_dep_from_col(new_flat) +if (is.null(rd_map)) rd_map <- rev_dep_from_col(old_flat) +if (is.null(rd_map)) { + # Fallback: derive from qm Depends/Imports/LinkingTo list-cols or + # comma-separated strings. This is coarser (union universe, not + # opt_repos-scoped) but usable. + qm_src <- new_qm_df %||% old_qm_df + if (!is.null(qm_src) && + any(c("depends", "imports", "linking_to", "linkingto") + %in% tolower(names(qm_src)))) { + coalesce_deps <- function(row) { + pieces <- c() + for (col in intersect(c("depends", "imports", + "linking_to", "linkingto"), + tolower(names(qm_src)))) { + v <- row[[names(qm_src)[tolower(names(qm_src)) == col][1]]] + if (is.list(v)) v <- unlist(v) + if (is.character(v)) + pieces <- c(pieces, + trimws(unlist(strsplit(v, "[,;]")))) + } + unique(pieces[nzchar(pieces) & pieces != "R"]) + } + counts <- integer(nrow(qm_src)) + names(counts) <- qm_src$package + all_deps <- lapply(seq_len(nrow(qm_src)), + function(i) coalesce_deps(qm_src[i, , drop = FALSE])) + dep_tbl <- table(unlist(all_deps)) + rd_map <- as.integer(dep_tbl) + names(rd_map) <- names(dep_tbl) + cat("Note: rev_deps derived from qm Depends/Imports fallback ", + "(coarser than opt_repos-scoped counts).\n", sep = "") + } +} +if (is.null(rd_map)) { + cat("Warning: no rev-dep source available; unlocker/blocker ", + "tables will show n_rev_deps = NA.\n", sep = "") + rd_map <- setNames(rep(NA_integer_, length(shared)), shared) +} + diff_df <- data.frame( package = old_flat$package, version_old = if ("version" %in% names(old_flat)) old_flat$version else NA, @@ -182,13 +236,13 @@ diff_df <- data.frame( covr_new = to_num(new_flat$covr_coverage[ match(old_flat$package, new_flat$package) ]), + n_rev_deps = as.integer(rd_map[old_flat$package]), stringsAsFactors = FALSE ) diff_df$version_changed <- !is.na(diff_df$version_old) & !is.na(diff_df$version_new) & diff_df$version_old != diff_df$version_new diff_df$covr_delta <- diff_df$covr_new - diff_df$covr_old -# Categorize (base R, no dplyr dep): diff_df$covr_status <- ifelse( is.na(diff_df$covr_new) & is.na(diff_df$covr_old), "both_na", ifelse(is.na(diff_df$covr_old), "new_only", @@ -197,6 +251,14 @@ diff_df$covr_status <- ifelse( ifelse(diff_df$covr_delta > 0, "improved", "regressed")))) ) +# 65% threshold crossings +THR <- 65 +diff_df$crossed_up <- !is.na(diff_df$covr_old) & !is.na(diff_df$covr_new) & + diff_df$covr_old < THR & diff_df$covr_new >= THR +diff_df$crossed_down <- !is.na(diff_df$covr_old) & !is.na(diff_df$covr_new) & + diff_df$covr_old >= THR & diff_df$covr_new < THR +diff_df$below_after <- !is.na(diff_df$covr_new) & diff_df$covr_new < THR + # ---- Band shift ---------------------------------------------------- band <- function(x) { @@ -207,7 +269,7 @@ band <- function(x) { diff_df$band_old <- band(diff_df$covr_old) diff_df$band_new <- band(diff_df$covr_new) -cat("== Coverage-band shift (rows = old band, cols = new band) =====\n") +cat("== Coverage-band shift (rows = old, cols = new) =======\n") band_shift <- table(diff_df$band_old, diff_df$band_new, useNA = "ifany", dnn = c("old", "new")) print(band_shift) @@ -216,35 +278,42 @@ cat("\n") # ---- Delta summary counts ------------------------------------------ thresh <- 5.0 -n_improved_big <- sum(diff_df$covr_delta >= thresh, na.rm = TRUE) -n_improved_small <- sum(diff_df$covr_delta > 0 & - diff_df$covr_delta < thresh, na.rm = TRUE) -n_unchanged <- sum(diff_df$covr_status == "unchanged", na.rm = TRUE) -n_regressed_small<- sum(diff_df$covr_delta < 0 & - diff_df$covr_delta > -thresh, na.rm = TRUE) -n_regressed_big <- sum(diff_df$covr_delta <= -thresh, na.rm = TRUE) -n_new_only <- sum(diff_df$covr_status == "new_only", na.rm = TRUE) -n_lost <- sum(diff_df$covr_status == "lost_metric", na.rm = TRUE) +counts <- c( + improved_big = sum(diff_df$covr_delta >= thresh, na.rm = TRUE), + improved_small = sum(diff_df$covr_delta > 0 & + diff_df$covr_delta < thresh, na.rm = TRUE), + unchanged = sum(diff_df$covr_status == "unchanged", na.rm = TRUE), + regressed_small = sum(diff_df$covr_delta < 0 & + diff_df$covr_delta > -thresh, na.rm = TRUE), + regressed_big = sum(diff_df$covr_delta <= -thresh, na.rm = TRUE), + crossed_up = sum(diff_df$crossed_up, na.rm = TRUE), + crossed_down = sum(diff_df$crossed_down, na.rm = TRUE), + new_only = sum(diff_df$covr_status == "new_only", na.rm = TRUE), + lost_metric = sum(diff_df$covr_status == "lost_metric", na.rm = TRUE) +) cat("== Covr delta summary (shared pkgs) ===================\n") -cat(sprintf(" Improved >= %.0f pp : %d\n", thresh, n_improved_big)) -cat(sprintf(" Improved < %.0f pp : %d\n", thresh, n_improved_small)) -cat(sprintf(" Unchanged : %d\n", n_unchanged)) -cat(sprintf(" Regressed < %.0f pp : %d\n", thresh, n_regressed_small)) -cat(sprintf(" Regressed >= %.0f pp : %d\n", thresh, n_regressed_big)) -cat(sprintf(" Gained metric (NA->#) : %d\n", n_new_only)) -cat(sprintf(" Lost metric (#->NA) : %d\n", n_lost)) +cat(sprintf(" Improved >= %.0f pp : %d\n", thresh, counts["improved_big"])) +cat(sprintf(" Improved < %.0f pp : %d\n", thresh, counts["improved_small"])) +cat(sprintf(" Unchanged : %d\n", counts["unchanged"])) +cat(sprintf(" Regressed < %.0f pp : %d\n", thresh, counts["regressed_small"])) +cat(sprintf(" Regressed >= %.0f pp : %d\n", thresh, counts["regressed_big"])) +cat(sprintf(" Crossed UP over %d%% : %d\n", THR, counts["crossed_up"])) +cat(sprintf(" Crossed DOWN under %d%%: %d\n", THR, counts["crossed_down"])) +cat(sprintf(" Gained metric (NA->#) : %d\n", counts["new_only"])) +cat(sprintf(" Lost metric (#->NA) : %d\n", counts["lost_metric"])) cat("=======================================================\n\n") -# ---- Top regressions / improvements -------------------------------- +# ---- Top tables ---------------------------------------------------- -.disp <- function(df) { - df <- df[, c("package", "version_old", "version_new", +disp_cols <- c("package", "version_old", "version_new", "covr_old", "covr_new", "covr_delta", - "version_changed"), drop = FALSE] - df$covr_old <- round(df$covr_old, 2) - df$covr_new <- round(df$covr_new, 2) - df$covr_delta <- round(df$covr_delta, 2) + "n_rev_deps", "version_changed") +.round_disp <- function(df) { + df <- df[, intersect(disp_cols, names(df)), drop = FALSE] + for (nm in c("covr_old", "covr_new", "covr_delta")) { + if (nm %in% names(df)) df[[nm]] <- round(df[[nm]], 2) + } df } @@ -256,24 +325,41 @@ improved_df <- diff_df[!is.na(diff_df$covr_delta) & diff_df$covr_delta >= thresh, , drop = FALSE] improved_df <- improved_df[order(-improved_df$covr_delta), , drop = FALSE] +# NEW: unlockers = crossed 65 upward, ranked by rev-dep count +unlockers_df <- diff_df[diff_df$crossed_up, , drop = FALSE] +unlockers_df <- unlockers_df[order(-unlockers_df$n_rev_deps, + -unlockers_df$covr_delta), , drop = FALSE] + +# NEW: blockers = still below 65% after run, ranked by rev-dep count. +# Includes both "regressed across 65" AND "was already below and stayed +# below" -- either way, unblocking these propagates the most. +blockers_df <- diff_df[diff_df$below_after, , drop = FALSE] +blockers_df <- blockers_df[order(-blockers_df$n_rev_deps, + blockers_df$covr_new), , drop = FALSE] + cat("== Top 20 regressions (largest -delta) ================\n") -if (nrow(regressed_df) == 0L) { - cat(" (none)\n") -} else { - print(.disp(utils::head(regressed_df, 20)), row.names = FALSE) -} +if (nrow(regressed_df) == 0L) cat(" (none)\n") else + print(.round_disp(utils::head(regressed_df, 20)), row.names = FALSE) cat("\n") cat("== Top 20 improvements (largest +delta) ===============\n") -if (nrow(improved_df) == 0L) { - cat(" (none)\n") -} else { - print(.disp(utils::head(improved_df, 20)), row.names = FALSE) -} +if (nrow(improved_df) == 0L) cat(" (none)\n") else + print(.round_disp(utils::head(improved_df, 20)), row.names = FALSE) cat("\n") -# ---- Optional: final_decision shifts ------------------------------- +cat(sprintf("== Top 20 UNLOCKERS (crossed %d%%, by rev-dep count) ==\n", THR)) +if (nrow(unlockers_df) == 0L) cat(" (none)\n") else + print(.round_disp(utils::head(unlockers_df, 20)), row.names = FALSE) +cat("\n") + +cat(sprintf("== Top 20 BLOCKERS (still < %d%%, by rev-dep count) ===\n", THR)) +if (nrow(blockers_df) == 0L) cat(" (none)\n") else + print(.round_disp(utils::head(blockers_df, 20)), row.names = FALSE) +cat("\n") +# ---- Optional decision-category shift ------------------------------ + +dec_tab <- NULL if (!is.null(old_qm_df) && !is.null(new_qm_df) && "final_decision" %in% names(old_qm_df) && "final_decision" %in% names(new_qm_df)) { @@ -283,28 +369,158 @@ if (!is.null(old_qm_df) && !is.null(new_qm_df) && names(nm)[2] <- "decision_new" dec <- merge(om, nm, by = "package", all = FALSE) dec <- dec[dec$package %in% shared, , drop = FALSE] - cat("== Decision-category shift (old -> new) ===============\n") dec_tab <- table(dec$decision_old, dec$decision_new, useNA = "ifany", dnn = c("old", "new")) print(dec_tab) cat("=======================================================\n\n") - - # Merge into diff_df for saved output diff_df <- merge(diff_df, dec, by = "package", all.x = TRUE) } -# ---- Persist diff frame -------------------------------------------- +# ---- Persist frame ------------------------------------------------- + +rds_path <- file.path(out_dir, paste0("covr_diff_", run_tag, ".rds")) +saveRDS(diff_df, rds_path) +cat("Saved full diff frame to: ", rds_path, "\n", sep = "") + +# ---- HTML report --------------------------------------------------- + +.html_escape <- function(x) { + x <- gsub("&", "&", x, fixed = TRUE) + x <- gsub("<", "<", x, fixed = TRUE) + x <- gsub(">", ">", x, fixed = TRUE) + x +} + +.tbl_html <- function(df, empty_msg = "(none)") { + if (is.null(df) || nrow(df) == 0L) { + return(paste0("

", empty_msg, "

")) + } + cols <- names(df) + header <- paste0("", paste0("", .html_escape(cols), "", + collapse = ""), "") + cells <- apply(df, 1, function(row) { + tds <- vapply(seq_along(row), function(j) { + val <- row[[j]] + cls <- "" + if (cols[j] == "covr_delta" && suppressWarnings(!is.na(as.numeric(val)))) { + d <- as.numeric(val) + cls <- if (d > 0) " class='pos'" else if (d < 0) " class='neg'" else "" + } + paste0("", .html_escape(format(val)), "") + }, character(1)) + paste0("", paste0(tds, collapse = ""), "") + }) + paste0("", + "", header, "", + "", paste0(cells, collapse = ""), "", + "
") +} -if (!exists("out_diff")) { - out_diff <- file.path( - "dev", - paste0("covr_diff_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".rds") - ) +.matrix_html <- function(m, caption = "") { + if (is.null(m)) return("") + rn <- rownames(m); cn <- colnames(m) + hdr <- paste0("", .html_escape(caption), "", + paste0("", .html_escape(cn), "", collapse = ""), + "") + rows <- vapply(seq_len(nrow(m)), function(i) { + tds <- paste0("", m[i, ], "", collapse = "") + paste0("", .html_escape(rn[i]), "", + tds, "") + }, character(1)) + paste0("", hdr, paste0(rows, collapse = ""), + "
") } -saveRDS(diff_df, out_diff) -cat("Saved full diff frame to: ", out_diff, "\n", sep = "") -cat(" ", nrow(diff_df), " rows x ", ncol(diff_df), - " cols. Globals: diff_df, regressed_df, improved_df.\n", sep = "") + +# Small summary panel of counts +count_rows <- data.frame( + metric = c( + sprintf("Improved >= %.0f pp", thresh), + sprintf("Improved < %.0f pp", thresh), + "Unchanged", + sprintf("Regressed < %.0f pp", thresh), + sprintf("Regressed >= %.0f pp", thresh), + sprintf("Crossed UP over %d%%", THR), + sprintf("Crossed DOWN under %d%%", THR), + "Gained metric (NA -> #)", + "Lost metric (# -> NA)" + ), + n = c(counts["improved_big"], counts["improved_small"], + counts["unchanged"], + counts["regressed_small"], counts["regressed_big"], + counts["crossed_up"], counts["crossed_down"], + counts["new_only"], counts["lost_metric"]), + stringsAsFactors = FALSE +) + +html <- paste0( + "", + "val.pipeline covr diff -- ", .html_escape(run_tag), "", + "", + "

val.pipeline covr_coverage diff

", + "
", + "
Run tag: ", .html_escape(run_tag), "
", + "
Shared pkgs: ", length(shared), "
", + "
Old only: ", length(only_old), "
", + "
New only: ", length(only_new), "
", + "
Threshold: ", THR, "%
", + "
", + "

Delta summary

", + .tbl_html(count_rows), + "

Coverage-band shift (rows = old, cols = new)

", + .matrix_html(band_shift, caption = "old \\ new"), + if (!is.null(dec_tab)) + paste0("

Final decision shift (old -> new)

", + .matrix_html(dec_tab, caption = "old \\ new")) + else "", + "

Top 20 regressions (largest -delta)

", + .tbl_html(.round_disp(utils::head(regressed_df, 20))), + "

Top 20 improvements (largest +delta)

", + .tbl_html(.round_disp(utils::head(improved_df, 20))), + "

Top 20 UNLOCKERS -- crossed ", THR, "% upward, by rev-dep count

", + "

Packages that just qualified. Higher rev-dep count = larger ", + "downstream slice of the qualified set this pkg unlocks.

", + .tbl_html(.round_disp(utils::head(unlockers_df, 20)), + empty_msg = "No packages crossed the threshold upward."), + "

Top 20 BLOCKERS -- still below ", THR, "% after run, by rev-dep count

", + "

Packages that remain unqualified. Ranked by rev-dep count so the ", + "biggest downstream blockers surface first -- these are the highest-", + "value investigation targets.

", + .tbl_html(.round_disp(utils::head(blockers_df, 20)), + empty_msg = "No packages are below the threshold."), + "

Notes

", + "
    ", + "
  • Rev-dep counts sourced from reverse_dependencies on ", + "qual_assessments where available; falls back to computing from qm's ", + "Depends/Imports/LinkingTo columns.
    • ", + "
  • version_changed = TRUE flags rows where an upstream ", + "version bump between runs may account for the delta -- separate from ", + "any pipeline-side change.
    • ", + "
", + "" +) + +html_path <- file.path(out_dir, paste0("covr_diff_", run_tag, ".html")) +writeLines(html, html_path) +cat("Wrote HTML report to : ", html_path, "\n", sep = "") +cat("Globals: diff_df, regressed_df, improved_df, unlockers_df, blockers_df.\n") invisible(diff_df) From cafdf7e2d55ea829fd9de9c18da1fe5d8a199b1b Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Tue, 15 Sep 2026 08:42:13 -0700 Subject: [PATCH 09/10] dev/diff script: auto-detect qm key column (package/pkg/pkg_name) qual_metadata frames written by val_build() key on `pkg`, not `package` (that's qual_assessments's convention). The diff script hard-coded 'package' when subsetting qm for the decision-category diff, producing: Error: Can't subset columns that don't exist. Column `package` doesn't exist. Fix: new `.qm_key_col()` helper checks c('package', 'pkg', 'pkg_name') in order and picks the first hit. Applied at the qm merge site; the built decision-diff frame is normalized to 'package' internally so the downstream merge onto diff_df still keys correctly. Also drop a dead `names(counts) <- qm_src$package` line in the rev-dep qm-derivation fallback that likewise assumed 'package' and was never actually used (counts was unpopulated; dep_tbl is built independently from all_deps). Smoke tested with a qm frame keyed on 'pkg' + final_decision col: decision-shift table populates cleanly. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- dev/dev_diff_run_assessments.R | 49 +++++++++++++++++++++++++--------- 1 file changed, 36 insertions(+), 13 deletions(-) diff --git a/dev/dev_diff_run_assessments.R b/dev/dev_diff_run_assessments.R index b523812..d590c01 100644 --- a/dev/dev_diff_run_assessments.R +++ b/dev/dev_diff_run_assessments.R @@ -212,7 +212,6 @@ if (is.null(rd_map)) { unique(pieces[nzchar(pieces) & pieces != "R"]) } counts <- integer(nrow(qm_src)) - names(counts) <- qm_src$package all_deps <- lapply(seq_len(nrow(qm_src)), function(i) coalesce_deps(qm_src[i, , drop = FALSE])) dep_tbl <- table(unlist(all_deps)) @@ -359,22 +358,46 @@ cat("\n") # ---- Optional decision-category shift ------------------------------ +# qual_metadata keys on `pkg` (not `package` like qual_assessments does). +# Accept either; user-supplied frames from unrelated sources might use +# `pkg_name` too. First match wins. +.qm_key_col <- function(df) { + cands <- c("package", "pkg", "pkg_name") + hit <- intersect(cands, names(df)) + if (length(hit) == 0L) return(NA_character_) + hit[[1L]] +} + dec_tab <- NULL if (!is.null(old_qm_df) && !is.null(new_qm_df) && "final_decision" %in% names(old_qm_df) && "final_decision" %in% names(new_qm_df)) { - om <- old_qm_df[, c("package", "final_decision"), drop = FALSE] - nm <- new_qm_df[, c("package", "final_decision"), drop = FALSE] - names(om)[2] <- "decision_old" - names(nm)[2] <- "decision_new" - dec <- merge(om, nm, by = "package", all = FALSE) - dec <- dec[dec$package %in% shared, , drop = FALSE] - cat("== Decision-category shift (old -> new) ===============\n") - dec_tab <- table(dec$decision_old, dec$decision_new, - useNA = "ifany", dnn = c("old", "new")) - print(dec_tab) - cat("=======================================================\n\n") - diff_df <- merge(diff_df, dec, by = "package", all.x = TRUE) + old_key <- .qm_key_col(old_qm_df) + new_key <- .qm_key_col(new_qm_df) + if (is.na(old_key) || is.na(new_key)) { + cat("Warning: qm frames lack a recognizable key column ", + "(none of package/pkg/pkg_name found); skipping decision diff.\n", + sep = "") + } else { + om <- data.frame( + package = old_qm_df[[old_key]], + decision_old = old_qm_df$final_decision, + stringsAsFactors = FALSE + ) + nm <- data.frame( + package = new_qm_df[[new_key]], + decision_new = new_qm_df$final_decision, + stringsAsFactors = FALSE + ) + dec <- merge(om, nm, by = "package", all = FALSE) + dec <- dec[dec$package %in% shared, , drop = FALSE] + cat("== Decision-category shift (old -> new) ===============\n") + dec_tab <- table(dec$decision_old, dec$decision_new, + useNA = "ifany", dnn = c("old", "new")) + print(dec_tab) + cat("=======================================================\n\n") + diff_df <- merge(diff_df, dec, by = "package", all.x = TRUE) + } } # ---- Persist frame ------------------------------------------------- From b88d3cf973da9ca21281cfdc93f5546d46dcd5a2 Mon Sep 17 00:00:00 2001 From: aclark02-arcus Date: Tue, 15 Sep 2026 09:18:32 -0700 Subject: [PATCH 10/10] Add Context section to diff HTML report Bakes the covr-vs-pkgType mechanism write-up into the HTML report so it travels with the tables when shared with colleagues. Contents (styled as a highlighted callout box below the summary cards, above the delta tables): - Explicit statement that the ONLY pipeline-side change between the two runs is options(pkgType) flipping from 'source' to 'both' -- no metric defs, thresholds, decision rules, or {riskmetric} version changes. - Why covr doesn't care about the tarball: it instruments the install and runs the test suite in a subprocess, so target code is byte-identical either way. - Where the delta comes from: dependency install success. Comparison table of source vs both vs binary and their common failure modes. - Two amplifiers specific to val.pipeline + PPM: 1. available.packages() type filter narrows the offline cache. 2. Binary-only mirrors mean 'source' can render packages invisible even though they exist. - Why the number swings 20+ pp, not just a little. - Diagnostic tips for inspecting a specific regressor: read assess_record.rds's covr slot for 'no package called X' errors, grep val_pipeline.log for compilation failures. CSS: added a .context styleset (yellow callout, warm border, inner table with muted grid) so the write-up reads as 'meta / interpretation' rather than as another data table. Smoke-tested: HTML contains the section, all downstream tables still render. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- dev/dev_diff_run_assessments.R | 105 +++++++++++++++++++++++++++++++++ 1 file changed, 105 insertions(+) diff --git a/dev/dev_diff_run_assessments.R b/dev/dev_diff_run_assessments.R index d590c01..cb1560f 100644 --- a/dev/dev_diff_run_assessments.R +++ b/dev/dev_diff_run_assessments.R @@ -497,6 +497,15 @@ html <- paste0( ".summary .card{background:#f7f7f7;padding:8px 12px;border-radius:4px;", "font-size:13px;} .empty{color:#888;font-style:italic;}", "code{background:#f0f0f0;padding:1px 4px;border-radius:3px;}", + ".context{background:#fffbe6;border-left:4px solid #f0c419;", + "padding:12px 16px;margin-top:16px;border-radius:2px;font-size:14px;}", + ".context h3{margin-top:0;font-size:15px;} ", + ".context h4{font-size:14px;margin-bottom:4px;} ", + ".context table{font-size:13px;border-collapse:collapse;margin:6px 0;}", + ".context table th,.context table td{border:1px solid #e0d18a;", + "padding:3px 8px;text-align:left;background:#fff;}", + ".context ol,.context ul{margin:6px 0 6px 20px;}", + ".context li{margin:4px 0;}", "", "

val.pipeline covr_coverage diff

", "
", @@ -506,6 +515,102 @@ html <- paste0( "
New only: ", length(only_new), "
", "
Threshold: ", THR, "%
", "
", + + # ---- Context block: what changed + mechanism ----------------------- + "
", + "

Context: what changed between these two runs

", + "

The only pipeline-side change is options(pkgType):", + " it flipped from \"source\" in the old run to ", + "\"both\" in the new run. No metric definitions, ", + "no thresholds, no decision rules, no {riskmetric} ", + "version changes, no dep-graph logic changes. Every delta below ", + "reflects the covr_coverage number val.pipeline recorded for the ", + "same target package under those two session states.

", + + "

Why the number varies at all -- covr doesn't care about the tarball

", + "

covr::package_coverage() installs the target package ", + "with instrumentation, spawns a fresh R subprocess ", + "(R CMD BATCH --vanilla), runs the test suite, and reads ", + "back which lines the tests executed. The target's own code -- ", + ".R files, .c files, tests -- is byte-", + "identical whether the tarball was fetched as source or binary. The ", + "numerator and denominator of the coverage ratio are the same in ", + "both cases.

", + + "

Where the delta actually comes from: dependency install success

", + "

The variance lives in whether test-time dependencies install ", + "successfully. install.packages() respects ", + "getOption(\"pkgType\") when resolving deps:

", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "
pkgTypeBehaviorCommon failure mode
\"source\"Every dep compiled from sourceMissing system libs (libcurl-dev, ", + "libxml2-dev, libgdal-dev, gsl, ", + "...); PPM binary-only mirror gaps; longer/flakier installs
\"both\"Binary preferred, source fallbackVery reliable on PPM-configured Workbench (that's what PPM is for)", + "
\"binary\"Binary only, no fallbackFails hard on any pkg with no binary -- at least doesn't fail ", + "silently
", + + "

When a test-time dep fails to install, the affected test file ", + "typically fails to library()-load. testthat catches the ", + "load error and marks those test blocks as errored, so covr sees only ", + "the code exercised by tests that did run and the reported ", + "percentage drops. Crucially, covr doesn't fail. It reports the ", + "reduced number as if it were the truth. That's why the regression ", + "was silent until we ran a controlled A/B.

", + + "

Two amplifiers specific to val.pipeline + PPM

", + "
    ", + "
  1. available.packages() filtering. ", + "configure_riskmetric_offline_if_requested() builds an ", + "offline pkg cache using available.packages(type = getOption(\"pkgType\")). ", + "Under \"source\", binary-only entries in a PPM mirror ", + "drop out of the cache entirely -- riskmetric can't even see they ", + "exist, so downstream install probes for them fail before they ", + "start.
    2. ", + "
  2. PPM binary mirrors are the workbench norm. When R asks a ", + "binary-serving PPM URL for source of a pkg that only exists as a ", + "binary snapshot, it gets nothing. pkgType = \"both\" ", + "lets install.packages take the binary and move on; \"source\" ", + "treats the pkg as unavailable.
    3. ", + "
", + + "

Why the number varies so much, not just a little

", + "

Under \"source\", one broken dep can knock out ", + "several test files, which can knock out entire tested modules, ", + "easily dropping 30+ percentage points on a package with a ", + "mid-sized dep tree. Under \"both\", all the binaries ", + "flow through cleanly and the target's tests actually run. That's ", + "the mechanism behind the >20 pp swings you see in the regression ", + "and improvement lists below.

", + + "

Diagnostic tips when inspecting a specific regressor

", + "
    ", + "
  1. Open assessed/<pkg>_<ver>_assess_record.rds ", + "and look at the covr slot. If there are simpleError ", + "entries with messages like "there is no package called 'X'", ", + "that's the smoking gun: X failed to install as a dep and its test file ", + "bailed.
    2. ", + "
  2. Search val_pipeline.log for installation failed ", + "or non-zero exit status near the timestamp of the regressed ", + "package. Source-compile failures typically log ", + "ERROR: compilation failed for package 'X' before the pkg is ", + "silently marked unavailable.
    3. ", + "
  3. If a regressor is not a system-lib victim (deps install ", + "fine both ways) but still shows lower covr under \"both\", ", + "flag it -- something more interesting is happening than dep-install ", + "damage, and it's worth digging in.
    4. ", + "
", + "
", "

Delta summary

", .tbl_html(count_rows), "

Coverage-band shift (rows = old, cols = new)

",