# MSC-P-001 deterministic protocol-contract validator. MIT; R 4.5 plus sha256sum or certutil.

args <- commandArgs(trailingOnly = TRUE)
script_arg <- commandArgs(trailingOnly = FALSE)
file_arg <- sub("^--file=", "", script_arg[grep("^--file=", script_arg)])
script_dir <- dirname(normalizePath(file_arg))
default_data <- file.path(dirname(script_dir), "datasets", "msc-p001-testable-question.csv")
data_path <- if (length(args)) args[[1]] else default_data

required <- c(
  "question_id", "population", "eligibility", "unit_of_assignment", "unit_of_analysis",
  "intervention", "comparator", "outcome_label", "outcome_definition", "outcome_window_days",
  "estimand_formula", "intercurrent_event_strategy", "missing_outcome_rule", "estimator",
  "ci_method", "ci_bias_correction", "ci_solver_tolerance", "ci_solver_max_iterations",
  "confidence_level_percent", "alpha_two_sided", "multiplicity_rule",
  "minimum_useful_effect_pp", "direction", "success_bound", "success_operator",
  "falsifier_bound", "falsifier_operator", "inconclusive_rule", "protocol_deviation_rule",
  "data_status", "license"
)

header <- strsplit(readLines(data_path, n = 1L, warn = FALSE), ",", fixed = TRUE)[[1]]
if (!identical(header, required)) stop("dataset header must exactly match the protocol contract")
rows <- read.csv(data_path, stringsAsFactors = FALSE, check.names = FALSE, colClasses = "character")

sha256_text <- function(value) {
  temp <- tempfile(fileext = ".txt")
  on.exit(unlink(temp), add = TRUE)
  con <- file(temp, open = "wb")
  writeChar(value, con, eos = NULL, useBytes = TRUE)
  close(con)
  if (nzchar(Sys.which("sha256sum"))) {
    # GNU coreutils escapes the line with a leading backslash whenever the
    # hashed path contains one, as every Windows temporary path does, so the
    # digest is read by pattern rather than by position.
    line <- system2("sha256sum", shQuote(temp), stdout = TRUE)[[1]]
    digest <- regmatches(line, regexpr("[0-9a-f]{64}", line))
    if (length(digest)) return(digest[[1]])
  }
  if (nzchar(Sys.which("certutil"))) {
    lines <- system2("certutil", c("-hashfile", shQuote(temp), "SHA256"), stdout = TRUE)
    candidates <- gsub(" ", "", lines[grepl("^[0-9A-Fa-f ]{64,}$", lines)])
    if (length(candidates)) return(tolower(candidates[[1]]))
  }
  stop("sha256sum or certutil is required to seal the canonical record")
}

if (nrow(rows) != 1L) stop("the reference dataset must contain exactly one protocol record")
missing <- required[!vapply(rows[required], function(value) nzchar(trimws(value[[1]])), logical(1))]
if (length(missing)) stop(paste("missing required fields:", paste(missing, collapse = ", ")))
horizon_numeric <- as.numeric(rows$outcome_window_days)
threshold <- as.numeric(rows$minimum_useful_effect_pp)
tolerance <- as.numeric(rows$ci_solver_tolerance)
iterations_numeric <- as.numeric(rows$ci_solver_max_iterations)
confidence <- as.numeric(rows$confidence_level_percent)
alpha <- as.numeric(rows$alpha_two_sided)
if (!all(is.finite(c(horizon_numeric, threshold, tolerance, iterations_numeric, confidence, alpha)))) stop("numeric protocol fields must be finite")
if (horizon_numeric != floor(horizon_numeric) || iterations_numeric != floor(iterations_numeric)) stop("outcome window and solver iterations must be integers")
horizon <- as.integer(horizon_numeric)
iterations <- as.integer(iterations_numeric)
if (horizon <= 0 || threshold <= 0) stop("outcome window and threshold must be positive")
if (tolerance <= 0 || iterations <= 0) stop("confidence-interval solver controls must be positive")
if (!(confidence > 0 && confidence < 100 && alpha > 0 && alpha < 1)) stop("confidence and alpha must lie in their open probability ranges")
if (abs(confidence - 100 * (1 - alpha)) > 1e-12) stop("confidence and alpha are inconsistent")
if (rows$direction != "increase") stop("this reference contract supports direction=increase only")
expected <- c("lower", ">=", "upper", "<")
actual <- unname(unlist(rows[c("success_bound", "success_operator", "falsifier_bound", "falsifier_operator")]))
if (!identical(actual, expected)) stop("direction and decision bounds are inconsistent")
if (!grepl("every assigned eligible subscriber as denominator", rows$estimator, ignore.case = TRUE)) stop("invalid ITT denominator")
if (!grepl("regardless of delivery", rows$intercurrent_event_strategy, ignore.case = TRUE)) stop("intercurrent events are incomplete")
if (!grepl("otherwise stop confirmatory analysis", rows$missing_outcome_rule, ignore.case = TRUE)) stop("missing-outcome rule must fail closed")
if (!grepl("one primary outcome", rows$multiplicity_rule, ignore.case = TRUE)) stop("multiplicity scope is missing")
if (rows$ci_bias_correction != "N/(N-1)" || !grepl("inverting the constrained score statistic", rows$ci_method, ignore.case = TRUE)) stop("the Miettinen-Nurminen algorithm and bias correction must be explicit")
if (!grepl("post-opening deviation", rows$protocol_deviation_rule, ignore.case = TRUE)) stop("deviation rule is missing")
if (!grepl("no observed outcome", rows$data_status, ignore.case = TRUE)) stop("fixture must remain synthetic")
if (rows$license != "CC0-1.0") stop("fixture must use CC0-1.0")

question <- sprintf(
  "Among %s, does %s versus %s increase %s within %s days by at least %s percentage point?",
  tolower(rows$population), tolower(rows$intervention), tolower(rows$comparator),
  tolower(rows$outcome_label), rows$outcome_window_days, rows$minimum_useful_effect_pp
)
canonical <- paste(sprintf("%s=%s", required, trimws(unlist(rows[required]))), collapse = "\n")
cat(sprintf("question_id=%s\n", rows$question_id))
cat("protocol_complete=true\n")
cat(sprintf("testable_question=%s\n", question))
cat(sprintf("estimand=%s\n", rows$estimand_formula))
cat(sprintf("estimator=%s\n", rows$estimator))
cat(sprintf("confidence_interval=%s; bias correction=%s; tolerance=%s; max iterations=%s; %s%%; two-sided alpha=%s\n", rows$ci_method, rows$ci_bias_correction, rows$ci_solver_tolerance, rows$ci_solver_max_iterations, rows$confidence_level_percent, rows$alpha_two_sided))
cat(sprintf("success_rule=%s bound %s +%s percentage point\n", rows$success_bound, rows$success_operator, rows$minimum_useful_effect_pp))
cat(sprintf("falsifier=%s bound %s +%s percentage point\n", rows$falsifier_bound, rows$falsifier_operator, rows$minimum_useful_effect_pp))
cat(sprintf("data_status=%s\n", rows$data_status))
cat(sprintf("protocol_sha256=%s\n", sha256_text(canonical)))