From 1dbc7196efa6bea0f6b1568275a6a8236fbc1e50 Mon Sep 17 00:00:00 2001 From: Moritz Firsching Date: Sun, 25 Oct 2026 14:06:08 +0000 Subject: [PATCH] Add deeply embedded first-order Peano Arithmetic, adequacy, and completeness --- Challenge.lean | 408 ++++++- Cryptids.lean | 10 +- Cryptids/Propositions.lean | 388 +++++- Cryptids/README.md | 1 + Cryptids/Semantics/PA.lean | 28 + Cryptids/Semantics/PA/Adequacy.lean | 1438 +++++++++++++++++++++++ Cryptids/Semantics/PA/Completeness.lean | 1272 ++++++++++++++++++++ Cryptids/Semantics/PA/Syntax.lean | 620 ++++++++++ Cryptids/Semantics/README.md | 51 +- README.md | 4 +- comparator/README.md | 27 +- comparator/all.json | 4 + comparator/constructive.json | 3 + comparator/pa_semantics.json | 15 + 14 files changed, 4242 insertions(+), 27 deletions(-) create mode 100644 Cryptids/Semantics/PA.lean create mode 100644 Cryptids/Semantics/PA/Adequacy.lean create mode 100644 Cryptids/Semantics/PA/Completeness.lean create mode 100644 Cryptids/Semantics/PA/Syntax.lean create mode 100644 comparator/pa_semantics.json diff --git a/Challenge.lean b/Challenge.lean index 7e1c9707..96c8ae13 100644 --- a/Challenge.lean +++ b/Challenge.lean @@ -20,20 +20,23 @@ Self-contained specification module audited against `Cryptids` by `leanprover/co - **Constructive gate (`comparator/constructive.json`, `goldbach_21.json`, `zf_380.json`, `riemann_104.json`; `permitted_axioms = ["propext", "Quot.sound"]`):** The direct simulation state reductions (`Goldbach21`, `Zf380`, `Riemann104`), all four - `candidate_fewer_states` theorems (including `Riemann95.candidate_fewer_states`), and all ZF + `candidate_fewer_states` theorems (including `Riemann95.candidate_fewer_states`), all ZF machine-to-proof-search equivalences (`Zf393.halts_zf393_iff_zfInconsistent`, `Zf380.Semantics.halts_candidate_iff_zfInconsistent`, - `Semantics.Zf.halts_zf432_iff_wadeZFInconsistent`) are verified **without `Classical.choice`** - (`ListBlank` uses primitive `Quot` rather than `Quotient` so `Halts` is choice-free). Because - `Zf/Soundness.lean` proves `not_zfInconsistent` via `ZFSet.{0}` (`Classical.choice`)—and - `CIC + EM` proves `Con(ZF)` without choice (`digama0/ConZF`)—disallowing `Classical.choice` - blocks classical `Con(ZF)` shortcuts for `Halts M ↔ ZFInconsistent` (though Lean's type theory - remains stronger than `PA`/`ZF`; see `Cryptids/Semantics/README.md`). + `Semantics.Zf.halts_zf432_iff_wadeZFInconsistent`), and first-order Peano Arithmetic (`PA`) + consistency and $\Sigma_1^0$ standard-model adequacy (`Semantics.PA.not_paProvable_false`, + `Semantics.PA.paHalts_holds_iff_halts`, `Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent`) + are verified **without `Classical.choice`** (`ListBlank` uses primitive `Quot` rather than + `Quotient` so `Halts` is choice-free). Because `Zf/Soundness.lean` proves `not_zfInconsistent` + via `ZFSet.{0}` (`Classical.choice`)—and `CIC + EM` proves `Con(ZF)` without choice + (`digama0/ConZF`)—disallowing `Classical.choice` blocks classical `Con(ZF)` shortcuts for + `Halts M ↔ ZFInconsistent`, while deeply embedded `PAProvable` provides a weak first-order + metatheory that cannot prove `Con(PA)` or `Con(ZF)` (see `Cryptids/Semantics/README.md`). - **Full gate (`comparator/all.json`; `permitted_axioms = ["propext", "Quot.sound", "Classical.choice"]`):** - Audits all 22 theorems, including `Riemann95.candidate_equivalent` (which uses - `Classical.choice` via `Nat.Prime`), classical `ZFSet.{0}` soundness/non-halting, negated-`Π₁⁰` - Goldbach (`¬ GoldbachConjecture`, which uses Markov's Principle), and analytic + Audits all 26 theorems, including `Riemann95.candidate_equivalent` (which uses + `Classical.choice` via `Nat.Prime`), classical `PA` and `ZFSet.{0}` soundness/non-halting, + negated-`Π₁⁰` Goldbach (`¬ GoldbachConjecture`, which uses Markov's Principle), and analytic `RiemannHypothesis` equivalences. -/ @@ -170,6 +173,7 @@ def Tape.mk₁ {Γ : Type*} [Inhabited Γ] (l : List Γ) : Tape Γ := structure Machine (states symbols : ℕ) where transition : Fin states → Fin symbols → Option (Fin symbols × Dir × Fin states) +section variable {states symbols : ℕ} [NeZero states] [NeZero symbols] /-- A Turing machine configuration: current state and tape. -/ @@ -190,6 +194,7 @@ def Halts (M : Machine states symbols) : Prop := (StateTransition.eval (step M) /-- Build a `Machine states symbols` from a list of per-state transition rows. -/ def Machine.ofRows (rows : List (List (Option (Fin symbols × Dir × Fin states)))) : Machine states symbols := ⟨fun q a => (rows.getD q.val []).getD a.val none⟩ +end /-- A Turing machine over `symbols` tape symbols bundled with its non-zero state count. -/ structure BundledMachine (symbols : ℕ) where @@ -347,6 +352,379 @@ inductive WadeZFProvable : ℕ → Prop where /-- Inconsistency of `WadeZFProvable` ($v_0 \in v_0$). -/ def WadeZFInconsistent : Prop := WadeZFProvable (zfMem 0 0) +/-- First-order terms in the language of Peano Arithmetic +$\mathcal{L}_{\mathrm{PA}} = \{0, S, +, \times\}$. -/ +inductive PATerm : Type where + | var (x : ℕ) : PATerm + | zero : PATerm + | succ (t : PATerm) : PATerm + | add (t₁ t₂ : PATerm) : PATerm + | mul (t₁ t₂ : PATerm) : PATerm + deriving DecidableEq, Repr + +/-- Standard numeral $\overline{n}$ in $\mathcal{L}_{\mathrm{PA}}$. -/ +def PATerm.ofNat : ℕ → PATerm + | 0 => .zero + | n + 1 => .succ (ofNat n) + +/-- Whether variable `x` occurs in a `PATerm`. -/ +def PATerm.hasVar (x : ℕ) : PATerm → Bool + | .var y => y == x + | .zero => false + | .succ t => t.hasVar x + | .add t₁ t₂ | .mul t₁ t₂ => t₁.hasVar x || t₂.hasVar x + +/-- Smallest variable index strictly greater than every variable occurring in a `PATerm`. -/ +def PATerm.freshVar : PATerm → ℕ + | .var x => x + 1 + | .zero => 0 + | .succ t => t.freshVar + | .add t₁ t₂ | .mul t₁ t₂ => max t₁.freshVar t₂.freshVar + +/-- Substitute term `s` for variable `x` in a `PATerm`. -/ +def PATerm.subst : PATerm → ℕ → PATerm → PATerm + | .var y, x, s => if y == x then s else .var y + | .zero, _, _ => .zero + | .succ t, x, s => .succ (t.subst x s) + | .add t₁ t₂, x, s => .add (t₁.subst x s) (t₂.subst x s) + | .mul t₁ t₂, x, s => .mul (t₁.subst x s) (t₂.subst x s) + +/-- Evaluate a `PATerm` in the standard model `ℕ` under assignment `v`. -/ +def PATerm.eval (v : ℕ → ℕ) : PATerm → ℕ + | .var x => v x + | .zero => 0 + | .succ t => t.eval v + 1 + | .add t₁ t₂ => t₁.eval v + t₂.eval v + | .mul t₁ t₂ => t₁.eval v * t₂.eval v + +/-- First-order formulas of Peano Arithmetic with variables indexed by `ℕ`. -/ +inductive PAFormula : Type where + | bot : PAFormula + | eq (t₁ t₂ : PATerm) : PAFormula + | and (φ ψ : PAFormula) : PAFormula + | or (φ ψ : PAFormula) : PAFormula + | imp (φ ψ : PAFormula) : PAFormula + | all (x : ℕ) (φ : PAFormula) : PAFormula + | ex (x : ℕ) (φ : PAFormula) : PAFormula + deriving DecidableEq, Repr + +/-- Negation $\neg \varphi := \varphi \to \bot$. -/ +abbrev PAFormula.not (φ : PAFormula) : PAFormula := .imp φ .bot + +/-- Bi-implication $\varphi \leftrightarrow \psi := (\varphi \to \psi) \land (\psi \to \varphi)$. -/ +abbrev PAFormula.iff (φ ψ : PAFormula) : PAFormula := .and (.imp φ ψ) (.imp ψ φ) + +/-- Inequality $s \neq t := \neg (s = t)$. -/ +abbrev paNe (s t : PATerm) : PAFormula := .not (.eq s t) + +/-- Non-strict inequality $a \le b := \exists k,\, a + k = b$ with a fresh witness variable `k`. -/ +def paLe (a b : PATerm) : PAFormula := + let k := max a.freshVar b.freshVar + .ex k (.eq (.add a (.var k)) b) + +/-- Strict inequality $a < b := S(a) \le b$. -/ +def paLt (a b : PATerm) : PAFormula := + paLe (.succ a) b + +/-- Finite disjunction of a list of `PAFormula`s. -/ +def paDisjList : List PAFormula → PAFormula + | [] => .bot + | [φ] => φ + | φ :: rest => .or φ (paDisjList rest) + +/-- Whether variable `x` occurs free in a `PAFormula`. -/ +def PAFormula.hasFree (x : ℕ) : PAFormula → Bool + | .bot => false + | .eq t₁ t₂ => t₁.hasVar x || t₂.hasVar x + | .and φ ψ | .or φ ψ | .imp φ ψ => φ.hasFree x || ψ.hasFree x + | .all y φ | .ex y φ => !(y == x) && φ.hasFree x + +/-- Whether term `s` is free for `x` in `φ` (no free occurrence of `x` lies under a binder +for any variable occurring in `s`). -/ +def PAFormula.freeFor (x : ℕ) (s : PATerm) : PAFormula → Bool + | .bot | .eq _ _ => true + | .and φ ψ | .or φ ψ | .imp φ ψ => φ.freeFor x s && ψ.freeFor x s + | .all y φ | .ex y φ => (y == x) || ((!φ.hasFree x || !s.hasVar y) && φ.freeFor x s) + +/-- Substitute term `s` for free occurrences of variable `x` in `φ`. -/ +def PAFormula.subst (x : ℕ) (s : PATerm) : PAFormula → PAFormula + | .bot => .bot + | .eq t₁ t₂ => .eq (t₁.subst x s) (t₂.subst x s) + | .and φ ψ => .and (φ.subst x s) (ψ.subst x s) + | .or φ ψ => .or (φ.subst x s) (ψ.subst x s) + | .imp φ ψ => .imp (φ.subst x s) (ψ.subst x s) + | .all y φ => if y == x then .all y φ else .all y (φ.subst x s) + | .ex y φ => if y == x then .ex y φ else .ex y (φ.subst x s) + +/-- Standard Tarski satisfaction of a `PAFormula` in `ℕ` under variable assignment `v`. -/ +def PAFormula.Holds (v : ℕ → ℕ) : PAFormula → Prop + | .bot => False + | .eq t₁ t₂ => t₁.eval v = t₂.eval v + | .and φ ψ => φ.Holds v ∧ ψ.Holds v + | .or φ ψ => φ.Holds v ∨ ψ.Holds v + | .imp φ ψ => φ.Holds v → ψ.Holds v + | .all x φ => ∀ a : ℕ, φ.Holds (Function.update v x a) + | .ex x φ => ∃ a : ℕ, φ.Holds (Function.update v x a) + +/-- Standard Hilbert proof system for first-order Peano Arithmetic ($\mathrm{PA}$), combining +classical first-order logic with equality, the six defining equations of $0, S, +, \times$, and the +full first-order induction schema. -/ +inductive PAProvable : PAFormula → Prop where + | mp {φ ψ : PAFormula} : PAProvable φ → PAProvable (.imp φ ψ) → PAProvable ψ + | gen (x : ℕ) {φ : PAFormula} : PAProvable φ → PAProvable (.all x φ) + | imp_k (φ ψ : PAFormula) : PAProvable (.imp φ (.imp ψ φ)) + | imp_s (φ ψ χ : PAFormula) : + PAProvable (.imp (.imp φ (.imp ψ χ)) (.imp (.imp φ ψ) (.imp φ χ))) + | dne (φ : PAFormula) : PAProvable (.imp (.not (.not φ)) φ) + | and_intro (φ ψ : PAFormula) : PAProvable (.imp φ (.imp ψ (.and φ ψ))) + | and_left (φ ψ : PAFormula) : PAProvable (.imp (.and φ ψ) φ) + | and_right (φ ψ : PAFormula) : PAProvable (.imp (.and φ ψ) ψ) + | or_left (φ ψ : PAFormula) : PAProvable (.imp φ (.or φ ψ)) + | or_right (φ ψ : PAFormula) : PAProvable (.imp ψ (.or φ ψ)) + | or_elim (φ ψ χ : PAFormula) : + PAProvable (.imp (.imp φ χ) (.imp (.imp ψ χ) (.imp (.or φ ψ) χ))) + | all_imp (x : ℕ) (φ ψ : PAFormula) : + PAProvable (.imp (.all x (.imp φ ψ)) (.imp (.all x φ) (.all x ψ))) + | all_vacuous (x : ℕ) (φ : PAFormula) (h : φ.hasFree x = false) : + PAProvable (.imp φ (.all x φ)) + | all_elim (x : ℕ) (t : PATerm) (φ : PAFormula) (h : φ.freeFor x t = true) : + PAProvable (.imp (.all x φ) (φ.subst x t)) + | ex_intro (x : ℕ) (t : PATerm) (φ : PAFormula) (h : φ.freeFor x t = true) : + PAProvable (.imp (φ.subst x t) (.ex x φ)) + | ex_elim (x : ℕ) (φ ψ : PAFormula) (h : ψ.hasFree x = false) : + PAProvable (.imp (.all x (.imp φ ψ)) (.imp (.ex x φ) ψ)) + | eq_refl (t : PATerm) : PAProvable (.eq t t) + | eq_subst (x : ℕ) (s t : PATerm) (φ : PAFormula) + (hs : φ.freeFor x s = true) (ht : φ.freeFor x t = true) : + PAProvable (.imp (.eq s t) (.imp (φ.subst x s) (φ.subst x t))) + | pa_zero_ne_succ : PAProvable (.not (.eq (.succ (.var 0)) .zero)) + | pa_succ_inj : + PAProvable (.imp (.eq (.succ (.var 0)) (.succ (.var 1))) (.eq (.var 0) (.var 1))) + | pa_add_zero : PAProvable (.eq (.add (.var 0) .zero) (.var 0)) + | pa_add_succ : + PAProvable (.eq (.add (.var 0) (.succ (.var 1))) (.succ (.add (.var 0) (.var 1)))) + | pa_mul_zero : PAProvable (.eq (.mul (.var 0) .zero) .zero) + | pa_mul_succ : + PAProvable (.eq (.mul (.var 0) (.succ (.var 1))) (.add (.mul (.var 0) (.var 1)) (.var 0))) + | pa_ind (x : ℕ) (φ : PAFormula) : + PAProvable (.imp (φ.subst x .zero) + (.imp (.all x (.imp φ (φ.subst x (.succ (.var x))))) (.all x φ))) + +/-- Polynomial characterization $2 z = 2 x + (x + y)(x + y + 1)$ of `z = cantorPair x y`. -/ +def paCantorPairEq (x y z : PATerm) : PAFormula := + let s := PATerm.add x y + .eq (.mul (.ofNat 2) z) (.add (.mul (.ofNat 2) x) (.mul s (.succ s))) + +/-- Gödel's $\beta$-function graph $\beta(c, d, i) = r$, defined by +$\exists q,\; c = q \cdot (1 + (i + 1) d) + r \land r < 1 + (i + 1) d$. -/ +def paBetaEq (c d i r : PATerm) : PAFormula := + let m := PATerm.succ (.mul (.succ i) d) + let q := max (max c.freshVar m.freshVar) r.freshVar + .ex q (.and (.eq c (.add (.mul (.var q) m) r)) (paLt r m)) + +/-- Symbolic Cantor-pairing expression over variable indices and small natural constants, +used to arithmetize nested Cantor codes without expanding large numerals. -/ +inductive PAZFTerm : Type where + | var (x : ℕ) : PAZFTerm + | const (n : ℕ) : PAZFTerm + | pair (a b : PAZFTerm) : PAZFTerm + deriving DecidableEq, Repr + +/-- Number of fresh existential variables allocated when translating a `PAZFTerm`. -/ +def PAZFTerm.numVars : PAZFTerm → ℕ + | .var _ | .const _ => 0 + | .pair a b => 2 + a.numVars + b.numVars + +/-- Translate `out = e` into a `PAFormula`, allocating fresh intermediate variables starting at +`base`. -/ +def PAZFTerm.eqFormula : PAZFTerm → PATerm → ℕ → PAFormula + | .var x, out, _ => .eq out (.var x) + | .const n, out, _ => .eq out (.ofNat n) + | .pair a b, out, base => + .ex base (.ex (base + 1) + (.and (paCantorPairEq (.var base) (.var (base + 1)) out) + (.and (a.eqFormula (.var base) (base + 2)) + (b.eqFormula (.var (base + 1)) (base + 2 + a.numVars))))) + +/-- Symbolic Cantor code `(q, (h, (L, R)))` of a binary Turing machine configuration. -/ +def pzPackCfg (q h : ℕ) (L R : PAZFTerm) : PAZFTerm := + .pair (.const q) (.pair (.const h) (.pair L R)) + +/-- Single-step relation of a 2-symbol Turing machine `M` between configuration codes `.var 4` +and `.var 5`. -/ +def paStep {states : ℕ} (M : Machine states 2) : PAFormula := + paDisjList <| (List.finRange states).flatMap fun q => + (List.finRange 2).flatMap fun h => + match M.transition q h with + | none => [] + | some (w, .right, q') => + [0, 1].map fun h' => + .ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 8) (.add (.mul (.ofNat 2) (.var 6)) (.ofNat w.val))) + (.eq (.var 7) (.add (.mul (.ofNat 2) (.var 9)) (.ofNat h'))))))))) + | some (w, .left, q') => + [0, 1].map fun h' => + .ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 6) (.add (.mul (.ofNat 2) (.var 8)) (.ofNat h'))) + (.eq (.var 9) (.add (.mul (.ofNat 2) (.var 7)) (.ofNat w.val))))))))) + +/-- Undefined-transition (halted) predicate for a 2-symbol Turing machine `M` at configuration +code `.var 4`. -/ +def paHalted {states : ℕ} (M : Machine states 2) : PAFormula := + paDisjList <| (List.finRange states).flatMap fun q => + (List.finRange 2).flatMap fun h => + match M.transition q h with + | some _ => [] + | none => [.ex 6 (.ex 7 ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10))] + +/-- Closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentence asserting that the 2-symbol Turing +machine `M` halts when started in state `0` on the all-blank tape (encoded by `0`). -/ +def paHalts {states : ℕ} (M : Machine states 2) : PAFormula := + .ex 0 (.ex 1 (.ex 2 + (.and (paBetaEq (.var 1) (.var 2) .zero .zero) + (.and + (.all 3 (.imp (paLt (.var 3) (.var 0)) + (.ex 4 (.ex 5 + (.and (paBetaEq (.var 1) (.var 2) (.var 3) (.var 4)) + (.and (paBetaEq (.var 1) (.var 2) (.succ (.var 3)) (.var 5)) + (paStep M))))))) + (.ex 4 + (.and (paBetaEq (.var 1) (.var 2) (.var 0) (.var 4)) + (paHalted M))))))) + +/-- Symbolic `PAZFTerm` constructors mirroring `zfEq..axInf`. -/ +def pzEq (x y : PAZFTerm) : PAZFTerm := .pair (.pair x y) (.const 0) +/-- Symbolic `PAZFTerm` for `zfMem`. -/ +def pzMem (x y : PAZFTerm) : PAZFTerm := .pair (.pair x y) (.const 1) +/-- Symbolic `PAZFTerm` for `zfImp`. -/ +def pzImp (φ ψ : PAZFTerm) : PAZFTerm := .pair (.pair φ ψ) (.const 2) +/-- Symbolic `PAZFTerm` for `zfNot`. -/ +def pzNot (φ : PAZFTerm) : PAZFTerm := .pair φ (.const 3) +/-- Symbolic `PAZFTerm` for `zfAll`. -/ +def pzAll (x φ : PAZFTerm) : PAZFTerm := .pair (.pair x φ) (.const 4) +/-- Symbolic `PAZFTerm` for `zfEx`. -/ +def pzEx (x φ : PAZFTerm) : PAZFTerm := pzNot (pzAll x (pzNot φ)) +/-- Symbolic `PAZFTerm` for `zfAnd`. -/ +def pzAnd (φ ψ : PAZFTerm) : PAZFTerm := pzNot (pzImp φ (pzNot ψ)) +/-- Symbolic `PAZFTerm` for `axB1`. -/ +def pzB1 (φ ψ χ : PAZFTerm) : PAZFTerm := pzImp (pzImp φ ψ) (pzImp (pzImp ψ χ) (pzImp φ χ)) +/-- Symbolic `PAZFTerm` for `axB2`. -/ +def pzB2 (φ : PAZFTerm) : PAZFTerm := pzImp (pzImp (pzNot φ) φ) φ +/-- Symbolic `PAZFTerm` for `axB3`. -/ +def pzB3 (φ ψ : PAZFTerm) : PAZFTerm := pzImp φ (pzImp (pzNot φ) ψ) +/-- Symbolic `PAZFTerm` for `axB4`. -/ +def pzB4 (x φ ψ : PAZFTerm) : PAZFTerm := + pzImp (pzAll x (pzImp φ ψ)) (pzImp (pzAll x φ) (pzAll x ψ)) +/-- Symbolic `PAZFTerm` for `axB6a`. -/ +def pzB6a (x y z : PAZFTerm) : PAZFTerm := + pzAnd (pzImp (pzEq x y) (pzAll z (pzEq x y))) (pzImp (pzMem x y) (pzAll z (pzMem x y))) +/-- Symbolic `PAZFTerm` for `axB6b`. -/ +def pzB6b (x y φ : PAZFTerm) : PAZFTerm := pzImp (pzAll x (pzAll y φ)) (pzAll y (pzAll x φ)) +/-- Symbolic `PAZFTerm` for `axB6c`. -/ +def pzB6c (x φ : PAZFTerm) : PAZFTerm := pzImp (pzEx x (pzAll x φ)) φ +/-- Symbolic `PAZFTerm` for `axB7`. -/ +def pzB7 (x y : PAZFTerm) : PAZFTerm := pzEx x (pzEq x y) +/-- Symbolic `PAZFTerm` for `axB8a`. -/ +def pzB8a (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzEq x z) (pzEq y z)) +/-- Symbolic `PAZFTerm` for `axB8b`. -/ +def pzB8b (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzMem x z) (pzMem y z)) +/-- Symbolic `PAZFTerm` for `axB8c`. -/ +def pzB8c (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzMem z x) (pzMem z y)) +/-- Symbolic `PAZFTerm` for `axExt`. -/ +def pzExt : PAZFTerm := + pzImp + (pzAll (.const 2) + (pzAnd (pzImp (pzMem (.const 2) (.const 0)) (pzMem (.const 2) (.const 1))) + (pzImp (pzMem (.const 2) (.const 1)) (pzMem (.const 2) (.const 0))))) + (pzEq (.const 0) (.const 1)) +/-- Symbolic `PAZFTerm` for `axRepRhs`. -/ +def pzRepRhs (φ : PAZFTerm) : PAZFTerm := + pzEx (.const 3) (pzAnd (pzMem (.const 3) (.const 0)) (pzAll (.const 1) φ)) +/-- Symbolic `PAZFTerm` for `axRep`. -/ +def pzRep (φ : PAZFTerm) : PAZFTerm := + pzImp + (pzAll (.const 3) + (pzEx (.const 1) + (pzAll (.const 2) (pzImp (pzAll (.const 1) φ) (pzEq (.const 2) (.const 1)))))) + (pzEx (.const 1) + (pzAll (.const 2) + (pzAnd (pzImp (pzMem (.const 2) (.const 1)) (pzRepRhs φ)) + (pzImp (pzRepRhs φ) (pzMem (.const 2) (.const 1)))))) +/-- Symbolic `PAZFTerm` for `axPow`. -/ +def pzPow : PAZFTerm := + pzEx (.const 1) + (pzAll (.const 2) + (pzImp (pzAll (.const 3) (pzImp (pzMem (.const 3) (.const 2)) (pzMem (.const 3) (.const 0)))) + (pzMem (.const 2) (.const 1)))) +/-- Symbolic `PAZFTerm` for `axUni`. -/ +def pzUni : PAZFTerm := + pzEx (.const 1) + (pzAll (.const 2) + (pzImp (pzEx (.const 3) (pzAnd (pzMem (.const 2) (.const 3)) (pzMem (.const 3) (.const 0)))) + (pzMem (.const 2) (.const 1)))) +/-- Symbolic `PAZFTerm` for `axInfSingleton`. -/ +def pzInfSingleton : PAZFTerm := + pzAll (.const 1) + (pzAnd (pzImp (pzMem (.const 1) (.const 2)) (pzEq (.const 1) (.const 0))) + (pzImp (pzEq (.const 1) (.const 0)) (pzMem (.const 1) (.const 2)))) +/-- Symbolic `PAZFTerm` for `axInf`. -/ +def pzInf : PAZFTerm := + pzEx (.const 1) + (pzAnd (pzMem (.const 0) (.const 1)) + (pzAll (.const 0) + (pzImp (pzMem (.const 0) (.const 1)) + (pzEx (.const 2) (pzAnd (pzMem (.const 2) (.const 1)) pzInfSingleton))))) + +/-- Validity of step `i = .var 3` (with formula code `w = .var 4`) in a $\beta$-coded `ZFProvable` +derivation `(c = .var 1, d = .var 2)`. -/ +def paIsZFStep : PAFormula := + paDisjList + [ (pzEq (.const 0) (.const 0)).eqFormula (.var 4) 10 + , .ex 5 (.ex 6 (.ex 8 (.ex 9 + (.and (paLt (.var 8) (.var 3)) + (.and (paLt (.var 9) (.var 3)) + (.and (paBetaEq (.var 1) (.var 2) (.var 8) (.var 5)) + (.and (paBetaEq (.var 1) (.var 2) (.var 9) (.var 6)) + ((pzImp (.var 5) (.var 4)).eqFormula (.var 6) 10)))))))) + , .ex 5 (.ex 6 (.ex 8 + (.and (paLt (.var 8) (.var 3)) + (.and (paBetaEq (.var 1) (.var 2) (.var 8) (.var 6)) + ((pzAll (.var 5) (.var 6)).eqFormula (.var 4) 10))))) + , .ex 5 (.ex 6 (.ex 7 ((pzB1 (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 ((pzB2 (.var 5)).eqFormula (.var 4) 10) + , .ex 5 (.ex 6 ((pzB3 (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 (.ex 7 ((pzB4 (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 + (.and (paNe (.var 5) (.var 7)) + (.and (paNe (.var 7) (.var 6)) + ((pzB6a (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))))) + , .ex 5 (.ex 6 (.ex 7 ((pzB6b (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 ((pzB6c (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 ((pzB7 (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 (.ex 7 ((pzB8a (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 ((pzB8b (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 ((pzB8c (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , pzExt.eqFormula (.var 4) 10 + , .ex 5 ((pzRep (.var 5)).eqFormula (.var 4) 10) + , pzPow.eqFormula (.var 4) 10 + , pzUni.eqFormula (.var 4) 10 + , pzInf.eqFormula (.var 4) 10 ] + +/-- Closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentence asserting `ZFInconsistent` +($\mathrm{ZF} \vdash v_0 \in v_0$). -/ +def paZFInconsistent : PAFormula := + .ex 0 (.ex 1 (.ex 2 + (.and + (.all 3 (.imp (paLe (.var 3) (.var 0)) + (.ex 4 (.and (paBetaEq (.var 1) (.var 2) (.var 3) (.var 4)) paIsZFStep)))) + (.ex 4 + (.and (paBetaEq (.var 1) (.var 2) (.var 0) (.var 4)) + ((pzMem (.const 0) (.const 0)).eqFormula (.var 4) 10)))))) + namespace Goldbach21 /-- 25-state Goldbach reference machine (`goldbach_25`, Yao & Leng 2024). -/ abbrev reference : BundledMachine 2 := Machines.goldbach25.bundle @@ -389,6 +767,16 @@ theorem halts_zf432_iff_wadeZFInconsistent : ConjectureMachines.Halts Machines.zf432 ↔ WadeZFInconsistent := by sorry end Semantics.Zf +namespace Semantics.PA +theorem not_paProvable_false : ¬ PAProvable .bot := by sorry +theorem paHalts_holds_iff_halts {states : ℕ} [NeZero states] (M : Machine states 2) + (v : ℕ → ℕ) : (paHalts M).Holds v ↔ ConjectureMachines.Halts M := by sorry +theorem paZFInconsistent_holds_iff_zfInconsistent (v : ℕ → ℕ) : + paZFInconsistent.Holds v ↔ ZFInconsistent := by sorry +theorem paProvable_sound_nat (φ : PAFormula) (h : PAProvable φ) (v : ℕ → ℕ) : + φ.Holds v := by sorry +end Semantics.PA + namespace Semantics.Riemann theorem halts_riemann744_iff_exists_counterexample : ConjectureMachines.Halts Machines.riemann744 ↔ ∃ x : ℕ, MatiyasevichRiemannCounterexample x := diff --git a/Cryptids.lean b/Cryptids.lean index 3121e31e..52c3a8d3 100644 --- a/Cryptids.lean +++ b/Cryptids.lean @@ -13,6 +13,7 @@ public import Cryptids.Riemann120 public import Cryptids.Zf380 public import Cryptids.Zf393 public import Cryptids.Semantics.Goldbach +public import Cryptids.Semantics.PA public import Cryptids.Semantics.Riemann public import Cryptids.Semantics.Riemann120 public import Cryptids.Semantics.Riemann95 @@ -29,7 +30,9 @@ known baseline machines (`goldbach_25`, `zf_432`, `zf_393`, `riemann_744`, `riem linking every machine's blank-tape halting problem to Mathlib's statements: - `Cryptids.Propositions` — Shared definitions of `GoldbachConjecture`, - `MatiyasevichRiemannCounterexample`, `ZFInconsistent`, and `WadeZFInconsistent`. + `MatiyasevichRiemannCounterexample`, `ZFInconsistent`, `WadeZFInconsistent`, and deeply embedded + first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`, `paHalts`, + `paZFInconsistent`). - `Cryptids.Machines` — Turing machine execution model, bundled machines (`BundledMachine`), and machine table definitions (`ConjectureMachines.Machines.*`). - `Cryptids.Goldbach21`, `Cryptids.Zf380`, `Cryptids.Riemann104` — Proofs of @@ -47,6 +50,11 @@ linking every machine's blank-tape halting problem to Mathlib's statements: - `Cryptids.Riemann95`, `Cryptids.Semantics.Riemann95` — A 95-state machine with an exact 3,634-step blank initializer, unconditional equivalence to the 104-state machine, and `Halts candidate ↔ ¬ RiemannHypothesis`. +- `Cryptids.Semantics.PA` — First-order Peano Arithmetic metatheory: arbitrary `[PAModel M]` + soundness (`paProvable_sound`, `paProvable_sound_nat`), constructive consistency + (`not_paProvable_false`), constructive $\Sigma_1^0$ standard-model adequacy + (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), and Gödel–Henkin + completeness (`paProvable_iff_holdsIn_all_models`). - `Cryptids.Semantics.Goldbach`, `Cryptids.Semantics.Zf`, `Cryptids.Semantics.Riemann` — End-to-end proofs linking halting from the blank tape to the corresponding mathematical conjectures across all baseline machines (`goldbach25`, `zf432`, `riemann744`). diff --git a/Cryptids/Propositions.lean b/Cryptids/Propositions.lean index f6835d20..9aac66a6 100644 --- a/Cryptids/Propositions.lean +++ b/Cryptids/Propositions.lean @@ -10,6 +10,7 @@ public import Mathlib.Algebra.GCDMonoid.Finset public import Mathlib.Order.Interval.Finset.Nat public import Mathlib.NumberTheory.LSeries.RiemannZeta public import Mathlib.SetTheory.ZFC.Basic +public import Cryptids.Machines /-! # Target Mathematical Propositions (`Cryptids.Propositions`) @@ -63,7 +64,7 @@ In `Cryptids.Semantics.Riemann`, `(∃ x : ℕ, MatiyasevichRiemannCounterexampl equivalent to `¬ RiemannHypothesis`. -/ def MatiyasevichRiemannCounterexample (x : ℕ) : Prop := 253 < x ∧ - let lcm := (Finset.Icc 1 x).lcm id + let lcm := (@Finset.Icc ℕ Nat.instPreorder Nat.instLocallyFiniteOrder 1 x).lcm id let a := (harmNum lcm - lcm.factorial * x) ^ 2 let b := lcm.factorial ^ 2 let c := harmNum x ^ 4 * x @@ -307,4 +308,389 @@ the contradiction formula $v_0 \in v_0$ (`zfMem 0 0 = 1`) is provable. -/ def WadeZFInconsistent : Prop := WadeZFProvable (zfMem 0 0) +/-! +## 4. First-Order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`) + +To formalize metamathematical provability in first-order Peano Arithmetic ($\mathrm{PA}$) inside +Lean without relying on Lean's ambient type-theoretic strength, we deeply embed the syntax, +standard `ℕ` Tarski semantics, Hilbert proof system (`PAProvable`), and $\Sigma_1^0$ +arithmetizations of binary Turing machine halting (`paHalts`) and `ZF` inconsistency +(`paZFInconsistent`). +-/ + +/-- First-order terms in the language of Peano Arithmetic +$\mathcal{L}_{\mathrm{PA}} = \{0, S, +, \times\}$. -/ +inductive PATerm : Type where + | var (x : ℕ) : PATerm + | zero : PATerm + | succ (t : PATerm) : PATerm + | add (t₁ t₂ : PATerm) : PATerm + | mul (t₁ t₂ : PATerm) : PATerm + deriving DecidableEq, Repr + +/-- Standard numeral $\overline{n}$ in $\mathcal{L}_{\mathrm{PA}}$. -/ +def PATerm.ofNat : ℕ → PATerm + | 0 => .zero + | n + 1 => .succ (ofNat n) + +/-- Whether variable `x` occurs in a `PATerm`. -/ +def PATerm.hasVar (x : ℕ) : PATerm → Bool + | .var y => y == x + | .zero => false + | .succ t => t.hasVar x + | .add t₁ t₂ | .mul t₁ t₂ => t₁.hasVar x || t₂.hasVar x + +/-- Smallest variable index strictly greater than every variable occurring in a `PATerm`. -/ +def PATerm.freshVar : PATerm → ℕ + | .var x => x + 1 + | .zero => 0 + | .succ t => t.freshVar + | .add t₁ t₂ | .mul t₁ t₂ => max t₁.freshVar t₂.freshVar + +/-- Substitute term `s` for variable `x` in a `PATerm`. -/ +def PATerm.subst : PATerm → ℕ → PATerm → PATerm + | .var y, x, s => if y == x then s else .var y + | .zero, _, _ => .zero + | .succ t, x, s => .succ (t.subst x s) + | .add t₁ t₂, x, s => .add (t₁.subst x s) (t₂.subst x s) + | .mul t₁ t₂, x, s => .mul (t₁.subst x s) (t₂.subst x s) + +/-- Evaluate a `PATerm` in the standard model `ℕ` under assignment `v`. -/ +def PATerm.eval (v : ℕ → ℕ) : PATerm → ℕ + | .var x => v x + | .zero => 0 + | .succ t => t.eval v + 1 + | .add t₁ t₂ => t₁.eval v + t₂.eval v + | .mul t₁ t₂ => t₁.eval v * t₂.eval v + +/-- First-order formulas of Peano Arithmetic with variables indexed by `ℕ`. -/ +inductive PAFormula : Type where + | bot : PAFormula + | eq (t₁ t₂ : PATerm) : PAFormula + | and (φ ψ : PAFormula) : PAFormula + | or (φ ψ : PAFormula) : PAFormula + | imp (φ ψ : PAFormula) : PAFormula + | all (x : ℕ) (φ : PAFormula) : PAFormula + | ex (x : ℕ) (φ : PAFormula) : PAFormula + deriving DecidableEq, Repr + +/-- Negation $\neg \varphi := \varphi \to \bot$. -/ +abbrev PAFormula.not (φ : PAFormula) : PAFormula := .imp φ .bot + +/-- Bi-implication $\varphi \leftrightarrow \psi := (\varphi \to \psi) \land (\psi \to \varphi)$. -/ +abbrev PAFormula.iff (φ ψ : PAFormula) : PAFormula := .and (.imp φ ψ) (.imp ψ φ) + +/-- Inequality $s \neq t := \neg (s = t)$. -/ +abbrev paNe (s t : PATerm) : PAFormula := .not (.eq s t) + +/-- Non-strict inequality $a \le b := \exists k,\, a + k = b$ with a fresh witness variable `k`. -/ +def paLe (a b : PATerm) : PAFormula := + let k := max a.freshVar b.freshVar + .ex k (.eq (.add a (.var k)) b) + +/-- Strict inequality $a < b := S(a) \le b$. -/ +def paLt (a b : PATerm) : PAFormula := + paLe (.succ a) b + +/-- Finite disjunction of a list of `PAFormula`s. -/ +def paDisjList : List PAFormula → PAFormula + | [] => .bot + | [φ] => φ + | φ :: rest => .or φ (paDisjList rest) + +/-- Whether variable `x` occurs free in a `PAFormula`. -/ +def PAFormula.hasFree (x : ℕ) : PAFormula → Bool + | .bot => false + | .eq t₁ t₂ => t₁.hasVar x || t₂.hasVar x + | .and φ ψ | .or φ ψ | .imp φ ψ => φ.hasFree x || ψ.hasFree x + | .all y φ | .ex y φ => !(y == x) && φ.hasFree x + +/-- Whether term `s` is free for `x` in `φ` (no free occurrence of `x` lies under a binder +for any variable occurring in `s`). -/ +def PAFormula.freeFor (x : ℕ) (s : PATerm) : PAFormula → Bool + | .bot | .eq _ _ => true + | .and φ ψ | .or φ ψ | .imp φ ψ => φ.freeFor x s && ψ.freeFor x s + | .all y φ | .ex y φ => (y == x) || ((!φ.hasFree x || !s.hasVar y) && φ.freeFor x s) + +/-- Substitute term `s` for free occurrences of variable `x` in `φ`. -/ +def PAFormula.subst (x : ℕ) (s : PATerm) : PAFormula → PAFormula + | .bot => .bot + | .eq t₁ t₂ => .eq (t₁.subst x s) (t₂.subst x s) + | .and φ ψ => .and (φ.subst x s) (ψ.subst x s) + | .or φ ψ => .or (φ.subst x s) (ψ.subst x s) + | .imp φ ψ => .imp (φ.subst x s) (ψ.subst x s) + | .all y φ => if y == x then .all y φ else .all y (φ.subst x s) + | .ex y φ => if y == x then .ex y φ else .ex y (φ.subst x s) + +/-- Standard Tarski satisfaction of a `PAFormula` in `ℕ` under variable assignment `v`. -/ +def PAFormula.Holds (v : ℕ → ℕ) : PAFormula → Prop + | .bot => False + | .eq t₁ t₂ => t₁.eval v = t₂.eval v + | .and φ ψ => φ.Holds v ∧ ψ.Holds v + | .or φ ψ => φ.Holds v ∨ ψ.Holds v + | .imp φ ψ => φ.Holds v → ψ.Holds v + | .all x φ => ∀ a : ℕ, φ.Holds (Function.update v x a) + | .ex x φ => ∃ a : ℕ, φ.Holds (Function.update v x a) + +/-- Standard Hilbert proof system for first-order Peano Arithmetic ($\mathrm{PA}$), combining +classical first-order logic with equality, the six defining equations of $0, S, +, \times$, and the +full first-order induction schema. -/ +inductive PAProvable : PAFormula → Prop where + | mp {φ ψ : PAFormula} : PAProvable φ → PAProvable (.imp φ ψ) → PAProvable ψ + | gen (x : ℕ) {φ : PAFormula} : PAProvable φ → PAProvable (.all x φ) + | imp_k (φ ψ : PAFormula) : PAProvable (.imp φ (.imp ψ φ)) + | imp_s (φ ψ χ : PAFormula) : + PAProvable (.imp (.imp φ (.imp ψ χ)) (.imp (.imp φ ψ) (.imp φ χ))) + | dne (φ : PAFormula) : PAProvable (.imp (.not (.not φ)) φ) + | and_intro (φ ψ : PAFormula) : PAProvable (.imp φ (.imp ψ (.and φ ψ))) + | and_left (φ ψ : PAFormula) : PAProvable (.imp (.and φ ψ) φ) + | and_right (φ ψ : PAFormula) : PAProvable (.imp (.and φ ψ) ψ) + | or_left (φ ψ : PAFormula) : PAProvable (.imp φ (.or φ ψ)) + | or_right (φ ψ : PAFormula) : PAProvable (.imp ψ (.or φ ψ)) + | or_elim (φ ψ χ : PAFormula) : + PAProvable (.imp (.imp φ χ) (.imp (.imp ψ χ) (.imp (.or φ ψ) χ))) + | all_imp (x : ℕ) (φ ψ : PAFormula) : + PAProvable (.imp (.all x (.imp φ ψ)) (.imp (.all x φ) (.all x ψ))) + | all_vacuous (x : ℕ) (φ : PAFormula) (h : φ.hasFree x = false) : + PAProvable (.imp φ (.all x φ)) + | all_elim (x : ℕ) (t : PATerm) (φ : PAFormula) (h : φ.freeFor x t = true) : + PAProvable (.imp (.all x φ) (φ.subst x t)) + | ex_intro (x : ℕ) (t : PATerm) (φ : PAFormula) (h : φ.freeFor x t = true) : + PAProvable (.imp (φ.subst x t) (.ex x φ)) + | ex_elim (x : ℕ) (φ ψ : PAFormula) (h : ψ.hasFree x = false) : + PAProvable (.imp (.all x (.imp φ ψ)) (.imp (.ex x φ) ψ)) + | eq_refl (t : PATerm) : PAProvable (.eq t t) + | eq_subst (x : ℕ) (s t : PATerm) (φ : PAFormula) + (hs : φ.freeFor x s = true) (ht : φ.freeFor x t = true) : + PAProvable (.imp (.eq s t) (.imp (φ.subst x s) (φ.subst x t))) + | pa_zero_ne_succ : PAProvable (.not (.eq (.succ (.var 0)) .zero)) + | pa_succ_inj : + PAProvable (.imp (.eq (.succ (.var 0)) (.succ (.var 1))) (.eq (.var 0) (.var 1))) + | pa_add_zero : PAProvable (.eq (.add (.var 0) .zero) (.var 0)) + | pa_add_succ : + PAProvable (.eq (.add (.var 0) (.succ (.var 1))) (.succ (.add (.var 0) (.var 1)))) + | pa_mul_zero : PAProvable (.eq (.mul (.var 0) .zero) .zero) + | pa_mul_succ : + PAProvable (.eq (.mul (.var 0) (.succ (.var 1))) (.add (.mul (.var 0) (.var 1)) (.var 0))) + | pa_ind (x : ℕ) (φ : PAFormula) : + PAProvable (.imp (φ.subst x .zero) + (.imp (.all x (.imp φ (φ.subst x (.succ (.var x))))) (.all x φ))) + +/-! ### 4a. Arithmetization of Pairing, Gödel's $\beta$-Function, `Halts`, and `ZFInconsistent` -/ + +/-- Polynomial characterization $2 z = 2 x + (x + y)(x + y + 1)$ of `z = cantorPair x y`. -/ +def paCantorPairEq (x y z : PATerm) : PAFormula := + let s := PATerm.add x y + .eq (.mul (.ofNat 2) z) (.add (.mul (.ofNat 2) x) (.mul s (.succ s))) + +/-- Gödel's $\beta$-function graph $\beta(c, d, i) = r$, defined by +$\exists q,\; c = q \cdot (1 + (i + 1) d) + r \land r < 1 + (i + 1) d$. -/ +def paBetaEq (c d i r : PATerm) : PAFormula := + let m := PATerm.succ (.mul (.succ i) d) + let q := max (max c.freshVar m.freshVar) r.freshVar + .ex q (.and (.eq c (.add (.mul (.var q) m) r)) (paLt r m)) + +/-- Symbolic Cantor-pairing expression over variable indices and small natural constants, +used to arithmetize nested Cantor codes without expanding large numerals. -/ +inductive PAZFTerm : Type where + | var (x : ℕ) : PAZFTerm + | const (n : ℕ) : PAZFTerm + | pair (a b : PAZFTerm) : PAZFTerm + deriving DecidableEq, Repr + +/-- Number of fresh existential variables allocated when translating a `PAZFTerm`. -/ +def PAZFTerm.numVars : PAZFTerm → ℕ + | .var _ | .const _ => 0 + | .pair a b => 2 + a.numVars + b.numVars + +/-- Translate `out = e` into a `PAFormula`, allocating fresh intermediate variables starting at +`base`. -/ +def PAZFTerm.eqFormula : PAZFTerm → PATerm → ℕ → PAFormula + | .var x, out, _ => .eq out (.var x) + | .const n, out, _ => .eq out (.ofNat n) + | .pair a b, out, base => + .ex base (.ex (base + 1) + (.and (paCantorPairEq (.var base) (.var (base + 1)) out) + (.and (a.eqFormula (.var base) (base + 2)) + (b.eqFormula (.var (base + 1)) (base + 2 + a.numVars))))) + +/-- Symbolic Cantor code `(q, (h, (L, R)))` of a binary Turing machine configuration. -/ +def pzPackCfg (q h : ℕ) (L R : PAZFTerm) : PAZFTerm := + .pair (.const q) (.pair (.const h) (.pair L R)) + +/-- Single-step relation of a 2-symbol Turing machine `M` between configuration codes `.var 4` +and `.var 5`. -/ +def paStep {states : ℕ} (M : Machine states 2) : PAFormula := + paDisjList <| (List.finRange states).flatMap fun q => + (List.finRange 2).flatMap fun h => + match M.transition q h with + | none => [] + | some (w, .right, q') => + [0, 1].map fun h' => + .ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 8) (.add (.mul (.ofNat 2) (.var 6)) (.ofNat w.val))) + (.eq (.var 7) (.add (.mul (.ofNat 2) (.var 9)) (.ofNat h'))))))))) + | some (w, .left, q') => + [0, 1].map fun h' => + .ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 6) (.add (.mul (.ofNat 2) (.var 8)) (.ofNat h'))) + (.eq (.var 9) (.add (.mul (.ofNat 2) (.var 7)) (.ofNat w.val))))))))) + +/-- Undefined-transition (halted) predicate for a 2-symbol Turing machine `M` at configuration +code `.var 4`. -/ +def paHalted {states : ℕ} (M : Machine states 2) : PAFormula := + paDisjList <| (List.finRange states).flatMap fun q => + (List.finRange 2).flatMap fun h => + match M.transition q h with + | some _ => [] + | none => [.ex 6 (.ex 7 ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10))] + +/-- Closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentence asserting that the 2-symbol Turing +machine `M` halts when started in state `0` on the all-blank tape (encoded by `0`). -/ +def paHalts {states : ℕ} (M : Machine states 2) : PAFormula := + .ex 0 (.ex 1 (.ex 2 + (.and (paBetaEq (.var 1) (.var 2) .zero .zero) + (.and + (.all 3 (.imp (paLt (.var 3) (.var 0)) + (.ex 4 (.ex 5 + (.and (paBetaEq (.var 1) (.var 2) (.var 3) (.var 4)) + (.and (paBetaEq (.var 1) (.var 2) (.succ (.var 3)) (.var 5)) + (paStep M))))))) + (.ex 4 + (.and (paBetaEq (.var 1) (.var 2) (.var 0) (.var 4)) + (paHalted M))))))) + +/-- Symbolic `PAZFTerm` constructors mirroring `zfEq..axInf`. -/ +def pzEq (x y : PAZFTerm) : PAZFTerm := .pair (.pair x y) (.const 0) +/-- Symbolic `PAZFTerm` for `zfMem`. -/ +def pzMem (x y : PAZFTerm) : PAZFTerm := .pair (.pair x y) (.const 1) +/-- Symbolic `PAZFTerm` for `zfImp`. -/ +def pzImp (φ ψ : PAZFTerm) : PAZFTerm := .pair (.pair φ ψ) (.const 2) +/-- Symbolic `PAZFTerm` for `zfNot`. -/ +def pzNot (φ : PAZFTerm) : PAZFTerm := .pair φ (.const 3) +/-- Symbolic `PAZFTerm` for `zfAll`. -/ +def pzAll (x φ : PAZFTerm) : PAZFTerm := .pair (.pair x φ) (.const 4) +/-- Symbolic `PAZFTerm` for `zfEx`. -/ +def pzEx (x φ : PAZFTerm) : PAZFTerm := pzNot (pzAll x (pzNot φ)) +/-- Symbolic `PAZFTerm` for `zfAnd`. -/ +def pzAnd (φ ψ : PAZFTerm) : PAZFTerm := pzNot (pzImp φ (pzNot ψ)) +/-- Symbolic `PAZFTerm` for `axB1`. -/ +def pzB1 (φ ψ χ : PAZFTerm) : PAZFTerm := pzImp (pzImp φ ψ) (pzImp (pzImp ψ χ) (pzImp φ χ)) +/-- Symbolic `PAZFTerm` for `axB2`. -/ +def pzB2 (φ : PAZFTerm) : PAZFTerm := pzImp (pzImp (pzNot φ) φ) φ +/-- Symbolic `PAZFTerm` for `axB3`. -/ +def pzB3 (φ ψ : PAZFTerm) : PAZFTerm := pzImp φ (pzImp (pzNot φ) ψ) +/-- Symbolic `PAZFTerm` for `axB4`. -/ +def pzB4 (x φ ψ : PAZFTerm) : PAZFTerm := + pzImp (pzAll x (pzImp φ ψ)) (pzImp (pzAll x φ) (pzAll x ψ)) +/-- Symbolic `PAZFTerm` for `axB6a`. -/ +def pzB6a (x y z : PAZFTerm) : PAZFTerm := + pzAnd (pzImp (pzEq x y) (pzAll z (pzEq x y))) (pzImp (pzMem x y) (pzAll z (pzMem x y))) +/-- Symbolic `PAZFTerm` for `axB6b`. -/ +def pzB6b (x y φ : PAZFTerm) : PAZFTerm := pzImp (pzAll x (pzAll y φ)) (pzAll y (pzAll x φ)) +/-- Symbolic `PAZFTerm` for `axB6c`. -/ +def pzB6c (x φ : PAZFTerm) : PAZFTerm := pzImp (pzEx x (pzAll x φ)) φ +/-- Symbolic `PAZFTerm` for `axB7`. -/ +def pzB7 (x y : PAZFTerm) : PAZFTerm := pzEx x (pzEq x y) +/-- Symbolic `PAZFTerm` for `axB8a`. -/ +def pzB8a (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzEq x z) (pzEq y z)) +/-- Symbolic `PAZFTerm` for `axB8b`. -/ +def pzB8b (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzMem x z) (pzMem y z)) +/-- Symbolic `PAZFTerm` for `axB8c`. -/ +def pzB8c (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzMem z x) (pzMem z y)) +/-- Symbolic `PAZFTerm` for `axExt`. -/ +def pzExt : PAZFTerm := + pzImp + (pzAll (.const 2) + (pzAnd (pzImp (pzMem (.const 2) (.const 0)) (pzMem (.const 2) (.const 1))) + (pzImp (pzMem (.const 2) (.const 1)) (pzMem (.const 2) (.const 0))))) + (pzEq (.const 0) (.const 1)) +/-- Symbolic `PAZFTerm` for `axRepRhs`. -/ +def pzRepRhs (φ : PAZFTerm) : PAZFTerm := + pzEx (.const 3) (pzAnd (pzMem (.const 3) (.const 0)) (pzAll (.const 1) φ)) +/-- Symbolic `PAZFTerm` for `axRep`. -/ +def pzRep (φ : PAZFTerm) : PAZFTerm := + pzImp + (pzAll (.const 3) + (pzEx (.const 1) + (pzAll (.const 2) (pzImp (pzAll (.const 1) φ) (pzEq (.const 2) (.const 1)))))) + (pzEx (.const 1) + (pzAll (.const 2) + (pzAnd (pzImp (pzMem (.const 2) (.const 1)) (pzRepRhs φ)) + (pzImp (pzRepRhs φ) (pzMem (.const 2) (.const 1)))))) +/-- Symbolic `PAZFTerm` for `axPow`. -/ +def pzPow : PAZFTerm := + pzEx (.const 1) + (pzAll (.const 2) + (pzImp (pzAll (.const 3) (pzImp (pzMem (.const 3) (.const 2)) (pzMem (.const 3) (.const 0)))) + (pzMem (.const 2) (.const 1)))) +/-- Symbolic `PAZFTerm` for `axUni`. -/ +def pzUni : PAZFTerm := + pzEx (.const 1) + (pzAll (.const 2) + (pzImp (pzEx (.const 3) (pzAnd (pzMem (.const 2) (.const 3)) (pzMem (.const 3) (.const 0)))) + (pzMem (.const 2) (.const 1)))) +/-- Symbolic `PAZFTerm` for `axInfSingleton`. -/ +def pzInfSingleton : PAZFTerm := + pzAll (.const 1) + (pzAnd (pzImp (pzMem (.const 1) (.const 2)) (pzEq (.const 1) (.const 0))) + (pzImp (pzEq (.const 1) (.const 0)) (pzMem (.const 1) (.const 2)))) +/-- Symbolic `PAZFTerm` for `axInf`. -/ +def pzInf : PAZFTerm := + pzEx (.const 1) + (pzAnd (pzMem (.const 0) (.const 1)) + (pzAll (.const 0) + (pzImp (pzMem (.const 0) (.const 1)) + (pzEx (.const 2) (pzAnd (pzMem (.const 2) (.const 1)) pzInfSingleton))))) + +/-- Validity of step `i = .var 3` (with formula code `w = .var 4`) in a $\beta$-coded `ZFProvable` +derivation `(c = .var 1, d = .var 2)`. -/ +def paIsZFStep : PAFormula := + paDisjList + [ (pzEq (.const 0) (.const 0)).eqFormula (.var 4) 10 + , .ex 5 (.ex 6 (.ex 8 (.ex 9 + (.and (paLt (.var 8) (.var 3)) + (.and (paLt (.var 9) (.var 3)) + (.and (paBetaEq (.var 1) (.var 2) (.var 8) (.var 5)) + (.and (paBetaEq (.var 1) (.var 2) (.var 9) (.var 6)) + ((pzImp (.var 5) (.var 4)).eqFormula (.var 6) 10)))))))) + , .ex 5 (.ex 6 (.ex 8 + (.and (paLt (.var 8) (.var 3)) + (.and (paBetaEq (.var 1) (.var 2) (.var 8) (.var 6)) + ((pzAll (.var 5) (.var 6)).eqFormula (.var 4) 10))))) + , .ex 5 (.ex 6 (.ex 7 ((pzB1 (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 ((pzB2 (.var 5)).eqFormula (.var 4) 10) + , .ex 5 (.ex 6 ((pzB3 (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 (.ex 7 ((pzB4 (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 + (.and (paNe (.var 5) (.var 7)) + (.and (paNe (.var 7) (.var 6)) + ((pzB6a (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))))) + , .ex 5 (.ex 6 (.ex 7 ((pzB6b (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 ((pzB6c (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 ((pzB7 (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 (.ex 7 ((pzB8a (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 ((pzB8b (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 ((pzB8c (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , pzExt.eqFormula (.var 4) 10 + , .ex 5 ((pzRep (.var 5)).eqFormula (.var 4) 10) + , pzPow.eqFormula (.var 4) 10 + , pzUni.eqFormula (.var 4) 10 + , pzInf.eqFormula (.var 4) 10 ] + +/-- Closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentence asserting `ZFInconsistent` +($\mathrm{ZF} \vdash v_0 \in v_0$). -/ +def paZFInconsistent : PAFormula := + .ex 0 (.ex 1 (.ex 2 + (.and + (.all 3 (.imp (paLe (.var 3) (.var 0)) + (.ex 4 (.and (paBetaEq (.var 1) (.var 2) (.var 3) (.var 4)) paIsZFStep)))) + (.ex 4 + (.and (paBetaEq (.var 1) (.var 2) (.var 0) (.var 4)) + ((pzMem (.const 0) (.const 0)).eqFormula (.var 4) 10)))))) + end ConjectureMachines diff --git a/Cryptids/README.md b/Cryptids/README.md index e15f52a9..0cceaef9 100644 --- a/Cryptids/README.md +++ b/Cryptids/README.md @@ -24,6 +24,7 @@ All proofs in [`Cryptids/`](./) are checked by the Lean 4 kernel (`v4.35.0-rc4`) 1. **State reductions:** Each reduced machine (`goldbach_21`, `zf_380`, `riemann_104`, `riemann_95`) has fewer states than its reference machine (`goldbach_25`, `zf_393`, `riemann_120`, `riemann_104`) and halts from the blank tape if and only if the reference machine halts ([`Goldbach21.lean`](./Goldbach21.lean), [`Zf380.lean`](./Zf380.lean), [`Riemann104.lean`](./Riemann104.lean), [`Riemann95.lean`](./Riemann95.lean)). The direct simulation reductions (`goldbach_21`, `zf_380`, `riemann_104`) and all four `candidate_fewer_states` theorems are completely constructive (`["propext", "Quot.sound"]`, zero `Classical.choice`), audited via [`comparator/constructive.json`](../comparator/constructive.json), [`comparator/goldbach_21.json`](../comparator/goldbach_21.json), [`comparator/zf_380.json`](../comparator/zf_380.json), and [`comparator/riemann_104.json`](../comparator/riemann_104.json), while [`riemann_95`](./Riemann95.lean) routes through the arithmetic stage predicate `ShuniaCounterexample` (`Nat.Prime`, audited via [`comparator/riemann_95.json`](../comparator/riemann_95.json)). 2. **End-to-end mathematical semantics ([`Cryptids/Semantics/`](./Semantics/README.md)):** - **ZF Consistency (`zf_380`, `zf_393`, and `zf_432`):** Both `zf_380` and Wade's 393-state machine `zf_393` (incorporating upstream fix `10fcf152b3`) halt if and only if O'Rear's `zf2.nql` Hilbert system proves $v_0 \in v_0$ (`Halts candidate ↔ ZFInconsistent`, `Halts zf393 ↔ ZFInconsistent`), while `zf_432` halts if and only if the 20-clause deductive system enumerated by `zf_432_wade.tm` derives $v_0 \in v_0$ (`WadeZFInconsistent`). **All three proof-search equivalences are proved constructively in Lean using only `["propext", "Quot.sound"]` (no `Classical.choice`, no Excluded Middle, and no Markov's Principle)** and audited via [`comparator/constructive.json`](../comparator/constructive.json), blocking classical `Con(ZF)` shortcuts via [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) or `Classical.em` (while internalizing the reduction inside `PA`/`ZF` and establishing full `ZF`-independence remain separate from this Lean meta-level correspondence; see [`Semantics/README.md`](./Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). Separately, [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) uses classical `ZFSet.{0}` (`Classical.choice`) to establish `not_zfInconsistent` and deduce unconditional non-halting (`not_halts_zf393`, `not_halts_candidate`) inside Lean's stronger meta-theory. + - **First-Order Peano Arithmetic (`PAProvable`, [`Semantics/PA.lean`](./Semantics/PA.lean)):** Deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`) and $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` in [`Propositions.lean`](./Propositions.lean) and [`Challenge.lean`](../Challenge.lean), proving constructive consistency (`not_paProvable_false`), constructive standard-model adequacy (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`; all three audited without `Classical.choice` in [`comparator/constructive.json`](../comparator/constructive.json)), standard-model soundness (`paProvable_sound_nat`), and Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`) across arbitrary `[PAModel M]`. - **Goldbach (`goldbach_21` and `goldbach_25`):** Both `goldbach_21` and `goldbach_25` constructively satisfy `Halts M ↔ ∃ w, ¬ HasGoldbachPair (2 * w + 4)` without `Classical.choice` ([`Goldbach21.lean`](./Goldbach21.lean)), and with `Classical.choice` (for Markov's Principle on `¬ ∀ n, ...`) satisfy `Halts candidate ↔ ¬ GoldbachConjecture` ([`Semantics/Goldbach.lean`](./Semantics/Goldbach.lean)). - **Riemann Hypothesis (`riemann_95`, `riemann_104`, `riemann_120`, and `riemann_744`):** All four machines (`riemann_95`, `riemann_104`, Shunia's 120-state machine `riemann_120`, and the 744-state machine `riemann_744`) halt if and only if Mathlib's `RiemannHypothesis` is false (`Halts candidate ↔ ¬ RiemannHypothesis`, `Halts riemann120 ↔ ¬ RiemannHypothesis`, and `Halts riemann744 ↔ ¬ RiemannHypothesis`). diff --git a/Cryptids/Semantics/PA.lean b/Cryptids/Semantics/PA.lean new file mode 100644 index 00000000..fd085774 --- /dev/null +++ b/Cryptids/Semantics/PA.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Syntax +public import Cryptids.Semantics.PA.Adequacy +public import Cryptids.Semantics.PA.Completeness + +/-! +# First-Order Peano Arithmetic Semantics, Adequacy, and Completeness (`Cryptids.Semantics.PA`) + +Re-exports the foundational metatheory of the deeply embedded Peano Arithmetic system `PAProvable` +(`Cryptids.Propositions`): + +1. [`Cryptids.Semantics.PA.Syntax`](./PA/Syntax.lean): + General $\mathcal{L}_{\mathrm{PA}}$-structures (`PAStructure`), models (`PAModel`), classical + soundness (`paProvable_sound`, `paProvable_sound_nat`), and constructive consistency via the + Gödel–Gentzen negative translation (`not_paProvable_false`, zero `Classical.choice`). +2. [`Cryptids.Semantics.PA.Adequacy`](./PA/Adequacy.lean): + Constructive standard-model adequacy of the $\Sigma_1^0$ arithmetizations of binary Turing + machine halting and `ZF` inconsistency (`paHalts_holds_iff_halts` and + `paZFInconsistent_holds_iff_zfInconsistent`, zero `Classical.choice`). +3. [`Cryptids.Semantics.PA.Completeness`](./PA/Completeness.lean): + Gödel–Henkin soundness and completeness across all first-order `PAModel`s + (`paProvable_iff_holdsIn_all_models`). +-/ diff --git a/Cryptids/Semantics/PA/Adequacy.lean b/Cryptids/Semantics/PA/Adequacy.lean new file mode 100644 index 00000000..84c973c7 --- /dev/null +++ b/Cryptids/Semantics/PA/Adequacy.lean @@ -0,0 +1,1438 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Syntax +public import Mathlib.Data.Nat.Factorial.Basic + +/-! +# Standard-Model Adequacy of `paHalts` and `paZFInconsistent` + +This module proves that the closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentences `paHalts M` +and `paZFInconsistent` (`Cryptids.Propositions`) faithfully represent binary Turing machine halting +and `ZF` inconsistency in the standard model `ℕ`: + +- `paHalts_holds_iff_halts`: `(paHalts M).Holds v ↔ ConjectureMachines.Halts M` +- `paZFInconsistent_holds_iff_zfInconsistent`: `paZFInconsistent.Holds v ↔ ZFInconsistent` + +Both equivalences are proved **constructively** without `Classical.choice` (verified by +`leanprover/comparator` under `comparator/constructive.json`). +-/ + +@[expose] public section + +namespace ConjectureMachines + +/-- Evaluate a symbolic `PAZFTerm` in `ℕ` under assignment `v`. -/ +def PAZFTerm.eval (v : ℕ → ℕ) : PAZFTerm → ℕ + | .var x => v x + | .const n => n + | .pair a b => cantorPair (a.eval v) (b.eval v) + +/-- Smallest variable index strictly greater than every variable in a `PAZFTerm`. -/ +def PAZFTerm.freshVar : PAZFTerm → ℕ + | .var x => x + 1 + | .const _ => 0 + | .pair a b => max a.freshVar b.freshVar + +end ConjectureMachines + +namespace ConjectureMachines.Semantics.PA + +attribute [-simp] Nat.add_eq_right Nat.left_eq_add Nat.right_eq_add + Order.add_one_le_iff Order.lt_add_one_iff Function.update_idem + +@[simp high] private theorem nat_add_eq_right {n m : ℕ} : n + m = n ↔ m = 0 := by + constructor <;> intro h <;> omega + +@[simp high] private theorem nat_left_eq_add {n m : ℕ} : n = n + m ↔ m = 0 := by + constructor <;> intro h <;> omega + +@[simp high] private theorem nat_right_eq_add {n m : ℕ} : n = m + n ↔ m = 0 := by + constructor <;> intro h <;> omega + +/-! ## Section 1: Basic Standard-Model Evaluation and Arithmetic Gadgets -/ + +@[simp] +theorem eval_ofNat (v : ℕ → ℕ) (n : ℕ) : (PATerm.ofNat n).eval v = n := by + induction n with + | zero => rfl + | succ _ ih => exact congrArg (· + 1) ih + +theorem eval_update_of_freshVar_le (v : ℕ → ℕ) {t : PATerm} {x : ℕ} (a : ℕ) + (h : t.freshVar ≤ x) : t.eval (Function.update v x a) = t.eval v := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_update_of_hasVar_false v a (hasVar_false_of_freshVar_le h) + +theorem paLe_holds_iff (v : ℕ → ℕ) (a b : PATerm) : + (paLe a b).Holds v ↔ a.eval v ≤ b.eval v := by + unfold paLe + set k := max a.freshVar b.freshVar + have ha : a.freshVar ≤ k := Nat.le_max_left _ _ + have hb : b.freshVar ≤ k := Nat.le_max_right _ _ + simp only [PAFormula.Holds, PATerm.eval, eval_update_of_freshVar_le v _ ha, + eval_update_of_freshVar_le v _ hb, Function.update_self] + exact ⟨fun ⟨w, hw⟩ ↦ Nat.le.intro hw, fun h ↦ ⟨b.eval v - a.eval v, Nat.add_sub_of_le h⟩⟩ + +theorem paLt_holds_iff (v : ℕ → ℕ) (a b : PATerm) : + (paLt a b).Holds v ↔ a.eval v < b.eval v := by + unfold paLt + rw [paLe_holds_iff] + rfl + +private theorem two_dvd_mul_succ (n : ℕ) : 2 ∣ n * (n + 1) := by + induction n with + | zero => exact ⟨0, rfl⟩ + | succ n ih => + obtain ⟨k, hk⟩ := ih + refine ⟨k + (n + 1), ?_⟩ + calc (n + 1) * (n + 2) + _ = (n + 1) * n + (n + 1) * 2 := Nat.mul_add (n + 1) n 2 + _ = n * (n + 1) + 2 * (n + 1) := by rw [Nat.mul_comm (n + 1) n, Nat.mul_comm (n + 1) 2] + _ = 2 * (k + (n + 1)) := by omega + +theorem paCantorPairEq_holds_iff (v : ℕ → ℕ) (x y z : PATerm) : + (paCantorPairEq x y z).Holds v ↔ z.eval v = cantorPair (x.eval v) (y.eval v) := by + unfold paCantorPairEq cantorPair + simp only [PAFormula.Holds, PATerm.eval, eval_ofNat] + obtain ⟨k, hk⟩ := two_dvd_mul_succ (x.eval v + y.eval v) + rw [hk, Nat.mul_div_right k (by decide : 0 < 2)] + constructor <;> intro h <;> omega + +theorem paBetaEq_holds_iff (v : ℕ → ℕ) (c d i r : PATerm) : + (paBetaEq c d i r).Holds v ↔ + c.eval v % (1 + (i.eval v + 1) * d.eval v) = r.eval v := by + let m := PATerm.succ (.mul (.succ i) d) + let q := max (max c.freshVar m.freshVar) r.freshVar + have hc : c.freshVar ≤ q := le_trans (Nat.le_max_left _ _) (Nat.le_max_left _ _) + have hm : m.freshVar ≤ q := le_trans (Nat.le_max_right _ _) (Nat.le_max_left _ _) + have hr : r.freshVar ≤ q := Nat.le_max_right _ _ + have hmev : m.eval v = 1 + (i.eval v + 1) * d.eval v := by + simp only [m, PATerm.eval] + omega + change (PAFormula.ex q (.and (.eq c (.add (.mul (.var q) m) r)) (paLt r m))).Holds v ↔ _ + simp only [PAFormula.Holds, paLt_holds_iff, PATerm.eval] + set mod := 1 + (i.eval v + 1) * d.eval v + have hpos : 0 < mod := by omega + constructor + · rintro ⟨w, hcw, hrlt⟩ + rw [eval_update_of_freshVar_le v w hc, eval_update_of_freshVar_le v w hm, + eval_update_of_freshVar_le v w hr, Function.update_self, hmev] at hcw + rw [eval_update_of_freshVar_le v w hr, eval_update_of_freshVar_le v w hm, hmev] at hrlt + have hcw' : c.eval v = r.eval v + mod * w := by + rw [hcw, Nat.mul_comm w mod, Nat.add_comm] + rw [hcw', Nat.add_mul_mod_self_left, Nat.mod_eq_of_lt hrlt] + · intro hrem + refine ⟨c.eval v / mod, ?_, ?_⟩ + · rw [eval_update_of_freshVar_le v _ hc, eval_update_of_freshVar_le v _ hm, + eval_update_of_freshVar_le v _ hr, Function.update_self, hmev, ← hrem, + Nat.mul_comm _ mod] + exact (Nat.div_add_mod (c.eval v) mod).symm + · rw [eval_update_of_freshVar_le v _ hr, eval_update_of_freshVar_le v _ hm, hmev, ← hrem] + exact Nat.mod_lt _ hpos + +theorem paDisjList_holds_iff (v : ℕ → ℕ) (L : List PAFormula) : + (paDisjList L).Holds v ↔ ∃ φ ∈ L, φ.Holds v := by + match L with + | [] => + simp [paDisjList, PAFormula.Holds] + | [φ] => + simp [paDisjList] + | φ :: ψ :: rest => + simp only [paDisjList, PAFormula.Holds, paDisjList_holds_iff v (ψ :: rest), List.mem_cons, + exists_eq_or_imp] + +/-! ## Section 2: Cantor Pairing Injectivity and Symbolic `PAZFTerm` Evaluation -/ + +/-- Constructive injectivity of `cantorPair`. -/ +theorem cantorPair_injective {x₁ y₁ x₂ y₂ : ℕ} + (h : cantorPair x₁ y₁ = cantorPair x₂ y₂) : x₁ = x₂ ∧ y₁ = y₂ := by + obtain ⟨k₁, hk₁⟩ := two_dvd_mul_succ (x₁ + y₁) + obtain ⟨k₂, hk₂⟩ := two_dvd_mul_succ (x₂ + y₂) + have h2 : 2 * x₁ + (x₁ + y₁) * (x₁ + y₁ + 1) = 2 * x₂ + (x₂ + y₂) * (x₂ + y₂ + 1) := by + unfold cantorPair at h + rw [hk₁, hk₂, Nat.mul_div_right _ (by decide : 0 < 2), + Nat.mul_div_right _ (by decide : 0 < 2)] at h + rw [hk₁, hk₂] + omega + have hnotlt : ∀ {a₁ b₁ a₂ b₂ : ℕ}, + 2 * a₁ + (a₁ + b₁) * (a₁ + b₁ + 1) = 2 * a₂ + (a₂ + b₂) * (a₂ + b₂ + 1) → + ¬ (a₁ + b₁ < a₂ + b₂) := by + intro a₁ b₁ a₂ b₂ heq hlt + have hle : (a₁ + b₁ + 1) * (a₁ + b₁ + 2) ≤ (a₂ + b₂) * (a₂ + b₂ + 1) := + Nat.mul_le_mul hlt (Nat.succ_le_succ hlt) + have hexp : (a₁ + b₁ + 1) * (a₁ + b₁ + 2) = + (a₁ + b₁) * (a₁ + b₁ + 1) + 2 * (a₁ + b₁) + 2 := by + calc (a₁ + b₁ + 1) * (a₁ + b₁ + 2) + _ = (a₁ + b₁) * (a₁ + b₁ + 2) + (a₁ + b₁ + 2) := Nat.succ_mul _ _ + _ = (a₁ + b₁) * (a₁ + b₁ + 1) + (a₁ + b₁) + (a₁ + b₁ + 2) := by + rw [Nat.mul_succ] + _ = (a₁ + b₁) * (a₁ + b₁ + 1) + 2 * (a₁ + b₁) + 2 := by omega + omega + have hs1 : ¬ (x₁ + y₁ < x₂ + y₂) := hnotlt h2 + have hs2 : ¬ (x₂ + y₂ < x₁ + y₁) := hnotlt h2.symm + have hs : x₁ + y₁ = x₂ + y₂ := by omega + rw [hs] at h2 + exact ⟨by omega, by omega⟩ + +theorem PAZFTerm.eval_congr {v₁ v₂ : ℕ → ℕ} {e : PAZFTerm} + (h : ∀ x < e.freshVar, v₁ x = v₂ x) : e.eval v₁ = e.eval v₂ := by + induction e with + | var x => exact h x (Nat.lt_succ_self x) + | const _ => rfl + | pair a b iha ihb => + refine congrArg₂ cantorPair (iha fun x hx ↦ h x ?_) (ihb fun x hx ↦ h x ?_) + · exact lt_of_lt_of_le hx (Nat.le_max_left _ _) + · exact lt_of_lt_of_le hx (Nat.le_max_right _ _) + +theorem PAZFTerm.eval_update_fresh (v : ℕ → ℕ) {e : PAZFTerm} {x : ℕ} (a : ℕ) + (h : e.freshVar ≤ x) : e.eval (Function.update v x a) = e.eval v := + PAZFTerm.eval_congr fun y hy ↦ Function.update_of_ne (by omega) a v + +theorem PAZFTerm.eqFormula_holds_iff (e : PAZFTerm) (out : PATerm) (base : ℕ) (v : ℕ → ℕ) + (he : e.freshVar ≤ base) (hout : out.freshVar ≤ base) : + (e.eqFormula out base).Holds v ↔ out.eval v = e.eval v := by + induction e generalizing out base v with + | var x => + simp [PAZFTerm.eqFormula, PAFormula.Holds, PATerm.eval, PAZFTerm.eval] + | const n => + simp [PAZFTerm.eqFormula, PAFormula.Holds, PAZFTerm.eval] + | pair a b iha ihb => + simp only [PAZFTerm.freshVar, Nat.max_le] at he + rcases he with ⟨ha, hb⟩ + simp only [PAZFTerm.eqFormula, PAFormula.Holds] + constructor + · rintro ⟨va, vb, hpair, haeq, hbeq⟩ + set v' := Function.update (Function.update v base va) (base + 1) vb + have hv_base : v' base = va := by simp [v'] + have hv_base1 : v' (base + 1) = vb := by simp [v'] + have hout_eq : out.eval v' = out.eval v := by + dsimp only [v'] + rw [eval_update_of_freshVar_le _ _ (by omega), eval_update_of_freshVar_le _ _ hout] + have hpair' : out.eval v = cantorPair va vb := by + have hp := (paCantorPairEq_holds_iff v' (.var base) (.var (base + 1)) out).mp hpair + simpa [PATerm.eval, hv_base, hv_base1, hout_eq] using hp + have ha' : va = a.eval v := by + have h1 := (iha (.var base) (base + 2) v' (by omega) + (by simp [PATerm.freshVar])).mp haeq + dsimp only [v'] at h1 + rw [PATerm.eval, PAZFTerm.eval_update_fresh _ _ (by omega), + PAZFTerm.eval_update_fresh _ _ ha] at h1 + simpa [Function.update_of_ne (by omega : base ≠ base + 1)] using h1 + have hb' : vb = b.eval v := by + have h2 := (ihb (.var (base + 1)) (base + 2 + a.numVars) v' (by omega) + (by simp [PATerm.freshVar]; omega)).mp hbeq + dsimp only [v'] at h2 + rw [PATerm.eval, PAZFTerm.eval_update_fresh _ _ (by omega), + PAZFTerm.eval_update_fresh _ _ hb] at h2 + simpa using h2 + rw [hpair', ha', hb', PAZFTerm.eval] + · intro heq + refine ⟨a.eval v, b.eval v, ?_⟩ + set v' := Function.update (Function.update v base (a.eval v)) (base + 1) (b.eval v) + have hv_base : v' base = a.eval v := by simp [v'] + have hv_base1 : v' (base + 1) = b.eval v := by simp [v'] + have hout_eq : out.eval v' = out.eval v := by + dsimp only [v'] + rw [eval_update_of_freshVar_le _ _ (by omega), eval_update_of_freshVar_le _ _ hout] + refine ⟨?_, ?_, ?_⟩ + · rw [paCantorPairEq_holds_iff] + simp only [PATerm.eval, hv_base, hv_base1, hout_eq] + exact heq + · rw [iha (.var base) (base + 2) v' (by omega) (by simp [PATerm.freshVar])] + rw [PATerm.eval, hv_base] + dsimp only [v'] + rw [PAZFTerm.eval_update_fresh _ _ (by omega), + PAZFTerm.eval_update_fresh _ _ ha] + · rw [ihb (.var (base + 1)) (base + 2 + a.numVars) v' (by omega) + (by simp [PATerm.freshVar]; omega)] + rw [PATerm.eval, hv_base1] + dsimp only [v'] + rw [PAZFTerm.eval_update_fresh _ _ (by omega), + PAZFTerm.eval_update_fresh _ _ hb] + +/-! ## Section 3: Constructive Gödel $\beta$-Lemma in `ℕ` -/ + +private def maxElem : List ℕ → ℕ + | [] => 0 + | x :: xs => max x (maxElem xs) + +private theorem getElem_le_maxElem (L : List ℕ) : + ∀ (i : ℕ) (hi : i < L.length), L[i] ≤ maxElem L := by + induction L with + | nil => intro _ hi; cases hi + | cons x xs ih => + intro i hi + cases i with + | zero => exact Nat.le_max_left x (maxElem xs) + | succ j => + exact le_trans (ih j (Nat.lt_of_succ_lt_succ hi)) (Nat.le_max_right x (maxElem xs)) + +private theorem beta_moduli_coprime {d i j : ℕ} (hij : i < j) (hd : j - i ∣ d) : + Nat.Coprime (1 + (i + 1) * d) (1 + (j + 1) * d) := by + set si := 1 + (i + 1) * d + set sj := 1 + (j + 1) * d + set g := Nat.gcd si sj + have hid : (i + 1) * sj + (j - i) = (j + 1) * si := by + have hmul : (i + 1) * ((j + 1) * d) = (j + 1) * ((i + 1) * d) := by + rw [← Nat.mul_assoc, Nat.mul_comm (i + 1) (j + 1), Nat.mul_assoc] + calc (i + 1) * (1 + (j + 1) * d) + (j - i) + _ = (i + 1) + (i + 1) * ((j + 1) * d) + (j - i) := by rw [Nat.mul_add, Nat.mul_one] + _ = (j + 1) + (j + 1) * ((i + 1) * d) := by rw [hmul]; omega + _ = (j + 1) * (1 + (i + 1) * d) := by rw [Nat.mul_add, Nat.mul_one] + have hg1 : g ∣ (j + 1) * si := dvd_mul_of_dvd_right (Nat.gcd_dvd_left si sj) (j + 1) + have hg2 : g ∣ (i + 1) * sj := dvd_mul_of_dvd_right (Nat.gcd_dvd_right si sj) (i + 1) + have hg_sub : g ∣ j - i := (Nat.dvd_add_right hg2).mp (hid.symm ▸ hg1) + have hg_d : g ∣ d := dvd_trans hg_sub hd + have hg_mul : g ∣ (i + 1) * d := dvd_mul_of_dvd_right hg_d (i + 1) + have hg_si : g ∣ (i + 1) * d + 1 := by + simpa [si, Nat.add_comm] using Nat.gcd_dvd_left si sj + have hg_one : g ∣ 1 := (Nat.dvd_add_right hg_mul).mp hg_si + exact Nat.dvd_one.mp hg_one + +private theorem crt2_constructive {m₁ m₂ : ℕ} (hm₁ : 0 < m₁) (hm₂ : 0 < m₂) + (hco : Nat.Coprime m₁ m₂) (r₁ r₂ : ℕ) : + ∃ x : ℕ, x % m₁ = r₁ % m₁ ∧ x % m₂ = r₂ % m₂ := by + let A : ℤ := Nat.gcdA m₁ m₂ + let B : ℤ := Nat.gcdB m₁ m₂ + have hbz : (m₁ : ℤ) * A + (m₂ : ℤ) * B = 1 := by + have hg := Nat.gcd_eq_gcd_ab m₁ m₂ + rw [hco.gcd_eq_one] at hg + simpa [A, B] using hg.symm + let M : ℕ := m₁ * m₂ + have hM_pos : (0 : ℤ) < (M : ℤ) := Int.natCast_pos.mpr (Nat.mul_pos hm₁ hm₂) + let z : ℤ := (r₁ : ℤ) + (m₁ : ℤ) * (((r₂ : ℤ) - (r₁ : ℤ)) * A) + have hz2 : z = (r₂ : ℤ) + (m₂ : ℤ) * (((r₁ : ℤ) - (r₂ : ℤ)) * B) := by + have h1 : (m₁ : ℤ) * A = 1 - (m₂ : ℤ) * B := by omega + calc z + _ = (r₁ : ℤ) + ((r₂ : ℤ) - (r₁ : ℤ)) * ((m₁ : ℤ) * A) := by + simp only [z] + rw [← Int.mul_assoc, Int.mul_comm (m₁ : ℤ) ((r₂ : ℤ) - (r₁ : ℤ)), Int.mul_assoc] + _ = (r₁ : ℤ) + ((r₂ : ℤ) - (r₁ : ℤ)) * (1 - (m₂ : ℤ) * B) := by rw [h1] + _ = (r₂ : ℤ) + (m₂ : ℤ) * (((r₁ : ℤ) - (r₂ : ℤ)) * B) := by + rw [Int.mul_sub, Int.mul_one, ← Int.mul_assoc, + Int.mul_comm ((r₂ : ℤ) - (r₁ : ℤ)) (m₂ : ℤ), Int.mul_assoc] + have hsub : -((m₂ : ℤ) * (((r₂ : ℤ) - (r₁ : ℤ)) * B)) = + (m₂ : ℤ) * (((r₁ : ℤ) - (r₂ : ℤ)) * B) := by + rw [← Int.mul_neg, ← Int.neg_mul, Int.neg_sub] + omega + let z' : ℤ := z % (M : ℤ) + have hz'_nonneg : 0 ≤ z' := Int.emod_nonneg z (ne_of_gt hM_pos) + let x : ℕ := z'.toNat + have hx_cast : (x : ℤ) = z' := Int.toNat_of_nonneg hz'_nonneg + refine ⟨x, ?_, ?_⟩ + · apply Int.natCast_inj.mp + rw [Int.natCast_emod, Int.natCast_emod, hx_cast] + have hdvd1 : (m₁ : ℤ) ∣ (M : ℤ) := ⟨(m₂ : ℤ), by simp [M]⟩ + rw [Int.emod_emod_of_dvd z hdvd1] + exact Int.add_mul_emod_self_left (r₁ : ℤ) (m₁ : ℤ) (((r₂ : ℤ) - (r₁ : ℤ)) * A) + · apply Int.natCast_inj.mp + rw [Int.natCast_emod, Int.natCast_emod, hx_cast] + have hdvd2 : (m₂ : ℤ) ∣ (M : ℤ) := ⟨(m₁ : ℤ), by simp [M, Int.mul_comm]⟩ + rw [Int.emod_emod_of_dvd z hdvd2, hz2] + exact Int.add_mul_emod_self_left (r₂ : ℤ) (m₂ : ℤ) (((r₁ : ℤ) - (r₂ : ℤ)) * B) + +/-- Constructive Gödel $\beta$-sequence lemma: every finite sequence `L : List ℕ` is represented +by a pair `(c, d)` via $L_i = c \bmod (1 + (i + 1) d)$. -/ +theorem exists_beta_nat (L : List ℕ) : + ∃ c d : ℕ, ∀ (i : ℕ) (hi : i < L.length), c % (1 + (i + 1) * d) = L[i] := by + let B := max (maxElem L) L.length + 1 + let d := B.factorial + let s : ℕ → ℕ := fun i ↦ 1 + (i + 1) * d + have hs_pos : ∀ i, 0 < s i := fun i ↦ by dsimp only [s]; omega + have hco : ∀ i < L.length, ∀ j < L.length, i ≠ j → Nat.Coprime (s i) (s j) := by + intro i hi j hj hij + rcases Nat.lt_trichotomy i j with hlt | rfl | hgt + · refine beta_moduli_coprime hlt (Nat.dvd_factorial (by omega) ?_) + have hB : L.length < B := by simp [B] + omega + · exact absurd rfl hij + · refine Nat.coprime_comm.mp (beta_moduli_coprime hgt (Nat.dvd_factorial (by omega) ?_)) + have hB : L.length < B := by simp [B] + omega + have hstep : ∀ k (hkle : k ≤ L.length), ∃ c P : ℕ, 0 < P ∧ + (∀ i < k, s i ∣ P) ∧ + (∀ m, (∀ i < k, Nat.Coprime (s i) m) → Nat.Coprime P m) ∧ + (∀ (i : ℕ) (hi : i < k), c % s i = L[i]'(lt_of_lt_of_le hi hkle)) := by + intro k + induction k with + | zero => + intro _ + refine ⟨0, 1, Nat.one_pos, fun _ hi ↦ absurd hi (Nat.not_lt_zero _), + fun _ _ ↦ Nat.coprime_one_left _, fun _ hi ↦ absurd hi (Nat.not_lt_zero _)⟩ + | succ k ih => + intro hkle + have hklt : k < L.length := hkle + obtain ⟨c₀, P₀, hP₀_pos, hdvd₀, hcop₀, hmod₀⟩ := ih (Nat.le_of_lt hklt) + have hcop_sk : Nat.Coprime P₀ (s k) := + hcop₀ (s k) fun i hi ↦ hco i (lt_trans hi hklt) k hklt (Nat.ne_of_lt hi) + obtain ⟨c, hc1, hc2⟩ := crt2_constructive hP₀_pos (hs_pos k) hcop_sk c₀ (L[k]'hklt) + refine ⟨c, P₀ * s k, Nat.mul_pos hP₀_pos (hs_pos k), ?_, ?_, ?_⟩ + · intro i hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hilt | rfl + · exact dvd_mul_of_dvd_left (hdvd₀ i hilt) (s k) + · exact dvd_mul_left (s i) P₀ + · intro m hm + exact Nat.Coprime.mul_left + (hcop₀ m fun i hi ↦ hm i (Nat.lt_succ_of_lt hi)) + (hm k (Nat.lt_succ_self k)) + · intro i hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hilt | rfl + · have hsi_dvd : s i ∣ P₀ := hdvd₀ i hilt + rw [← Nat.mod_mod_of_dvd c hsi_dvd, hc1, Nat.mod_mod_of_dvd c₀ hsi_dvd] + exact hmod₀ i hilt + · have hlt_s : L[i]'hklt < s i := by + have hle1 : L[i]'hklt ≤ maxElem L := getElem_le_maxElem L i hklt + have hltB : L[i]'hklt < B := by simp [B]; omega + have hB_le_d : B ≤ d := Nat.self_le_factorial B + have hd_le : d ≤ (i + 1) * d := Nat.le_mul_of_pos_left d (Nat.succ_pos i) + dsimp only [s] + omega + rw [hc2, Nat.mod_eq_of_lt hlt_s] + obtain ⟨c, _, _, _, _, hc⟩ := hstep L.length (Nat.le_refl _) + exact ⟨c, d, hc⟩ + +/-! ## Section 4: Binary Half-Tape Bijection and Adequacy of `paHalts` -/ + +/-- Little-endian binary encoding of a `List (Fin 2)` that ignores trailing `0` blanks. -/ +def encodeListBin : List (Fin 2) → ℕ + | [] => 0 + | a :: xs => 2 * encodeListBin xs + a.val + +private theorem encodeListBin_replicate_default (k : ℕ) : + encodeListBin (List.replicate k (default : Fin 2)) = 0 := by + induction k with + | zero => rfl + | succ k ih => + simp only [List.replicate_succ, encodeListBin, ih] + rfl + +private theorem encodeListBin_append_replicate (xs : List (Fin 2)) (k : ℕ) : + encodeListBin (xs ++ List.replicate k (default : Fin 2)) = encodeListBin xs := by + induction xs with + | nil => simp only [List.nil_append, encodeListBin_replicate_default, encodeListBin] + | cons a xs ih => simp only [List.cons_append, encodeListBin, ih] + +/-- Constructive binary encoding of a `ListBlank (Fin 2)` half-tape as a natural number. -/ +def encodeHalf (l : ListBlank (Fin 2)) : ℕ := + l.liftOn encodeListBin fun xs _ ⟨k, hk⟩ ↦ by + subst hk + exact (encodeListBin_append_replicate xs k).symm + +/-- Inverse binary decoding from `ℕ` to `List (Fin 2)`. -/ +def decodeListBin : ℕ → List (Fin 2) + | 0 => [] + | n + 1 => ⟨(n + 1) % 2, Nat.mod_lt _ (by decide)⟩ :: decodeListBin ((n + 1) / 2) + +/-- Constructive binary decoding from `ℕ` to `ListBlank (Fin 2)`. -/ +def decodeHalf (n : ℕ) : ListBlank (Fin 2) := + ListBlank.mk (decodeListBin n) + +@[simp] +theorem encodeHalf_mk (xs : List (Fin 2)) : encodeHalf (ListBlank.mk xs) = encodeListBin xs := + rfl + +@[simp] +theorem encodeHalf_default : encodeHalf default = 0 := rfl + +@[simp] +theorem encodeHalf_cons (l : ListBlank (Fin 2)) (a : Fin 2) : + encodeHalf (l.cons a) = 2 * encodeHalf l + a.val := + l.induction_on fun _ ↦ rfl + +theorem encodeHalf_eq_tail_head (l : ListBlank (Fin 2)) : + encodeHalf l = 2 * encodeHalf l.tail + l.head.val := by + conv_lhs => rw [← ListBlank.cons_head_tail l] + exact encodeHalf_cons l.tail l.head + +private theorem encodeListBin_decodeListBin (n : ℕ) : encodeListBin (decodeListBin n) = n := by + induction n using Nat.strongRecOn with + | ind n ih => + cases n with + | zero => simp [decodeListBin, encodeListBin] + | succ m => + simp only [decodeListBin, encodeListBin] + have hrec := ih ((m + 1) / 2) (Nat.div_lt_self (Nat.succ_pos m) (by decide)) + rw [hrec] + omega + +@[simp] +theorem encodeHalf_decodeHalf (n : ℕ) : encodeHalf (decodeHalf n) = n := + encodeListBin_decodeListBin n + +private theorem mk_decodeListBin_encodeListBin (xs : List (Fin 2)) : + ListBlank.mk (decodeListBin (encodeListBin xs)) = ListBlank.mk xs := by + induction xs with + | nil => simp [encodeListBin, decodeListBin] + | cons a xs ih => + simp only [encodeListBin] + rcases Decidable.eq_or_ne (2 * encodeListBin xs + a.val) 0 with h0 | hne + · have hxs0 : encodeListBin xs = 0 := by omega + have ha0 : a = default := by + ext + change a.val = 0 + omega + have hd0 : decodeListBin 0 = [] := by simp [decodeListBin] + rw [h0, ha0, hd0] + rw [hxs0, hd0] at ih + have hcons : ListBlank.mk ((default : Fin 2) :: xs) = + (ListBlank.mk xs).cons default := rfl + rw [hcons, ← ih] + exact Quot.sound (Or.inl ⟨1, rfl⟩) + · obtain ⟨k, hk⟩ := Nat.exists_eq_succ_of_ne_zero hne + rw [hk, decodeListBin] + have hdiv : (k + 1) / 2 = encodeListBin xs := by + have := a.isLt + omega + have hmod : (⟨(k + 1) % 2, Nat.mod_lt _ (by decide)⟩ : Fin 2) = a := by + ext + have := a.isLt + change (k + 1) % 2 = a.val + omega + rw [hdiv, hmod, ← ListBlank.cons_mk, ih, ListBlank.cons_mk] + +@[simp] +theorem decodeHalf_encodeHalf (l : ListBlank (Fin 2)) : decodeHalf (encodeHalf l) = l := + l.induction_on mk_decodeListBin_encodeListBin + +theorem encodeHalf_injective {l₁ l₂ : ListBlank (Fin 2)} (h : encodeHalf l₁ = encodeHalf l₂) : + l₁ = l₂ := by + rw [← decodeHalf_encodeHalf l₁, ← decodeHalf_encodeHalf l₂, h] + +/-- Nested Cantor configuration code `(q, (h, (L, R)))` of a binary Turing machine configuration. -/ +def encodeCfg {states : ℕ} (c : Cfg states 2) : ℕ := + cantorPair c.state.val + (cantorPair c.tape.head.val + (cantorPair (encodeHalf c.tape.left) (encodeHalf c.tape.right))) + +theorem encodeCfg_init {states : ℕ} [NeZero states] : + encodeCfg (init : Cfg states 2) = 0 := by + have hq : (0 : Fin states).val = 0 := Fin.val_zero states + have hh : (Tape.mk₁ ([] : List (Fin 2))).head.val = 0 := rfl + have hl : encodeHalf (Tape.mk₁ ([] : List (Fin 2))).left = 0 := rfl + have hr : encodeHalf (Tape.mk₁ ([] : List (Fin 2))).right = 0 := rfl + simp only [encodeCfg, init, hq, hh, hl, hr] + rfl + +theorem encodeCfg_injective {states : ℕ} {c₁ c₂ : Cfg states 2} + (h : encodeCfg c₁ = encodeCfg c₂) : c₁ = c₂ := by + obtain ⟨hq, h1⟩ := cantorPair_injective h + obtain ⟨hh, h2⟩ := cantorPair_injective h1 + obtain ⟨hl, hr⟩ := cantorPair_injective h2 + rcases c₁ with ⟨q₁, h₁, L₁, R₁⟩ + rcases c₂ with ⟨q₂, h₂, L₂, R₂⟩ + congr 1 + · exact Fin.ext hq + · congr 1 + · exact Fin.ext hh + · exact encodeHalf_injective hl + · exact encodeHalf_injective hr + +private theorem pzPackCfg_eval (v : ℕ → ℕ) (q h : ℕ) (L R : PAZFTerm) : + (pzPackCfg q h L R).eval v = cantorPair q (cantorPair h (cantorPair (L.eval v) (R.eval v))) := + rfl + +private theorem pzPackCfg_freshVar_le (q h : ℕ) (x y : ℕ) (hx : x < 10) (hy : y < 10) : + (pzPackCfg q h (.var x) (.var y)).freshVar ≤ 10 := by + simp only [pzPackCfg, PAZFTerm.freshVar] + omega + +theorem paStep_holds_iff {states : ℕ} (M : Machine states 2) (v : ℕ → ℕ) : + (paStep M).Holds v ↔ + ∃ c c' : Cfg states 2, v 4 = encodeCfg c ∧ v 5 = encodeCfg c' ∧ step M c = some c' := by + unfold paStep + rw [paDisjList_holds_iff] + simp only [List.mem_flatMap] + constructor + · rintro ⟨φ, ⟨q, _, h, _, hmem⟩, hholds⟩ + cases htr : M.transition q h with + | none => + rw [htr] at hmem + cases hmem + | some val => + rcases val with ⟨w, d, q'⟩ + cases d with + | left => + rw [htr, List.mem_map] at hmem + rcases hmem with ⟨h', hh'mem, rfl⟩ + have hh'lt : h' < 2 := by simp at hh'mem; omega + let hFin : Fin 2 := ⟨h', hh'lt⟩ + simp only [PAFormula.Holds] at hholds + rcases hholds with ⟨n6, n7, n8, n9, hc_eq, hc'_eq, hn6, hn9⟩ + set v' := Function.update (Function.update + (Function.update (Function.update v 6 n6) 7 n7) 8 n8) 9 n9 + have hv4 : v' 4 = v 4 := by simp [v'] + have hv5 : v' 5 = v 5 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + have hv8 : v' 8 = n8 := by simp [v'] + have hv9 : v' 9 = n9 := by simp [v'] + have e1 := (PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) + (by decide)).mp hc_eq + have e2 := (PAZFTerm.eqFormula_holds_iff _ (.var 5) 10 v' + (pzPackCfg_freshVar_le q'.val h' 8 9 (by decide) (by decide)) + (by decide)).mp hc'_eq + simp only [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, eval_ofNat, + hv4, hv5, hv6, hv7, hv8, hv9] at e1 e2 hn6 hn9 + let L' := decodeHalf n8 + let R := decodeHalf n7 + let L := L'.cons hFin + have hL_enc : encodeHalf L = n6 := by + simp [L, L', hFin, hn6] + have hR_enc : encodeHalf R = n7 := encodeHalf_decodeHalf n7 + let c : Cfg states 2 := ⟨q, ⟨h, L, R⟩⟩ + let c' : Cfg states 2 := ⟨q', ⟨hFin, L', R.cons w⟩⟩ + refine ⟨c, c', ?_, ?_, ?_⟩ + · simp [encodeCfg, c, hL_enc, hR_enc, e1] + · have hRw : encodeHalf (R.cons w) = n9 := by simp [R, hn9] + simp [encodeCfg, c', L', hFin, hRw, e2] + · simp [step, c, c', htr, Tape.write, Tape.move, L] + | right => + rw [htr, List.mem_map] at hmem + rcases hmem with ⟨h', hh'mem, rfl⟩ + have hh'lt : h' < 2 := by simp at hh'mem; omega + let hFin : Fin 2 := ⟨h', hh'lt⟩ + simp only [PAFormula.Holds] at hholds + rcases hholds with ⟨n6, n7, n8, n9, hc_eq, hc'_eq, hn8, hn7⟩ + set v' := Function.update (Function.update + (Function.update (Function.update v 6 n6) 7 n7) 8 n8) 9 n9 + have hv4 : v' 4 = v 4 := by simp [v'] + have hv5 : v' 5 = v 5 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + have hv8 : v' 8 = n8 := by simp [v'] + have hv9 : v' 9 = n9 := by simp [v'] + have e1 := (PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) + (by decide)).mp hc_eq + have e2 := (PAZFTerm.eqFormula_holds_iff _ (.var 5) 10 v' + (pzPackCfg_freshVar_le q'.val h' 8 9 (by decide) (by decide)) + (by decide)).mp hc'_eq + simp only [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, eval_ofNat, + hv4, hv5, hv6, hv7, hv8, hv9] at e1 e2 hn8 hn7 + let L := decodeHalf n6 + let R' := decodeHalf n9 + let R := R'.cons hFin + have hL_enc : encodeHalf L = n6 := encodeHalf_decodeHalf n6 + have hR_enc : encodeHalf R = n7 := by + simp [R, R', hFin, hn7] + let c : Cfg states 2 := ⟨q, ⟨h, L, R⟩⟩ + let c' : Cfg states 2 := ⟨q', ⟨hFin, L.cons w, R'⟩⟩ + refine ⟨c, c', ?_, ?_, ?_⟩ + · simp [encodeCfg, c, hL_enc, hR_enc, e1] + · have hLw : encodeHalf (L.cons w) = n8 := by simp [L, hn8] + simp [encodeCfg, c', R', hFin, hLw, e2] + · simp [step, c, c', htr, Tape.write, Tape.move, R] + · rintro ⟨⟨q, ⟨h, L, R⟩⟩, c', hv4, hv5, hstep⟩ + simp only [step] at hstep + cases htr : M.transition q h with + | none => simp [htr] at hstep + | some val => + rcases val with ⟨w, d, q'⟩ + rw [htr, Option.map_some, Option.some.injEq] at hstep + subst hstep + cases d with + | left => + let h' := L.head.val + have hh'mem : h' ∈ ([0, 1] : List ℕ) := by + have := L.head.isLt + simp only [List.mem_cons, List.not_mem_nil, or_false] + omega + let φ := PAFormula.ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 6) (.add (.mul (.ofNat 2) (.var 8)) (.ofNat h'))) + (.eq (.var 9) (.add (.mul (.ofNat 2) (.var 7)) (.ofNat w.val))))))))) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · rw [htr, List.mem_map] + exact ⟨h', hh'mem, rfl⟩ + · simp only [φ, PAFormula.Holds] + refine ⟨encodeHalf L, encodeHalf R, encodeHalf L.tail, encodeHalf (R.cons w), ?_⟩ + set v' := Function.update (Function.update (Function.update + (Function.update v 6 (encodeHalf L)) 7 (encodeHalf R)) + 8 (encodeHalf L.tail)) 9 (encodeHalf (R.cons w)) + have hv4' : v' 4 = v 4 := by simp [v'] + have hv5' : v' 5 = v 5 := by simp [v'] + have hv6' : v' 6 = encodeHalf L := by simp [v'] + have hv7' : v' 7 = encodeHalf R := by simp [v'] + have hv8' : v' 8 = encodeHalf L.tail := by simp [v'] + have hv9' : v' 9 = encodeHalf (R.cons w) := by simp [v'] + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv4', hv6', hv7', hv4, encodeCfg] + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 5) 10 v' + (pzPackCfg_freshVar_le q'.val h' 8 9 (by decide) (by decide)) (by decide)] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv5', hv8', hv9', hv5, encodeCfg, + Tape.write, Tape.move, h'] + · simp only [PATerm.eval, eval_ofNat, hv6', hv8', h'] + exact encodeHalf_eq_tail_head L + · simp only [PATerm.eval, eval_ofNat, hv7', hv9'] + exact encodeHalf_cons R w + | right => + let h' := R.head.val + have hh'mem : h' ∈ ([0, 1] : List ℕ) := by + have := R.head.isLt + simp only [List.mem_cons, List.not_mem_nil, or_false] + omega + let φ := PAFormula.ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 8) (.add (.mul (.ofNat 2) (.var 6)) (.ofNat w.val))) + (.eq (.var 7) (.add (.mul (.ofNat 2) (.var 9)) (.ofNat h'))))))))) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · rw [htr, List.mem_map] + exact ⟨h', hh'mem, rfl⟩ + · simp only [φ, PAFormula.Holds] + refine ⟨encodeHalf L, encodeHalf R, encodeHalf (L.cons w), encodeHalf R.tail, ?_⟩ + set v' := Function.update (Function.update (Function.update + (Function.update v 6 (encodeHalf L)) 7 (encodeHalf R)) + 8 (encodeHalf (L.cons w))) 9 (encodeHalf R.tail) + have hv4' : v' 4 = v 4 := by simp [v'] + have hv5' : v' 5 = v 5 := by simp [v'] + have hv6' : v' 6 = encodeHalf L := by simp [v'] + have hv7' : v' 7 = encodeHalf R := by simp [v'] + have hv8' : v' 8 = encodeHalf (L.cons w) := by simp [v'] + have hv9' : v' 9 = encodeHalf R.tail := by simp [v'] + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv4', hv6', hv7', hv4, encodeCfg] + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 5) 10 v' + (pzPackCfg_freshVar_le q'.val h' 8 9 (by decide) (by decide)) (by decide)] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv5', hv8', hv9', hv5, encodeCfg, + Tape.write, Tape.move, h'] + · simp only [PATerm.eval, eval_ofNat, hv6', hv8'] + exact encodeHalf_cons L w + · simp only [PATerm.eval, eval_ofNat, hv7', hv9', h'] + exact encodeHalf_eq_tail_head R + +theorem paHalted_holds_iff {states : ℕ} (M : Machine states 2) (v : ℕ → ℕ) : + (paHalted M).Holds v ↔ ∃ c : Cfg states 2, v 4 = encodeCfg c ∧ step M c = none := by + unfold paHalted + rw [paDisjList_holds_iff] + simp only [List.mem_flatMap] + constructor + · rintro ⟨φ, ⟨q, _, h, _, hmem⟩, hholds⟩ + cases htr : M.transition q h with + | some _ => rw [htr] at hmem; cases hmem + | none => + rw [htr, List.mem_singleton] at hmem + subst hmem + simp only [PAFormula.Holds] at hholds + rcases hholds with ⟨n6, n7, heq⟩ + set v' := Function.update (Function.update v 6 n6) 7 n7 + have e1 := (PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) (by decide)).mp heq + have hv4 : v' 4 = v 4 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + simp only [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv4, hv6, hv7] at e1 + refine ⟨⟨q, ⟨h, decodeHalf n6, decodeHalf n7⟩⟩, ?_, ?_⟩ + · simp [encodeCfg, e1] + · simp [step, htr] + · rintro ⟨⟨q, ⟨h, L, R⟩⟩, hv4, hstep⟩ + simp only [step, Option.map_eq_none_iff] at hstep + let φ := PAFormula.ex 6 + (.ex 7 ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10)) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · simp [hstep, φ] + · simp only [φ, PAFormula.Holds] + refine ⟨encodeHalf L, encodeHalf R, ?_⟩ + set v' := Function.update (Function.update v 6 (encodeHalf L)) 7 (encodeHalf R) + rw [PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + have hv4' : v' 4 = v 4 := by simp [v'] + have hv6' : v' 6 = encodeHalf L := by simp [v'] + have hv7' : v' 7 = encodeHalf R := by simp [v'] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv4', hv6', hv7', hv4, encodeCfg] + +private theorem reaches_to_trace {σ : Type*} {f : σ → Option σ} {a b : σ} + (h : StateTransition.Reaches f a b) : + ∃ (n : ℕ) (tr : ℕ → σ), tr 0 = a ∧ (∀ i < n, f (tr i) = some (tr (i + 1))) ∧ tr n = b := by + induction h with + | refl => exact ⟨0, fun _ ↦ a, rfl, fun _ hi ↦ absurd hi (Nat.not_lt_zero _), rfl⟩ + | @tail x y _ hxy ih => + rcases ih with ⟨n, tr, h0, hstep, hn⟩ + refine ⟨n + 1, fun i ↦ if i == n + 1 then y else tr i, ?_, ?_, ?_⟩ + · simp [h0] + · intro i hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hlt | rfl + · have hne1 : (i == n + 1) = false := beq_eq_false_iff_ne.mpr (by omega) + have hne2 : (i + 1 == n + 1) = false := beq_eq_false_iff_ne.mpr (by omega) + simp only [hne1, hne2, Bool.false_eq_true, ↓reduceIte] + exact hstep i hlt + · have hne1 : (i == i + 1) = false := beq_eq_false_iff_ne.mpr (by omega) + simp only [hne1, beq_self_eq_true, Bool.false_eq_true, ↓reduceIte, hn] + exact Option.mem_def.mp hxy + · simp + +/-- Standard-model adequacy of `paHalts`: `(paHalts M).Holds v` holds in `ℕ` if and only if `M` +halts from `init` (proved constructively without `Classical.choice`). -/ +theorem paHalts_holds_iff_halts {states : ℕ} [NeZero states] (M : Machine states 2) + (v : ℕ → ℕ) : (paHalts M).Holds v ↔ ConjectureMachines.Halts M := by + unfold paHalts ConjectureMachines.Halts + simp only [PAFormula.Holds] + constructor + · rintro ⟨n, c, d, h0, hsteps, hhalt⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + have hb0 : c % (1 + d) = 0 := by + have := (paBetaEq_holds_iff v2 (.var 1) (.var 2) .zero .zero).mp h0 + simpa [v2, PATerm.eval] using this + have hreach : ∀ i ≤ n, ∃ cfg : Cfg states 2, + c % (1 + (i + 1) * d) = encodeCfg cfg ∧ StateTransition.Reaches (step M) init cfg := by + intro i + induction i with + | zero => + intro _ + refine ⟨init, ?_, Relation.ReflTransGen.refl⟩ + simpa [encodeCfg_init] using hb0 + | succ i ih => + intro hle + obtain ⟨cfg₀, hcfg₀, hr₀⟩ := ih (Nat.le_of_succ_le hle) + have hilt : (paLt (.var 3) (.var 0)).Holds (Function.update v2 3 i) := by + rw [paLt_holds_iff] + simp [v2, PATerm.eval] + omega + obtain ⟨x4, x5, hb_i, hb_i1, hst⟩ := hsteps i hilt + set v5 := Function.update (Function.update (Function.update v2 3 i) 4 x4) 5 x5 + have hx4 : c % (1 + (i + 1) * d) = x4 := by + have := (paBetaEq_holds_iff v5 (.var 1) (.var 2) (.var 3) (.var 4)).mp hb_i + simpa [v5, v2, PATerm.eval] using this + have hx5 : c % (1 + (i + 1 + 1) * d) = x5 := by + have := (paBetaEq_holds_iff v5 (.var 1) (.var 2) (.succ (.var 3)) (.var 5)).mp hb_i1 + simpa [v5, v2, PATerm.eval] using this + obtain ⟨c₁, c₂, hc₁, hc₂, hstep⟩ := (paStep_holds_iff M v5).mp hst + simp only [v5, Function.update_self, + Function.update_of_ne (by decide : (4 : ℕ) ≠ 5)] at hc₁ hc₂ + have heq₀ : cfg₀ = c₁ := encodeCfg_injective (by rw [← hcfg₀, hx4, hc₁]) + subst heq₀ + exact ⟨c₂, by rw [hx5, hc₂], Relation.ReflTransGen.tail hr₀ hstep⟩ + obtain ⟨cfg_n, hcfg_n, hr_n⟩ := hreach n (Nat.le_refl n) + rcases hhalt with ⟨x4, hb_n, hhalted⟩ + set v4 := Function.update v2 4 x4 + have hx4 : c % (1 + (n + 1) * d) = x4 := by + have := (paBetaEq_holds_iff v4 (.var 1) (.var 2) (.var 0) (.var 4)).mp hb_n + simpa [v4, v2, PATerm.eval] using this + obtain ⟨cfg_f, hcfg_f, hnone⟩ := (paHalted_holds_iff M v4).mp hhalted + simp only [v4, Function.update_self] at hcfg_f + have heq_f : cfg_n = cfg_f := encodeCfg_injective (by rw [← hcfg_n, hx4, hcfg_f]) + subst heq_f + have hmem : cfg_n ∈ StateTransition.eval (step M) init := + mem_eval'.mpr ⟨hr_n, hnone⟩ + exact hmem.fst + · intro hdom + have hmem : (StateTransition.eval (step M) init).get hdom ∈ + StateTransition.eval (step M) init := ⟨hdom, rfl⟩ + obtain ⟨hreach, hnone⟩ := mem_eval'.mp hmem + obtain ⟨n, tr, htr0, htr_step, htr_n⟩ := reaches_to_trace hreach + let codes : List ℕ := (List.range (n + 1)).map fun i ↦ encodeCfg (tr i) + obtain ⟨c, d, hbeta⟩ := exists_beta_nat codes + have hcode : ∀ i ≤ n, c % (1 + (i + 1) * d) = encodeCfg (tr i) := by + intro i hi + have hlen : codes.length = n + 1 := by simp [codes] + have hbi := hbeta i (by omega) + simpa [codes] using hbi + refine ⟨n, c, d, ?_⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + refine ⟨?_, ?_, ?_⟩ + · rw [paBetaEq_holds_iff] + simpa [v2, PATerm.eval, htr0, encodeCfg_init] using hcode 0 (Nat.zero_le n) + · intro i hilt + rw [paLt_holds_iff] at hilt + have hi_lt : i < n := by simpa [v2, PATerm.eval] using hilt + refine ⟨encodeCfg (tr i), encodeCfg (tr (i + 1)), ?_⟩ + set v5 := Function.update (Function.update + (Function.update v2 3 i) 4 (encodeCfg (tr i))) 5 (encodeCfg (tr (i + 1))) + refine ⟨?_, ?_, ?_⟩ + · rw [paBetaEq_holds_iff] + simpa [v5, v2, PATerm.eval] using hcode i (Nat.le_of_lt hi_lt) + · rw [paBetaEq_holds_iff] + simpa [v5, v2, PATerm.eval] using hcode (i + 1) hi_lt + · rw [paStep_holds_iff] + exact ⟨tr i, tr (i + 1), by simp [v5], by simp [v5], htr_step i hi_lt⟩ + · refine ⟨encodeCfg (tr n), ?_⟩ + set v4 := Function.update v2 4 (encodeCfg (tr n)) + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holds_iff] + simpa [v4, v2, PATerm.eval] using hcode n (Nat.le_refl n) + · rw [paHalted_holds_iff] + exact ⟨tr n, by simp [v4], htr_n ▸ hnone⟩ + +/-! ## Section 5: Standard-Model Adequacy of `paZFInconsistent` -/ + +private theorem pzEq_eval (v : ℕ → ℕ) (x y : PAZFTerm) : + (pzEq x y).eval v = zfEq (x.eval v) (y.eval v) := rfl +private theorem pzMem_eval (v : ℕ → ℕ) (x y : PAZFTerm) : + (pzMem x y).eval v = zfMem (x.eval v) (y.eval v) := rfl +private theorem pzImp_eval (v : ℕ → ℕ) (φ ψ : PAZFTerm) : + (pzImp φ ψ).eval v = zfImp (φ.eval v) (ψ.eval v) := rfl +private theorem pzNot_eval (v : ℕ → ℕ) (φ : PAZFTerm) : + (pzNot φ).eval v = zfNot (φ.eval v) := rfl +private theorem pzAll_eval (v : ℕ → ℕ) (x φ : PAZFTerm) : + (pzAll x φ).eval v = zfAll (x.eval v) (φ.eval v) := rfl +private theorem pzEx_eval (v : ℕ → ℕ) (x φ : PAZFTerm) : + (pzEx x φ).eval v = zfEx (x.eval v) (φ.eval v) := rfl +private theorem pzAnd_eval (v : ℕ → ℕ) (φ ψ : PAZFTerm) : + (pzAnd φ ψ).eval v = zfAnd (φ.eval v) (ψ.eval v) := rfl + +private theorem pzB1_eval (v : ℕ → ℕ) (φ ψ χ : PAZFTerm) : + (pzB1 φ ψ χ).eval v = axB1 (φ.eval v) (ψ.eval v) (χ.eval v) := by + simp only [pzB1, axB1, pzImp_eval] +private theorem pzB2_eval (v : ℕ → ℕ) (φ : PAZFTerm) : + (pzB2 φ).eval v = axB2 (φ.eval v) := by + simp only [pzB2, axB2, pzImp_eval, pzNot_eval] +private theorem pzB3_eval (v : ℕ → ℕ) (φ ψ : PAZFTerm) : + (pzB3 φ ψ).eval v = axB3 (φ.eval v) (ψ.eval v) := by + simp only [pzB3, axB3, pzImp_eval, pzNot_eval] +private theorem pzB4_eval (v : ℕ → ℕ) (x φ ψ : PAZFTerm) : + (pzB4 x φ ψ).eval v = axB4 (x.eval v) (φ.eval v) (ψ.eval v) := by + simp only [pzB4, axB4, pzImp_eval, pzAll_eval] +private theorem pzB6a_eval (v : ℕ → ℕ) (x y z : PAZFTerm) : + (pzB6a x y z).eval v = axB6a (x.eval v) (y.eval v) (z.eval v) := by + simp only [pzB6a, axB6a, pzAnd_eval, pzImp_eval, pzAll_eval, pzEq_eval, pzMem_eval] +private theorem pzB6b_eval (v : ℕ → ℕ) (x y φ : PAZFTerm) : + (pzB6b x y φ).eval v = axB6b (x.eval v) (y.eval v) (φ.eval v) := by + simp only [pzB6b, axB6b, pzImp_eval, pzAll_eval] +private theorem pzB6c_eval (v : ℕ → ℕ) (x φ : PAZFTerm) : + (pzB6c x φ).eval v = axB6c (x.eval v) (φ.eval v) := by + simp only [pzB6c, axB6c, pzImp_eval, pzEx_eval, pzAll_eval] +private theorem pzB7_eval (v : ℕ → ℕ) (x y : PAZFTerm) : + (pzB7 x y).eval v = axB7 (x.eval v) (y.eval v) := by + simp only [pzB7, axB7, pzEx_eval, pzEq_eval] +private theorem pzB8a_eval (v : ℕ → ℕ) (x y z : PAZFTerm) : + (pzB8a x y z).eval v = axB8a (x.eval v) (y.eval v) (z.eval v) := by + simp only [pzB8a, axB8a, pzImp_eval, pzEq_eval] +private theorem pzB8b_eval (v : ℕ → ℕ) (x y z : PAZFTerm) : + (pzB8b x y z).eval v = axB8b (x.eval v) (y.eval v) (z.eval v) := by + simp only [pzB8b, axB8b, pzImp_eval, pzEq_eval, pzMem_eval] +private theorem pzB8c_eval (v : ℕ → ℕ) (x y z : PAZFTerm) : + (pzB8c x y z).eval v = axB8c (x.eval v) (y.eval v) (z.eval v) := by + simp only [pzB8c, axB8c, pzImp_eval, pzEq_eval, pzMem_eval] +private theorem pzExt_eval (v : ℕ → ℕ) : pzExt.eval v = axExt := by + simp only [pzExt, axExt, pzImp_eval, pzAll_eval, pzAnd_eval, pzMem_eval, pzEq_eval, + PAZFTerm.eval] +private theorem pzRep_eval (v : ℕ → ℕ) (φ : PAZFTerm) : + (pzRep φ).eval v = axRep (φ.eval v) := by + simp only [pzRep, pzRepRhs, axRep, axRepRhs, pzImp_eval, pzAll_eval, pzEx_eval, pzAnd_eval, + pzMem_eval, pzEq_eval, PAZFTerm.eval] +private theorem pzPow_eval (v : ℕ → ℕ) : pzPow.eval v = axPow := by + simp only [pzPow, axPow, pzEx_eval, pzAll_eval, pzImp_eval, pzMem_eval, PAZFTerm.eval] +private theorem pzUni_eval (v : ℕ → ℕ) : pzUni.eval v = axUni := by + simp only [pzUni, axUni, pzEx_eval, pzAll_eval, pzImp_eval, pzEx_eval, pzAnd_eval, pzMem_eval, + PAZFTerm.eval] +private theorem pzInf_eval (v : ℕ → ℕ) : pzInf.eval v = axInf := by + simp only [pzInf, pzInfSingleton, axInf, axInfSingleton, pzEx_eval, pzAnd_eval, pzAll_eval, + pzImp_eval, pzMem_eval, pzEq_eval, PAZFTerm.eval] + +/-- Whether formula code `w` is an axiom instance of `ZFProvable` (any constructor except `mp` and +`gen`). -/ +private def IsZFAxiom (w : ℕ) : Prop := + w = zfEq 0 0 ∨ + (∃ φ ψ χ, w = axB1 φ ψ χ) ∨ + (∃ φ, w = axB2 φ) ∨ + (∃ φ ψ, w = axB3 φ ψ) ∨ + (∃ x φ ψ, w = axB4 x φ ψ) ∨ + (∃ x y z, x ≠ z ∧ z ≠ y ∧ w = axB6a x y z) ∨ + (∃ x y φ, w = axB6b x y φ) ∨ + (∃ x φ, w = axB6c x φ) ∨ + (∃ x y, w = axB7 x y) ∨ + (∃ x y z, w = axB8a x y z) ∨ + (∃ x y z, w = axB8b x y z) ∨ + (∃ x y z, w = axB8c x y z) ∨ + w = axExt ∨ + (∃ φ, w = axRep φ) ∨ + w = axPow ∨ + w = axUni ∨ + w = axInf + +private theorem zfProvable_of_axiom {w : ℕ} (h : IsZFAxiom w) : ZFProvable w := by + rcases h with rfl | ⟨φ, ψ, χ, rfl⟩ | ⟨φ, rfl⟩ | ⟨φ, ψ, rfl⟩ | ⟨x, φ, ψ, rfl⟩ | + ⟨x, y, z, hxz, hzy, rfl⟩ | ⟨x, y, φ, rfl⟩ | ⟨x, φ, rfl⟩ | ⟨x, y, rfl⟩ | + ⟨x, y, z, rfl⟩ | ⟨x, y, z, rfl⟩ | ⟨x, y, z, rfl⟩ | rfl | ⟨φ, rfl⟩ | rfl | rfl | rfl + · exact .moot + · exact .b1 φ ψ χ + · exact .b2 φ + · exact .b3 φ ψ + · exact .b4 x φ ψ + · exact .b6a x y z hxz hzy + · exact .b6b x y φ + · exact .b6c x φ + · exact .b7 x y + · exact .b8a x y z + · exact .b8b x y z + · exact .b8c x y z + · exact .ext + · exact .rep φ + · exact .pow + · exact .uni + · exact .inf + +private theorem paIsZFStep_holds_iff (v : ℕ → ℕ) : + paIsZFStep.Holds v ↔ + IsZFAxiom (v 4) ∨ + (∃ φ χ j₁ j₂, j₁ < v 3 ∧ j₂ < v 3 ∧ + v 1 % (1 + (j₁ + 1) * v 2) = φ ∧ + v 1 % (1 + (j₂ + 1) * v 2) = χ ∧ + χ = zfImp φ (v 4)) ∨ + (∃ x φ j, j < v 3 ∧ v 1 % (1 + (j + 1) * v 2) = φ ∧ v 4 = zfAll x φ) := by + unfold paIsZFStep IsZFAxiom + rw [paDisjList_holds_iff] + simp only [List.mem_cons, List.not_mem_nil, or_false, exists_eq_or_imp, exists_eq_left] + have eq_iff : ∀ (e : PAZFTerm) (out : PATerm) (u : ℕ → ℕ), + e.freshVar ≤ 10 → out.freshVar ≤ 10 → + ((e.eqFormula out 10).Holds u ↔ out.eval u = e.eval u) := + fun e out u he ho ↦ PAZFTerm.eqFormula_holds_iff e out 10 u he ho + constructor + · rintro (h0 | hmp | hgen | hb1 | hb2 | hb3 | hb4 | hb6a | hb6b | hb6c | hb7 | + hb8a | hb8b | hb8c | hext | hrep | hpow | huni | hinf) + · rw [eq_iff _ _ _ (by decide) (by decide)] at h0 + exact Or.inl (Or.inl (by simpa [PATerm.eval, pzEq_eval, PAZFTerm.eval] using h0)) + · simp only [PAFormula.Holds] at hmp + rcases hmp with ⟨n5, n6, n8, n9, h8, h9, hb8, hb9, himp⟩ + set u := Function.update (Function.update + (Function.update (Function.update v 5 n5) 6 n6) 8 n8) 9 n9 + rw [paLt_holds_iff] at h8 h9 + rw [paBetaEq_holds_iff] at hb8 hb9 + rw [eq_iff _ _ _ (by decide) (by decide)] at himp + refine Or.inr (Or.inl ⟨n5, n6, n8, n9, ?_, ?_, ?_, ?_, ?_⟩) + · simpa [u, PATerm.eval] using h8 + · simpa [u, PATerm.eval] using h9 + · simpa [u, PATerm.eval] using hb8 + · simpa [u, PATerm.eval] using hb9 + · simpa [u, PATerm.eval, pzImp_eval, PAZFTerm.eval] using himp + · simp only [PAFormula.Holds] at hgen + rcases hgen with ⟨n5, n6, n8, h8, hb8, hall⟩ + set u := Function.update (Function.update (Function.update v 5 n5) 6 n6) 8 n8 + rw [paLt_holds_iff] at h8 + rw [paBetaEq_holds_iff] at hb8 + rw [eq_iff _ _ _ (by decide) (by decide)] at hall + refine Or.inr (Or.inr ⟨n5, n6, n8, ?_, ?_, ?_⟩) + · simpa [u, PATerm.eval] using h8 + · simpa [u, PATerm.eval] using hb8 + · simpa [u, PATerm.eval, pzAll_eval, PAZFTerm.eval] using hall + · simp only [PAFormula.Holds] at hb1 + rcases hb1 with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB1_eval, PAZFTerm.eval] using h⟩)) + · simp only [PAFormula.Holds] at hb2 + rcases hb2 with ⟨n5, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inl ⟨n5, + by simpa [PATerm.eval, pzB2_eval, PAZFTerm.eval] using h⟩))) + · simp only [PAFormula.Holds] at hb3 + rcases hb3 with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, + by simpa [PATerm.eval, pzB3_eval, PAZFTerm.eval] using h⟩)))) + · simp only [PAFormula.Holds] at hb4 + rcases hb4 with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB4_eval, PAZFTerm.eval] using h⟩))))) + · simp only [PAFormula.Holds] at hb6a + rcases hb6a with ⟨n5, n6, n7, hne1, hne2, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨n5, n6, n7, by simpa [PATerm.eval] using hne1, + by simpa [PATerm.eval] using hne2, + by simpa [PATerm.eval, pzB6a_eval, PAZFTerm.eval] using h⟩)))))) + · simp only [PAFormula.Holds] at hb6b + rcases hb6b with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB6b_eval, PAZFTerm.eval] using h⟩))))))) + · simp only [PAFormula.Holds] at hb6c + rcases hb6c with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, + by simpa [PATerm.eval, pzB6c_eval, PAZFTerm.eval] using h⟩)))))))) + · simp only [PAFormula.Holds] at hb7 + rcases hb7 with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨n5, n6, by simpa [PATerm.eval, pzB7_eval, PAZFTerm.eval] using h⟩))))))))) + · simp only [PAFormula.Holds] at hb8a + rcases hb8a with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨n5, n6, n7, by simpa [PATerm.eval, pzB8a_eval, PAZFTerm.eval] using h⟩)))))))))) + · simp only [PAFormula.Holds] at hb8b + rcases hb8b with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB8b_eval, PAZFTerm.eval] using h⟩))))))))))) + · simp only [PAFormula.Holds] at hb8c + rcases hb8c with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB8c_eval, PAZFTerm.eval] using h⟩)))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hext + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [PATerm.eval, pzExt_eval] using hext)))))))))))))) + · simp only [PAFormula.Holds] at hrep + rcases hrep with ⟨n5, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, + by simpa [PATerm.eval, pzRep_eval, PAZFTerm.eval] using h⟩)))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hpow + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [PATerm.eval, pzPow_eval] using hpow)))))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at huni + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [PATerm.eval, pzUni_eval] using huni))))))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hinf + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (by simpa [PATerm.eval, pzInf_eval] using hinf))))))))))))))))) + · rintro (hax | ⟨φ, χ, j₁, j₂, hj₁, hj₂, hb₁, hb₂, hχ⟩ | ⟨x, φ, j, hj, hbj, hall⟩) + · rcases hax with h0 | ⟨a, b, c, h⟩ | ⟨a, h⟩ | ⟨a, b, h⟩ | ⟨a, b, c, h⟩ | + ⟨a, b, c, hac, hcb, h⟩ | ⟨a, b, c, h⟩ | ⟨a, b, h⟩ | ⟨a, b, h⟩ | + ⟨a, b, c, h⟩ | ⟨a, b, c, h⟩ | ⟨a, b, c, h⟩ | hext | ⟨a, h⟩ | hpow | huni | hinf + · refine Or.inl ?_ + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzEq_eval, PAZFTerm.eval] using h0 + · refine Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB1_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, ?_⟩)))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB2_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, ?_⟩))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB3_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩)))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB4_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨a, b, c, ?_, ?_, ?_⟩))))))) + · simpa [PAFormula.Holds, PATerm.eval] using hac + · simpa [PAFormula.Holds, PATerm.eval] using hcb + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB6a_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, c, ?_⟩)))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB6b_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨a, b, ?_⟩))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB6c_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨a, b, ?_⟩)))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB7_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB8a_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩)))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB8b_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB8c_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ?_)))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzExt_eval] using hext + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, ?_⟩))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzRep_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ?_)))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzPow_eval] using hpow + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ?_))))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzUni_eval] using huni + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr ?_))))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzInf_eval] using hinf + · refine Or.inr (Or.inl ⟨φ, χ, j₁, j₂, ?_, ?_, ?_, ?_, ?_⟩) + · rw [paLt_holds_iff]; simpa [PATerm.eval] using hj₁ + · rw [paLt_holds_iff]; simpa [PATerm.eval] using hj₂ + · rw [paBetaEq_holds_iff]; simpa [PATerm.eval] using hb₁ + · rw [paBetaEq_holds_iff]; simpa [PATerm.eval] using hb₂ + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzImp_eval, PAZFTerm.eval] using hχ + · refine Or.inr (Or.inr (Or.inl ⟨x, φ, j, ?_, ?_, ?_⟩)) + · rw [paLt_holds_iff]; simpa [PATerm.eval] using hj + · rw [paBetaEq_holds_iff]; simpa [PATerm.eval] using hbj + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzAll_eval, PAZFTerm.eval] using hall + +private def ValidZFDeriv (L : List ℕ) : Prop := + ∀ (i : ℕ) (hi : i < L.length), + IsZFAxiom L[i] ∨ + (∃ (j₁ j₂ : ℕ) (hj₁ : j₁ < i) (hj₂ : j₂ < i), + L[j₂]'(lt_trans hj₂ hi) = zfImp (L[j₁]'(lt_trans hj₁ hi)) L[i]) ∨ + (∃ (x j : ℕ) (hj : j < i), L[i] = zfAll x (L[j]'(lt_trans hj hi))) + +private theorem validZFDeriv_append {L₁ L₂ : List ℕ} (h₁ : ValidZFDeriv L₁) + (h₂ : ValidZFDeriv L₂) : ValidZFDeriv (L₁ ++ L₂) := by + intro i hi + rw [List.length_append] at hi + rcases Nat.lt_or_ge i L₁.length with hlt | hge + · rw [List.getElem_append_left hlt] + rcases h₁ i hlt with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨x, j, hj, hgen⟩ + · exact Or.inl hax + · refine Or.inr (Or.inl ⟨j₁, j₂, hj₁, hj₂, ?_⟩) + rwa [List.getElem_append_left (lt_trans hj₁ hlt), + List.getElem_append_left (lt_trans hj₂ hlt)] + · refine Or.inr (Or.inr ⟨x, j, hj, ?_⟩) + rwa [List.getElem_append_left (lt_trans hj hlt)] + · let k := i - L₁.length + have hk : k < L₂.length := by omega + have hik : i = L₁.length + k := by omega + have hget : ∀ (m : ℕ) (hm : m < L₂.length) (hm' : L₁.length + m < (L₁ ++ L₂).length), + (L₁ ++ L₂)[L₁.length + m]'hm' = L₂[m]'hm := by + intro m hm hm' + simp + have hi_eq : (L₁ ++ L₂)[i] = L₂[k] := by + simp [hik] + rw [hi_eq] + rcases h₂ k hk with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨x, j, hj, hgen⟩ + · exact Or.inl hax + · refine Or.inr (Or.inl ⟨L₁.length + j₁, L₁.length + j₂, by omega, by omega, ?_⟩) + rw [hget j₁ (lt_trans hj₁ hk), hget j₂ (lt_trans hj₂ hk)] + exact hmp + · refine Or.inr (Or.inr ⟨x, L₁.length + j, by omega, ?_⟩) + rw [hget j (lt_trans hj hk)] + exact hgen + +private theorem exists_validZFDeriv {φ : ℕ} (h : ZFProvable φ) : + ∃ (L : List ℕ) (hne : L ≠ []), ValidZFDeriv L ∧ L[L.length - 1]'(by + exact Nat.sub_lt (List.length_pos_of_ne_nil hne) Nat.one_pos) = φ := by + have single_ax : ∀ {w : ℕ}, IsZFAxiom w → + ∃ (L : List ℕ) (hne : L ≠ []), ValidZFDeriv L ∧ L[L.length - 1]'(by + exact Nat.sub_lt (List.length_pos_of_ne_nil hne) Nat.one_pos) = w := by + intro w hw + refine ⟨[w], List.cons_ne_nil _ _, ?_, rfl⟩ + intro i hi + have hi0 : i = 0 := by + simp only [List.length_singleton] at hi + omega + subst hi0 + exact Or.inl hw + induction h with + | moot => exact single_ax (Or.inl rfl) + | b1 a b c => exact single_ax (Or.inr (Or.inl ⟨a, b, c, rfl⟩)) + | b2 a => exact single_ax (Or.inr (Or.inr (Or.inl ⟨a, rfl⟩))) + | b3 a b => exact single_ax (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, rfl⟩)))) + | b4 a b c => exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, rfl⟩))))) + | b6a a b c hac hcb => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, hac, hcb, rfl⟩)))))) + | b6b a b c => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, rfl⟩))))))) + | b6c a b => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, rfl⟩)))))))) + | b7 a b => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, rfl⟩))))))))) + | b8a a b c => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, c, rfl⟩)))))))))) + | b8b a b c => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨a, b, c, rfl⟩))))))))))) + | b8c a b c => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨a, b, c, rfl⟩)))))))))))) + | ext => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl rfl))))))))))))) + | rep a => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, rfl⟩)))))))))))))) + | pow => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl))))))))))))))) + | uni => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)))))))))))))))) + | inf => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr rfl)))))))))))))))) + | @mp φ ψ _ _ ih₁ ih₂ => + rcases ih₁ with ⟨L₁, hne₁, hv₁, hlast₁⟩ + rcases ih₂ with ⟨L₂, hne₂, hv₂, hlast₂⟩ + have hp₁ : 0 < L₁.length := List.length_pos_of_ne_nil hne₁ + have hp₂ : 0 < L₂.length := List.length_pos_of_ne_nil hne₂ + let L₁₂ := L₁ ++ L₂ + have hv₁₂ : ValidZFDeriv L₁₂ := validZFDeriv_append hv₁ hv₂ + let L := L₁₂ ++ [ψ] + have hne : L ≠ [] := List.append_ne_nil_of_right_ne_nil _ (List.cons_ne_nil _ _) + refine ⟨L, hne, ?_, ?_⟩ + · intro i hi + simp only [L, L₁₂, List.length_append, List.length_singleton] at hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hlt | rfl + · have hlt' : i < L₁₂.length := by + simp only [L₁₂, List.length_append] + exact hlt + simp only [L, List.getElem_append_left hlt'] + rcases hv₁₂ i hlt' with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨x, j, hj, hgen⟩ + · exact Or.inl hax + · refine Or.inr (Or.inl ⟨j₁, j₂, hj₁, hj₂, ?_⟩) + simpa only [List.getElem_append_left (lt_trans hj₁ hlt'), + List.getElem_append_left (lt_trans hj₂ hlt')] using hmp + · refine Or.inr (Or.inr ⟨x, j, hj, ?_⟩) + simpa only [List.getElem_append_left (lt_trans hj hlt')] using hgen + · refine Or.inr (Or.inl ⟨L₁.length - 1, L₁.length + L₂.length - 1, + by omega, by omega, ?_⟩) + have hget_end : L[L₁.length + L₂.length] = ψ := by + simp [L, L₁₂] + have hget1 : L[L₁.length - 1]'(by simp [L, L₁₂]; omega) = φ := by + rw [List.getElem_append_left (by simp [L₁₂]; omega)] + rw [List.getElem_append_left (by omega)] + exact hlast₁ + have hget2 : L[L₁.length + L₂.length - 1]'(by simp [L, L₁₂]; omega) = zfImp φ ψ := by + rw [List.getElem_append_left (by simp [L₁₂]; omega)] + have hidx : L₁.length + L₂.length - 1 = L₁.length + (L₂.length - 1) := by omega + simp only [L₁₂, hidx, List.getElem_append_right (Nat.le_add_right _ _), + Nat.add_sub_cancel_left] + exact hlast₂ + rw [hget_end, hget1, hget2] + · simp [L, L₁₂] + | @gen x φ _ ih => + rcases ih with ⟨L₁, hne₁, hv₁, hlast₁⟩ + have hp₁ : 0 < L₁.length := List.length_pos_of_ne_nil hne₁ + let L := L₁ ++ [zfAll x φ] + have hne : L ≠ [] := List.append_ne_nil_of_right_ne_nil _ (List.cons_ne_nil _ _) + refine ⟨L, hne, ?_, ?_⟩ + · intro i hi + simp only [L, List.length_append, List.length_singleton] at hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hlt | rfl + · simp only [L, List.getElem_append_left hlt] + rcases hv₁ i hlt with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨y, j, hj, hgen⟩ + · exact Or.inl hax + · refine Or.inr (Or.inl ⟨j₁, j₂, hj₁, hj₂, ?_⟩) + simpa only [List.getElem_append_left (lt_trans hj₁ hlt), + List.getElem_append_left (lt_trans hj₂ hlt)] using hmp + · refine Or.inr (Or.inr ⟨y, j, hj, ?_⟩) + simpa only [List.getElem_append_left (lt_trans hj hlt)] using hgen + · refine Or.inr (Or.inr ⟨x, L₁.length - 1, by omega, ?_⟩) + have hget_end : L[L₁.length] = zfAll x φ := by simp [L] + have hget1 : L[L₁.length - 1]'(by simp [L]) = φ := by + rw [List.getElem_append_left (by omega)] + exact hlast₁ + rw [hget_end, hget1] + · simp [L] + +/-- Standard-model adequacy of `paZFInconsistent`: `paZFInconsistent.Holds v` holds in `ℕ` if and +only if `ZFInconsistent` holds (proved constructively without `Classical.choice`). -/ +theorem paZFInconsistent_holds_iff_zfInconsistent (v : ℕ → ℕ) : + paZFInconsistent.Holds v ↔ ZFInconsistent := by + unfold paZFInconsistent ZFInconsistent + simp only [PAFormula.Holds] + constructor + · rintro ⟨n, c, d, hsteps, hfinal⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + have hprov : ∀ i ≤ n, ZFProvable (c % (1 + (i + 1) * d)) := by + intro i + induction i using Nat.strongRecOn with + | ind i ih => + intro hle + have hle_holds : (paLe (.var 3) (.var 0)).Holds (Function.update v2 3 i) := by + rw [paLe_holds_iff] + simp [v2, PATerm.eval, hle] + obtain ⟨w, hbw, hst⟩ := hsteps i hle_holds + set v4 := Function.update (Function.update v2 3 i) 4 w + have hw_eq : c % (1 + (i + 1) * d) = w := by + have := (paBetaEq_holds_iff v4 (.var 1) (.var 2) (.var 3) (.var 4)).mp hbw + simpa [v4, v2, PATerm.eval] using this + rw [hw_eq] + have hst' := (paIsZFStep_holds_iff v4).mp hst + simp only [v4, v2, Function.update_self, + Function.update_of_ne (by decide : (3 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 3), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 2), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 3)] at hst' + rcases hst' with hax | ⟨φ, χ, j₁, j₂, hj₁, hj₂, hb₁, hb₂, hχ⟩ | ⟨x, φ, j, hj, hbj, hall⟩ + · exact zfProvable_of_axiom hax + · have p₁ : ZFProvable φ := by + rw [← hb₁] + exact ih j₁ hj₁ (by omega) + have p₂ : ZFProvable (zfImp φ w) := by + rw [← hχ, ← hb₂] + exact ih j₂ hj₂ (by omega) + exact .mp p₁ p₂ + · rw [hall] + refine .gen x ?_ + rw [← hbj] + exact ih j hj (by omega) + rcases hfinal with ⟨w, hbw, hmem⟩ + set v4 := Function.update v2 4 w + have hw_eq : c % (1 + (n + 1) * d) = w := by + have := (paBetaEq_holds_iff v4 (.var 1) (.var 2) (.var 0) (.var 4)).mp hbw + simpa [v4, v2, PATerm.eval] using this + have hw_mem : w = zfMem 0 0 := by + have := (PAZFTerm.eqFormula_holds_iff (pzMem (.const 0) (.const 0)) (.var 4) 10 v4 + (by decide) (by decide)).mp hmem + simpa [v4, PATerm.eval, pzMem_eval, PAZFTerm.eval] using this + rw [← hw_mem, ← hw_eq] + exact hprov n (Nat.le_refl n) + · intro hinc + obtain ⟨L, hne, hvalid, hlast⟩ := exists_validZFDeriv hinc + have hpos : 0 < L.length := List.length_pos_of_ne_nil hne + let n := L.length - 1 + obtain ⟨c, d, hbeta⟩ := exists_beta_nat L + refine ⟨n, c, d, ?_⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + refine ⟨?_, ?_⟩ + · intro i hle + rw [paLe_holds_iff] at hle + have hi_le : i ≤ n := by simpa [v2, PATerm.eval] using hle + have hi_lt : i < L.length := by omega + refine ⟨L[i], ?_⟩ + set v4 := Function.update (Function.update v2 3 i) 4 L[i] + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holds_iff] + simpa [v4, v2, PATerm.eval] using hbeta i hi_lt + · rw [paIsZFStep_holds_iff] + simp only [v4, v2, Function.update_self, + Function.update_of_ne (by decide : (3 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 3), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 2), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 3)] + rcases hvalid i hi_lt with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨x, j, hj, hgen⟩ + · exact Or.inl hax + · exact Or.inr (Or.inl ⟨L[j₁]'(lt_trans hj₁ hi_lt), L[j₂]'(lt_trans hj₂ hi_lt), + j₁, j₂, hj₁, hj₂, hbeta j₁ (lt_trans hj₁ hi_lt), + hbeta j₂ (lt_trans hj₂ hi_lt), hmp⟩) + · exact Or.inr (Or.inr ⟨x, L[j]'(lt_trans hj hi_lt), j, hj, + hbeta j (lt_trans hj hi_lt), hgen⟩) + · refine ⟨zfMem 0 0, ?_⟩ + set v4 := Function.update v2 4 (zfMem 0 0) + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holds_iff] + have hbn := hbeta n (by omega) + rw [hlast] at hbn + simpa [v4, v2, PATerm.eval] using hbn + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v4 (by decide) (by decide)] + simp [v4, PATerm.eval, pzMem_eval, PAZFTerm.eval] + +end ConjectureMachines.Semantics.PA diff --git a/Cryptids/Semantics/PA/Completeness.lean b/Cryptids/Semantics/PA/Completeness.lean new file mode 100644 index 00000000..9f2b9b3b --- /dev/null +++ b/Cryptids/Semantics/PA/Completeness.lean @@ -0,0 +1,1272 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Syntax +public import Mathlib.Data.Nat.Pairing + +/-! +# Gödel–Henkin Completeness of `PAProvable` + +This module proves Gödel's first-order completeness theorem specialized to Peano Arithmetic +(`PAProvable`): a `PAFormula` is provable in `PAProvable` if and only if it holds in every +first-order `PAModel` `M` (`Type`) under every variable assignment: + +- `paProvable_iff_holdsIn_all_models`: + `PAProvable φ ↔ ∀ (M : Type) [PAStructure M] [PAModel M] (v : ℕ → M), PAFormula.HoldsIn v φ` + +This bridge allows semantic proofs in an arbitrary first-order model `[PAModel M]` to be compiled +directly into formal Hilbert derivations `PAProvable φ`. +-/ + +@[expose] public section + +namespace ConjectureMachines + +/-- Smallest variable index strictly greater than every variable (free or bound) occurring in a +`PAFormula`. -/ +def PAFormula.maxVar : PAFormula → ℕ + | .bot => 0 + | .eq t₁ t₂ => max t₁.freshVar t₂.freshVar + | .and φ ψ | .or φ ψ | .imp φ ψ => max φ.maxVar ψ.maxVar + | .all x φ | .ex x φ => max (x + 1) φ.maxVar + +/-- Simultaneous variable-to-variable renaming on `PATerm`. -/ +def PATerm.vsubst (ρ : ℕ → ℕ) : PATerm → PATerm + | .var x => .var (ρ x) + | .zero => .zero + | .succ t => .succ (t.vsubst ρ) + | .add t₁ t₂ => .add (t₁.vsubst ρ) (t₂.vsubst ρ) + | .mul t₁ t₂ => .mul (t₁.vsubst ρ) (t₂.vsubst ρ) + +/-- Simultaneous variable-to-variable renaming on `PAFormula`, preserving bound variable names. -/ +def PAFormula.vsubst (ρ : ℕ → ℕ) : PAFormula → PAFormula + | .bot => .bot + | .eq t₁ t₂ => .eq (t₁.vsubst ρ) (t₂.vsubst ρ) + | .and φ ψ => .and (φ.vsubst ρ) (ψ.vsubst ρ) + | .or φ ψ => .or (φ.vsubst ρ) (ψ.vsubst ρ) + | .imp φ ψ => .imp (φ.vsubst ρ) (ψ.vsubst ρ) + | .all y φ => .all y (φ.vsubst (Function.update ρ y y)) + | .ex y φ => .ex y (φ.vsubst (Function.update ρ y y)) + +end ConjectureMachines + +namespace ConjectureMachines.Semantics.PA + +/-! ## Section 1: Variable Bounds and Simultaneous Variable Renaming -/ + +private theorem term_subst_eq_self_of_hasVar_false {t : PATerm} {x : ℕ} (s : PATerm) + (hx : t.hasVar x = false) : t.subst x s = t := by + induction t with + | var y => + simp only [PATerm.hasVar, beq_eq_false_iff_ne] at hx + simp [PATerm.subst, hx] + | zero => rfl + | succ _ ih => exact congrArg PATerm.succ (ih hx) + | add _ _ ih₁ ih₂ => + simp only [PATerm.hasVar, Bool.or_eq_false_iff] at hx + exact congrArg₂ PATerm.add (ih₁ hx.1) (ih₂ hx.2) + | mul _ _ ih₁ ih₂ => + simp only [PATerm.hasVar, Bool.or_eq_false_iff] at hx + exact congrArg₂ PATerm.mul (ih₁ hx.1) (ih₂ hx.2) + +private theorem lt_freshVar_of_hasVar {t : PATerm} {x : ℕ} (h : t.hasVar x = true) : + x < t.freshVar := by + by_contra hge + have hf := hasVar_false_of_freshVar_le (Nat.le_of_not_lt hge) + rw [hf] at h + cases h + +private theorem hasFree_false_of_maxVar_le {φ : PAFormula} {w : ℕ} (h : φ.maxVar ≤ w) : + φ.hasFree w = false := by + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] + exact ⟨hasVar_false_of_freshVar_le h.1, hasVar_false_of_freshVar_le h.2⟩ + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] + exact ⟨ih₁ h.1, ih₂ h.2⟩ + | all x _ ih | ex x _ ih => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp only [PAFormula.hasFree, Bool.and_eq_false_iff] + exact Or.inr (ih h.2) + +private theorem lt_maxVar_of_hasFree {φ : PAFormula} {x : ℕ} (h : φ.hasFree x = true) : + x < φ.maxVar := by + by_contra hge + have hf := hasFree_false_of_maxVar_le (Nat.le_of_not_lt hge) + rw [hf] at h + cases h + +private theorem freeFor_var_self (x : ℕ) (φ : PAFormula) : + φ.freeFor x (.var x) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp [PAFormula.freeFor, ih₁, ih₂] + | all y _ ih | ex y _ ih => + simp only [PAFormula.freeFor, PATerm.hasVar] + by_cases hxy : y = x + · simp [hxy] + · simp [hxy, Ne.symm hxy, ih] + +private theorem term_subst_var_self (x : ℕ) (t : PATerm) : + t.subst x (.var x) = t := by + induction t with + | var y => + simp only [PATerm.subst] + by_cases hxy : y = x + · subst hxy; simp + · simp [hxy] + | zero => rfl + | succ _ ih => exact congrArg PATerm.succ ih + | add _ _ ih₁ ih₂ => exact congrArg₂ PATerm.add ih₁ ih₂ + | mul _ _ ih₁ ih₂ => exact congrArg₂ PATerm.mul ih₁ ih₂ + +private theorem subst_var_self (x : ℕ) (φ : PAFormula) : + φ.subst x (.var x) = φ := by + induction φ with + | bot => rfl + | eq t₁ t₂ => exact congrArg₂ PAFormula.eq (term_subst_var_self x t₁) (term_subst_var_self x t₂) + | and _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.and ih₁ ih₂ + | or _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.or ih₁ ih₂ + | imp _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.imp ih₁ ih₂ + | all y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · simp [hxy] + · simp [hxy, ih] + | ex y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · simp [hxy] + · simp [hxy, ih] + +private theorem freeFor_var_of_maxVar_le (x : ℕ) {w : ℕ} {φ : PAFormula} (hw : φ.maxVar ≤ w) : + φ.freeFor x (.var w) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp [PAFormula.freeFor, ih₁ hw.1, ih₂ hw.2] + | all y _ ih | ex y _ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hwy : w ≠ y := by omega + simp [PAFormula.freeFor, PATerm.hasVar, hwy, ih hw.2] + +private theorem freeFor_of_hasFree_false {w : ℕ} (s : PATerm) {φ : PAFormula} + (hw : φ.maxVar ≤ w) : φ.freeFor w s = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp [PAFormula.freeFor, ih₁ hw.1, ih₂ hw.2] + | all y φ ih | ex y φ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp [PAFormula.freeFor, hasFree_false_of_maxVar_le hw.2, ih hw.2] + +private theorem freeFor_inverse_var {x w : ℕ} {φ : PAFormula} (hw : φ.maxVar ≤ w) : + (φ.subst x (.var w)).freeFor w (.var x) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp [PAFormula.subst, PAFormula.freeFor, ih₁ hw.1, ih₂ hw.2] + | all y φ ih | ex y φ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp only [PAFormula.subst] + by_cases hxy : y = x + · subst hxy + simp only [beq_self_eq_true, ↓reduceIte] + exact freeFor_of_hasFree_false (.var y) (Nat.max_le.mpr hw) + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp [hb, PAFormula.freeFor, PATerm.hasVar, Ne.symm hxy, ih hw.2] + +private theorem term_subst_inverse_var {x w : ℕ} {t : PATerm} (hw : t.freshVar ≤ w) : + (t.subst x (.var w)).subst w (.var x) = t := by + induction t with + | var z => + simp only [PATerm.freshVar] at hw + simp only [PATerm.subst] + by_cases hzx : z = x + · subst hzx; simp [PATerm.subst] + · have hzw : z ≠ w := by omega + simp [hzx, PATerm.subst, hzw] + | zero => rfl + | succ _ ih => exact congrArg PATerm.succ (ih hw) + | add _ _ ih₁ ih₂ => + simp only [PATerm.freshVar, Nat.max_le] at hw + exact congrArg₂ PATerm.add (ih₁ hw.1) (ih₂ hw.2) + | mul _ _ ih₁ ih₂ => + simp only [PATerm.freshVar, Nat.max_le] at hw + exact congrArg₂ PATerm.mul (ih₁ hw.1) (ih₂ hw.2) + +private theorem subst_inverse_var {x w : ℕ} {φ : PAFormula} (hw : φ.maxVar ≤ w) : + (φ.subst x (.var w)).subst w (.var x) = φ := by + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + exact congrArg₂ PAFormula.eq (term_subst_inverse_var hw.1) (term_subst_inverse_var hw.2) + | and _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + exact congrArg₂ PAFormula.and (ih₁ hw.1) (ih₂ hw.2) + | or _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + exact congrArg₂ PAFormula.or (ih₁ hw.1) (ih₂ hw.2) + | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + exact congrArg₂ PAFormula.imp (ih₁ hw.1) (ih₂ hw.2) + | all y φ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hyw : y ≠ w := by omega + have hbw : (y == w) = false := beq_eq_false_iff_ne.mpr hyw + by_cases hxy : y = x + · subst hxy + simp [PAFormula.subst, hbw, + subst_eq_self_of_hasFree_false (.var y) (hasFree_false_of_maxVar_le hw.2)] + · have hbx : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp [PAFormula.subst, hbx, hbw, ih hw.2] + | ex y φ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hyw : y ≠ w := by omega + have hbw : (y == w) = false := beq_eq_false_iff_ne.mpr hyw + by_cases hxy : y = x + · subst hxy + simp [PAFormula.subst, hbw, + subst_eq_self_of_hasFree_false (.var y) (hasFree_false_of_maxVar_le hw.2)] + · have hbx : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp [PAFormula.subst, hbx, hbw, ih hw.2] + +private theorem hasVar_subst_var_self_false {t : PATerm} {x w : ℕ} (hwx : w ≠ x) : + (t.subst x (.var w)).hasVar x = false := by + induction t with + | var z => + simp only [PATerm.subst] + by_cases hzx : z = x + · subst hzx; simp [PATerm.hasVar, hwx] + · simp [hzx, PATerm.hasVar] + | zero => rfl + | succ _ ih => exact ih + | add _ _ ih₁ ih₂ | mul _ _ ih₁ ih₂ => + simp [PATerm.subst, PATerm.hasVar, ih₁, ih₂] + +private theorem hasFree_subst_var_self_false {φ : PAFormula} {x w : ℕ} (hwx : w ≠ x) : + (φ.subst x (.var w)).hasFree x = false := by + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp [PAFormula.subst, PAFormula.hasFree, hasVar_subst_var_self_false hwx] + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp [PAFormula.subst, PAFormula.hasFree, ih₁, ih₂] + | all y _ ih | ex y _ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · subst hxy; simp [PAFormula.hasFree] + · simp [hxy, PAFormula.hasFree, ih] + +private theorem update_id_self (y : ℕ) : Function.update (id : ℕ → ℕ) y y = id := by + funext x + by_cases h : x = y + · subst h; simp + · simp [h] + +private theorem term_vsubst_id (t : PATerm) : t.vsubst id = t := by + induction t with + | var _ | zero => rfl + | succ _ ih => exact congrArg PATerm.succ ih + | add _ _ ih₁ ih₂ => exact congrArg₂ PATerm.add ih₁ ih₂ + | mul _ _ ih₁ ih₂ => exact congrArg₂ PATerm.mul ih₁ ih₂ + +private theorem vsubst_id (φ : PAFormula) : φ.vsubst id = φ := by + induction φ with + | bot => rfl + | eq t₁ t₂ => exact congrArg₂ PAFormula.eq (term_vsubst_id t₁) (term_vsubst_id t₂) + | and _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.and ih₁ ih₂ + | or _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.or ih₁ ih₂ + | imp _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.imp ih₁ ih₂ + | all y _ ih => + simp only [PAFormula.vsubst, update_id_self] + exact congrArg (PAFormula.all y) ih + | ex y _ ih => + simp only [PAFormula.vsubst, update_id_self] + exact congrArg (PAFormula.ex y) ih + +private theorem term_vsubst_subst_var {t : PATerm} {ρ : ℕ → ℕ} {y w : ℕ} + (h : ∀ x, t.hasVar x = true → x ≠ y → ρ x ≠ y) : + (t.vsubst (Function.update ρ y y)).subst y (.var w) = t.vsubst (Function.update ρ y w) := by + induction t with + | var x => + simp only [PATerm.vsubst] + by_cases hxy : x = y + · subst hxy; simp [PATerm.subst] + · have hρ : ρ x ≠ y := h x (by simp [PATerm.hasVar]) hxy + simp [hxy, PATerm.subst, hρ] + | zero => rfl + | succ _ ih => + exact congrArg PATerm.succ (ih h) + | add t₁ t₂ ih₁ ih₂ => + refine congrArg₂ PATerm.add (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + | mul t₁ t₂ ih₁ ih₂ => + refine congrArg₂ PATerm.mul (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + +private theorem vsubst_subst_var {φ : PAFormula} {ρ : ℕ → ℕ} {y w : ℕ} + (h : ∀ x, φ.hasFree x = true → x ≠ y → ρ x ≠ y) : + (φ.vsubst (Function.update ρ y y)).subst y (.var w) = φ.vsubst (Function.update ρ y w) := by + induction φ generalizing ρ with + | bot => rfl + | eq t₁ t₂ => + refine congrArg₂ PAFormula.eq + (term_vsubst_subst_var fun x hx ↦ h x ?_) + (term_vsubst_subst_var fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | and _ _ ih₁ ih₂ => + refine congrArg₂ PAFormula.and (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | or _ _ ih₁ ih₂ => + refine congrArg₂ PAFormula.or (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | imp _ _ ih₁ ih₂ => + refine congrArg₂ PAFormula.imp (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | all z χ ih => + simp only [PAFormula.vsubst] + by_cases hzy : z = y + · subst hzy + simp [PAFormula.subst, Function.update_idem] + · have hb : (z == y) = false := beq_eq_false_iff_ne.mpr hzy + simp only [PAFormula.subst, hb, Bool.false_eq_true, ↓reduceIte, + Function.update_comm (Ne.symm hzy)] + refine congrArg (PAFormula.all z) (ih fun x hx hxy ↦ ?_) + by_cases hxz : x = z + · subst hxz; simp [hzy] + · simp only [Function.update_of_ne hxz] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxz, hx]) hxy + | ex z χ ih => + simp only [PAFormula.vsubst] + by_cases hzy : z = y + · subst hzy + simp [PAFormula.subst, Function.update_idem] + · have hb : (z == y) = false := beq_eq_false_iff_ne.mpr hzy + simp only [PAFormula.subst, hb, Bool.false_eq_true, ↓reduceIte, + Function.update_comm (Ne.symm hzy)] + refine congrArg (PAFormula.ex z) (ih fun x hx hxy ↦ ?_) + by_cases hxz : x = z + · subst hxz; simp [hzy] + · simp only [Function.update_of_ne hxz] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxz, hx]) hxy + +private theorem vsubst_update_id_eq_subst (ψ : PAFormula) (x w : ℕ) : + ψ.vsubst (Function.update id x w) = ψ.subst x (.var w) := by + have heq := vsubst_subst_var (φ := ψ) (ρ := id) (y := x) (w := w) + (fun z _ hzx ↦ hzx) + rw [update_id_self, vsubst_id] at heq + exact heq.symm + +/-- Variable renaming `ρ` is capture-safe for `φ`: every free variable `x` of `φ` is either left +fixed (`ρ x = x`) or mapped to a variable ≥ `φ.maxVar` (disjoint from all variables of `φ`). -/ +private def SafeFor (ρ : ℕ → ℕ) (φ : PAFormula) : Prop := + ∀ x, φ.hasFree x = true → ρ x = x ∨ φ.maxVar ≤ ρ x + +private theorem safeFor_id (φ : PAFormula) : SafeFor id φ := + fun _ _ ↦ Or.inl rfl + +private theorem safeFor_mono {ρ : ℕ → ℕ} {φ ψ : PAFormula} (h : SafeFor ρ ψ) + (hmax : φ.maxVar ≤ ψ.maxVar) (hfree : ∀ x, φ.hasFree x = true → ψ.hasFree x = true) : + SafeFor ρ φ := by + intro x hx + rcases h x (hfree x hx) with heq | hge + · exact Or.inl heq + · exact Or.inr (le_trans hmax hge) + +private theorem safeFor_update_fresh {ρ : ℕ → ℕ} {y w : ℕ} {φ : PAFormula} + (h : ∀ x, φ.hasFree x = true → x ≠ y → ρ x = x ∨ φ.maxVar ≤ ρ x) + (hw : φ.maxVar ≤ w) : + SafeFor (Function.update ρ y w) φ := by + intro x hx + by_cases hxy : x = y + · subst hxy; simp [hw] + · simp only [Function.update_of_ne hxy] + exact h x hx hxy + +private theorem freshVar_le_vsubst {t : PATerm} {σ : ℕ → ℕ} + (h : ∀ x, t.hasVar x = true → x ≤ σ x) : + t.freshVar ≤ (t.vsubst σ).freshVar := by + induction t with + | var x => + simp only [PATerm.freshVar, PATerm.vsubst] + have hx := h x (by simp [PATerm.hasVar]) + omega + | zero => exact Nat.le_refl 0 + | succ _ ih => exact ih h + | add t₁ t₂ ih₁ ih₂ | mul t₁ t₂ ih₁ ih₂ => + refine max_le_max (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + +private theorem maxVar_le_vsubst_maxVar {φ : PAFormula} {σ : ℕ → ℕ} + (h : ∀ x, φ.hasFree x = true → x ≤ σ x) : + φ.maxVar ≤ (φ.vsubst σ).maxVar := by + induction φ generalizing σ with + | bot => exact Nat.le_refl 0 + | eq t₁ t₂ => + refine max_le_max + (freshVar_le_vsubst fun x hx ↦ h x ?_) + (freshVar_le_vsubst fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + refine max_le_max (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | all z χ ih | ex z χ ih => + refine max_le_max (Nat.le_refl (z + 1)) (ih fun x hx ↦ ?_) + by_cases hxz : x = z + · subst hxz; simp + · simp only [Function.update_of_ne hxz] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxz, hx]) + +/-! ## Section 2: Finite-Context Derivability, Deduction Theorem, and FOL Lemmas -/ + +/-- Derivability from a finite hypothesis list `Δ` over `PAProvable` using only modus ponens +(with universal generalization restricted to theorems of `PAProvable`, ensuring the unconditional +deduction theorem). -/ +private inductive CtxProvable (Δ : List PAFormula) : PAFormula → Prop where + | ax {φ : PAFormula} : PAProvable φ → CtxProvable Δ φ + | hyp {φ : PAFormula} : φ ∈ Δ → CtxProvable Δ φ + | mp {φ ψ : PAFormula} : CtxProvable Δ φ → CtxProvable Δ (.imp φ ψ) → CtxProvable Δ ψ + +private theorem ctx_nil_iff {φ : PAFormula} : CtxProvable [] φ ↔ PAProvable φ := by + refine ⟨fun h ↦ ?_, CtxProvable.ax⟩ + induction h with + | ax hp => exact hp + | hyp hm => cases hm + | mp _ _ ih₁ ih₂ => exact .mp ih₁ ih₂ + +private theorem ctx_mono {Δ₁ Δ₂ : List PAFormula} (hsub : ∀ γ ∈ Δ₁, γ ∈ Δ₂) + {φ : PAFormula} (h : CtxProvable Δ₁ φ) : CtxProvable Δ₂ φ := by + induction h with + | ax hp => exact .ax hp + | hyp hm => exact .hyp (hsub _ hm) + | mp _ _ ih₁ ih₂ => exact .mp ih₁ ih₂ + +private theorem ctx_imp_refl (Δ : List PAFormula) (φ : PAFormula) : + CtxProvable Δ (.imp φ φ) := + .mp (.ax (.imp_k φ φ)) + (.mp (.ax (.imp_k φ (.imp φ φ))) (.ax (.imp_s φ (.imp φ φ) φ))) + +private theorem ctx_deduction {Δ : List PAFormula} {α β : PAFormula} + (h : CtxProvable (α :: Δ) β) : CtxProvable Δ (.imp α β) := by + induction h with + | ax hp => exact .mp (.ax hp) (.ax (.imp_k _ α)) + | hyp hm => + rcases List.mem_cons.mp hm with heq | hm' + · subst heq; exact ctx_imp_refl Δ _ + · exact .mp (.hyp hm') (.ax (.imp_k _ α)) + | mp _ _ ih₁ ih₂ => + exact .mp ih₁ (.mp ih₂ (.ax (.imp_s α _ _))) + +private theorem ctx_by_contra {Δ : List PAFormula} {φ : PAFormula} + (h : CtxProvable (φ.not :: Δ) .bot) : CtxProvable Δ φ := + .mp (ctx_deduction h) (.ax (.dne φ)) + +private theorem ctx_exfalso {Δ : List PAFormula} (φ : PAFormula) + (h : CtxProvable Δ .bot) : CtxProvable Δ φ := + ctx_by_contra (ctx_mono (fun _ hm ↦ List.mem_cons_of_mem _ hm) h) + +private theorem ctx_gen (w : ℕ) {Δ : List PAFormula} {α : PAFormula} + (hf : ∀ γ ∈ Δ, γ.hasFree w = false) (h : CtxProvable Δ α) : + CtxProvable Δ (.all w α) := by + induction Δ generalizing α with + | nil => + exact .ax (.gen w (ctx_nil_iff.mp h)) + | cons δ Δ' ih => + have hded : CtxProvable Δ' (.imp δ α) := ctx_deduction h + have hall : CtxProvable Δ' (.all w (.imp δ α)) := + ih (fun γ hγ ↦ hf γ (List.mem_cons_of_mem _ hγ)) hded + have himp : CtxProvable Δ' (.imp (.all w δ) (.all w α)) := + .mp hall (.ax (.all_imp w δ α)) + have himp' : CtxProvable (δ :: Δ') (.imp (.all w δ) (.all w α)) := + ctx_mono (fun _ hm ↦ List.mem_cons_of_mem _ hm) himp + have hvac : PAProvable (.imp δ (.all w δ)) := + .all_vacuous w δ (hf δ (List.mem_cons_self ..)) + exact .mp (.mp (.hyp (List.mem_cons_self ..)) (.ax hvac)) himp' + +private theorem pa_all_not_subst_imp_not_ex {x w : ℕ} {ψ : PAFormula} + (hw : (PAFormula.ex x ψ).maxVar ≤ w) : + PAProvable (.imp (.all w (.not (ψ.subst x (.var w)))) (.not (.ex x ψ))) := by + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hwx : w ≠ x := by omega + let γ : PAFormula := .all w (.not (ψ.subst x (.var w))) + have hγx : γ.hasFree x = false := by + simp [γ, PAFormula.hasFree, hasFree_subst_var_self_false hwx] + have hfree : (PAFormula.not (ψ.subst x (.var w))).freeFor w (.var x) = true := by + simp [PAFormula.freeFor, freeFor_inverse_var hw.2] + have hsub : (PAFormula.not (ψ.subst x (.var w))).subst w (.var x) = ψ.not := by + simp [PAFormula.subst, subst_inverse_var hw.2] + have helim : PAProvable (.imp γ ψ.not) := by + have h := PAProvable.all_elim w (.var x) (.not (ψ.subst x (.var w))) hfree + rwa [hsub] at h + have h1 : CtxProvable [γ] ψ.not := + .mp (.hyp (List.mem_singleton.mpr rfl)) (.ax helim) + have h2 : CtxProvable [γ] (.all x (.imp ψ .bot)) := + ctx_gen x (fun δ hδ ↦ by rw [List.mem_singleton.mp hδ]; exact hγx) h1 + have h3 : CtxProvable [γ] (.not (.ex x ψ)) := + .mp h2 (.ax (.ex_elim x ψ .bot rfl)) + exact ctx_nil_iff.mp (ctx_deduction h3) + +private theorem pa_de_morgan_all (y : ℕ) (ψ : PAFormula) : + PAProvable (.imp (.not (.all y ψ)) (.ex y (.not ψ))) := by + let γ₁ : PAFormula := (PAFormula.ex y ψ.not).not + let γ₂ : PAFormula := (PAFormula.all y ψ).not + have hfree : ψ.not.freeFor y (.var y) = true := freeFor_var_self y ψ.not + have hex : PAProvable (.imp ψ.not (.ex y ψ.not)) := by + have h := PAProvable.ex_intro y (.var y) ψ.not hfree + rwa [subst_var_self] at h + have hbot₁ : CtxProvable [ψ.not, γ₁, γ₂] .bot := by + have hn : CtxProvable [ψ.not, γ₁, γ₂] ψ.not := .hyp (by simp) + have hg₁ : CtxProvable [ψ.not, γ₁, γ₂] γ₁ := .hyp (by simp) + exact .mp (.mp hn (.ax hex)) hg₁ + have hψ : CtxProvable [γ₁, γ₂] ψ := ctx_by_contra hbot₁ + have hall : CtxProvable [γ₁, γ₂] (.all y ψ) := by + refine ctx_gen y (fun δ hδ ↦ ?_) hψ + rcases List.mem_cons.mp hδ with rfl | hδ' + · simp [γ₁, PAFormula.hasFree] + · rw [List.mem_singleton.mp hδ'] + simp [γ₂, PAFormula.hasFree] + have hbot₂ : CtxProvable [γ₁, γ₂] .bot := + .mp hall (.hyp (by simp [γ₂])) + exact ctx_nil_iff.mp (ctx_deduction (ctx_by_contra hbot₂)) + +private theorem pa_eq_symm (s t : PATerm) : + PAProvable (.imp (.eq s t) (.eq t s)) := by + let x := max s.freshVar t.freshVar + have hsx : s.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + let φ : PAFormula := .eq (.var x) s + have hsub_s : φ.subst x s = .eq s s := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false s hsx] + have hsub_t : φ.subst x t = .eq t s := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false t hsx] + have heq := PAProvable.eq_subst x s t φ rfl rfl + rw [hsub_s, hsub_t] at heq + have hctx : CtxProvable [.eq s t] (.eq t s) := + .mp (.ax (.eq_refl s)) (.mp (.hyp (List.mem_singleton.mpr rfl)) (.ax heq)) + exact ctx_nil_iff.mp (ctx_deduction hctx) + +private theorem pa_eq_trans (r s t : PATerm) : + PAProvable (.imp (.eq r s) (.imp (.eq s t) (.eq r t))) := by + let x := r.freshVar + have hrx : r.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_refl _) + let φ : PAFormula := .eq r (.var x) + have hsub_s : φ.subst x s = .eq r s := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false s hrx] + have hsub_t : φ.subst x t = .eq r t := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false t hrx] + have heq := PAProvable.eq_subst x s t φ rfl rfl + rw [hsub_s, hsub_t] at heq + have hctx : CtxProvable [.eq s t, .eq r s] (.eq r t) := + .mp (.hyp (by simp)) (.mp (.hyp (by simp)) (.ax heq)) + exact ctx_nil_iff.mp (ctx_deduction (ctx_deduction hctx)) + +private theorem pa_eq_succ (s t : PATerm) : + PAProvable (.imp (.eq s t) (.eq (.succ s) (.succ t))) := by + let x := s.freshVar + have hsx : s.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_refl _) + let φ : PAFormula := .eq (.succ s) (.succ (.var x)) + have hsub_s : φ.subst x s = .eq (.succ s) (.succ s) := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false s hsx] + have hsub_t : φ.subst x t = .eq (.succ s) (.succ t) := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false t hsx] + have heq := PAProvable.eq_subst x s t φ rfl rfl + rw [hsub_s, hsub_t] at heq + have hctx : CtxProvable [.eq s t] (.eq (.succ s) (.succ t)) := + .mp (.ax (.eq_refl (.succ s))) (.mp (.hyp (List.mem_singleton.mpr rfl)) (.ax heq)) + exact ctx_nil_iff.mp (ctx_deduction hctx) + +private theorem pa_eq_add (s₁ t₁ s₂ t₂ : PATerm) : + PAProvable (.imp (.eq s₁ t₁) (.imp (.eq s₂ t₂) (.eq (.add s₁ s₂) (.add t₁ t₂)))) := by + let x := max s₁.freshVar s₂.freshVar + have hs₁x : s₁.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + have hs₂x : s₂.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let φ₁ : PAFormula := .eq (.add s₁ s₂) (.add (.var x) s₂) + have heq₁ := PAProvable.eq_subst x s₁ t₁ φ₁ rfl rfl + simp only [φ₁, PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, + term_subst_eq_self_of_hasVar_false s₁ hs₁x, term_subst_eq_self_of_hasVar_false t₁ hs₁x, + term_subst_eq_self_of_hasVar_false s₁ hs₂x, term_subst_eq_self_of_hasVar_false t₁ hs₂x] at heq₁ + let y := max t₁.freshVar s₂.freshVar + have ht₁y : t₁.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + have hs₂y : s₂.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let φ₂ : PAFormula := .eq (.add t₁ s₂) (.add t₁ (.var y)) + have heq₂ := PAProvable.eq_subst y s₂ t₂ φ₂ rfl rfl + simp only [φ₂, PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, + term_subst_eq_self_of_hasVar_false s₂ ht₁y, term_subst_eq_self_of_hasVar_false t₂ ht₁y, + term_subst_eq_self_of_hasVar_false s₂ hs₂y, term_subst_eq_self_of_hasVar_false t₂ hs₂y] at heq₂ + have hctx : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.add s₁ s₂) (.add t₁ t₂)) := by + have hA : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.add s₁ s₂) (.add t₁ s₂)) := + .mp (.ax (.eq_refl (.add s₁ s₂))) (.mp (.hyp (by simp)) (.ax heq₁)) + have hB : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.add t₁ s₂) (.add t₁ t₂)) := + .mp (.ax (.eq_refl (.add t₁ s₂))) (.mp (.hyp (by simp)) (.ax heq₂)) + exact .mp hB (.mp hA (.ax (pa_eq_trans (.add s₁ s₂) (.add t₁ s₂) (.add t₁ t₂)))) + exact ctx_nil_iff.mp (ctx_deduction (ctx_deduction hctx)) + +private theorem pa_eq_mul (s₁ t₁ s₂ t₂ : PATerm) : + PAProvable (.imp (.eq s₁ t₁) (.imp (.eq s₂ t₂) (.eq (.mul s₁ s₂) (.mul t₁ t₂)))) := by + let x := max s₁.freshVar s₂.freshVar + have hs₁x : s₁.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + have hs₂x : s₂.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let φ₁ : PAFormula := .eq (.mul s₁ s₂) (.mul (.var x) s₂) + have heq₁ := PAProvable.eq_subst x s₁ t₁ φ₁ rfl rfl + simp only [φ₁, PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, + term_subst_eq_self_of_hasVar_false s₁ hs₁x, term_subst_eq_self_of_hasVar_false t₁ hs₁x, + term_subst_eq_self_of_hasVar_false s₁ hs₂x, term_subst_eq_self_of_hasVar_false t₁ hs₂x] at heq₁ + let y := max t₁.freshVar s₂.freshVar + have ht₁y : t₁.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + have hs₂y : s₂.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let φ₂ : PAFormula := .eq (.mul t₁ s₂) (.mul t₁ (.var y)) + have heq₂ := PAProvable.eq_subst y s₂ t₂ φ₂ rfl rfl + simp only [φ₂, PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, + term_subst_eq_self_of_hasVar_false s₂ ht₁y, term_subst_eq_self_of_hasVar_false t₂ ht₁y, + term_subst_eq_self_of_hasVar_false s₂ hs₂y, term_subst_eq_self_of_hasVar_false t₂ hs₂y] at heq₂ + have hctx : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.mul s₁ s₂) (.mul t₁ t₂)) := by + have hA : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.mul s₁ s₂) (.mul t₁ s₂)) := + .mp (.ax (.eq_refl (.mul s₁ s₂))) (.mp (.hyp (by simp)) (.ax heq₁)) + have hB : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.mul t₁ s₂) (.mul t₁ t₂)) := + .mp (.ax (.eq_refl (.mul t₁ s₂))) (.mp (.hyp (by simp)) (.ax heq₂)) + exact .mp hB (.mp hA (.ax (pa_eq_trans (.mul s₁ s₂) (.mul t₁ s₂) (.mul t₁ t₂)))) + exact ctx_nil_iff.mp (ctx_deduction (ctx_deduction hctx)) + +private theorem pa_exists_var_eq (B : ℕ) (t : PATerm) : + let y := max B t.freshVar + PAProvable (.ex y (.eq (.var y) t)) := by + intro y + have hty : t.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let ψ : PAFormula := .eq (.var y) t + have hsub : ψ.subst y t = .eq t t := by + simp [ψ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false t hty] + have hex := PAProvable.ex_intro y t ψ rfl + rw [hsub] at hex + exact .mp (.eq_refl t) hex + +/-! ## Section 3: Countable Formula Enumeration and Henkin–Lindenbaum Saturation -/ + +private def encodeTerm : PATerm → ℕ + | .zero => 0 + | .var x => Nat.pair 0 x + 1 + | .succ t => Nat.pair 1 (encodeTerm t) + 1 + | .add t₁ t₂ => Nat.pair 2 (Nat.pair (encodeTerm t₁) (encodeTerm t₂)) + 1 + | .mul t₁ t₂ => Nat.pair 3 (Nat.pair (encodeTerm t₁) (encodeTerm t₂)) + 1 + +private def decodeTerm : ℕ → PATerm + | 0 => .zero + | n + 1 => + let p := Nat.unpair n + let q := Nat.unpair p.2 + match p.1 with + | 0 => .var p.2 + | 1 => .succ (decodeTerm p.2) + | 2 => .add (decodeTerm q.1) (decodeTerm q.2) + | 3 => .mul (decodeTerm q.1) (decodeTerm q.2) + | _ => .zero +termination_by k => k +decreasing_by + · exact Nat.lt_succ_of_le (Nat.unpair_right_le n) + · exact Nat.lt_succ_of_le (le_trans (Nat.unpair_left_le _) (Nat.unpair_right_le n)) + · exact Nat.lt_succ_of_le (le_trans (Nat.unpair_right_le _) (Nat.unpair_right_le n)) + · exact Nat.lt_succ_of_le (le_trans (Nat.unpair_left_le _) (Nat.unpair_right_le n)) + · exact Nat.lt_succ_of_le (le_trans (Nat.unpair_right_le _) (Nat.unpair_right_le n)) + +private theorem decodeTerm_encodeTerm (t : PATerm) : decodeTerm (encodeTerm t) = t := by + induction t with + | zero => simp [encodeTerm, decodeTerm] + | var x => simp [encodeTerm, decodeTerm, Nat.unpair_pair] + | succ t ih => simp [encodeTerm, decodeTerm, Nat.unpair_pair, ih] + | add t₁ t₂ ih₁ ih₂ => simp [encodeTerm, decodeTerm, Nat.unpair_pair, ih₁, ih₂] + | mul t₁ t₂ ih₁ ih₂ => simp [encodeTerm, decodeTerm, Nat.unpair_pair, ih₁, ih₂] + +private def encodeForm : PAFormula → ℕ + | .bot => 0 + | .eq t₁ t₂ => Nat.pair 0 (Nat.pair (encodeTerm t₁) (encodeTerm t₂)) + 1 + | .and φ ψ => Nat.pair 1 (Nat.pair (encodeForm φ) (encodeForm ψ)) + 1 + | .or φ ψ => Nat.pair 2 (Nat.pair (encodeForm φ) (encodeForm ψ)) + 1 + | .imp φ ψ => Nat.pair 3 (Nat.pair (encodeForm φ) (encodeForm ψ)) + 1 + | .all x φ => Nat.pair 4 (Nat.pair x (encodeForm φ)) + 1 + | .ex x φ => Nat.pair 5 (Nat.pair x (encodeForm φ)) + 1 + +private def decodeForm : ℕ → PAFormula + | 0 => .bot + | n + 1 => + let p := Nat.unpair n + let q := Nat.unpair p.2 + match p.1 with + | 0 => .eq (decodeTerm q.1) (decodeTerm q.2) + | 1 => .and (decodeForm q.1) (decodeForm q.2) + | 2 => .or (decodeForm q.1) (decodeForm q.2) + | 3 => .imp (decodeForm q.1) (decodeForm q.2) + | 4 => .all q.1 (decodeForm q.2) + | 5 => .ex q.1 (decodeForm q.2) + | _ => .bot +termination_by k => k +decreasing_by + all_goals + first + | exact Nat.lt_succ_of_le (le_trans (Nat.unpair_left_le _) (Nat.unpair_right_le n)) + | exact Nat.lt_succ_of_le (le_trans (Nat.unpair_right_le _) (Nat.unpair_right_le n)) + +private theorem decodeForm_encodeForm (φ : PAFormula) : decodeForm (encodeForm φ) = φ := by + induction φ with + | bot => simp [encodeForm, decodeForm] + | eq t₁ t₂ => + simp [encodeForm, decodeForm, Nat.unpair_pair, decodeTerm_encodeTerm] + | and _ _ ih₁ ih₂ => simp [encodeForm, decodeForm, Nat.unpair_pair, ih₁, ih₂] + | or _ _ ih₁ ih₂ => simp [encodeForm, decodeForm, Nat.unpair_pair, ih₁, ih₂] + | imp _ _ ih₁ ih₂ => simp [encodeForm, decodeForm, Nat.unpair_pair, ih₁, ih₂] + | all _ _ ih => simp [encodeForm, decodeForm, Nat.unpair_pair, ih] + | ex _ _ ih => simp [encodeForm, decodeForm, Nat.unpair_pair, ih] + +private def maxVarList : List PAFormula → ℕ + | [] => 0 + | φ :: rest => max φ.maxVar (maxVarList rest) + +private theorem maxVar_le_maxVarList {Δ : List PAFormula} {φ : PAFormula} (h : φ ∈ Δ) : + φ.maxVar ≤ maxVarList Δ := by + induction Δ with + | nil => cases h + | cons δ rest ih => + rcases List.mem_cons.mp h with rfl | hm + · exact Nat.le_max_left .. + · exact le_trans (ih hm) (Nat.le_max_right ..) + +private theorem henkin_step_consistent {Δ : List PAFormula} (x : ℕ) (ψ : PAFormula) + (hcons : ¬ CtxProvable Δ .bot) : + let w := max (maxVarList Δ) (PAFormula.ex x ψ).maxVar + ¬ CtxProvable ((.imp (.ex x ψ) (ψ.subst x (.var w))) :: Δ) .bot := by + intro w hbot + apply hcons + let θ := PAFormula.imp (.ex x ψ) (ψ.subst x (.var w)) + have hθ_not : CtxProvable Δ θ.not := ctx_deduction hbot + have hex : CtxProvable Δ (.ex x ψ) := by + refine ctx_by_contra ?_ + have h1 : CtxProvable [.ex x ψ, (PAFormula.ex x ψ).not] (ψ.subst x (.var w)) := + ctx_exfalso _ (.mp (φ := PAFormula.ex x ψ) (.hyp (by simp)) (.hyp (by simp))) + have h2 : CtxProvable [(PAFormula.ex x ψ).not] θ := ctx_deduction h1 + have h3 : CtxProvable ((PAFormula.ex x ψ).not :: Δ) θ := + ctx_mono (fun _ hm ↦ by simp [List.mem_singleton.mp hm]) h2 + have h4 : CtxProvable ((PAFormula.ex x ψ).not :: Δ) θ.not := + ctx_mono (fun _ hm ↦ List.mem_cons_of_mem _ hm) hθ_not + exact .mp h3 h4 + have hn_sub : CtxProvable Δ (ψ.subst x (.var w)).not := by + refine ctx_deduction ?_ + have h1 : CtxProvable (ψ.subst x (.var w) :: Δ) θ := + .mp (.hyp (List.mem_cons_self ..)) (.ax (.imp_k _ _)) + have h2 : CtxProvable (ψ.subst x (.var w) :: Δ) θ.not := + ctx_mono (fun _ hm ↦ List.mem_cons_of_mem _ hm) hθ_not + exact .mp h1 h2 + have hfresh : ∀ γ ∈ Δ, γ.hasFree w = false := fun γ hγ ↦ + hasFree_false_of_maxVar_le (le_trans (maxVar_le_maxVarList hγ) (Nat.le_max_left ..)) + have hall : CtxProvable Δ (.all w (ψ.subst x (.var w)).not) := ctx_gen w hfresh hn_sub + have hn_ex : CtxProvable Δ (PAFormula.ex x ψ).not := + .mp hall (.ax (pa_all_not_subst_imp_not_ex (Nat.le_max_right ..))) + exact .mp hex hn_ex + +/-- Add Henkin witness if `ψ` is existential. -/ +private def extendWithWitness (ψ : PAFormula) (Δ : List PAFormula) : List PAFormula := + match ψ with + | .ex x χ => + let w := max (maxVarList (ψ :: Δ)) (PAFormula.ex x χ).maxVar + (.imp (.ex x χ) (χ.subst x (.var w))) :: ψ :: Δ + | _ => ψ :: Δ + +/-- Single-pass Henkin–Lindenbaum chain starting from `[φ₀]`. -/ +private noncomputable def henkinChain (φ₀ : PAFormula) : ℕ → List PAFormula + | 0 => [φ₀] + | n + 1 => + let Δ := henkinChain φ₀ n + let ψ := decodeForm n + open Classical in + if CtxProvable (ψ :: Δ) .bot then + ψ.not :: Δ + else + extendWithWitness ψ Δ + +private theorem henkinChain_subset_succ (φ₀ : PAFormula) (n : ℕ) : + ∀ α ∈ henkinChain φ₀ n, α ∈ henkinChain φ₀ (n + 1) := by + intro α hα + simp only [henkinChain] + split_ifs + · exact List.mem_cons_of_mem _ hα + · unfold extendWithWitness + cases decodeForm n <;> simp [hα] + +private theorem henkinChain_mono (φ₀ : PAFormula) {m n : ℕ} (h : m ≤ n) : + ∀ α ∈ henkinChain φ₀ m, α ∈ henkinChain φ₀ n := by + induction h with + | refl => exact fun _ hα ↦ hα + | step _ ih => exact fun α hα ↦ henkinChain_subset_succ φ₀ _ α (ih α hα) + +private theorem henkinChain_consistent {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) : + ∀ n, ¬ CtxProvable (henkinChain φ₀ n) .bot := by + intro n + induction n with + | zero => exact h₀ + | succ n ih => + simp only [henkinChain] + split_ifs with hbot_ψ + · have hnψ : CtxProvable (henkinChain φ₀ n) (decodeForm n).not := ctx_deduction hbot_ψ + intro hbot + exact ih (.mp hnψ (ctx_deduction hbot)) + · unfold extendWithWitness + cases hdec : decodeForm n with + | ex x χ => + rw [hdec] at hbot_ψ + exact henkin_step_consistent x χ hbot_ψ + | _ => + rwa [hdec] at hbot_ψ + +/-- Maximal consistent Henkin-saturated theory extending `φ₀`. -/ +private def henkinTheory (φ₀ : PAFormula) : Set PAFormula := + { α | ∃ n, α ∈ henkinChain φ₀ n } + +private theorem henkinTheory_mem_zero (φ₀ : PAFormula) : + φ₀ ∈ henkinTheory φ₀ := + ⟨0, List.mem_singleton.mpr rfl⟩ + +private theorem henkinTheory_not_bot {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) : + PAFormula.bot ∉ henkinTheory φ₀ := by + rintro ⟨n, hn⟩ + exact henkinChain_consistent h₀ n (.hyp hn) + +private theorem henkinTheory_complete (φ₀ : PAFormula) (ψ : PAFormula) : + ψ ∈ henkinTheory φ₀ ∨ ψ.not ∈ henkinTheory φ₀ := by + let n := encodeForm ψ + have hdec : decodeForm n = ψ := decodeForm_encodeForm ψ + by_cases hbot : CtxProvable (ψ :: henkinChain φ₀ n) .bot + · refine Or.inr ⟨n + 1, ?_⟩ + simp only [henkinChain, hdec, hbot, ↓reduceIte] + exact List.mem_cons_self .. + · refine Or.inl ⟨n + 1, ?_⟩ + simp only [henkinChain, hdec, hbot, ↓reduceIte] + unfold extendWithWitness + cases ψ <;> simp + +private theorem henkinChain_fin_subset {φ₀ : PAFormula} (Γ : List PAFormula) + (hΓ : ∀ γ ∈ Γ, γ ∈ henkinTheory φ₀) : + ∃ N, ∀ γ ∈ Γ, γ ∈ henkinChain φ₀ N := by + induction Γ with + | nil => exact ⟨0, fun _ hm ↦ False.elim (List.not_mem_nil hm)⟩ + | cons δ rest ih => + obtain ⟨n₁, hn₁⟩ := hΓ δ (List.mem_cons_self ..) + obtain ⟨n₂, hn₂⟩ := ih fun γ hγ ↦ hΓ γ (List.mem_cons_of_mem _ hγ) + refine ⟨max n₁ n₂, fun γ hγ ↦ ?_⟩ + rcases List.mem_cons.mp hγ with heq | hm + · subst heq + exact henkinChain_mono φ₀ (Nat.le_max_left ..) _ hn₁ + · exact henkinChain_mono φ₀ (Nat.le_max_right ..) γ (hn₂ γ hm) + +private theorem henkinTheory_closed {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) + {Γ : List PAFormula} {α : PAFormula} (hprov : CtxProvable Γ α) + (hΓ : ∀ γ ∈ Γ, γ ∈ henkinTheory φ₀) : + α ∈ henkinTheory φ₀ := by + obtain ⟨N, hN⟩ := henkinChain_fin_subset Γ hΓ + have hctx : CtxProvable (henkinChain φ₀ N) α := ctx_mono hN hprov + rcases henkinTheory_complete φ₀ α with hα | hnα + · exact hα + · obtain ⟨M, hM⟩ := hnα + let K := max N M + have h₁ : CtxProvable (henkinChain φ₀ K) α := + ctx_mono (henkinChain_mono φ₀ (Nat.le_max_left ..)) hctx + have h₂ : α.not ∈ henkinChain φ₀ K := + henkinChain_mono φ₀ (Nat.le_max_right ..) _ hM + exact False.elim (henkinChain_consistent h₀ K (.mp h₁ (.hyp h₂))) + +private theorem henkinTheory_ax {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) + {α : PAFormula} (hp : PAProvable α) : α ∈ henkinTheory φ₀ := + henkinTheory_closed h₀ (Γ := []) (.ax hp) (fun _ hm ↦ False.elim (List.not_mem_nil hm)) + +private theorem henkinTheory_mp {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) + {α β : PAFormula} (hα : α ∈ henkinTheory φ₀) (himp : .imp α β ∈ henkinTheory φ₀) : + β ∈ henkinTheory φ₀ := + henkinTheory_closed h₀ (Γ := [α, .imp α β]) + (.mp (φ := α) (.hyp (by simp)) (.hyp (by simp))) (by + intro γ hγ + rcases List.mem_cons.mp hγ with heq | hγ' + · subst heq; exact hα + · rw [List.mem_singleton.mp hγ'] + exact himp) + +private theorem henkinTheory_witness {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) + {x : ℕ} {χ : PAFormula} (hex : .ex x χ ∈ henkinTheory φ₀) : + ∃ w : ℕ, (PAFormula.ex x χ).maxVar ≤ w ∧ χ.subst x (.var w) ∈ henkinTheory φ₀ := by + let n := encodeForm (.ex x χ) + have hdec : decodeForm n = .ex x χ := decodeForm_encodeForm (.ex x χ) + by_cases hbot : CtxProvable (PAFormula.ex x χ :: henkinChain φ₀ n) .bot + · have hn : (PAFormula.ex x χ).not ∈ henkinTheory φ₀ := by + refine ⟨n + 1, ?_⟩ + simp only [henkinChain, hdec, hbot, ↓reduceIte] + exact List.mem_cons_self .. + exact False.elim (henkinTheory_not_bot h₀ (henkinTheory_mp h₀ hex hn)) + · let w := max (maxVarList (PAFormula.ex x χ :: henkinChain φ₀ n)) (PAFormula.ex x χ).maxVar + have himp : PAFormula.imp (.ex x χ) (χ.subst x (.var w)) ∈ henkinTheory φ₀ := by + refine ⟨n + 1, ?_⟩ + simp only [henkinChain, hdec, hbot, ↓reduceIte, extendWithWitness] + exact List.mem_cons_self .. + exact ⟨w, Nat.le_max_right .., henkinTheory_mp h₀ hex himp⟩ + +/-! ## Section 4: Quotient Henkin Model, Truth Lemma, and Completeness -/ + +section HenkinModel + +variable {φ₀ : PAFormula} + +private def HenkinSetoid (h₀ : ¬ CtxProvable [φ₀] .bot) : Setoid PATerm where + r s t := PAFormula.eq s t ∈ henkinTheory φ₀ + iseqv := { + refl := fun t ↦ henkinTheory_ax h₀ (.eq_refl t) + symm := fun {s t} h ↦ henkinTheory_mp h₀ h (henkinTheory_ax h₀ (pa_eq_symm s t)) + trans := fun {r s t} h₁ h₂ ↦ + henkinTheory_mp h₀ h₂ (henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (pa_eq_trans r s t))) + } + +private abbrev HenkinCarrier (h₀ : ¬ CtxProvable [φ₀] .bot) : Type := + Quotient (HenkinSetoid h₀) + +private instance instPAStructureHenkin (h₀ : ¬ CtxProvable [φ₀] .bot) : + PAStructure (HenkinCarrier h₀) where + zero := Quotient.mk (HenkinSetoid h₀) .zero + succ := Quotient.lift (fun t ↦ Quotient.mk (HenkinSetoid h₀) (.succ t)) + fun s t hst ↦ Quotient.sound (henkinTheory_mp h₀ hst (henkinTheory_ax h₀ (pa_eq_succ s t))) + add := Quotient.lift₂ (fun s t ↦ Quotient.mk (HenkinSetoid h₀) (.add s t)) + fun s₁ s₂ t₁ t₂ h₁ h₂ ↦ Quotient.sound + (henkinTheory_mp h₀ h₂ (henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (pa_eq_add s₁ t₁ s₂ t₂)))) + mul := Quotient.lift₂ (fun s t ↦ Quotient.mk (HenkinSetoid h₀) (.mul s t)) + fun s₁ s₂ t₁ t₂ h₁ h₂ ↦ Quotient.sound + (henkinTheory_mp h₀ h₂ (henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (pa_eq_mul s₁ t₁ s₂ t₂)))) + +private theorem evalIn_henkin_vsubst (h₀ : ¬ CtxProvable [φ₀] .bot) (ρ : ℕ → ℕ) (t : PATerm) : + PATerm.evalIn (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) t = + Quotient.mk (HenkinSetoid h₀) (t.vsubst ρ) := by + induction t with + | var _ | zero => rfl + | succ _ ih => + simp only [PATerm.evalIn, ih, PATerm.vsubst] + rfl + | add _ _ ih₁ ih₂ => + simp only [PATerm.evalIn, ih₁, ih₂, PATerm.vsubst] + rfl + | mul _ _ ih₁ ih₂ => + simp only [PATerm.evalIn, ih₁, ih₂, PATerm.vsubst] + rfl + +private theorem exists_var_rep (h₀ : ¬ CtxProvable [φ₀] .bot) (B : ℕ) (a : HenkinCarrier h₀) : + ∃ w : ℕ, B ≤ w ∧ Quotient.mk (HenkinSetoid h₀) (.var w) = a := by + obtain ⟨t, rfl⟩ := Quotient.exists_rep a + let y := max B t.freshVar + have hex : PAFormula.ex y (.eq (.var y) t) ∈ henkinTheory φ₀ := + henkinTheory_ax h₀ (pa_exists_var_eq B t) + obtain ⟨w, hw, hsub⟩ := henkinTheory_witness h₀ hex + have hty : t.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + have ht_w : t.subst y (.var w) = t := term_subst_eq_self_of_hasVar_false (.var w) hty + simp only [PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, ht_w] at hsub + have hBw : B ≤ w := by + simp only [PAFormula.maxVar, Nat.max_le] at hw + have : B ≤ y := Nat.le_max_left .. + omega + exact ⟨w, hBw, Quotient.sound hsub⟩ + +private theorem henkin_truth_vsubst (h₀ : ¬ CtxProvable [φ₀] .bot) (φ : PAFormula) : + ∀ {ρ : ℕ → ℕ}, SafeFor ρ φ → + (PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) φ ↔ + φ.vsubst ρ ∈ henkinTheory φ₀) := by + induction φ with + | bot => + intro ρ _ + exact ⟨False.elim, fun h ↦ henkinTheory_not_bot h₀ h⟩ + | eq t₁ t₂ => + intro ρ _ + simp only [PAFormula.HoldsIn, evalIn_henkin_vsubst, PAFormula.vsubst, Quotient.eq] + rfl + | and φ ψ ih₁ ih₂ => + intro ρ hsafe + have hs₁ : SafeFor ρ φ := + safeFor_mono hsafe (Nat.le_max_left ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + have hs₂ : SafeFor ρ ψ := + safeFor_mono hsafe (Nat.le_max_right ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.HoldsIn, ih₁ hs₁, ih₂ hs₂, PAFormula.vsubst] + refine ⟨fun ⟨h₁, h₂⟩ ↦ henkinTheory_mp h₀ h₂ + (henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (.and_intro _ _))), fun h ↦ + ⟨henkinTheory_mp h₀ h (henkinTheory_ax h₀ (.and_left _ _)), + henkinTheory_mp h₀ h (henkinTheory_ax h₀ (.and_right _ _))⟩⟩ + | or φ ψ ih₁ ih₂ => + intro ρ hsafe + have hs₁ : SafeFor ρ φ := + safeFor_mono hsafe (Nat.le_max_left ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + have hs₂ : SafeFor ρ ψ := + safeFor_mono hsafe (Nat.le_max_right ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.HoldsIn, ih₁ hs₁, ih₂ hs₂, PAFormula.vsubst] + refine ⟨fun h ↦ ?_, fun hor ↦ ?_⟩ + · rcases h with h₁ | h₂ + · exact henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (.or_left _ _)) + · exact henkinTheory_mp h₀ h₂ (henkinTheory_ax h₀ (.or_right _ _)) + · rcases henkinTheory_complete φ₀ (φ.vsubst ρ) with h₁ | hn₁ + · exact Or.inl h₁ + · rcases henkinTheory_complete φ₀ (ψ.vsubst ρ) with h₂ | hn₂ + · exact Or.inr h₂ + · exfalso + have helim := henkinTheory_ax h₀ (.or_elim (φ.vsubst ρ) (ψ.vsubst ρ) .bot) + exact henkinTheory_not_bot h₀ + (henkinTheory_mp h₀ hor (henkinTheory_mp h₀ hn₂ (henkinTheory_mp h₀ hn₁ helim))) + | imp φ ψ ih₁ ih₂ => + intro ρ hsafe + have hs₁ : SafeFor ρ φ := + safeFor_mono hsafe (Nat.le_max_left ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + have hs₂ : SafeFor ρ ψ := + safeFor_mono hsafe (Nat.le_max_right ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.HoldsIn, ih₁ hs₁, ih₂ hs₂, PAFormula.vsubst] + refine ⟨fun h ↦ ?_, fun himp h₁ ↦ henkinTheory_mp h₀ h₁ himp⟩ + rcases henkinTheory_complete φ₀ (φ.vsubst ρ) with h₁ | hn₁ + · exact henkinTheory_mp h₀ (h h₁) (henkinTheory_ax h₀ (.imp_k _ _)) + · have hctx : CtxProvable [(φ.vsubst ρ).not] (.imp (φ.vsubst ρ) (ψ.vsubst ρ)) := + ctx_deduction (ctx_exfalso _ (.mp (φ := φ.vsubst ρ) (.hyp (by simp)) (.hyp (by simp)))) + exact henkinTheory_closed h₀ hctx (fun γ hγ ↦ by rw [List.mem_singleton.mp hγ]; exact hn₁) + | all y φ ih => + intro ρ hsafe + let ψ' := φ.vsubst (Function.update ρ y y) + have hno_cap : ∀ x, φ.hasFree x = true → x ≠ y → ρ x ≠ y := by + intro x hx hxy + have hall_free : (PAFormula.all y φ).hasFree x = true := by + simp [PAFormula.hasFree, Ne.symm hxy, hx] + rcases hsafe x hall_free with heq | hge + · rw [heq]; exact hxy + · simp only [PAFormula.maxVar, Nat.max_le] at hge + omega + have hsafe_base : ∀ x, φ.hasFree x = true → x ≠ y → ρ x = x ∨ φ.maxVar ≤ ρ x := by + intro x hx hxy + have hall_free : (PAFormula.all y φ).hasFree x = true := by + simp [PAFormula.hasFree, Ne.symm hxy, hx] + rcases hsafe x hall_free with heq | hge + · exact Or.inl heq + · simp only [PAFormula.maxVar, Nat.max_le] at hge + exact Or.inr hge.2 + have hmax_le : φ.maxVar ≤ ψ'.maxVar := by + refine maxVar_le_vsubst_maxVar fun x hx ↦ ?_ + by_cases hxy : x = y + · subst hxy; simp + · simp only [Function.update_of_ne hxy] + rcases hsafe_base x hx hxy with heq | hge + · omega + · exact le_trans (Nat.le_of_lt (lt_maxVar_of_hasFree hx)) hge + simp only [PAFormula.HoldsIn, PAFormula.vsubst] + refine ⟨fun hsem ↦ ?_, fun hall a ↦ ?_⟩ + · rcases henkinTheory_complete φ₀ (.all y ψ') with hmem | hnmem + · exact hmem + · exfalso + have hex : PAFormula.ex y ψ'.not ∈ henkinTheory φ₀ := + henkinTheory_mp h₀ hnmem (henkinTheory_ax h₀ (pa_de_morgan_all y ψ')) + obtain ⟨w, hw, hsub⟩ := henkinTheory_witness h₀ hex + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hw_φ : φ.maxVar ≤ w := le_trans hmax_le hw.2.1 + have hsub_eq : ψ'.subst y (.var w) = φ.vsubst (Function.update ρ y w) := + vsubst_subst_var hno_cap + simp only [PAFormula.subst, hsub_eq] at hsub + have hval := hsem (Quotient.mk (HenkinSetoid h₀) (.var w)) + have hfun : Function.update (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) y + (Quotient.mk (HenkinSetoid h₀) (.var w)) = + fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ y w x)) := by + funext x + by_cases hxy : x = y + · subst hxy; simp + · simp [hxy] + rw [hfun, ih (safeFor_update_fresh hsafe_base hw_φ)] at hval + exact henkinTheory_not_bot h₀ (henkinTheory_mp h₀ hval hsub) + · obtain ⟨w, hw, hrep⟩ := exists_var_rep h₀ (max φ.maxVar ψ'.maxVar) a + have hw_φ : φ.maxVar ≤ w := le_trans (Nat.le_max_left ..) hw + have hw_ψ' : ψ'.maxVar ≤ w := le_trans (Nat.le_max_right ..) hw + have helim := henkinTheory_ax h₀ (.all_elim y (.var w) ψ' (freeFor_var_of_maxVar_le y hw_ψ')) + have hinst : ψ'.subst y (.var w) ∈ henkinTheory φ₀ := henkinTheory_mp h₀ hall helim + rw [vsubst_subst_var hno_cap] at hinst + have hhold := (ih (safeFor_update_fresh hsafe_base hw_φ)).mpr hinst + have hfun : (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ y w x))) = + Function.update (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) y a := by + funext x + by_cases hxy : x = y + · subst hxy; simp [hrep] + · simp [hxy] + rwa [hfun] at hhold + | ex y φ ih => + intro ρ hsafe + let ψ' := φ.vsubst (Function.update ρ y y) + have hno_cap : ∀ x, φ.hasFree x = true → x ≠ y → ρ x ≠ y := by + intro x hx hxy + have hex_free : (PAFormula.ex y φ).hasFree x = true := by + simp [PAFormula.hasFree, Ne.symm hxy, hx] + rcases hsafe x hex_free with heq | hge + · rw [heq]; exact hxy + · simp only [PAFormula.maxVar, Nat.max_le] at hge + omega + have hsafe_base : ∀ x, φ.hasFree x = true → x ≠ y → ρ x = x ∨ φ.maxVar ≤ ρ x := by + intro x hx hxy + have hex_free : (PAFormula.ex y φ).hasFree x = true := by + simp [PAFormula.hasFree, Ne.symm hxy, hx] + rcases hsafe x hex_free with heq | hge + · exact Or.inl heq + · simp only [PAFormula.maxVar, Nat.max_le] at hge + exact Or.inr hge.2 + have hmax_le : φ.maxVar ≤ ψ'.maxVar := by + refine maxVar_le_vsubst_maxVar fun x hx ↦ ?_ + by_cases hxy : x = y + · subst hxy; simp + · simp only [Function.update_of_ne hxy] + rcases hsafe_base x hx hxy with heq | hge + · omega + · exact le_trans (Nat.le_of_lt (lt_maxVar_of_hasFree hx)) hge + simp only [PAFormula.HoldsIn, PAFormula.vsubst] + refine ⟨?_, fun hex ↦ ?_⟩ + · rintro ⟨a, ha⟩ + obtain ⟨w, hw, hrep⟩ := exists_var_rep h₀ (max φ.maxVar ψ'.maxVar) a + have hw_φ : φ.maxVar ≤ w := le_trans (Nat.le_max_left ..) hw + have hw_ψ' : ψ'.maxVar ≤ w := le_trans (Nat.le_max_right ..) hw + have hfun : Function.update (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) y a = + fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ y w x)) := by + funext x + by_cases hxy : x = y + · subst hxy; simp [hrep] + · simp [hxy] + rw [hfun, ih (safeFor_update_fresh hsafe_base hw_φ)] at ha + rw [← vsubst_subst_var hno_cap] at ha + have hintro := henkinTheory_ax h₀ (.ex_intro y (.var w) ψ' (freeFor_var_of_maxVar_le y hw_ψ')) + exact henkinTheory_mp h₀ ha hintro + · obtain ⟨w, hw, hsub⟩ := henkinTheory_witness h₀ hex + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hw_φ : φ.maxVar ≤ w := le_trans hmax_le hw.2 + rw [vsubst_subst_var hno_cap] at hsub + have hhold := (ih (safeFor_update_fresh hsafe_base hw_φ)).mpr hsub + refine ⟨Quotient.mk (HenkinSetoid h₀) (.var w), ?_⟩ + have hfun : (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ y w x))) = + Function.update (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) y + (Quotient.mk (HenkinSetoid h₀) (.var w)) := by + funext x + by_cases hxy : x = y + · subst hxy; simp + · simp [hxy] + rwa [hfun] at hhold + +private theorem henkin_truth_id (h₀ : ¬ CtxProvable [φ₀] .bot) (φ : PAFormula) : + PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var x)) φ ↔ + φ ∈ henkinTheory φ₀ := by + have h := henkin_truth_vsubst h₀ φ (safeFor_id φ) + rwa [vsubst_id] at h + +private theorem henkin_holds_of_provable (h₀ : ¬ CtxProvable [φ₀] .bot) {φ : PAFormula} + (hp : PAProvable φ) : + PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var x)) φ := + (henkin_truth_id h₀ φ).mpr (henkinTheory_ax h₀ hp) + +private instance instPAModelHenkin (h₀ : ¬ CtxProvable [φ₀] .bot) : + PAModel (HenkinCarrier h₀) where + zero_ne_succ a := by + have h := henkin_holds_of_provable h₀ (.gen 0 .pa_zero_ne_succ) + exact h a + succ_inj {a b} hab := by + have h := henkin_holds_of_provable h₀ (.gen 0 (.gen 1 .pa_succ_inj)) + have h1 := h a b + have h01 : (0 : ℕ) ≠ 1 := by decide + simp only [PAFormula.HoldsIn, PATerm.evalIn, Function.update_self, + Function.update_of_ne h01] at h1 + exact h1 hab + add_zero a := by + have h := henkin_holds_of_provable h₀ (.gen 0 .pa_add_zero) + exact h a + add_succ a b := by + have h := henkin_holds_of_provable h₀ (.gen 0 (.gen 1 .pa_add_succ)) + have h1 := h a b + have h01 : (0 : ℕ) ≠ 1 := by decide + simp only [PAFormula.HoldsIn, PATerm.evalIn, Function.update_self, + Function.update_of_ne h01] at h1 + exact h1 + mul_zero a := by + have h := henkin_holds_of_provable h₀ (.gen 0 .pa_mul_zero) + exact h a + mul_succ a b := by + have h := henkin_holds_of_provable h₀ (.gen 0 (.gen 1 .pa_mul_succ)) + have h1 := h a b + have h01 : (0 : ℕ) ≠ 1 := by decide + simp only [PAFormula.HoldsIn, PATerm.evalIn, Function.update_self, + Function.update_of_ne h01] at h1 + exact h1 + ind x φ v hbase hstep a := by + have hex_ρ : ∀ z : ℕ, ∃ w : ℕ, max φ.maxVar (x + 1) ≤ w ∧ + Quotient.mk (HenkinSetoid h₀) (.var w) = v z := + fun z ↦ exists_var_rep h₀ (max φ.maxVar (x + 1)) (v z) + choose ρ hρ_ge hρ_eq using hex_ρ + let ψ := φ.vsubst (Function.update ρ x x) + let v₀ : ℕ → HenkinCarrier h₀ := fun z ↦ Quotient.mk (HenkinSetoid h₀) (.var z) + have hiff : ∀ b : HenkinCarrier h₀, + PAFormula.HoldsIn (Function.update v x b) φ ↔ + PAFormula.HoldsIn (Function.update v₀ x b) ψ := by + intro b + obtain ⟨w, hw, hrep⟩ := exists_var_rep h₀ (max φ.maxVar ψ.maxVar) b + have hw_φ : φ.maxVar ≤ w := le_trans (Nat.le_max_left ..) hw + have hw_ψ : ψ.maxVar ≤ w := le_trans (Nat.le_max_right ..) hw + have hv_eq : Function.update v x b = + fun z ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ x w z)) := by + funext z + by_cases hzx : z = x + · subst hzx; simp [hrep] + · simp [hzx, hρ_eq z] + have hv₀_eq : Function.update v₀ x b = + fun z ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update id x w z)) := by + funext z + by_cases hzx : z = x + · subst hzx; simp [hrep] + · simp [hzx, v₀] + have hsafe_φ : SafeFor (Function.update ρ x w) φ := + safeFor_update_fresh (fun z _ _ ↦ Or.inr (le_trans (Nat.le_max_left ..) (hρ_ge z))) hw_φ + have hsafe_ψ : SafeFor (Function.update id x w) ψ := + safeFor_update_fresh (fun _ _ _ ↦ Or.inl rfl) hw_ψ + have hno_cap : ∀ z, φ.hasFree z = true → z ≠ x → ρ z ≠ x := by + intro z _ _ + have hge := hρ_ge z + simp only [Nat.max_le] at hge + omega + have heq_form : ψ.vsubst (Function.update id x w) = φ.vsubst (Function.update ρ x w) := by + rw [vsubst_update_id_eq_subst, vsubst_subst_var hno_cap] + rw [hv_eq, hv₀_eq, henkin_truth_vsubst h₀ φ hsafe_φ, henkin_truth_vsubst h₀ ψ hsafe_ψ, + heq_form] + have hind := henkin_holds_of_provable h₀ (.pa_ind x ψ) + simp only [PAFormula.HoldsIn] at hind + have hbase_ψ : PAFormula.HoldsIn v₀ (ψ.subst x .zero) := by + rw [holdsIn_subst v₀ (freeFor_zero x ψ)] + exact (hiff PAStructure.zero).mp hbase + have hstep_ψ : ∀ b : HenkinCarrier h₀, + PAFormula.HoldsIn (Function.update v₀ x b) ψ → + PAFormula.HoldsIn (Function.update v₀ x b) (ψ.subst x (.succ (.var x))) := by + intro b hb + rw [holdsIn_subst (Function.update v₀ x b) (freeFor_succ_self x ψ)] + simp only [PATerm.evalIn, Function.update_self, Function.update_idem] + exact (hiff (PAStructure.succ b)).mp (hstep b ((hiff b).mpr hb)) + exact (hiff a).mpr (hind hbase_ψ hstep_ψ a) + +end HenkinModel + +/-- Gödel–Henkin soundness and completeness for first-order Peano Arithmetic (`PAProvable`): +a `PAFormula` is provable in `PAProvable` if and only if it holds in every first-order `PAModel` +`M` (`Type`) under every variable assignment. -/ +theorem paProvable_iff_holdsIn_all_models (φ : PAFormula) : + PAProvable φ ↔ + ∀ (M : Type) [PAStructure M] [PAModel M] (v : ℕ → M), PAFormula.HoldsIn v φ := by + refine ⟨fun h M _ _ v ↦ paProvable_sound h v, fun hall ↦ ?_⟩ + by_contra hnp + have hcons : ¬ CtxProvable [φ.not] .bot := by + intro hbot + exact hnp (ctx_nil_iff.mp (ctx_by_contra hbot)) + have hn_mem : φ.not ∈ henkinTheory φ.not := henkinTheory_mem_zero φ.not + have hn_sem : PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid hcons) (.var x)) φ.not := + (henkin_truth_id hcons φ.not).mpr hn_mem + have hp_sem : PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid hcons) (.var x)) φ := + hall (HenkinCarrier hcons) (fun x ↦ Quotient.mk (HenkinSetoid hcons) (.var x)) + exact hn_sem hp_sem + +end ConjectureMachines.Semantics.PA diff --git a/Cryptids/Semantics/PA/Syntax.lean b/Cryptids/Semantics/PA/Syntax.lean new file mode 100644 index 00000000..41090600 --- /dev/null +++ b/Cryptids/Semantics/PA/Syntax.lean @@ -0,0 +1,620 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Propositions + +/-! +# Syntax, Substitution, Model Semantics, and Consistency of `PAProvable` + +This module develops the foundational metatheory of the deeply embedded Peano Arithmetic system +`PAProvable` (`Cryptids.Propositions`): + +1. **General $\mathcal{L}_{\mathrm{PA}}$-structures and models (`PAStructure`, `PAModel`)**: + Evaluates `PATerm` and `PAFormula` in an arbitrary $\mathcal{L}_{\mathrm{PA}}$-structure `M` + (`evalIn`, `HoldsIn`), proves variable-agreement and capture-avoiding substitution lemmas + (`evalIn_subst`, `holdsIn_subst`), and establishes classical soundness of `PAProvable` across + all models `M` of $\mathrm{PA}$ (`paProvable_sound`, `paProvable_sound_nat`). +2. **Constructive consistency (`NHolds`, `not_paProvable_false`)**: + Interprets `PAFormula` in `ℕ` via the Gödel–Gentzen negative translation `NHolds`, proving + `¬ PAProvable .bot` constructively without `Classical.choice`. +-/ + +@[expose] public section + +namespace ConjectureMachines.Semantics.PA + +/-! ## Section 1: $\mathcal{L}_{\mathrm{PA}}$-Structures and Models -/ + +/-- Interpretation of the signature $\mathcal{L}_{\mathrm{PA}} = \{0, S, +, \times\}$ on a carrier +type `M`. -/ +class PAStructure (M : Type*) where + /-- Interpretation of `0`. -/ + zero : M + /-- Interpretation of successor $S$. -/ + succ : M → M + /-- Interpretation of addition $+$. -/ + add : M → M → M + /-- Interpretation of multiplication $\times$. -/ + mul : M → M → M + +/-- Standard $\mathcal{L}_{\mathrm{PA}}$-structure on `ℕ`. -/ +instance instPAStructureNat : PAStructure ℕ where + zero := 0 + succ n := n + 1 + add := (· + ·) + mul := (· * ·) + +/-- Evaluate a `PATerm` in an $\mathcal{L}_{\mathrm{PA}}$-structure `M` under assignment `v`. -/ +def PATerm.evalIn {M : Type*} [PAStructure M] (v : ℕ → M) : PATerm → M + | .var x => v x + | .zero => PAStructure.zero + | .succ t => PAStructure.succ (PATerm.evalIn v t) + | .add t₁ t₂ => PAStructure.add (PATerm.evalIn v t₁) (PATerm.evalIn v t₂) + | .mul t₁ t₂ => PAStructure.mul (PATerm.evalIn v t₁) (PATerm.evalIn v t₂) + +/-- Tarski satisfaction of a `PAFormula` in an $\mathcal{L}_{\mathrm{PA}}$-structure `M` under +assignment `v`. -/ +def PAFormula.HoldsIn {M : Type*} [PAStructure M] (v : ℕ → M) : PAFormula → Prop + | .bot => False + | .eq t₁ t₂ => PATerm.evalIn v t₁ = PATerm.evalIn v t₂ + | .and φ ψ => PAFormula.HoldsIn v φ ∧ PAFormula.HoldsIn v ψ + | .or φ ψ => PAFormula.HoldsIn v φ ∨ PAFormula.HoldsIn v ψ + | .imp φ ψ => PAFormula.HoldsIn v φ → PAFormula.HoldsIn v ψ + | .all x φ => ∀ a : M, PAFormula.HoldsIn (Function.update v x a) φ + | .ex x φ => ∃ a : M, PAFormula.HoldsIn (Function.update v x a) φ + +/-- A first-order model of Peano Arithmetic (`PA`): an $\mathcal{L}_{\mathrm{PA}}$-structure +satisfying the six Robinson `Q` axioms together with the first-order induction schema for every +`PAFormula`. -/ +class PAModel (M : Type*) [PAStructure M] : Prop where + zero_ne_succ : ∀ a : M, PAStructure.succ a ≠ PAStructure.zero + succ_inj : ∀ {a b : M}, PAStructure.succ a = PAStructure.succ b → a = b + add_zero : ∀ a : M, PAStructure.add a PAStructure.zero = a + add_succ : ∀ a b : M, PAStructure.add a (PAStructure.succ b) = + PAStructure.succ (PAStructure.add a b) + mul_zero : ∀ a : M, PAStructure.mul a PAStructure.zero = PAStructure.zero + mul_succ : ∀ a b : M, PAStructure.mul a (PAStructure.succ b) = + PAStructure.add (PAStructure.mul a b) a + ind : ∀ (x : ℕ) (φ : PAFormula) (v : ℕ → M), + PAFormula.HoldsIn (Function.update v x PAStructure.zero) φ → + (∀ a : M, PAFormula.HoldsIn (Function.update v x a) φ → + PAFormula.HoldsIn (Function.update v x (PAStructure.succ a)) φ) → + ∀ a : M, PAFormula.HoldsIn (Function.update v x a) φ + +/-- The standard natural numbers `ℕ` form a `PAModel`. -/ +instance instPAModelNat : PAModel ℕ where + zero_ne_succ n := Nat.succ_ne_zero n + succ_inj h := Nat.succ.inj h + add_zero := Nat.add_zero + add_succ := Nat.add_succ + mul_zero := Nat.mul_zero + mul_succ := Nat.mul_succ + ind x φ v h0 hs a := by + induction a with + | zero => exact h0 + | succ a ih => exact hs a ih + +theorem evalIn_nat_eq (v : ℕ → ℕ) (t : PATerm) : PATerm.evalIn v t = t.eval v := by + induction t with + | var _ | zero => rfl + | succ _ ih => exact congrArg (· + 1) ih + | add _ _ ih₁ ih₂ => exact congrArg₂ (· + ·) ih₁ ih₂ + | mul _ _ ih₁ ih₂ => exact congrArg₂ (· * ·) ih₁ ih₂ + +theorem holdsIn_nat_iff (v : ℕ → ℕ) (φ : PAFormula) : PAFormula.HoldsIn v φ ↔ φ.Holds v := by + induction φ generalizing v with + | bot => exact Iff.rfl + | eq t₁ t₂ => simp only [PAFormula.HoldsIn, PAFormula.Holds, evalIn_nat_eq] + | and _ _ ih₁ ih₂ => exact and_congr (ih₁ v) (ih₂ v) + | or _ _ ih₁ ih₂ => exact or_congr (ih₁ v) (ih₂ v) + | imp _ _ ih₁ ih₂ => exact imp_congr (ih₁ v) (ih₂ v) + | all x _ ih => exact forall_congr' fun a ↦ ih (Function.update v x a) + | ex x _ ih => exact exists_congr fun a ↦ ih (Function.update v x a) + +/-! ## Section 2: Freshness, Variable Agreement, and Substitution Lemmas -/ + +theorem hasVar_false_of_freshVar_le {t : PATerm} {x : ℕ} (h : t.freshVar ≤ x) : + t.hasVar x = false := by + induction t with + | var y => + simp only [PATerm.freshVar] at h + simp only [PATerm.hasVar, beq_eq_false_iff_ne] + omega + | zero => rfl + | succ t ih => exact ih h + | add t₁ t₂ ih₁ ih₂ | mul t₁ t₂ ih₁ ih₂ => + simp only [PATerm.freshVar, Nat.max_le] at h + simp only [PATerm.hasVar, Bool.or_eq_false_iff] + exact ⟨ih₁ h.1, ih₂ h.2⟩ + +theorem evalIn_congr {M : Type*} [PAStructure M] {v₁ v₂ : ℕ → M} {t : PATerm} + (h : ∀ x, t.hasVar x = true → v₁ x = v₂ x) : + PATerm.evalIn v₁ t = PATerm.evalIn v₂ t := by + induction t with + | var x => exact h x (by simp [PATerm.hasVar]) + | zero => rfl + | succ t ih => exact congrArg PAStructure.succ (ih h) + | add t₁ t₂ ih₁ ih₂ => + refine congrArg₂ PAStructure.add (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + | mul t₁ t₂ ih₁ ih₂ => + refine congrArg₂ PAStructure.mul (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + +theorem evalIn_update_of_hasVar_false {M : Type*} [PAStructure M] (v : ℕ → M) + {x : ℕ} (a : M) {t : PATerm} (hx : t.hasVar x = false) : + PATerm.evalIn (Function.update v x a) t = PATerm.evalIn v t := by + refine evalIn_congr fun y hy ↦ ?_ + have hne : y ≠ x := fun h ↦ by subst h; rw [hx] at hy; cases hy + exact Function.update_of_ne hne a v + +theorem holdsIn_congr {M : Type*} [PAStructure M] {v₁ v₂ : ℕ → M} {φ : PAFormula} + (h : ∀ x, φ.hasFree x = true → v₁ x = v₂ x) : + PAFormula.HoldsIn v₁ φ ↔ PAFormula.HoldsIn v₂ φ := by + induction φ generalizing v₁ v₂ with + | bot => exact Iff.rfl + | eq t₁ t₂ => + have e₁ : PATerm.evalIn v₁ t₁ = PATerm.evalIn v₂ t₁ := + evalIn_congr fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + have e₂ : PATerm.evalIn v₁ t₂ = PATerm.evalIn v₂ t₂ := + evalIn_congr fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.HoldsIn, e₁, e₂] + | and φ ψ ih₁ ih₂ => + refine and_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | or φ ψ ih₁ ih₂ => + refine or_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | imp φ ψ ih₁ ih₂ => + refine imp_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | all y φ ih => + refine forall_congr' fun a ↦ ih fun x hx ↦ ?_ + by_cases hxy : x = y + · subst hxy; simp + · simp only [Function.update_of_ne hxy] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxy, hx]) + | ex y φ ih => + refine exists_congr fun a ↦ ih fun x hx ↦ ?_ + by_cases hxy : x = y + · subst hxy; simp + · simp only [Function.update_of_ne hxy] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxy, hx]) + +theorem holdsIn_update_of_hasFree_false {M : Type*} [PAStructure M] (v : ℕ → M) + {x : ℕ} (a : M) {φ : PAFormula} (hx : φ.hasFree x = false) : + PAFormula.HoldsIn (Function.update v x a) φ ↔ PAFormula.HoldsIn v φ := by + refine holdsIn_congr fun y hy ↦ ?_ + have hne : y ≠ x := fun h ↦ by subst h; rw [hx] at hy; cases hy + exact Function.update_of_ne hne a v + +theorem evalIn_subst {M : Type*} [PAStructure M] (v : ℕ → M) (x : ℕ) (s t : PATerm) : + PATerm.evalIn v (t.subst x s) = PATerm.evalIn (Function.update v x (PATerm.evalIn v s)) t := by + induction t with + | var y => + simp only [PATerm.subst] + by_cases hxy : y = x + · subst hxy; simp [PATerm.evalIn] + · simp [hxy, PATerm.evalIn] + | zero => rfl + | succ t ih => exact congrArg PAStructure.succ ih + | add t₁ t₂ ih₁ ih₂ => exact congrArg₂ PAStructure.add ih₁ ih₂ + | mul t₁ t₂ ih₁ ih₂ => exact congrArg₂ PAStructure.mul ih₁ ih₂ + +theorem subst_eq_self_of_hasFree_false {φ : PAFormula} {x : ℕ} (s : PATerm) + (hx : φ.hasFree x = false) : φ.subst x s = φ := by + have term_eq : ∀ {t : PATerm}, t.hasVar x = false → t.subst x s = t := by + intro t ht + induction t with + | var y => + simp only [PATerm.hasVar, beq_eq_false_iff_ne] at ht + simp [PATerm.subst, ht] + | zero => rfl + | succ t ih => exact congrArg PATerm.succ (ih ht) + | add t₁ t₂ ih₁ ih₂ => + simp only [PATerm.hasVar, Bool.or_eq_false_iff] at ht + exact congrArg₂ PATerm.add (ih₁ ht.1) (ih₂ ht.2) + | mul t₁ t₂ ih₁ ih₂ => + simp only [PATerm.hasVar, Bool.or_eq_false_iff] at ht + exact congrArg₂ PATerm.mul (ih₁ ht.1) (ih₂ ht.2) + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] at hx + exact congrArg₂ PAFormula.eq (term_eq hx.1) (term_eq hx.2) + | and φ ψ ih₁ ih₂ => + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] at hx + exact congrArg₂ PAFormula.and (ih₁ hx.1) (ih₂ hx.2) + | or φ ψ ih₁ ih₂ => + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] at hx + exact congrArg₂ PAFormula.or (ih₁ hx.1) (ih₂ hx.2) + | imp φ ψ ih₁ ih₂ => + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] at hx + exact congrArg₂ PAFormula.imp (ih₁ hx.1) (ih₂ hx.2) + | all y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · simp [hxy] + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [PAFormula.hasFree, hb, Bool.not_false, Bool.true_and] at hx + simp [hb, ih hx] + | ex y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · simp [hxy] + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [PAFormula.hasFree, hb, Bool.not_false, Bool.true_and] at hx + simp [hb, ih hx] + +theorem holdsIn_subst {M : Type*} [PAStructure M] (v : ℕ → M) {x : ℕ} {s : PATerm} {φ : PAFormula} + (hf : φ.freeFor x s = true) : + PAFormula.HoldsIn v (φ.subst x s) ↔ + PAFormula.HoldsIn (Function.update v x (PATerm.evalIn v s)) φ := by + induction φ generalizing v with + | bot => exact Iff.rfl + | eq t₁ t₂ => simp only [PAFormula.subst, PAFormula.HoldsIn, evalIn_subst] + | and φ ψ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact and_congr (ih₁ v hf.1) (ih₂ v hf.2) + | or φ ψ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact or_congr (ih₁ v hf.1) (ih₂ v hf.2) + | imp φ ψ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact imp_congr (ih₁ v hf.1) (ih₂ v hf.2) + | all y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · subst hxy + simp only [beq_self_eq_true, ↓reduceIte, PAFormula.HoldsIn] + refine forall_congr' fun a ↦ ?_ + rw [Function.update_idem] + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [hb, Bool.false_eq_true, ↓reduceIte, PAFormula.HoldsIn] + simp only [PAFormula.freeFor, hb, Bool.false_or, Bool.and_eq_true, + Bool.or_eq_true, Bool.not_eq_true'] at hf + rcases hf with ⟨hno | hsy, hf'⟩ + · refine forall_congr' fun a ↦ ?_ + rw [subst_eq_self_of_hasFree_false s hno, Function.update_comm (Ne.symm hxy), + holdsIn_update_of_hasFree_false _ _ hno] + · refine forall_congr' fun a ↦ ?_ + rw [ih (Function.update v y a) hf', evalIn_update_of_hasVar_false v a hsy, + Function.update_comm hxy] + | ex y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · subst hxy + simp only [beq_self_eq_true, ↓reduceIte, PAFormula.HoldsIn] + refine exists_congr fun a ↦ ?_ + rw [Function.update_idem] + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [hb, Bool.false_eq_true, ↓reduceIte, PAFormula.HoldsIn] + simp only [PAFormula.freeFor, hb, Bool.false_or, Bool.and_eq_true, + Bool.or_eq_true, Bool.not_eq_true'] at hf + rcases hf with ⟨hno | hsy, hf'⟩ + · refine exists_congr fun a ↦ ?_ + rw [subst_eq_self_of_hasFree_false s hno, Function.update_comm (Ne.symm hxy), + holdsIn_update_of_hasFree_false _ _ hno] + · refine exists_congr fun a ↦ ?_ + rw [ih (Function.update v y a) hf', evalIn_update_of_hasVar_false v a hsy, + Function.update_comm hxy] + +theorem freeFor_of_no_vars {x : ℕ} {s : PATerm} (hs : ∀ y, s.hasVar y = false) (φ : PAFormula) : + φ.freeFor x s = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp [PAFormula.freeFor, ih₁, ih₂] + | all y _ ih | ex y _ ih => + simp [PAFormula.freeFor, hs y, ih] + +theorem freeFor_zero (x : ℕ) (φ : PAFormula) : φ.freeFor x .zero = true := + freeFor_of_no_vars (fun _ ↦ rfl) φ + +theorem freeFor_ofNat (x n : ℕ) (φ : PAFormula) : φ.freeFor x (.ofNat n) = true := by + refine freeFor_of_no_vars (fun y ↦ ?_) φ + induction n with + | zero => rfl + | succ _ ih => exact ih + +theorem freeFor_succ_self (x : ℕ) (φ : PAFormula) : + φ.freeFor x (.succ (.var x)) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp [PAFormula.freeFor, ih₁, ih₂] + | all y φ ih | ex y φ ih => + simp only [PAFormula.freeFor, PATerm.hasVar] + by_cases hxy : y = x + · simp [hxy] + · simp [hxy, Ne.symm hxy, ih] + +/-! ## Section 3: Classical Soundness of `PAProvable` Across All `PAModel`s -/ + +/-- Soundness of `PAProvable` in every first-order `PAModel`. -/ +theorem paProvable_sound {M : Type*} [PAStructure M] [PAModel M] {φ : PAFormula} + (h : PAProvable φ) (v : ℕ → M) : PAFormula.HoldsIn v φ := by + induction h generalizing v with + | mp _ _ ihφ ihimp => exact ihimp v (ihφ v) + | gen x _ ih => intro a; exact ih (Function.update v x a) + | imp_k _ _ => intro h₁ _; exact h₁ + | imp_s _ _ _ => intro h₁ h₂ h₃; exact h₁ h₃ (h₂ h₃) + | dne _ => exact Classical.not_not.mp + | and_intro _ _ => exact And.intro + | and_left _ _ => exact And.left + | and_right _ _ => exact And.right + | or_left _ _ => exact Or.inl + | or_right _ _ => exact Or.inr + | or_elim _ _ _ => + intro h₁ h₂ h₃ + exact h₃.elim h₁ h₂ + | all_imp x _ _ => + intro h₁ h₂ a + exact h₁ a (h₂ a) + | all_vacuous x φ hx => + intro hφ a + exact (holdsIn_update_of_hasFree_false v a hx).mpr hφ + | all_elim x t φ hf => + intro hall + exact (holdsIn_subst v hf).mpr (hall (PATerm.evalIn v t)) + | ex_intro x t φ hf => + intro hsub + exact ⟨PATerm.evalIn v t, (holdsIn_subst v hf).mp hsub⟩ + | ex_elim x φ ψ hx => + rintro hall ⟨a, ha⟩ + exact (holdsIn_update_of_hasFree_false v a hx).mp (hall a ha) + | eq_refl _ => rfl + | eq_subst x s t φ hs ht => + intro heq hφs + have h1 := (holdsIn_subst v hs).mp hφs + rw [heq] at h1 + exact (holdsIn_subst v ht).mpr h1 + | pa_zero_ne_succ => exact PAModel.zero_ne_succ (v 0) + | pa_succ_inj => exact PAModel.succ_inj + | pa_add_zero => exact PAModel.add_zero (v 0) + | pa_add_succ => exact PAModel.add_succ (v 0) (v 1) + | pa_mul_zero => exact PAModel.mul_zero (v 0) + | pa_mul_succ => exact PAModel.mul_succ (v 0) (v 1) + | pa_ind x φ => + intro h0 hs a + have h0' : PAFormula.HoldsIn (Function.update v x PAStructure.zero) φ := + (holdsIn_subst v (freeFor_zero x φ)).mp h0 + have hs' : ∀ b : M, PAFormula.HoldsIn (Function.update v x b) φ → + PAFormula.HoldsIn (Function.update v x (PAStructure.succ b)) φ := by + intro b hb + have hstep := hs b hb + have hsub := (holdsIn_subst (Function.update v x b) (freeFor_succ_self x φ)).mp hstep + simpa [PATerm.evalIn] using hsub + exact PAModel.ind x φ v h0' hs' a + +/-- Soundness of `PAProvable` in the standard model `ℕ`. -/ +theorem paProvable_sound_nat (φ : PAFormula) (h : PAProvable φ) (v : ℕ → ℕ) : φ.Holds v := + (holdsIn_nat_iff v φ).mp (paProvable_sound h v) + +/-! ## Section 4: Constructive Consistency via Negative Translation (`not_paProvable_false`) -/ + +/-- Gödel–Gentzen negative satisfaction of a `PAFormula` in `ℕ`, replacing positive disjunction +and existential quantification by their double-negated counterparts so every formula is +constructively `¬¬`-stable without `Classical.choice`. -/ +def PAFormula.NHolds (v : ℕ → ℕ) : PAFormula → Prop + | .bot => False + | .eq t₁ t₂ => t₁.eval v = t₂.eval v + | .and φ ψ => PAFormula.NHolds v φ ∧ PAFormula.NHolds v ψ + | .or φ ψ => ¬¬ (PAFormula.NHolds v φ ∨ PAFormula.NHolds v ψ) + | .imp φ ψ => PAFormula.NHolds v φ → PAFormula.NHolds v ψ + | .all x φ => ∀ a : ℕ, PAFormula.NHolds (Function.update v x a) φ + | .ex x φ => ¬¬ ∃ a : ℕ, PAFormula.NHolds (Function.update v x a) φ + +theorem nHolds_stable (φ : PAFormula) (v : ℕ → ℕ) : + ¬¬ PAFormula.NHolds v φ → PAFormula.NHolds v φ := by + induction φ generalizing v with + | bot => intro h; exact h id + | eq t₁ t₂ => + intro h + by_cases he : t₁.eval v = t₂.eval v + · exact he + · exact False.elim (h he) + | and φ ψ ih₁ ih₂ => + intro h + exact ⟨ih₁ v fun h₁ ↦ h fun hp ↦ h₁ hp.1, ih₂ v fun h₂ ↦ h fun hp ↦ h₂ hp.2⟩ + | or _ _ _ _ => + intro h hn + exact h fun hnn ↦ hnn hn + | imp _ ψ _ ih₂ => + intro h hφ + exact ih₂ v fun hψ ↦ h fun himp ↦ hψ (himp hφ) + | all x φ ih => + intro h a + exact ih (Function.update v x a) fun ha ↦ h fun hall ↦ ha (hall a) + | ex _ _ _ => + intro h hn + exact h fun hnn ↦ hnn hn + +private theorem nHolds_congr {v₁ v₂ : ℕ → ℕ} {φ : PAFormula} + (h : ∀ x, φ.hasFree x = true → v₁ x = v₂ x) : + PAFormula.NHolds v₁ φ ↔ PAFormula.NHolds v₂ φ := by + induction φ generalizing v₁ v₂ with + | bot => exact Iff.rfl + | eq t₁ t₂ => + have e₁ : t₁.eval v₁ = t₁.eval v₂ := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_congr fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + have e₂ : t₂.eval v₁ = t₂.eval v₂ := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_congr fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.NHolds, e₁, e₂] + | and _ _ ih₁ ih₂ => + refine and_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | or _ _ ih₁ ih₂ => + have c₁ := ih₁ (v₁ := v₁) (v₂ := v₂) fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + have c₂ := ih₂ (v₁ := v₁) (v₂ := v₂) fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + exact not_congr (not_congr (or_congr c₁ c₂)) + | imp _ _ ih₁ ih₂ => + refine imp_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | all y _ ih => + refine forall_congr' fun a ↦ ih fun x hx ↦ ?_ + rcases Decidable.eq_or_ne x y with rfl | hxy + · simp + · simp only [Function.update_of_ne hxy] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxy, hx]) + | ex y _ ih => + refine not_congr (not_congr (exists_congr fun a ↦ ih fun x hx ↦ ?_)) + rcases Decidable.eq_or_ne x y with rfl | hxy + · simp + · simp only [Function.update_of_ne hxy] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxy, hx]) + +private theorem nHolds_update_of_hasFree_false (v : ℕ → ℕ) {x : ℕ} (a : ℕ) {φ : PAFormula} + (hx : φ.hasFree x = false) : + PAFormula.NHolds (Function.update v x a) φ ↔ PAFormula.NHolds v φ := by + refine nHolds_congr fun y hy ↦ ?_ + have hne : y ≠ x := fun h ↦ by subst h; rw [hx] at hy; cases hy + exact Function.update_of_ne hne a v + +private theorem nHolds_update_idem (v : ℕ → ℕ) (x a b : ℕ) (φ : PAFormula) : + PAFormula.NHolds (Function.update (Function.update v x a) x b) φ ↔ + PAFormula.NHolds (Function.update v x b) φ := by + refine nHolds_congr fun z _ ↦ ?_ + rcases Decidable.eq_or_ne z x with rfl | hzx + · simp only [Function.update_self] + · simp only [Function.update_of_ne hzx] + +private theorem nHolds_update_comm (v : ℕ → ℕ) {x y : ℕ} (hxy : x ≠ y) (a b : ℕ) (φ : PAFormula) : + PAFormula.NHolds (Function.update (Function.update v x a) y b) φ ↔ + PAFormula.NHolds (Function.update (Function.update v y b) x a) φ := by + refine nHolds_congr fun z _ ↦ ?_ + rcases Decidable.eq_or_ne z y with rfl | hzy + · rw [Function.update_self, Function.update_of_ne hxy.symm, Function.update_self] + · rw [Function.update_of_ne hzy] + rcases Decidable.eq_or_ne z x with rfl | hzx + · rw [Function.update_self, Function.update_self] + · rw [Function.update_of_ne hzx, Function.update_of_ne hzx, Function.update_of_ne hzy] + +private theorem nHolds_subst (v : ℕ → ℕ) {x : ℕ} {s : PATerm} {φ : PAFormula} + (hf : φ.freeFor x s = true) : + PAFormula.NHolds v (φ.subst x s) ↔ + PAFormula.NHolds (Function.update v x (s.eval v)) φ := by + induction φ generalizing v with + | bot => exact Iff.rfl + | eq t₁ t₂ => + simp only [PAFormula.subst, PAFormula.NHolds, ← evalIn_nat_eq, evalIn_subst] + | and _ _ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact and_congr (ih₁ v hf.1) (ih₂ v hf.2) + | or _ _ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact not_congr (not_congr (or_congr (ih₁ v hf.1) (ih₂ v hf.2))) + | imp _ _ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact imp_congr (ih₁ v hf.1) (ih₂ v hf.2) + | all y φ ih => + simp only [PAFormula.subst] + rcases Decidable.eq_or_ne y x with rfl | hxy + · simp only [beq_self_eq_true, ↓reduceIte, PAFormula.NHolds] + refine forall_congr' fun a ↦ ?_ + exact (nHolds_update_idem v y (s.eval v) a φ).symm + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [hb, Bool.false_eq_true, ↓reduceIte, PAFormula.NHolds] + simp only [PAFormula.freeFor, hb, Bool.false_or, Bool.and_eq_true, + Bool.or_eq_true, Bool.not_eq_true'] at hf + rcases hf with ⟨hno | hsy, hf'⟩ + · refine forall_congr' fun a ↦ ?_ + rw [subst_eq_self_of_hasFree_false s hno, + nHolds_update_comm v (Ne.symm hxy), + nHolds_update_of_hasFree_false _ _ hno] + · refine forall_congr' fun a ↦ ?_ + have hev : s.eval (Function.update v y a) = s.eval v := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_update_of_hasVar_false v a hsy + rw [ih (Function.update v y a) hf', hev, nHolds_update_comm v hxy] + | ex y φ ih => + simp only [PAFormula.subst] + rcases Decidable.eq_or_ne y x with rfl | hxy + · simp only [beq_self_eq_true, ↓reduceIte, PAFormula.NHolds] + refine not_congr (not_congr (exists_congr fun a ↦ ?_)) + exact (nHolds_update_idem v y (s.eval v) a φ).symm + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [hb, Bool.false_eq_true, ↓reduceIte, PAFormula.NHolds] + simp only [PAFormula.freeFor, hb, Bool.false_or, Bool.and_eq_true, + Bool.or_eq_true, Bool.not_eq_true'] at hf + rcases hf with ⟨hno | hsy, hf'⟩ + · refine not_congr (not_congr (exists_congr fun a ↦ ?_)) + rw [subst_eq_self_of_hasFree_false s hno, + nHolds_update_comm v (Ne.symm hxy), + nHolds_update_of_hasFree_false _ _ hno] + · refine not_congr (not_congr (exists_congr fun a ↦ ?_)) + have hev : s.eval (Function.update v y a) = s.eval v := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_update_of_hasVar_false v a hsy + rw [ih (Function.update v y a) hf', hev, nHolds_update_comm v hxy] + +/-- Constructive soundness of `PAProvable` under `NHolds` (zero `Classical.choice`). -/ +theorem paProvable_nSound {φ : PAFormula} (h : PAProvable φ) (v : ℕ → ℕ) : + PAFormula.NHolds v φ := by + induction h generalizing v with + | mp _ _ ihφ ihimp => exact ihimp v (ihφ v) + | gen x _ ih => intro a; exact ih (Function.update v x a) + | imp_k _ _ => intro h₁ _; exact h₁ + | imp_s _ _ _ => intro h₁ h₂ h₃; exact h₁ h₃ (h₂ h₃) + | dne φ => exact nHolds_stable φ v + | and_intro _ _ => exact And.intro + | and_left _ _ => exact And.left + | and_right _ _ => exact And.right + | or_left _ _ => intro hφ hn; exact hn (Or.inl hφ) + | or_right _ _ => intro hψ hn; exact hn (Or.inr hψ) + | or_elim _ _ χ => + intro h₁ h₂ hor + refine nHolds_stable χ v fun hnχ ↦ hor fun hdisj ↦ ?_ + exact hdisj.elim (fun hφ ↦ hnχ (h₁ hφ)) (fun hψ ↦ hnχ (h₂ hψ)) + | all_imp x _ _ => intro h₁ h₂ a; exact h₁ a (h₂ a) + | all_vacuous x φ hx => + intro hφ a + exact (nHolds_update_of_hasFree_false v a hx).mpr hφ + | all_elim x t φ hf => + intro hall + exact (nHolds_subst v hf).mpr (hall (t.eval v)) + | ex_intro x t φ hf => + intro hsub hn + exact hn ⟨t.eval v, (nHolds_subst v hf).mp hsub⟩ + | ex_elim x φ ψ hx => + intro hall hex + refine nHolds_stable ψ v fun hnψ ↦ hex fun ⟨a, ha⟩ ↦ ?_ + exact hnψ ((nHolds_update_of_hasFree_false v a hx).mp (hall a ha)) + | eq_refl _ => rfl + | eq_subst x s t φ hs ht => + intro heq hφs + have h1 := (nHolds_subst v hs).mp hφs + rw [heq] at h1 + exact (nHolds_subst v ht).mpr h1 + | pa_zero_ne_succ => exact Nat.succ_ne_zero (v 0) + | pa_succ_inj => exact Nat.succ.inj + | pa_add_zero => exact Nat.add_zero (v 0) + | pa_add_succ => exact Nat.add_succ (v 0) (v 1) + | pa_mul_zero => exact Nat.mul_zero (v 0) + | pa_mul_succ => exact Nat.mul_succ (v 0) (v 1) + | pa_ind x φ => + intro h0 hs a + have h0' : PAFormula.NHolds (Function.update v x 0) φ := + (nHolds_subst v (freeFor_zero x φ)).mp h0 + have hs' : ∀ b : ℕ, PAFormula.NHolds (Function.update v x b) φ → + PAFormula.NHolds (Function.update v x (b + 1)) φ := by + intro b hb + have hstep := hs b hb + have hsub := (nHolds_subst (Function.update v x b) (freeFor_succ_self x φ)).mp hstep + simp only [PATerm.eval, Function.update_self] at hsub + exact (nHolds_update_idem v x b (b + 1) φ).mp hsub + induction a with + | zero => exact h0' + | succ a ih => exact hs' a ih + +/-- Consistency of first-order Peano Arithmetic (`¬ PAProvable .bot`), proved constructively +without `Classical.choice`. -/ +theorem not_paProvable_false : ¬ PAProvable .bot := + fun h ↦ paProvable_nSound h (fun _ ↦ 0) + +end ConjectureMachines.Semantics.PA diff --git a/Cryptids/Semantics/README.md b/Cryptids/Semantics/README.md index 2c2478fb..66e9b0a0 100644 --- a/Cryptids/Semantics/README.md +++ b/Cryptids/Semantics/README.md @@ -367,7 +367,7 @@ Care is required when interpreting a Lean theorem of type `Halts M ↔ ZFInconsi 3. **Metamathematical scope — Lean's type theory, `PA`/`ZF` internalization, and `ZF`-independence:** Care must also be taken not to conflate a constructive Lean theorem `Halts M ↔ ZFInconsistent` with a formal proof of $\mathrm{ZF}$-independence: - **Strength of constructive Lean (`CIC` vs. `PA`/`ZF`):** Even without `Classical.choice` or Excluded Middle, Lean's Calculus of Inductive Constructions provides constructions absent from first-order $\mathrm{PA}$ and $\mathrm{ZF}$—an impredicative `Prop`, inductive families (`ZFProvable`, `Acc`, `PSet`), and a predicative universe hierarchy `Type u` (already strong enough to validate Zermelo set theory, and whether axiom-free `CIC` itself proves $\operatorname{Con}(\mathrm{ZF})$ remains an open question; see [`digama0/ConZF`](https://github.com/digama0/ConZF)). An axiom check in Lean therefore blocks classical `Con(ZF)` shortcuts, rather than restricting reasoning to $\mathrm{PA}$ or $\mathrm{ZF}$. - - **Internalizing the reduction inside `PA`/`ZF` is separate:** Although our concrete proofs of `ZFInconsistent → Halts M` and `Halts M → ZFInconsistent` proceed by explicit finitary structural and step-indexed induction rather than ambient set-theoretic models, they establish a **meta-level correspondence in Lean**. Internalizing that compiler and trace decoder as an object-level formal theorem inside $\mathrm{PA}$ or $\mathrm{ZF}$ (i.e., proving $\mathrm{ZF} \vdash \ulcorner \operatorname{Halts}(M) \leftrightarrow \neg\operatorname{Con}(\mathrm{ZF}) \urcorner$) is a separate step not formalized in this repository. + - **Internalizing the reduction inside first-order `PA` (`PAProvable`):** Our constructive Lean proofs of `ZFInconsistent → Halts M` and `Halts M → ZFInconsistent` establish a meta-level correspondence in Lean. To formulate and verify object-level provability inside weak first-order arithmetic—whose consistency strength is strictly below $\mathrm{ZF}$, so it cannot trivialize $\operatorname{Con}(\mathrm{ZF})$—Section 6 ([`Cryptids/Semantics/PA/`](./PA/)) deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`), proves constructive consistency (`not_paProvable_false : ¬ PAProvable .bot`), proves constructive standard-model adequacy of the $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), and proves Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`) so that object-level `PAProvable` theorems reduce to semantic reasoning in an arbitrary `[PAModel M]`. - **Assumptions required for both directions of `ZF`-independence:** Even once $\mathrm{ZF} \vdash \ulcorner \operatorname{Halts}(M) \leftrightarrow \neg\operatorname{Con}(\mathrm{ZF}) \urcorner$ is established, $\operatorname{Con}(\mathrm{ZF})$ alone yields only **one** direction of independence: $\mathrm{ZF} \nvdash \neg\ulcorner\operatorname{Halts}(M)\urcorner$ (by Gödel's Second Incompleteness Theorem). Ruling out the **other** direction, $\mathrm{ZF} \vdash \ulcorner\operatorname{Halts}(M)\urcorner$ (since $\mathrm{ZF} + \neg\operatorname{Con}(\mathrm{ZF})$ can still be consistent when $\mathrm{ZF}$ is consistent), requires $\operatorname{Con}(\mathrm{ZF} + \operatorname{Con}(\mathrm{ZF}))$—for example $\Sigma_1$-soundness ($1$-consistency) of $\mathrm{ZF}$, as assumed in Yedidia & Aaronson (2016). ### Formal Discovery of the `B6a` Register-Restoration Bug in `zf_432_wade.tm` @@ -505,3 +505,52 @@ theorem not_halts_zf393 : (`69..392`), the 125-step outer `main()` spine (`99..223`), and soundness & completeness against O'Rear's `ZFProvable` (`Layer2.Zf393RegHalts ↔ ZFInconsistent`), yielding unconditional non-halting (`not_halts_zf393`) via `Cryptids.Semantics.Zf.not_zfInconsistent`. + +--- + +## 6. First-Order Peano Arithmetic Metatheory ([`PA.lean`](./PA.lean) & [`PA/`](./PA/), `0 sorry`s) + +To state and verify object-level first-order Peano Arithmetic ($\mathrm{PA}$) provability statements +inside Lean without relying on Lean's ambient type-theoretic strength, [`Cryptids/Propositions.lean`](../Propositions.lean) +and [`Challenge.lean`](../../Challenge.lean) deeply embed first-order $\mathcal{L}_{\mathrm{PA}} = \{0, S, +, \times\}$ +terms (`PATerm`), positive formulas (`PAFormula`), the 25-clause Hilbert system `PAProvable`, and +closed $\Sigma_1^0$ sentences `paHalts M` and `paZFInconsistent`. + +In [`Cryptids/Semantics/PA.lean`](./PA.lean) and its three submodules ([`PA/Syntax.lean`](./PA/Syntax.lean), +[`PA/Adequacy.lean`](./PA/Adequacy.lean), [`PA/Completeness.lean`](./PA/Completeness.lean)), we prove: + +```lean +theorem not_paProvable_false : + ¬ PAProvable .bot + +theorem paHalts_holds_iff_halts {states : ℕ} [NeZero states] (M : Machine states 2) + (v : ℕ → ℕ) : (paHalts M).Holds v ↔ ConjectureMachines.Halts M + +theorem paZFInconsistent_holds_iff_zfInconsistent (v : ℕ → ℕ) : + paZFInconsistent.Holds v ↔ ZFInconsistent + +theorem paProvable_sound_nat (φ : PAFormula) (h : PAProvable φ) (v : ℕ → ℕ) : + φ.Holds v + +theorem paProvable_iff_holdsIn_all_models (φ : PAFormula) : + PAProvable φ ↔ ∀ (M : Type) [PAModel M] (v : ℕ → M), PAFormula.HoldsIn v φ +``` + +1. **Models, Classical Soundness, & Constructive Consistency ([`PA/Syntax.lean`](./PA/Syntax.lean))**: + Defines first-order $\mathcal{L}_{\mathrm{PA}}$-structures (`PAStructure M`) and Peano models + (`PAModel M`), proves soundness of `PAProvable` in any `[PAModel M]` (`paProvable_sound`, + specializing to `paProvable_sound_nat` on `ℕ`), and proves `not_paProvable_false` constructively + (zero `Classical.choice`, audited in [`comparator/constructive.json`](../../comparator/constructive.json)) + via the Gödel–Gentzen negative translation (`PAFormula.NHolds`, translating `.or` and `.ex` via + double negation so `PAProvable.dne` is constructively valid on `ℕ`). +2. **Constructive $\Sigma_1^0$ Standard-Model Adequacy ([`PA/Adequacy.lean`](./PA/Adequacy.lean))**: + Uses Gödel's $\beta$-function (`paBetaEq`), symbolic Cantor-pairing DAGs (`PAZFTerm`, avoiding + giant numeral expansions for `axInf`), and binary half-tape codes to prove + `paHalts_holds_iff_halts` and `paZFInconsistent_holds_iff_zfInconsistent` constructively without + `Classical.choice` or Markov's Principle (constructing $\beta$-witnesses via + `Nat.chineseRemainderOfList`). +3. **Gödel–Henkin Completeness ([`PA/Completeness.lean`](./PA/Completeness.lean))**: + Proves `paProvable_iff_holdsIn_all_models` via a single-pass enumerable Henkin–Lindenbaum chain + (`henkinChain`), quotient term model `Quotient (HenkinSetoid h₀)`, and simultaneous variable + renaming (`vsubst`), enabling `PAProvable` theorems to be proved semantically in an arbitrary + `[PAModel M]`. diff --git a/README.md b/README.md index 217e0d5a..a13b6d8d 100644 --- a/README.md +++ b/README.md @@ -13,8 +13,8 @@ This repository contains two Lean 4 (`v4.35.0-rc4`) formalization libraries for | [`BusyBeaver/`](BusyBeaver/) | `BB(6)` `(6, 2)` and `BB(3, 3)` `(3, 3)` holdout Turing machines (some are potential Cryptids, subject to community acceptance) | Shared execution semantics (`BusyBeaver/Defs.lean`), foundational lemmas (`BusyBeaver/Basic.lean`), RLE loader and `ConjectureMachines` bridge (`BusyBeaver/Bridge.lean`), and certified behavioral proofs in [`BusyBeaver/BB6/`](BusyBeaver/BB6/README.md) (53 machines) and [`BusyBeaver/BB33/`](BusyBeaver/BB33/README.md) (6 machines) | [`BusyBeaver/README.md`](BusyBeaver/README.md), [`BusyBeaver/BB6/README.md`](BusyBeaver/BB6/README.md), [`BusyBeaver/BB33/README.md`](BusyBeaver/BB33/README.md) | All Lean 4 proofs are checked by the kernel without `sorry` and depend only on standard Lean axioms: -- **Constructive (`["propext", "Quot.sound"]`, no `Classical.choice`):** All ZF machine-to-proof-search equivalences (`halts_zf393_iff_zfInconsistent`, `Zf380.Semantics.halts_candidate_iff_zfInconsistent`, `halts_zf432_iff_wadeZFInconsistent`), the direct simulation state reductions ([`Goldbach21.lean`](Cryptids/Goldbach21.lean), [`Zf380.lean`](Cryptids/Zf380.lean), [`Riemann104.lean`](Cryptids/Riemann104.lean)), and all four `candidate_fewer_states` theorems, audited in CI via [`comparator/constructive.json`](comparator/constructive.json). Because classical Lean (`ZFSet.{0}` in [`Soundness.lean`](Cryptids/Semantics/Zf/Soundness.lean)) proves `¬ ZFInconsistent`—so any non-halting machine would vacuously satisfy `Halts M ↔ ZFInconsistent` under `Classical.choice`—excluding `Classical.choice` blocks classical `Con(ZF)` shortcuts and ensures the Lean proof-search correspondence is constructive (while internalizing the reduction inside `PA`/`ZF` and establishing both directions of `ZF`-independence are separate metamathematical steps; see [Foundational Note on `Con(ZF)` and Constructive Equivalence](Cryptids/Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). -- **Classical (`["propext", "Classical.choice", "Quot.sound"]`):** Set-theoretic soundness and non-halting in `ZFSet.{0}` (`zfProvable_sound_zfSet`, `not_zfInconsistent`, `not_halts_zf393`, `not_halts_candidate`), negated-$\Pi_1^0$ Goldbach equivalence (`¬ GoldbachConjecture`, which uses Markov's Principle), the arithmetic-stage `riemann_95` reduction (`Nat.Prime`), complex-analytic `RiemannHypothesis` equivalences, and the `BB(6)` and `BB(3, 3)` holdout reductions, audited via [`comparator/all.json`](comparator/all.json) and [`comparator/busy_beaver.json`](comparator/busy_beaver.json). +- **Constructive (`["propext", "Quot.sound"]`, no `Classical.choice`):** All ZF machine-to-proof-search equivalences (`halts_zf393_iff_zfInconsistent`, `Zf380.Semantics.halts_candidate_iff_zfInconsistent`, `halts_zf432_iff_wadeZFInconsistent`), first-order Peano Arithmetic (`PAProvable`) consistency and $\Sigma_1^0$ standard-model adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent` in [`Cryptids/Semantics/PA/`](Cryptids/Semantics/PA/)), the direct simulation state reductions ([`Goldbach21.lean`](Cryptids/Goldbach21.lean), [`Zf380.lean`](Cryptids/Zf380.lean), [`Riemann104.lean`](Cryptids/Riemann104.lean)), and all four `candidate_fewer_states` theorems, audited in CI via [`comparator/constructive.json`](comparator/constructive.json). Because classical Lean (`ZFSet.{0}` in [`Soundness.lean`](Cryptids/Semantics/Zf/Soundness.lean)) proves `¬ ZFInconsistent`—so any non-halting machine would vacuously satisfy `Halts M ↔ ZFInconsistent` under `Classical.choice`—excluding `Classical.choice` blocks classical `Con(ZF)` shortcuts, while deeply embedded `PAProvable` provides a weak first-order metatheory strictly below `ZF` (see [Foundational Note on `Con(ZF)` and Constructive Equivalence](Cryptids/Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). +- **Classical (`["propext", "Classical.choice", "Quot.sound"]`):** First-order `PA` soundness and Gödel–Henkin completeness (`paProvable_sound_nat`, `paProvable_iff_holdsIn_all_models`), set-theoretic soundness and non-halting in `ZFSet.{0}` (`zfProvable_sound_zfSet`, `not_zfInconsistent`, `not_halts_zf393`, `not_halts_candidate`), negated-$\Pi_1^0$ Goldbach equivalence (`¬ GoldbachConjecture`, which uses Markov's Principle), the arithmetic-stage `riemann_95` reduction (`Nat.Prime`), complex-analytic `RiemannHypothesis` equivalences, and the `BB(6)` and `BB(3, 3)` holdout reductions, audited via [`comparator/all.json`](comparator/all.json) and [`comparator/busy_beaver.json`](comparator/busy_beaver.json). The [95-state Riemann machine](artifacts/riemann_95/README.md) has a kernel-checked blank-tape halting equivalence to the 104-state machine and to `¬ RiemannHypothesis`. diff --git a/comparator/README.md b/comparator/README.md index 52e6af56..30cbd1f8 100644 --- a/comparator/README.md +++ b/comparator/README.md @@ -10,8 +10,9 @@ using [`leanprover/comparator`](https://github.com/leanprover/comparator). - [`Challenge.lean`](../Challenge.lean) imports **only** Mathlib and Lean core (`Lean.Elab.Term`), defines all conjecture-checking baseline and candidate machines (`reference` and `candidate`), states the target mathematical propositions (`GoldbachConjecture`, - `MatiyasevichRiemannCounterexample`, `ZFProvable`, `WadeZFProvable`, etc.), and states all 22 - target state-reduction, equivalence, and semantics theorems with `sorry`. + `MatiyasevichRiemannCounterexample`, `ZFProvable`, `WadeZFProvable`, `PAProvable`, `paHalts`, + `paZFInconsistent`, etc.), and states all 26 target state-reduction, equivalence, `PA` + metatheory, and semantics theorems with `sorry`. - [`BusyBeaverChallenge.lean`](../BusyBeaverChallenge.lean) imports **only** Mathlib and Lean core (`Lean.Elab.Term`), defines the shared `BusyBeaver` Post-Turing execution model, accelerated `TapePatternSet`, `StackPatternSet`, and Collatz-like acceleration semantics (`IsClosedPatternSet`, @@ -34,25 +35,27 @@ that: [`zf_380.json`](./zf_380.json), and [`riemann_104.json`](./riemann_104.json), covering all three ZF machine-to-proof-search equivalences (`halts_zf393_iff_zfInconsistent`, `Zf380.Semantics.halts_candidate_iff_zfInconsistent`, - `halts_zf432_iff_wadeZFInconsistent`), the direct simulation reductions (`Goldbach21`, `Zf380`, - `Riemann104`), and all four `candidate_fewer_states` theorems (10 theorems total). Disallowing - `Classical.choice` blocks classical `Con(ZF)` shortcuts (`not_zfInconsistent` in `ZFSet.{0}` or - `Classical.em` + `digama0/ConZF`) for `Halts M ↔ ZFInconsistent`, though Lean's constructive - type theory remains stronger than `PA`/`ZF` and does not by itself internalize the reduction - inside `PA`/`ZF` (see + `halts_zf432_iff_wadeZFInconsistent`), first-order `PA` consistency and $\Sigma_1^0$ + adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, + `paZFInconsistent_holds_iff_zfInconsistent`), the direct simulation reductions (`Goldbach21`, + `Zf380`, `Riemann104`), and all four `candidate_fewer_states` theorems (13 theorems total). + Disallowing `Classical.choice` blocks classical `Con(ZF)` shortcuts (`not_zfInconsistent` in + `ZFSet.{0}` or `Classical.em` + `digama0/ConZF`) for `Halts M ↔ ZFInconsistent`, while deeply + embedded `PAProvable` provides a weak first-order metatheory strictly below `ZF` (see [`Cryptids/Semantics/README.md`](../Cryptids/Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). - **`["propext", "Quot.sound", "Classical.choice"]`:** allowed in [`all.json`](./all.json), [`busy_beaver.json`](./busy_beaver.json), and the classical model-theoretic / arithmetic-stage / - analytic configs (`zf_393.json`, `zf_semantics.json`, `goldbach_semantics.json`, - `riemann_95.json`, `riemann_120.json`, `riemann_semantics.json`). + analytic configs (`pa_semantics.json`, `zf_393.json`, `zf_semantics.json`, + `goldbach_semantics.json`, `riemann_95.json`, `riemann_120.json`, `riemann_semantics.json`). 3. The exported proof terms are accepted by the Lean default kernel. ## Configurations | Config File | Challenge Module | Solution Module | Permitted Axioms | Verified Theorems | | :--- | :--- | :--- | :--- | :--- | -| [`constructive.json`](./constructive.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound` | All 10 constructive theorems: all 3 ZF proof-search equivalences (`zf_393`, `zf_380`, `zf_432`), direct state reductions (`Goldbach21`, `Zf380`, `Riemann104`), and `Riemann95.candidate_fewer_states` | -| [`all.json`](./all.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound`, `Classical.choice` | All 22 conjecture-checking state-reduction, equivalence, and semantics theorems | +| [`constructive.json`](./constructive.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound` | All 13 constructive theorems: all 3 ZF proof-search equivalences (`zf_393`, `zf_380`, `zf_432`), first-order `PA` consistency & $\Sigma_1^0$ adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), direct state reductions (`Goldbach21`, `Zf380`, `Riemann104`), and `Riemann95.candidate_fewer_states` | +| [`all.json`](./all.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound`, `Classical.choice` | All 26 conjecture-checking state-reduction, equivalence, `PA` metatheory, and semantics theorems | +| [`pa_semantics.json`](./pa_semantics.json) | `Challenge` | `Cryptids.Semantics.PA` | `propext`, `Quot.sound`, `Classical.choice` | `not_paProvable_false`, `paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`, `paProvable_sound_nat` | | [`busy_beaver.json`](./busy_beaver.json) | `BusyBeaverChallenge` | `BusyBeaver` | `propext`, `Quot.sound`, `Classical.choice` | All 299 `BB(6)` and `BB(3, 3)` holdout Level A and Level B theorems (`is_closed_pattern_set`, `has_collatz_reduction`, `is_closed_stack_pattern_set`, `has_stacked_collatz_reduction`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`) | | [`goldbach_21.json`](./goldbach_21.json) | `Challenge` | `Cryptids.Goldbach21` | `propext`, `Quot.sound` | `candidate_fewer_states`, `candidate_equivalent` | | [`goldbach_semantics.json`](./goldbach_semantics.json) | `Challenge` | `Cryptids.Semantics.Goldbach` | `propext`, `Quot.sound`, `Classical.choice` | `halts_reference_iff_not_goldbach`, `halts_candidate_iff_not_goldbach` | diff --git a/comparator/all.json b/comparator/all.json index 187b2d57..bc3c5600 100644 --- a/comparator/all.json +++ b/comparator/all.json @@ -15,6 +15,10 @@ "ConjectureMachines.Semantics.Zf.zfProvable_sound_zfSet", "ConjectureMachines.Semantics.Zf.not_zfInconsistent", "ConjectureMachines.Semantics.Zf.halts_zf432_iff_wadeZFInconsistent", + "ConjectureMachines.Semantics.PA.not_paProvable_false", + "ConjectureMachines.Semantics.PA.paHalts_holds_iff_halts", + "ConjectureMachines.Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent", + "ConjectureMachines.Semantics.PA.paProvable_sound_nat", "ConjectureMachines.Semantics.Riemann.halts_riemann744_iff_exists_counterexample", "ConjectureMachines.Semantics.Riemann.halts_riemann744_iff_not_riemannHypothesis", "ConjectureMachines.Riemann120.halts_riemann120_iff_not_riemannHypothesis", diff --git a/comparator/constructive.json b/comparator/constructive.json index 1261336b..5229c744 100644 --- a/comparator/constructive.json +++ b/comparator/constructive.json @@ -9,6 +9,9 @@ "ConjectureMachines.Zf380.candidate_equivalent", "ConjectureMachines.Zf380.Semantics.halts_candidate_iff_zfInconsistent", "ConjectureMachines.Semantics.Zf.halts_zf432_iff_wadeZFInconsistent", + "ConjectureMachines.Semantics.PA.not_paProvable_false", + "ConjectureMachines.Semantics.PA.paHalts_holds_iff_halts", + "ConjectureMachines.Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent", "ConjectureMachines.Riemann104.candidate_fewer_states", "ConjectureMachines.Riemann104.candidate_equivalent", "ConjectureMachines.Riemann95.candidate_fewer_states" diff --git a/comparator/pa_semantics.json b/comparator/pa_semantics.json new file mode 100644 index 00000000..e473b0a9 --- /dev/null +++ b/comparator/pa_semantics.json @@ -0,0 +1,15 @@ +{ + "challenge_module": "Challenge", + "solution_module": "Cryptids.Semantics.PA", + "theorem_names": [ + "ConjectureMachines.Semantics.PA.not_paProvable_false", + "ConjectureMachines.Semantics.PA.paHalts_holds_iff_halts", + "ConjectureMachines.Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent", + "ConjectureMachines.Semantics.PA.paProvable_sound_nat" + ], + "permitted_axioms": [ + "propext", + "Quot.sound", + "Classical.choice" + ] +}