# data-raw/measure_signposting_rate.R
#
# Phase R3 Task 19c: measures the harmonization-signposting suggestion rate
# 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
#       actually supports if it can't fill a full 3+3 design -- see
#       .measure_year_span())
#     x up to N_GOV sampled governments (seeded, deterministic)
#
# 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.
#
# 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
#   USCOGDATA_URL=<staged-corpus-url> Rscript data-raw/measure_signposting_rate.R
#
# Or from R:
#   source("data-raw/measure_signposting_rate.R")
#   res <- measure_signposting_rate(corpus_url = "<url>")
#   res$summary; res$by_category

#' 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_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),
    error = function(e) NULL
  )
  status <- attr(old_src, "status")
  if (is.null(old_src) || (!is.null(status) && status != 0L) ||
      !any(grepl("^\\.build_suggestions", old_src))) {
    stop(
      "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
    )
  }
  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 (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
}

#' Resolve the query battery's year span: a `pre_n`-year window immediately
#' before `boundary_year` unioned with a `post_n`-year window starting at
#' `boundary_year` (default 3+3 around 2012, the wide-aggregate ->
#' modern-leaf format boundary). Falls back to every distinct year the
#' corpus actually has in `long` when it can't fill that full design, and
#' says so explicitly in `$note` rather than silently padding or
#' fabricating years.
#' @noRd
.measure_year_span <- function(con, boundary_year = 2012L,
                                pre_n = 3L, post_n = 3L) {
  available <- sort(as.integer(
    DBI::dbGetQuery(con, "SELECT DISTINCT year FROM long")$year
  ))
  desired_pre  <- (boundary_year - pre_n):(boundary_year - 1L)
  desired_post <- boundary_year:(boundary_year + post_n - 1L)
  actual_pre   <- intersect(desired_pre, available)
  actual_post  <- intersect(desired_post, available)
  full_design  <- length(actual_pre) == pre_n && length(actual_post) == post_n

  if (full_design) {
    years <- sort(c(actual_pre, actual_post))
    note <- sprintf(
      "Full %d-year pre/%d-year post-%d design available -- using years: %s.",
      pre_n, post_n, boundary_year, paste(years, collapse = ", ")
    )
  } else {
    years <- available
    note <- sprintf(paste(
      "Corpus does NOT support a full %d-year pre/%d-year post-%d span",
      "(desired pre-window %s -> only %s present; desired post-window %s",
      "-> only %s present). Falling back to the WIDEST span this corpus",
      "supports: all %d distinct year(s) actually in `long`: %s.",
      "This is NOT a 3-year pre/post-%d design -- reported as measured,",
      "not padded or fabricated."
    ),
    pre_n, post_n, boundary_year,
    paste(desired_pre, collapse = ","),
    if (length(actual_pre)) paste(actual_pre, collapse = ",") else "none",
    paste(desired_post, collapse = ","),
    if (length(actual_post)) paste(actual_post, collapse = ",") else "none",
    length(available), paste(available, collapse = ", "),
    boundary_year)
  }
  list(years = years, full_design = full_design, note = note,
       available = available)
}

#' Deterministically sample up to `n` distinct governments that actually
#' report *something* in the battery's year span (querying a government
#' with zero presence in every measured year isn't a realistic query).
#' @noRd
.measure_sample_govids <- function(con, years, n = 20L, seed = 19L) {
  pool <- DBI::dbGetQuery(con, sprintf(
    "SELECT DISTINCT canonical_govid FROM long WHERE year IN (%s)
     ORDER BY canonical_govid",
    paste(years, collapse = ",")
  ))$canonical_govid
  if (length(pool) <= n) return(sort(pool))
  set.seed(seed)
  sort(sample(pool, n))
}

#' 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, selfcov_env, category,
                                category_type, govid, years) {
  view        <- if (identical(category_type, "revenue")) {
    "revenue_annotated_harmonized"
  } else {
    "spending_annotated_harmonized"
  }
  subtype_col <- if (identical(category_type, "revenue")) {
    "revenue_subtype"
  } else {
    "spend_subtype"
  }
  sql    <- .build_verb_sql(view, subtype_col, govid, years, category)
  result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))

  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(
    category        = category,
    category_type   = category_type,
    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
  )
}

