|
| 1 | +# --- Value Reconciliation --- |
| 2 | +# The backbone of a manuscript audit: enumerate every number the document |
| 3 | +# states, build a corpus of every number the code actually produced, and |
| 4 | +# account for each one. Completeness at the data level, not the reading |
| 5 | +# level -- an agent can misread a value while "reading carefully", but it |
| 6 | +# cannot skip a row of a registry it is gated on. |
| 7 | + |
| 8 | +# Normalize scientific-notation typography so "1.5 x 10^-3", "2.1 × 10^(−4)", |
| 9 | +# and "3e-2" all tokenize identically. Unicode minus is folded to ASCII. |
| 10 | +normalize_number_text <- function(line) { |
| 11 | + line <- gsub("\u2212", "-", line) |
| 12 | + gsub("\\s*[x\u00d7\u22c5\u00b7]\\s*10\\s*\\^?\\s*[({\\[]?\\s*([-+]?\\d+)(?:\\s*[)}\\]])?", |
| 13 | + "e\\1", line, perl = TRUE) |
| 14 | +} |
| 15 | + |
| 16 | +# Tokenize the numeric values in one line. Returns a data.frame with one row |
| 17 | +# per token: raw text, numeric value, displayed precision (as a ulp), and |
| 18 | +# flags for thresholds ("< .001") and percents. |
| 19 | +extract_numbers_from_line <- function(line) { |
| 20 | + empty <- data.frame(raw = character(0), value = numeric(0), ulp = numeric(0), |
| 21 | + is_threshold = logical(0), threshold_dir = character(0), |
| 22 | + is_percent = logical(0), stringsAsFactors = FALSE) |
| 23 | + norm <- normalize_number_text(line) |
| 24 | + pattern <- paste0( |
| 25 | + "(?<![A-Za-z0-9_.])", # not inside a word/identifier/decimal |
| 26 | + "([<>]\\s*)?", # optional threshold marker |
| 27 | + "(-?(?:\\d{1,3}(?:,\\d{3})+(?:\\.\\d+)?|\\d+\\.\\d+|\\.\\d+|\\d+))", |
| 28 | + "([eE][-+]?\\d+)?", # optional exponent |
| 29 | + "(\\s?%)?", # optional percent |
| 30 | + "(?![A-Za-z0-9_])" # not running into a word |
| 31 | + ) |
| 32 | + m <- gregexpr(pattern, norm, perl = TRUE) |
| 33 | + if (m[[1]][1] == -1) return(empty) |
| 34 | + |
| 35 | + toks <- regmatches(norm, m)[[1]] |
| 36 | + out <- lapply(toks, function(tok) { |
| 37 | + raw <- trimws(tok) |
| 38 | + dir <- if (grepl("^<", raw)) "<" else if (grepl("^>", raw)) ">" else "" |
| 39 | + is_pct <- grepl("%$", raw) |
| 40 | + core <- gsub("^[<>]\\s*|\\s?%$", "", raw) |
| 41 | + core <- gsub(",", "", core) |
| 42 | + |
| 43 | + mant <- sub("[eE].*$", "", core) |
| 44 | + exp_part <- if (grepl("[eE]", core)) { |
| 45 | + as.integer(sub("^.*[eE]", "", core)) |
| 46 | + } else 0L |
| 47 | + n_dec <- if (grepl("\\.", mant)) nchar(sub("^-?\\d*\\.", "", mant)) else 0L |
| 48 | + |
| 49 | + value <- suppressWarnings(as.numeric(core)) |
| 50 | + if (is.na(value)) return(NULL) |
| 51 | + data.frame(raw = raw, value = value, |
| 52 | + ulp = 10^(exp_part - n_dec), |
| 53 | + is_threshold = nzchar(dir), threshold_dir = dir, |
| 54 | + is_percent = is_pct, stringsAsFactors = FALSE) |
| 55 | + }) |
| 56 | + out <- out[!vapply(out, is.null, logical(1))] |
| 57 | + if (length(out) == 0) return(empty) |
| 58 | + do.call(rbind, out) |
| 59 | +} |
| 60 | + |
| 61 | +# Extract all numbers from a character vector, with line numbers and context. |
| 62 | +extract_numbers_impl <- function(lines, label = "text") { |
| 63 | + res <- lapply(seq_along(lines), function(i) { |
| 64 | + d <- extract_numbers_from_line(lines[i]) |
| 65 | + if (nrow(d) == 0) return(NULL) |
| 66 | + d$line <- i |
| 67 | + ctx <- trimws(lines[i]) |
| 68 | + if (nchar(ctx) > 160) ctx <- paste0(substr(ctx, 1, 157), "...") |
| 69 | + d$context <- ctx |
| 70 | + d |
| 71 | + }) |
| 72 | + res <- res[!vapply(res, is.null, logical(1))] |
| 73 | + if (length(res) == 0) { |
| 74 | + return(data.frame(raw = character(0), value = numeric(0), ulp = numeric(0), |
| 75 | + is_threshold = logical(0), threshold_dir = character(0), |
| 76 | + is_percent = logical(0), line = integer(0), |
| 77 | + context = character(0), source = character(0), |
| 78 | + stringsAsFactors = FALSE)) |
| 79 | + } |
| 80 | + out <- do.call(rbind, res) |
| 81 | + out$source <- label |
| 82 | + out |
| 83 | +} |
| 84 | + |
| 85 | +# Read any file as text lines, routing manuscripts through the structured |
| 86 | +# extractor so table cells stay separated. |
| 87 | +read_as_text_lines <- function(path) { |
| 88 | + ext <- tolower(tools::file_ext(path)) |
| 89 | + if (ext %in% c("docx", "pdf")) extract_manuscript_text(path) |
| 90 | + else readLines(path, warn = FALSE) |
| 91 | +} |
| 92 | + |
| 93 | +# Does any corpus value match this document value at its displayed precision? |
| 94 | +value_matches_corpus <- function(value, ulp, corpus_values) { |
| 95 | + tol <- ulp / 2 * (1 + 1e-9) + 1e-12 |
| 96 | + any(abs(corpus_values - value) <= tol) |
| 97 | +} |
| 98 | + |
| 99 | +#' Reconcile every number in a document against source outputs |
| 100 | +#' |
| 101 | +#' Extracts every numeric token from a manuscript (or supplement) and checks |
| 102 | +#' each against the corpus of numbers found in the given source files (logs, |
| 103 | +#' generated tables, script output, CSVs). Matching respects the document's |
| 104 | +#' displayed precision: a document value of `5038.5` matches a source value |
| 105 | +#' of `5038.46`, and `0.967` matches `0.9668`. Thresholds like `< .001` are |
| 106 | +#' satisfied by any smaller source value; percents are also checked against |
| 107 | +#' their proportion form (flagged as scaled). Years (1900-2100, no decimals) |
| 108 | +#' are skipped by default. |
| 109 | +#' |
| 110 | +#' The full per-value registry is assigned to `values_registry` in the global |
| 111 | +#' environment so an audit can be gated on every row being accounted for. |
| 112 | +#' |
| 113 | +#' @param document Path to the manuscript (.docx, .pdf, or text; .docx tables |
| 114 | +#' are extracted cell-separated). |
| 115 | +#' @param sources Character vector of files whose numbers form the corpus. |
| 116 | +#' @param ignore_years Skip 4-digit integers in 1900-2100. Default TRUE. |
| 117 | +#' @param max_unmatched_shown Cap on unmatched values printed in the summary |
| 118 | +#' (the registry always holds all of them). Default 100. |
| 119 | +#' @return The summary report as a character string (invisibly); the |
| 120 | +#' `values_registry` data.frame is assigned to the global environment. |
| 121 | +#' @export |
| 122 | +reconcile_values <- function(document, sources, ignore_years = TRUE, |
| 123 | + max_unmatched_shown = 100L) { |
| 124 | + document <- path.expand(document) |
| 125 | + if (!file.exists(document)) stop("Document not found: ", document, call. = FALSE) |
| 126 | + sources <- path.expand(sources) |
| 127 | + missing_src <- sources[!file.exists(sources)] |
| 128 | + if (length(missing_src) > 0) { |
| 129 | + stop("Source file(s) not found: ", paste(missing_src, collapse = ", "), call. = FALSE) |
| 130 | + } |
| 131 | + |
| 132 | + doc_nums <- extract_numbers_impl(read_as_text_lines(document), basename(document)) |
| 133 | + |
| 134 | + corpus <- numeric(0) |
| 135 | + for (s in sources) { |
| 136 | + sn <- extract_numbers_impl(read_as_text_lines(s), basename(s)) |
| 137 | + corpus <- c(corpus, sn$value, sn$value[sn$is_percent] / 100) |
| 138 | + } |
| 139 | + corpus <- unique(corpus) |
| 140 | + |
| 141 | + if (nrow(doc_nums) == 0) { |
| 142 | + return(invisible("No numeric values found in the document.")) |
| 143 | + } |
| 144 | + |
| 145 | + status <- character(nrow(doc_nums)) |
| 146 | + for (i in seq_len(nrow(doc_nums))) { |
| 147 | + v <- doc_nums$value[i] |
| 148 | + u <- doc_nums$ulp[i] |
| 149 | + if (ignore_years && !doc_nums$is_percent[i] && !doc_nums$is_threshold[i] && |
| 150 | + u == 1 && v >= 1900 && v <= 2100 && v == floor(v)) { |
| 151 | + status[i] <- "year_skipped" |
| 152 | + } else if (doc_nums$is_threshold[i]) { |
| 153 | + ok <- if (doc_nums$threshold_dir[i] == "<") any(corpus < v + 1e-12) |
| 154 | + else any(corpus > v - 1e-12) |
| 155 | + status[i] <- if (ok) "threshold_ok" else "unmatched" |
| 156 | + } else if (value_matches_corpus(v, u, corpus)) { |
| 157 | + status[i] <- "matched" |
| 158 | + } else if (doc_nums$is_percent[i] && |
| 159 | + value_matches_corpus(v / 100, u / 100, corpus)) { |
| 160 | + status[i] <- "matched_scaled" |
| 161 | + } else { |
| 162 | + status[i] <- "unmatched" |
| 163 | + } |
| 164 | + } |
| 165 | + |
| 166 | + registry <- data.frame( |
| 167 | + value_id = seq_len(nrow(doc_nums)), |
| 168 | + line = doc_nums$line, |
| 169 | + raw = doc_nums$raw, |
| 170 | + value = doc_nums$value, |
| 171 | + status = status, |
| 172 | + context = doc_nums$context, |
| 173 | + adjudicated = FALSE, |
| 174 | + note = "", |
| 175 | + stringsAsFactors = FALSE |
| 176 | + ) |
| 177 | + assign("values_registry", registry, envir = .GlobalEnv) |
| 178 | + |
| 179 | + n <- nrow(registry) |
| 180 | + counts <- table(factor(registry$status, |
| 181 | + levels = c("matched", "matched_scaled", "threshold_ok", |
| 182 | + "unmatched", "year_skipped"))) |
| 183 | + unmatched <- registry[registry$status == "unmatched", , drop = FALSE] |
| 184 | + shown <- utils::head(unmatched, max_unmatched_shown) |
| 185 | + |
| 186 | + report <- paste0( |
| 187 | + "=== VALUE RECONCILIATION ===\n", |
| 188 | + sprintf("Document: %s (%d numeric values)\n", basename(document), n), |
| 189 | + sprintf("Corpus: %d unique values from %d source file(s)\n", |
| 190 | + length(corpus), length(sources)), |
| 191 | + sprintf("matched: %d | matched_scaled: %d | threshold_ok: %d | unmatched: %d | year_skipped: %d\n", |
| 192 | + counts["matched"], counts["matched_scaled"], counts["threshold_ok"], |
| 193 | + counts["unmatched"], counts["year_skipped"]), |
| 194 | + "\n'values_registry' has been assigned to the global environment.\n", |
| 195 | + if (nrow(unmatched) == 0) { |
| 196 | + "\nEvery non-year value is accounted for.\n" |
| 197 | + } else { |
| 198 | + paste0( |
| 199 | + sprintf("\nUNMATCHED VALUES (%d%s) -- each must be adjudicated:\n", |
| 200 | + nrow(unmatched), |
| 201 | + if (nrow(unmatched) > nrow(shown)) |
| 202 | + sprintf(", first %d shown", nrow(shown)) else ""), |
| 203 | + paste(sprintf(" [id %d, line %d] %s :: %s", |
| 204 | + shown$value_id, shown$line, shown$raw, shown$context), |
| 205 | + collapse = "\n"), |
| 206 | + "\n\nFor each: recompute it, or mark why it cannot come from the sources", |
| 207 | + "\n(e.g. citation year, DOI fragment, versioning). Record verdicts with:", |
| 208 | + "\n values_registry$adjudicated[values_registry$value_id == ID] <- TRUE", |
| 209 | + "\n values_registry$note[values_registry$value_id == ID] <- \"reason\"\n" |
| 210 | + ) |
| 211 | + } |
| 212 | + ) |
| 213 | + cat(report) |
| 214 | + invisible(report) |
| 215 | +} |
0 commit comments