# R/complete.R # # `complete = TRUE` on the money verbs. Fills the requested grid so that a # cell the corpus does not carry still appears, labelled with WHY it is # missing. # # The corpus stopped storing the wide era's explicit zeros # (cog_pipeline#64, series break SB194), which made absence ambiguous: # # <= FY2011 dense_source absent => Census published $0 (census_zero) # >= FY2012 sparse_source absent => not reported, unknown (not_reported) # # Before sparsification a wide-era query whose cells were all $0 came back as # explicit $0 rows; afterwards it came back empty, with nothing to say which # of the two meanings applied. This restores that -- and improves on it, # because the pre-sparsification corpus could not distinguish the two either. # # `census_zero` fills carry `amt_nominal = 0`; `not_reported` fills carry NA. # That difference is the entire point: writing 0 into a modern absence would # invent data, which is the error the representation contract exists to stop. #' @noRd .abort_complete_unsupported <- function(reason, alternative) { cli::cli_abort(c( "{.code complete = TRUE} is not supported for this query.", x = reason, i = alternative ), class = "uscogdata_complete_unsupported") } #' @noRd .require_representation <- function(con, manifest) { needed <- c("representation.parquet", "code_set.parquet") missing <- needed[!vapply(needed, function(f) .corpus_has_table(manifest, f), logical(1))] if (length(missing) == 0L) return(invisible(TRUE)) cli::cli_abort(c( "This corpus does not publish the representation contract.", x = "Missing: {.file {missing}}.", i = "{.code complete = TRUE} needs those tables to know whether an absent cell means Census published $0 or means the government did not report.", i = "They ship with corpora published from 2026-07-29 onward; re-point {.envvar USCOGDATA_URL} at a current corpus, or omit {.code complete}." ), class = "uscogdata_representation_unavailable") } #' The cells a government-year COULD carry: every code in force for that #' government's own type, mapped through `summary_categories`, restricted to #' the calling verb's flow prefixes and (when given) its category filter. #' #' Scoped by `govs_type` deliberately. Filling against the union of all types #' would invent cells that the government can never report -- a county row for #' "state IG transfer to school districts" -- and those inventions would then #' be indistinguishable from real census zeros. #' #' `NOT cs.is_aggregate` mirrors `spending_long` / `revenue_long`, which drop #' aggregate rows. Without it the grid would offer cells the verb structurally #' never returns, so every one of them would fill as a phantom $0. #' @noRd .completion_grid_sql <- function(subtype_col, govid, years, category, flow_prefixes) { category_pred <- if (is.null(category)) { "" } else { sprintf("AND c.category IN (%s)", .sql_lit_chr(category)) } sprintf( "SELECT DISTINCT cs.year, x.canonical_govid, x.gov_name, c.%1$s AS subtype_value, c.category, r.absence_means FROM code_set cs JOIN canonical_fips_xwalk x ON x.govs_type = cs.type JOIN summary_categories c ON c.item_code = cs.item_code JOIN representation r ON r.year = cs.year WHERE x.canonical_govid IN (%2$s) AND cs.year IN (%3$s) AND NOT cs.is_aggregate AND LEFT(cs.item_code, 1) IN (%4$s) AND c.category IS NOT NULL AND c.%1$s IS NOT NULL %5$s", subtype_col, .sql_lit_chr(govid), paste(as.integer(years), collapse = ","), .sql_lit_chr(flow_prefixes), category_pred ) } #' Fill `result` out to the full grid, stamping `value_source` on every row. #' #' Returns the completed tibble with a `.completion` attribute carrying the #' provenance block. Reported rows are passed through untouched -- filling #' must never alter or drop what the corpus actually published. #' @noRd .complete_result <- function(result, con, subtype_col, govid, years, category, flow_prefixes) { grid <- tibble::as_tibble(DBI::dbGetQuery( con, .completion_grid_sql(subtype_col, govid, years, category, flow_prefixes) )) result$value_source <- rep("reported", nrow(result)) if (nrow(grid) == 0L) { attr(result, ".completion") <- list( applied = TRUE, rows_filled = 0L, absence_means = list() ) return(result) } names(grid)[names(grid) == "subtype_value"] <- subtype_col key <- function(d) { paste(d$year, d$canonical_govid, d[[subtype_col]], d$category, sep = "\r") } missing <- grid[!key(grid) %in% key(result), , drop = FALSE] if (nrow(missing) > 0L) { filled <- tibble::tibble( year = as.integer(missing$year), canonical_govid = as.character(missing$canonical_govid), gov_name = as.character(missing$gov_name), category = as.character(missing$category), # census_zero is a value Census published; not_reported is unknown and # must stay NA. Collapsing the two to 0 is the defect, not the fill. amt_nominal = ifelse(missing$absence_means == "census_zero", 0, NA_real_), codes_included = NA_character_, aggregate_fallback = NA, value_source = as.character(missing$absence_means) ) filled[[subtype_col]] <- as.character(missing[[subtype_col]]) if ("notes" %in% names(result)) filled$notes <- NA_character_ result <- dplyr::bind_rows(result, filled) result <- result[order(result$year, result$canonical_govid, result[[subtype_col]], result$category), , drop = FALSE] } rules <- unique(grid[, c("year", "absence_means")]) attr(result, ".completion") <- list( applied = TRUE, rows_filled = nrow(missing), absence_means = stats::setNames( as.list(as.character(rules$absence_means)), as.character(rules$year) ) ) result }