diff --git a/data-raw/measure_signposting_rate.R b/data-raw/measure_signposting_rate.R index 51bc456..00492f7 100644 --- a/data-raw/measure_signposting_rate.R +++ b/data-raw/measure_signposting_rate.R @@ -1,8 +1,8 @@ # data-raw/measure_signposting_rate.R # # Phase R3 Task 19c: measures the harmonization-signposting suggestion rate -# under BOTH the R2 "coarse" (whole-result) gap check and the R3 "per-code" -# gap check now shipped in R/suggestions.R, over a realistic query battery: +# under THREE `.build_suggestions()` implementations, over a realistic query +# battery: # every summary_categories category # x a 3-year pre/post-2012 span (the wide-aggregate -> modern-leaf # format-boundary window; falls back to the widest span the corpus @@ -10,19 +10,37 @@ # .measure_year_span()) # x up to N_GOV sampled governments (seeded, deterministic) # -# This script MEASURES the coarse-vs-per-code delta; it does not decide -# whether that much added signposting "noise" is acceptable. That is -# Jared's ruling at Checkpoint R3 (see -# cog_pipeline/.superpowers/sdd/phase-r-task-19c-brief.md). +# The three arms, oldest to newest: +# - "coarse" (git ref b0df1ec, the merged R2 tip): a year counts as +# gapped only when the WHOLE category result has zero rows that year. +# - "selfcov" (git ref da72bf3, Task 19c's first per-code pass, since +# amended after review): per-code, but a component's gap could be +# satisfied by ANY component of the recipe INCLUDING ITSELF -- so a +# code whose only representation in a year was its own wide-era +# aggregate row satisfied its own coverage check. Flagged in review as +# not matching review-doc S: 0.3's literal criterion ("... has no rows +# ... but OTHER components do") and fixed in the next commit. +# - "percode" (live code): per-code, requiring a genuinely DIFFERENT +# sibling component to supply the covering evidence -- the shipped, +# corrected implementation. # -# The R2 "coarse" implementation no longer exists in R/suggestions.R (Task -# 19c replaced it in place with the per-code version), so this script pulls -# it VERBATIM from git history (default ref: b0df1ec, the merged tip of the -# R2 branch) and evaluates it in an isolated environment parented on the -# uscogdata namespace, so it still resolves unchanged helpers it depends on -# (.sql_lit_chr()) exactly as the live package does. This guarantees the -# "coarse" arm is the actual shipped R2 code, not a hand-reconstruction of -# it that could silently drift from what really shipped. +# This script MEASURES the deltas; it does not decide whether the added +# signposting "noise" going coarse -> percode is acceptable. That is +# Jared's ruling at Checkpoint R3 (see +# cog_pipeline/.superpowers/sdd/phase-r-task-19c-brief.md). The selfcov arm +# exists purely to answer a narrower, mechanical question for that ruling: +# how much of the coarse -> percode delta was ever attributable to the +# self-coverage bug (selfcov -> percode), as opposed to genuine +# other-component coverage (coarse -> percode directly)? +# +# All three arms no longer coexist in R/suggestions.R (each superseded the +# last in place), so this script pulls each VERBATIM from git history and +# evaluates it in an isolated environment parented on the uscogdata +# namespace, so each still resolves the unchanged sibling helpers it +# depends on (.sql_lit_chr()) exactly as the live package did at that +# commit. This guarantees every non-live arm is the actual shipped code at +# that point, not a hand-reconstruction that could silently drift from what +# really shipped. # # Usage (from the uscogdata package root; a git checkout, not a tarball): # Rscript data-raw/measure_signposting_rate.R @@ -33,13 +51,12 @@ # res <- measure_signposting_rate(corpus_url = "") # res$summary; res$by_category -#' Pull the R2-era (coarse, whole-result) `.build_suggestions()` verbatim -#' from git history and evaluate it in an isolated environment parented on -#' the uscogdata namespace, so it resolves unchanged sibling helpers -#' (`.sql_lit_chr()`) the same way the live package does. +#' Pull a historical `.build_suggestions()` (and whatever helpers it uses) +#' verbatim from git history and evaluate it in an isolated environment +#' parented on the uscogdata namespace, so it resolves unchanged sibling +#' helpers (`.sql_lit_chr()`) the same way the live package does. #' @noRd -.measure_load_coarse_impl <- function(git_ref = "b0df1ec", - git_path = "R/suggestions.R") { +.measure_load_git_impl <- function(git_ref, git_path = "R/suggestions.R") { old_src <- tryCatch( system2("git", c("show", sprintf("%s:%s", git_ref, git_path)), stdout = TRUE, stderr = TRUE), @@ -49,7 +66,7 @@ if (is.null(old_src) || (!is.null(status) && status != 0L) || !any(grepl("^\\.build_suggestions", old_src))) { stop( - "Could not retrieve the R2 .build_suggestions() implementation from ", + "Could not retrieve the .build_suggestions() implementation from ", "git ref '", git_ref, "' at '", git_path, "'. Run this script from ", "inside the uscogdata git checkout (not a tarball/installed copy).", call. = FALSE @@ -58,10 +75,9 @@ env <- new.env(parent = asNamespace("uscogdata")) # eval(parse()) here is safe: `old_src` is not external/untrusted input -- # it is this repo's OWN historical R/suggestions.R, fetched via `git show` - # from a fixed, hardcoded internal commit ref (default b0df1ec, the merged - # R2 tip; overridable only by a caller who already has R-level code - # execution in this dev-only measurement script). No network or - # user-supplied data reaches this call. + # from a fixed, hardcoded internal commit ref (overridable only by a + # caller who already has R-level code execution in this dev-only + # measurement script). No network or user-supplied data reaches this call. eval(parse(text = old_src), envir = env) stopifnot(is.function(env$.build_suggestions)) env @@ -129,12 +145,12 @@ sort(sample(pool, n)) } -#' Run one (category, government) query through both the coarse (git ref -#' `coarse_env`) and current per-code `.build_suggestions()` and return a -#' one-row summary of what each one fired. +#' Run one (category, government) query through the coarse (`coarse_env`), +#' self-coverage-allowed (`selfcov_env`), and live per-code +#' `.build_suggestions()` and return a one-row summary of what each fired. #' @noRd -.measure_one_query <- function(con, coarse_env, category, category_type, - govid, years) { +.measure_one_query <- function(con, coarse_env, selfcov_env, category, + category_type, govid, years) { view <- if (identical(category_type, "revenue")) { "revenue_annotated_harmonized" } else { @@ -151,6 +167,9 @@ coarse_sugg <- coarse_env$.build_suggestions( con, govid, years, category, result, "harmonized" ) + selfcov_sugg <- selfcov_env$.build_suggestions( + con, govid, years, category, "harmonized" + ) percode_sugg <- .build_suggestions(con, govid, years, category, "harmonized") data.frame( @@ -159,8 +178,10 @@ canonical_govid = govid, n_result_rows = nrow(result), n_coarse = length(coarse_sugg), + n_selfcov = length(selfcov_sugg), n_percode = length(percode_sugg), fired_coarse = length(coarse_sugg) > 0L, + fired_selfcov = length(selfcov_sugg) > 0L, fired_percode = length(percode_sugg) > 0L, stringsAsFactors = FALSE ) @@ -183,7 +204,10 @@ #' with `post_years_n` years starting at `boundary_year`. Falls back to #' the corpus's widest actually-available span when this can't be filled #' (see `.measure_year_span()`). -#' @param git_ref Git ref to pull the R2 coarse `.build_suggestions()` from. +#' @param coarse_ref Git ref to pull the R2 coarse `.build_suggestions()` +#' from. +#' @param selfcov_ref Git ref to pull Task 19c's first, self-coverage- +#' allowed per-code `.build_suggestions()` from (amended after review). #' @param verbose Print progress/notes as the battery runs. #' @return Invisibly, a list with `corpus_url`, `years`, `span_note`, #' `full_design`, `govids`, `seed`, `detail` (one row per query), @@ -195,7 +219,8 @@ measure_signposting_rate <- function(corpus_url = Sys.getenv("USCOGDATA_URL", un boundary_year = 2012L, pre_years_n = 3L, post_years_n = 3L, - git_ref = "b0df1ec", + coarse_ref = "b0df1ec", + selfcov_ref = "da72bf3", verbose = TRUE) { pkgload::load_all(".", quiet = TRUE) @@ -218,7 +243,8 @@ measure_signposting_rate <- function(corpus_url = Sys.getenv("USCOGDATA_URL", un }, add = TRUE) con <- cog_open() - coarse_env <- .measure_load_coarse_impl(git_ref = git_ref) + coarse_env <- .measure_load_git_impl(git_ref = coarse_ref) + selfcov_env <- .measure_load_git_impl(git_ref = selfcov_ref) span <- .measure_year_span(con, boundary_year, pre_years_n, post_years_n) years <- span$years @@ -249,7 +275,7 @@ measure_signposting_rate <- function(corpus_url = Sys.getenv("USCOGDATA_URL", un for (gv in govids) { k <- k + 1L rows[[k]] <- .measure_one_query( - con, coarse_env, + con, coarse_env, selfcov_env, category = categories$category[ci], category_type = categories$category_type[ci], govid = gv, years = years @@ -257,28 +283,41 @@ measure_signposting_rate <- function(corpus_url = Sys.getenv("USCOGDATA_URL", un } } detail <- do.call(rbind, rows) + # percode only ever fires where selfcov also fires (percode is a strict + # narrowing of selfcov: same gap detection, plus the self-coverage path + # removed) -- this is what makes the decomposition below exact rather + # than approximate. Checked, not assumed. + stopifnot(all(detail$fired_percode <= detail$fired_selfcov)) + detail$fired_selfcov_only <- detail$fired_selfcov & !detail$fired_percode by_category <- dplyr::summarise( dplyr::group_by(detail, category, category_type), n_queries = dplyr::n(), coarse_rate = mean(fired_coarse), + selfcov_rate = mean(fired_selfcov), percode_rate = mean(fired_percode), - delta_pp = (mean(fired_percode) - mean(fired_coarse)) * 100, + original_delta_pp = (mean(fired_selfcov) - mean(fired_coarse)) * 100, + corrected_delta_pp = (mean(fired_percode) - mean(fired_coarse)) * 100, + selfcov_share_pp = mean(fired_selfcov_only) * 100, .groups = "drop" ) - by_category <- dplyr::arrange(by_category, dplyr::desc(delta_pp)) + by_category <- dplyr::arrange(by_category, dplyr::desc(corrected_delta_pp)) summary_overall <- data.frame( n_queries = nrow(detail), n_categories = nrow(categories), n_governments = length(govids), coarse_fired = sum(detail$fired_coarse), + selfcov_fired = sum(detail$fired_selfcov), percode_fired = sum(detail$fired_percode), coarse_rate = mean(detail$fired_coarse), + selfcov_rate = mean(detail$fired_selfcov), percode_rate = mean(detail$fired_percode) ) - summary_overall$delta_pp <- (summary_overall$percode_rate - summary_overall$coarse_rate) * 100 - summary_overall$relative_increase <- if (summary_overall$coarse_rate > 0) { + summary_overall$original_delta_pp <- (summary_overall$selfcov_rate - summary_overall$coarse_rate) * 100 + summary_overall$corrected_delta_pp <- (summary_overall$percode_rate - summary_overall$coarse_rate) * 100 + summary_overall$selfcov_share_pp <- mean(detail$fired_selfcov_only) * 100 + summary_overall$relative_increase <- if (summary_overall$coarse_rate > 0) { summary_overall$percode_rate / summary_overall$coarse_rate - 1 } else { NA_real_ @@ -286,10 +325,16 @@ measure_signposting_rate <- function(corpus_url = Sys.getenv("USCOGDATA_URL", un if (verbose) { message(sprintf( - "Coarse rate: %.4f (%d/%d) | Per-code rate: %.4f (%d/%d) | Delta: %+.2f pp", + "Coarse rate: %.4f (%d/%d) | Self-cov-allowed rate: %.4f (%d/%d) | Corrected per-code rate: %.4f (%d/%d)", summary_overall$coarse_rate, summary_overall$coarse_fired, summary_overall$n_queries, - summary_overall$percode_rate, summary_overall$percode_fired, summary_overall$n_queries, - summary_overall$delta_pp + summary_overall$selfcov_rate, summary_overall$selfcov_fired, summary_overall$n_queries, + summary_overall$percode_rate, summary_overall$percode_fired, summary_overall$n_queries + )) + message(sprintf( + "Original delta (selfcov - coarse): %+.2f pp | Corrected delta (percode - coarse): %+.2f pp | Self-coverage share of original delta: %.2f pp (%d/%d queries fired ONLY via self-coverage)", + summary_overall$original_delta_pp, summary_overall$corrected_delta_pp, + summary_overall$selfcov_share_pp, + sum(detail$fired_selfcov_only), summary_overall$n_queries )) } @@ -316,9 +361,9 @@ if (identical(environment(), globalenv()) && sys.nframe() == 0L) { cat(res$span_note, "\n") cat("Governments sampled:", length(res$govids), "\n\n") - cat("==== Overall summary ====\n") + cat("==== Overall summary (coarse / self-coverage-allowed / corrected per-code) ====\n") print(res$summary) - cat("\n==== By category (sorted by delta, descending) ====\n") + cat("\n==== By category (sorted by corrected delta, descending) ====\n") print(as.data.frame(res$by_category), row.names = FALSE) }