#' Measure the coarse-vs-per-code signposting suggestion rate over a
#' realistic query battery (every category x a pre/post-boundary_year span
#' x up to n_gov sampled governments).
#'
#' @param corpus_url Corpus to measure against. Defaults to
#'   `Sys.getenv("USCOGDATA_URL")`; if that's unset, falls back to the
#'   bundled v5 fixture (so the script runs out of the box). Re-run with
#'   `USCOGDATA_URL` pointed at the staged/full corpus later.
#' @param n_gov Governments to sample (deterministically). "Up to" -- if
#'   the corpus has fewer distinct governments in the measured years than
#'   this, every one of them is used.
#' @param seed Sampling seed (fixed for reproducibility).
#' @param boundary_year,pre_years_n,post_years_n Define the desired query
#'   span: `pre_years_n` years immediately before `boundary_year`, unioned
#'   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 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),
#'   `by_category`, and `summary`.
#' @noRd
measure_signposting_rate <- function(corpus_url = Sys.getenv("USCOGDATA_URL", unset = NA),
                                      n_gov = 20L,
                                      seed = 19L,
                                      boundary_year = 2012L,
                                      pre_years_n = 3L,
                                      post_years_n = 3L,
                                      coarse_ref = "b0df1ec",
                                      selfcov_ref = "da72bf3",
                                      verbose = TRUE) {
  pkgload::load_all(".", quiet = TRUE)

  if (is.na(corpus_url) || !nzchar(corpus_url)) {
    corpus_url <- paste0(
      system.file("extdata/fixture_corpus", package = "uscogdata"), "/"
    )
    if (verbose) {
      message("No USCOGDATA_URL set; defaulting to the bundled v5 fixture: ",
              corpus_url)
    }
  }

  old_url <- Sys.getenv("USCOGDATA_URL", unset = NA)
  cog_close()
  Sys.setenv(USCOGDATA_URL = corpus_url)
  on.exit({
    cog_close()
    if (is.na(old_url)) Sys.unsetenv("USCOGDATA_URL") else Sys.setenv(USCOGDATA_URL = old_url)
  }, add = TRUE)

  con <- cog_open()
  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
  if (verbose) message(span$note)

  govids <- .measure_sample_govids(con, years, n = n_gov, seed = seed)
  if (verbose) {
    message(sprintf("Sampled %d government(s) (seed = %d) from %d present in years %s.",
                     length(govids), seed,
                     length(DBI::dbGetQuery(con, sprintf(
                       "SELECT DISTINCT canonical_govid FROM long WHERE year IN (%s)",
                       paste(years, collapse = ",")))$canonical_govid),
                     paste(years, collapse = ", ")))
  }

  categories <- DBI::dbGetQuery(con,
    "SELECT DISTINCT category, category_type FROM summary_categories
     WHERE category IS NOT NULL ORDER BY category_type, category")
  if (verbose) {
    message(sprintf("Battery: %d categories x %d governments = %d queries.",
                     nrow(categories), length(govids),
                     nrow(categories) * length(govids)))
  }

  rows <- vector("list", nrow(categories) * length(govids))
  k <- 0L
  for (ci in seq_len(nrow(categories))) {
    for (gv in govids) {
      k <- k + 1L
      rows[[k]] <- .measure_one_query(
        con, coarse_env, selfcov_env,
        category = categories$category[ci],
        category_type = categories$category_type[ci],
        govid = gv, years = years
      )
    }
  }
  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),
    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(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$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_
  }

  if (verbose) {
    message(sprintf(
      "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$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
    ))
  }

  invisible(list(
    corpus_url   = corpus_url,
    years        = years,
    span_note    = span$note,
    full_design  = span$full_design,
    govids       = govids,
    seed         = seed,
    n_categories = nrow(categories),
    detail       = detail,
    by_category  = by_category,
    summary      = summary_overall
  ))
}

if (identical(environment(), globalenv()) && sys.nframe() == 0L) {
  res <- measure_signposting_rate()
  cat("\n==== Query battery ====\n")
  cat("Corpus:", res$corpus_url, "\n")
  cat("Years:", paste(res$years, collapse = ", "), "\n")
  cat("Full 3-year pre/post-2012 design achieved:", res$full_design, "\n")
  cat(res$span_note, "\n")
  cat("Governments sampled:", length(res$govids), "\n\n")

  cat("==== Overall summary (coarse / self-coverage-allowed / corrected per-code) ====\n")
  print(res$summary)

  cat("\n==== By category (sorted by corrected delta, descending) ====\n")
  print(as.data.frame(res$by_category), row.names = FALSE)
}