diff --git a/Complexitylib/Circuits.lean b/Complexitylib/Circuits.lean index e13c17b3..775c7ab4 100644 --- a/Complexitylib/Circuits.lean +++ b/Complexitylib/Circuits.lean @@ -7,6 +7,12 @@ import Complexitylib.Circuits.Basic import Complexitylib.Circuits.BitString import Complexitylib.Circuits.DecisionTree import Complexitylib.Circuits.Formula +import Complexitylib.Circuits.FormulaEncoding +import Complexitylib.Circuits.FormulaEncoding.Navigation +import Complexitylib.Circuits.FormulaEncoding.ForwardNavigation +import Complexitylib.Circuits.FormulaEncoding.BitNavigation +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation +import Complexitylib.Circuits.CircuitFormula import Complexitylib.Circuits.Restriction import Complexitylib.Circuits.BranchingProgram import Complexitylib.Circuits.Barrington @@ -14,8 +20,21 @@ import Complexitylib.Circuits.BarringtonS5 import Complexitylib.Circuits.BarringtonBridge import Complexitylib.Circuits.BarringtonRepr import Complexitylib.Circuits.BarringtonLength +import Complexitylib.Circuits.BarringtonCompiler +import Complexitylib.Circuits.BarringtonStreaming +import Complexitylib.Circuits.BarringtonSlots +import Complexitylib.Circuits.BarringtonSlotQuery +import Complexitylib.Circuits.BarringtonTokenQuery +import Complexitylib.Circuits.BarringtonBitQuery +import Complexitylib.Circuits.BarringtonBitSerializer +import Complexitylib.Circuits.BarringtonProbeQuery +import Complexitylib.Circuits.BarringtonProbeSerializer +import Complexitylib.Circuits.BranchingProgramEncoding +import Complexitylib.Circuits.BranchingProgramEncoding.Machine +import Complexitylib.Circuits.BarringtonCodeGenerator import Complexitylib.Circuits.BarringtonFamily import Complexitylib.Circuits.BarringtonConverse +import Complexitylib.Circuits.CircuitFormula.Family import Complexitylib.Circuits.MultilinearExtension import Complexitylib.Circuits.NormalForm import Complexitylib.Circuits.AndOrNot @@ -28,6 +47,7 @@ import Complexitylib.Circuits.EssentialInput import Complexitylib.Circuits.Shannon import Complexitylib.Circuits.LowerBound import Complexitylib.Circuits.Schnorr +import Complexitylib.Circuits.DepthClasses import Complexitylib.Circuits.AC0 import Complexitylib.Circuits.Nondeterminism import Complexitylib.Circuits.Hardwiring @@ -84,7 +104,29 @@ convention. * **Barrington's theorem** (`barrington_equivalence`): Logarithmic-depth Boolean formula families are exactly polynomial-length - width-`5` permutation branching-program families. + width-`5` permutation branching-program families. The finite forward theorem + `barrington_representation_depth_four` gives the textbook length bound + `4 ^ depth`, and `barrington_quadratic_of_log_depth` specializes it to `n²` + at depth at most `log₂ n`. + `barringtonCompile_representation` supplies the same finite theorem through + an explicit executable compiler rather than an existential choice. + `BPCode.Program.decode?_encode` verifies the canonical serialized output + format needed by the remaining log-space uniformity proof. + `barringtonCompileCode_spec` then connects canonical formula bits to canonical + program bits, exact semantics, and a serialized output-size bound. + `barringtonCompileStream_instruction?` gives the corresponding exact + random-access instruction view without constructing the complete program, + while `barringtonCompileSlot?_eq_instruction?` follows one branch of the + fixed `4^D` address schedule and returns exactly its selected instruction, + while `barringtonCompileTokensSlot?_eq_instruction?` carries that query over + canonical postfix tokens using stack-free child-span recovery, and + `barringtonCompileBitsSlot?_eq_instruction?` performs the same query directly + over canonical encoded formula bits. `barringtonCompileProbeSlot?_eq_instruction?` + further replaces the complete bit list by a position-indexed source oracle, + with explicit finite decoding fuel. `barringtonCompileBitsCode_eq` then proves + the fixed-address two-pass serializer emits the exact canonical code. + `BoolFunFamily.onTotalAssignments_mem_Width5BP` applies the theorem to the + total-assignment view of an actual typed `NC1` circuit family. ## Module structure @@ -94,10 +136,40 @@ Public modules (definitions a reviewer should read): `CompleteBasis`, `sizeComplexity`, `wireDepth`, `depth` * `Complexitylib.Circuits.BitString` — canonical bridges between `BitString n` and `List Bool` +* `Complexitylib.Circuits.CircuitFormula` — exact selected-output unfolding from + fan-in-two circuit DAGs to Boolean formulas, with a factor-two depth bound +* `Complexitylib.Circuits.FormulaEncoding` — canonical iterative postfix formula + codec with exact round trips and code length +* `Complexitylib.Circuits.FormulaEncoding.ProbeNavigation` — exact token, + subtree, and child-span navigation through a position-indexed bit oracle +* `Complexitylib.Circuits.CircuitFormula.Family` — family-level unfolding and + the typed-`NC1` bridge to width-`5` branching programs * `Complexitylib.Circuits.Family` — circuit families, list semantics, pointwise size/depth bounds, and the polynomial-size characterization * `Complexitylib.Circuits.BarringtonConverse` — balanced branching-program evaluation and the nonuniform Barrington equivalence +* `Complexitylib.Circuits.BarringtonCompiler` — executable finite `S₅` search + and formula-to-program compilation with the `4 ^ depth` bound +* `Complexitylib.Circuits.BarringtonStreaming` — random-access compilation by + instruction index without materializing the complete recursive program +* `Complexitylib.Circuits.BarringtonSlots` — exact placement of compiled + instructions in a depth-bounded fixed-address schedule +* `Complexitylib.Circuits.BarringtonSlotQuery` — structural first/last occupied + addresses and exact direct lookup in that fixed schedule +* `Complexitylib.Circuits.BarringtonTokenQuery` — the same exact fixed-slot + query over canonical postfix token streams, without reconstructing a formula +* `Complexitylib.Circuits.BarringtonBitQuery` — the fixed-slot query directly + over canonical encoded formula bits, with bit-level child-span recovery +* `Complexitylib.Circuits.BarringtonBitSerializer` — exact two-pass canonical + serialization by scanning the fixed encoded-bit address schedule +* `Complexitylib.Circuits.BarringtonProbeQuery` — exact fixed-address queries + through restartable position-indexed formula-code probes +* `Complexitylib.Circuits.BranchingProgramEncoding` — canonical seven-bit + permutation ranks, instruction/program codecs, and exact size bounds +* `Complexitylib.Circuits.BranchingProgramEncoding.Machine` — framed, + one-way machine emission of canonical instruction codes from binary registers +* `Complexitylib.Circuits.BarringtonCodeGenerator` — the total bitstring-level + formula-code-to-program-code reference for promised log-depth `FL` generation * `Complexitylib.Circuits.Encoding` — canonical proof-free encoding, validation, and iterative evaluation of fan-in-two AND/OR circuits * `Complexitylib.Circuits.Encoding.Family` — tagged encoding and evaluation at @@ -116,7 +188,9 @@ Public modules (definitions a reviewer should read): (`two_pow_le_complexity_of_xorBool`) * `Complexitylib.Circuits.XOR` — `Schnorr.xorBool` (N-input parity) * `Complexitylib.Circuits.EssentialInput` — `IsEssentialInput`, `essentialInputs` -* `Complexitylib.Circuits.AC0` — `AC0` +* `Complexitylib.Circuits.DepthClasses` — `DEPTH`, the nonuniform `NC` and `AC` + hierarchies, and the aliases `NC0`, `NC1`, and `AC0` +* `Complexitylib.Circuits.AC0` — compatibility import for `AC0` * `Complexitylib.Circuits.Nondeterminism.Defs` — `existsQuantify`, `forallQuantify` * `Complexitylib.Circuits.Hardwiring` — exact-size prefix hardwiring * `Complexitylib.Circuits.Unrolling` — bounded machine-configuration layouts, diff --git a/Complexitylib/Circuits/AC0.lean b/Complexitylib/Circuits/AC0.lean index 1592a978..5422a953 100644 --- a/Complexitylib/Circuits/AC0.lean +++ b/Complexitylib/Circuits/AC0.lean @@ -4,13 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Samuel Schlesinger -/ import Complexitylib.Circuits.AC0.Defs +import Complexitylib.Circuits.DepthClasses /-! # The class AC⁰ -Surface module for `Complexity.AC0`: Boolean-function families computable by -constant-depth, polynomial-size circuit families of unbounded fan-in AND/OR -gates with free negation on wires. The definition lives in -`Complexitylib.Circuits.AC0.Defs`; separation results against AC⁰ are a -roadmap item and will surface here. +Compatibility surface for `Complexity.AC0`: Boolean-function families computed +by constant-depth, polynomial-size circuit families of unbounded fan-in AND/OR +gates with free negation on wires. The definition and basic API now live in +`Complexitylib.Circuits.DepthClasses`; separation results against AC⁰ remain +a roadmap item. -/ diff --git a/Complexitylib/Circuits/AC0/Defs.lean b/Complexitylib/Circuits/AC0/Defs.lean index d865cae0..693ad72f 100644 --- a/Complexitylib/Circuits/AC0/Defs.lean +++ b/Complexitylib/Circuits/AC0/Defs.lean @@ -3,35 +3,12 @@ Copyright (c) 2025 Samuel Schlesinger. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Samuel Schlesinger -/ -import Complexitylib.Circuits.AndOrNot.Defs +import Complexitylib.Circuits.DepthClasses.Defs -/-! # AC0 — Core Definitions +/-! +# AC0 -- compatibility import -This module defines the AC0 circuit complexity class. - -## Main definitions - -* `AC0` — the class of families in AC0 (constant depth, polynomial size, - unbounded fan-in AND/OR) +`Complexity.AC0` now lives with the complete `DEPTH`/`NC`/`AC` hierarchy in +`Complexitylib.Circuits.DepthClasses.Defs`. This module preserves the original +import path. -/ - -namespace Complexity - -/-- A Boolean function family is in **AC0** if there exist constants `d` -(depth bound) and `c` (size exponent) such that for every input length -`N ≥ 1`, some unbounded-fan-in AND/OR circuit of depth at most `d` and -size at most `N ^ c` computes `f N`. - -This captures the standard definition of AC0: -- **Constant depth**: the circuit depth does not grow with `N`. -- **Polynomial size**: the number of gates is bounded by a polynomial in `N`. -- **Unbounded fan-in**: AND and OR gates may have arbitrarily many inputs. -- **Free negation**: each gate input carries a negation flag (standard in - circuit complexity). -/ -def AC0 : Set BoolFunFamily := fun f => - ∃ (d c : Nat), ∀ (N : Nat) [NeZero N], - ∃ (G : Nat) (circuit : Circuit Basis.unboundedAndOr N 1 G), - circuit.depth ≤ d ∧ circuit.size ≤ N ^ c ∧ - (fun x => (circuit.eval x) 0) = f N - -end Complexity diff --git a/Complexitylib/Circuits/Barrington.lean b/Complexitylib/Circuits/Barrington.lean index 481ab45a..b3f4ee46 100644 --- a/Complexitylib/Circuits/Barrington.lean +++ b/Complexitylib/Circuits/Barrington.lean @@ -5,6 +5,7 @@ Authors: Samuel Schlesinger -/ import Complexitylib.Circuits.BranchingProgram import Mathlib.Algebra.Group.Commutator +import Mathlib.Data.List.ModifyLast /-! # Toward Barrington's theorem: the group-theoretic core @@ -20,9 +21,12 @@ Boolean function `f` through the permutation `σ`, meaning it evaluates to `σ` exactly when `f` holds and to `1` (the identity) otherwise. The closure lemmas proved here are the moves in Barrington's inductive construction: -- **conjugation** changes the representing permutation (`Computes_conj`); -- **negation** flips the function while inverting the permutation - (`Computes_not`); +- **conjugation** changes the representing permutation, either by wrapping the + program (`Computes_conj`) or pointwise with no length overhead + (`Computes_conjugate`); +- **negation** flips the function while inverting the permutation, either by + appending a constant (`Computes_not`) or by folding that constant into the + final instruction (`Computes_not_compact`); - the **commutator trick** (`Computes_and`) represents `f ∧ g` through the commutator `⁅σ, τ⁆` — choosing `σ, τ` to be `5`-cycles in `S₅` whose commutator is again a `5`-cycle is exactly what makes the `AND` gate work. @@ -32,7 +36,12 @@ proved here are the moves in Barrington's inductive construction: - `BPInstr.inverse`, `BP.inverse`, `BP.eval_inverse` — inverting a program inverts the permutation it evaluates to. - `BPInstr.const`, `BPInstr.eval_const` — constant instructions. -- `BP.Computes`, `BP.Computes_conj`, `BP.Computes_not`, `BP.Computes_and`. +- `BPInstr.conjugate`, `BP.conjugate`, `BP.eval_conjugate` — length-preserving + pointwise conjugation. +- `BPInstr.postMul`, `BP.postMul`, `BP.eval_postMul` — fold a final constant + into the last instruction, adding an instruction only to the empty program. +- `BP.Computes`, `BP.Computes_conj`, `BP.Computes_not`, + `BP.Computes_not_compact`, `BP.Computes_and`. -/ open scoped commutatorElement @@ -60,6 +69,83 @@ def BPInstr.const {w : ℕ} (c : Equiv.Perm (Fin w)) : BPInstr w := simp only [BPInstr.eval, BPInstr.const] cases α 0 <;> rfl +/-- Conjugate both branches of an instruction by the same permutation. -/ +def BPInstr.conjugate {w : ℕ} (τ : Equiv.Perm (Fin w)) + (ins : BPInstr w) : BPInstr w := + { ins with + perm0 := τ * ins.perm0 * τ⁻¹ + perm1 := τ * ins.perm1 * τ⁻¹ } + +/-- Pointwise instruction conjugation realizes group conjugation. -/ +@[simp] theorem BPInstr.eval_conjugate {w : ℕ} (α : ℕ → Bool) + (τ : Equiv.Perm (Fin w)) (ins : BPInstr w) : + BPInstr.eval α (BPInstr.conjugate τ ins) = + τ * BPInstr.eval α ins * τ⁻¹ := by + simp only [BPInstr.eval, BPInstr.conjugate] + cases α ins.var <;> rfl + +/-- Right-multiply both branches of an instruction by a fixed permutation. -/ +def BPInstr.postMul {w : ℕ} (ins : BPInstr w) + (c : Equiv.Perm (Fin w)) : BPInstr w := + { ins with perm0 := ins.perm0 * c, perm1 := ins.perm1 * c } + +/-- Right-multiplication commutes with selecting an instruction branch. -/ +@[simp] theorem BPInstr.eval_postMul {w : ℕ} (α : ℕ → Bool) + (ins : BPInstr w) (c : Equiv.Perm (Fin w)) : + BPInstr.eval α (BPInstr.postMul ins c) = BPInstr.eval α ins * c := by + simp only [BPInstr.eval, BPInstr.postMul] + cases α ins.var <;> rfl + +/-- Conjugate every instruction of a branching program. Unlike wrapping with +constant instructions, this operation preserves length exactly. -/ +def BP.conjugate {w : ℕ} (τ : Equiv.Perm (Fin w)) (p : BP w) : BP w := + p.map (BPInstr.conjugate τ) + +/-- Pointwise conjugation conjugates the value of the whole program. -/ +theorem BP.eval_conjugate {w : ℕ} (α : ℕ → Bool) + (τ : Equiv.Perm (Fin w)) (p : BP w) : + BP.eval α (BP.conjugate τ p) = τ * BP.eval α p * τ⁻¹ := by + induction p with + | nil => simp [BP.conjugate, BP.eval] + | cons ins p ih => + rw [show BP.conjugate τ (ins :: p) = + BPInstr.conjugate τ ins :: BP.conjugate τ p from rfl] + rw [BP.eval_cons, BPInstr.eval_conjugate, ih, BP.eval_cons] + simp only [mul_assoc, inv_mul_cancel_left] + +/-- Pointwise conjugation preserves program length exactly. -/ +@[simp] theorem BP.length_conjugate {w : ℕ} + (τ : Equiv.Perm (Fin w)) (p : BP w) : + (BP.conjugate τ p).length = p.length := by + simp [BP.conjugate] + +/-- Fold a final constant multiplication into the last instruction. The empty +program has no last instruction, so it becomes a singleton constant program. -/ +def BP.postMul {w : ℕ} (p : BP w) (c : Equiv.Perm (Fin w)) : BP w := + if p = [] then [BPInstr.const c] + else p.modifyLast fun ins => BPInstr.postMul ins c + +/-- Folding a final constant into the last instruction right-multiplies the +program value. -/ +theorem BP.eval_postMul {w : ℕ} (α : ℕ → Bool) (p : BP w) + (c : Equiv.Perm (Fin w)) : + BP.eval α (BP.postMul p c) = BP.eval α p * c := by + induction p using List.reverseRecOn with + | nil => simp [BP.postMul, BP.eval_singleton] + | append_singleton p ins ih => + simp [BP.postMul, List.modifyLast_concat, BP.eval_append, + BP.eval_singleton, mul_assoc] + +/-- Folding a final constant uses the original length, except that an empty +program needs one instruction. -/ +theorem BP.length_postMul {w : ℕ} (p : BP w) + (c : Equiv.Perm (Fin w)) : + (BP.postMul p c).length = max 1 p.length := by + induction p using List.reverseRecOn with + | nil => simp [BP.postMul] + | append_singleton p ins ih => + simp [BP.postMul, List.modifyLast_concat] + /-- Invert a branching program: reverse the instruction list and invert each instruction. -/ def BP.inverse {w : ℕ} (p : BP w) : BP w := (p.map BPInstr.inverse).reverse @@ -91,6 +177,16 @@ theorem BP.Computes_conj {w : ℕ} {σ : Equiv.Perm (Fin w)} {p : BP w} simp only [BP.eval_append, BP.eval_singleton, BPInstr.eval_const, h α] rcases Bool.eq_false_or_eq_true (f α) with hf | hf <;> simp [hf] +/-- **Length-preserving conjugation.** Conjugating every instruction changes +the representing permutation without adding constant instructions. -/ +theorem BP.Computes_conjugate {w : ℕ} {σ : Equiv.Perm (Fin w)} {p : BP w} + {f : (ℕ → Bool) → Bool} (h : BP.Computes σ p f) + (τ : Equiv.Perm (Fin w)) : + BP.Computes (τ * σ * τ⁻¹) (BP.conjugate τ p) f := by + intro α + rw [BP.eval_conjugate, h α] + rcases Bool.eq_false_or_eq_true (f α) with hf | hf <;> simp [hf] + /-- **Negation.** Appending a constant `σ⁻¹` to a program that represents `f` through `σ` yields a program representing `¬f` through `σ⁻¹`. -/ theorem BP.Computes_not {w : ℕ} {σ : Equiv.Perm (Fin w)} {p : BP w} @@ -100,6 +196,16 @@ theorem BP.Computes_not {w : ℕ} {σ : Equiv.Perm (Fin w)} {p : BP w} simp only [BP.eval_append, BP.eval_singleton, BPInstr.eval_const, h α] rcases Bool.eq_false_or_eq_true (f α) with hf | hf <;> simp [hf] +/-- **Compact negation.** Multiplying the final selected permutation by `σ⁻¹` +represents `¬f` through `σ⁻¹`. The multiplication is folded into the last +instruction, so the length becomes only `max 1 p.length`. -/ +theorem BP.Computes_not_compact {w : ℕ} {σ : Equiv.Perm (Fin w)} {p : BP w} + {f : (ℕ → Bool) → Bool} (h : BP.Computes σ p f) : + BP.Computes σ⁻¹ (BP.postMul p σ⁻¹) (fun α => !f α) := by + intro α + rw [BP.eval_postMul, h α] + rcases Bool.eq_false_or_eq_true (f α) with hf | hf <;> simp [hf] + /-- **The commutator trick** (Barrington's `AND` gate). If `p` represents `f` through `σ` and `q` represents `g` through `τ`, then the commutator program `p q p⁻¹ q⁻¹` represents `f ∧ g` through the commutator `⁅σ, τ⁆`. diff --git a/Complexitylib/Circuits/BarringtonBitQuery.lean b/Complexitylib/Circuits/BarringtonBitQuery.lean new file mode 100644 index 00000000..284b38e6 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonBitQuery.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonBitQuery.Defs +import Complexitylib.Circuits.BarringtonBitQuery.Internal +import Complexitylib.Circuits.BarringtonTokenQuery + +/-! +# Direct Barrington queries over canonical formula bits + +This module moves the fixed-address Barrington controller from postfix token +lists to their canonical bit encoding. The controller recovers token roots and +child spans through bit-level probes, follows one base-four address, and never +reconstructs the inductive formula or materializes the complete branching +program. + +## Main results + +- `barringtonBitsFirstOccupiedSlot?_eq` -- encoded traversal finds the exact + structural first address. +- `barringtonBitsLastOccupiedSlot?_eq` -- encoded traversal finds the exact + structural last address. +- `barringtonCompileBitsSlot?_eq_instruction?` -- every encoded-bit query + returns exactly the corresponding fixed-schedule instruction. +-/ + +namespace Complexity + +/-- Traversal over canonical formula bits computes the structural first +occupied Barrington address. -/ +theorem barringtonBitsFirstOccupiedSlot?_eq (fuel : ℕ) + (formula : BoolFormula) : + barringtonBitsFirstOccupiedSlot? fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ = + barringtonFirstOccupiedSlot? fuel formula := by + calc + _ = barringtonTokensFirstOccupiedSlot? fuel + (FormulaCode.tokens formula) := by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + (barringtonBitsOccupiedSlots_correct_context_internal fuel [] [] + formula).1 + _ = _ := barringtonTokensFirstOccupiedSlot?_eq fuel formula + +/-- Traversal over canonical formula bits computes the structural last +occupied Barrington address. -/ +theorem barringtonBitsLastOccupiedSlot?_eq (fuel : ℕ) + (formula : BoolFormula) : + barringtonBitsLastOccupiedSlot? fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ = + barringtonLastOccupiedSlot? fuel formula := by + calc + _ = barringtonTokensLastOccupiedSlot? fuel + (FormulaCode.tokens formula) := by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + (barringtonBitsOccupiedSlots_correct_context_internal fuel [] [] + formula).2 + _ = _ := barringtonTokensLastOccupiedSlot?_eq fuel formula + +/-- Every direct query over canonical formula bits agrees with the selected +instruction of the list-valued fixed Barrington schedule. -/ +theorem barringtonCompileBitsSlot?_eq_instruction? (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (slot : ℕ) : + barringtonCompileBitsSlot? fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target slot = + BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot := by + calc + _ = barringtonCompileTokensSlot? fuel (FormulaCode.tokens formula) + target slot := by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + barringtonCompileBitsSlot?_correct_context_internal fuel [] [] + formula target slot + _ = _ := + barringtonCompileTokensSlot?_eq_instruction? fuel formula target slot + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonBitQuery/Defs.lean b/Complexitylib/Circuits/BarringtonBitQuery/Defs.lean new file mode 100644 index 00000000..89628d17 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonBitQuery/Defs.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonTokenQuery.Defs +import Complexitylib.Circuits.FormulaEncoding.BitNavigation.Defs + +/-! +# Direct Barrington queries over encoded token segments -- definitions + +These recurrences are the pure semantics of the eventual probe controller. +They retain only a token segment, query its root from encoded bits, recover +binary child spans by the backwards owed-subtree scan, and follow one selected +base-four Barrington address. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- Query the root token of a nonempty segment. -/ +def segmentRootToken? (bits : List Bool) + (segment : TokenSegment) : Option Token := do + let root ← segment.root? + tokenValueAt? bits root + +end FormulaCode + +/-- First occupied fixed address computed from one encoded token segment. -/ +def barringtonBitsFirstOccupiedSlot? : ℕ → List Bool → + FormulaCode.TokenSegment → Option ℕ + | 0, bits, segment => + match FormulaCode.segmentRootToken? bits segment with + | some (.var _) | some .tru => some 0 + | _ => none + | fuel + 1, bits, segment => + match FormulaCode.segmentRootToken? bits segment with + | some (.var _) | some .tru => some 0 + | some .fls => none + | some .neg => + match segment.dropRoot? with + | none => none + | some child => + some ((barringtonBitsFirstOccupiedSlot? + fuel bits child).getD 0) + | some .conj => + match FormulaCode.encodedBinaryChildren? bits segment with + | none => none + | some (left, right) => + match barringtonBitsFirstOccupiedSlot? fuel bits left with + | some slot => some slot + | none => + (barringtonBitsFirstOccupiedSlot? fuel bits right).map + (4 ^ fuel + ·) + | some .disj => + match FormulaCode.encodedBinaryChildren? bits segment with + | none => none + | some (left, _) => + some ((barringtonBitsFirstOccupiedSlot? + fuel bits left).getD 0) + | none => none + +/-- Last occupied fixed address computed from one encoded token segment. -/ +def barringtonBitsLastOccupiedSlot? : ℕ → List Bool → + FormulaCode.TokenSegment → Option ℕ + | 0, bits, segment => + match FormulaCode.segmentRootToken? bits segment with + | some (.var _) | some .tru => some 0 + | _ => none + | fuel + 1, bits, segment => + match FormulaCode.segmentRootToken? bits segment with + | some (.var _) | some .tru => some 0 + | some .fls => none + | some .neg => + match segment.dropRoot? with + | none => none + | some child => + some ((barringtonBitsLastOccupiedSlot? + fuel bits child).getD 0) + | some .conj => + match FormulaCode.encodedBinaryChildren? bits segment with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + match barringtonBitsFirstOccupiedSlot? fuel bits right with + | some slot => + some (3 * blockSize + (blockSize - 1 - slot)) + | none => + (barringtonBitsFirstOccupiedSlot? fuel bits left).map + fun slot => 2 * blockSize + (blockSize - 1 - slot) + | some .disj => + match FormulaCode.encodedBinaryChildren? bits segment with + | none => none + | some (_, right) => + let blockSize := 4 ^ fuel + let firstRight := + (barringtonBitsFirstOccupiedSlot? fuel bits right).getD 0 + some (3 * blockSize + (blockSize - 1 - firstRight)) + | none => none + +/-- Query one fixed-address Barrington instruction from an encoded token +segment. -/ +def barringtonCompileBitsSlot? : ℕ → List Bool → + FormulaCode.TokenSegment → Equiv.Perm (Fin 5) → ℕ → + Option (BPInstr 5) + | fuel, bits, segment, target, slot => + match fuel, FormulaCode.segmentRootToken? bits segment with + | _, some (.var index) => + if slot = 0 then some ⟨index, 1, target⟩ else none + | _, some .tru => + if slot = 0 then some (BPInstr.const target) else none + | _, some .fls => none + | 0, _ => none + | fuel + 1, some .neg => + match segment.dropRoot? with + | none => none + | some child => + let blockSize := 4 ^ fuel + if slot < blockSize then + barringtonPostMulSlot? + (barringtonCompileBitsSlot? fuel bits child target⁻¹) + (barringtonBitsLastOccupiedSlot? fuel bits child) + target slot + else + none + | fuel + 1, some .conj => + match FormulaCode.encodedBinaryChildren? bits segment with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + let leftQuery := barringtonCompileBitsSlot? fuel bits left + (barringtonLeft target) + let rightQuery := barringtonCompileBitsSlot? fuel bits right + (barringtonRight target) + if slot < blockSize then + leftQuery slot + else if slot < 2 * blockSize then + rightQuery (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (slot - 3 * blockSize) + else + none + | fuel + 1, some .disj => + match FormulaCode.encodedBinaryChildren? bits segment with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftQuery := barringtonPostMulSlot? + (barringtonCompileBitsSlot? fuel bits left leftTarget⁻¹) + (barringtonBitsLastOccupiedSlot? fuel bits left) leftTarget + let rightQuery := barringtonPostMulSlot? + (barringtonCompileBitsSlot? fuel bits right rightTarget⁻¹) + (barringtonBitsLastOccupiedSlot? fuel bits right) rightTarget + let commutatorQuery := fun localSlot => + if localSlot < blockSize then + leftQuery localSlot + else if localSlot < 2 * blockSize then + rightQuery (localSlot - blockSize) + else if localSlot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (localSlot - 2 * blockSize) + else if localSlot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (localSlot - 3 * blockSize) + else + none + let firstRight := + (barringtonBitsFirstOccupiedSlot? fuel bits right).getD 0 + let commutatorLast := + 3 * blockSize + (blockSize - 1 - firstRight) + barringtonPostMulSlot? commutatorQuery + (some commutatorLast) target slot + | _, none => none + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonBitQuery/Internal.lean b/Complexitylib/Circuits/BarringtonBitQuery/Internal.lean new file mode 100644 index 00000000..8f042444 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonBitQuery/Internal.lean @@ -0,0 +1,354 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonBitQuery.Defs +import Complexitylib.Circuits.BarringtonTokenQuery.Internal +import Complexitylib.Circuits.FormulaEncoding.BitNavigation.Internal + +/-! +# Direct Barrington queries over encoded token segments -- proof internals +-/ + +namespace Complexity + +namespace FormulaCode + +theorem segmentRootToken?_encodeTokenStream_context_internal + (before after : List Token) (formula : BoolFormula) : + segmentRootToken? + (encodeTokenStream (before ++ tokens formula ++ after)) + ⟨before.length, formula.size⟩ = + (tokens formula).getLast? := by + have hpositive : 0 < formula.size := by + cases formula <;> simp [BoolFormula.size] + rw [segmentRootToken?] + rw [show formula.size = (formula.size - 1) + 1 by omega] + simp only [TokenSegment.root?, Option.bind_eq_bind, Option.bind_some] + have hglobal : before.length + (formula.size - 1) < + (before ++ tokens formula ++ after).length := by + simp + omega + rw [tokenValueAt?_encodeTokenStream_internal _ _ hglobal] + rw [← List.getElem?_eq_getElem hglobal] + rw [List.getElem?_append_left (by simp; omega)] + rw [List.getElem?_append_right (by omega)] + rw [show before.length + (formula.size - 1) - before.length = + formula.size - 1 by omega] + rw [List.getLast?_eq_getElem?] + simp + +end FormulaCode + +theorem barringtonBitsOccupiedSlots_correct_context_internal (fuel : ℕ) + (before after : List FormulaCode.Token) (formula : BoolFormula) : + let bits := FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after) + let segment : FormulaCode.TokenSegment := + ⟨before.length, formula.size⟩ + barringtonBitsFirstOccupiedSlot? fuel bits segment = + barringtonTokensFirstOccupiedSlot? fuel + (FormulaCode.tokens formula) ∧ + barringtonBitsLastOccupiedSlot? fuel bits segment = + barringtonTokensLastOccupiedSlot? fuel + (FormulaCode.tokens formula) := by + induction fuel generalizing before after formula with + | zero => + have hroot := + FormulaCode.segmentRootToken?_encodeTokenStream_context_internal + before after formula + cases formula <;> + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot <;> + simp [barringtonBitsFirstOccupiedSlot?, + barringtonBitsLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, hroot] + | succ fuel ih => + have hroot := + FormulaCode.segmentRootToken?_encodeTokenStream_context_internal + before after formula + cases formula with + | var index => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + simp [barringtonBitsFirstOccupiedSlot?, + barringtonBitsLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, hroot] + | tru => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + simp [barringtonBitsFirstOccupiedSlot?, + barringtonBitsLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, hroot] + | fls => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + simp [barringtonBitsFirstOccupiedSlot?, + barringtonBitsLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, hroot] + | neg formula => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchild := ih before (FormulaCode.Token.neg :: after) formula + have hchild' : + barringtonBitsFirstOccupiedSlot? fuel + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.neg formula) ++ after)) + ⟨before.length, formula.size⟩ = + barringtonTokensFirstOccupiedSlot? fuel + (FormulaCode.tokens formula) ∧ + barringtonBitsLastOccupiedSlot? fuel + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.neg formula) ++ after)) + ⟨before.length, formula.size⟩ = + barringtonTokensLastOccupiedSlot? fuel + (FormulaCode.tokens formula) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchild + simp [FormulaCode.tokens, List.append_assoc] at hchild' + simp [barringtonBitsFirstOccupiedSlot?, + barringtonBitsLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.TokenSegment.dropRoot?, hroot, + hchild'.1, hchild'.2] + | conj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.encodedBinaryChildren?_encodeTokenStream_internal + before after left right FormulaCode.Token.conj + have hchildren' : + FormulaCode.encodedBinaryChildren? + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ after)) + ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleft := ih before + (FormulaCode.tokens right ++ FormulaCode.Token.conj :: after) + left + have hright := ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.conj :: after) right + have hleft' := hleft + have hright' := hright + simp [List.append_assoc] at hleft' hright' + simp [barringtonBitsFirstOccupiedSlot?, + barringtonBitsLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hroot, hchildren', hleft'.1, hright'.1] + exact ⟨rfl, rfl⟩ + | disj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.encodedBinaryChildren?_encodeTokenStream_internal + before after left right FormulaCode.Token.disj + have hchildren' : + FormulaCode.encodedBinaryChildren? + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ after)) + ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleft := ih before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left + have hright := ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right + have hleft' := hleft + have hright' := hright + simp [List.append_assoc] at hleft' hright' + simp [barringtonBitsFirstOccupiedSlot?, + barringtonBitsLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hroot, hchildren', hleft'.1, hright'.1] + +theorem barringtonCompileBitsSlot?_correct_context_internal (fuel : ℕ) + (before after : List FormulaCode.Token) (formula : BoolFormula) + (target : Equiv.Perm (Fin 5)) (slot : ℕ) : + barringtonCompileBitsSlot? fuel + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after)) + ⟨before.length, formula.size⟩ target slot = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens formula) target slot := by + induction fuel generalizing before after formula target slot with + | zero => + have hroot := + FormulaCode.segmentRootToken?_encodeTokenStream_context_internal + before after formula + cases formula <;> + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ <;> + simp [barringtonCompileBitsSlot?, + barringtonCompileTokensSlot?, hroot] + | succ fuel ih => + have hroot := + FormulaCode.segmentRootToken?_encodeTokenStream_context_internal + before after formula + cases formula with + | var index => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileBitsSlot?, + barringtonCompileTokensSlot?, hroot] + | tru => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileBitsSlot?, + barringtonCompileTokensSlot?, hroot] + | fls => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileBitsSlot?, + barringtonCompileTokensSlot?, hroot] + | neg formula => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hoccupied := + barringtonBitsOccupiedSlots_correct_context_internal fuel before + (FormulaCode.Token.neg :: after) formula + have hquery : + barringtonCompileBitsSlot? fuel + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.neg formula) ++ after)) + ⟨before.length, formula.size⟩ target⁻¹ = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens formula) target⁻¹ := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before (FormulaCode.Token.neg :: after) formula target⁻¹ + querySlot + simp [FormulaCode.tokens, List.append_assoc] at hquery + have hoccupied' := hoccupied + simp [List.append_assoc] at hoccupied' + simp [barringtonCompileBitsSlot?, + barringtonCompileTokensSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.TokenSegment.dropRoot?, hroot, hquery, + hoccupied'.2] + | conj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.encodedBinaryChildren?_encodeTokenStream_internal + before after left right FormulaCode.Token.conj + have hchildren' : + FormulaCode.encodedBinaryChildren? + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ after)) + ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleftQuery : + barringtonCompileBitsSlot? fuel + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ after)) + ⟨before.length, left.size⟩ (barringtonLeft target) = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens left) (barringtonLeft target) := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before + (FormulaCode.tokens right ++ FormulaCode.Token.conj :: after) + left (barringtonLeft target) querySlot + have hrightQuery : + barringtonCompileBitsSlot? fuel + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ after)) + ⟨before.length + left.size, right.size⟩ + (barringtonRight target) = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens right) (barringtonRight target) := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.conj :: after) right + (barringtonRight target) querySlot + simp [FormulaCode.tokens, List.append_assoc] at hleftQuery hrightQuery + simp [barringtonCompileBitsSlot?, + barringtonCompileTokensSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hroot, hchildren', hleftQuery, hrightQuery] + | disj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.encodedBinaryChildren?_encodeTokenStream_internal + before after left right FormulaCode.Token.disj + have hchildren' : + FormulaCode.encodedBinaryChildren? + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ after)) + ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleftOccupied := + barringtonBitsOccupiedSlots_correct_context_internal fuel before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left + have hrightOccupied := + barringtonBitsOccupiedSlots_correct_context_internal fuel + (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right + have hleftOccupied' := hleftOccupied + have hrightOccupied' := hrightOccupied + simp [List.append_assoc] at hleftOccupied' hrightOccupied' + have hleftQuery (childTarget : Equiv.Perm (Fin 5)) : + barringtonCompileBitsSlot? fuel + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ after)) + ⟨before.length, left.size⟩ childTarget = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens left) childTarget := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left childTarget querySlot + have hrightQuery (childTarget : Equiv.Perm (Fin 5)) : + barringtonCompileBitsSlot? fuel + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ after)) + ⟨before.length + left.size, right.size⟩ childTarget = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens right) childTarget := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right childTarget querySlot + simp [FormulaCode.tokens, List.append_assoc] at hleftQuery hrightQuery + simp [barringtonCompileBitsSlot?, + barringtonCompileTokensSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hroot, hchildren', hleftOccupied'.2, + hrightOccupied'.1, hrightOccupied'.2, + hleftQuery, hrightQuery] + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonBitSerializer.lean b/Complexitylib/Circuits/BarringtonBitSerializer.lean new file mode 100644 index 00000000..9b63251a --- /dev/null +++ b/Complexitylib/Circuits/BarringtonBitSerializer.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonBitSerializer.Defs +import Complexitylib.Circuits.BarringtonBitSerializer.Internal + +/-! +# Fixed-slot Barrington serialization over encoded formula bits + +This module specifies the exact two-pass stream used by the uniform generator: +query all `4 ^ fuel` fixed addresses, count and erase empty slots, then emit the +canonical branching-program code. Under the promised depth bound, the result +is byte-for-byte the existing executable Barrington compiler's code. + +## Main results + +- `barringtonCompileBitsSlots_eq` -- querying every fixed address reconstructs + the fixed optional schedule exactly. +- `barringtonCompileBitsProgram_eq` -- erasing empty queried slots recovers the + executable Barrington compiler. +- `barringtonCompileBitsProgram_length` -- the first pass computes the exact + instruction count used by the canonical header. +- `barringtonCompileBitsCode_eq` -- the complete serialized output is exact. +-/ + +namespace Complexity + +/-- Querying all encoded-bit addresses reconstructs the fixed optional schedule +exactly. -/ +theorem barringtonCompileBitsSlots_eq (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + barringtonCompileBitsSlots fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target = + barringtonCompileSlots fuel formula target := + barringtonCompileBitsSlots_correct_internal fuel formula target + +/-- Under the depth promise, erasing empty queried addresses recovers the +executable Barrington compiler instruction-for-instruction. -/ +theorem barringtonCompileBitsProgram_eq (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + barringtonCompileBitsProgram fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target = + barringtonCompile formula target := + barringtonCompileBitsProgram_correct_internal fuel formula target hdepth + +/-- The queried instruction stream has exactly the target-independent count +used by the canonical program header. -/ +theorem barringtonCompileBitsProgram_length (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + (barringtonCompileBitsProgram fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target).length = + barringtonInstructionCount formula := + barringtonCompileBitsProgram_length_internal fuel formula target hdepth + +/-- Under the depth promise, the fixed-address two-pass serializer emits the +exact canonical code of the executable Barrington compiler. -/ +theorem barringtonCompileBitsCode_eq (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + barringtonCompileBitsCode fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target = + BPCode.Program.encode (barringtonCompile formula target) := + barringtonCompileBitsCode_correct_internal fuel formula target hdepth + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonBitSerializer/Defs.lean b/Complexitylib/Circuits/BarringtonBitSerializer/Defs.lean new file mode 100644 index 00000000..53963883 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonBitSerializer/Defs.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonBitQuery.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Defs + +/-! +# Fixed-slot Barrington serialization over encoded formula bits -- definitions + +The eventual log-space machine makes two passes over the fixed `4 ^ fuel` +address space. The first pass counts occupied slots for the program header; the +second emits each occupied instruction. These pure definitions fix that exact +two-pass output independently of the machine implementation. +-/ + +namespace Complexity + +/-- Query every address in the fixed Barrington schedule. -/ +def barringtonCompileBitsSlots (fuel : ℕ) (bits : List Bool) + (segment : FormulaCode.TokenSegment) (target : Equiv.Perm (Fin 5)) : + BPSlots 5 := + (List.range (4 ^ fuel)).map fun slot => + barringtonCompileBitsSlot? fuel bits segment target slot + +/-- Erase empty fixed addresses to obtain the emitted instruction stream. -/ +def barringtonCompileBitsProgram (fuel : ℕ) (bits : List Bool) + (segment : FormulaCode.TokenSegment) (target : Equiv.Perm (Fin 5)) : + BP 5 := + (barringtonCompileBitsSlots fuel bits segment target).filterMap id + +/-- Canonically serialize the instruction stream obtained by fixed-address +queries over encoded formula bits. -/ +def barringtonCompileBitsCode (fuel : ℕ) (bits : List Bool) + (segment : FormulaCode.TokenSegment) (target : Equiv.Perm (Fin 5)) : + List Bool := + BPCode.Program.encode + (barringtonCompileBitsProgram fuel bits segment target) + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonBitSerializer/Internal.lean b/Complexitylib/Circuits/BarringtonBitSerializer/Internal.lean new file mode 100644 index 00000000..84058ce6 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonBitSerializer/Internal.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonBitQuery +import Complexitylib.Circuits.BarringtonBitSerializer.Defs +import Complexitylib.Circuits.BarringtonSlots + +/-! +# Fixed-slot Barrington serialization over encoded formula bits -- internals +-/ + +namespace Complexity + +theorem barringtonCompileBitsSlots_correct_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + barringtonCompileBitsSlots fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target = + barringtonCompileSlots fuel formula target := by + apply List.ext_getElem + · simp [barringtonCompileBitsSlots, barringtonCompileSlots_length] + · intro slot hbits hslots + simp only [barringtonCompileBitsSlots, List.length_map, + List.length_range] at hbits + simp only [barringtonCompileBitsSlots] + rw [List.getElem_map] + simp only [List.getElem_range] + rw [barringtonCompileBitsSlot?_eq_instruction?] + simp [BPSlots.instruction?, List.getElem?_eq_getElem hslots] + +theorem barringtonCompileBitsProgram_correct_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + barringtonCompileBitsProgram fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target = + barringtonCompile formula target := by + rw [barringtonCompileBitsProgram, + barringtonCompileBitsSlots_correct_internal, + barringtonCompileSlots_filterMap fuel formula target hdepth] + +theorem barringtonCompileBitsProgram_length_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + (barringtonCompileBitsProgram fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target).length = + barringtonInstructionCount formula := by + rw [barringtonCompileBitsProgram, + barringtonCompileBitsSlots_correct_internal] + exact barringtonCompileSlots_occupiedCount fuel formula target hdepth + +theorem barringtonCompileBitsCode_correct_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + barringtonCompileBitsCode fuel (FormulaCode.encode formula) + ⟨0, formula.size⟩ target = + BPCode.Program.encode (barringtonCompile formula target) := by + rw [barringtonCompileBitsCode, + barringtonCompileBitsProgram_correct_internal fuel formula target hdepth] + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonBridge.lean b/Complexitylib/Circuits/BarringtonBridge.lean index 2c934db7..d1b82e0f 100644 --- a/Complexitylib/Circuits/BarringtonBridge.lean +++ b/Complexitylib/Circuits/BarringtonBridge.lean @@ -22,7 +22,9 @@ actually consumes — where the *target* representing cycle is an arbitrary - `Complexity.BP.Computes_retarget` — a program representing `f` through one `5`-cycle can be rebuilt to represent `f` through *any* chosen `5`-cycle - (`5`-cycles are conjugate, and conjugation is `BP.Computes_conj`). + (`5`-cycles are conjugate, and pointwise conjugation preserves length). +- `Complexity.BP.Computes_retarget_length` — the retargeted program has exactly + the original length. - `Complexity.BP.Computes_and5` — given subprograms representing `f` and `g` through `5`-cycles, `f ∧ g` is representable through *any* target `5`-cycle. This is Barrington's `AND` gate with full target-cycle freedom, the exact shape @@ -42,8 +44,9 @@ private theorem cycleType5 {g : Perm (Fin 5)} (hc : g.IsCycle) (ho : orderOf g = /-- **Retargeting.** If `p` represents `f` through a `5`-cycle `σ`, then for any `5`-cycle `a` there is a program representing `f` through `a`. (The two - `5`-cycles are conjugate — `isConj_iff_cycleType_eq` — and conjugation of the - representing permutation is `BP.Computes_conj`.) -/ + `5`-cycles are conjugate — `isConj_iff_cycleType_eq` — and pointwise + conjugation changes the representing permutation without adding + instructions.) -/ theorem BP.Computes_retarget {p : BP 5} {f : (ℕ → Bool) → Bool} {σ : Perm (Fin 5)} (hp : BP.Computes σ p f) (hσc : σ.IsCycle) (hσo : orderOf σ = 5) {a : Perm (Fin 5)} (hac : a.IsCycle) (hao : orderOf a = 5) : @@ -51,10 +54,24 @@ theorem BP.Computes_retarget {p : BP 5} {f : (ℕ → Bool) → Bool} {σ : Perm have hconj : IsConj σ a := Equiv.Perm.isConj_iff_cycleType_eq.mpr (by rw [cycleType5 hσc hσo, cycleType5 hac hao]) obtain ⟨τ, hτ⟩ := isConj_iff.mp hconj - have h := BP.Computes_conj hp τ + have h := BP.Computes_conjugate hp τ rw [hτ] at h exact ⟨_, h⟩ +/-- **Exact-length retargeting.** Retargeting between `5`-cycles by pointwise +conjugation preserves program length exactly. -/ +theorem BP.Computes_retarget_length {p : BP 5} + {f : (ℕ → Bool) → Bool} {σ : Perm (Fin 5)} + (hp : BP.Computes σ p f) (hσc : σ.IsCycle) (hσo : orderOf σ = 5) + {a : Perm (Fin 5)} (hac : a.IsCycle) (hao : orderOf a = 5) : + ∃ r : BP 5, BP.Computes a r f ∧ r.length = p.length := by + have hconj : IsConj σ a := Equiv.Perm.isConj_iff_cycleType_eq.mpr + (by rw [cycleType5 hσc hσo, cycleType5 hac hao]) + obtain ⟨τ, hτ⟩ := isConj_iff.mp hconj + have h := BP.Computes_conjugate hp τ + rw [hτ] at h + exact ⟨BP.conjugate τ p, h, BP.length_conjugate τ p⟩ + /-- **Barrington's `AND` gate, with target-cycle freedom.** Given subprograms representing `f` and `g` each through some `5`-cycle, and any chosen target `5`-cycle `c`, there is a program representing `f ∧ g` through `c`. diff --git a/Complexitylib/Circuits/BarringtonCodeGenerator.lean b/Complexitylib/Circuits/BarringtonCodeGenerator.lean new file mode 100644 index 00000000..f4c08ce6 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonCodeGenerator.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCodeGenerator.Defs +import Complexitylib.Circuits.BarringtonCodeGenerator.Internal + +/-! +# Bitstring-level Barrington code generator + +`barringtonCompileCode` is the exact extensional reference used by the remaining +uniformity proof. On a canonical postfix formula code it emits the canonical +code of `barringtonCompile formula barringtonTargetBase`; malformed inputs map +to the empty string. + +This module proves the complete extensional specification independently of a +machine implementation: output decoding recovers the executable program, its +evaluation matches the source formula, and its instruction count is at most +`4 ^ depth`. The unbounded function is not itself expected to lie in `FL`, since +arbitrary linear-depth inputs have exponentially long outputs. The next layer +must build a total `FL` generator that agrees with it along a promised +logarithmic-depth family. + +## Main results + +- `barringtonCompileCode_encode` -- exact generated bits. +- `decode?_barringtonCompileCode_encode` -- generated-code round trip. +- `length_barringtonCompileCode_encode_le` -- serialized output-size bound. +- `barringtonCompileCode_spec` -- decoded semantics and Barrington length bound. +-/ + +namespace Complexity + +/-- The executable compiler reads no formula-external variable: any uniform +bound on the source formula's variable indices bounds every emitted +instruction. Constant instructions use variable zero. -/ +theorem barringtonCompile_var_bound + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (bound : ℕ) + (hvars : ∀ index ∈ formula.vars, index ≤ bound) : + ∀ instruction ∈ barringtonCompile formula target, + instruction.var ≤ bound := + barringtonCompile_var_bound_internal formula target bound hvars + +/-- Every variable referenced by a formula is at most its canonical code +length. -/ +theorem formula_variable_le_code_length + (formula : BoolFormula) (index : ℕ) (hindex : index ∈ formula.vars) : + index ≤ (FormulaCode.encode formula).length := + formula_variable_le_code_length_internal formula index hindex + +/-- On canonical formula input, the generator emits exactly the canonical +encoding of the executable Barrington compiler's result. -/ +@[simp] theorem barringtonCompileCode_encode (formula : BoolFormula) : + barringtonCompileCode (FormulaCode.encode formula) = + BPCode.Program.encode + (barringtonCompile formula barringtonTargetBase) := + barringtonCompileCode_encode_internal formula + +/-- Decoding generated code recovers the executable compiler's program. -/ +theorem decode?_barringtonCompileCode_encode + (formula : BoolFormula) : + BPCode.Program.decode? + (barringtonCompileCode (FormulaCode.encode formula)) = + some (barringtonCompile formula barringtonTargetBase) := + decode?_barringtonCompileCode_encode_internal formula + +/-- Exact generated-code length on canonical formula input. -/ +theorem length_barringtonCompileCode_encode + (formula : BoolFormula) : + (barringtonCompileCode (FormulaCode.encode formula)).length = + (barringtonCompile formula barringtonTargetBase).length + 1 + + (((barringtonCompile formula barringtonTargetBase).map + fun instruction => instruction.var + 15).sum) := + length_barringtonCompileCode_encode_internal formula + +/-- Serialized generated output is bounded by the Barrington instruction bound +times the source-code length needed for each terminated-unary variable field. -/ +theorem length_barringtonCompileCode_encode_le + (formula : BoolFormula) : + (barringtonCompileCode (FormulaCode.encode formula)).length ≤ + 4 ^ formula.depth + 1 + + 4 ^ formula.depth * ((FormulaCode.encode formula).length + 15) := + length_barringtonCompileCode_encode_le_internal formula + +/-- **Bitstring-level constructive Barrington theorem.** Generated code decodes +to a program with exact formula semantics through the fixed nonidentity target +cycle and instruction count at most `4 ^ depth`. -/ +theorem barringtonCompileCode_spec (formula : BoolFormula) : + barringtonTargetBase ≠ 1 ∧ + (∀ assignment, + BP.eval assignment + (barringtonCompile formula barringtonTargetBase) = + if BoolFormula.eval assignment formula then + barringtonTargetBase else 1) ∧ + (barringtonCompile formula barringtonTargetBase).length ≤ + 4 ^ formula.depth ∧ + BPCode.Program.decode? + (barringtonCompileCode (FormulaCode.encode formula)) = + some (barringtonCompile formula barringtonTargetBase) := + barringtonCompileCode_spec_internal formula + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonCodeGenerator/Defs.lean b/Complexitylib/Circuits/BarringtonCodeGenerator/Defs.lean new file mode 100644 index 00000000..a0ae35f7 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonCodeGenerator/Defs.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCompiler.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Defs +import Complexitylib.Circuits.FormulaEncoding.Defs + +/-! +# Pure bitstring reference for uniform Barrington generation + +This file fixes the extensional reference function for compiling formula codes. +It decodes a canonical postfix Boolean formula, runs the executable Barrington +compiler at the fixed target `5`-cycle, and serializes the resulting width-`5` +program. Malformed formula codes map to the empty string; valid program codes +are always nonempty because they start with an instruction-count field. + +This unbounded function is deliberately **not** claimed to lie in `FL`: on an +arbitrary depth-`m` formula its output may have `4^m` instructions. A uniform +Barrington theorem instead needs a total log-space generator that agrees with +this reference along a promised logarithmic-depth family and remains bounded +on all other inputs. +-/ + +namespace Complexity + +/-- Decode a formula code and emit the canonical code of its compiled +width-`5` Barrington program. Malformed inputs produce the empty string. -/ +def barringtonCompileCode (bits : List Bool) : List Bool := + match FormulaCode.decode? bits with + | none => [] + | some formula => + BPCode.Program.encode + (barringtonCompile formula barringtonTargetBase) + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonCodeGenerator/Internal.lean b/Complexitylib/Circuits/BarringtonCodeGenerator/Internal.lean new file mode 100644 index 00000000..1026551f --- /dev/null +++ b/Complexitylib/Circuits/BarringtonCodeGenerator/Internal.lean @@ -0,0 +1,221 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCodeGenerator.Defs +import Complexitylib.Circuits.BarringtonCompiler +import Complexitylib.Circuits.BranchingProgramEncoding +import Complexitylib.Circuits.FormulaEncoding + +/-! +# Pure Barrington code-generator internals +-/ + +namespace Complexity + +private theorem BP.forall_var_inverse_internal {w bound : ℕ} + (program : BP w) + (hvars : ∀ instruction ∈ program, instruction.var ≤ bound) : + ∀ instruction ∈ BP.inverse program, instruction.var ≤ bound := by + intro instruction hinstruction + simp only [BP.inverse, List.mem_reverse, List.mem_map] at hinstruction + obtain ⟨source, hsource, rfl⟩ := hinstruction + exact hvars source hsource + +private theorem BP.forall_var_postMul_internal {w bound : ℕ} + (program : BP w) (permutation : Equiv.Perm (Fin w)) + (hvars : ∀ instruction ∈ program, instruction.var ≤ bound) : + ∀ instruction ∈ BP.postMul program permutation, + instruction.var ≤ bound := by + induction program using List.reverseRecOn with + | nil => + intro instruction hinstruction + simp [BP.postMul, BPInstr.const] at hinstruction + subst instruction + exact Nat.zero_le bound + | append_singleton program last ih => + intro instruction hinstruction + have hnonempty : program ++ [last] ≠ [] := by simp + simp only [BP.postMul, if_neg hnonempty, + List.modifyLast_concat, List.mem_append, + List.mem_singleton] at hinstruction + rcases hinstruction with hprefix | rfl + · exact hvars instruction (List.mem_append_left _ hprefix) + · exact hvars last (by simp) + +private theorem BP.forall_var_commutatorProgram_internal + {bound : ℕ} (left right : BP 5) + (hleft : ∀ instruction ∈ left, instruction.var ≤ bound) + (hright : ∀ instruction ∈ right, instruction.var ≤ bound) : + ∀ instruction ∈ BP.commutatorProgram left right, + instruction.var ≤ bound := by + have hleftInverse := BP.forall_var_inverse_internal left hleft + have hrightInverse := BP.forall_var_inverse_internal right hright + intro instruction hinstruction + simp only [BP.commutatorProgram, List.mem_append] at hinstruction + rcases hinstruction with hinstruction | hinstruction + · rcases hinstruction with hinstruction | hinstruction + · rcases hinstruction with hinstruction | hinstruction + · exact hleft instruction hinstruction + · exact hright instruction hinstruction + · exact hleftInverse instruction hinstruction + · exact hrightInverse instruction hinstruction + +/-- Internal variable-locality theorem for the executable compiler. -/ +theorem barringtonCompile_var_bound_internal + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (bound : ℕ) + (hvars : ∀ index ∈ formula.vars, index ≤ bound) : + ∀ instruction ∈ barringtonCompile formula target, + instruction.var ≤ bound := by + induction formula generalizing target with + | var index => + intro instruction hinstruction + simp only [barringtonCompile, List.mem_singleton] at hinstruction + subst instruction + exact hvars index (by simp [BoolFormula.vars]) + | tru => + intro instruction hinstruction + simp [barringtonCompile, BPInstr.const] at hinstruction + subst instruction + exact Nat.zero_le bound + | fls => simp [barringtonCompile] + | neg formula ih => + exact BP.forall_var_postMul_internal _ _ + (ih target⁻¹ (by simpa only [BoolFormula.vars] using hvars)) + | conj left right ihLeft ihRight => + apply BP.forall_var_commutatorProgram_internal + · apply ihLeft + intro index hindex + exact hvars index (Finset.mem_union_left _ hindex) + · apply ihRight + intro index hindex + exact hvars index (Finset.mem_union_right _ hindex) + | disj left right ihLeft ihRight => + simp only [barringtonCompile] + apply BP.forall_var_postMul_internal + apply BP.forall_var_commutatorProgram_internal + · apply BP.forall_var_postMul_internal + apply ihLeft + intro index hindex + exact hvars index (Finset.mem_union_left _ hindex) + · apply BP.forall_var_postMul_internal + apply ihRight + intro index hindex + exact hvars index (Finset.mem_union_right _ hindex) + +/-- Internal bound placing every referenced variable below the formula-code +length. -/ +theorem formula_variable_le_code_length_internal + (formula : BoolFormula) (index : ℕ) (hindex : index ∈ formula.vars) : + index ≤ (FormulaCode.encode formula).length := by + induction formula with + | var sourceIndex => + simp only [BoolFormula.vars, Finset.mem_singleton] at hindex + subst index + simp [FormulaCode.length_encode, FormulaCode.tokens, + FormulaCode.Token.codeLength, BoolFormula.size] + omega + | tru => simp [BoolFormula.vars] at hindex + | fls => simp [BoolFormula.vars] at hindex + | neg formula ih => + have hsub : index ≤ (FormulaCode.encode formula).length := + ih (by simpa only [BoolFormula.vars] using hindex) + apply hsub.trans + simp [FormulaCode.length_encode, FormulaCode.tokens, + FormulaCode.Token.codeLength, BoolFormula.size] + omega + | conj left right ihLeft ihRight => + simp only [BoolFormula.vars, Finset.mem_union] at hindex + rcases hindex with hleft | hright + · apply (ihLeft hleft).trans + simp [FormulaCode.length_encode, FormulaCode.tokens, + FormulaCode.Token.codeLength, BoolFormula.size] + omega + · apply (ihRight hright).trans + simp [FormulaCode.length_encode, FormulaCode.tokens, + FormulaCode.Token.codeLength, BoolFormula.size] + omega + | disj left right ihLeft ihRight => + simp only [BoolFormula.vars, Finset.mem_union] at hindex + rcases hindex with hleft | hright + · apply (ihLeft hleft).trans + simp [FormulaCode.length_encode, FormulaCode.tokens, + FormulaCode.Token.codeLength, BoolFormula.size] + omega + · apply (ihRight hright).trans + simp [FormulaCode.length_encode, FormulaCode.tokens, + FormulaCode.Token.codeLength, BoolFormula.size] + omega + +/-- Internal exact action of the code generator on a canonical formula code. -/ +theorem barringtonCompileCode_encode_internal (formula : BoolFormula) : + barringtonCompileCode (FormulaCode.encode formula) = + BPCode.Program.encode + (barringtonCompile formula barringtonTargetBase) := by + simp [barringtonCompileCode] + +/-- Internal decoding theorem for generated program code. -/ +theorem decode?_barringtonCompileCode_encode_internal + (formula : BoolFormula) : + BPCode.Program.decode? + (barringtonCompileCode (FormulaCode.encode formula)) = + some (barringtonCompile formula barringtonTargetBase) := by + rw [barringtonCompileCode_encode_internal] + exact BPCode.Program.decode?_encode _ + +/-- Internal exact output-code length on canonical formula input. -/ +theorem length_barringtonCompileCode_encode_internal + (formula : BoolFormula) : + (barringtonCompileCode (FormulaCode.encode formula)).length = + (barringtonCompile formula barringtonTargetBase).length + 1 + + (((barringtonCompile formula barringtonTargetBase).map + fun instruction => instruction.var + 15).sum) := by + rw [barringtonCompileCode_encode_internal] + exact BPCode.Program.length_encode _ + +/-- Internal serialized-output bound in terms of formula-code length and depth. +The extra factor comes from the terminated-unary variable field in each +instruction. -/ +theorem length_barringtonCompileCode_encode_le_internal + (formula : BoolFormula) : + (barringtonCompileCode (FormulaCode.encode formula)).length ≤ + 4 ^ formula.depth + 1 + + 4 ^ formula.depth * ((FormulaCode.encode formula).length + 15) := by + let program := barringtonCompile formula barringtonTargetBase + have hvariables : + ∀ instruction ∈ program, + instruction.var ≤ (FormulaCode.encode formula).length := by + apply barringtonCompile_var_bound_internal + intro index hindex + exact formula_variable_le_code_length_internal formula index hindex + have hprogram := + BPCode.Program.length_encode_le program + (FormulaCode.encode formula).length hvariables + have hlength : program.length ≤ 4 ^ formula.depth := + barringtonCompile_length_le formula barringtonTargetBase + have hscaled := Nat.mul_le_mul_right + ((FormulaCode.encode formula).length + 15) hlength + rw [barringtonCompileCode_encode_internal] + exact hprogram.trans (by omega) + +/-- Internal combined semantic and program-length specification of generated +code on canonical formula input. -/ +theorem barringtonCompileCode_spec_internal (formula : BoolFormula) : + barringtonTargetBase ≠ 1 ∧ + (∀ assignment, + BP.eval assignment + (barringtonCompile formula barringtonTargetBase) = + if BoolFormula.eval assignment formula then + barringtonTargetBase else 1) ∧ + (barringtonCompile formula barringtonTargetBase).length ≤ + 4 ^ formula.depth ∧ + BPCode.Program.decode? + (barringtonCompileCode (FormulaCode.encode formula)) = + some (barringtonCompile formula barringtonTargetBase) := by + obtain ⟨htarget, hsemantics, hlength⟩ := + barringtonCompile_representation formula + exact ⟨htarget, hsemantics, hlength, + decode?_barringtonCompileCode_encode_internal formula⟩ + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonCompiler.lean b/Complexitylib/Circuits/BarringtonCompiler.lean new file mode 100644 index 00000000..f642d921 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonCompiler.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCompiler.Defs +import Complexitylib.Circuits.BarringtonCompiler.Internal + +/-! +# An executable Barrington compiler + +This module turns the finite Barrington theorem into an explicit recursive +compiler. Earlier existence proofs selected `S₅` conjugators in `Prop`; here, +`allPermutationsFin` gives a computable enumeration and `firstConjugator5` +performs a deterministic finite search. The resulting `barringtonCompile` +contains no choice operation. + +For every Boolean formula and target `5`-cycle, the compiler returns a width-`5` +permutation branching program with exact representation semantics and the +textbook length bound `4 ^ depth`. The remaining work for a fully uniform +Barrington theorem is therefore serialization and a resource-bounded generator +proof, not extraction of program data from an existential theorem. + +## Main results + +- `Complexity.firstConjugator5_spec` -- correctness of finite conjugator search. +- `Complexity.barrington_commutator` -- the searched factors decompose every + target `5`-cycle. +- `Complexity.barringtonCompile_computes` -- exact compiler semantics. +- `Complexity.barringtonCompile_length_le` -- length at most `4 ^ depth`. +- `Complexity.barringtonCompile_representation` -- constructive finite + Barrington theorem for the fixed canonical target cycle. +-/ + +open scoped commutatorElement +open Equiv + +namespace Complexity + +/-- `allPermutationsFin n` contains every permutation of `Fin n`. -/ +theorem mem_allPermutationsFin {n : ℕ} (permutation : Perm (Fin n)) : + permutation ∈ allPermutationsFin n := + mem_allPermutationsFin_internal permutation + +/-- If two permutations are conjugate, the executable finite search returns a +valid conjugator. -/ +theorem firstConjugator5_spec + (source target : Perm (Fin 5)) + (hexists : ∃ g, g * source * g⁻¹ = target) : + firstConjugator5 source target * source * + (firstConjugator5 source target)⁻¹ = target := + firstConjugator5_spec_internal source target hexists + +/-- The fixed left base permutation is a `5`-cycle. -/ +theorem barringtonLeftBase_spec : + barringtonLeftBase.IsCycle ∧ orderOf barringtonLeftBase = 5 := + barringtonLeftBase_spec_internal + +/-- The fixed right base permutation is a `5`-cycle. -/ +theorem barringtonRightBase_spec : + barringtonRightBase.IsCycle ∧ orderOf barringtonRightBase = 5 := + barringtonRightBase_spec_internal + +/-- The fixed commutator target is a `5`-cycle. -/ +theorem barringtonTargetBase_spec : + barringtonTargetBase.IsCycle ∧ orderOf barringtonTargetBase = 5 := + barringtonTargetBase_spec_internal + +/-- The canonical target moves point zero, so every compiled family can use a +single fixed decision point. -/ +theorem barringtonTargetBase_moves_zero : + barringtonTargetBase (0 : Fin 5) ≠ 0 := + barringtonTargetBase_moves_zero_internal + +/-- The canonical left factor is a `5`-cycle for every target value. -/ +theorem barringtonLeft_spec (target : Perm (Fin 5)) : + (barringtonLeft target).IsCycle ∧ + orderOf (barringtonLeft target) = 5 := + barringtonLeft_spec_internal target + +/-- The canonical right factor is a `5`-cycle for every target value. -/ +theorem barringtonRight_spec (target : Perm (Fin 5)) : + (barringtonRight target).IsCycle ∧ + orderOf (barringtonRight target) = 5 := + barringtonRight_spec_internal target + +/-- The executable factors have commutator equal to any target `5`-cycle. -/ +theorem barrington_commutator + (target : Perm (Fin 5)) (hcycle : target.IsCycle) + (horder : orderOf target = 5) : + ⁅barringtonLeft target, barringtonRight target⁆ = target := + barrington_commutator_internal target hcycle horder + +namespace BP + +/-- The four-block commutator program has exactly twice the sum of the source +lengths. -/ +theorem length_commutatorProgram {w : ℕ} (p q : BP w) : + (BP.commutatorProgram p q).length = + 2 * p.length + 2 * q.length := + BP.length_commutatorProgram_internal p q + +end BP + +/-- The executable compiler represents a formula through any target `5`-cycle. +-/ +theorem barringtonCompile_computes (formula : BoolFormula) + (target : Perm (Fin 5)) (hcycle : target.IsCycle) + (horder : orderOf target = 5) : + BP.Computes target (barringtonCompile formula target) + (fun assignment => BoolFormula.eval assignment formula) := + barringtonCompile_computes_internal formula target hcycle horder + +/-- The executable compiler satisfies the textbook `4 ^ depth` length bound. -/ +theorem barringtonCompile_length_le + (formula : BoolFormula) (target : Perm (Fin 5)) : + (barringtonCompile formula target).length ≤ 4 ^ formula.depth := + barringtonCompile_length_le_internal formula target + +/-- The canonical target cycle is nonidentity. -/ +theorem barringtonTargetBase_ne_one : barringtonTargetBase ≠ 1 := by + intro heq + have horder := barringtonTargetBase_spec.2 + rw [heq] at horder + simp at horder + +/-- **Constructive finite Barrington theorem.** The explicit compiled program +evaluates to one fixed nonidentity `5`-cycle exactly when the formula is true, +and its length is at most `4 ^ depth`. -/ +theorem barringtonCompile_representation (formula : BoolFormula) : + barringtonTargetBase ≠ 1 ∧ + (∀ assignment, + BP.eval assignment + (barringtonCompile formula barringtonTargetBase) = + if BoolFormula.eval assignment formula then + barringtonTargetBase else 1) ∧ + (barringtonCompile formula barringtonTargetBase).length ≤ + 4 ^ formula.depth := + ⟨barringtonTargetBase_ne_one, + barringtonCompile_computes formula barringtonTargetBase + barringtonTargetBase_spec.1 barringtonTargetBase_spec.2, + barringtonCompile_length_le formula barringtonTargetBase⟩ + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonCompiler/Defs.lean b/Complexitylib/Circuits/BarringtonCompiler/Defs.lean new file mode 100644 index 00000000..b9ca411b --- /dev/null +++ b/Complexitylib/Circuits/BarringtonCompiler/Defs.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.Barrington +import Complexitylib.Circuits.BarringtonS5 +import Complexitylib.Circuits.Formula + +/-! +# An executable Barrington compiler -- definitions + +The original existence proof chooses conjugators and commutator factors inside +`Prop`. This module instead searches the finite group `S₅` explicitly, making +the target-cycle decomposition and the resulting formula compiler executable. +-/ + +open scoped commutatorElement +open Equiv + +namespace Complexity + +/-- A computable enumeration of every permutation of `Fin n`, obtained from +the recursive decomposition `S_(n+1) ≃ Fin (n+1) × S_n`. -/ +def allPermutationsFin : (n : ℕ) → List (Perm (Fin n)) + | 0 => [1] + | n + 1 => + (List.finRange (n + 1)).flatMap fun imageZero => + (allPermutationsFin n).map fun tail => + Equiv.Perm.decomposeFin.symm (imageZero, tail) + +/-- Test whether `g` conjugates `source` to `target`. -/ +def isConjugator5 (source target g : Perm (Fin 5)) : Bool := + decide (g * source * g⁻¹ = target) + +/-- The first conjugator in the canonical finite enumeration of `S₅`, or the +identity if no conjugator exists. -/ +def firstConjugator5 (source target : Perm (Fin 5)) : Perm (Fin 5) := + ((allPermutationsFin 5).find? (isConjugator5 source target)).getD 1 + +/-- The first fixed `5`-cycle in the explicit Barrington commutator. -/ +def barringtonLeftBase : Perm (Fin 5) := + finRotate 5 + +/-- The second fixed `5`-cycle in the explicit Barrington commutator. -/ +def barringtonRightBase : Perm (Fin 5) := + ([0, 2, 4, 3, 1] : List (Fin 5)).formPerm + +/-- The fixed target cycle obtained as the commutator of the two base cycles. -/ +def barringtonTargetBase : Perm (Fin 5) := + ⁅barringtonLeftBase, barringtonRightBase⁆ + +/-- Canonically search for a permutation conjugating the fixed target cycle to +`target`. -/ +def barringtonConjugator (target : Perm (Fin 5)) : Perm (Fin 5) := + firstConjugator5 barringtonTargetBase target + +/-- The left factor in the canonical commutator decomposition of `target`. -/ +def barringtonLeft (target : Perm (Fin 5)) : Perm (Fin 5) := + barringtonConjugator target * barringtonLeftBase * + (barringtonConjugator target)⁻¹ + +/-- The right factor in the canonical commutator decomposition of `target`. -/ +def barringtonRight (target : Perm (Fin 5)) : Perm (Fin 5) := + barringtonConjugator target * barringtonRightBase * + (barringtonConjugator target)⁻¹ + +namespace BP + +/-- The four-block program commutator `p q p⁻¹ q⁻¹`. -/ +def commutatorProgram {w : ℕ} (p q : BP w) : BP w := + p ++ q ++ BP.inverse p ++ BP.inverse q + +end BP + +/-- Compile a Boolean formula to a width-`5` permutation branching program +representing it through `target`. + +The definition is total for every target permutation. Its correctness theorem +assumes that `target` is a `5`-cycle. Binary gates use the executable canonical +commutator decomposition above; no choice from an existential proof remains. -/ +def barringtonCompile : BoolFormula → Perm (Fin 5) → BP 5 + | .var i, target => [⟨i, 1, target⟩] + | .tru, target => [BPInstr.const target] + | .fls, _ => [] + | .neg formula, target => + BP.postMul (barringtonCompile formula target⁻¹) target + | .conj left right, target => + BP.commutatorProgram + (barringtonCompile left (barringtonLeft target)) + (barringtonCompile right (barringtonRight target)) + | .disj left right, target => + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftProgram := BP.postMul + (barringtonCompile left leftTarget⁻¹) leftTarget + let rightProgram := BP.postMul + (barringtonCompile right rightTarget⁻¹) rightTarget + BP.postMul (BP.commutatorProgram leftProgram rightProgram) target + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonCompiler/Internal.lean b/Complexitylib/Circuits/BarringtonCompiler/Internal.lean new file mode 100644 index 00000000..12884929 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonCompiler/Internal.lean @@ -0,0 +1,289 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCompiler.Defs +import Complexitylib.Circuits.BarringtonLength + +/-! +# An executable Barrington compiler -- proof internals +-/ + +open scoped commutatorElement +open Equiv + +set_option maxRecDepth 100000 + +namespace Complexity + +theorem mem_allPermutationsFin_internal {n : ℕ} (permutation : Perm (Fin n)) : + permutation ∈ allPermutationsFin n := by + induction n with + | zero => + have hpermutation : permutation = 1 := Subsingleton.elim _ _ + simp [allPermutationsFin, hpermutation] + | succ n ih => + simp only [allPermutationsFin, List.mem_flatMap, List.mem_map] + refine ⟨(Equiv.Perm.decomposeFin permutation).1, by simp, + (Equiv.Perm.decomposeFin permutation).2, ih _, ?_⟩ + simp + +theorem firstConjugator5_spec_internal + (source target : Perm (Fin 5)) + (hexists : ∃ g, g * source * g⁻¹ = target) : + firstConjugator5 source target * source * + (firstConjugator5 source target)⁻¹ = target := by + unfold firstConjugator5 + generalize hfind : + (allPermutationsFin 5).find? (isConjugator5 source target) = found + cases found with + | none => + exfalso + obtain ⟨g, hg⟩ := hexists + have hsome : + ((allPermutationsFin 5).find? + (isConjugator5 source target)).isSome := + List.find?_isSome.mpr ⟨g, mem_allPermutationsFin_internal g, by + simp [isConjugator5, hg]⟩ + simp [hfind] at hsome + | some g => + simp only [Option.getD_some] + have hg := List.find?_some hfind + simpa only [isConjugator5, decide_eq_true_eq] using hg + +theorem barringtonLeftBase_spec_internal : + barringtonLeftBase.IsCycle ∧ orderOf barringtonLeftBase = 5 := by + apply isCycle_orderOf_five_of_pow + · decide + · decide + +theorem barringtonRightBase_spec_internal : + barringtonRightBase.IsCycle ∧ orderOf barringtonRightBase = 5 := by + apply isCycle_orderOf_five_of_pow + · decide + · decide + +theorem barringtonTargetBase_spec_internal : + barringtonTargetBase.IsCycle ∧ orderOf barringtonTargetBase = 5 := by + apply isCycle_orderOf_five_of_pow + · decide + · decide + +/-- Internal check that the canonical target moves the fixed query point zero. -/ +theorem barringtonTargetBase_moves_zero_internal : + barringtonTargetBase (0 : Fin 5) ≠ 0 := by + decide + +private theorem cycleType_five {cycle : Perm (Fin 5)} + (hcycle : cycle.IsCycle) (horder : orderOf cycle = 5) : + cycle.cycleType = {5} := by + have hsupport : cycle.support.card = 5 := by + rw [← hcycle.orderOf] + exact horder + rw [hcycle.cycleType, hsupport] + +theorem barringtonConjugator_spec_internal + (target : Perm (Fin 5)) (hcycle : target.IsCycle) + (horder : orderOf target = 5) : + barringtonConjugator target * barringtonTargetBase * + (barringtonConjugator target)⁻¹ = target := by + have hbase := barringtonTargetBase_spec_internal + have hconj : IsConj barringtonTargetBase target := + Equiv.Perm.isConj_iff_cycleType_eq.mpr + (by rw [cycleType_five hbase.1 hbase.2, + cycleType_five hcycle horder]) + obtain ⟨g, hg⟩ := isConj_iff.mp hconj + exact firstConjugator5_spec_internal barringtonTargetBase target ⟨g, hg⟩ + +theorem barringtonLeft_spec_internal + (target : Perm (Fin 5)) : + (barringtonLeft target).IsCycle ∧ + orderOf (barringtonLeft target) = 5 := by + simpa only [barringtonLeft] using + conj_isCycle_orderOf_five barringtonLeftBase_spec_internal + (barringtonConjugator target) + +theorem barringtonRight_spec_internal + (target : Perm (Fin 5)) : + (barringtonRight target).IsCycle ∧ + orderOf (barringtonRight target) = 5 := by + simpa only [barringtonRight] using + conj_isCycle_orderOf_five barringtonRightBase_spec_internal + (barringtonConjugator target) + +theorem barrington_commutator_internal + (target : Perm (Fin 5)) (hcycle : target.IsCycle) + (horder : orderOf target = 5) : + ⁅barringtonLeft target, barringtonRight target⁆ = target := by + calc + ⁅barringtonLeft target, barringtonRight target⁆ = + barringtonConjugator target * barringtonTargetBase * + (barringtonConjugator target)⁻¹ := by + simp only [barringtonLeft, barringtonRight, barringtonTargetBase, + commutatorElement_def] + group + _ = target := barringtonConjugator_spec_internal target hcycle horder + +theorem BP.length_commutatorProgram_internal {w : ℕ} (p q : BP w) : + (BP.commutatorProgram p q).length = + 2 * p.length + 2 * q.length := by + simp only [BP.commutatorProgram, List.length_append, BP.length_inverse] + omega + +theorem barringtonCompile_computes_internal (formula : BoolFormula) : + ∀ (target : Perm (Fin 5)), target.IsCycle → orderOf target = 5 → + BP.Computes target (barringtonCompile formula target) + (fun assignment => BoolFormula.eval assignment formula) := by + induction formula with + | var i => + intro target hcycle horder + simpa only [barringtonCompile, BoolFormula.eval] using + BP.Computes_var target i + | tru => + intro target hcycle horder + simpa only [barringtonCompile, BoolFormula.eval] using + BP.Computes_true target + | fls => + intro target hcycle horder + simpa only [barringtonCompile, BoolFormula.eval] using + BP.Computes_false target + | neg formula ih => + intro target hcycle horder + have hinvCycle : target⁻¹.IsCycle := hcycle.inv + have hinvOrder : orderOf target⁻¹ = 5 := by + rw [orderOf_inv] + exact horder + have h := BP.Computes_not_compact + (ih target⁻¹ hinvCycle hinvOrder) + simpa only [barringtonCompile, BoolFormula.eval, inv_inv] using h + | conj left right ihleft ihright => + intro target hcycle horder + have hleftSpec := barringtonLeft_spec_internal target + have hrightSpec := barringtonRight_spec_internal target + have hleft := ihleft (barringtonLeft target) + hleftSpec.1 hleftSpec.2 + have hright := ihright (barringtonRight target) + hrightSpec.1 hrightSpec.2 + have h := BP.Computes_and hleft hright + rw [barrington_commutator_internal target hcycle horder] at h + simpa only [barringtonCompile, BP.commutatorProgram, + BoolFormula.eval] using h + | disj left right ihleft ihright => + intro target hcycle horder + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftProgram := BP.postMul + (barringtonCompile left leftTarget⁻¹) leftTarget + let rightProgram := BP.postMul + (barringtonCompile right rightTarget⁻¹) rightTarget + have hinnerCycle : innerTarget.IsCycle := hcycle.inv + have hinnerOrder : orderOf innerTarget = 5 := by + dsimp only [innerTarget] + rw [orderOf_inv] + exact horder + have hleftSpec := barringtonLeft_spec_internal innerTarget + have hrightSpec := barringtonRight_spec_internal innerTarget + have hleftInvCycle : leftTarget⁻¹.IsCycle := hleftSpec.1.inv + have hleftInvOrder : orderOf leftTarget⁻¹ = 5 := by + rw [orderOf_inv] + exact hleftSpec.2 + have hrightInvCycle : rightTarget⁻¹.IsCycle := hrightSpec.1.inv + have hrightInvOrder : orderOf rightTarget⁻¹ = 5 := by + rw [orderOf_inv] + exact hrightSpec.2 + have hleftBase := ihleft leftTarget⁻¹ + hleftInvCycle hleftInvOrder + have hrightBase := ihright rightTarget⁻¹ + hrightInvCycle hrightInvOrder + have hleft : BP.Computes leftTarget leftProgram + (fun assignment => !BoolFormula.eval assignment left) := by + simpa only [leftProgram, inv_inv] using + BP.Computes_not_compact hleftBase + have hright : BP.Computes rightTarget rightProgram + (fun assignment => !BoolFormula.eval assignment right) := by + simpa only [rightProgram, inv_inv] using + BP.Computes_not_compact hrightBase + have hinner := BP.Computes_and hleft hright + rw [barrington_commutator_internal innerTarget + hinnerCycle hinnerOrder] at hinner + have hfinal := BP.Computes_not_compact hinner + have hfun : + (fun assignment => + !((!BoolFormula.eval assignment left) && + (!BoolFormula.eval assignment right))) = + (fun assignment => + BoolFormula.eval assignment (.disj left right)) := by + funext assignment + simp [BoolFormula.eval, Bool.not_and, Bool.not_not] + rw [hfun] at hfinal + simpa only [barringtonCompile, innerTarget, leftTarget, rightTarget, + leftProgram, rightProgram, inv_inv] using hfinal + +theorem barringtonCompile_length_le_internal + (formula : BoolFormula) (target : Perm (Fin 5)) : + (barringtonCompile formula target).length ≤ 4 ^ formula.depth := by + induction formula generalizing target with + | var i => + simp [barringtonCompile, BoolFormula.depth] + | tru => + simp [barringtonCompile, BoolFormula.depth] + | fls => + simp [barringtonCompile, BoolFormula.depth] + | neg formula ih => + rw [barringtonCompile, BP.length_postMul] + apply le_trans (max_le (Nat.one_le_pow _ _ (by omega)) (ih target⁻¹)) + exact Nat.pow_le_pow_right (by omega) (by simp [BoolFormula.depth]) + | conj left right ihleft ihright => + rw [barringtonCompile, BP.length_commutatorProgram_internal] + have hleft : + (barringtonCompile left (barringtonLeft target)).length ≤ + 4 ^ max left.depth right.depth := + le_trans (ihleft (barringtonLeft target)) + (Nat.pow_le_pow_right (by omega) (le_max_left _ _)) + have hright : + (barringtonCompile right (barringtonRight target)).length ≤ + 4 ^ max left.depth right.depth := + le_trans (ihright (barringtonRight target)) + (Nat.pow_le_pow_right (by omega) (le_max_right _ _)) + simp only [BoolFormula.depth, Nat.pow_succ] + omega + | disj left right ihleft ihright => + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftProgram := BP.postMul + (barringtonCompile left leftTarget⁻¹) leftTarget + let rightProgram := BP.postMul + (barringtonCompile right rightTarget⁻¹) rightTarget + have hleft : leftProgram.length ≤ 4 ^ left.depth := by + dsimp only [leftProgram] + rw [BP.length_postMul] + exact max_le (Nat.one_le_pow _ _ (by omega)) + (ihleft leftTarget⁻¹) + have hright : rightProgram.length ≤ 4 ^ right.depth := by + dsimp only [rightProgram] + rw [BP.length_postMul] + exact max_le (Nat.one_le_pow _ _ (by omega)) + (ihright rightTarget⁻¹) + have hleftMax : leftProgram.length ≤ + 4 ^ max left.depth right.depth := + le_trans hleft + (Nat.pow_le_pow_right (by omega) (le_max_left _ _)) + have hrightMax : rightProgram.length ≤ + 4 ^ max left.depth right.depth := + le_trans hright + (Nat.pow_le_pow_right (by omega) (le_max_right _ _)) + have hcommutator : + (BP.commutatorProgram leftProgram rightProgram).length ≤ + 4 ^ (max left.depth right.depth + 1) := by + rw [BP.length_commutatorProgram_internal, Nat.pow_succ] + omega + change (BP.postMul + (BP.commutatorProgram leftProgram rightProgram) target).length ≤ + 4 ^ (max left.depth right.depth + 1) + rw [BP.length_postMul] + exact max_le (Nat.one_le_pow _ _ (by omega)) hcommutator + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonFamily.lean b/Complexitylib/Circuits/BarringtonFamily.lean index c64233d3..5147a22a 100644 --- a/Complexitylib/Circuits/BarringtonFamily.lean +++ b/Complexitylib/Circuits/BarringtonFamily.lean @@ -9,9 +9,10 @@ import Mathlib.Data.Nat.Log /-! # Barrington at the family level: `NC¹ ⊆` polynomial-size width-`5` branching programs -`Circuits/BarringtonLength.lean` proves the per-formula bound `barrington_representation_depth` -(a formula of depth `d` compiles to a width-`5` program of length `≤ 17^d`). This -module lifts that to *families*: a family of formulas of logarithmic depth +`Circuits/BarringtonLength.lean` proves the textbook per-formula bound +`barrington_representation_depth_four` (a formula of depth `d` compiles to a +width-`5` program of length `≤ 4^d`). This module lifts that to *families*: a +family of formulas of logarithmic depth (`NC¹`) is computed, formula by formula, by a family of width-`5` permutation branching programs of **polynomial** length. That is the class-level polynomial-size direction of Barrington's characterization, in the nonuniform (per-length) setting. @@ -19,7 +20,7 @@ direction of Barrington's characterization, in the nonuniform (per-length) setti The families here range over the same `ℕ → Bool` assignments the Barrington development already uses, so `FormulaFamily.logDepth_polyLength_bp` follows by applying the per-formula bound pointwise, together with the arithmetic fact that -`17^{c·log₂ n + c}` is bounded by a polynomial in `n`. +`4^{c·log₂ n + c}` is bounded by a polynomial in `n`. ## Main definitions and results @@ -32,24 +33,22 @@ open Equiv namespace Complexity -/-- `17^{c·log₂ n + c} ≤ 17^c · (n+1)^{5c}`: the construction length for a +/-- `4^{c·log₂ n + c} ≤ 4^c · (n+1)^{2c}`: the construction length for a depth-`(c·log₂ n + c)` formula is polynomial in `n`. -/ -private theorem pow17_poly (c n : ℕ) : - 17 ^ (c * Nat.log 2 n + c) ≤ 17 ^ c * (n + 1) ^ (5 * c) := by - have hlog : 17 ^ Nat.log 2 n ≤ (n + 1) ^ 5 := by +theorem pow4_poly (c n : ℕ) : + 4 ^ (c * Nat.log 2 n + c) ≤ 4 ^ c * (n + 1) ^ (2 * c) := by + have hlog : 4 ^ Nat.log 2 n ≤ (n + 1) ^ 2 := by rcases Nat.eq_zero_or_pos n with hn | hn · subst hn; simp - · calc 17 ^ Nat.log 2 n - ≤ 32 ^ Nat.log 2 n := Nat.pow_le_pow_left (by omega) _ - _ = (2 ^ Nat.log 2 n) ^ 5 := by - rw [show (32 : ℕ) = 2 ^ 5 from rfl, ← pow_mul, ← pow_mul, Nat.mul_comm] - _ ≤ n ^ 5 := Nat.pow_le_pow_left (Nat.pow_log_le_self 2 (by omega)) 5 - _ ≤ (n + 1) ^ 5 := Nat.pow_le_pow_left (by omega) 5 - calc 17 ^ (c * Nat.log 2 n + c) - = (17 ^ Nat.log 2 n) ^ c * 17 ^ c := by + · calc 4 ^ Nat.log 2 n + ≤ n ^ 2 := pow_four_log_le n (by omega) + _ ≤ (n + 1) ^ 2 := Nat.pow_le_pow_left (by omega) 2 + calc 4 ^ (c * Nat.log 2 n + c) + = (4 ^ Nat.log 2 n) ^ c * 4 ^ c := by rw [pow_add, mul_comm c (Nat.log 2 n), pow_mul] - _ ≤ ((n + 1) ^ 5) ^ c * 17 ^ c := Nat.mul_le_mul_right _ (Nat.pow_le_pow_left hlog c) - _ = 17 ^ c * (n + 1) ^ (5 * c) := by rw [← pow_mul]; ring + _ ≤ ((n + 1) ^ 2) ^ c * 4 ^ c := + Nat.mul_le_mul_right _ (Nat.pow_le_pow_left hlog c) + _ = 4 ^ c * (n + 1) ^ (2 * c) := by rw [← pow_mul]; ring /-- A family of Boolean formulas, one per input length. -/ def FormulaFamily := ℕ → BoolFormula @@ -70,11 +69,13 @@ theorem FormulaFamily.logDepth_polyLength_bp (F : FormulaFamily) (hF : F.LogDept (∀ n α, BP.eval α (R n) = if BoolFormula.eval α (F n) then S n else 1) ∧ (∀ n, (R n).length ≤ C * (n + 1) ^ p) := by obtain ⟨c, hc⟩ := hF - choose R S hS hev hlen using fun n => barrington_representation_depth (F n) - refine ⟨R, S, 17 ^ c, 5 * c, hS, hev, fun n => ?_⟩ - calc (R n).length ≤ 17 ^ (F n).depth := hlen n - _ ≤ 17 ^ (c * Nat.log 2 n + c) := Nat.pow_le_pow_right (by omega) (hc n) - _ ≤ 17 ^ c * (n + 1) ^ (5 * c) := pow17_poly c n + choose R S hS hev hlen using fun n => + barrington_representation_depth_four (F n) + refine ⟨R, S, 4 ^ c, 2 * c, hS, hev, fun n => ?_⟩ + calc (R n).length ≤ 4 ^ (F n).depth := hlen n + _ ≤ 4 ^ (c * Nat.log 2 n + c) := + Nat.pow_le_pow_right (by omega) (hc n) + _ ≤ 4 ^ c * (n + 1) ^ (2 * c) := pow4_poly c n /-- **Family-level Barrington, Boolean-decision form.** A logarithmic-depth formula family is *decided* by a family of polynomial-length width-`5` branching diff --git a/Complexitylib/Circuits/BarringtonLength.lean b/Complexitylib/Circuits/BarringtonLength.lean index 5bd97970..6dfd8df8 100644 --- a/Complexitylib/Circuits/BarringtonLength.lean +++ b/Complexitylib/Circuits/BarringtonLength.lean @@ -13,29 +13,28 @@ import Mathlib.Data.Nat.Log `Circuits/BarringtonRepr.lean` proves the *existence* of a width-`5` permutation branching program for every Boolean formula, but discards the program's length. -This module re-runs the same construction while tracking length, obtaining an -explicit bound: every formula of tree-size `s` is computed by a program of length -at most `13 ^ s`. - -The bound is honest but **not** the textbook `4 ^ depth` — that tighter constant -needs a smarter construction that avoids the constant conjugation overhead of the -retargeting step (`BP.Computes_retarget_len` adds `2` per re-aim, and the De -Morgan `disj` case adds a further constant). The `13 ^ size` bound here follows -directly from the recurrence of the present construction and already shows the -program is of size singly-exponential in the formula, polynomial in the number of -leaves at fixed depth — enough to place bounded-depth formulas in polynomial-size -width-`5` branching programs. +This module tracks both the original wrapper-based construction and the optimized +textbook construction. Pointwise conjugation retargets a program without changing +its length, while compact negation folds the final constant into the last +instruction. The resulting binary-gate recurrence is exactly fourfold and proves +the classical `4 ^ depth` bound. ## Main results - `Complexity.BP.length_inverse` — program inversion preserves length. - `Complexity.BP.Computes_retarget_len`, `Complexity.BP.Computes_and5_len` — - length-tracked versions of the bridge moves. + compatibility bounds for the original wrapper construction. +- `Complexity.BP.Computes_and5_tight` — the exact additive-free commutator + length recurrence. - `Complexity.barringtonBound`, `Complexity.barringtonBound_le` — the explicit - length recurrence and its `13 ^ size` closed form. + original length recurrence and its `13 ^ size` closed form. - `Complexity.Computes_formula_len` — the length-tracked formula recursion. +- `Complexity.Computes_formula_depth_four` — optimized formula recursion with + the textbook `4 ^ depth` bound. - `Complexity.barrington_representation_len` — Barrington's theorem with the `13 ^ size` length bound. +- `Complexity.barrington_representation_depth_four` — Barrington's theorem with + the textbook `4 ^ depth` length bound. -/ open scoped commutatorElement @@ -49,24 +48,15 @@ namespace Complexity theorem BP.length_inverse {w : ℕ} (p : BP w) : (BP.inverse p).length = p.length := by simp [BP.inverse] -/-- Both `5`-cycles of `S₅` have cycle type `{5}` (file-local copy). -/ -private theorem cycleType5L {g : Perm (Fin 5)} (hc : g.IsCycle) (ho : orderOf g = 5) : - g.cycleType = {5} := by - have hs : g.support.card = 5 := by rw [← hc.orderOf]; exact ho - rw [hc.cycleType, hs] - -/-- Length-tracked retargeting: re-aiming a program to another `5`-cycle costs at - most two extra instructions (the conjugating constants). -/ +/-- Compatibility retargeting bound. Pointwise conjugation actually preserves +length exactly, which is stronger than the historical two-instruction bound. -/ theorem BP.Computes_retarget_len {p : BP 5} {f : (ℕ → Bool) → Bool} {σ : Perm (Fin 5)} (hp : BP.Computes σ p f) (hσc : σ.IsCycle) (hσo : orderOf σ = 5) {a : Perm (Fin 5)} (hac : a.IsCycle) (hao : orderOf a = 5) : ∃ r : BP 5, BP.Computes a r f ∧ r.length ≤ p.length + 2 := by - have hconj : IsConj σ a := Equiv.Perm.isConj_iff_cycleType_eq.mpr - (by rw [cycleType5L hσc hσo, cycleType5L hac hao]) - obtain ⟨τ, hτ⟩ := isConj_iff.mp hconj - have h := BP.Computes_conj hp τ - rw [hτ] at h - exact ⟨_, h, by simp [List.length_append]⟩ + obtain ⟨r, hr, hlen⟩ := + BP.Computes_retarget_length hp hσc hσo hac hao + exact ⟨r, hr, by omega⟩ /-- Length-tracked `AND` gate: the commutator construction at most doubles the two subprograms and adds a constant from the two retargetings. -/ @@ -84,6 +74,27 @@ theorem BP.Computes_and5_len {p q : BP 5} {f g : (ℕ → Bool) → Bool} {σ τ refine ⟨p' ++ q' ++ BP.inverse p' ++ BP.inverse q', hand, ?_⟩ simp only [List.length_append, BP.length_inverse]; omega +/-- **Tight Barrington `AND` gate.** Pointwise retargeting has zero overhead, so +the commutator program has exactly twice the sum of the two input lengths. -/ +theorem BP.Computes_and5_tight {p q : BP 5} + {f g : (ℕ → Bool) → Bool} {σ τ : Perm (Fin 5)} + (hp : BP.Computes σ p f) (hσc : σ.IsCycle) (hσo : orderOf σ = 5) + (hq : BP.Computes τ q g) (hτc : τ.IsCycle) (hτo : orderOf τ = 5) + {c : Perm (Fin 5)} (hcc : c.IsCycle) (hco : orderOf c = 5) : + ∃ r : BP 5, BP.Computes c r (fun α => f α && g α) ∧ + r.length = 2 * p.length + 2 * q.length := by + obtain ⟨a, b, hac, hao, hbc, hbo, hab⟩ := + every_fiveCycle_is_commutator c hcc hco + obtain ⟨p', hp', hlp'⟩ := + BP.Computes_retarget_length hp hσc hσo hac hao + obtain ⟨q', hq', hlq'⟩ := + BP.Computes_retarget_length hq hτc hτo hbc hbo + have hand := BP.Computes_and hp' hq' + rw [hab] at hand + refine ⟨p' ++ q' ++ BP.inverse p' ++ BP.inverse q', hand, ?_⟩ + simp only [List.length_append, BP.length_inverse, hlp', hlq'] + omega + /-- Explicit length bound for the Barrington branching-program construction, following its recurrence: leaves cost `≤ 1`, negation adds `1`, and the `AND` / `OR` steps double the children and add a constant. -/ @@ -192,6 +203,93 @@ theorem Computes_formula_len (φ : BoolFormula) : simp only [barringtonBound, List.length_append, List.length_cons, List.length_nil] at hls ⊢ omega +/-- **Textbook depth-tracked formula representability.** Every Boolean formula +`φ` is represented through any target `5`-cycle by a program of length at most +`4 ^ depth φ`. Pointwise retargeting contributes no instructions, compact +negation contributes no length beyond `max 1`, and each binary gate uses the +four copies in the commutator construction. -/ +theorem Computes_formula_depth_four (φ : BoolFormula) : + ∀ (c : Perm (Fin 5)), c.IsCycle → orderOf c = 5 → + ∃ r : BP 5, BP.Computes c r (fun α => BoolFormula.eval α φ) ∧ + r.length ≤ 4 ^ φ.depth := by + induction φ with + | var i => + intro c hcc hco + exact ⟨_, BP.Computes_var c i, by simp [BoolFormula.depth]⟩ + | tru => + intro c hcc hco + exact ⟨_, BP.Computes_true c, by simp [BoolFormula.depth]⟩ + | fls => + intro c hcc hco + exact ⟨_, BP.Computes_false c, by simp [BoolFormula.depth]⟩ + | neg φ ih => + intro c hcc hco + have hci : c⁻¹.IsCycle := hcc.inv + have hoi : orderOf c⁻¹ = 5 := by rw [orderOf_inv]; exact hco + obtain ⟨p, hp, hlp⟩ := ih c⁻¹ hci hoi + have h := BP.Computes_not_compact hp + rw [inv_inv] at h + refine ⟨BP.postMul p (c⁻¹)⁻¹, h, ?_⟩ + rw [BP.length_postMul] + apply le_trans (max_le (Nat.one_le_pow _ _ (by omega)) hlp) + exact Nat.pow_le_pow_right (by omega) (by simp [BoolFormula.depth]) + | conj φ ψ ihφ ihψ => + intro c hcc hco + obtain ⟨p, hp, hlp⟩ := ihφ c hcc hco + obtain ⟨q, hq, hlq⟩ := ihψ c hcc hco + obtain ⟨r, hr, hlr⟩ := + BP.Computes_and5_tight hp hcc hco hq hcc hco hcc hco + refine ⟨r, hr, ?_⟩ + have hlp' : p.length ≤ 4 ^ max φ.depth ψ.depth := + le_trans hlp (Nat.pow_le_pow_right (by omega) (le_max_left _ _)) + have hlq' : q.length ≤ 4 ^ max φ.depth ψ.depth := + le_trans hlq (Nat.pow_le_pow_right (by omega) (le_max_right _ _)) + rw [hlr] + simp only [BoolFormula.depth, Nat.pow_succ] + omega + | disj φ ψ ihφ ihψ => + intro c hcc hco + have hci : c⁻¹.IsCycle := hcc.inv + have hoi : orderOf c⁻¹ = 5 := by rw [orderOf_inv]; exact hco + obtain ⟨p, hp, hlp⟩ := ihφ c hcc hco + obtain ⟨q, hq, hlq⟩ := ihψ c hcc hco + let p' := BP.postMul p c⁻¹ + let q' := BP.postMul q c⁻¹ + have hp' : BP.Computes c⁻¹ p' + (fun α => !BoolFormula.eval α φ) := by + exact BP.Computes_not_compact hp + have hq' : BP.Computes c⁻¹ q' + (fun α => !BoolFormula.eval α ψ) := by + exact BP.Computes_not_compact hq + have hlp' : p'.length ≤ 4 ^ φ.depth := by + simp only [p', BP.length_postMul] + exact max_le (Nat.one_le_pow _ _ (by omega)) hlp + have hlq' : q'.length ≤ 4 ^ ψ.depth := by + simp only [q', BP.length_postMul] + exact max_le (Nat.one_le_pow _ _ (by omega)) hlq + obtain ⟨s, hs, hls⟩ := + BP.Computes_and5_tight hp' hci hoi hq' hci hoi hci hoi + have h := BP.Computes_not_compact hs + rw [inv_inv] at h + have hfun : + (fun α => !((!BoolFormula.eval α φ) && + (!BoolFormula.eval α ψ))) = + (fun α => BoolFormula.eval α φ || BoolFormula.eval α ψ) := by + funext α + simp [Bool.not_and, Bool.not_not] + rw [hfun] at h + refine ⟨BP.postMul s (c⁻¹)⁻¹, h, ?_⟩ + have hlpMax : p'.length ≤ 4 ^ max φ.depth ψ.depth := + le_trans hlp' (Nat.pow_le_pow_right (by omega) (le_max_left _ _)) + have hlqMax : q'.length ≤ 4 ^ max φ.depth ψ.depth := + le_trans hlq' (Nat.pow_le_pow_right (by omega) (le_max_right _ _)) + have hls' : s.length ≤ 4 ^ (max φ.depth ψ.depth + 1) := by + rw [hls] + simp only [Nat.pow_succ] + omega + rw [BP.length_postMul] + exact max_le (Nat.one_le_pow _ _ (by omega)) hls' + /-- **Barrington's theorem with a length bound.** Every Boolean formula `φ` is computed by a width-`5` permutation branching program (a nonidentity `σ ∈ S₅` with program-value `= σ ↔ φ` true) whose length is at most `13 ^ (size φ)`. -/ @@ -204,19 +302,57 @@ theorem barrington_representation_len (φ : BoolFormula) : refine ⟨r, finRotate 5, ?_, fun α => hr α, le_trans hlr (barringtonBound_le φ)⟩ rw [Ne, ← orderOf_eq_one_iff, ho]; norm_num -/-- **Barrington's theorem, depth form.** Every Boolean formula `φ` is computed by - a width-`5` permutation branching program of length at most `17 ^ (depth φ)`. - For a log-depth (`NC¹`) formula this length is polynomial in the number of - inputs — the polynomial-size direction of Barrington's characterization (with - a loose base `17` in place of the textbook `4`). -/ +/-- **Barrington's theorem, textbook finite form.** Every Boolean formula `φ` +of depth `d` is computed by a width-`5` permutation branching program of length +at most `4 ^ d`. -/ +theorem barrington_representation_depth_four (φ : BoolFormula) : + ∃ (r : BP 5) (σ : Perm (Fin 5)), σ ≠ 1 ∧ + (∀ α, BP.eval α r = if BoolFormula.eval α φ then σ else 1) ∧ + r.length ≤ 4 ^ φ.depth := by + obtain ⟨hc, ho⟩ := + isCycle_orderOf_five_of_pow (g := finRotate 5) (by decide) (by decide) + obtain ⟨r, hr, hlr⟩ := + Computes_formula_depth_four φ (finRotate 5) hc ho + refine ⟨r, finRotate 5, ?_, fun α => hr α, hlr⟩ + rw [Ne, ← orderOf_eq_one_iff, ho] + norm_num + +/-- Compatibility form of the earlier depth bound. The textbook theorem +`barrington_representation_depth_four` now gives the stronger base `4`; this +corollary retains the former base-`17` API. -/ theorem barrington_representation_depth (φ : BoolFormula) : ∃ (r : BP 5) (σ : Perm (Fin 5)), σ ≠ 1 ∧ (∀ α, BP.eval α r = if BoolFormula.eval α φ then σ else 1) ∧ r.length ≤ 17 ^ φ.depth := by - obtain ⟨hc, ho⟩ := isCycle_orderOf_five_of_pow (g := finRotate 5) (by decide) (by decide) - obtain ⟨r, hr, hlr⟩ := Computes_formula_len φ (finRotate 5) hc ho - refine ⟨r, finRotate 5, ?_, fun α => hr α, le_trans hlr (barringtonBound_le_pow_depth φ)⟩ - rw [Ne, ← orderOf_eq_one_iff, ho]; norm_num + obtain ⟨r, σ, hσ, hr, hlr⟩ := + barrington_representation_depth_four φ + exact ⟨r, σ, hσ, hr, + le_trans hlr (Nat.pow_le_pow_left (by omega) φ.depth)⟩ + +/-- `4 ^ (log₂ n) ≤ n ^ 2`: the arithmetic specialization of the textbook +Barrington bound to logarithmic depth. -/ +theorem pow_four_log_le (n : ℕ) (hn : n ≠ 0) : + 4 ^ Nat.log 2 n ≤ n ^ 2 := by + calc + 4 ^ Nat.log 2 n = (2 ^ Nat.log 2 n) ^ 2 := by + rw [show (4 : ℕ) = 2 ^ 2 from rfl, ← pow_mul, ← pow_mul, + Nat.mul_comm] + _ ≤ n ^ 2 := Nat.pow_le_pow_left (Nat.pow_log_le_self 2 hn) 2 + +/-- **Log-depth formulas have quadratic-length width-`5` programs.** A formula +of depth at most `log₂ n` compiles to a program of length at most `n²`. -/ +theorem barrington_quadratic_of_log_depth (φ : BoolFormula) (n : ℕ) + (hn : n ≠ 0) (hd : φ.depth ≤ Nat.log 2 n) : + ∃ (r : BP 5) (σ : Perm (Fin 5)), σ ≠ 1 ∧ + (∀ α, BP.eval α r = if BoolFormula.eval α φ then σ else 1) ∧ + r.length ≤ n ^ 2 := by + obtain ⟨r, σ, hσ, hev, hlen⟩ := + barrington_representation_depth_four φ + refine ⟨r, σ, hσ, hev, ?_⟩ + calc + r.length ≤ 4 ^ φ.depth := hlen + _ ≤ 4 ^ Nat.log 2 n := Nat.pow_le_pow_right (by omega) hd + _ ≤ n ^ 2 := pow_four_log_le n hn /-- `17 ^ (log₂ n) ≤ n ^ 5`: since `17 ≤ 2⁵`, `17^{log₂ n} ≤ (2^{log₂ n})⁵ ≤ n⁵`. This is the arithmetic behind "logarithmic depth gives polynomial size". -/ diff --git a/Complexitylib/Circuits/BarringtonProbeQuery.lean b/Complexitylib/Circuits/BarringtonProbeQuery.lean new file mode 100644 index 00000000..0d2e623c --- /dev/null +++ b/Complexitylib/Circuits/BarringtonProbeQuery.lean @@ -0,0 +1,213 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonProbeQuery.Defs +import Complexitylib.Circuits.BarringtonProbeQuery.Internal +import Complexitylib.Circuits.BarringtonTokenQuery + +/-! +# Direct Barrington queries through canonical formula-code probes + +This module replaces the complete encoded formula list by a numeric bit +oracle. With fuel covering the header and every token field, the first/last +occupied addresses and every fixed-address instruction agree exactly with the +reference Barrington compiler. + +## Main results + +- `barringtonProbeSlotsNonempty_eq` gives exact schedule nonemptiness without + computing either extreme address. +- `barringtonCompileProbeSlotOccupied_eq` gives exact target-free occupancy at + every fixed address. +- `barringtonProbeFirstOccupiedScan?_eq` and + `barringtonProbeLastOccupiedScan?_eq` recover the structural extremes by + bounded scans of that occupancy kernel. +- `barringtonCompileProbeScannedSlot?_eq_instruction?` gives the exact + instruction query using only those bounded scans. +- `barringtonProbeFirstOccupiedSlot?_eq` gives the structural first address. +- `barringtonProbeLastOccupiedSlot?_eq` gives the structural last address. +- `barringtonCompileProbeSlot?_eq_instruction?` gives the exact instruction at + every fixed address. +-/ + +namespace Complexity + +/-- Probe traversal over canonical formula bits computes exact fixed-schedule +nonemptiness without carrying a target permutation. -/ +theorem barringtonProbeSlotsNonempty_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonProbeSlotsNonempty fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ = + barringtonCompileSlotsNonempty fuel formula := by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + (barringtonProbeSlotOccupancy_correct_context_internal fuel [] [] formula + bitFuel (by simpa using hheader) (by simpa using hbound)).1 + +/-- Probe traversal over canonical formula bits computes exact occupancy at +every fixed address, independently of the compiler target. -/ +theorem barringtonCompileProbeSlotOccupied_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) (slot : ℕ) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonCompileProbeSlotOccupied fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ slot = + (BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot).isSome := by + rw [show barringtonCompileProbeSlotOccupied fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ slot = + barringtonCompileSlotOccupied fuel formula slot by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + (barringtonProbeSlotOccupancy_correct_context_internal fuel [] [] + formula bitFuel (by simpa using hheader) + (by simpa using hbound)).2 slot] + exact barringtonCompileSlotOccupied_correct_internal fuel formula target slot + |>.trans (congrArg Option.isSome + (barringtonCompileSlot?_correct_internal fuel formula target slot)) + +/-- Scanning the oracle occupancy kernel from the start recovers the exact +structural first occupied address. -/ +theorem barringtonProbeFirstOccupiedScan?_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonProbeFirstOccupiedScan? fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ = + barringtonFirstOccupiedSlot? fuel formula := by + rw [barringtonProbeFirstOccupiedScan?] + have hoccupied : + barringtonCompileProbeSlotOccupied fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ = + fun slot => (BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot).isSome := by + funext slot + exact barringtonCompileProbeSlotOccupied_eq fuel formula bitFuel target + slot hheader hbound + rw [hoccupied, ← barringtonCompileSlots_length_internal fuel formula target] + rw [BPSlots.firstTrueSlot?_instruction_internal] + exact (barringtonOccupiedSlots_correct_internal fuel formula target).1.symm + +/-- Scanning the oracle occupancy kernel through the complete bound recovers +the exact structural last occupied address. -/ +theorem barringtonProbeLastOccupiedScan?_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonProbeLastOccupiedScan? fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ = + barringtonLastOccupiedSlot? fuel formula := by + rw [barringtonProbeLastOccupiedScan?] + have hoccupied : + barringtonCompileProbeSlotOccupied fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ = + fun slot => (BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot).isSome := by + funext slot + exact barringtonCompileProbeSlotOccupied_eq fuel formula bitFuel target + slot hheader hbound + rw [hoccupied, ← barringtonCompileSlots_length_internal fuel formula target] + rw [BPSlots.lastTrueSlot?_instruction_internal] + exact (barringtonOccupiedSlots_correct_internal fuel formula target).2.symm + +/-- Every scan-based instruction query through canonical formula bits agrees +with the selected instruction of the list-valued fixed schedule. -/ +theorem barringtonCompileProbeScannedSlot?_eq_instruction? (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) (slot : ℕ) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonCompileProbeScannedSlot? fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target slot = + BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot := by + calc + _ = barringtonCompileSlot? fuel formula target slot := by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + barringtonCompileProbeScannedSlot?_correct_context_internal fuel [] [] + formula bitFuel target slot (by simpa using hheader) + (by simpa using hbound) + _ = _ := barringtonCompileSlot?_correct_internal fuel formula target slot + +/-- Probe traversal over canonical formula bits computes the structural first +occupied Barrington address. -/ +theorem barringtonProbeFirstOccupiedSlot?_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonProbeFirstOccupiedSlot? fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ = + barringtonFirstOccupiedSlot? fuel formula := by + calc + _ = barringtonTokensFirstOccupiedSlot? fuel + (FormulaCode.tokens formula) := by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + (barringtonProbeOccupiedSlots_correct_context_internal fuel [] [] + formula bitFuel (by simpa using hheader) + (by simpa using hbound)).1 + _ = _ := barringtonTokensFirstOccupiedSlot?_eq fuel formula + +/-- Probe traversal over canonical formula bits computes the structural last +occupied Barrington address. -/ +theorem barringtonProbeLastOccupiedSlot?_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonProbeLastOccupiedSlot? fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ = + barringtonLastOccupiedSlot? fuel formula := by + calc + _ = barringtonTokensLastOccupiedSlot? fuel + (FormulaCode.tokens formula) := by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + (barringtonProbeOccupiedSlots_correct_context_internal fuel [] [] + formula bitFuel (by simpa using hheader) + (by simpa using hbound)).2 + _ = _ := barringtonTokensLastOccupiedSlot?_eq fuel formula + +/-- Every direct query through canonical formula-code probes agrees with the +selected instruction of the list-valued fixed Barrington schedule. -/ +theorem barringtonCompileProbeSlot?_eq_instruction? (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) (slot : ℕ) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonCompileProbeSlot? fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target slot = + BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot := by + calc + _ = barringtonCompileTokensSlot? fuel (FormulaCode.tokens formula) + target slot := by + simpa [FormulaCode.encode, FormulaCode.encodeTokenStream] using + barringtonCompileProbeSlot?_correct_context_internal fuel [] [] + formula bitFuel target slot (by simpa using hheader) + (by simpa using hbound) + _ = _ := + barringtonCompileTokensSlot?_eq_instruction? fuel formula target slot + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonProbeQuery/Defs.lean b/Complexitylib/Circuits/BarringtonProbeQuery/Defs.lean new file mode 100644 index 00000000..56eaf368 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonProbeQuery/Defs.lean @@ -0,0 +1,406 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonTokenQuery.Defs +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation.Defs + +/-! +# Direct Barrington queries through a position-indexed formula-code oracle + +These recurrences are the pure semantics of the restartable-probe controller. +Every source-code read is a numeric oracle query. The controller retains only +the current postfix segment and follows one selected base-four address; binary +child spans are recovered by repeated oracle token queries. +-/ + +namespace Complexity + +namespace FormulaCode + +namespace BitOracle + +/-- Query the root token of a nonempty segment through a bit oracle. -/ +def segmentRootToken? (query : BitOracle) (bitFuel : ℕ) + (segment : TokenSegment) : Option Token := do + let root ← segment.root? + tokenValueAt? query bitFuel root + +end BitOracle + +end FormulaCode + +/-- Whether a fixed Barrington schedule queried through source-code probes is +nonempty. This recurrence never computes an extreme occupied address. -/ +def barringtonProbeSlotsNonempty : ℕ → FormulaCode.BitOracle → ℕ → + FormulaCode.TokenSegment → Bool + | 0, query, bitFuel, segment => + match FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | some (.var _) | some .tru => true + | _ => false + | fuel + 1, query, bitFuel, segment => + match FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | some (.var _) | some .tru => true + | some .fls => false + | some .neg | some .disj => true + | some .conj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => false + | some (left, right) => + barringtonProbeSlotsNonempty fuel query bitFuel left || + barringtonProbeSlotsNonempty fuel query bitFuel right + | none => false + +/-- Query only fixed-address occupancy through source-code probes. This Boolean +recurrence carries neither a target permutation nor recursive first/last +queries. -/ +def barringtonCompileProbeSlotOccupied : ℕ → FormulaCode.BitOracle → ℕ → + FormulaCode.TokenSegment → ℕ → Bool + | fuel, query, bitFuel, segment, slot => + match fuel, + FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | _, some (.var _) | _, some .tru => slot == 0 + | _, some .fls => false + | 0, _ => false + | fuel + 1, some .neg => + match segment.dropRoot? with + | none => false + | some child => + let blockSize := 4 ^ fuel + if slot < blockSize then + barringtonPostMulSlotOccupied + (barringtonProbeSlotsNonempty fuel query bitFuel child) + (barringtonCompileProbeSlotOccupied + fuel query bitFuel child) slot + else + false + | fuel + 1, some .conj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => false + | some (left, right) => + let blockSize := 4 ^ fuel + let leftOccupied := barringtonCompileProbeSlotOccupied + fuel query bitFuel left + let rightOccupied := barringtonCompileProbeSlotOccupied + fuel query bitFuel right + if slot < blockSize then + leftOccupied slot + else if slot < 2 * blockSize then + rightOccupied (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlotOccupied blockSize leftOccupied + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlotOccupied blockSize rightOccupied + (slot - 3 * blockSize) + else + false + | fuel + 1, some .disj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => false + | some (left, right) => + let blockSize := 4 ^ fuel + let leftOccupied := barringtonPostMulSlotOccupied + (barringtonProbeSlotsNonempty fuel query bitFuel left) + (barringtonCompileProbeSlotOccupied + fuel query bitFuel left) + let rightOccupied := barringtonPostMulSlotOccupied + (barringtonProbeSlotsNonempty fuel query bitFuel right) + (barringtonCompileProbeSlotOccupied + fuel query bitFuel right) + if slot < blockSize then + leftOccupied slot + else if slot < 2 * blockSize then + rightOccupied (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlotOccupied blockSize leftOccupied + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlotOccupied blockSize rightOccupied + (slot - 3 * blockSize) + else + false + | _, none => false + +/-- First occupied address found by scanning the target-free oracle occupancy +kernel over the complete fixed schedule. -/ +def barringtonProbeFirstOccupiedScan? (fuel : ℕ) + (query : FormulaCode.BitOracle) (bitFuel : ℕ) + (segment : FormulaCode.TokenSegment) : Option ℕ := + firstTrueSlot? (4 ^ fuel) + (barringtonCompileProbeSlotOccupied fuel query bitFuel segment) + +/-- Last occupied address found by scanning the target-free oracle occupancy +kernel over the complete fixed schedule. -/ +def barringtonProbeLastOccupiedScan? (fuel : ℕ) + (query : FormulaCode.BitOracle) (bitFuel : ℕ) + (segment : FormulaCode.TokenSegment) : Option ℕ := + lastTrueSlot? (4 ^ fuel) + (barringtonCompileProbeSlotOccupied fuel query bitFuel segment) + +/-- Query one Barrington instruction while locating every postmultiplication +address by bounded scans of the target-free occupancy kernel. Recursive calls +follow only the selected base-four block. -/ +def barringtonCompileProbeScannedSlot? : ℕ → FormulaCode.BitOracle → ℕ → + FormulaCode.TokenSegment → Equiv.Perm (Fin 5) → ℕ → + Option (BPInstr 5) + | fuel, query, bitFuel, segment, target, slot => + match fuel, + FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | _, some (.var index) => + if slot = 0 then some ⟨index, 1, target⟩ else none + | _, some .tru => + if slot = 0 then some (BPInstr.const target) else none + | _, some .fls => none + | 0, _ => none + | fuel + 1, some .neg => + match segment.dropRoot? with + | none => none + | some child => + let blockSize := 4 ^ fuel + if slot < blockSize then + barringtonPostMulSlot? + (barringtonCompileProbeScannedSlot? + fuel query bitFuel child target⁻¹) + (barringtonProbeLastOccupiedScan? + fuel query bitFuel child) + target slot + else + none + | fuel + 1, some .conj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + let leftQuery := barringtonCompileProbeScannedSlot? + fuel query bitFuel left (barringtonLeft target) + let rightQuery := barringtonCompileProbeScannedSlot? + fuel query bitFuel right (barringtonRight target) + if slot < blockSize then + leftQuery slot + else if slot < 2 * blockSize then + rightQuery (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (slot - 3 * blockSize) + else + none + | fuel + 1, some .disj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftQuery := barringtonPostMulSlot? + (barringtonCompileProbeScannedSlot? + fuel query bitFuel left leftTarget⁻¹) + (barringtonProbeLastOccupiedScan? + fuel query bitFuel left) leftTarget + let rightQuery := barringtonPostMulSlot? + (barringtonCompileProbeScannedSlot? + fuel query bitFuel right rightTarget⁻¹) + (barringtonProbeLastOccupiedScan? + fuel query bitFuel right) rightTarget + let commutatorQuery := fun localSlot => + if localSlot < blockSize then + leftQuery localSlot + else if localSlot < 2 * blockSize then + rightQuery (localSlot - blockSize) + else if localSlot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (localSlot - 2 * blockSize) + else if localSlot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (localSlot - 3 * blockSize) + else + none + let firstRight := + (barringtonProbeFirstOccupiedScan? + fuel query bitFuel right).getD 0 + let commutatorLast := + 3 * blockSize + (blockSize - 1 - firstRight) + barringtonPostMulSlot? commutatorQuery + (some commutatorLast) target slot + | _, none => none + +/-- First occupied fixed address computed through source-code probes. -/ +def barringtonProbeFirstOccupiedSlot? : ℕ → FormulaCode.BitOracle → ℕ → + FormulaCode.TokenSegment → Option ℕ + | 0, query, bitFuel, segment => + match FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | some (.var _) | some .tru => some 0 + | _ => none + | fuel + 1, query, bitFuel, segment => + match FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | some (.var _) | some .tru => some 0 + | some .fls => none + | some .neg => + match segment.dropRoot? with + | none => none + | some child => + some ((barringtonProbeFirstOccupiedSlot? + fuel query bitFuel child).getD 0) + | some .conj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => none + | some (left, right) => + match barringtonProbeFirstOccupiedSlot? + fuel query bitFuel left with + | some slot => some slot + | none => + (barringtonProbeFirstOccupiedSlot? + fuel query bitFuel right).map (4 ^ fuel + ·) + | some .disj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => none + | some (left, _) => + some ((barringtonProbeFirstOccupiedSlot? + fuel query bitFuel left).getD 0) + | none => none + +/-- Last occupied fixed address computed through source-code probes. -/ +def barringtonProbeLastOccupiedSlot? : ℕ → FormulaCode.BitOracle → ℕ → + FormulaCode.TokenSegment → Option ℕ + | 0, query, bitFuel, segment => + match FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | some (.var _) | some .tru => some 0 + | _ => none + | fuel + 1, query, bitFuel, segment => + match FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | some (.var _) | some .tru => some 0 + | some .fls => none + | some .neg => + match segment.dropRoot? with + | none => none + | some child => + some ((barringtonProbeLastOccupiedSlot? + fuel query bitFuel child).getD 0) + | some .conj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + match barringtonProbeFirstOccupiedSlot? + fuel query bitFuel right with + | some slot => + some (3 * blockSize + (blockSize - 1 - slot)) + | none => + (barringtonProbeFirstOccupiedSlot? + fuel query bitFuel left).map + fun slot => 2 * blockSize + (blockSize - 1 - slot) + | some .disj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => none + | some (_, right) => + let blockSize := 4 ^ fuel + let firstRight := + (barringtonProbeFirstOccupiedSlot? + fuel query bitFuel right).getD 0 + some (3 * blockSize + (blockSize - 1 - firstRight)) + | none => none + +/-- Query one fixed-address Barrington instruction through source-code probes. -/ +def barringtonCompileProbeSlot? : ℕ → FormulaCode.BitOracle → ℕ → + FormulaCode.TokenSegment → Equiv.Perm (Fin 5) → ℕ → Option (BPInstr 5) + | fuel, query, bitFuel, segment, target, slot => + match fuel, + FormulaCode.BitOracle.segmentRootToken? query bitFuel segment with + | _, some (.var index) => + if slot = 0 then some ⟨index, 1, target⟩ else none + | _, some .tru => + if slot = 0 then some (BPInstr.const target) else none + | _, some .fls => none + | 0, _ => none + | fuel + 1, some .neg => + match segment.dropRoot? with + | none => none + | some child => + let blockSize := 4 ^ fuel + if slot < blockSize then + barringtonPostMulSlot? + (barringtonCompileProbeSlot? + fuel query bitFuel child target⁻¹) + (barringtonProbeLastOccupiedSlot? + fuel query bitFuel child) + target slot + else + none + | fuel + 1, some .conj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + let leftQuery := barringtonCompileProbeSlot? + fuel query bitFuel left (barringtonLeft target) + let rightQuery := barringtonCompileProbeSlot? + fuel query bitFuel right (barringtonRight target) + if slot < blockSize then + leftQuery slot + else if slot < 2 * blockSize then + rightQuery (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (slot - 3 * blockSize) + else + none + | fuel + 1, some .disj => + match FormulaCode.BitOracle.encodedBinaryChildren? + query bitFuel segment with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftQuery := barringtonPostMulSlot? + (barringtonCompileProbeSlot? + fuel query bitFuel left leftTarget⁻¹) + (barringtonProbeLastOccupiedSlot? + fuel query bitFuel left) leftTarget + let rightQuery := barringtonPostMulSlot? + (barringtonCompileProbeSlot? + fuel query bitFuel right rightTarget⁻¹) + (barringtonProbeLastOccupiedSlot? + fuel query bitFuel right) rightTarget + let commutatorQuery := fun localSlot => + if localSlot < blockSize then + leftQuery localSlot + else if localSlot < 2 * blockSize then + rightQuery (localSlot - blockSize) + else if localSlot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (localSlot - 2 * blockSize) + else if localSlot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (localSlot - 3 * blockSize) + else + none + let firstRight := + (barringtonProbeFirstOccupiedSlot? + fuel query bitFuel right).getD 0 + let commutatorLast := + 3 * blockSize + (blockSize - 1 - firstRight) + barringtonPostMulSlot? commutatorQuery + (some commutatorLast) target slot + | _, none => none + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonProbeQuery/Internal.lean b/Complexitylib/Circuits/BarringtonProbeQuery/Internal.lean new file mode 100644 index 00000000..5642a701 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonProbeQuery/Internal.lean @@ -0,0 +1,868 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonProbeQuery.Defs +import Complexitylib.Circuits.BarringtonTokenQuery.Internal +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation.Internal + +/-! +# Direct Barrington queries through a formula-code oracle -- proof internals +-/ + +namespace Complexity + +namespace FormulaCode + +namespace BitOracle + +theorem segmentRootToken?_ofList_encodeTokenStream_context_internal + (before after : List Token) (formula : BoolFormula) (bitFuel : ℕ) + (hheader : (before ++ tokens formula ++ after).length + 1 ≤ bitFuel) + (hbound : ∀ token ∈ before ++ tokens formula ++ after, + token.codeLength ≤ bitFuel) : + segmentRootToken? + (ofList (encodeTokenStream (before ++ tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ = + (tokens formula).getLast? := by + have hpositive : 0 < formula.size := by + cases formula <;> simp [BoolFormula.size] + rw [segmentRootToken?] + rw [show formula.size = (formula.size - 1) + 1 by omega] + simp only [TokenSegment.root?, Option.bind_eq_bind, Option.bind_some] + have hglobal : before.length + (formula.size - 1) < + (before ++ tokens formula ++ after).length := by + simp + omega + rw [tokenValueAt?_ofList_encodeTokenStream_internal _ bitFuel _ hheader + hglobal hbound] + rw [← List.getElem?_eq_getElem hglobal] + rw [List.getElem?_append_left (by simp; omega)] + rw [List.getElem?_append_right (by omega)] + rw [show before.length + (formula.size - 1) - before.length = + formula.size - 1 by omega] + rw [List.getLast?_eq_getElem?] + simp + +end BitOracle + +end FormulaCode + +theorem barringtonProbeSlotOccupancy_correct_context_internal (fuel : ℕ) + (before after : List FormulaCode.Token) (formula : BoolFormula) + (bitFuel : ℕ) + (hheader : + (before ++ FormulaCode.tokens formula ++ after).length + 1 ≤ bitFuel) + (hbound : ∀ token ∈ before ++ FormulaCode.tokens formula ++ after, + token.codeLength ≤ bitFuel) : + barringtonProbeSlotsNonempty fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ = + barringtonCompileSlotsNonempty fuel formula ∧ + ∀ slot, + barringtonCompileProbeSlotOccupied fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ slot = + barringtonCompileSlotOccupied fuel formula slot := by + induction fuel generalizing before after formula with + | zero => + have hroot := + FormulaCode.BitOracle.segmentRootToken?_ofList_encodeTokenStream_context_internal + before after formula bitFuel hheader hbound + cases formula <;> + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ <;> + simp [barringtonProbeSlotsNonempty, + barringtonCompileProbeSlotOccupied, + barringtonCompileSlotsNonempty, barringtonCompileSlotOccupied, + hroot] + | succ fuel ih => + have hroot := + FormulaCode.BitOracle.segmentRootToken?_ofList_encodeTokenStream_context_internal + before after formula bitFuel hheader hbound + cases formula with + | var index => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonProbeSlotsNonempty, + barringtonCompileProbeSlotOccupied, + barringtonCompileSlotsNonempty, barringtonCompileSlotOccupied, + hroot] + | tru => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonProbeSlotsNonempty, + barringtonCompileProbeSlotOccupied, + barringtonCompileSlotsNonempty, barringtonCompileSlotOccupied, + hroot] + | fls => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonProbeSlotsNonempty, + barringtonCompileProbeSlotOccupied, + barringtonCompileSlotsNonempty, barringtonCompileSlotOccupied, + hroot] + | neg formula => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchild := ih before (FormulaCode.Token.neg :: after) formula + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchild' := hchild + simp [List.append_assoc] at hchild' + have hchildFunction := funext hchild'.2 + simp [barringtonProbeSlotsNonempty, + barringtonCompileProbeSlotOccupied, + barringtonCompileSlotsNonempty, barringtonCompileSlotOccupied, + FormulaCode.tokens, BoolFormula.size, List.append_assoc, + FormulaCode.TokenSegment.dropRoot?, hroot, hchild'.1, + hchildFunction] + | conj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream_internal + before after left right FormulaCode.Token.conj bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchildren' : + FormulaCode.BitOracle.encodedBinaryChildren? + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ + after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleft := ih before + (FormulaCode.tokens right ++ FormulaCode.Token.conj :: after) + left + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hright := ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.conj :: after) right + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hleft' := hleft + have hright' := hright + simp [List.append_assoc] at hleft' hright' + have hleftFunction := funext hleft'.2 + have hrightFunction := funext hright'.2 + simp [barringtonProbeSlotsNonempty, + barringtonCompileProbeSlotOccupied, + barringtonCompileSlotsNonempty, barringtonCompileSlotOccupied, + FormulaCode.tokens, BoolFormula.size, List.append_assoc, + hroot, hchildren', hleft'.1, hleftFunction, hright'.1, + hrightFunction] + | disj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream_internal + before after left right FormulaCode.Token.disj bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchildren' : + FormulaCode.BitOracle.encodedBinaryChildren? + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ + after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleft := ih before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hright := ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hleft' := hleft + have hright' := hright + simp [List.append_assoc] at hleft' hright' + have hleftFunction := funext hleft'.2 + have hrightFunction := funext hright'.2 + simp [barringtonProbeSlotsNonempty, + barringtonCompileProbeSlotOccupied, + barringtonCompileSlotsNonempty, barringtonCompileSlotOccupied, + FormulaCode.tokens, BoolFormula.size, List.append_assoc, + hroot, hchildren', hleft'.1, hleftFunction, hright'.1, + hrightFunction] + +theorem barringtonProbeOccupiedScans_correct_context_internal (fuel : ℕ) + (before after : List FormulaCode.Token) (formula : BoolFormula) + (bitFuel : ℕ) (target : Equiv.Perm (Fin 5)) + (hheader : + (before ++ FormulaCode.tokens formula ++ after).length + 1 ≤ bitFuel) + (hbound : ∀ token ∈ before ++ FormulaCode.tokens formula ++ after, + token.codeLength ≤ bitFuel) : + barringtonProbeFirstOccupiedScan? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ = + barringtonFirstOccupiedSlot? fuel formula ∧ + barringtonProbeLastOccupiedScan? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ = + barringtonLastOccupiedSlot? fuel formula := by + have hoccupancy := barringtonProbeSlotOccupancy_correct_context_internal + fuel before after formula bitFuel hheader hbound + have hprobeFormula := funext hoccupancy.2 + have hformulaSchedule : barringtonCompileSlotOccupied fuel formula = + fun slot => (BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot).isSome := by + funext slot + exact barringtonCompileSlotOccupied_correct_internal fuel formula target + slot |>.trans (congrArg Option.isSome + (barringtonCompileSlot?_correct_internal fuel formula target slot)) + have hprobeSchedule := hprobeFormula.trans hformulaSchedule + constructor + · rw [barringtonProbeFirstOccupiedScan?, hprobeSchedule, + ← barringtonCompileSlots_length_internal fuel formula target] + rw [BPSlots.firstTrueSlot?_instruction_internal] + exact (barringtonOccupiedSlots_correct_internal fuel formula target).1.symm + · rw [barringtonProbeLastOccupiedScan?, hprobeSchedule, + ← barringtonCompileSlots_length_internal fuel formula target] + rw [BPSlots.lastTrueSlot?_instruction_internal] + exact (barringtonOccupiedSlots_correct_internal fuel formula target).2.symm + +theorem barringtonCompileProbeScannedSlot?_correct_context_internal + (fuel : ℕ) (before after : List FormulaCode.Token) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) (slot : ℕ) + (hheader : + (before ++ FormulaCode.tokens formula ++ after).length + 1 ≤ bitFuel) + (hbound : ∀ token ∈ before ++ FormulaCode.tokens formula ++ after, + token.codeLength ≤ bitFuel) : + barringtonCompileProbeScannedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ target slot = + barringtonCompileSlot? fuel formula target slot := by + induction fuel generalizing before after formula target slot with + | zero => + have hroot := + FormulaCode.BitOracle.segmentRootToken?_ofList_encodeTokenStream_context_internal + before after formula bitFuel hheader hbound + cases formula <;> + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ <;> + simp [barringtonCompileProbeScannedSlot?, barringtonCompileSlot?, + hroot] + | succ fuel ih => + have hroot := + FormulaCode.BitOracle.segmentRootToken?_ofList_encodeTokenStream_context_internal + before after formula bitFuel hheader hbound + cases formula with + | var index => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileProbeScannedSlot?, barringtonCompileSlot?, + hroot] + | tru => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileProbeScannedSlot?, barringtonCompileSlot?, + hroot] + | fls => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileProbeScannedSlot?, barringtonCompileSlot?, + hroot] + | neg formula => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hscans := + barringtonProbeOccupiedScans_correct_context_internal fuel before + (FormulaCode.Token.neg :: after) formula bitFuel target⁻¹ + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hquery : + barringtonCompileProbeScannedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.neg formula) ++ after))) + bitFuel ⟨before.length, formula.size⟩ target⁻¹ = + barringtonCompileSlot? fuel formula target⁻¹ := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before (FormulaCode.Token.neg :: after) formula target⁻¹ + querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + simp [FormulaCode.tokens, List.append_assoc] at hquery + have hscans' := hscans + simp [List.append_assoc] at hscans' + simp [barringtonCompileProbeScannedSlot?, barringtonCompileSlot?, + FormulaCode.tokens, BoolFormula.size, List.append_assoc, + FormulaCode.TokenSegment.dropRoot?, hroot, hquery, hscans'.2] + | conj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream_internal + before after left right FormulaCode.Token.conj bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchildren' : + FormulaCode.BitOracle.encodedBinaryChildren? + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ + after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleftQuery : + barringtonCompileProbeScannedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ + after))) + bitFuel ⟨before.length, left.size⟩ + (barringtonLeft target) = + barringtonCompileSlot? fuel left + (barringtonLeft target) := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before + (FormulaCode.tokens right ++ FormulaCode.Token.conj :: after) + left (barringtonLeft target) querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hrightQuery : + barringtonCompileProbeScannedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ + after))) + bitFuel ⟨before.length + left.size, right.size⟩ + (barringtonRight target) = + barringtonCompileSlot? fuel right + (barringtonRight target) := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.conj :: after) right + (barringtonRight target) querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + simp [FormulaCode.tokens, List.append_assoc] at hleftQuery hrightQuery + simp [barringtonCompileProbeScannedSlot?, barringtonCompileSlot?, + FormulaCode.tokens, BoolFormula.size, List.append_assoc, + hroot, hchildren', hleftQuery, hrightQuery] + | disj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream_internal + before after left right FormulaCode.Token.disj bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchildren' : + FormulaCode.BitOracle.encodedBinaryChildren? + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ + after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleftScans := + barringtonProbeOccupiedScans_correct_context_internal fuel before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left bitFuel target + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hrightScans := + barringtonProbeOccupiedScans_correct_context_internal fuel + (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right bitFuel target + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hleftScans' := hleftScans + have hrightScans' := hrightScans + simp [List.append_assoc] at hleftScans' hrightScans' + have hleftQuery (childTarget : Equiv.Perm (Fin 5)) : + barringtonCompileProbeScannedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ + after))) + bitFuel ⟨before.length, left.size⟩ childTarget = + barringtonCompileSlot? fuel left childTarget := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left childTarget querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hrightQuery (childTarget : Equiv.Perm (Fin 5)) : + barringtonCompileProbeScannedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ + after))) + bitFuel ⟨before.length + left.size, right.size⟩ + childTarget = + barringtonCompileSlot? fuel right childTarget := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right childTarget querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + simp [FormulaCode.tokens, List.append_assoc] at hleftQuery hrightQuery + simp [barringtonCompileProbeScannedSlot?, barringtonCompileSlot?, + FormulaCode.tokens, BoolFormula.size, List.append_assoc, + hroot, hchildren', hleftScans'.2, + hrightScans'.1, hrightScans'.2, hleftQuery, hrightQuery] + +theorem barringtonProbeOccupiedSlots_correct_context_internal (fuel : ℕ) + (before after : List FormulaCode.Token) (formula : BoolFormula) + (bitFuel : ℕ) + (hheader : + (before ++ FormulaCode.tokens formula ++ after).length + 1 ≤ bitFuel) + (hbound : ∀ token ∈ before ++ FormulaCode.tokens formula ++ after, + token.codeLength ≤ bitFuel) : + barringtonProbeFirstOccupiedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ = + barringtonTokensFirstOccupiedSlot? fuel + (FormulaCode.tokens formula) ∧ + barringtonProbeLastOccupiedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ = + barringtonTokensLastOccupiedSlot? fuel + (FormulaCode.tokens formula) := by + induction fuel generalizing before after formula with + | zero => + have hroot := + FormulaCode.BitOracle.segmentRootToken?_ofList_encodeTokenStream_context_internal + before after formula bitFuel hheader hbound + cases formula <;> + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot <;> + simp [barringtonProbeFirstOccupiedSlot?, + barringtonProbeLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, hroot] + | succ fuel ih => + have hroot := + FormulaCode.BitOracle.segmentRootToken?_ofList_encodeTokenStream_context_internal + before after formula bitFuel hheader hbound + cases formula with + | var index => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + simp [barringtonProbeFirstOccupiedSlot?, + barringtonProbeLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, hroot] + | tru => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + simp [barringtonProbeFirstOccupiedSlot?, + barringtonProbeLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, hroot] + | fls => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + simp [barringtonProbeFirstOccupiedSlot?, + barringtonProbeLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, hroot] + | neg formula => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchild := ih before (FormulaCode.Token.neg :: after) formula + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchild' : + barringtonProbeFirstOccupiedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.neg formula) ++ after))) + bitFuel ⟨before.length, formula.size⟩ = + barringtonTokensFirstOccupiedSlot? fuel + (FormulaCode.tokens formula) ∧ + barringtonProbeLastOccupiedSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.neg formula) ++ after))) + bitFuel ⟨before.length, formula.size⟩ = + barringtonTokensLastOccupiedSlot? fuel + (FormulaCode.tokens formula) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchild + simp [FormulaCode.tokens, List.append_assoc] at hchild' + simp [barringtonProbeFirstOccupiedSlot?, + barringtonProbeLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.TokenSegment.dropRoot?, hroot, + hchild'.1, hchild'.2] + | conj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream_internal + before after left right FormulaCode.Token.conj bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchildren' : + FormulaCode.BitOracle.encodedBinaryChildren? + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ + after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleft := ih before + (FormulaCode.tokens right ++ FormulaCode.Token.conj :: after) + left + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hright := ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.conj :: after) right + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hleft' := hleft + have hright' := hright + simp [List.append_assoc] at hleft' hright' + simp [barringtonProbeFirstOccupiedSlot?, + barringtonProbeLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hroot, hchildren', hleft'.1, hright'.1] + exact ⟨rfl, rfl⟩ + | disj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream_internal + before after left right FormulaCode.Token.disj bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchildren' : + FormulaCode.BitOracle.encodedBinaryChildren? + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ + after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleft := ih before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hright := ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right + (by simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hleft' := hleft + have hright' := hright + simp [List.append_assoc] at hleft' hright' + simp [barringtonProbeFirstOccupiedSlot?, + barringtonProbeLastOccupiedSlot?, + barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hroot, hchildren', hleft'.1, hright'.1] + +theorem barringtonCompileProbeSlot?_correct_context_internal (fuel : ℕ) + (before after : List FormulaCode.Token) (formula : BoolFormula) + (bitFuel : ℕ) (target : Equiv.Perm (Fin 5)) (slot : ℕ) + (hheader : + (before ++ FormulaCode.tokens formula ++ after).length + 1 ≤ bitFuel) + (hbound : ∀ token ∈ before ++ FormulaCode.tokens formula ++ after, + token.codeLength ≤ bitFuel) : + barringtonCompileProbeSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens formula ++ after))) + bitFuel ⟨before.length, formula.size⟩ target slot = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens formula) target slot := by + induction fuel generalizing before after formula target slot with + | zero => + have hroot := + FormulaCode.BitOracle.segmentRootToken?_ofList_encodeTokenStream_context_internal + before after formula bitFuel hheader hbound + cases formula <;> + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ <;> + simp [barringtonCompileProbeSlot?, + barringtonCompileTokensSlot?, hroot] + | succ fuel ih => + have hroot := + FormulaCode.BitOracle.segmentRootToken?_ofList_encodeTokenStream_context_internal + before after formula bitFuel hheader hbound + cases formula with + | var index => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileProbeSlot?, + barringtonCompileTokensSlot?, hroot] + | tru => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileProbeSlot?, + barringtonCompileTokensSlot?, hroot] + | fls => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot ⊢ + simp [barringtonCompileProbeSlot?, + barringtonCompileTokensSlot?, hroot] + | neg formula => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hoccupied := + barringtonProbeOccupiedSlots_correct_context_internal fuel before + (FormulaCode.Token.neg :: after) formula bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hquery : + barringtonCompileProbeSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.neg formula) ++ after))) + bitFuel ⟨before.length, formula.size⟩ target⁻¹ = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens formula) target⁻¹ := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before (FormulaCode.Token.neg :: after) formula target⁻¹ + querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + simp [FormulaCode.tokens, List.append_assoc] at hquery + have hoccupied' := hoccupied + simp [List.append_assoc] at hoccupied' + simp [barringtonCompileProbeSlot?, + barringtonCompileTokensSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.TokenSegment.dropRoot?, hroot, hquery, + hoccupied'.2] + | conj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream_internal + before after left right FormulaCode.Token.conj bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchildren' : + FormulaCode.BitOracle.encodedBinaryChildren? + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ + after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleftQuery : + barringtonCompileProbeSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ + after))) + bitFuel ⟨before.length, left.size⟩ + (barringtonLeft target) = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens left) (barringtonLeft target) := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before + (FormulaCode.tokens right ++ FormulaCode.Token.conj :: after) + left (barringtonLeft target) querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hrightQuery : + barringtonCompileProbeSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.conj left right) ++ + after))) + bitFuel ⟨before.length + left.size, right.size⟩ + (barringtonRight target) = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens right) (barringtonRight target) := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.conj :: after) right + (barringtonRight target) querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + simp [FormulaCode.tokens, List.append_assoc] at hleftQuery hrightQuery + simp [barringtonCompileProbeSlot?, + barringtonCompileTokensSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hroot, hchildren', hleftQuery, hrightQuery] + | disj left right => + simp [FormulaCode.tokens, BoolFormula.size, + List.append_assoc] at hroot + have hchildren := + FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream_internal + before after left right FormulaCode.Token.disj bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hchildren' : + FormulaCode.BitOracle.encodedBinaryChildren? + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ + after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + simpa [FormulaCode.tokens, List.append_assoc] using hchildren + simp [FormulaCode.tokens, List.append_assoc] at hchildren' + have hleftOccupied := + barringtonProbeOccupiedSlots_correct_context_internal fuel before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hrightOccupied := + barringtonProbeOccupiedSlots_correct_context_internal fuel + (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right bitFuel + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hleftOccupied' := hleftOccupied + have hrightOccupied' := hrightOccupied + simp [List.append_assoc] at hleftOccupied' hrightOccupied' + have hleftQuery (childTarget : Equiv.Perm (Fin 5)) : + barringtonCompileProbeSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ + after))) + bitFuel ⟨before.length, left.size⟩ childTarget = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens left) childTarget := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih before + (FormulaCode.tokens right ++ FormulaCode.Token.disj :: after) + left childTarget querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + have hrightQuery (childTarget : Equiv.Perm (Fin 5)) : + barringtonCompileProbeSlot? fuel + (FormulaCode.BitOracle.ofList + (FormulaCode.encodeTokenStream + (before ++ FormulaCode.tokens (.disj left right) ++ + after))) + bitFuel ⟨before.length + left.size, right.size⟩ childTarget = + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens right) childTarget := by + funext querySlot + simpa [FormulaCode.tokens, List.append_assoc] using + ih (before ++ FormulaCode.tokens left) + (FormulaCode.Token.disj :: after) right childTarget querySlot + (by + simpa [FormulaCode.tokens, List.append_assoc] using hheader) + (by + simpa [FormulaCode.tokens, List.append_assoc] using hbound) + simp [FormulaCode.tokens, List.append_assoc] at hleftQuery hrightQuery + simp [barringtonCompileProbeSlot?, + barringtonCompileTokensSlot?, FormulaCode.tokens, + BoolFormula.size, List.append_assoc, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hroot, hchildren', hleftOccupied'.2, + hrightOccupied'.1, hrightOccupied'.2, + hleftQuery, hrightQuery] + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonProbeSerializer.lean b/Complexitylib/Circuits/BarringtonProbeSerializer.lean new file mode 100644 index 00000000..567016aa --- /dev/null +++ b/Complexitylib/Circuits/BarringtonProbeSerializer.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonProbeSerializer.Defs +import Complexitylib.Circuits.BarringtonProbeSerializer.Internal + +/-! +# Two-pass Barrington serialization through a bit oracle + +This module fixes the complete output of the restartable-probe serializer. +Under the canonical formula-code and depth promises, scanning all `4 ^ fuel` +addresses twice yields the executable Barrington compiler's canonical code +byte-for-byte. +-/ + +namespace Complexity + +/-- Querying every scan-based oracle address reconstructs the fixed optional +schedule exactly. -/ +theorem barringtonCompileProbeSlots_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonCompileProbeSlots fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target = + barringtonCompileSlots fuel formula target := + barringtonCompileProbeSlots_correct_internal fuel formula bitFuel target + hheader hbound + +/-- Under the depth promise, erasing empty oracle addresses recovers the +executable compiler instruction-for-instruction. -/ +theorem barringtonCompileProbeProgram_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) + (hdepth : formula.depth ≤ fuel) : + barringtonCompileProbeProgram fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target = + barringtonCompile formula target := + barringtonCompileProbeProgram_correct_internal fuel formula bitFuel target + hheader hbound hdepth + +/-- The first oracle scan computes the exact target-independent instruction +count used by the canonical program header. -/ +theorem barringtonCompileProbeProgram_length (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) + (hdepth : formula.depth ≤ fuel) : + (barringtonCompileProbeProgram fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target).length = + barringtonInstructionCount formula := + barringtonCompileProbeProgram_length_internal fuel formula bitFuel target + hheader hbound hdepth + +/-- The complete two-pass oracle serializer emits the exact canonical code of +the executable Barrington compiler. -/ +theorem barringtonCompileProbeCode_eq (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) + (hdepth : formula.depth ≤ fuel) : + barringtonCompileProbeCode fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target = + BPCode.Program.encode (barringtonCompile formula target) := + barringtonCompileProbeCode_correct_internal fuel formula bitFuel target + hheader hbound hdepth + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonProbeSerializer/Defs.lean b/Complexitylib/Circuits/BarringtonProbeSerializer/Defs.lean new file mode 100644 index 00000000..b68e8002 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonProbeSerializer/Defs.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonProbeQuery.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Defs + +/-! +# Two-pass Barrington serialization through a bit oracle -- definitions + +These definitions are the pure semantics of the machine-level serializer. The +first pass counts occupied fixed addresses; the second repeats the same scan, +erases empty addresses, and emits the canonical program code. Every formula +bit is obtained through the same position-indexed oracle used by the +restartable output-probe machine. +-/ + +namespace Complexity + +/-- Query every fixed Barrington address through the scan-based bit oracle. -/ +def barringtonCompileProbeSlots (fuel : ℕ) + (query : FormulaCode.BitOracle) (bitFuel : ℕ) + (segment : FormulaCode.TokenSegment) (target : Equiv.Perm (Fin 5)) : + BPSlots 5 := + (List.range (4 ^ fuel)).map fun slot => + barringtonCompileProbeScannedSlot? fuel query bitFuel segment target slot + +/-- Erase empty oracle-query addresses to obtain the emitted program. -/ +def barringtonCompileProbeProgram (fuel : ℕ) + (query : FormulaCode.BitOracle) (bitFuel : ℕ) + (segment : FormulaCode.TokenSegment) (target : Equiv.Perm (Fin 5)) : + BP 5 := + (barringtonCompileProbeSlots fuel query bitFuel segment target).filterMap id + +/-- Canonically serialize the program obtained by the two oracle-query scans. -/ +def barringtonCompileProbeCode (fuel : ℕ) + (query : FormulaCode.BitOracle) (bitFuel : ℕ) + (segment : FormulaCode.TokenSegment) (target : Equiv.Perm (Fin 5)) : + List Bool := + BPCode.Program.encode + (barringtonCompileProbeProgram fuel query bitFuel segment target) + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonProbeSerializer/Internal.lean b/Complexitylib/Circuits/BarringtonProbeSerializer/Internal.lean new file mode 100644 index 00000000..547c65b2 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonProbeSerializer/Internal.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonProbeQuery +import Complexitylib.Circuits.BarringtonProbeSerializer.Defs +import Complexitylib.Circuits.BarringtonSlots + +/-! +# Two-pass Barrington serialization through a bit oracle -- proof internals +-/ + +namespace Complexity + +theorem barringtonCompileProbeSlots_correct_internal (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) : + barringtonCompileProbeSlots fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target = + barringtonCompileSlots fuel formula target := by + apply List.ext_getElem + · simp [barringtonCompileProbeSlots, barringtonCompileSlots_length] + · intro slot hprobe hslots + simp only [barringtonCompileProbeSlots, List.length_map, + List.length_range] at hprobe + simp only [barringtonCompileProbeSlots] + rw [List.getElem_map] + simp only [List.getElem_range] + rw [barringtonCompileProbeScannedSlot?_eq_instruction? fuel formula + bitFuel target slot hheader hbound] + simp [BPSlots.instruction?, List.getElem?_eq_getElem hslots] + +theorem barringtonCompileProbeProgram_correct_internal (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) + (hdepth : formula.depth ≤ fuel) : + barringtonCompileProbeProgram fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target = + barringtonCompile formula target := by + rw [barringtonCompileProbeProgram, + barringtonCompileProbeSlots_correct_internal fuel formula bitFuel target + hheader hbound, + barringtonCompileSlots_filterMap fuel formula target hdepth] + +theorem barringtonCompileProbeProgram_length_internal (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) + (hdepth : formula.depth ≤ fuel) : + (barringtonCompileProbeProgram fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target).length = + barringtonInstructionCount formula := by + rw [barringtonCompileProbeProgram, + barringtonCompileProbeSlots_correct_internal fuel formula bitFuel target + hheader hbound] + exact barringtonCompileSlots_occupiedCount fuel formula target hdepth + +theorem barringtonCompileProbeCode_correct_internal (fuel : ℕ) + (formula : BoolFormula) (bitFuel : ℕ) + (target : Equiv.Perm (Fin 5)) + (hheader : formula.size + 1 ≤ bitFuel) + (hbound : ∀ token ∈ FormulaCode.tokens formula, + token.codeLength ≤ bitFuel) + (hdepth : formula.depth ≤ fuel) : + barringtonCompileProbeCode fuel + (FormulaCode.BitOracle.ofList (FormulaCode.encode formula)) + bitFuel ⟨0, formula.size⟩ target = + BPCode.Program.encode (barringtonCompile formula target) := by + rw [barringtonCompileProbeCode, + barringtonCompileProbeProgram_correct_internal fuel formula bitFuel + target hheader hbound hdepth] + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonRepr.lean b/Complexitylib/Circuits/BarringtonRepr.lean index 5c398730..5b887f76 100644 --- a/Complexitylib/Circuits/BarringtonRepr.lean +++ b/Complexitylib/Circuits/BarringtonRepr.lean @@ -28,9 +28,10 @@ The recursion follows the connectives directly: composed of `AND` and negation. Each step preserves representation through a genuine `5`-cycle, which is what the commutator-trick `AND` requires. -What is *not* yet established here is the `4^d` length bound (which needs the -explicit — rather than existential — construction and a size recurrence) and the -lift to nonuniform `NC¹`. Those remain open (roadmap track M3). +The length bookkeeping lives in `Circuits/BarringtonLength.lean`, where +length-preserving pointwise conjugation and compact negation sharpen this +semantic recursion to the textbook `4^d` bound. The nonuniform family lift and +converse live in `BarringtonFamily.lean` and `BarringtonConverse.lean`. ## Main results diff --git a/Complexitylib/Circuits/BarringtonSlotQuery.lean b/Complexitylib/Circuits/BarringtonSlotQuery.lean new file mode 100644 index 00000000..909bec85 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonSlotQuery.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonSlotQuery.Defs +import Complexitylib.Circuits.BarringtonSlotQuery.Internal + +/-! +# Direct queries into fixed-address Barrington slots + +`barringtonCompileSlot?` locates one instruction in the depth-bounded fixed +schedule without constructing the complete recursive list. Its structural +first- and last-occupied-address recurrences are independent of the target +permutation, so they are suitable for a finite-state machine controller. + +## Main results + +- `barringtonFirstOccupiedSlot?_eq` -- the structural first address is exact. +- `barringtonLastOccupiedSlot?_eq` -- the structural last address is exact. +- `barringtonCompileSlotsNonempty_eq` -- the small nonemptiness recurrence is + exact. +- `barringtonCompileSlotOccupied_eq` -- the target-free Boolean slot query is + exact. +- `barringtonCompileSlot?_eq_instruction?` -- every direct query agrees with + the list-valued fixed-slot compiler. +- `BPInstrTransform.apply_invertOutput` and `apply_postMulOutput` -- the finite + pending-transform state realizes the two instruction wrappers used during + recursive descent. +- `BarringtonSlotCursor.localSlot_succ` and `localSlot_descend` -- the current + base-four digit selects one of four child blocks, while inverse blocks are + tracked by one reflection bit and the original numeric slot remains fixed. +- `BarringtonSlotCursor.selectsRight_eq_rawLowBit` and + `selectsInverse_eq_rawHighBit` -- those two finite branch decisions are the + corresponding binary address bits, xor the reflection flag. +-/ + +namespace Complexity + +/-- The identity finite-control transformation leaves an instruction fixed. -/ +@[simp] theorem BPInstrTransform.apply_identity (instruction : BPInstr 5) : + BPInstrTransform.identity.apply instruction = instruction := + BPInstrTransform.apply_identity_internal instruction + +/-- Updating finite control for an inverse block is exactly instruction +inversion after the previously accumulated transformation. -/ +@[simp] theorem BPInstrTransform.apply_invertOutput + (transform : BPInstrTransform) (instruction : BPInstr 5) : + transform.invertOutput.apply instruction = + (transform.apply instruction).inverse := + BPInstrTransform.apply_invertOutput_internal transform instruction + +/-- Updating finite control at the last occupied slot is exactly +postmultiplication after the previously accumulated transformation. -/ +@[simp] theorem BPInstrTransform.apply_postMulOutput + (transform : BPInstrTransform) (instruction : BPInstr 5) + (permutation : Equiv.Perm (Fin 5)) : + (transform.postMulOutput permutation).apply instruction = + (transform.apply instruction).postMul permutation := + BPInstrTransform.apply_postMulOutput_internal transform instruction + permutation + +/-- Pending permutation transformations never change the queried variable. -/ +@[simp] theorem BPInstrTransform.apply_var + (transform : BPInstrTransform) (instruction : BPInstr 5) : + (transform.apply instruction).var = instruction.var := + BPInstrTransform.apply_var_internal transform instruction + +/-- Every raw base-four address digit lies in its four-element alphabet. -/ +theorem BarringtonSlotCursor.rawDigit_lt + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.rawDigit fuel < 4 := + BarringtonSlotCursor.rawDigit_lt_internal cursor fuel + +/-- Reflection preserves the four-element range of the current digit. -/ +theorem BarringtonSlotCursor.digit_lt + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.digit fuel < 4 := + BarringtonSlotCursor.digit_lt_internal cursor fuel + +/-- The low bit of the current base-four digit is the binary slot bit at +position `2 * fuel`. -/ +theorem BarringtonSlotCursor.rawLowBit_eq_testBit + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.rawLowBit fuel = (cursor.rawDigit fuel).testBit 0 := + BarringtonSlotCursor.rawLowBit_eq_testBit_internal cursor fuel + +/-- The high bit of the current base-four digit is the binary slot bit at +position `2 * fuel + 1`. -/ +theorem BarringtonSlotCursor.rawHighBit_eq_testBit + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.rawHighBit fuel = (cursor.rawDigit fuel).testBit 1 := + BarringtonSlotCursor.rawHighBit_eq_testBit_internal cursor fuel + +/-- Right-child selection needs only the low raw address bit and the finite +reflection flag. -/ +theorem BarringtonSlotCursor.selectsRight_eq_rawLowBit + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.selectsRight fuel = + (cursor.rawLowBit fuel != cursor.reversed) := + BarringtonSlotCursor.selectsRight_eq_rawLowBit_internal cursor fuel + +/-- Inverse-block selection needs only the high raw address bit and the finite +reflection flag. -/ +theorem BarringtonSlotCursor.selectsInverse_eq_rawHighBit + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.selectsInverse fuel = + (cursor.rawHighBit fuel != cursor.reversed) := + BarringtonSlotCursor.selectsInverse_eq_rawHighBit_internal cursor fuel + +/-- After descending, the next reflection flag is exactly the raw high bit of +the block just selected; no reflection stack is required. -/ +theorem BarringtonSlotCursor.descend_reversed + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + (cursor.descend fuel).reversed = cursor.rawHighBit fuel := + BarringtonSlotCursor.descend_reversed_internal cursor fuel + +/-- The represented local address always fits in the remaining base-four +block. -/ +theorem BarringtonSlotCursor.localSlot_lt + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.localSlot fuel < 4 ^ fuel := + BarringtonSlotCursor.localSlot_lt_internal cursor fuel + +/-- The effective address splits exactly into its current base-four block and +the remaining local address. -/ +theorem BarringtonSlotCursor.localSlot_succ + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.localSlot (fuel + 1) = + cursor.digit fuel * 4 ^ fuel + cursor.localSlot fuel := + BarringtonSlotCursor.localSlot_succ_internal cursor fuel + +/-- Descending preserves the original stored address and toggles reflection +exactly when the selected child block is inverse. -/ +theorem BarringtonSlotCursor.localSlot_descend + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + (cursor.descend fuel).localSlot fuel = + if cursor.selectsInverse fuel then + 4 ^ fuel - 1 - cursor.localSlot fuel + else + cursor.localSlot fuel := + BarringtonSlotCursor.localSlot_descend_internal cursor fuel + +/-- The structural first-address recurrence finds the first occupied slot of +the list-valued fixed schedule. -/ +theorem barringtonFirstOccupiedSlot?_eq (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + barringtonFirstOccupiedSlot? fuel formula = + BPSlots.firstOccupiedSlot? + (barringtonCompileSlots fuel formula target) := + (barringtonOccupiedSlots_correct_internal fuel formula target).1 + +/-- The structural last-address recurrence finds the last occupied slot of +the list-valued fixed schedule. -/ +theorem barringtonLastOccupiedSlot?_eq (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + barringtonLastOccupiedSlot? fuel formula = + BPSlots.lastOccupiedSlot? + (barringtonCompileSlots fuel formula target) := + (barringtonOccupiedSlots_correct_internal fuel formula target).2 + +/-- The target-independent nonemptiness recurrence agrees with either +structural extreme-address query. -/ +theorem barringtonCompileSlotsNonempty_eq (fuel : ℕ) + (formula : BoolFormula) : + barringtonCompileSlotsNonempty fuel formula = + (barringtonFirstOccupiedSlot? fuel formula).isSome ∧ + barringtonCompileSlotsNonempty fuel formula = + (barringtonLastOccupiedSlot? fuel formula).isSome := + barringtonCompileSlotsNonempty_correct_internal fuel formula + +/-- The target-free Boolean occupancy query agrees with the instruction query +at every fixed address. -/ +theorem barringtonCompileSlotOccupied_eq (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (slot : ℕ) : + barringtonCompileSlotOccupied fuel formula slot = + (BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot).isSome := by + rw [barringtonCompileSlotOccupied_correct_internal] + rw [barringtonCompileSlot?_correct_internal] + +/-- Every direct fixed-address query agrees with the corresponding query into +the list-valued fixed schedule. -/ +theorem barringtonCompileSlot?_eq_instruction? (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (slot : ℕ) : + barringtonCompileSlot? fuel formula target slot = + BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot := + barringtonCompileSlot?_correct_internal fuel formula target slot + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonSlotQuery/Defs.lean b/Complexitylib/Circuits/BarringtonSlotQuery/Defs.lean new file mode 100644 index 00000000..5cff2fb9 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonSlotQuery/Defs.lean @@ -0,0 +1,384 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonSlots.Defs + +/-! +# Direct queries into fixed-address Barrington slots -- definitions + +The list-valued fixed-slot compiler is the extensional reference for uniform +generation, but a log-space controller must locate one slot without building +the full list. This file gives structural first/last occupied-slot recurrences +and a direct indexed query. Every recursive query descends under a strictly +smaller fuel bound; inverse blocks reverse the local address, while `postMul` +uses the structural last occupied address. +-/ + +namespace Complexity + +namespace BPSlots + +/-- Occupied instruction at a zero-based fixed-slot address. -/ +def instruction? (slots : BPSlots w) (slot : ℕ) : Option (BPInstr w) := + slots[slot]?.join + +/-- First occupied fixed-slot address, if one exists. -/ +def firstOccupiedSlot? : BPSlots w → Option ℕ + | [] => none + | none :: slots => (firstOccupiedSlot? slots).map Nat.succ + | some _ :: _ => some 0 + +/-- Last occupied fixed-slot address, if one exists. -/ +def lastOccupiedSlot? : BPSlots w → Option ℕ + | [] => none + | slot :: slots => + match lastOccupiedSlot? slots with + | some last => some (last + 1) + | none => if slot.isSome then some 0 else none + +end BPSlots + +/-- Finite-control transformation accumulated while a direct Barrington query +descends through inverse blocks and postmultiplication wrappers. + +Both branches of an instruction undergo the same map +`p ↦ left * p^(±1) * right`; the variable index is unchanged. Since every +field is finite at width five, the complete transformation can live in a +Turing machine's finite state. -/ +structure BPInstrTransform where + /-- Whether to invert the selected permutation before multiplying. -/ + inverted : Bool + /-- Fixed permutation multiplied on the left. -/ + left : Equiv.Perm (Fin 5) + /-- Fixed permutation multiplied on the right. -/ + right : Equiv.Perm (Fin 5) + deriving DecidableEq + +instance : Fintype BPInstrTransform := + Fintype.ofEquiv + (Bool × Equiv.Perm (Fin 5) × Equiv.Perm (Fin 5)) + { toFun := fun data => + { inverted := data.1, left := data.2.1, right := data.2.2 } + invFun := fun transform => + (transform.inverted, transform.left, transform.right) + left_inv := fun data => by cases data; rfl + right_inv := fun transform => by cases transform; rfl } + +/-- Apply a pending finite-control transformation to one permutation. -/ +def BPInstrTransform.applyPerm (transform : BPInstrTransform) + (permutation : Equiv.Perm (Fin 5)) : Equiv.Perm (Fin 5) := + transform.left * + (if transform.inverted then permutation⁻¹ else permutation) * + transform.right + +/-- Apply a pending finite-control transformation to both instruction +branches while preserving its variable index. -/ +def BPInstrTransform.apply (transform : BPInstrTransform) + (instruction : BPInstr 5) : BPInstr 5 := + { instruction with + perm0 := transform.applyPerm instruction.perm0 + perm1 := transform.applyPerm instruction.perm1 } + +/-- Identity pending transformation. -/ +def BPInstrTransform.identity : BPInstrTransform := + { inverted := false, left := 1, right := 1 } + +/-- Update a pending transformation when the enclosing block inverts the +instruction selected below it. -/ +def BPInstrTransform.invertOutput (transform : BPInstrTransform) : + BPInstrTransform := + { inverted := !transform.inverted + left := transform.right⁻¹ + right := transform.left⁻¹ } + +/-- Update a pending transformation when the selected instruction is the last +occupied slot of a postmultiplication wrapper. -/ +def BPInstrTransform.postMulOutput (transform : BPInstrTransform) + (permutation : Equiv.Perm (Fin 5)) : BPInstrTransform := + { transform with right := transform.right * permutation } + +/-- Stack-free address state for direct Barrington descent. The original slot +stays fixed; `reversed` records whether the remaining low base-four digits are +read in reverse order because the path entered an inverse block. -/ +structure BarringtonSlotCursor where + /-- Original fixed-schedule slot address. -/ + slot : ℕ + /-- Whether the remaining local address is reflected. -/ + reversed : Bool + deriving DecidableEq + +/-- Raw base-four digit at the boundary between `fuel` lower digits and the +current digit. -/ +def BarringtonSlotCursor.rawDigit (cursor : BarringtonSlotCursor) + (fuel : ℕ) : ℕ := + cursor.slot / 4 ^ fuel % 4 + +/-- Low bit of the current raw base-four digit, read directly from the binary +slot address. -/ +def BarringtonSlotCursor.rawLowBit (cursor : BarringtonSlotCursor) + (fuel : ℕ) : Bool := + cursor.slot.testBit (2 * fuel) + +/-- High bit of the current raw base-four digit, read directly from the binary +slot address. -/ +def BarringtonSlotCursor.rawHighBit (cursor : BarringtonSlotCursor) + (fuel : ℕ) : Bool := + cursor.slot.testBit (2 * fuel + 1) + +/-- Effective current base-four digit after accounting for a pending address +reflection. -/ +def BarringtonSlotCursor.digit (cursor : BarringtonSlotCursor) + (fuel : ℕ) : ℕ := + if cursor.reversed then 3 - cursor.rawDigit fuel else cursor.rawDigit fuel + +/-- Whether the current block selects the right child. Digits zero and two +select the left child; digits one and three select the right child. -/ +def BarringtonSlotCursor.selectsRight (cursor : BarringtonSlotCursor) + (fuel : ℕ) : Bool := + cursor.digit fuel % 2 == 1 + +/-- Whether the selected child block is inverted. -/ +def BarringtonSlotCursor.selectsInverse (cursor : BarringtonSlotCursor) + (fuel : ℕ) : Bool := + decide (2 ≤ cursor.digit fuel) + +/-- Descend one base-four level without modifying the stored address. Entering +an inverse block toggles the reflection flag. -/ +def BarringtonSlotCursor.descend (cursor : BarringtonSlotCursor) + (fuel : ℕ) : BarringtonSlotCursor := + { slot := cursor.slot + reversed := cursor.reversed != cursor.selectsInverse fuel } + +/-- Effective local address represented by the lowest `fuel` base-four digits. -/ +def BarringtonSlotCursor.localSlot (cursor : BarringtonSlotCursor) + (fuel : ℕ) : ℕ := + let blockSize := 4 ^ fuel + let raw := cursor.slot % blockSize + if cursor.reversed then blockSize - 1 - raw else raw + +/-- Apply fixed-schedule `postMul` to one direct slot query. A missing last +occupied address means the underlying schedule is empty, so the wrapper places +its constant instruction in slot zero. -/ +def barringtonPostMulSlot? (query : ℕ → Option (BPInstr 5)) + (lastOccupied : Option ℕ) (permutation : Equiv.Perm (Fin 5)) + (slot : ℕ) : Option (BPInstr 5) := + match lastOccupied with + | none => if slot = 0 then some (BPInstr.const permutation) else none + | some last => + (query slot).map fun instruction => + if slot = last then instruction.postMul permutation else instruction + +/-- Query an inverse block of fixed size without constructing it. -/ +def barringtonInverseSlot? (blockSize : ℕ) + (query : ℕ → Option (BPInstr 5)) (slot : ℕ) : + Option (BPInstr 5) := + if slot < blockSize then + (query (blockSize - 1 - slot)).map BPInstr.inverse + else + none + +/-- First occupied slot of the fixed-address compilation, if any. Occupancy is +independent of the target permutation. -/ +def barringtonFirstOccupiedSlot? : ℕ → BoolFormula → Option ℕ + | _, .var _ | _, .tru => some 0 + | _, .fls => none + | 0, .neg _ | 0, .conj _ _ | 0, .disj _ _ => none + | fuel + 1, .neg formula => + some ((barringtonFirstOccupiedSlot? fuel formula).getD 0) + | fuel + 1, .conj left right => + match barringtonFirstOccupiedSlot? fuel left with + | some slot => some slot + | none => + (barringtonFirstOccupiedSlot? fuel right).map + (4 ^ fuel + ·) + | fuel + 1, .disj left _ => + some ((barringtonFirstOccupiedSlot? fuel left).getD 0) + +/-- Last occupied slot of the fixed-address compilation, if any. Inverse +blocks turn a child's first occupied address into the block's last one. -/ +def barringtonLastOccupiedSlot? : ℕ → BoolFormula → Option ℕ + | _, .var _ | _, .tru => some 0 + | _, .fls => none + | 0, .neg _ | 0, .conj _ _ | 0, .disj _ _ => none + | fuel + 1, .neg formula => + some ((barringtonLastOccupiedSlot? fuel formula).getD 0) + | fuel + 1, .conj left right => + let blockSize := 4 ^ fuel + match barringtonFirstOccupiedSlot? fuel right with + | some slot => some (3 * blockSize + (blockSize - 1 - slot)) + | none => + (barringtonFirstOccupiedSlot? fuel left).map fun slot => + 2 * blockSize + (blockSize - 1 - slot) + | fuel + 1, .disj _ right => + let blockSize := 4 ^ fuel + let firstRight := + (barringtonFirstOccupiedSlot? fuel right).getD 0 + some (3 * blockSize + (blockSize - 1 - firstRight)) + +/-- Whether the fixed-address compilation has any occupied slot. This +target-independent recurrence is smaller than computing either extreme +address: negation and disjunction are automatically nonempty after their +postmultiplications, while conjunction is nonempty exactly when one child is. -/ +def barringtonCompileSlotsNonempty : ℕ → BoolFormula → Bool + | _, .var _ | _, .tru => true + | _, .fls => false + | 0, .neg _ | 0, .conj _ _ | 0, .disj _ _ => false + | _ + 1, .neg _ | _ + 1, .disj _ _ => true + | fuel + 1, .conj left right => + barringtonCompileSlotsNonempty fuel left || + barringtonCompileSlotsNonempty fuel right + +/-- Occupancy after a fixed-schedule postmultiplication. An empty source gains +a constant instruction at address zero; a nonempty source retains exactly its +occupied addresses. -/ +def barringtonPostMulSlotOccupied (nonempty : Bool) + (occupied : ℕ → Bool) (slot : ℕ) : Bool := + if nonempty then occupied slot else slot == 0 + +/-- Occupancy of a reversed fixed-size block. Instruction inversion does not +affect occupancy. -/ +def barringtonInverseSlotOccupied (blockSize : ℕ) + (occupied : ℕ → Bool) (slot : ℕ) : Bool := + if slot < blockSize then occupied (blockSize - 1 - slot) else false + +/-- First true address below a fixed bound, queried without materializing the +Boolean list. Recursive calls shift the query so the result remains local. -/ +def firstTrueSlot? : ℕ → (ℕ → Bool) → Option ℕ + | 0, _ => none + | bound + 1, occupied => + if occupied 0 then some 0 + else (firstTrueSlot? bound fun slot => occupied (slot + 1)).map Nat.succ + +/-- Last true address below a fixed bound, queried without materializing the +Boolean list. -/ +def lastTrueSlot? : ℕ → (ℕ → Bool) → Option ℕ + | 0, _ => none + | bound + 1, occupied => + match lastTrueSlot? bound fun slot => occupied (slot + 1) with + | some slot => some (slot + 1) + | none => if occupied 0 then some 0 else none + +/-- Query only whether one fixed Barrington address is occupied. Unlike the +instruction query below, this recurrence carries no permutation and performs +no first/last-address query. It is therefore the small Boolean kernel used by +the eventual scanning controller. -/ +def barringtonCompileSlotOccupied : ℕ → BoolFormula → ℕ → Bool + | _, .var _, slot | _, .tru, slot => slot == 0 + | _, .fls, _ => false + | 0, .neg _, _ | 0, .conj _ _, _ | 0, .disj _ _, _ => false + | fuel + 1, .neg formula, slot => + let blockSize := 4 ^ fuel + if slot < blockSize then + barringtonPostMulSlotOccupied + (barringtonCompileSlotsNonempty fuel formula) + (barringtonCompileSlotOccupied fuel formula) slot + else + false + | fuel + 1, .conj left right, slot => + let blockSize := 4 ^ fuel + let leftOccupied := barringtonCompileSlotOccupied fuel left + let rightOccupied := barringtonCompileSlotOccupied fuel right + if slot < blockSize then + leftOccupied slot + else if slot < 2 * blockSize then + rightOccupied (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlotOccupied blockSize leftOccupied + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlotOccupied blockSize rightOccupied + (slot - 3 * blockSize) + else + false + | fuel + 1, .disj left right, slot => + let blockSize := 4 ^ fuel + let leftOccupied := barringtonPostMulSlotOccupied + (barringtonCompileSlotsNonempty fuel left) + (barringtonCompileSlotOccupied fuel left) + let rightOccupied := barringtonPostMulSlotOccupied + (barringtonCompileSlotsNonempty fuel right) + (barringtonCompileSlotOccupied fuel right) + if slot < blockSize then + leftOccupied slot + else if slot < 2 * blockSize then + rightOccupied (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlotOccupied blockSize leftOccupied + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlotOccupied blockSize rightOccupied + (slot - 3 * blockSize) + else + false + +/-- Directly query one fixed-address compilation slot. This follows only the +selected base-four block. The finite permutation data and pending instruction +transformations can therefore live in a concrete controller's finite state. -/ +def barringtonCompileSlot? : ℕ → BoolFormula → + Equiv.Perm (Fin 5) → ℕ → Option (BPInstr 5) + | _, .var index, target, slot => + if slot = 0 then some ⟨index, 1, target⟩ else none + | _, .tru, target, slot => + if slot = 0 then some (BPInstr.const target) else none + | _, .fls, _, _ => none + | 0, .neg _, _, _ | 0, .conj _ _, _, _ | 0, .disj _ _, _, _ => none + | fuel + 1, .neg formula, target, slot => + let blockSize := 4 ^ fuel + if slot < blockSize then + barringtonPostMulSlot? + (barringtonCompileSlot? fuel formula target⁻¹) + (barringtonLastOccupiedSlot? fuel formula) target slot + else + none + | fuel + 1, .conj left right, target, slot => + let blockSize := 4 ^ fuel + let leftQuery := + barringtonCompileSlot? fuel left (barringtonLeft target) + let rightQuery := + barringtonCompileSlot? fuel right (barringtonRight target) + if slot < blockSize then + leftQuery slot + else if slot < 2 * blockSize then + rightQuery (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (slot - 3 * blockSize) + else + none + | fuel + 1, .disj left right, target, slot => + let blockSize := 4 ^ fuel + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftQuery := barringtonPostMulSlot? + (barringtonCompileSlot? fuel left leftTarget⁻¹) + (barringtonLastOccupiedSlot? fuel left) leftTarget + let rightQuery := barringtonPostMulSlot? + (barringtonCompileSlot? fuel right rightTarget⁻¹) + (barringtonLastOccupiedSlot? fuel right) rightTarget + let commutatorQuery := fun localSlot => + if localSlot < blockSize then + leftQuery localSlot + else if localSlot < 2 * blockSize then + rightQuery (localSlot - blockSize) + else if localSlot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (localSlot - 2 * blockSize) + else if localSlot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (localSlot - 3 * blockSize) + else + none + let firstRight := + (barringtonFirstOccupiedSlot? fuel right).getD 0 + let commutatorLast := + 3 * blockSize + (blockSize - 1 - firstRight) + barringtonPostMulSlot? commutatorQuery (some commutatorLast) + target slot + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonSlotQuery/Internal.lean b/Complexitylib/Circuits/BarringtonSlotQuery/Internal.lean new file mode 100644 index 00000000..efd50799 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonSlotQuery/Internal.lean @@ -0,0 +1,1401 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonSlotQuery.Defs +import Complexitylib.Circuits.BarringtonSlots.Internal + +/-! +# Direct queries into fixed-address Barrington slots -- proof internals +-/ + +namespace Complexity + +namespace BPSlots + +@[simp] theorem firstOccupiedSlot?_replicate_none_internal (count : ℕ) : + firstOccupiedSlot? + (List.replicate count (none : Option (BPInstr w))) = none := by + induction count with + | zero => rfl + | succ count ih => + change (firstOccupiedSlot? + (List.replicate count (none : Option (BPInstr w)))).map Nat.succ = none + rw [ih] + rfl + +@[simp] theorem lastOccupiedSlot?_replicate_none_internal (count : ℕ) : + lastOccupiedSlot? + (List.replicate count (none : Option (BPInstr w))) = none := by + induction count with + | zero => rfl + | succ count ih => + change (match lastOccupiedSlot? + (List.replicate count (none : Option (BPInstr w))) with + | some last => some (last + 1) + | none => none) = none + rw [ih] + +theorem firstOccupiedSlot?_append_internal + (left right : BPSlots w) : + firstOccupiedSlot? (left ++ right) = + match firstOccupiedSlot? left with + | some slot => some slot + | none => (firstOccupiedSlot? right).map (left.length + ·) := by + induction left with + | nil => simp [firstOccupiedSlot?] + | cons slot left ih => + cases slot with + | none => + simp only [List.cons_append, firstOccupiedSlot?, List.length_cons] + rw [ih] + cases hleft : firstOccupiedSlot? left with + | none => + cases hright : firstOccupiedSlot? right with + | none => simp + | some rightSlot => simp; omega + | some leftSlot => + cases hright : firstOccupiedSlot? right <;> simp + | some instruction => rfl + +theorem lastOccupiedSlot?_append_internal + (left right : BPSlots w) : + lastOccupiedSlot? (left ++ right) = + match lastOccupiedSlot? right with + | some slot => some (left.length + slot) + | none => lastOccupiedSlot? left := by + induction left with + | nil => + simp only [List.nil_append, List.length_nil, Nat.zero_add] + cases lastOccupiedSlot? right <;> rfl + | cons slot left ih => + simp only [List.cons_append, lastOccupiedSlot?, List.length_cons] + rw [ih] + cases hright : lastOccupiedSlot? right with + | some rightSlot => simp; omega + | none => rfl + +theorem firstOccupiedSlot?_eq_none_iff_internal (slots : BPSlots w) : + firstOccupiedSlot? slots = none ↔ slots.filterMap id = [] := by + induction slots with + | nil => simp [firstOccupiedSlot?] + | cons slot slots ih => + cases slot <;> simp [firstOccupiedSlot?, ih] + +theorem lastOccupiedSlot?_eq_none_iff_internal (slots : BPSlots w) : + lastOccupiedSlot? slots = none ↔ slots.filterMap id = [] := by + induction slots with + | nil => simp [lastOccupiedSlot?] + | cons slot slots ih => + cases hlast : lastOccupiedSlot? slots with + | none => + have hfilter : slots.filterMap id = [] := + (ih.mp hlast) + cases slot with + | none => + rw [List.filterMap_cons_none rfl] + constructor + · intro _ + exact hfilter + · intro _ + simp [lastOccupiedSlot?, hlast] + | some instruction => + change lastOccupiedSlot? (some instruction :: slots) = none ↔ + instruction :: slots.filterMap id = [] + constructor <;> intro h + · simp [lastOccupiedSlot?, hlast] at h + · simp at h + | some last => + have hfilter : slots.filterMap id ≠ [] := by + intro hempty + exact Option.some_ne_none last + (hlast.symm.trans (ih.mpr hempty)) + cases slot with + | none => + rw [List.filterMap_cons_none rfl] + constructor + · intro hnone + simp [lastOccupiedSlot?, hlast] at hnone + · intro hempty + exact (hfilter hempty).elim + | some instruction => + change lastOccupiedSlot? (some instruction :: slots) = none ↔ + instruction :: slots.filterMap id = [] + constructor + · intro hnone + simp [lastOccupiedSlot?, hlast] at hnone + · intro hempty + simp at hempty + +theorem lastOccupiedSlot?_eq_none_iff_first_internal (slots : BPSlots w) : + lastOccupiedSlot? slots = none ↔ firstOccupiedSlot? slots = none := + (lastOccupiedSlot?_eq_none_iff_internal slots).trans + (firstOccupiedSlot?_eq_none_iff_internal slots).symm + +theorem firstOccupiedSlot?_lt_length_internal + {slots : BPSlots w} {slot : ℕ} + (hslot : firstOccupiedSlot? slots = some slot) : + slot < slots.length := by + induction slots generalizing slot with + | nil => simp [firstOccupiedSlot?] at hslot + | cons head slots ih => + cases head with + | none => + simp only [firstOccupiedSlot?] at hslot + cases hfirst : firstOccupiedSlot? slots with + | none => simp [hfirst] at hslot + | some first => + simp [hfirst] at hslot + subst slot + simpa using Nat.succ_lt_succ (ih hfirst) + | some instruction => + simp [firstOccupiedSlot?] at hslot + subst slot + simp + +theorem lastOccupiedSlot?_lt_length_internal + {slots : BPSlots w} {slot : ℕ} + (hslot : lastOccupiedSlot? slots = some slot) : + slot < slots.length := by + induction slots generalizing slot with + | nil => simp [lastOccupiedSlot?] at hslot + | cons head slots ih => + simp only [lastOccupiedSlot?] at hslot + cases hlast : lastOccupiedSlot? slots with + | some last => + simp [hlast] at hslot + subst slot + simpa using Nat.succ_lt_succ (ih hlast) + | none => + simp only [hlast] at hslot + split at hslot + · simp at hslot + subst slot + simp + · simp at hslot + +theorem firstOccupiedSlot?_map_internal + (slots : BPSlots w) (f : BPInstr w → BPInstr v) : + firstOccupiedSlot? (slots.map (Option.map f)) = + firstOccupiedSlot? slots := by + induction slots with + | nil => rfl + | cons slot slots ih => + cases slot <;> simp [firstOccupiedSlot?, ih] + +theorem lastOccupiedSlot?_map_internal + (slots : BPSlots w) (f : BPInstr w → BPInstr v) : + lastOccupiedSlot? (slots.map (Option.map f)) = + lastOccupiedSlot? slots := by + induction slots with + | nil => rfl + | cons slot slots ih => + cases slot <;> simp [lastOccupiedSlot?, ih] + +theorem firstOccupiedSlot?_reverse_internal (slots : BPSlots w) : + firstOccupiedSlot? slots.reverse = + (lastOccupiedSlot? slots).map fun slot => + slots.length - 1 - slot := by + induction slots with + | nil => rfl + | cons head slots ih => + rw [List.reverse_cons, firstOccupiedSlot?_append_internal, ih] + cases hlast : lastOccupiedSlot? slots with + | some last => + simp only [lastOccupiedSlot?, hlast, Option.map_some, + List.length_cons] + congr 1 + rw [Nat.add_sub_cancel, Nat.sub_sub] + simp [Nat.add_comm] + | none => + cases head <;> + simp [firstOccupiedSlot?, lastOccupiedSlot?, hlast] + +theorem lastOccupiedSlot?_reverse_internal (slots : BPSlots w) : + lastOccupiedSlot? slots.reverse = + (firstOccupiedSlot? slots).map fun slot => + slots.length - 1 - slot := by + induction slots with + | nil => rfl + | cons head slots ih => + rw [List.reverse_cons, lastOccupiedSlot?_append_internal] + cases head with + | some instruction => simp [firstOccupiedSlot?, lastOccupiedSlot?] + | none => + cases hfirst : firstOccupiedSlot? slots with + | none => + simp [lastOccupiedSlot?, firstOccupiedSlot?, ih, hfirst] + | some first => + have hlt := firstOccupiedSlot?_lt_length_internal hfirst + simp [lastOccupiedSlot?, firstOccupiedSlot?, ih, hfirst] + omega + +theorem firstOccupiedSlot?_inverse_internal (slots : BPSlots w) : + firstOccupiedSlot? slots.inverse = + (lastOccupiedSlot? slots).map fun slot => + slots.length - 1 - slot := by + rw [BPSlots.inverse, firstOccupiedSlot?_reverse_internal, + lastOccupiedSlot?_map_internal] + simp + +theorem lastOccupiedSlot?_inverse_internal (slots : BPSlots w) : + lastOccupiedSlot? slots.inverse = + (firstOccupiedSlot? slots).map fun slot => + slots.length - 1 - slot := by + rw [BPSlots.inverse, lastOccupiedSlot?_reverse_internal, + firstOccupiedSlot?_map_internal] + simp + +theorem firstOccupiedSlot?_postMulFirst_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) : + firstOccupiedSlot? (postMulFirst permutation slots) = + firstOccupiedSlot? slots := by + induction slots with + | nil => rfl + | cons slot slots ih => + cases slot <;> simp [postMulFirst, firstOccupiedSlot?, ih] + +theorem lastOccupiedSlot?_postMulFirst_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) : + lastOccupiedSlot? (postMulFirst permutation slots) = + lastOccupiedSlot? slots := by + induction slots with + | nil => rfl + | cons slot slots ih => + cases slot <;> simp [postMulFirst, lastOccupiedSlot?, ih] + +theorem firstOccupiedSlot?_postMul_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) (hne : slots ≠ []) : + firstOccupiedSlot? (slots.postMul permutation) = + some ((firstOccupiedSlot? slots).getD 0) := by + rw [BPSlots.postMul.eq_def] + split + · rename_i hempty + cases slots with + | nil => exact (hne rfl).elim + | cons slot slots => + have hfirst : firstOccupiedSlot? (slot :: slots) = none := + firstOccupiedSlot?_eq_none_iff_internal _ |>.2 hempty + cases slot with + | none => + have htail : firstOccupiedSlot? slots = none := by + simpa [firstOccupiedSlot?] using hfirst + simp [firstOccupiedSlot?, htail] + | some instruction => simp [firstOccupiedSlot?] at hfirst + · rename_i hnonempty + rw [firstOccupiedSlot?_reverse_internal, + lastOccupiedSlot?_postMulFirst_internal, + lastOccupiedSlot?_reverse_internal] + cases hfirst : firstOccupiedSlot? slots with + | none => + exact (hnonempty + (firstOccupiedSlot?_eq_none_iff_internal _ |>.1 hfirst)).elim + | some first => + have hlt := firstOccupiedSlot?_lt_length_internal hfirst + simp only [Option.map_some, List.length_reverse, + BPSlots.length_postMulFirst_internal, Option.getD_some] + congr 2 + omega + +theorem lastOccupiedSlot?_postMul_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) (hne : slots ≠ []) : + lastOccupiedSlot? (slots.postMul permutation) = + some ((lastOccupiedSlot? slots).getD 0) := by + rw [BPSlots.postMul.eq_def] + split + · rename_i hempty + cases slots with + | nil => exact (hne rfl).elim + | cons slot slots => + have hrest : slots.filterMap id = [] := by + cases slot with + | none => simpa using hempty + | some instruction => simp at hempty + have hlast : lastOccupiedSlot? slots = none := + lastOccupiedSlot?_eq_none_iff_internal _ |>.2 hrest + cases slot with + | none => simp [lastOccupiedSlot?, hlast] + | some instruction => simp at hempty + · rename_i hnonempty + rw [lastOccupiedSlot?_reverse_internal, + firstOccupiedSlot?_postMulFirst_internal, + firstOccupiedSlot?_reverse_internal] + cases hlast : lastOccupiedSlot? slots with + | none => + exact (hnonempty + (lastOccupiedSlot?_eq_none_iff_internal _ |>.1 hlast)).elim + | some last => + have hlt := lastOccupiedSlot?_lt_length_internal hlast + simp only [Option.map_some, List.length_reverse, + BPSlots.length_postMulFirst_internal, Option.getD_some] + congr 2 + omega + +theorem instruction?_append_internal (left right : BPSlots w) + (slot : ℕ) : + instruction? (left ++ right) slot = + if slot < left.length then instruction? left slot + else instruction? right (slot - left.length) := by + rw [instruction?, List.getElem?_append] + split <;> rfl + +@[simp] theorem instruction?_replicate_none_internal + (count slot : ℕ) : + instruction? + (List.replicate count (none : Option (BPInstr w))) slot = none := by + rw [instruction?, List.getElem?_replicate] + split <;> rfl + +theorem instruction?_singletonAt_internal (fuel : ℕ) + (instruction : BPInstr w) (slot : ℕ) : + instruction? (singletonAt fuel instruction) slot = + if slot = 0 then some instruction else none := by + cases slot with + | zero => rfl + | succ slot => + rw [if_neg (by omega)] + exact instruction?_replicate_none_internal _ _ + +theorem instruction?_emptyAt_internal (fuel slot : ℕ) : + instruction? (emptyAt fuel : BPSlots w) slot = none := + instruction?_replicate_none_internal _ _ + +theorem instruction?_eq_none_of_first_eq_none_internal + {slots : BPSlots w} + (hfirst : firstOccupiedSlot? slots = none) (slot : ℕ) : + instruction? slots slot = none := by + induction slots generalizing slot with + | nil => simp [instruction?] + | cons head slots ih => + cases head with + | some instruction => simp [firstOccupiedSlot?] at hfirst + | none => + have htail : firstOccupiedSlot? slots = none := by + simpa [firstOccupiedSlot?] using hfirst + cases slot with + | zero => rfl + | succ slot => + simpa [instruction?] using ih htail slot + +theorem instruction?_postMulFirst_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) (slot : ℕ) : + instruction? (postMulFirst permutation slots) slot = + match firstOccupiedSlot? slots with + | none => instruction? slots slot + | some first => + (instruction? slots slot).map fun instruction => + if slot = first then instruction.postMul permutation + else instruction := by + induction slots generalizing slot with + | nil => simp [postMulFirst, firstOccupiedSlot?, instruction?] + | cons head slots ih => + cases head with + | some instruction => + cases slot <;> + simp [postMulFirst, firstOccupiedSlot?, instruction?] + | none => + cases slot with + | zero => + simp only [postMulFirst, firstOccupiedSlot?, instruction?] + cases firstOccupiedSlot? slots <;> rfl + | succ slot => + change instruction? (postMulFirst permutation slots) slot = + match (firstOccupiedSlot? slots).map Nat.succ with + | none => instruction? slots slot + | some first => + (instruction? slots slot).map fun instruction => + if slot + 1 = first then + instruction.postMul permutation else instruction + rw [ih] + cases hfirst : firstOccupiedSlot? slots with + | none => rfl + | some first => simp + +theorem instruction?_reverse_internal (slots : BPSlots w) (slot : ℕ) : + instruction? slots.reverse slot = + if slot < slots.length then + instruction? slots (slots.length - 1 - slot) + else + none := by + by_cases hslot : slot < slots.length + · rw [if_pos hslot, instruction?, + List.getElem?_reverse (l := slots) (i := slot) hslot] + rfl + · rw [if_neg hslot, instruction?] + have hlength : slots.reverse.length ≤ slot := by simp; omega + rw [List.getElem?_eq_none hlength] + rfl + +theorem instruction?_inverse_internal (slots : BPSlots w) (slot : ℕ) : + instruction? slots.inverse slot = + if slot < slots.length then + (instruction? slots (slots.length - 1 - slot)).map + BPInstr.inverse + else + none := by + rw [BPSlots.inverse] + by_cases hslot : slot < slots.length + · rw [if_pos hslot] + have hmapLength : + (slots.map fun entry => entry.map BPInstr.inverse).length = + slots.length := by simp + have hreverse := List.getElem?_reverse + (l := slots.map fun entry => entry.map BPInstr.inverse) + (i := slot) (by simpa [hmapLength] using hslot) + simp only [instruction?, hreverse, hmapLength, List.getElem?_map] + cases slots[slots.length - 1 - slot]? <;> rfl + · rw [if_neg hslot] + apply Option.eq_none_iff_forall_not_mem.mpr + intro instruction hinstruction + have hlength : + (slots.map fun entry => entry.map BPInstr.inverse).reverse.length ≤ + slot := by simp; omega + rw [instruction?, List.getElem?_eq_none hlength] at hinstruction + simp at hinstruction + +theorem barringtonPostMulSlot?_correct_internal + (slots : BPSlots 5) (permutation : Equiv.Perm (Fin 5)) + (slot : ℕ) (hne : slots ≠ []) : + barringtonPostMulSlot? (instruction? slots) + (lastOccupiedSlot? slots) permutation slot = + instruction? (slots.postMul permutation) slot := by + rw [BPSlots.postMul.eq_def] + by_cases hempty : slots.filterMap id = [] + · rw [if_pos hempty] + have hlast : lastOccupiedSlot? slots = none := + lastOccupiedSlot?_eq_none_iff_internal slots |>.2 hempty + rw [barringtonPostMulSlot?.eq_def, hlast] + cases slots with + | nil => exact (hne rfl).elim + | cons head slots => + have hhead : head = none := by + have hall := List.filterMap_eq_nil_iff.mp hempty head + (by simp) + simpa using hall + subst head + have hrestFilter : slots.filterMap id = [] := by + simpa using hempty + have hrestFirst : firstOccupiedSlot? slots = none := + firstOccupiedSlot?_eq_none_iff_internal slots |>.2 hrestFilter + cases slot with + | zero => rfl + | succ slot => + rw [if_neg (by omega)] + simpa [instruction?] using + (instruction?_eq_none_of_first_eq_none_internal + hrestFirst slot).symm + · rw [if_neg hempty] + cases hlast : lastOccupiedSlot? slots with + | none => + exact (hempty + (lastOccupiedSlot?_eq_none_iff_internal slots |>.1 hlast)).elim + | some last => + have hlastLt := lastOccupiedSlot?_lt_length_internal hlast + simp only [barringtonPostMulSlot?.eq_def] + by_cases hslot : slot < slots.length + · rw [instruction?_reverse_internal] + rw [if_pos (by + simpa [BPSlots.length_postMulFirst_internal] using hslot)] + simp only [List.length_reverse, + BPSlots.length_postMulFirst_internal] + rw [instruction?_postMulFirst_internal, + firstOccupiedSlot?_reverse_internal, hlast] + simp only [Option.map_some] + have hreversedLt : slots.length - 1 - slot < slots.length := by + omega + rw [instruction?_reverse_internal, + if_pos hreversedLt] + have hdouble : + slots.length - 1 - (slots.length - 1 - slot) = slot := by + omega + rw [hdouble] + by_cases heq : slot = last + · subst last + simp + · have hreverseNe : + slots.length - 1 - slot ≠ + slots.length - 1 - last := by + omega + simp [heq, hreverseNe] + · have hquery : instruction? slots slot = none := by + rw [instruction?] + exact congrArg Option.join + (List.getElem?_eq_none (by omega)) + rw [hquery] + simp only [Option.map_none] + rw [instruction?_reverse_internal] + rw [if_neg (by + simp [BPSlots.length_postMulFirst_internal] + omega)] + +theorem barringtonInverseSlot?_correct_internal + (slots : BPSlots 5) (slot : ℕ) : + barringtonInverseSlot? slots.length (instruction? slots) slot = + instruction? slots.inverse slot := by + rw [barringtonInverseSlot?, instruction?_inverse_internal] + +theorem instruction?_fourBlocks_internal + (left right : BPSlots 5) (blockSize slot : ℕ) + (hleftLength : left.length = blockSize) + (hrightLength : right.length = blockSize) : + instruction? + (left ++ right ++ left.inverse ++ right.inverse) slot = + if slot < blockSize then + instruction? left slot + else if slot < 2 * blockSize then + instruction? right (slot - blockSize) + else if slot < 3 * blockSize then + instruction? left.inverse (slot - 2 * blockSize) + else if slot < 4 * blockSize then + instruction? right.inverse (slot - 3 * blockSize) + else + none := by + rw [instruction?_append_internal] + simp only [List.length_append, BPSlots.length_inverse_internal, + hleftLength, hrightLength] + by_cases hthree : slot < 3 * blockSize + · rw [if_pos (by omega)] + rw [instruction?_append_internal] + simp only [List.length_append, hleftLength, hrightLength] + by_cases htwo : slot < 2 * blockSize + · rw [if_pos (by omega)] + rw [instruction?_append_internal] + simp only [hleftLength] + by_cases hone : slot < blockSize + · simp [hone] + · simp [hone, htwo] + · rw [if_neg (by omega)] + have hone : ¬slot < blockSize := by omega + have hsub : slot - (blockSize + blockSize) = + slot - 2 * blockSize := by omega + rw [if_neg hone, hsub] + rw [if_neg htwo, if_pos hthree] + · by_cases hfour : slot < 4 * blockSize + · rw [if_neg (by omega)] + have hone : ¬slot < blockSize := by omega + have htwo : ¬slot < 2 * blockSize := by omega + have hsub : slot - (blockSize + blockSize + blockSize) = + slot - 3 * blockSize := by omega + rw [if_neg hone, if_neg htwo, hsub] + rw [if_neg hthree, if_pos hfour] + · rw [if_neg (by omega)] + have hout : right.inverse.length ≤ + slot - (blockSize + blockSize + blockSize) := by + rw [BPSlots.length_inverse_internal, hrightLength] + omega + rw [instruction?, List.getElem?_eq_none hout] + have hone : ¬slot < blockSize := by omega + have htwo : ¬slot < 2 * blockSize := by omega + rw [if_neg hone, if_neg htwo] + rw [if_neg hthree, if_neg hfour] + rfl + +theorem firstTrueSlot?_instruction_internal (slots : BPSlots w) : + firstTrueSlot? slots.length + (fun slot => (instruction? slots slot).isSome) = + firstOccupiedSlot? slots := by + induction slots with + | nil => simp [firstTrueSlot?, firstOccupiedSlot?] + | cons head slots ih => + cases head with + | none => + simp only [firstTrueSlot?, instruction?, List.getElem?_cons_zero, + firstOccupiedSlot?] + simpa only [instruction?] using congrArg (Option.map Nat.succ) ih + | some instruction => + simp [firstTrueSlot?, firstOccupiedSlot?, instruction?] + +theorem lastTrueSlot?_instruction_internal (slots : BPSlots w) : + lastTrueSlot? slots.length + (fun slot => (instruction? slots slot).isSome) = + lastOccupiedSlot? slots := by + induction slots with + | nil => simp [lastTrueSlot?, lastOccupiedSlot?] + | cons head slots ih => + cases head with + | none => + simp only [lastTrueSlot?, instruction?, List.getElem?_cons_zero, + Option.isSome_none, Bool.false_eq, lastOccupiedSlot?] + simpa only [instruction?] using congrArg + (fun result => match result with + | some slot => some (slot + 1) + | none => none) ih + | some instruction => + simp only [lastTrueSlot?, instruction?, + List.getElem?_cons_zero, Option.join_some, Option.isSome_some, + lastOccupiedSlot?] + simpa only [instruction?] using congrArg + (fun result => match result with + | some slot => some (slot + 1) + | none => some 0) ih + +end BPSlots + +theorem BPInstrTransform.apply_identity_internal + (instruction : BPInstr 5) : + BPInstrTransform.identity.apply instruction = instruction := by + cases instruction + simp [BPInstrTransform.apply, BPInstrTransform.applyPerm, + BPInstrTransform.identity] + +theorem BPInstrTransform.apply_invertOutput_internal + (transform : BPInstrTransform) (instruction : BPInstr 5) : + transform.invertOutput.apply instruction = + (transform.apply instruction).inverse := by + cases transform with + | mk inverted left right => + cases inverted <;> cases instruction <;> + simp [BPInstrTransform.invertOutput, BPInstrTransform.apply, + BPInstrTransform.applyPerm, BPInstr.inverse, mul_assoc] + +theorem BPInstrTransform.apply_postMulOutput_internal + (transform : BPInstrTransform) (instruction : BPInstr 5) + (permutation : Equiv.Perm (Fin 5)) : + (transform.postMulOutput permutation).apply instruction = + (transform.apply instruction).postMul permutation := by + cases transform + cases instruction + simp [BPInstrTransform.postMulOutput, BPInstrTransform.apply, + BPInstrTransform.applyPerm, BPInstr.postMul, mul_assoc] + +theorem BPInstrTransform.apply_var_internal + (transform : BPInstrTransform) (instruction : BPInstr 5) : + (transform.apply instruction).var = instruction.var := + rfl + +theorem BarringtonSlotCursor.rawDigit_lt_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.rawDigit fuel < 4 := by + exact Nat.mod_lt _ (by omega) + +private theorem four_pow_eq_two_pow_two_mul_internal (fuel : ℕ) : + 4 ^ fuel = 2 ^ (2 * fuel) := by + calc + 4 ^ fuel = (2 ^ 2) ^ fuel := by norm_num + _ = 2 ^ (2 * fuel) := by rw [pow_mul] + +theorem BarringtonSlotCursor.rawLowBit_eq_testBit_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.rawLowBit fuel = (cursor.rawDigit fuel).testBit 0 := by + rw [BarringtonSlotCursor.rawLowBit, BarringtonSlotCursor.rawDigit, + four_pow_eq_two_pow_two_mul_internal] + calc + cursor.slot.testBit (2 * fuel) = + (cursor.slot / 2 ^ (2 * fuel)).testBit 0 := by + simpa using + (Nat.testBit_div_two_pow (n := 2 * fuel) cursor.slot 0).symm + _ = (cursor.slot / 2 ^ (2 * fuel) % 4).testBit 0 := by simp + +theorem BarringtonSlotCursor.rawHighBit_eq_testBit_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.rawHighBit fuel = (cursor.rawDigit fuel).testBit 1 := by + rw [BarringtonSlotCursor.rawHighBit, BarringtonSlotCursor.rawDigit, + four_pow_eq_two_pow_two_mul_internal] + calc + cursor.slot.testBit (2 * fuel + 1) = + (cursor.slot / 2 ^ (2 * fuel)).testBit 1 := by + simpa [Nat.add_comm] using + (Nat.testBit_div_two_pow (n := 2 * fuel) cursor.slot 1).symm + _ = (cursor.slot / 2 ^ (2 * fuel) % 4).testBit 1 := by + simpa using + (Nat.testBit_mod_two_pow (cursor.slot / 2 ^ (2 * fuel)) 2 1).symm + +theorem BarringtonSlotCursor.digit_lt_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.digit fuel < 4 := by + have hraw := cursor.rawDigit_lt_internal fuel + cases hrev : cursor.reversed <;> + simp [BarringtonSlotCursor.digit, hrev] <;> omega + +theorem BarringtonSlotCursor.selectsRight_eq_rawLowBit_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.selectsRight fuel = (cursor.rawLowBit fuel != cursor.reversed) := by + have hraw := cursor.rawDigit_lt_internal fuel + have hbit := cursor.rawLowBit_eq_testBit_internal fuel + have hdigit : cursor.rawDigit fuel = 0 ∨ cursor.rawDigit fuel = 1 ∨ + cursor.rawDigit fuel = 2 ∨ cursor.rawDigit fuel = 3 := by + omega + rcases hdigit with hdigit | hdigit | hdigit | hdigit <;> + cases hrev : cursor.reversed <;> + simp [BarringtonSlotCursor.selectsRight, BarringtonSlotCursor.digit, + hrev, hbit, hdigit] + +theorem BarringtonSlotCursor.selectsInverse_eq_rawHighBit_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.selectsInverse fuel = (cursor.rawHighBit fuel != cursor.reversed) := by + have hraw := cursor.rawDigit_lt_internal fuel + have hbit := cursor.rawHighBit_eq_testBit_internal fuel + have hdigit : cursor.rawDigit fuel = 0 ∨ cursor.rawDigit fuel = 1 ∨ + cursor.rawDigit fuel = 2 ∨ cursor.rawDigit fuel = 3 := by + omega + rcases hdigit with hdigit | hdigit | hdigit | hdigit <;> + cases hrev : cursor.reversed <;> + simp [BarringtonSlotCursor.selectsInverse, BarringtonSlotCursor.digit, + hrev, hbit, hdigit] <;> + norm_num [Nat.testBit_eq_decide_div_mod_eq] + +theorem BarringtonSlotCursor.descend_reversed_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + (cursor.descend fuel).reversed = cursor.rawHighBit fuel := by + rw [BarringtonSlotCursor.descend, + cursor.selectsInverse_eq_rawHighBit_internal fuel] + cases cursor.rawHighBit fuel <;> cases cursor.reversed <;> rfl + +theorem BarringtonSlotCursor.localSlot_lt_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.localSlot fuel < 4 ^ fuel := by + have hpositive : 0 < 4 ^ fuel := pow_pos (by omega) fuel + have hraw : cursor.slot % 4 ^ fuel < 4 ^ fuel := + Nat.mod_lt _ hpositive + cases hrev : cursor.reversed <;> + simp [BarringtonSlotCursor.localSlot, hrev] <;> omega + +theorem BarringtonSlotCursor.localSlot_succ_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + cursor.localSlot (fuel + 1) = + cursor.digit fuel * 4 ^ fuel + cursor.localSlot fuel := by + have hpositive : 0 < 4 ^ fuel := pow_pos (by omega) fuel + have hraw : cursor.rawDigit fuel < 4 := cursor.rawDigit_lt_internal fuel + have hlow : cursor.slot % 4 ^ fuel < 4 ^ fuel := + Nat.mod_lt _ hpositive + simp only [BarringtonSlotCursor.localSlot] + rw [show 4 ^ (fuel + 1) = 4 ^ fuel * 4 by simp [pow_succ]] + rw [Nat.mod_mul] + cases hrev : cursor.reversed + · simp [BarringtonSlotCursor.digit, BarringtonSlotCursor.rawDigit, + hrev, Nat.add_comm, Nat.mul_comm] + · simp only [BarringtonSlotCursor.digit, + BarringtonSlotCursor.rawDigit, hrev, ite_true] + have hdigit : cursor.slot / 4 ^ fuel % 4 = 0 ∨ + cursor.slot / 4 ^ fuel % 4 = 1 ∨ + cursor.slot / 4 ^ fuel % 4 = 2 ∨ + cursor.slot / 4 ^ fuel % 4 = 3 := by + omega + rcases hdigit with hdigit | hdigit | hdigit | hdigit <;> + simp only [hdigit] <;> omega + +theorem BarringtonSlotCursor.localSlot_descend_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) : + (cursor.descend fuel).localSlot fuel = + if cursor.selectsInverse fuel then + 4 ^ fuel - 1 - cursor.localSlot fuel + else + cursor.localSlot fuel := by + have hpositive : 0 < 4 ^ fuel := pow_pos (by omega) fuel + have hraw : cursor.slot % 4 ^ fuel < 4 ^ fuel := + Nat.mod_lt _ hpositive + cases hrev : cursor.reversed <;> + cases hinverse : cursor.selectsInverse fuel <;> + simp [BarringtonSlotCursor.descend, BarringtonSlotCursor.localSlot, + hrev, hinverse] + all_goals omega + +private theorem barringtonCompileSlots_ne_nil_query_internal + (fuel : ℕ) (formula : BoolFormula) + (target : Equiv.Perm (Fin 5)) : + barringtonCompileSlots fuel formula target ≠ [] := by + intro hempty + have hlength := barringtonCompileSlots_length_internal fuel formula target + rw [hempty] at hlength + have hpositive : 0 < 4 ^ fuel := pow_pos (by omega) fuel + simp at hlength + omega + +/-- The small nonemptiness recurrence agrees with both structural extreme +queries. -/ +theorem barringtonCompileSlotsNonempty_correct_internal (fuel : ℕ) + (formula : BoolFormula) : + barringtonCompileSlotsNonempty fuel formula = + (barringtonFirstOccupiedSlot? fuel formula).isSome ∧ + barringtonCompileSlotsNonempty fuel formula = + (barringtonLastOccupiedSlot? fuel formula).isSome := by + induction fuel generalizing formula with + | zero => + cases formula <;> + simp [barringtonCompileSlotsNonempty, + barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?] + | succ fuel ih => + cases formula with + | conj left right => + obtain ⟨hleftFirst, _hleftLast⟩ := ih left + obtain ⟨hrightFirst, _hrightLast⟩ := ih right + simp only [barringtonCompileSlotsNonempty, + barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?, + hleftFirst, hrightFirst] + cases barringtonFirstOccupiedSlot? fuel left <;> + cases barringtonFirstOccupiedSlot? fuel right <;> simp + | var index => + simp [barringtonCompileSlotsNonempty, + barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?] + | tru => + simp [barringtonCompileSlotsNonempty, + barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?] + | fls => + simp [barringtonCompileSlotsNonempty, + barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?] + | neg formula => + simp [barringtonCompileSlotsNonempty, + barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?] + | disj left right => + simp [barringtonCompileSlotsNonempty, + barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?] + +private theorem optionMap_isSome_internal {A B : Type} + (f : A → B) (value : Option A) : + (value.map f).isSome = value.isSome := by + cases value <;> rfl + +private theorem barringtonPostMulSlotOccupied_correct_internal + (nonempty : Bool) (occupied : ℕ → Bool) + (query : ℕ → Option (BPInstr 5)) (lastOccupied : Option ℕ) + (permutation : Equiv.Perm (Fin 5)) + (hnonempty : nonempty = lastOccupied.isSome) + (hquery : ∀ slot, occupied slot = (query slot).isSome) (slot : ℕ) : + barringtonPostMulSlotOccupied nonempty occupied slot = + (barringtonPostMulSlot? query lastOccupied permutation slot).isSome := by + rw [hnonempty] + cases lastOccupied with + | none => + by_cases hslot : slot = 0 <;> + simp [barringtonPostMulSlotOccupied, barringtonPostMulSlot?, hslot] + | some last => + simp [barringtonPostMulSlotOccupied, barringtonPostMulSlot?, hquery] + +private theorem barringtonInverseSlotOccupied_correct_internal + (blockSize : ℕ) (occupied : ℕ → Bool) + (query : ℕ → Option (BPInstr 5)) + (hquery : ∀ slot, occupied slot = (query slot).isSome) (slot : ℕ) : + barringtonInverseSlotOccupied blockSize occupied slot = + (barringtonInverseSlot? blockSize query slot).isSome := by + by_cases hslot : slot < blockSize <;> + simp [barringtonInverseSlotOccupied, barringtonInverseSlot?, hslot, + hquery] + +/-- The target-independent Boolean occupancy query is exactly the `isSome` +projection of the instruction query. -/ +theorem barringtonCompileSlotOccupied_correct_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (slot : ℕ) : + barringtonCompileSlotOccupied fuel formula slot = + (barringtonCompileSlot? fuel formula target slot).isSome := by + induction fuel generalizing formula target slot with + | zero => + cases formula <;> + simp only [barringtonCompileSlotOccupied, barringtonCompileSlot?] <;> + first | rfl | (split <;> simp_all) + | succ fuel ih => + cases formula with + | var index => + simp only [barringtonCompileSlotOccupied, barringtonCompileSlot?] + split <;> simp_all + | tru => + simp only [barringtonCompileSlotOccupied, barringtonCompileSlot?] + split <;> simp_all + | fls => + rfl + | neg formula => + have hnonempty := + (barringtonCompileSlotsNonempty_correct_internal fuel formula).2 + simp only [barringtonCompileSlotOccupied, barringtonCompileSlot?] + by_cases hslot : slot < 4 ^ fuel + · rw [if_pos hslot, if_pos hslot] + exact barringtonPostMulSlotOccupied_correct_internal + (barringtonCompileSlotsNonempty fuel formula) + (barringtonCompileSlotOccupied fuel formula) + (barringtonCompileSlot? fuel formula target⁻¹) + (barringtonLastOccupiedSlot? fuel formula) target hnonempty + (fun localSlot => ih formula target⁻¹ localSlot) slot + · rw [if_neg hslot, if_neg hslot] + rfl + | conj left right => + simp only [barringtonCompileSlotOccupied, barringtonCompileSlot?] + by_cases hone : slot < 4 ^ fuel + · rw [if_pos hone, if_pos hone] + exact ih left (barringtonLeft target) slot + · rw [if_neg hone, if_neg hone] + by_cases htwo : slot < 2 * 4 ^ fuel + · rw [if_pos htwo, if_pos htwo] + exact ih right (barringtonRight target) (slot - 4 ^ fuel) + · rw [if_neg htwo, if_neg htwo] + by_cases hthree : slot < 3 * 4 ^ fuel + · rw [if_pos hthree, if_pos hthree] + exact barringtonInverseSlotOccupied_correct_internal + (4 ^ fuel) (barringtonCompileSlotOccupied fuel left) + (barringtonCompileSlot? fuel left (barringtonLeft target)) + (fun localSlot => + ih left (barringtonLeft target) localSlot) + (slot - 2 * 4 ^ fuel) + · rw [if_neg hthree, if_neg hthree] + by_cases hfour : slot < 4 * 4 ^ fuel + · rw [if_pos hfour, if_pos hfour] + exact barringtonInverseSlotOccupied_correct_internal + (4 ^ fuel) (barringtonCompileSlotOccupied fuel right) + (barringtonCompileSlot? fuel right + (barringtonRight target)) + (fun localSlot => + ih right (barringtonRight target) localSlot) + (slot - 3 * 4 ^ fuel) + · rw [if_neg hfour, if_neg hfour] + rfl + | disj left right => + have hleftNonempty := + (barringtonCompileSlotsNonempty_correct_internal fuel left).2 + have hrightNonempty := + (barringtonCompileSlotsNonempty_correct_internal fuel right).2 + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftOccupied := barringtonPostMulSlotOccupied + (barringtonCompileSlotsNonempty fuel left) + (barringtonCompileSlotOccupied fuel left) + let rightOccupied := barringtonPostMulSlotOccupied + (barringtonCompileSlotsNonempty fuel right) + (barringtonCompileSlotOccupied fuel right) + let leftQuery := barringtonPostMulSlot? + (barringtonCompileSlot? fuel left leftTarget⁻¹) + (barringtonLastOccupiedSlot? fuel left) leftTarget + let rightQuery := barringtonPostMulSlot? + (barringtonCompileSlot? fuel right rightTarget⁻¹) + (barringtonLastOccupiedSlot? fuel right) rightTarget + have hleft : ∀ localSlot, + leftOccupied localSlot = (leftQuery localSlot).isSome := by + intro localSlot + exact barringtonPostMulSlotOccupied_correct_internal + (barringtonCompileSlotsNonempty fuel left) + (barringtonCompileSlotOccupied fuel left) + (barringtonCompileSlot? fuel left leftTarget⁻¹) + (barringtonLastOccupiedSlot? fuel left) leftTarget + hleftNonempty + (fun childSlot => ih left leftTarget⁻¹ childSlot) + localSlot + have hright : ∀ localSlot, + rightOccupied localSlot = (rightQuery localSlot).isSome := by + intro localSlot + exact barringtonPostMulSlotOccupied_correct_internal + (barringtonCompileSlotsNonempty fuel right) + (barringtonCompileSlotOccupied fuel right) + (barringtonCompileSlot? fuel right rightTarget⁻¹) + (barringtonLastOccupiedSlot? fuel right) rightTarget + hrightNonempty + (fun childSlot => ih right rightTarget⁻¹ childSlot) + localSlot + simp only [barringtonCompileSlotOccupied, barringtonCompileSlot?] + change (if slot < 4 ^ fuel then leftOccupied slot + else if slot < 2 * 4 ^ fuel then + rightOccupied (slot - 4 ^ fuel) + else if slot < 3 * 4 ^ fuel then + barringtonInverseSlotOccupied (4 ^ fuel) leftOccupied + (slot - 2 * 4 ^ fuel) + else if slot < 4 * 4 ^ fuel then + barringtonInverseSlotOccupied (4 ^ fuel) rightOccupied + (slot - 3 * 4 ^ fuel) + else false) = _ + simp only [barringtonPostMulSlot?] + by_cases hone : slot < 4 ^ fuel + · rw [if_pos hone, if_pos hone] + rw [optionMap_isSome_internal] + simpa only [leftOccupied, leftQuery] using hleft slot + · rw [if_neg hone, if_neg hone] + by_cases htwo : slot < 2 * 4 ^ fuel + · rw [if_pos htwo, if_pos htwo] + rw [optionMap_isSome_internal] + simpa only [rightOccupied, rightQuery] using + hright (slot - 4 ^ fuel) + · rw [if_neg htwo, if_neg htwo] + by_cases hthree : slot < 3 * 4 ^ fuel + · rw [if_pos hthree, if_pos hthree] + rw [optionMap_isSome_internal] + exact barringtonInverseSlotOccupied_correct_internal + (4 ^ fuel) leftOccupied leftQuery hleft + (slot - 2 * 4 ^ fuel) + · rw [if_neg hthree, if_neg hthree] + by_cases hfour : slot < 4 * 4 ^ fuel + · rw [if_pos hfour, if_pos hfour] + rw [optionMap_isSome_internal] + exact barringtonInverseSlotOccupied_correct_internal + (4 ^ fuel) rightOccupied rightQuery hright + (slot - 3 * 4 ^ fuel) + · rw [if_neg hfour, if_neg hfour] + rfl + +/-- The structural first/last recurrences identify the exact occupied +extremes of the list-valued fixed-slot compiler. -/ +theorem barringtonOccupiedSlots_correct_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + barringtonFirstOccupiedSlot? fuel formula = + BPSlots.firstOccupiedSlot? + (barringtonCompileSlots fuel formula target) ∧ + barringtonLastOccupiedSlot? fuel formula = + BPSlots.lastOccupiedSlot? + (barringtonCompileSlots fuel formula target) := by + induction fuel generalizing formula target with + | zero => + cases formula <;> + simp [barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?, + barringtonCompileSlots, BPSlots.singletonAt, BPSlots.emptyAt, + BPSlots.firstOccupiedSlot?, BPSlots.lastOccupiedSlot?] + | succ fuel ih => + cases formula with + | var index => + simp [barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?, + barringtonCompileSlots, BPSlots.singletonAt, + BPSlots.firstOccupiedSlot?, BPSlots.lastOccupiedSlot?] + | tru => + simp [barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?, + barringtonCompileSlots, BPSlots.singletonAt, + BPSlots.firstOccupiedSlot?, BPSlots.lastOccupiedSlot?] + | fls => + simp [barringtonFirstOccupiedSlot?, barringtonLastOccupiedSlot?, + barringtonCompileSlots, BPSlots.emptyAt] + | neg formula => + obtain ⟨hfirst, hlast⟩ := ih formula target⁻¹ + have hne := barringtonCompileSlots_ne_nil_query_internal + fuel formula target⁻¹ + constructor + · simp [barringtonFirstOccupiedSlot?, barringtonCompileSlots, + BPSlots.firstOccupiedSlot?_append_internal, + BPSlots.firstOccupiedSlot?_postMul_internal, hne, + hfirst] + · simp [barringtonLastOccupiedSlot?, barringtonCompileSlots, + BPSlots.lastOccupiedSlot?_append_internal, + BPSlots.lastOccupiedSlot?_postMul_internal, hne, + hlast] + | conj left right => + obtain ⟨hleftFirst, hleftLast⟩ := + ih left (barringtonLeft target) + obtain ⟨hrightFirst, hrightLast⟩ := + ih right (barringtonRight target) + cases hleft : barringtonFirstOccupiedSlot? fuel left <;> + cases hright : barringtonFirstOccupiedSlot? fuel right + all_goals + have hleftActual := hleftFirst.symm.trans hleft + have hrightActual := hrightFirst.symm.trans hright + have hleftEmpty := + BPSlots.lastOccupiedSlot?_eq_none_iff_first_internal + (barringtonCompileSlots fuel left (barringtonLeft target)) + have hrightEmpty := + BPSlots.lastOccupiedSlot?_eq_none_iff_first_internal + (barringtonCompileSlots fuel right (barringtonRight target)) + simp [hleftActual] at hleftEmpty + simp [hrightActual] at hrightEmpty + constructor + · simp [barringtonFirstOccupiedSlot?, + barringtonCompileSlots, + BPSlots.firstOccupiedSlot?_append_internal, + BPSlots.firstOccupiedSlot?_inverse_internal, + BPSlots.length_inverse_internal, + barringtonCompileSlots_length_internal, hleft, hright, + hleftActual, hrightActual, hleftEmpty, hrightEmpty] + · simp [barringtonLastOccupiedSlot?, + barringtonCompileSlots, + BPSlots.lastOccupiedSlot?_append_internal, + BPSlots.lastOccupiedSlot?_inverse_internal, + BPSlots.length_inverse_internal, + barringtonCompileSlots_length_internal, hleft, hright, + hleftActual, hrightActual, hleftEmpty, hrightEmpty] + all_goals ring_nf + | disj left right => + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftBase := + barringtonCompileSlots fuel left leftTarget⁻¹ + let rightBase := + barringtonCompileSlots fuel right rightTarget⁻¹ + let leftSlots := leftBase.postMul leftTarget + let rightSlots := rightBase.postMul rightTarget + let commSlots := leftSlots ++ rightSlots ++ leftSlots.inverse ++ + rightSlots.inverse + obtain ⟨hleftFirst, hleftLast⟩ := ih left leftTarget⁻¹ + obtain ⟨hrightFirst, hrightLast⟩ := ih right rightTarget⁻¹ + have hleftNe : leftBase ≠ [] := by + exact barringtonCompileSlots_ne_nil_query_internal + fuel left leftTarget⁻¹ + have hrightNe : rightBase ≠ [] := by + exact barringtonCompileSlots_ne_nil_query_internal + fuel right rightTarget⁻¹ + have hleftSlotsFirst : BPSlots.firstOccupiedSlot? leftSlots = + some ((BPSlots.firstOccupiedSlot? leftBase).getD 0) := by + exact BPSlots.firstOccupiedSlot?_postMul_internal + leftBase leftTarget hleftNe + have hrightSlotsFirst : BPSlots.firstOccupiedSlot? rightSlots = + some ((BPSlots.firstOccupiedSlot? rightBase).getD 0) := by + exact BPSlots.firstOccupiedSlot?_postMul_internal + rightBase rightTarget hrightNe + have hcommNe : commSlots ≠ [] := by + intro hempty + have hlength := congrArg List.length hempty + simp [commSlots, leftSlots, leftBase, + BPSlots.length_postMul_internal, + barringtonCompileSlots_length_internal] at hlength + have hcommFirst : BPSlots.firstOccupiedSlot? commSlots = + some ((BPSlots.firstOccupiedSlot? leftBase).getD 0) := by + simp [commSlots, BPSlots.firstOccupiedSlot?_append_internal, + hleftSlotsFirst] + have hcommLast : BPSlots.lastOccupiedSlot? commSlots = + some (3 * 4 ^ fuel + + (4 ^ fuel - 1 - + (BPSlots.firstOccupiedSlot? rightBase).getD 0)) := by + rw [show commSlots = + (leftSlots ++ rightSlots ++ leftSlots.inverse) ++ + rightSlots.inverse by simp [commSlots, List.append_assoc]] + rw [BPSlots.lastOccupiedSlot?_append_internal, + BPSlots.lastOccupiedSlot?_inverse_internal, + hrightSlotsFirst] + simp only [Option.map_some] + simp [leftSlots, rightSlots, leftBase, rightBase, + BPSlots.length_postMul_internal, + BPSlots.length_inverse_internal, + barringtonCompileSlots_length_internal] + ring_nf + have hfinalFirst := BPSlots.firstOccupiedSlot?_postMul_internal + commSlots target hcommNe + have hfinalLast := BPSlots.lastOccupiedSlot?_postMul_internal + commSlots target hcommNe + rw [show barringtonCompileSlots (fuel + 1) (.disj left right) + target = commSlots.postMul target from rfl] + constructor + · rw [hfinalFirst, hcommFirst] + simpa [barringtonFirstOccupiedSlot?, leftBase] using + congrArg (Option.getD · 0) hleftFirst + · rw [hfinalLast, hcommLast] + simpa [barringtonLastOccupiedSlot?, rightBase] using + congrArg (fun slot => + 4 ^ fuel - 1 - slot.getD 0) hrightFirst + +/-- The depth-bounded direct query returns exactly the instruction stored at +the corresponding address of the list-valued fixed-slot compiler. -/ +theorem barringtonCompileSlot?_correct_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (slot : ℕ) : + barringtonCompileSlot? fuel formula target slot = + BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot := by + induction fuel generalizing formula target slot with + | zero => + cases formula <;> cases slot <;> + simp [barringtonCompileSlot?, barringtonCompileSlots, + BPSlots.instruction?, BPSlots.singletonAt, BPSlots.emptyAt] + | succ fuel ih => + cases formula with + | var index => + simp [barringtonCompileSlot?, barringtonCompileSlots, + BPSlots.instruction?_singletonAt_internal] + | tru => + simp [barringtonCompileSlot?, barringtonCompileSlots, + BPSlots.instruction?_singletonAt_internal] + | fls => + simp [barringtonCompileSlot?, barringtonCompileSlots, + BPSlots.instruction?_emptyAt_internal] + | neg formula => + have hlast := + (barringtonOccupiedSlots_correct_internal fuel formula target⁻¹).2 + have hne := barringtonCompileSlots_ne_nil_query_internal + fuel formula target⁻¹ + have hpostLength : + ((barringtonCompileSlots fuel formula target⁻¹).postMul + target).length = 4 ^ fuel := by + rw [BPSlots.length_postMul_internal, + barringtonCompileSlots_length_internal] + have hquery : + barringtonCompileSlot? fuel formula target⁻¹ = + BPSlots.instruction? + (barringtonCompileSlots fuel formula target⁻¹) := by + funext querySlot + exact ih formula target⁻¹ querySlot + by_cases hslot : slot < 4 ^ fuel + · simp only [barringtonCompileSlot?, hslot, ↓reduceIte, + barringtonCompileSlots, + BPSlots.instruction?_append_internal, hpostLength] + rw [hquery, hlast] + exact BPSlots.barringtonPostMulSlot?_correct_internal + (barringtonCompileSlots fuel formula target⁻¹) + target slot hne + · simp only [barringtonCompileSlot?, hslot, ↓reduceIte, + barringtonCompileSlots, + BPSlots.instruction?_append_internal, hpostLength] + exact BPSlots.instruction?_replicate_none_internal _ _ |>.symm + | conj left right => + let leftTarget := barringtonLeft target + let rightTarget := barringtonRight target + let leftSlots := + barringtonCompileSlots fuel left leftTarget + let rightSlots := + barringtonCompileSlots fuel right rightTarget + have hleftLength : leftSlots.length = 4 ^ fuel := by + exact barringtonCompileSlots_length_internal + fuel left leftTarget + have hrightLength : rightSlots.length = 4 ^ fuel := by + exact barringtonCompileSlots_length_internal + fuel right rightTarget + have hleftQuery : + barringtonCompileSlot? fuel left leftTarget = + BPSlots.instruction? leftSlots := by + funext querySlot + exact ih left leftTarget querySlot + have hrightQuery : + barringtonCompileSlot? fuel right rightTarget = + BPSlots.instruction? rightSlots := by + funext querySlot + exact ih right rightTarget querySlot + have hleftInverse (querySlot : ℕ) : + barringtonInverseSlot? (4 ^ fuel) + (BPSlots.instruction? leftSlots) querySlot = + BPSlots.instruction? leftSlots.inverse querySlot := by + rw [← hleftLength] + exact BPSlots.barringtonInverseSlot?_correct_internal + leftSlots querySlot + have hrightInverse (querySlot : ℕ) : + barringtonInverseSlot? (4 ^ fuel) + (BPSlots.instruction? rightSlots) querySlot = + BPSlots.instruction? rightSlots.inverse querySlot := by + rw [← hrightLength] + exact BPSlots.barringtonInverseSlot?_correct_internal + rightSlots querySlot + rw [show barringtonCompileSlots (fuel + 1) (.conj left right) + target = leftSlots ++ rightSlots ++ leftSlots.inverse ++ + rightSlots.inverse from rfl] + rw [BPSlots.instruction?_fourBlocks_internal leftSlots rightSlots + (4 ^ fuel) slot hleftLength hrightLength] + simp only [barringtonCompileSlot?] + simp only [leftTarget, rightTarget] at hleftQuery hrightQuery + simp only [hleftQuery, hrightQuery, hleftInverse, hrightInverse] + | disj left right => + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftBase := + barringtonCompileSlots fuel left leftTarget⁻¹ + let rightBase := + barringtonCompileSlots fuel right rightTarget⁻¹ + let leftSlots := leftBase.postMul leftTarget + let rightSlots := rightBase.postMul rightTarget + let commSlots := leftSlots ++ rightSlots ++ leftSlots.inverse ++ + rightSlots.inverse + let leftQuery := barringtonPostMulSlot? + (barringtonCompileSlot? fuel left leftTarget⁻¹) + (barringtonLastOccupiedSlot? fuel left) leftTarget + let rightQuery := barringtonPostMulSlot? + (barringtonCompileSlot? fuel right rightTarget⁻¹) + (barringtonLastOccupiedSlot? fuel right) rightTarget + let commutatorQuery := fun localSlot => + if localSlot < 4 ^ fuel then + leftQuery localSlot + else if localSlot < 2 * 4 ^ fuel then + rightQuery (localSlot - 4 ^ fuel) + else if localSlot < 3 * 4 ^ fuel then + barringtonInverseSlot? (4 ^ fuel) leftQuery + (localSlot - 2 * 4 ^ fuel) + else if localSlot < 4 * 4 ^ fuel then + barringtonInverseSlot? (4 ^ fuel) rightQuery + (localSlot - 3 * 4 ^ fuel) + else + none + obtain ⟨hleftFirst, hleftLast⟩ := + barringtonOccupiedSlots_correct_internal + fuel left leftTarget⁻¹ + obtain ⟨hrightFirst, hrightLast⟩ := + barringtonOccupiedSlots_correct_internal + fuel right rightTarget⁻¹ + have hleftNe : leftBase ≠ [] := by + exact barringtonCompileSlots_ne_nil_query_internal + fuel left leftTarget⁻¹ + have hrightNe : rightBase ≠ [] := by + exact barringtonCompileSlots_ne_nil_query_internal + fuel right rightTarget⁻¹ + have hleftBaseQuery : + barringtonCompileSlot? fuel left leftTarget⁻¹ = + BPSlots.instruction? leftBase := by + funext querySlot + exact ih left leftTarget⁻¹ querySlot + have hrightBaseQuery : + barringtonCompileSlot? fuel right rightTarget⁻¹ = + BPSlots.instruction? rightBase := by + funext querySlot + exact ih right rightTarget⁻¹ querySlot + have hleftQuery : leftQuery = + BPSlots.instruction? leftSlots := by + funext querySlot + simp only [leftQuery, leftSlots] + rw [hleftBaseQuery, hleftLast] + exact BPSlots.barringtonPostMulSlot?_correct_internal + leftBase leftTarget querySlot hleftNe + have hrightQuery : rightQuery = + BPSlots.instruction? rightSlots := by + funext querySlot + simp only [rightQuery, rightSlots] + rw [hrightBaseQuery, hrightLast] + exact BPSlots.barringtonPostMulSlot?_correct_internal + rightBase rightTarget querySlot hrightNe + have hleftLength : leftSlots.length = 4 ^ fuel := by + rw [BPSlots.length_postMul_internal] + exact barringtonCompileSlots_length_internal + fuel left leftTarget⁻¹ + have hrightLength : rightSlots.length = 4 ^ fuel := by + rw [BPSlots.length_postMul_internal] + exact barringtonCompileSlots_length_internal + fuel right rightTarget⁻¹ + have hleftInverse (querySlot : ℕ) : + barringtonInverseSlot? (4 ^ fuel) + (BPSlots.instruction? leftSlots) querySlot = + BPSlots.instruction? leftSlots.inverse querySlot := by + rw [← hleftLength] + exact BPSlots.barringtonInverseSlot?_correct_internal + leftSlots querySlot + have hrightInverse (querySlot : ℕ) : + barringtonInverseSlot? (4 ^ fuel) + (BPSlots.instruction? rightSlots) querySlot = + BPSlots.instruction? rightSlots.inverse querySlot := by + rw [← hrightLength] + exact BPSlots.barringtonInverseSlot?_correct_internal + rightSlots querySlot + have hcommutatorQuery : commutatorQuery = + BPSlots.instruction? commSlots := by + funext querySlot + simp only [commutatorQuery, hleftQuery, hrightQuery, + hleftInverse, hrightInverse] + rw [show commSlots = + leftSlots ++ rightSlots ++ leftSlots.inverse ++ + rightSlots.inverse from rfl] + exact (BPSlots.instruction?_fourBlocks_internal + leftSlots rightSlots (4 ^ fuel) querySlot + hleftLength hrightLength).symm + have hrightSlotsFirst : BPSlots.firstOccupiedSlot? rightSlots = + some ((BPSlots.firstOccupiedSlot? rightBase).getD 0) := by + exact BPSlots.firstOccupiedSlot?_postMul_internal + rightBase rightTarget hrightNe + have hcommNe : commSlots ≠ [] := by + intro hempty + have hlength := congrArg List.length hempty + simp [commSlots, hleftLength, hrightLength, + BPSlots.length_inverse_internal] at hlength + have hcommLastActual : BPSlots.lastOccupiedSlot? commSlots = + some (3 * 4 ^ fuel + + (4 ^ fuel - 1 - + (BPSlots.firstOccupiedSlot? rightBase).getD 0)) := by + rw [show commSlots = + (leftSlots ++ rightSlots ++ leftSlots.inverse) ++ + rightSlots.inverse by simp [commSlots, List.append_assoc]] + rw [BPSlots.lastOccupiedSlot?_append_internal, + BPSlots.lastOccupiedSlot?_inverse_internal, + hrightSlotsFirst] + simp only [Option.map_some] + simp [hleftLength, hrightLength, + BPSlots.length_inverse_internal] + ring_nf + have hcommLast : + some (3 * 4 ^ fuel + + (4 ^ fuel - 1 - + (barringtonFirstOccupiedSlot? fuel right).getD 0)) = + BPSlots.lastOccupiedSlot? commSlots := by + rw [hrightFirst, hcommLastActual] + change barringtonPostMulSlot? commutatorQuery + (some (3 * 4 ^ fuel + + (4 ^ fuel - 1 - + (barringtonFirstOccupiedSlot? fuel right).getD 0))) + target slot = + BPSlots.instruction? (commSlots.postMul target) slot + rw [hcommutatorQuery, hcommLast] + exact BPSlots.barringtonPostMulSlot?_correct_internal + commSlots target slot hcommNe + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonSlots.lean b/Complexitylib/Circuits/BarringtonSlots.lean new file mode 100644 index 00000000..da9c81a3 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonSlots.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonSlots.Defs +import Complexitylib.Circuits.BarringtonSlots.Internal + +/-! +# Fixed-address Barrington compilation slots + +`barringtonCompileSlots fuel formula target` schedules the existing compiler +inside exactly `4 ^ fuel` optional slots. Under the promised depth bound, +erasing empty slots recovers the existing compiler exactly. The fixed +four-block address space is the machine-facing traversal used by the uniform +generator. + +## Main results + +- `barringtonCompileSlots_length` -- the slot count is exactly `4 ^ fuel`. +- `barringtonCompileSlots_filterMap` -- occupied slots are exactly the + reference compiler output. +- `barringtonCompileSlots_occupiedCount` -- counting occupied slots gives the + exact instruction-count recurrence. +-/ + +namespace Complexity + +/-- The fixed-address schedule has exactly `4 ^ fuel` slots. -/ +theorem barringtonCompileSlots_length (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + (barringtonCompileSlots fuel formula target).length = 4 ^ fuel := + barringtonCompileSlots_length_internal fuel formula target + +/-- Under its depth promise, erasing empty slots recovers the existing +Barrington compiler exactly. -/ +theorem barringtonCompileSlots_filterMap (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + (barringtonCompileSlots fuel formula target).filterMap id = + barringtonCompile formula target := + barringtonCompileSlots_filterMap_internal fuel formula target hdepth + +/-- Counting the occupied slots recovers the exact number of instructions in +the reference compiler output. -/ +theorem barringtonCompileSlots_occupiedCount (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + ((barringtonCompileSlots fuel formula target).filterMap id).length = + barringtonInstructionCount formula := + barringtonCompileSlots_occupiedCount_internal fuel formula target hdepth + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonSlots/Defs.lean b/Complexitylib/Circuits/BarringtonSlots/Defs.lean new file mode 100644 index 00000000..9fcf58c2 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonSlots/Defs.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCompiler.Defs + +/-! +# Fixed-address Barrington compilation slots -- definitions + +A depth bound `fuel` gives `4 ^ fuel` addressable slots. Real compiler +instructions occupy some slots and the rest are empty. Binary nodes use four +equal blocks; unary nodes use the first block and pad the other three. This +fixed layout removes recursive child-length arithmetic from the eventual +log-space controller while retaining the existing compiler after empty slots +are erased. +-/ + +namespace Complexity + +/-- A fixed-address schedule whose occupied slots contain branching-program +instructions. -/ +abbrev BPSlots (w : ℕ) := List (Option (BPInstr w)) + +namespace BPSlots + +/-- Modify the first occupied slot, leaving all later slots unchanged. -/ +def postMulFirst (permutation : Equiv.Perm (Fin w)) : BPSlots w → BPSlots w + | [] => [] + | none :: slots => none :: postMulFirst permutation slots + | some instruction :: slots => + some (BPInstr.postMul instruction permutation) :: slots + +/-- Fold a constant permutation into the last occupied slot. If every slot is +empty, place the required constant instruction in the first available slot. -/ +def postMul (slots : BPSlots w) (permutation : Equiv.Perm (Fin w)) : + BPSlots w := + if slots.filterMap id = [] then + match slots with + | [] => [] + | _ :: rest => some (BPInstr.const permutation) :: rest + else + (postMulFirst permutation slots.reverse).reverse + +/-- Reverse the schedule and invert each occupied instruction. -/ +def inverse (slots : BPSlots w) : BPSlots w := + (slots.map fun slot => slot.map BPInstr.inverse).reverse + +/-- One occupied slot followed by padding to total length `4 ^ fuel`. -/ +def singletonAt (fuel : ℕ) (instruction : BPInstr w) : BPSlots w := + some instruction :: List.replicate (4 ^ fuel - 1) none + +/-- A completely empty schedule of total length `4 ^ fuel`. -/ +def emptyAt (fuel : ℕ) : BPSlots w := + List.replicate (4 ^ fuel) none + +end BPSlots + +/-- Compile into exactly `4 ^ fuel` optional instruction slots. Correctness is +claimed when `formula.depth ≤ fuel`; shallower nodes are padded on the right. -/ +def barringtonCompileSlots : ℕ → BoolFormula → + Equiv.Perm (Fin 5) → BPSlots 5 + | fuel, .var index, target => + .singletonAt fuel ⟨index, 1, target⟩ + | fuel, .tru, target => + .singletonAt fuel (BPInstr.const target) + | fuel, .fls, _ => + .emptyAt fuel + | 0, .neg _, _ => + .emptyAt 0 + | fuel + 1, .neg formula, target => + let child := + (barringtonCompileSlots fuel formula target⁻¹).postMul target + child ++ List.replicate (3 * 4 ^ fuel) none + | 0, .conj _ _, _ => + .emptyAt 0 + | fuel + 1, .conj left right, target => + let leftSlots := + barringtonCompileSlots fuel left (barringtonLeft target) + let rightSlots := + barringtonCompileSlots fuel right (barringtonRight target) + leftSlots ++ rightSlots ++ leftSlots.inverse ++ rightSlots.inverse + | 0, .disj _ _, _ => + .emptyAt 0 + | fuel + 1, .disj left right, target => + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftSlots := + (barringtonCompileSlots fuel left leftTarget⁻¹).postMul leftTarget + let rightSlots := + (barringtonCompileSlots fuel right rightTarget⁻¹).postMul rightTarget + (leftSlots ++ rightSlots ++ leftSlots.inverse ++ + rightSlots.inverse).postMul target + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonSlots/Internal.lean b/Complexitylib/Circuits/BarringtonSlots/Internal.lean new file mode 100644 index 00000000..65484c25 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonSlots/Internal.lean @@ -0,0 +1,284 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonSlots.Defs +import Complexitylib.Circuits.BarringtonStreaming.Internal + +/-! +# Fixed-address Barrington compilation slots -- proof internals +-/ + +namespace Complexity + +namespace BPSlots + +theorem length_postMulFirst_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) : + (postMulFirst permutation slots).length = slots.length := by + induction slots with + | nil => rfl + | cons slot slots ih => + cases slot <;> simp [postMulFirst, ih] + +theorem length_postMul_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) : + (slots.postMul permutation).length = slots.length := by + rw [postMul.eq_def] + split + · cases slots <;> rfl + · simp [length_postMulFirst_internal] + +theorem length_inverse_internal (slots : BPSlots w) : + slots.inverse.length = slots.length := by + simp [inverse] + +theorem length_singletonAt_internal (fuel : ℕ) (instruction : BPInstr w) : + (singletonAt fuel instruction).length = 4 ^ fuel := by + simp [singletonAt] + have hpositive : 0 < 4 ^ fuel := pow_pos (by omega) fuel + omega + +theorem length_emptyAt_internal (fuel : ℕ) : + (emptyAt fuel : BPSlots w).length = 4 ^ fuel := by + simp [emptyAt] + +private theorem filterMap_postMulFirst_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) : + (postMulFirst permutation slots).filterMap id = + match slots.filterMap id with + | [] => [] + | instruction :: program => + BPInstr.postMul instruction permutation :: program := by + induction slots with + | nil => rfl + | cons slot slots ih => + cases slot with + | none => + change (postMulFirst permutation slots).filterMap id = _ + exact ih + | some instruction => simp [postMulFirst] + +theorem filterMap_postMul_internal (slots : BPSlots w) + (permutation : Equiv.Perm (Fin w)) (hne : slots ≠ []) : + (slots.postMul permutation).filterMap id = + BP.postMul (slots.filterMap id) permutation := by + by_cases hprogram : slots.filterMap id = [] + · rw [postMul.eq_def, if_pos hprogram] + cases slots with + | nil => exact (hne rfl).elim + | cons slot slots => + cases slot with + | none => + have hrest : slots.filterMap id = [] := by + simpa using hprogram + rw [BP.postMul, if_pos hprogram] + change BPInstr.const permutation :: + slots.filterMap id = [BPInstr.const permutation] + rw [hrest] + | some instruction => + simp at hprogram + · rw [postMul.eq_def, if_neg hprogram, List.filterMap_reverse, + filterMap_postMulFirst_internal] + rw [BP.postMul, if_neg hprogram] + rw [List.filterMap_reverse] + let program := slots.filterMap id + change (match program.reverse with + | [] => [] + | instruction :: rest => + BPInstr.postMul instruction permutation :: rest).reverse = + program.modifyLast fun instruction => + BPInstr.postMul instruction permutation + have hreverse : program.reverse ≠ [] := by + simpa [program] using hprogram + cases hreverseEq : program.reverse with + | nil => exact (hreverse hreverseEq).elim + | cons instruction prefixReverse => + have hprogramEq : + program = prefixReverse.reverse ++ [instruction] := by + rw [← List.reverse_inj] + simp [hreverseEq] + rw [hprogramEq, List.modifyLast_concat] + simp + +theorem filterMap_inverse_internal (slots : BPSlots w) : + slots.inverse.filterMap id = BP.inverse (slots.filterMap id) := by + rw [inverse, BP.inverse, List.filterMap_reverse] + rw [List.reverse_inj] + rw [List.filterMap_map] + change List.filterMap (fun slot => slot.map BPInstr.inverse) slots = + List.map BPInstr.inverse (List.filterMap (fun slot => slot) slots) + induction slots with + | nil => rfl + | cons slot slots ih => + cases slot <;> simp [ih] + +end BPSlots + +theorem barringtonCompileSlots_length_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + (barringtonCompileSlots fuel formula target).length = 4 ^ fuel := by + induction fuel generalizing formula target with + | zero => + cases formula <;> + simp [barringtonCompileSlots, BPSlots.singletonAt, + BPSlots.emptyAt] + | succ fuel ih => + cases formula <;> + simp [barringtonCompileSlots, + BPSlots.length_singletonAt_internal, + BPSlots.length_emptyAt_internal, + BPSlots.length_postMul_internal, + BPSlots.length_inverse_internal, ih, pow_succ] <;> + ring + +private theorem barringtonCompileSlots_ne_nil_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + barringtonCompileSlots fuel formula target ≠ [] := by + intro hempty + have hlength := barringtonCompileSlots_length_internal fuel formula target + rw [hempty] at hlength + have hpositive : 0 < 4 ^ fuel := pow_pos (by omega) fuel + simp at hlength + omega + +theorem barringtonCompileSlots_filterMap_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + (barringtonCompileSlots fuel formula target).filterMap id = + barringtonCompile formula target := by + induction fuel generalizing formula target with + | zero => + cases formula with + | var index => + simp [barringtonCompileSlots, BPSlots.singletonAt, + barringtonCompile] + | tru => + simp [barringtonCompileSlots, BPSlots.singletonAt, + barringtonCompile] + | fls => + simp [barringtonCompileSlots, BPSlots.emptyAt, + barringtonCompile] + | neg formula => + simp [BoolFormula.depth] at hdepth + | conj left right => + simp [BoolFormula.depth] at hdepth + | disj left right => + simp [BoolFormula.depth] at hdepth + | succ fuel ih => + cases formula with + | var index => + simp [barringtonCompileSlots, BPSlots.singletonAt, + barringtonCompile] + | tru => + simp [barringtonCompileSlots, BPSlots.singletonAt, + barringtonCompile] + | fls => + simp [barringtonCompileSlots, BPSlots.emptyAt, + barringtonCompile] + | neg formula => + have hchildDepth : formula.depth ≤ fuel := by + simpa [BoolFormula.depth] using hdepth + have hchild := ih formula target⁻¹ hchildDepth + have hne := barringtonCompileSlots_ne_nil_internal + fuel formula target⁻¹ + simp only [barringtonCompileSlots, List.filterMap_append] + rw [BPSlots.filterMap_postMul_internal _ _ hne, hchild] + simp [barringtonCompile] + | conj left right => + have hmax : max left.depth right.depth ≤ fuel := by + simpa [BoolFormula.depth] using hdepth + have hleftDepth : left.depth ≤ fuel := + le_trans (le_max_left _ _) hmax + have hrightDepth : right.depth ≤ fuel := + le_trans (le_max_right _ _) hmax + have hleft := ih left (barringtonLeft target) hleftDepth + have hright := ih right (barringtonRight target) hrightDepth + let leftSlots := + barringtonCompileSlots fuel left (barringtonLeft target) + let rightSlots := + barringtonCompileSlots fuel right (barringtonRight target) + have hleftInverse : + leftSlots.inverse.filterMap id = + BP.inverse (barringtonCompile left + (barringtonLeft target)) := by + rw [BPSlots.filterMap_inverse_internal, hleft] + have hrightInverse : + rightSlots.inverse.filterMap id = + BP.inverse (barringtonCompile right + (barringtonRight target)) := by + rw [BPSlots.filterMap_inverse_internal, hright] + simp only [barringtonCompileSlots, List.filterMap_append] + rw [hleft, hright, hleftInverse, hrightInverse] + rfl + | disj left right => + have hmax : max left.depth right.depth ≤ fuel := by + simpa [BoolFormula.depth] using hdepth + have hleftDepth : left.depth ≤ fuel := + le_trans (le_max_left _ _) hmax + have hrightDepth : right.depth ≤ fuel := + le_trans (le_max_right _ _) hmax + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftBase := + barringtonCompileSlots fuel left leftTarget⁻¹ + let rightBase := + barringtonCompileSlots fuel right rightTarget⁻¹ + let leftSlots := leftBase.postMul leftTarget + let rightSlots := rightBase.postMul rightTarget + let commSlots := leftSlots ++ rightSlots ++ leftSlots.inverse ++ + rightSlots.inverse + have hleftBaseNe : leftBase ≠ [] := + barringtonCompileSlots_ne_nil_internal fuel left leftTarget⁻¹ + have hrightBaseNe : rightBase ≠ [] := + barringtonCompileSlots_ne_nil_internal fuel right rightTarget⁻¹ + have hleftFilter : leftSlots.filterMap id = + BP.postMul (barringtonCompile left leftTarget⁻¹) + leftTarget := by + rw [show leftSlots = leftBase.postMul leftTarget from rfl, + BPSlots.filterMap_postMul_internal _ _ hleftBaseNe] + exact congrArg (BP.postMul · leftTarget) + (ih left leftTarget⁻¹ hleftDepth) + have hrightFilter : rightSlots.filterMap id = + BP.postMul (barringtonCompile right rightTarget⁻¹) + rightTarget := by + rw [show rightSlots = rightBase.postMul rightTarget from rfl, + BPSlots.filterMap_postMul_internal _ _ hrightBaseNe] + exact congrArg (BP.postMul · rightTarget) + (ih right rightTarget⁻¹ hrightDepth) + have hleftInverse : + leftSlots.inverse.filterMap id = + BP.inverse (BP.postMul + (barringtonCompile left leftTarget⁻¹) leftTarget) := by + rw [BPSlots.filterMap_inverse_internal, hleftFilter] + have hrightInverse : + rightSlots.inverse.filterMap id = + BP.inverse (BP.postMul + (barringtonCompile right rightTarget⁻¹) rightTarget) := by + rw [BPSlots.filterMap_inverse_internal, hrightFilter] + have hcommNe : commSlots ≠ [] := by + intro hempty + have hlength := congrArg List.length hempty + simp [commSlots, leftSlots, leftBase, + BPSlots.length_postMul_internal, + barringtonCompileSlots_length_internal] at hlength + rw [show barringtonCompileSlots (fuel + 1) (.disj left right) + target = commSlots.postMul target from rfl] + rw [BPSlots.filterMap_postMul_internal _ _ hcommNe] + simp only [barringtonCompile] + apply congrArg (BP.postMul · target) + simp only [commSlots, List.filterMap_append, + BP.commutatorProgram] + rw [hleftFilter, hrightFilter, hleftInverse, hrightInverse] + +theorem barringtonCompileSlots_occupiedCount_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) + (hdepth : formula.depth ≤ fuel) : + ((barringtonCompileSlots fuel formula target).filterMap id).length = + barringtonInstructionCount formula := by + rw [barringtonCompileSlots_filterMap_internal fuel formula target hdepth] + exact (barringtonInstructionCount_eq_length_internal formula target).symm + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonStreaming.lean b/Complexitylib/Circuits/BarringtonStreaming.lean new file mode 100644 index 00000000..a968afe7 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonStreaming.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonStreaming.Defs +import Complexitylib.Circuits.BarringtonStreaming.Internal + +/-! +# Random-access Barrington instruction streams + +`barringtonCompileStream` mirrors the executable Barrington compiler using +only lengths and indexed instruction queries. It never constructs the complete +recursive instruction list. The exactness theorem identifies both its length +and every query with the existing reference compiler. + +## Main results + +- `barringtonInstructionCount_eq_length` -- target-independent exact length. +- `barringtonCompileStream_length` -- exact instruction count. +- `barringtonCompileStream_instruction?` -- exact indexed instruction query. +-/ + +namespace Complexity + +/-- The target-independent recurrence is the exact compiled-program length. -/ +theorem barringtonInstructionCount_eq_length (formula : BoolFormula) + (target : Equiv.Perm (Fin 5)) : + barringtonInstructionCount formula = + (barringtonCompile formula target).length := + barringtonInstructionCount_eq_length_internal formula target + +/-- The random-access compiler has exactly the reference program's length. -/ +theorem barringtonCompileStream_length (formula : BoolFormula) + (target : Equiv.Perm (Fin 5)) : + (barringtonCompileStream formula target).length = + (barringtonCompile formula target).length := + (barringtonCompileStream_correctFor_internal formula target).1 + +/-- Every random-access instruction query agrees with the reference compiler. -/ +theorem barringtonCompileStream_instruction? (formula : BoolFormula) + (target : Equiv.Perm (Fin 5)) (index : ℕ) : + (barringtonCompileStream formula target).instruction? index = + (barringtonCompile formula target)[index]? := + (barringtonCompileStream_correctFor_internal formula target).2 index + +/-- The random-access compiler inherits the textbook instruction bound. -/ +theorem barringtonCompileStream_length_le (formula : BoolFormula) + (target : Equiv.Perm (Fin 5)) : + (barringtonCompileStream formula target).length ≤ 4 ^ formula.depth := by + rw [barringtonCompileStream_length] + exact barringtonCompile_length_le formula target + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonStreaming/Defs.lean b/Complexitylib/Circuits/BarringtonStreaming/Defs.lean new file mode 100644 index 00000000..ea798f85 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonStreaming/Defs.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCompiler.Defs + +/-! +# Random-access Barrington instruction streams -- definitions + +The ordinary executable compiler constructs its complete instruction list. +For uniform generation we instead need a description supporting one indexed +instruction query at a time. `BPStream` retains only the length and query +function; its combinators implement append, reversal/inversion, final +multiplication, and the four-block commutator without materializing a list. +-/ + +namespace Complexity + +/-- A random-access description of a branching program's instruction list. -/ +structure BPStream (w : ℕ) where + /-- Number of instructions in the represented program. -/ + length : ℕ + /-- Instruction at a zero-based index, or `none` outside the stream. -/ + instruction? : ℕ → Option (BPInstr w) + +namespace BPStream + +/-- The empty random-access program. -/ +def empty : BPStream w where + length := 0 + instruction? := fun _ => none + +/-- A one-instruction random-access program. -/ +def singleton (instruction : BPInstr w) : BPStream w where + length := 1 + instruction? := fun index => if index = 0 then some instruction else none + +/-- Concatenate two random-access programs. -/ +def append (left right : BPStream w) : BPStream w where + length := left.length + right.length + instruction? := fun index => + if index < left.length then left.instruction? index + else right.instruction? (index - left.length) + +/-- Reverse a random-access program and invert every instruction. -/ +def inverse (stream : BPStream w) : BPStream w where + length := stream.length + instruction? := fun index => + if index < stream.length then + (stream.instruction? (stream.length - 1 - index)).map BPInstr.inverse + else none + +/-- Fold a constant permutation into the final instruction. -/ +def postMul (stream : BPStream w) (permutation : Equiv.Perm (Fin w)) : + BPStream w where + length := max 1 stream.length + instruction? := fun index => + if stream.length = 0 then + if index = 0 then some (BPInstr.const permutation) else none + else if index + 1 = stream.length then + (stream.instruction? index).map fun instruction => + BPInstr.postMul instruction permutation + else stream.instruction? index + +/-- The four-block stream `left right left⁻¹ right⁻¹`. -/ +def commutator (left right : BPStream w) : BPStream w := + ((left.append right).append left.inverse).append right.inverse + +/-- A stream agrees with a concrete branching program when its length and +every indexed query are exact. -/ +def CorrectFor (stream : BPStream w) (program : BP w) : Prop := + stream.length = program.length ∧ + ∀ index, stream.instruction? index = program[index]? + +end BPStream + +/-- Exact number of instructions produced by Barrington compilation. Unlike +the compiler itself, this recurrence never constructs an instruction. -/ +def barringtonInstructionCount : BoolFormula → ℕ + | .var _ | .tru => 1 + | .fls => 0 + | .neg formula => max 1 (barringtonInstructionCount formula) + | .conj left right => + 2 * barringtonInstructionCount left + + 2 * barringtonInstructionCount right + | .disj left right => + 2 * max 1 (barringtonInstructionCount left) + + 2 * max 1 (barringtonInstructionCount right) + +/-- Random-access form of the executable Barrington compiler. No recursive +case constructs a complete branching-program list. -/ +def barringtonCompileStream : BoolFormula → + Equiv.Perm (Fin 5) → BPStream 5 + | .var index, target => + .singleton ⟨index, 1, target⟩ + | .tru, target => + .singleton (BPInstr.const target) + | .fls, _ => + .empty + | .neg formula, target => + (barringtonCompileStream formula target⁻¹).postMul target + | .conj left right, target => + .commutator + (barringtonCompileStream left (barringtonLeft target)) + (barringtonCompileStream right (barringtonRight target)) + | .disj left right, target => + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftStream := + (barringtonCompileStream left leftTarget⁻¹).postMul leftTarget + let rightStream := + (barringtonCompileStream right rightTarget⁻¹).postMul rightTarget + (BPStream.commutator leftStream rightStream).postMul target + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonStreaming/Internal.lean b/Complexitylib/Circuits/BarringtonStreaming/Internal.lean new file mode 100644 index 00000000..95fd5a95 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonStreaming/Internal.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonStreaming.Defs +import Complexitylib.Circuits.BarringtonCompiler + +/-! +# Random-access Barrington instruction streams -- proof internals +-/ + +namespace Complexity + +namespace BPStream + +theorem empty_correctFor_internal : + (empty : BPStream w).CorrectFor [] := by + simp [CorrectFor, empty] + +theorem singleton_correctFor_internal (instruction : BPInstr w) : + (singleton instruction).CorrectFor [instruction] := by + constructor + · rfl + · intro index + cases index <;> simp [singleton] + +theorem CorrectFor.append_internal {left right : BPStream w} + {leftProgram rightProgram : BP w} + (hleft : left.CorrectFor leftProgram) + (hright : right.CorrectFor rightProgram) : + (left.append right).CorrectFor (leftProgram ++ rightProgram) := by + constructor + · simp [append, hleft.1, hright.1] + · intro index + rw [append] + dsimp only + rw [hleft.1] + by_cases hindex : index < leftProgram.length + · rw [if_pos hindex, hleft.2, List.getElem?_append_left hindex] + · rw [if_neg hindex, hright.2, + List.getElem?_append_right (by omega)] + +theorem CorrectFor.inverse_internal {stream : BPStream w} + {program : BP w} (hstream : stream.CorrectFor program) : + stream.inverse.CorrectFor program.inverse := by + constructor + · simp [inverse, BP.inverse, hstream.1] + · intro index + rw [inverse] + dsimp only + rw [hstream.1] + by_cases hindex : index < program.length + · rw [if_pos hindex, hstream.2] + simp only [BP.inverse] + rw [List.getElem?_reverse (by simpa using hindex), + List.getElem?_map] + simp + · rw [if_neg hindex] + simp [BP.inverse, hindex] + +theorem CorrectFor.postMul_internal {stream : BPStream w} + {program : BP w} (hstream : stream.CorrectFor program) + (permutation : Equiv.Perm (Fin w)) : + (stream.postMul permutation).CorrectFor + (BP.postMul program permutation) := by + constructor + · simpa [postMul, hstream.1] using + (BP.length_postMul program permutation).symm + · intro index + induction program using List.reverseRecOn with + | nil => + have hlength : stream.length = 0 := by simpa using hstream.1 + change (if stream.length = 0 then + if index = 0 then some (BPInstr.const permutation) else none + else if index + 1 = stream.length then + (stream.instruction? index).map fun instruction => + BPInstr.postMul instruction permutation + else stream.instruction? index) = _ + rw [hlength] + cases index <;> simp [BP.postMul] + | append_singleton program last ih => + have hlength : stream.length = program.length + 1 := by + simpa using hstream.1 + change (if stream.length = 0 then + if index = 0 then some (BPInstr.const permutation) else none + else if index + 1 = stream.length then + (stream.instruction? index).map fun instruction => + BPInstr.postMul instruction permutation + else stream.instruction? index) = _ + rw [if_neg (by omega : stream.length ≠ 0)] + have hpost : BP.postMul (program ++ [last]) permutation = + program ++ [BPInstr.postMul last permutation] := by + simp [BP.postMul, List.modifyLast_concat] + rw [hpost] + by_cases hbefore : index < program.length + · rw [if_neg (by omega : index + 1 ≠ stream.length)] + rw [hstream.2, List.getElem?_append_left hbefore, + List.getElem?_append_left hbefore] + · by_cases hlast : index = program.length + · subst index + rw [if_pos (by omega : program.length + 1 = stream.length)] + simp [hstream.2] + · have hpast : program.length + 1 ≤ index := by omega + rw [if_neg (by omega : index + 1 ≠ stream.length)] + rw [hstream.2] + simp [List.getElem?_eq_none, hpast] + +theorem CorrectFor.commutator_internal {left right : BPStream w} + {leftProgram rightProgram : BP w} + (hleft : left.CorrectFor leftProgram) + (hright : right.CorrectFor rightProgram) : + (commutator left right).CorrectFor + (BP.commutatorProgram leftProgram rightProgram) := by + exact (((hleft.append_internal hright).append_internal + hleft.inverse_internal).append_internal hright.inverse_internal) + +end BPStream + +/-- Internal exact instruction-count recurrence. -/ +theorem barringtonInstructionCount_eq_length_internal + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + barringtonInstructionCount formula = + (barringtonCompile formula target).length := by + induction formula generalizing target with + | var index => rfl + | tru => rfl + | fls => rfl + | neg formula ih => + simp only [barringtonInstructionCount, barringtonCompile, + BP.length_postMul] + rw [← ih target⁻¹] + | conj left right ihLeft ihRight => + simp only [barringtonInstructionCount, barringtonCompile, + BP.length_commutatorProgram] + rw [← ihLeft (barringtonLeft target), + ← ihRight (barringtonRight target)] + | disj left right ihLeft ihRight => + simp only [barringtonInstructionCount, barringtonCompile, + BP.length_postMul, BP.length_commutatorProgram] + rw [← ihLeft (barringtonLeft target⁻¹)⁻¹, + ← ihRight (barringtonRight target⁻¹)⁻¹] + omega + +/-- Internal exactness of the random-access compiler. -/ +theorem barringtonCompileStream_correctFor_internal + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) : + (barringtonCompileStream formula target).CorrectFor + (barringtonCompile formula target) := by + induction formula generalizing target with + | var index => + exact BPStream.singleton_correctFor_internal _ + | tru => + exact BPStream.singleton_correctFor_internal _ + | fls => + exact BPStream.empty_correctFor_internal + | neg formula ih => + exact (ih target⁻¹).postMul_internal target + | conj left right ihLeft ihRight => + exact BPStream.CorrectFor.commutator_internal + (ihLeft (barringtonLeft target)) + (ihRight (barringtonRight target)) + | disj left right ihLeft ihRight => + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftStream := + (barringtonCompileStream left leftTarget⁻¹).postMul leftTarget + let rightStream := + (barringtonCompileStream right rightTarget⁻¹).postMul rightTarget + let leftProgram := BP.postMul + (barringtonCompile left leftTarget⁻¹) leftTarget + let rightProgram := BP.postMul + (barringtonCompile right rightTarget⁻¹) rightTarget + have hleft : leftStream.CorrectFor leftProgram := + (ihLeft leftTarget⁻¹).postMul_internal leftTarget + have hright : rightStream.CorrectFor rightProgram := + (ihRight rightTarget⁻¹).postMul_internal rightTarget + exact (hleft.commutator_internal hright).postMul_internal target + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonTokenQuery.lean b/Complexitylib/Circuits/BarringtonTokenQuery.lean new file mode 100644 index 00000000..d9c890a0 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonTokenQuery.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonTokenQuery.Defs +import Complexitylib.Circuits.BarringtonTokenQuery.Internal + +/-! +# Direct Barrington queries over postfix token streams + +This module bridges the canonical postfix formula representation to the +fixed-address Barrington query. Binary children are recovered with the +backwards owed-subtree scan, so the recursive controller never reconstructs an +inductive formula or materializes a compiled branching program. + +## Main results + +- `FormulaCode.postfixBinaryChildren?_tokens` -- exact child splitting. +- `barringtonTokensFirstOccupiedSlot?_eq` -- exact structural first address. +- `barringtonTokensLastOccupiedSlot?_eq` -- exact structural last address. +- `barringtonCompileTokensSlot?_eq_instruction?` -- token-stream queries agree + with the list-valued fixed-slot compiler. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- The postfix splitter recovers the exact canonical children below a binary +root. -/ +theorem postfixBinaryChildren?_tokens (left right : BoolFormula) (op : Token) : + postfixBinaryChildren? (tokens left ++ tokens right ++ [op]) = + some (tokens left, tokens right) := + postfixBinaryChildren?_tokens_internal left right op + +end FormulaCode + +/-- Token-stream traversal computes the same first occupied address as the +formula-valued recurrence. -/ +theorem barringtonTokensFirstOccupiedSlot?_eq (fuel : ℕ) + (formula : BoolFormula) : + barringtonTokensFirstOccupiedSlot? fuel (FormulaCode.tokens formula) = + barringtonFirstOccupiedSlot? fuel formula := + (barringtonTokensOccupiedSlots_correct_internal fuel formula).1 + +/-- Token-stream traversal computes the same last occupied address as the +formula-valued recurrence. -/ +theorem barringtonTokensLastOccupiedSlot?_eq (fuel : ℕ) + (formula : BoolFormula) : + barringtonTokensLastOccupiedSlot? fuel (FormulaCode.tokens formula) = + barringtonLastOccupiedSlot? fuel formula := + (barringtonTokensOccupiedSlots_correct_internal fuel formula).2 + +/-- Every direct query over canonical postfix tokens agrees with the +list-valued fixed-address compiler. -/ +theorem barringtonCompileTokensSlot?_eq_instruction? (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (slot : ℕ) : + barringtonCompileTokensSlot? fuel (FormulaCode.tokens formula) + target slot = + BPSlots.instruction? + (barringtonCompileSlots fuel formula target) slot := by + rw [barringtonCompileTokensSlot?_correct_internal] + exact barringtonCompileSlot?_correct_internal fuel formula target slot + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonTokenQuery/Defs.lean b/Complexitylib/Circuits/BarringtonTokenQuery/Defs.lean new file mode 100644 index 00000000..ade3fec8 --- /dev/null +++ b/Complexitylib/Circuits/BarringtonTokenQuery/Defs.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonSlotQuery.Defs +import Complexitylib.Circuits.FormulaEncoding.Navigation.Defs + +/-! +# Direct Barrington queries over postfix token streams -- definitions + +The machine-facing controller receives a canonical postfix token stream rather +than an inductive `BoolFormula`. A binary root recovers its right-child width +with the backwards owed-subtree scan, then represents both children by slices +of the same stream. The recursive Barrington query follows only one fixed +base-four block. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- Split the body below a postfix binary root into its left and right child +token streams. Malformed streams may fail. -/ +def postfixBinaryChildren? (stream : List Token) : + Option (List Token × List Token) := do + let body := stream.dropLast + let rightWidth ← subtreeWidth? stream (stream.length - 2) + if rightWidth ≤ body.length then + let leftWidth := body.length - rightWidth + some (body.take leftWidth, body.drop leftWidth) + else + none + +end FormulaCode + +/-- First occupied fixed address, computed from a postfix token stream. -/ +def barringtonTokensFirstOccupiedSlot? : ℕ → + List FormulaCode.Token → Option ℕ + | 0, stream => + match stream.getLast? with + | some (.var _) | some .tru => some 0 + | _ => none + | fuel + 1, stream => + match stream.getLast? with + | some (.var _) | some .tru => some 0 + | some .fls => none + | some .neg => + some ((barringtonTokensFirstOccupiedSlot? + fuel stream.dropLast).getD 0) + | some .conj => + match FormulaCode.postfixBinaryChildren? stream with + | none => none + | some (left, right) => + match barringtonTokensFirstOccupiedSlot? fuel left with + | some slot => some slot + | none => + (barringtonTokensFirstOccupiedSlot? fuel right).map + (4 ^ fuel + ·) + | some .disj => + match FormulaCode.postfixBinaryChildren? stream with + | none => none + | some (left, _) => + some ((barringtonTokensFirstOccupiedSlot? fuel left).getD 0) + | none => none + +/-- Last occupied fixed address, computed from a postfix token stream. -/ +def barringtonTokensLastOccupiedSlot? : ℕ → + List FormulaCode.Token → Option ℕ + | 0, stream => + match stream.getLast? with + | some (.var _) | some .tru => some 0 + | _ => none + | fuel + 1, stream => + match stream.getLast? with + | some (.var _) | some .tru => some 0 + | some .fls => none + | some .neg => + some ((barringtonTokensLastOccupiedSlot? + fuel stream.dropLast).getD 0) + | some .conj => + match FormulaCode.postfixBinaryChildren? stream with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + match barringtonTokensFirstOccupiedSlot? fuel right with + | some slot => + some (3 * blockSize + (blockSize - 1 - slot)) + | none => + (barringtonTokensFirstOccupiedSlot? fuel left).map + fun slot => 2 * blockSize + (blockSize - 1 - slot) + | some .disj => + match FormulaCode.postfixBinaryChildren? stream with + | none => none + | some (_, right) => + let blockSize := 4 ^ fuel + let firstRight := + (barringtonTokensFirstOccupiedSlot? fuel right).getD 0 + some (3 * blockSize + (blockSize - 1 - firstRight)) + | none => none + +/-- Query one fixed-address Barrington instruction directly from a postfix +token stream. -/ +def barringtonCompileTokensSlot? : ℕ → List FormulaCode.Token → + Equiv.Perm (Fin 5) → ℕ → Option (BPInstr 5) + | fuel, stream, target, slot => + match fuel, stream.getLast? with + | _, some (.var index) => + if slot = 0 then some ⟨index, 1, target⟩ else none + | _, some .tru => + if slot = 0 then some (BPInstr.const target) else none + | _, some .fls => none + | 0, _ => none + | fuel + 1, some .neg => + let blockSize := 4 ^ fuel + if slot < blockSize then + barringtonPostMulSlot? + (barringtonCompileTokensSlot? fuel stream.dropLast target⁻¹) + (barringtonTokensLastOccupiedSlot? fuel stream.dropLast) + target slot + else + none + | fuel + 1, some .conj => + match FormulaCode.postfixBinaryChildren? stream with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + let leftQuery := barringtonCompileTokensSlot? fuel left + (barringtonLeft target) + let rightQuery := barringtonCompileTokensSlot? fuel right + (barringtonRight target) + if slot < blockSize then + leftQuery slot + else if slot < 2 * blockSize then + rightQuery (slot - blockSize) + else if slot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (slot - 2 * blockSize) + else if slot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (slot - 3 * blockSize) + else + none + | fuel + 1, some .disj => + match FormulaCode.postfixBinaryChildren? stream with + | none => none + | some (left, right) => + let blockSize := 4 ^ fuel + let innerTarget := target⁻¹ + let leftTarget := barringtonLeft innerTarget + let rightTarget := barringtonRight innerTarget + let leftQuery := barringtonPostMulSlot? + (barringtonCompileTokensSlot? fuel left leftTarget⁻¹) + (barringtonTokensLastOccupiedSlot? fuel left) leftTarget + let rightQuery := barringtonPostMulSlot? + (barringtonCompileTokensSlot? fuel right rightTarget⁻¹) + (barringtonTokensLastOccupiedSlot? fuel right) rightTarget + let commutatorQuery := fun localSlot => + if localSlot < blockSize then + leftQuery localSlot + else if localSlot < 2 * blockSize then + rightQuery (localSlot - blockSize) + else if localSlot < 3 * blockSize then + barringtonInverseSlot? blockSize leftQuery + (localSlot - 2 * blockSize) + else if localSlot < 4 * blockSize then + barringtonInverseSlot? blockSize rightQuery + (localSlot - 3 * blockSize) + else + none + let firstRight := + (barringtonTokensFirstOccupiedSlot? fuel right).getD 0 + let commutatorLast := + 3 * blockSize + (blockSize - 1 - firstRight) + barringtonPostMulSlot? commutatorQuery + (some commutatorLast) target slot + | _, none => none + +end Complexity diff --git a/Complexitylib/Circuits/BarringtonTokenQuery/Internal.lean b/Complexitylib/Circuits/BarringtonTokenQuery/Internal.lean new file mode 100644 index 00000000..60c3c51f --- /dev/null +++ b/Complexitylib/Circuits/BarringtonTokenQuery/Internal.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonSlotQuery.Internal +import Complexitylib.Circuits.BarringtonTokenQuery.Defs +import Complexitylib.Circuits.FormulaEncoding.Navigation.Internal + +/-! +# Direct Barrington queries over postfix token streams -- proof internals +-/ + +namespace Complexity + +namespace FormulaCode + +theorem postfixBinaryChildren?_tokens_internal + (left right : BoolFormula) (op : Token) : + postfixBinaryChildren? (tokens left ++ tokens right ++ [op]) = + some (tokens left, tokens right) := by + rw [postfixBinaryChildren?] + simp only [List.dropLast_concat, List.length_append, + List.length_singleton, length_tokens_internal] + rw [show left.size + right.size + 1 - 2 = + left.size + right.size - 1 by omega] + rw [subtreeWidth?_tokens_binary_right_internal] + change (if right.size ≤ left.size + right.size then + some + ((tokens left ++ tokens right).take + (left.size + right.size - right.size), + (tokens left ++ tokens right).drop + (left.size + right.size - right.size)) + else none) = some (tokens left, tokens right) + rw [if_pos (by omega)] + rw [show left.size + right.size - right.size = left.size by omega] + rw [← length_tokens_internal left] + simp + +theorem postfixBinaryChildren?_tokens_assoc_internal + (left right : BoolFormula) (op : Token) : + postfixBinaryChildren? (tokens left ++ (tokens right ++ [op])) = + some (tokens left, tokens right) := by + rw [← List.append_assoc] + exact postfixBinaryChildren?_tokens_internal left right op + +end FormulaCode + +theorem barringtonTokensOccupiedSlots_correct_internal (fuel : ℕ) + (formula : BoolFormula) : + barringtonTokensFirstOccupiedSlot? fuel (FormulaCode.tokens formula) = + barringtonFirstOccupiedSlot? fuel formula ∧ + barringtonTokensLastOccupiedSlot? fuel (FormulaCode.tokens formula) = + barringtonLastOccupiedSlot? fuel formula := by + induction fuel generalizing formula with + | zero => + cases formula <;> + simp [barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, barringtonFirstOccupiedSlot?, + barringtonLastOccupiedSlot?, FormulaCode.tokens] + | succ fuel ih => + cases formula with + | var index => + simp [barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, barringtonFirstOccupiedSlot?, + barringtonLastOccupiedSlot?, FormulaCode.tokens] + | tru => + simp [barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, barringtonFirstOccupiedSlot?, + barringtonLastOccupiedSlot?, FormulaCode.tokens] + | fls => + simp [barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, barringtonFirstOccupiedSlot?, + barringtonLastOccupiedSlot?, FormulaCode.tokens] + | neg formula => + obtain ⟨hfirst, hlast⟩ := ih formula + simp [barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, barringtonFirstOccupiedSlot?, + barringtonLastOccupiedSlot?, FormulaCode.tokens, hfirst, hlast] + | conj left right => + obtain ⟨hleftFirst, _⟩ := ih left + obtain ⟨hrightFirst, _⟩ := ih right + simp only [barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, barringtonFirstOccupiedSlot?, + barringtonLastOccupiedSlot?, FormulaCode.tokens, + List.getLast?_concat] + rw [FormulaCode.postfixBinaryChildren?_tokens_internal] + simp only [hleftFirst, hrightFirst] + exact ⟨rfl, rfl⟩ + | disj left right => + obtain ⟨hleftFirst, _⟩ := ih left + obtain ⟨hrightFirst, _⟩ := ih right + simp only [barringtonTokensFirstOccupiedSlot?, + barringtonTokensLastOccupiedSlot?, barringtonFirstOccupiedSlot?, + barringtonLastOccupiedSlot?, FormulaCode.tokens, + List.getLast?_concat] + rw [FormulaCode.postfixBinaryChildren?_tokens_internal] + simp only [hleftFirst, hrightFirst] + exact ⟨True.intro, True.intro⟩ + +theorem barringtonCompileTokensSlot?_correct_internal (fuel : ℕ) + (formula : BoolFormula) (target : Equiv.Perm (Fin 5)) (slot : ℕ) : + barringtonCompileTokensSlot? fuel (FormulaCode.tokens formula) + target slot = barringtonCompileSlot? fuel formula target slot := by + induction fuel generalizing formula target slot with + | zero => + cases formula <;> + simp [barringtonCompileTokensSlot?, barringtonCompileSlot?, + FormulaCode.tokens] + | succ fuel ih => + cases formula with + | var index => + simp [barringtonCompileTokensSlot?, barringtonCompileSlot?, + FormulaCode.tokens] + | tru => + simp [barringtonCompileTokensSlot?, barringtonCompileSlot?, + FormulaCode.tokens] + | fls => + simp [barringtonCompileTokensSlot?, barringtonCompileSlot?, + FormulaCode.tokens] + | neg formula => + have hlast := + (barringtonTokensOccupiedSlots_correct_internal fuel formula).2 + have hquery : + barringtonCompileTokensSlot? fuel + (FormulaCode.tokens formula) target⁻¹ = + barringtonCompileSlot? fuel formula target⁻¹ := by + funext querySlot + exact ih formula target⁻¹ querySlot + simp [barringtonCompileTokensSlot?, barringtonCompileSlot?, + FormulaCode.tokens, hquery, hlast] + | conj left right => + have hleftQuery : + barringtonCompileTokensSlot? fuel (FormulaCode.tokens left) + (barringtonLeft target) = + barringtonCompileSlot? fuel left + (barringtonLeft target) := by + funext querySlot + exact ih left (barringtonLeft target) querySlot + have hrightQuery : + barringtonCompileTokensSlot? fuel (FormulaCode.tokens right) + (barringtonRight target) = + barringtonCompileSlot? fuel right + (barringtonRight target) := by + funext querySlot + exact ih right (barringtonRight target) querySlot + simp [barringtonCompileTokensSlot?, barringtonCompileSlot?, + FormulaCode.tokens, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hleftQuery, hrightQuery] + | disj left right => + have hleftLast := + (barringtonTokensOccupiedSlots_correct_internal fuel left).2 + have hrightFirst := + (barringtonTokensOccupiedSlots_correct_internal fuel right).1 + have hrightLast := + (barringtonTokensOccupiedSlots_correct_internal fuel right).2 + have hleftQuery (childTarget : Equiv.Perm (Fin 5)) : + barringtonCompileTokensSlot? fuel (FormulaCode.tokens left) + childTarget = + barringtonCompileSlot? fuel left childTarget := by + funext querySlot + exact ih left childTarget querySlot + have hrightQuery (childTarget : Equiv.Perm (Fin 5)) : + barringtonCompileTokensSlot? fuel (FormulaCode.tokens right) + childTarget = + barringtonCompileSlot? fuel right childTarget := by + funext querySlot + exact ih right childTarget querySlot + simp [barringtonCompileTokensSlot?, barringtonCompileSlot?, + FormulaCode.tokens, + FormulaCode.postfixBinaryChildren?_tokens_assoc_internal, + hleftLast, hrightFirst, hrightLast, + hleftQuery, hrightQuery] + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding.lean b/Complexitylib/Circuits/BranchingProgramEncoding.lean new file mode 100644 index 00000000..c657cf53 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Internal + +/-! +# Canonical encoding of width-five branching programs + +This module exposes the machine-facing codec used by the uniform Barrington +track. Every `S₅` permutation is ranked in a fixed computable table and stored +in seven bits. Instructions add a terminated-unary variable index, and a +program adds a terminated-unary instruction count. + +The exact decoder is a left inverse, serialization is injective, nonempty +trailing data is rejected, and the code length is explicit. Consequently the +remaining uniformity proof can target one stable bit format without carrying +finite permutation proofs on the machine tape. + +## Main results + +- `BPCode.Perm5.decodePrefix?_encode_append` -- permutation-field round trip. +- `BPCode.Instr.decodePrefix?_encode_append` -- instruction round trip. +- `BPCode.Program.decode?_encode` -- whole-program round trip. +- `BPCode.Program.encode_injective` -- canonical codes are unambiguous. +- `BPCode.Program.length_encode` -- exact serialization length. +-/ + +namespace Complexity + +namespace BPCode + +namespace Perm5 + +/-- The explicit permutation table has exactly `5! = 120` entries. -/ +theorem table_length : table.length = 120 := + table_length_internal + +/-- Every permutation of `Fin 5` occurs in the fixed table. -/ +theorem mem_table (permutation : Equiv.Perm (Fin 5)) : permutation ∈ table := + mem_table_internal permutation + +/-- Every canonical table position fits in the seven-bit field. -/ +theorem index_lt_two_pow (permutation : Equiv.Perm (Fin 5)) : + index permutation < 2 ^ bitWidth := + index_lt_two_pow_internal permutation + +/-- Every encoded permutation field has the fixed width of seven bits. -/ +@[simp] theorem length_encode (permutation : Equiv.Perm (Fin 5)) : + (encode permutation).length = bitWidth := + length_encode_internal permutation + +/-- Decoding an encoded permutation in front of any suffix recovers both. -/ +@[simp] theorem decodePrefix?_encode_append + (permutation : Equiv.Perm (Fin 5)) (suffix : List Bool) : + decodePrefix? (encode permutation ++ suffix) = + some (permutation, suffix) := + decodePrefix?_encode_append_internal permutation suffix + +end Perm5 + +namespace Instr + +/-- An instruction uses its unary variable length plus fourteen permutation +bits, for a total of `var + 15`. -/ +@[simp] theorem length_encode (instruction : BPInstr 5) : + (encode instruction).length = instruction.var + 15 := + length_encode_internal instruction + +/-- Decoding an encoded instruction in front of any suffix recovers both. -/ +@[simp] theorem decodePrefix?_encode_append + (instruction : BPInstr 5) (suffix : List Bool) : + decodePrefix? (encode instruction ++ suffix) = + some (instruction, suffix) := + decodePrefix?_encode_append_internal instruction suffix + +end Instr + +namespace Program + +/-- Fixed-count decoding consumes exactly the requested encoded instructions. -/ +@[simp] theorem decodeInstructions?_flatMap_encode_append + (program : BP 5) (suffix : List Bool) : + decodeInstructions? program.length (program.flatMap Instr.encode ++ suffix) = + some (program, suffix) := + decodeInstructions?_flatMap_encode_append_internal program suffix + +/-- Prefix decoding preserves a caller-supplied suffix. -/ +@[simp] theorem decodePrefix?_encode_append + (program : BP 5) (suffix : List Bool) : + decodePrefix? (encode program ++ suffix) = some (program, suffix) := + decodePrefix?_encode_append_internal program suffix + +/-- Exact decoding is a left inverse of canonical serialization. -/ +@[simp] theorem decode?_encode (program : BP 5) : + decode? (encode program) = some program := + decode?_encode_internal program + +/-- Canonical program serialization is injective. -/ +theorem encode_injective : Function.Injective encode := + encode_injective_internal + +/-- Exact decoding rejects nonempty trailing data. -/ +theorem decode?_encode_append_eq_none + (program : BP 5) {suffix : List Bool} (hsuffix : suffix ≠ []) : + decode? (encode program ++ suffix) = none := + decode?_encode_append_eq_none_internal program hsuffix + +/-- Exact code length: one unary count field plus all instruction fields. -/ +@[simp] theorem length_encode (program : BP 5) : + (encode program).length = + program.length + 1 + + (program.map fun instruction => instruction.var + 15).sum := + length_encode_internal program + +/-- If all variable indices are bounded, serialization has the corresponding +linear-in-program-length bound. -/ +theorem length_encode_le (program : BP 5) (variableBound : ℕ) + (hvars : ∀ instruction ∈ program, instruction.var ≤ variableBound) : + (encode program).length ≤ + program.length + 1 + program.length * (variableBound + 15) := + length_encode_le_internal program variableBound hvars + +end Program + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Defs.lean new file mode 100644 index 00000000..65938e14 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Defs.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCompiler.Defs +import Complexitylib.Circuits.Encoding.Defs +import Complexitylib.Mathlib.NatBits + +/-! +# Machine-facing encoding of width-five branching programs + +This file defines a deterministic, proof-free bit format for the width-`5` +permutation branching programs produced by Barrington's theorem. Permutations +are represented by their rank in the computable `S₅` enumeration, using seven +bits because `|S₅| = 120 < 2^7`. Variable indices and the instruction count use +the existing terminated-unary circuit codec. + +An instruction is encoded as its variable field followed by two fixed-width +permutation fields. A program starts with its instruction count, so exact +decoding rejects truncation and trailing garbage. +-/ + +namespace Complexity + +namespace BPCode + +namespace Perm5 + +/-- Number of bits in the canonical rank encoding of an `S₅` permutation. -/ +def bitWidth : ℕ := 7 + +/-- The fixed computable table used to rank and unrank `S₅`. -/ +def table : List (Equiv.Perm (Fin 5)) := + allPermutationsFin 5 + +/-- The canonical table position of a permutation. -/ +def index (permutation : Equiv.Perm (Fin 5)) : ℕ := + table.idxOf permutation + +/-- Encode an `S₅` permutation by its seven-bit table position. -/ +def encode (permutation : Equiv.Perm (Fin 5)) : List Bool := + Nat.toBits bitWidth (index permutation) + +/-- Decode one fixed-width permutation field and return the unused suffix. -/ +def decodePrefix? (bits : List Bool) : Option (Equiv.Perm (Fin 5) × List Bool) := + if bits.length < bitWidth then + none + else + match table[Nat.fromBits (bits.take bitWidth)]? with + | none => none + | some permutation => some (permutation, bits.drop bitWidth) + +end Perm5 + +namespace Instr + +/-- Encode one width-`5` instruction as a terminated-unary variable followed +by its two seven-bit permutation ranks. -/ +def encode (instruction : BPInstr 5) : List Bool := + CircuitCode.NatCode.encode instruction.var ++ + Perm5.encode instruction.perm0 ++ Perm5.encode instruction.perm1 + +/-- Decode one instruction prefix and return the unused suffix. -/ +def decodePrefix? (bits : List Bool) : Option (BPInstr 5 × List Bool) := do + let (var, rest) ← CircuitCode.NatCode.decodePrefix? bits + let (perm0, rest) ← Perm5.decodePrefix? rest + let (perm1, rest) ← Perm5.decodePrefix? rest + some (⟨var, perm0, perm1⟩, rest) + +end Instr + +namespace Program + +/-- Decode exactly `count` instruction prefixes and return the unused suffix. -/ +def decodeInstructions? : ℕ → List Bool → Option (BP 5 × List Bool) + | 0, bits => some ([], bits) + | count + 1, bits => do + let (instruction, rest) ← Instr.decodePrefix? bits + let (program, rest) ← decodeInstructions? count rest + some (instruction :: program, rest) + +/-- Canonically encode a width-`5` branching program. -/ +def encode (program : BP 5) : List Bool := + CircuitCode.NatCode.encode program.length ++ program.flatMap Instr.encode + +/-- Decode one complete program prefix and return the unused suffix. -/ +def decodePrefix? (bits : List Bool) : Option (BP 5 × List Bool) := do + let (count, rest) ← CircuitCode.NatCode.decodePrefix? bits + decodeInstructions? count rest + +/-- Decode exactly one width-`5` branching program. Trailing bits are rejected. -/ +def decode? (bits : List Bool) : Option (BP 5) := + match decodePrefix? bits with + | some (program, []) => some program + | _ => none + +end Program + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Internal.lean new file mode 100644 index 00000000..c00165f0 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Internal.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonCompiler +import Complexitylib.Circuits.BranchingProgramEncoding.Defs +import Complexitylib.Circuits.Encoding + +/-! +# Width-five branching-program codec internals + +This module proves round-trip and length properties of the canonical codec. +Public statements are re-exported by +`Complexitylib.Circuits.BranchingProgramEncoding`. +-/ + +set_option maxRecDepth 100000 + +namespace Complexity + +namespace BPCode + +namespace Perm5 + +/-- Internal cardinality check for the explicit `S₅` table. -/ +theorem table_length_internal : table.length = 120 := by + decide + +/-- Internal completeness of the fixed permutation table. -/ +theorem mem_table_internal (permutation : Equiv.Perm (Fin 5)) : + permutation ∈ table := by + simpa only [table] using mem_allPermutationsFin permutation + +/-- Internal proof that every canonical permutation rank fits in seven bits. -/ +theorem index_lt_two_pow_internal (permutation : Equiv.Perm (Fin 5)) : + index permutation < 2 ^ bitWidth := by + have hindex : index permutation < table.length := + List.idxOf_lt_length_of_mem (mem_table_internal permutation) + rw [table_length_internal] at hindex + simpa only [bitWidth] using (show index permutation < 128 by omega) + +/-- Internal exact length of a permutation field. -/ +theorem length_encode_internal (permutation : Equiv.Perm (Fin 5)) : + (encode permutation).length = bitWidth := by + simp [encode, Nat.length_toBits] + +/-- Internal permutation-prefix round trip. -/ +theorem decodePrefix?_encode_append_internal + (permutation : Equiv.Perm (Fin 5)) (suffix : List Bool) : + decodePrefix? (encode permutation ++ suffix) = + some (permutation, suffix) := by + have hmem := mem_table_internal permutation + have hindexTable : index permutation < table.length := + List.idxOf_lt_length_of_mem hmem + have hindexPow := index_lt_two_pow_internal permutation + simp [decodePrefix?, encode, Nat.length_toBits, Nat.fromBits_toBits hindexPow, + hindexTable] + exact List.getElem_idxOf hindexTable + +end Perm5 + +namespace Instr + +/-- Internal exact instruction-code length. -/ +theorem length_encode_internal (instruction : BPInstr 5) : + (encode instruction).length = instruction.var + 15 := by + simp [encode, CircuitCode.NatCode.length_encode, + Perm5.length_encode_internal, Perm5.bitWidth] + +/-- Internal instruction-prefix round trip. -/ +theorem decodePrefix?_encode_append_internal + (instruction : BPInstr 5) (suffix : List Bool) : + decodePrefix? (encode instruction ++ suffix) = + some (instruction, suffix) := by + rcases instruction with ⟨var, perm0, perm1⟩ + simp [encode, decodePrefix?, List.append_assoc, + Perm5.decodePrefix?_encode_append_internal] + +end Instr + +namespace Program + +/-- Internal fixed-count instruction-list round trip. -/ +theorem decodeInstructions?_flatMap_encode_append_internal + (program : BP 5) (suffix : List Bool) : + decodeInstructions? program.length (program.flatMap Instr.encode ++ suffix) = + some (program, suffix) := by + induction program with + | nil => simp [decodeInstructions?] + | cons instruction program ih => + simp [decodeInstructions?, ih, List.append_assoc, + Instr.decodePrefix?_encode_append_internal] + +/-- Internal program-prefix round trip. -/ +theorem decodePrefix?_encode_append_internal + (program : BP 5) (suffix : List Bool) : + decodePrefix? (encode program ++ suffix) = some (program, suffix) := by + simp [decodePrefix?, encode, List.append_assoc, + decodeInstructions?_flatMap_encode_append_internal] + +/-- Internal exact-decoder round trip. -/ +theorem decode?_encode_internal (program : BP 5) : + decode? (encode program) = some program := by + unfold decode? + rw [show encode program = encode program ++ [] by simp, + decodePrefix?_encode_append_internal] + +/-- Internal proof that canonical program serialization is injective. -/ +theorem encode_injective_internal : Function.Injective encode := by + intro left right heq + have hleft := decode?_encode_internal left + have hright := decode?_encode_internal right + rw [heq] at hleft + exact Option.some.inj (hleft.symm.trans hright) + +/-- Internal proof that exact decoding rejects a nonempty trailing suffix. -/ +theorem decode?_encode_append_eq_none_internal + (program : BP 5) {suffix : List Bool} (hsuffix : suffix ≠ []) : + decode? (encode program ++ suffix) = none := by + unfold decode? + rw [decodePrefix?_encode_append_internal] + simp [hsuffix] + +/-- Internal exact program-code length. -/ +theorem length_encode_internal (program : BP 5) : + (encode program).length = + program.length + 1 + + (program.map fun instruction => instruction.var + 15).sum := by + simp [encode, CircuitCode.NatCode.length_encode, List.length_flatMap, + Instr.length_encode_internal] + +/-- Internal polynomial bound when every referenced variable is bounded. -/ +theorem length_encode_le_internal (program : BP 5) (variableBound : ℕ) + (hvars : ∀ instruction ∈ program, instruction.var ≤ variableBound) : + (encode program).length ≤ + program.length + 1 + program.length * (variableBound + 15) := by + have hsum : + (program.map fun instruction => instruction.var + 15).sum ≤ + program.length * (variableBound + 15) := by + induction program with + | nil => simp + | cons instruction program ih => + have hinstruction : instruction.var ≤ variableBound := + hvars instruction (by simp) + have htail : ∀ item ∈ program, item.var ≤ variableBound := by + intro item hitem + exact hvars item (by simp [hitem]) + specialize ih htail + simp only [List.map_cons, List.sum_cons, List.length_cons] + calc + instruction.var + 15 + + (program.map fun item => item.var + 15).sum ≤ + (variableBound + 15) + + program.length * (variableBound + 15) := + Nat.add_le_add (Nat.add_le_add_right hinstruction 15) ih + _ = (program.length + 1) * (variableBound + 15) := by + simp only [Nat.add_mul, Nat.one_mul] + ac_rfl + rw [length_encode_internal] + exact Nat.add_le_add_left hsum (program.length + 1) + +end Program + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine.lean new file mode 100644 index 00000000..9870889f --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.Instr +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScan +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanLoop +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanToken +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.OutputProbe +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.OutputProbeToken +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotBranch +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotCapture +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotDescend +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotPosition +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotStep + +/-! +# Machine emission of branching-program codes + +Concrete serializer leaves for the canonical width-five branching-program +encoding, together with the two-bit recursive slot dispatcher. +-/ diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan.lean new file mode 100644 index 00000000..f3a8d335 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScan.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScan.Internal + +/-! +# Forward postfix scan controller + +This module exposes the concrete numeric controller used after each decoded +formula token in the forward child-boundary scan. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- The concrete arity update realizes saturated postfix-stack arithmetic on +canonical binary state, with an explicit positive-height premise for binary +operators. -/ +theorem forwardScanHeightTM_hoareTime + (layout : ForwardScanLayout n) (arity height : ℕ) + (harity : arity ≤ 2) (hpositive : arity = 2 → 1 ≤ height) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hheight : (work₀ layout.heightIdx).HasBinaryNat height) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ layout.heightIdx → Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanHeightTM layout arity).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ layout.heightIdx + ((Tape.init ((height + 1 - arity).bits.map Γ.ofBool)).move + Dir3.right) ∧ + out = out₀) + (forwardScanHeightTime arity height) := + forwardScanHeightTM_hoareTime_internal layout arity height harity hpositive + inp₀ work₀ out₀ hheight hinput hother houtput + +/-- The selected height-one branch copies both current boundaries and restores +the equality verdict to canonical zero. -/ +theorem forwardScanCopyBoundaryTM_hoareTime + (layout : ForwardScanLayout n) + (tokenCount cursor lastOneCount lastOneCursor : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hcount : (work₀ layout.tokenCountIdx).HasBinaryNat tokenCount) + (hcursor : (work₀ layout.cursorIdx).HasBinaryNat cursor) + (hlastCount : + (work₀ layout.lastOneCountIdx).HasBinaryNat lastOneCount) + (hlastCursor : + (work₀ layout.lastOneCursorIdx).HasBinaryNat lastOneCursor) + (hscratch : (work₀ layout.copyScratchIdx).HasBinaryNat 0) + (hresult : (work₀ layout.resultIdx).HasBinaryString [true]) + (hresultStart : (work₀ layout.resultIdx).cells 0 = Γ.start) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanCopyBoundaryTM layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = forwardScanBoundaryWork layout work₀ tokenCount cursor ∧ + out = out₀) + (forwardScanRecordBoundaryTime true tokenCount cursor lastOneCount + lastOneCursor) := + forwardScanCopyBoundaryTM_hoareTime_internal layout tokenCount cursor + lastOneCount lastOneCursor inp₀ work₀ out₀ hcount hcursor hlastCount + hlastCursor hscratch hresult hresultStart hinput hwork houtput + +/-- After the stack-height update, the concrete controller increments the +token count, records both current boundaries exactly when the height is one, +and restores its verdict scratch. -/ +theorem forwardScanAfterHeightTM_hoareTime + (layout : ForwardScanLayout n) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hframe : ForwardScanFrame layout cursor height tokenCount lastOneCount + lastOneCursor work₀) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanAfterHeightTM layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = forwardScanAfterHeightWork layout work₀ height tokenCount + cursor ∧ + out = out₀) + (forwardScanAfterHeightTime height tokenCount cursor lastOneCount + lastOneCursor) := + forwardScanAfterHeightTM_hoareTime_internal layout cursor height tokenCount + lastOneCount lastOneCursor inp₀ work₀ out₀ hframe hinput hwork houtput + +/-- One call realizes the complete numeric update of a decoded postfix token: +stack height, token count, conditional child-boundary copies, and scratch +restoration. -/ +theorem forwardScanTokenStepTM_hoareTime + (layout : ForwardScanLayout n) (arity height tokenCount cursor + lastOneCount lastOneCursor : ℕ) + (harity : arity ≤ 2) (hpositive : arity = 2 → 1 ≤ height) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hframe : ForwardScanFrame layout cursor height tokenCount lastOneCount + lastOneCursor work₀) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanTokenStepTM layout arity).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = forwardScanTokenStepWork layout work₀ arity height tokenCount + cursor ∧ + out = out₀) + (forwardScanTokenStepTime arity height tokenCount cursor lastOneCount + lastOneCursor) := + forwardScanTokenStepTM_hoareTime_internal layout arity height tokenCount + cursor lastOneCount lastOneCursor harity hpositive inp₀ work₀ out₀ + hframe hinput hwork houtput + +/-- The arity-dependent stack-height update never moves output left. -/ +theorem forwardScanHeightTM_isTransducer + (layout : ForwardScanLayout n) (arity : ℕ) : + (forwardScanHeightTM layout arity).IsTransducer := + forwardScanHeightTM_isTransducer_internal layout arity + +/-- Copying a selected child boundary and clearing its verdict is append-only. -/ +theorem forwardScanCopyBoundaryTM_isTransducer + (layout : ForwardScanLayout n) : + (forwardScanCopyBoundaryTM layout).IsTransducer := + forwardScanCopyBoundaryTM_isTransducer_internal layout + +/-- Conditional child-boundary recording is append-only. -/ +theorem forwardScanRecordBoundaryTM_isTransducer + (layout : ForwardScanLayout n) : + (forwardScanRecordBoundaryTM layout).IsTransducer := + forwardScanRecordBoundaryTM_isTransducer_internal layout + +/-- The complete post-height numeric update is append-only. -/ +theorem forwardScanAfterHeightTM_isTransducer + (layout : ForwardScanLayout n) : + (forwardScanAfterHeightTM layout).IsTransducer := + forwardScanAfterHeightTM_isTransducer_internal layout + +/-- One complete numeric token update is append-only. -/ +theorem forwardScanTokenStepTM_isTransducer + (layout : ForwardScanLayout n) (arity : ℕ) : + (forwardScanTokenStepTM layout arity).IsTransducer := + forwardScanTokenStepTM_isTransducer_internal layout arity + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan/Defs.lean new file mode 100644 index 00000000..9cb591d7 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan/Defs.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +import Complexitylib.Models.TuringMachine.Registers.RegisterOps +import Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs + +/-! +# Forward postfix scan controller -- definitions + +This layer implements the numeric update performed after one formula token has +been decoded. It updates the postfix stack height and token count, tests whether +the new height is one, and if so copies the current token and bit cursors into +the retained child-boundary registers. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Eight distinct work tapes used by the forward postfix scan state. + +The role order is bit cursor, stack height, token count, last height-one token +count, last height-one bit cursor, constant one, equality verdict, and binary +copy scratch. -/ +structure ForwardScanLayout (n : ℕ) where + /-- Injective assignment of scan-state roles to physical work tapes. -/ + roles : Fin 8 ↪ Fin n + +/-- Current absolute bit cursor in the encoded formula source. -/ +def ForwardScanLayout.cursorIdx (layout : ForwardScanLayout n) : Fin n := + layout.roles 0 + +/-- Current postfix evaluation-stack height. -/ +def ForwardScanLayout.heightIdx (layout : ForwardScanLayout n) : Fin n := + layout.roles 1 + +/-- Number of complete tokens consumed in the current segment. -/ +def ForwardScanLayout.tokenCountIdx (layout : ForwardScanLayout n) : Fin n := + layout.roles 2 + +/-- Most recent token count at which the stack height became one. -/ +def ForwardScanLayout.lastOneCountIdx (layout : ForwardScanLayout n) : Fin n := + layout.roles 3 + +/-- Absolute bit cursor at the matching height-one boundary. -/ +def ForwardScanLayout.lastOneCursorIdx (layout : ForwardScanLayout n) : Fin n := + layout.roles 4 + +/-- Preserved canonical binary constant one. -/ +def ForwardScanLayout.oneIdx (layout : ForwardScanLayout n) : Fin n := + layout.roles 5 + +/-- Reusable one-bit equality verdict. -/ +def ForwardScanLayout.resultIdx (layout : ForwardScanLayout n) : Fin n := + layout.roles 6 + +/-- Reusable canonical-zero scratch for binary copies. -/ +def ForwardScanLayout.copyScratchIdx (layout : ForwardScanLayout n) : Fin n := + layout.roles 7 + +/-- Canonical numeric contents of all eight forward-scan registers. -/ +def ForwardScanFrame (layout : ForwardScanLayout n) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (work : Fin n → Tape) : Prop := + (work layout.cursorIdx).HasBinaryNat cursor ∧ + (work layout.heightIdx).HasBinaryNat height ∧ + (work layout.tokenCountIdx).HasBinaryNat tokenCount ∧ + (work layout.lastOneCountIdx).HasBinaryNat lastOneCount ∧ + (work layout.lastOneCursorIdx).HasBinaryNat lastOneCursor ∧ + (work layout.oneIdx).HasBinaryNat 1 ∧ + (work layout.resultIdx).HasBinaryNat 0 ∧ + (work layout.copyScratchIdx).HasBinaryNat 0 + +/-- Literal work-tape update performed by the height-one branch. -/ +def forwardScanBoundaryWork (layout : ForwardScanLayout n) + (work : Fin n → Tape) (tokenCount cursor : ℕ) : Fin n → Tape := + Function.update + (Function.update + (Function.update work layout.lastOneCountIdx + ((Tape.init (tokenCount.bits.map Γ.ofBool)).move Dir3.right)) + layout.lastOneCursorIdx + ((Tape.init (cursor.bits.map Γ.ofBool)).move Dir3.right)) + layout.resultIdx ((Tape.init []).move Dir3.right) + +/-- Literal final work family after the post-height update. -/ +def forwardScanAfterHeightWork (layout : ForwardScanLayout n) + (work : Fin n → Tape) (height tokenCount cursor : ℕ) : Fin n → Tape := + let counted := Function.update work layout.tokenCountIdx + ((Tape.init ((tokenCount + 1).bits.map Γ.ofBool)).move Dir3.right) + let compared := Function.update counted layout.resultIdx + ((Tape.init ([decide (height = 1)].map Γ.ofBool)).move Dir3.right) + if height = 1 then + forwardScanBoundaryWork layout compared (tokenCount + 1) cursor + else + Function.update compared layout.resultIdx + ((Tape.init []).move Dir3.right) + +/-- Literal final work family after one complete token-state update. -/ +def forwardScanTokenStepWork (layout : ForwardScanLayout n) + (work : Fin n → Tape) (arity height tokenCount cursor : ℕ) : + Fin n → Tape := + let nextHeight := height + 1 - arity + let heightUpdated := Function.update work layout.heightIdx + ((Tape.init (nextHeight.bits.map Γ.ofBool)).move Dir3.right) + forwardScanAfterHeightWork layout heightUpdated nextHeight tokenCount cursor + +/-- Update the stack height for one token arity. A leaf increments, a unary +token leaves the height fixed, and a binary token decrements. Values above two +share the binary branch; promised formula codes never select them. -/ +def forwardScanHeightTM (layout : ForwardScanLayout n) (arity : ℕ) : TM n := + match arity with + | 0 => TM.binarySuccTM layout.heightIdx + | 1 => TM.skipTM + | _ => TM.binaryPredTM layout.heightIdx + +/-- Copy both current boundaries into their retained registers, then clear the +one-bit equality verdict for the next token. -/ +def forwardScanCopyBoundaryTM (layout : ForwardScanLayout n) : TM n := + TM.seqTM + (TM.binaryCopyIntoTM layout.tokenCountIdx layout.lastOneCountIdx + layout.copyScratchIdx) + (TM.seqTM + (TM.binaryCopyIntoTM layout.cursorIdx layout.lastOneCursorIdx + layout.copyScratchIdx) + (TM.clearWorkTM layout.resultIdx)) + +/-- Branch on the normalized equality verdict. Height one records the current +token and bit boundaries; every other height only clears the verdict. -/ +def forwardScanRecordBoundaryTM (layout : ForwardScanLayout n) : TM n := + TM.branchWorkSymbolTM layout.resultIdx Γ.one + (forwardScanCopyBoundaryTM layout) + (TM.clearWorkTM layout.resultIdx) + +/-- Increment the token count, compare the updated height with one, record a +height-one boundary when selected, and restore the equality scratch to zero. -/ +def forwardScanAfterHeightTM (layout : ForwardScanLayout n) : TM n := + TM.seqTM (TM.binarySuccTM layout.tokenCountIdx) + (TM.seqTM + (TM.binaryEqRewindTM layout.heightIdx layout.oneIdx layout.resultIdx) + (forwardScanRecordBoundaryTM layout)) + +/-- Complete numeric update after decoding one token of the given arity. -/ +def forwardScanTokenStepTM (layout : ForwardScanLayout n) (arity : ℕ) : TM n := + TM.seqTM (forwardScanHeightTM layout arity) + (forwardScanAfterHeightTM layout) + +/-- Runtime of the arity-dependent height update. -/ +def forwardScanHeightTime (arity height : ℕ) : ℕ := + match arity with + | 0 => TM.binarySuccTime height + | 1 => 1 + | _ => TM.binaryPredTime (height - 1) + +/-- Runtime of the selected boundary-recording branch. -/ +def forwardScanRecordBoundaryTime (isOne : Bool) + (tokenCount cursor lastOneCount lastOneCursor : ℕ) : ℕ := + if isOne then + TM.binaryCopyTime tokenCount lastOneCount + 1 + + (TM.binaryCopyTime cursor lastOneCursor + 1 + + TM.clearWorkTimeBound 1) + else + TM.clearWorkTimeBound 1 + +/-- Runtime after the stack-height update, parameterized by the resulting +numeric state. -/ +def forwardScanAfterHeightTime (height tokenCount cursor lastOneCount + lastOneCursor : ℕ) : ℕ := + TM.binarySuccTime tokenCount + 1 + + (TM.binaryEqRewindTime height.bits (1 : ℕ).bits + 1 + + (forwardScanRecordBoundaryTime (decide (height = 1)) + (tokenCount + 1) cursor lastOneCount lastOneCursor + 1)) + +/-- Runtime of one complete numeric token update. -/ +def forwardScanTokenStepTime (arity height tokenCount cursor lastOneCount + lastOneCursor : ℕ) : ℕ := + let nextHeight := height + 1 - arity + forwardScanHeightTime arity height + 1 + + forwardScanAfterHeightTime nextHeight tokenCount cursor lastOneCount + lastOneCursor + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan/Internal.lean new file mode 100644 index 00000000..aef4aaaf --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScan/Internal.lean @@ -0,0 +1,697 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScan.Defs +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +import Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +import Complexitylib.Models.TuringMachine.Subroutines.BinaryEq +import Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork + +/-! +# Forward postfix scan controller -- proof internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +private theorem skipTM_isTransducer {n : ℕ} : (skipTM : TM n).IsTransducer := by + intro phase iHead wHeads oHead + cases phase <;> simp only [skipTM, idleDir] <;> split <;> decide + +private theorem forwardScanRole_ne (layout : ForwardScanLayout n) + (i j : Fin 8) (hij : i ≠ j) : layout.roles i ≠ layout.roles j := + layout.roles.injective.ne hij + +private theorem parked_of_hasBinaryNat {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem natBits_eq_one_iff (value : ℕ) : + value.bits = (1 : ℕ).bits ↔ value = 1 := by + constructor + · intro hbits + have hodd : value.bodd = true := by + rw [Nat.bodd_eq_bits_head, hbits] + rfl + have hdivBits : value.div2.bits = [] := by + rw [Nat.div2_bits_eq_tail, hbits] + rfl + have hdiv : value.div2 = 0 := by + apply Nat.size_eq_zero.mp + rw [← Nat.size_eq_bits_len, hdivBits] + rfl + rw [← Nat.bit_bodd_div2 value, hodd, hdiv] + rfl + · rintro rfl + rfl + +theorem forwardScanCopyBoundaryTM_hoareTime_internal + (layout : ForwardScanLayout n) + (tokenCount cursor lastOneCount lastOneCursor : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hcount : (work₀ layout.tokenCountIdx).HasBinaryNat tokenCount) + (hcursor : (work₀ layout.cursorIdx).HasBinaryNat cursor) + (hlastCount : + (work₀ layout.lastOneCountIdx).HasBinaryNat lastOneCount) + (hlastCursor : + (work₀ layout.lastOneCursorIdx).HasBinaryNat lastOneCursor) + (hscratch : (work₀ layout.copyScratchIdx).HasBinaryNat 0) + (hresult : (work₀ layout.resultIdx).HasBinaryString [true]) + (hresultStart : (work₀ layout.resultIdx).cells 0 = Γ.start) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanCopyBoundaryTM layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = forwardScanBoundaryWork layout work₀ tokenCount cursor ∧ + out = out₀) + (forwardScanRecordBoundaryTime true tokenCount cursor lastOneCount + lastOneCursor) := by + have hcountLast : layout.tokenCountIdx ≠ layout.lastOneCountIdx := by + unfold ForwardScanLayout.tokenCountIdx ForwardScanLayout.lastOneCountIdx + exact forwardScanRole_ne layout 2 3 (by decide) + have hcountScratch : layout.tokenCountIdx ≠ layout.copyScratchIdx := by + unfold ForwardScanLayout.tokenCountIdx ForwardScanLayout.copyScratchIdx + exact forwardScanRole_ne layout 2 7 (by decide) + have hlastScratch : layout.lastOneCountIdx ≠ + layout.copyScratchIdx := by + unfold ForwardScanLayout.lastOneCountIdx + ForwardScanLayout.copyScratchIdx + exact forwardScanRole_ne layout 3 7 (by decide) + let work₁ := Function.update work₀ layout.lastOneCountIdx + ((Tape.init (tokenCount.bits.map Γ.ofBool)).move Dir3.right) + have hcopyCount := binaryCopyIntoTM_hoareTime_frame + layout.tokenCountIdx layout.lastOneCountIdx layout.copyScratchIdx + hcountLast hcountScratch hlastScratch tokenCount lastOneCount inp₀ work₀ + out₀ hcount hlastCount hscratch hinput + (fun i _ _ _ => hwork i) houtput + have hcopyCount' : + (binaryCopyIntoTM layout.tokenCountIdx layout.lastOneCountIdx + layout.copyScratchIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = work₁ ∧ out = out₀) + (binaryCopyTime tokenCount lastOneCount) := by + simpa [work₁] using hcopyCount + have hcursorLast : layout.cursorIdx ≠ layout.lastOneCursorIdx := by + unfold ForwardScanLayout.cursorIdx ForwardScanLayout.lastOneCursorIdx + exact forwardScanRole_ne layout 0 4 (by decide) + have hcursorScratch : layout.cursorIdx ≠ layout.copyScratchIdx := by + unfold ForwardScanLayout.cursorIdx ForwardScanLayout.copyScratchIdx + exact forwardScanRole_ne layout 0 7 (by decide) + have hlastCursorScratch : layout.lastOneCursorIdx ≠ + layout.copyScratchIdx := by + unfold ForwardScanLayout.lastOneCursorIdx + ForwardScanLayout.copyScratchIdx + exact forwardScanRole_ne layout 4 7 (by decide) + have hlastCountCursor : layout.lastOneCountIdx ≠ layout.cursorIdx := by + unfold ForwardScanLayout.lastOneCountIdx ForwardScanLayout.cursorIdx + exact forwardScanRole_ne layout 3 0 (by decide) + have hlastCountLastCursor : layout.lastOneCountIdx ≠ + layout.lastOneCursorIdx := by + unfold ForwardScanLayout.lastOneCountIdx + ForwardScanLayout.lastOneCursorIdx + exact forwardScanRole_ne layout 3 4 (by decide) + have hlastCountResult : layout.lastOneCountIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.lastOneCountIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 3 6 (by decide) + have hwork₁ : ∀ i, Parked (work₁ i) := by + intro i + by_cases hi : i = layout.lastOneCountIdx + · subst i + simp only [work₁, Function.update_self] + exact parked_of_hasBinaryNat (Tape.init_move_right_hasBinaryNat tokenCount) + simpa only [work₁, Function.update_of_ne hi] using hwork i + have hcursor₁ : (work₁ layout.cursorIdx).HasBinaryNat cursor := by + simpa only [work₁, Function.update_of_ne hlastCountCursor.symm] using + hcursor + have hlastCursor₁ : + (work₁ layout.lastOneCursorIdx).HasBinaryNat lastOneCursor := by + simpa only [work₁, Function.update_of_ne hlastCountLastCursor.symm] using + hlastCursor + have hscratch₁ : (work₁ layout.copyScratchIdx).HasBinaryNat 0 := by + simpa only [work₁, Function.update_of_ne hlastScratch.symm] using hscratch + let work₂ := Function.update work₁ layout.lastOneCursorIdx + ((Tape.init (cursor.bits.map Γ.ofBool)).move Dir3.right) + have hcopyCursor := binaryCopyIntoTM_hoareTime_frame layout.cursorIdx + layout.lastOneCursorIdx layout.copyScratchIdx hcursorLast hcursorScratch + hlastCursorScratch cursor lastOneCursor inp₀ work₁ out₀ hcursor₁ + hlastCursor₁ hscratch₁ hinput (fun i _ _ _ => hwork₁ i) houtput + have hcopyCursor' : + (binaryCopyIntoTM layout.cursorIdx layout.lastOneCursorIdx + layout.copyScratchIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₁ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = work₂ ∧ out = out₀) + (binaryCopyTime cursor lastOneCursor) := by + simpa [work₂] using hcopyCursor + have hlastCursorResult : layout.lastOneCursorIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.lastOneCursorIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 4 6 (by decide) + have hwork₂ : ∀ i, Parked (work₂ i) := by + intro i + by_cases hi : i = layout.lastOneCursorIdx + · subst i + simp only [work₂, Function.update_self] + exact parked_of_hasBinaryNat (Tape.init_move_right_hasBinaryNat cursor) + simpa only [work₂, Function.update_of_ne hi] using hwork₁ i + have hresult₂ : work₂ layout.resultIdx = + (Tape.init ([true].map Γ.ofBool)).move Dir3.right := by + simpa only [work₂, Function.update_of_ne hlastCursorResult.symm, + work₁, Function.update_of_ne hlastCountResult.symm] using + Tape.eq_init_move_right_of_hasBinaryString hresult hresultStart + let work₃ := Function.update work₂ layout.resultIdx + ((Tape.init []).move Dir3.right) + have hclear := clearWorkTM_hoareTime_frame layout.resultIdx [true] inp₀ + work₂ out₀ hresult₂ hinput (fun i _ => hwork₂ i) houtput + have hclear' : (clearWorkTM layout.resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₂ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = work₃ ∧ out = out₀) + (clearWorkTimeBound 1) := by + simpa [work₃] using hclear + have htransition₁ : ∀ inp work out, + (inp = inp₀ ∧ work = work₁ ∧ out = out₀) → + (transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₁ ∧ + transitionTape out = out₀) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hwork₁ i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + have htransition₂ : ∀ inp work out, + (inp = inp₀ ∧ work = work₂ ∧ out = out₀) → + (transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₂ ∧ + transitionTape out = out₀) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hwork₂ i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + have htail := seqTM_hoareTime + (binaryCopyIntoTM layout.cursorIdx layout.lastOneCursorIdx + layout.copyScratchIdx) + (clearWorkTM layout.resultIdx) hcopyCursor' htransition₂ hclear' + unfold forwardScanCopyBoundaryTM forwardScanRecordBoundaryTime + simpa [work₁, work₂, work₃, forwardScanBoundaryWork] using + seqTM_hoareTime + (binaryCopyIntoTM layout.tokenCountIdx layout.lastOneCountIdx + layout.copyScratchIdx) + (seqTM + (binaryCopyIntoTM layout.cursorIdx layout.lastOneCursorIdx + layout.copyScratchIdx) + (clearWorkTM layout.resultIdx)) + hcopyCount' htransition₁ htail + +theorem forwardScanAfterHeightTM_hoareTime_internal + (layout : ForwardScanLayout n) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hframe : ForwardScanFrame layout cursor height tokenCount lastOneCount + lastOneCursor work₀) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanAfterHeightTM layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = forwardScanAfterHeightWork layout work₀ height tokenCount + cursor ∧ + out = out₀) + (forwardScanAfterHeightTime height tokenCount cursor lastOneCount + lastOneCursor) := by + rcases hframe with ⟨hcursor, hheight, hcount, hlastCount, hlastCursor, + hone, hresult, hscratch⟩ + have hcountHeight : layout.tokenCountIdx ≠ layout.heightIdx := by + unfold ForwardScanLayout.tokenCountIdx ForwardScanLayout.heightIdx + exact forwardScanRole_ne layout 2 1 (by decide) + have hcountCursor : layout.tokenCountIdx ≠ layout.cursorIdx := by + unfold ForwardScanLayout.tokenCountIdx ForwardScanLayout.cursorIdx + exact forwardScanRole_ne layout 2 0 (by decide) + have hcountLastCount : layout.tokenCountIdx ≠ + layout.lastOneCountIdx := by + unfold ForwardScanLayout.tokenCountIdx ForwardScanLayout.lastOneCountIdx + exact forwardScanRole_ne layout 2 3 (by decide) + have hcountLastCursor : layout.tokenCountIdx ≠ + layout.lastOneCursorIdx := by + unfold ForwardScanLayout.tokenCountIdx + ForwardScanLayout.lastOneCursorIdx + exact forwardScanRole_ne layout 2 4 (by decide) + have hcountOne : layout.tokenCountIdx ≠ layout.oneIdx := by + unfold ForwardScanLayout.tokenCountIdx ForwardScanLayout.oneIdx + exact forwardScanRole_ne layout 2 5 (by decide) + have hcountResult : layout.tokenCountIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.tokenCountIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 2 6 (by decide) + have hcountScratch : layout.tokenCountIdx ≠ layout.copyScratchIdx := by + unfold ForwardScanLayout.tokenCountIdx ForwardScanLayout.copyScratchIdx + exact forwardScanRole_ne layout 2 7 (by decide) + let counted := Function.update work₀ layout.tokenCountIdx + ((Tape.init ((tokenCount + 1).bits.map Γ.ofBool)).move Dir3.right) + have hcountRun := binarySuccTM_hoareTime_frame layout.tokenCountIdx + tokenCount inp₀ work₀ out₀ hcount hinput.read_ne_start + (fun i hi => (hwork i).read_ne_start) houtput.read_ne_start + have hcountRun' : (binarySuccTM layout.tokenCountIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = counted ∧ out = out₀) + (binarySuccTime tokenCount) := by + apply hcountRun.consequence (fun _ _ _ h => h) (fun inp work out h => ?_) + le_rfl + rcases h with ⟨hinp, hother, htarget, hout⟩ + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hi : i = layout.tokenCountIdx + · subst i + simp only [counted, Function.update_self] + exact htarget.eq_init_move_right + simpa only [counted, Function.update_of_ne hi] using hother i hi + have hworkCounted : ∀ i, Parked (counted i) := by + intro i + by_cases hi : i = layout.tokenCountIdx + · subst i + simp only [counted, Function.update_self] + exact parked_of_hasBinaryNat + (Tape.init_move_right_hasBinaryNat (tokenCount + 1)) + simpa only [counted, Function.update_of_ne hi] using hwork i + have hheightCounted : + (counted layout.heightIdx).HasBinaryNat height := by + simpa only [counted, Function.update_of_ne hcountHeight.symm] using hheight + have hcursorCounted : + (counted layout.cursorIdx).HasBinaryNat cursor := by + simpa only [counted, Function.update_of_ne hcountCursor.symm] using hcursor + have hcountCounted : + (counted layout.tokenCountIdx).HasBinaryNat (tokenCount + 1) := by + simp only [counted, Function.update_self] + exact Tape.init_move_right_hasBinaryNat (tokenCount + 1) + have hlastCountCounted : + (counted layout.lastOneCountIdx).HasBinaryNat lastOneCount := by + simpa only [counted, Function.update_of_ne hcountLastCount.symm] using + hlastCount + have hlastCursorCounted : + (counted layout.lastOneCursorIdx).HasBinaryNat lastOneCursor := by + simpa only [counted, Function.update_of_ne hcountLastCursor.symm] using + hlastCursor + have honeCounted : (counted layout.oneIdx).HasBinaryNat 1 := by + simpa only [counted, Function.update_of_ne hcountOne.symm] using hone + have hresultCounted : (counted layout.resultIdx).HasBinaryNat 0 := by + simpa only [counted, Function.update_of_ne hcountResult.symm] using hresult + have hscratchCounted : + (counted layout.copyScratchIdx).HasBinaryNat 0 := by + simpa only [counted, Function.update_of_ne hcountScratch.symm] using + hscratch + have hheightOne : layout.heightIdx ≠ layout.oneIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.oneIdx + exact forwardScanRole_ne layout 1 5 (by decide) + have hheightResult : layout.heightIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 1 6 (by decide) + have honeResult : layout.oneIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.oneIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 5 6 (by decide) + let compared := Function.update counted layout.resultIdx + ((Tape.init ([decide (height = 1)].map Γ.ofBool)).move Dir3.right) + have hcompareRun := binaryEqRewindTM_hoareTime_frame layout.heightIdx + layout.oneIdx layout.resultIdx + { lhs_rhs := hheightOne, lhs_result := hheightResult, + rhs_result := honeResult } + height.bits (1 : ℕ).bits inp₀ counted out₀ hheightCounted.2 + hheightCounted.1 honeCounted.2 honeCounted.1 (by + simpa [Nat.zero_bits] using hresultCounted.2) + hresultCounted.1 hinput (fun i _ _ _ => hworkCounted i) houtput + have hdecide : decide (height.bits = (1 : ℕ).bits) = + decide (height = 1) := + Bool.decide_congr (natBits_eq_one_iff height) + have hcompareRun' : + (binaryEqRewindTM layout.heightIdx layout.oneIdx layout.resultIdx) + |>.HoareTime + (fun inp work out => inp = inp₀ ∧ work = counted ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = compared ∧ out = out₀) + (binaryEqRewindTime height.bits (1 : ℕ).bits) := by + rw [hdecide] at hcompareRun + simpa [compared] using hcompareRun + have hworkCompared : ∀ i, Parked (compared i) := by + intro i + by_cases hi : i = layout.resultIdx + · subst i + simp only [compared, Function.update_self] + exact ⟨by simp [Tape.move], + Tape.init_ofBool_move_right_cells_ne_start [decide (height = 1)]⟩ + simpa only [compared, Function.update_of_ne hi] using hworkCounted i + have htransitionCounted : ∀ inp work out, + (inp = inp₀ ∧ work = counted ∧ out = out₀) → + (transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = counted ∧ + transitionTape out = out₀) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hworkCounted i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + have htransitionCompared : ∀ inp work out, + (inp = inp₀ ∧ work = compared ∧ out = out₀) → + (transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = compared ∧ + transitionTape out = out₀) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hworkCompared i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + by_cases hisOne : height = 1 + · have hcountCompared : + (compared layout.tokenCountIdx).HasBinaryNat (tokenCount + 1) := by + simpa only [compared, Function.update_of_ne hcountResult] using + hcountCounted + have hcursorResult : layout.cursorIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.cursorIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 0 6 (by decide) + have hcursorCompared : + (compared layout.cursorIdx).HasBinaryNat cursor := by + simpa only [compared, Function.update_of_ne hcursorResult] using + hcursorCounted + have hlastCountResult : layout.lastOneCountIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.lastOneCountIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 3 6 (by decide) + have hlastCountCompared : + (compared layout.lastOneCountIdx).HasBinaryNat lastOneCount := by + simpa only [compared, Function.update_of_ne hlastCountResult] using + hlastCountCounted + have hlastCursorResult : layout.lastOneCursorIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.lastOneCursorIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 4 6 (by decide) + have hlastCursorCompared : + (compared layout.lastOneCursorIdx).HasBinaryNat lastOneCursor := by + simpa only [compared, Function.update_of_ne hlastCursorResult] using + hlastCursorCounted + have hscratchResult : layout.copyScratchIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.copyScratchIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 7 6 (by decide) + have hscratchCompared : + (compared layout.copyScratchIdx).HasBinaryNat 0 := by + simpa only [compared, Function.update_of_ne hscratchResult] using + hscratchCounted + have hresultCompared : + (compared layout.resultIdx).HasBinaryString [true] := by + simpa [compared, hisOne] using + Tape.init_move_right_hasBinaryString [true] + have hresultComparedStart : + (compared layout.resultIdx).cells 0 = Γ.start := by + simp [compared, Tape.init, Tape.move] + have hcopy := forwardScanCopyBoundaryTM_hoareTime_internal layout + (tokenCount + 1) cursor lastOneCount lastOneCursor inp₀ compared out₀ + hcountCompared hcursorCompared hlastCountCompared hlastCursorCompared + hscratchCompared hresultCompared hresultComparedStart hinput + hworkCompared houtput + have hbranch := branchWorkSymbolTM_hoareTime_equal + (pre := fun inp work out => + inp = inp₀ ∧ work = compared ∧ out = out₀) + layout.resultIdx Γ.one + (forwardScanCopyBoundaryTM layout) (clearWorkTM layout.resultIdx) + (fun _ work _ hpre => by + rcases hpre with ⟨-, rfl, -⟩ + simp [compared, hisOne, Tape.read, Tape.move, Tape.init, Γ.ofBool]) + (fun _ _ _ hpre => hpre.1 ▸ hinput.read_ne_start) + (fun _ work _ hpre i => by + rw [hpre.2.1] + exact (hworkCompared i).read_ne_start) + (fun _ _ _ hpre => hpre.2.2 ▸ houtput.read_ne_start) hcopy + have htail := seqTM_hoareTime + (binaryEqRewindTM layout.heightIdx layout.oneIdx layout.resultIdx) + (forwardScanRecordBoundaryTM layout) hcompareRun' htransitionCompared + hbranch + simpa [forwardScanAfterHeightTM, forwardScanAfterHeightTime, + forwardScanAfterHeightWork, hisOne, compared, counted] using + seqTM_hoareTime (binarySuccTM layout.tokenCountIdx) + (seqTM + (binaryEqRewindTM layout.heightIdx layout.oneIdx layout.resultIdx) + (forwardScanRecordBoundaryTM layout)) + hcountRun' htransitionCounted htail + · have hresultCompared : compared layout.resultIdx = + (Tape.init ([false].map Γ.ofBool)).move Dir3.right := by + simp [compared, hisOne] + let cleared := Function.update compared layout.resultIdx + ((Tape.init []).move Dir3.right) + have hclear := clearWorkTM_hoareTime_frame layout.resultIdx [false] inp₀ + compared out₀ hresultCompared hinput (fun i _ => hworkCompared i) + houtput + have hclear' : (clearWorkTM layout.resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = compared ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = cleared ∧ out = out₀) + (clearWorkTimeBound 1) := by + simpa [cleared] using hclear + have hbranch := branchWorkSymbolTM_hoareTime_different + (pre := fun inp work out => + inp = inp₀ ∧ work = compared ∧ out = out₀) + layout.resultIdx Γ.one (forwardScanCopyBoundaryTM layout) + (clearWorkTM layout.resultIdx) + (fun _ work _ hpre => by + rcases hpre with ⟨-, rfl, -⟩ + simp [compared, hisOne, Tape.read, Tape.move, Tape.init, Γ.ofBool]) + (fun _ _ _ hpre => hpre.1 ▸ hinput.read_ne_start) + (fun _ work _ hpre i => by + rw [hpre.2.1] + exact (hworkCompared i).read_ne_start) + (fun _ _ _ hpre => hpre.2.2 ▸ houtput.read_ne_start) hclear' + have htail := seqTM_hoareTime + (binaryEqRewindTM layout.heightIdx layout.oneIdx layout.resultIdx) + (forwardScanRecordBoundaryTM layout) hcompareRun' htransitionCompared + hbranch + simpa [forwardScanAfterHeightTM, forwardScanAfterHeightTime, + forwardScanAfterHeightWork, forwardScanRecordBoundaryTime, hisOne, + cleared, compared, counted] using + seqTM_hoareTime (binarySuccTM layout.tokenCountIdx) + (seqTM + (binaryEqRewindTM layout.heightIdx layout.oneIdx layout.resultIdx) + (forwardScanRecordBoundaryTM layout)) + hcountRun' htransitionCounted htail + +theorem forwardScanHeightTM_hoareTime_internal + (layout : ForwardScanLayout n) (arity height : ℕ) + (harity : arity ≤ 2) (hpositive : arity = 2 → 1 ≤ height) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hheight : (work₀ layout.heightIdx).HasBinaryNat height) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ layout.heightIdx → Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanHeightTM layout arity).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ layout.heightIdx + ((Tape.init ((height + 1 - arity).bits.map Γ.ofBool)).move + Dir3.right) ∧ + out = out₀) + (forwardScanHeightTime arity height) := by + cases arity with + | zero => + have hrun := binarySuccTM_hoareTime_frame layout.heightIdx height inp₀ + work₀ out₀ hheight hinput.read_ne_start + (fun i hi => (hother i hi).read_ne_start) houtput.read_ne_start + apply hrun.consequence (fun _ _ _ h => h) (fun inp work out h => ?_) + (by simp [forwardScanHeightTime]) + rcases h with ⟨hinp, hwork, htarget, hout⟩ + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hi : i = layout.heightIdx + · subst i + rw [Function.update_self] + exact htarget.eq_init_move_right + rw [Function.update_of_ne hi] + exact hwork i hi + | succ arity => + cases arity with + | zero => + have hrun := skipTM_hoareTime_frame inp₀ work₀ out₀ hinput + (fun i => by + by_cases hi : i = layout.heightIdx + · subst i + exact ⟨by rw [hheight.2.1], + hheight.2.hasBinaryContent.cells_ne_start⟩ + · exact hother i hi) + houtput + apply hrun.consequence (fun _ _ _ h => h) + (fun inp work out h => ?_) (by simp [forwardScanHeightTime]) + rcases h with ⟨hinp, hwork, hout⟩ + refine ⟨hinp, ?_, hout⟩ + rw [hwork] + funext i + by_cases hi : i = layout.heightIdx + · subst i + rw [Function.update_self] + simpa using hheight.eq_init_move_right + rw [Function.update_of_ne hi] + | succ arity => + have harityZero : arity = 0 := by omega + subst arity + have hheightPos : 1 ≤ height := hpositive rfl + have hheightEq : height - 1 + 1 = height := by omega + have hrun := binaryPredTM_hoareTime_frame layout.heightIdx + (height - 1) inp₀ work₀ out₀ (by + simpa [hheightEq] using hheight) hinput.read_ne_start + (fun i hi => (hother i hi).read_ne_start) + houtput.read_ne_start + apply hrun.consequence (fun _ _ _ h => h) + (fun inp work out h => ?_) + (by simp [forwardScanHeightTime]) + rcases h with ⟨hinp, hwork, htarget, hout⟩ + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hi : i = layout.heightIdx + · subst i + rw [Function.update_self] + convert htarget.eq_init_move_right using 1 + rw [Function.update_of_ne hi] + exact hwork i hi + +theorem forwardScanTokenStepTM_hoareTime_internal + (layout : ForwardScanLayout n) (arity height tokenCount cursor + lastOneCount lastOneCursor : ℕ) + (harity : arity ≤ 2) (hpositive : arity = 2 → 1 ≤ height) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hframe : ForwardScanFrame layout cursor height tokenCount lastOneCount + lastOneCursor work₀) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanTokenStepTM layout arity).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = forwardScanTokenStepWork layout work₀ arity height tokenCount + cursor ∧ + out = out₀) + (forwardScanTokenStepTime arity height tokenCount cursor lastOneCount + lastOneCursor) := by + let nextHeight := height + 1 - arity + let heightUpdated := Function.update work₀ layout.heightIdx + ((Tape.init (nextHeight.bits.map Γ.ofBool)).move Dir3.right) + have hheightRun := forwardScanHeightTM_hoareTime_internal layout arity + height harity hpositive inp₀ work₀ out₀ hframe.2.1 hinput + (fun i _ => hwork i) houtput + have hheightRun' : (forwardScanHeightTM layout arity).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = heightUpdated ∧ out = out₀) + (forwardScanHeightTime arity height) := by + simpa [heightUpdated, nextHeight] using hheightRun + have hheightCursor : layout.heightIdx ≠ layout.cursorIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.cursorIdx + exact forwardScanRole_ne layout 1 0 (by decide) + have hheightCount : layout.heightIdx ≠ layout.tokenCountIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.tokenCountIdx + exact forwardScanRole_ne layout 1 2 (by decide) + have hheightLastCount : layout.heightIdx ≠ + layout.lastOneCountIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.lastOneCountIdx + exact forwardScanRole_ne layout 1 3 (by decide) + have hheightLastCursor : layout.heightIdx ≠ + layout.lastOneCursorIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.lastOneCursorIdx + exact forwardScanRole_ne layout 1 4 (by decide) + have hheightOne : layout.heightIdx ≠ layout.oneIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.oneIdx + exact forwardScanRole_ne layout 1 5 (by decide) + have hheightResult : layout.heightIdx ≠ layout.resultIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.resultIdx + exact forwardScanRole_ne layout 1 6 (by decide) + have hheightScratch : layout.heightIdx ≠ layout.copyScratchIdx := by + unfold ForwardScanLayout.heightIdx ForwardScanLayout.copyScratchIdx + exact forwardScanRole_ne layout 1 7 (by decide) + rcases hframe with ⟨hcursor, _hheight, hcount, hlastCount, hlastCursor, + hone, hresult, hscratch⟩ + have hframeUpdated : ForwardScanFrame layout cursor nextHeight tokenCount + lastOneCount lastOneCursor heightUpdated := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa only [heightUpdated, + Function.update_of_ne hheightCursor.symm] using hcursor + · simp only [heightUpdated, Function.update_self] + exact Tape.init_move_right_hasBinaryNat nextHeight + · simpa only [heightUpdated, + Function.update_of_ne hheightCount.symm] using hcount + · simpa only [heightUpdated, + Function.update_of_ne hheightLastCount.symm] using hlastCount + · simpa only [heightUpdated, + Function.update_of_ne hheightLastCursor.symm] using hlastCursor + · simpa only [heightUpdated, + Function.update_of_ne hheightOne.symm] using hone + · simpa only [heightUpdated, + Function.update_of_ne hheightResult.symm] using hresult + · simpa only [heightUpdated, + Function.update_of_ne hheightScratch.symm] using hscratch + have hworkUpdated : ∀ i, Parked (heightUpdated i) := by + intro i + by_cases hi : i = layout.heightIdx + · subst i + simp only [heightUpdated, Function.update_self] + exact parked_of_hasBinaryNat + (Tape.init_move_right_hasBinaryNat nextHeight) + simpa only [heightUpdated, Function.update_of_ne hi] using hwork i + have hafter := forwardScanAfterHeightTM_hoareTime_internal layout cursor + nextHeight tokenCount lastOneCount lastOneCursor inp₀ heightUpdated out₀ + hframeUpdated hinput hworkUpdated houtput + have htransition : ∀ inp work out, + (inp = inp₀ ∧ work = heightUpdated ∧ out = out₀) → + (transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = heightUpdated ∧ + transitionTape out = out₀) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hworkUpdated i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + simpa [forwardScanTokenStepTM, forwardScanTokenStepTime, + forwardScanTokenStepWork, nextHeight, heightUpdated] using + seqTM_hoareTime (forwardScanHeightTM layout arity) + (forwardScanAfterHeightTM layout) hheightRun' htransition hafter + +theorem forwardScanHeightTM_isTransducer_internal + (layout : ForwardScanLayout n) (arity : ℕ) : + (forwardScanHeightTM layout arity).IsTransducer := by + cases arity with + | zero => exact binarySuccTM_isTransducer layout.heightIdx + | succ arity => + cases arity with + | zero => exact skipTM_isTransducer + | succ _ => exact binaryPredTM_isTransducer layout.heightIdx + +theorem forwardScanCopyBoundaryTM_isTransducer_internal + (layout : ForwardScanLayout n) : + (forwardScanCopyBoundaryTM layout).IsTransducer := by + unfold forwardScanCopyBoundaryTM + exact + (binaryCopyIntoTM_isTransducer layout.tokenCountIdx + layout.lastOneCountIdx layout.copyScratchIdx).seqTM + ((binaryCopyIntoTM_isTransducer layout.cursorIdx + layout.lastOneCursorIdx layout.copyScratchIdx).seqTM + (clearWorkTM_isTransducer layout.resultIdx)) + +theorem forwardScanRecordBoundaryTM_isTransducer_internal + (layout : ForwardScanLayout n) : + (forwardScanRecordBoundaryTM layout).IsTransducer := by + unfold forwardScanRecordBoundaryTM + exact (forwardScanCopyBoundaryTM_isTransducer_internal layout) + |>.branchWorkSymbolTM (clearWorkTM_isTransducer layout.resultIdx) + +theorem forwardScanAfterHeightTM_isTransducer_internal + (layout : ForwardScanLayout n) : + (forwardScanAfterHeightTM layout).IsTransducer := by + unfold forwardScanAfterHeightTM + exact (binarySuccTM_isTransducer layout.tokenCountIdx).seqTM + ((binaryEqRewindTM_isTransducer layout.heightIdx layout.oneIdx + layout.resultIdx).seqTM + (forwardScanRecordBoundaryTM_isTransducer_internal layout)) + +theorem forwardScanTokenStepTM_isTransducer_internal + (layout : ForwardScanLayout n) (arity : ℕ) : + (forwardScanTokenStepTM layout arity).IsTransducer := by + unfold forwardScanTokenStepTM + exact (forwardScanHeightTM_isTransducer_internal layout arity).seqTM + (forwardScanAfterHeightTM_isTransducer_internal layout) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop.lean new file mode 100644 index 00000000..c1d0c676 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanLoop.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanLoop.Internal + +/-! +# Bounded forward postfix scan loop + +This module exposes the fresh loop-control roles and the one-way-output +certificate for bounded iteration of the complete decoded-token scanner. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- The bounded loop counter and its preserved token limit are distinct. -/ +theorem ForwardScanLoopLayout.counter_ne_limit (n : ℕ) + (layout : ForwardScanLoopLayout controllerTapes) : + layout.counterIdx n ≠ layout.limitIdx n := + layout.counter_ne_limit_internal n + +/-- No decoded-token role aliases the private loop counter. -/ +theorem ForwardScanLoopLayout.tokenRole_ne_counter + (layout : ForwardScanLoopLayout controllerTapes) (i : Fin 16) : + layout.tokenLayout.roles i ≠ layout.counterRole := + layout.tokenRole_ne_counter_internal i + +/-- No decoded-token role aliases the preserved token limit. -/ +theorem ForwardScanLoopLayout.tokenRole_ne_limit + (layout : ForwardScanLoopLayout controllerTapes) (i : Fin 16) : + layout.tokenLayout.roles i ≠ layout.limitRole := + layout.tokenRole_ne_limit_internal i + +/-- Bounded decoded-token scanning preserves one-way output behavior. -/ +theorem forwardScanTokenLoopTM_isTransducer (tm : TM n) + (controllerTapes : ℕ) + (layout : ForwardScanLoopLayout controllerTapes) : + (forwardScanTokenLoopTM tm controllerTapes layout).IsTransducer := + forwardScanTokenLoopTM_isTransducer_internal tm controllerTapes layout + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop/Defs.lean new file mode 100644 index 00000000..70c2379a --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop/Defs.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanToken.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs + +/-! +# Bounded forward postfix scan loop -- definitions + +This layer gives the decoded one-token scanner its own bounded count-up loop. +The loop counter and preserved token limit are structurally separate from the +sixteen roles used by token decoding and the semantic forward-scan state. In +particular, the loop counter never aliases the semantic token count that the +body already increments once per token. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Eighteen distinct controller roles for a bounded decoded-token scan. + +The first sixteen roles are inherited by `ForwardScanTokenLayout`; roles +sixteen and seventeen are the private loop counter and preserved token limit. +-/ +structure ForwardScanLoopLayout (controllerTapes : ℕ) where + /-- Injective assignment of all token-scan and loop-control roles. -/ + roles : Fin 18 ↪ Fin controllerTapes + +/-- Restrict a bounded-loop layout to the complete decoded-token scanner. -/ +def ForwardScanLoopLayout.tokenLayout + (layout : ForwardScanLoopLayout controllerTapes) : + ForwardScanTokenLayout controllerTapes where + roles := + { toFun := fun i => layout.roles ⟨i.val, by omega⟩ + inj' := by + intro i j hij + have hroles := congrArg Fin.val (layout.roles.injective hij) + exact Fin.ext (by simpa using hroles) } + +/-- Logical controller role of the bounded loop counter. -/ +def ForwardScanLoopLayout.counterRole + (layout : ForwardScanLoopLayout controllerTapes) : Fin controllerTapes := + layout.roles 16 + +/-- Logical controller role of the preserved token limit. -/ +def ForwardScanLoopLayout.limitRole + (layout : ForwardScanLoopLayout controllerTapes) : Fin controllerTapes := + layout.roles 17 + +/-- Physical work-tape index of the bounded loop counter. -/ +def ForwardScanLoopLayout.counterIdx (n : ℕ) + (layout : ForwardScanLoopLayout controllerTapes) : + Fin (0 + TM.outputProbeControllerTapes n + controllerTapes) := + TM.outputProbeIndexedControllerIdx n layout.counterRole + +/-- Physical work-tape index of the preserved token limit. -/ +def ForwardScanLoopLayout.limitIdx (n : ℕ) + (layout : ForwardScanLoopLayout controllerTapes) : + Fin (0 + TM.outputProbeControllerTapes n + controllerTapes) := + TM.outputProbeIndexedControllerIdx n layout.limitRole + +/-- Scan exactly the number of tokens named by the preserved binary limit. + +Each iteration decodes and applies one complete token before the generic loop +driver increments its private counter. +-/ +def forwardScanTokenLoopTM (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanLoopLayout controllerTapes) : + TM (0 + TM.outputProbeControllerTapes n + controllerTapes) := + TM.binaryForTM + (forwardScanDecodedTokenTM tm controllerTapes layout.tokenLayout) + (layout.counterIdx n) (layout.limitIdx n) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop/Internal.lean new file mode 100644 index 00000000..7edf245c --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanLoop/Internal.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanLoop.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanToken +import Complexitylib.Models.TuringMachine.OutputProbeIndexed +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor + +/-! +# Bounded forward postfix scan loop -- internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +theorem ForwardScanLoopLayout.counter_ne_limit_internal (n : ℕ) + (layout : ForwardScanLoopLayout controllerTapes) : + layout.counterIdx n ≠ layout.limitIdx n := by + intro heq + have hlogical := outputProbeIndexedControllerIdx_injective n heq + have hroles := layout.roles.injective hlogical + have hvals := congrArg Fin.val hroles + omega + +theorem ForwardScanLoopLayout.tokenRole_ne_counter_internal + (layout : ForwardScanLoopLayout controllerTapes) (i : Fin 16) : + layout.tokenLayout.roles i ≠ layout.counterRole := by + change layout.roles (Fin.castLE (by omega : 16 ≤ 18) i) ≠ + layout.roles ⟨16, by omega⟩ + exact layout.roles.injective.ne (by + intro heq + have hvals := congrArg (fun j : Fin 18 => j.val) heq + simp only [Fin.castLE] at hvals + omega) + +theorem ForwardScanLoopLayout.tokenRole_ne_limit_internal + (layout : ForwardScanLoopLayout controllerTapes) (i : Fin 16) : + layout.tokenLayout.roles i ≠ layout.limitRole := by + change layout.roles (Fin.castLE (by omega : 16 ≤ 18) i) ≠ + layout.roles ⟨17, by omega⟩ + exact layout.roles.injective.ne (by + intro heq + have hvals := congrArg (fun j : Fin 18 => j.val) heq + simp only [Fin.castLE] at hvals + omega) + +theorem forwardScanTokenLoopTM_isTransducer_internal (tm : TM n) + (controllerTapes : ℕ) + (layout : ForwardScanLoopLayout controllerTapes) : + (forwardScanTokenLoopTM tm controllerTapes layout).IsTransducer := by + unfold forwardScanTokenLoopTM + exact (forwardScanDecodedTokenTM_isTransducer tm controllerTapes + layout.tokenLayout).binaryForTM (layout.counterIdx n) (layout.limitIdx n) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken.lean new file mode 100644 index 00000000..98923ab9 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken.lean @@ -0,0 +1,653 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanToken.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanToken.Internal + +/-! +# Token decoding for the forward postfix scan + +This module exposes the combined token-decoder and numeric-scan register +layout, the variable-decoder normalization contract, and append-only safety of +the assembled one-token controller. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- The decoder tag selected by a pure token has exactly that token's postfix +arity. -/ +theorem forwardScanTokenTagArity_eq (token : FormulaCode.Token) : + forwardScanTokenTagArity (forwardScanTokenTag token) = token.arity := + forwardScanTokenTagArity_eq_internal token + +/-- The declared tag bits classify to the tag of the same pure token. -/ +theorem forwardScanTokenTagBits_classify (token : FormulaCode.Token) : + let bits := forwardScanTokenTagBits token + outputProbeTokenTag? bits.tag₀ bits.tag₁ bits.tag₂ = + some (forwardScanTokenTag token) := + forwardScanTokenTagBits_classify_internal token + +/-- At every valid ordinal in a canonical framed stream, three successful +source probes recover the exact decoder tag of that token. -/ +theorem outputProbeTokenTag?_ofList_encodeTokenStream + (stream : List FormulaCode.Token) (index : ℕ) + (hindex : index < stream.length) : + let cursor := stream.length + 1 + FormulaCode.tokenBitOffset stream index + ∃ tag₀ tag₁ tag₂, + FormulaCode.BitOracle.ofList (FormulaCode.encodeTokenStream stream) + cursor = some tag₀ ∧ + FormulaCode.BitOracle.ofList (FormulaCode.encodeTokenStream stream) + (cursor + 1) = some tag₁ ∧ + FormulaCode.BitOracle.ofList (FormulaCode.encodeTokenStream stream) + (cursor + 2) = some tag₂ ∧ + outputProbeTokenTag? tag₀ tag₁ tag₂ = + some (forwardScanTokenTag stream[index]) := + outputProbeTokenTag?_ofList_encodeTokenStream_internal stream index hindex + +/-- The three canonical source positions contain the exact declared tag bits, +not merely a tag that classifies equivalently. -/ +theorem forwardScanTokenTagBits_ofList_encodeTokenStream + (stream : List FormulaCode.Token) (index : ℕ) + (hindex : index < stream.length) : + let bits := FormulaCode.encodeTokenStream stream + let cursor := stream.length + 1 + FormulaCode.tokenBitOffset stream index + let tag := forwardScanTokenTagBits stream[index] + FormulaCode.BitOracle.ofList bits cursor = some tag.tag₀ ∧ + FormulaCode.BitOracle.ofList bits (cursor + 1) = some tag.tag₁ ∧ + FormulaCode.BitOracle.ofList bits (cursor + 2) = some tag.tag₂ := + forwardScanTokenTagBits_ofList_encodeTokenStream_internal stream index hindex + +/-- The same canonical tag theorem exposes direct list indices and all three +bounds needed by the source-probing machine contract. -/ +theorem outputProbeTokenTag?_getElem_encodeTokenStream + (stream : List FormulaCode.Token) (index : ℕ) + (hindex : index < stream.length) : + let bits := FormulaCode.encodeTokenStream stream + let cursor := stream.length + 1 + FormulaCode.tokenBitOffset stream index + ∃ (h₀ : cursor < bits.length) (h₁ : cursor + 1 < bits.length) + (h₂ : cursor + 2 < bits.length), + outputProbeTokenTag? (bits[cursor]'h₀) (bits[cursor + 1]'h₁) + (bits[cursor + 2]'h₂) = + some (forwardScanTokenTag stream[index]) := + outputProbeTokenTag?_getElem_encodeTokenStream_internal stream index hindex + +/-- Once token decoding has advanced the cursor, the numeric work update +realizes exactly one pure `ForwardScanState.step`. -/ +theorem ForwardScanFrame.forwardScanTokenStepWork + (layout : ForwardScanLayout n) + (state : FormulaCode.ForwardScanState) (token : FormulaCode.Token) + (work : Fin n → Tape) + (hframe : ForwardScanFrame layout + (state.bitOffset + token.codeLength) state.stackHeight state.tokenCount + state.lastOneCount state.lastOneBitOffset work) : + ForwardScanFrame layout (state.step token).bitOffset + (state.step token).stackHeight (state.step token).tokenCount + (state.step token).lastOneCount (state.step token).lastOneBitOffset + (forwardScanTokenStepWork layout work token.arity state.stackHeight + state.tokenCount (state.bitOffset + token.codeLength)) := + hframe.forwardScanTokenStepWork_internal layout state token work + +/-- Overwriting the shared source cursor with a canonical post-token position +preserves every other numeric scan register. -/ +theorem ForwardScanFrame.forwardScanTokenCursorWork + (n : ℕ) (layout : ForwardScanTokenLayout controllerTapes) + (oldCursor cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (hframe : ForwardScanFrame (layout.scanLayout n) oldCursor height + tokenCount lastOneCount lastOneCursor work) : + ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (forwardScanTokenCursorWork n layout work cursor) := + hframe.forwardScanTokenCursorWork_internal n layout oldCursor cursor height + tokenCount lastOneCount lastOneCursor work + +/-- The canonical stable outer-frame update for one pure token realizes +exactly one pure forward-scan step. -/ +theorem ForwardScanFrame.forwardScanTokenOuterExtrasAfter + (n : ℕ) (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : FormulaCode.ForwardScanState) (token : FormulaCode.Token) + (hframe : ForwardScanFrame (layout.scanLayout n) state.bitOffset + state.stackHeight state.tokenCount state.lastOneCount + state.lastOneBitOffset outerExtras) : + ForwardScanFrame (layout.scanLayout n) (state.step token).bitOffset + (state.step token).stackHeight (state.step token).tokenCount + (state.step token).lastOneCount (state.step token).lastOneBitOffset + (forwardScanTokenOuterExtrasAfter n layout outerExtras state token) := + hframe.forwardScanTokenOuterExtrasAfter_internal n layout outerExtras state + token + +/-- Applying the literal numeric token update to a restored latch frame is +exactly the same controller-local update to its stable outer frame. -/ +theorem outputProbeLatchFramePost_forwardScanTokenStepWork + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) + (arity height tokenCount cursor : ℕ) : + outputProbeLatchFramePost tm controllerTapes + (forwardScanTokenStepWork (layout.scanLayout n) outerExtras arity height + tokenCount cursor) + input output extras bit inp + (forwardScanTokenStepWork (layout.scanLayout n) work arity height + tokenCount cursor) out := + outputProbeLatchFramePost_forwardScanTokenStepWork_internal tm + controllerTapes layout outerExtras input output extras bit inp work out + hpost arity height tokenCount cursor + +/-- Variable-decoder normalization commutes through a restored latch frame as +the same three controller-local updates to its stable outer frame. -/ +theorem outputProbeLatchFramePost_forwardScanVarResetWork + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) : + outputProbeLatchFramePost tm controllerTapes + (forwardScanVarResetWork n layout outerExtras) + input output extras bit inp (forwardScanVarResetWork n layout work) + out := + outputProbeLatchFramePost_forwardScanVarResetWork_internal tm + controllerTapes layout outerExtras input output extras bit inp work out + hpost + +/-- Bounded unary decoding of a canonical variable token reaches its exact +post-token cursor and clears the active flag; extra fuel is absorbed by the +decoder's inactive no-op state. -/ +theorem outputProbeDecodeTokenVarFinalState_of_encode + (before after : List Bool) (varValue extraFuel : ℕ) : + (outputProbeDecodeNatStateAt + (before ++ FormulaCode.Token.encode + (FormulaCode.Token.var varValue) ++ after) + (outputProbeDecodeTokenVarInitial before.length) + (varValue + 1 + extraFuel)).result? = + (some (varValue, before.length + varValue + 4) : + Option (ℕ × ℕ)) := + outputProbeDecodeTokenVarFinalState_of_encode_internal before after + varValue extraFuel + +/-- The complete decoder and numeric scan use the same physical source cursor. -/ +@[simp] +theorem ForwardScanTokenLayout.scanLayout_cursorIdx + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).cursorIdx = + outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.cursorIdx := by + simpa using layout.scanLayout_cursorIdx_internal (n := n) + +/-- Normalizing the private variable-decoder registers preserves every numeric +forward-scan register literally. -/ +theorem ForwardScanFrame.forwardScanVarResetWork + (layout : ForwardScanTokenLayout controllerTapes) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → + Tape) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor work) : + ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor (forwardScanVarResetWork n layout work) := + hframe.forwardScanVarResetWork_internal layout cursor height tokenCount + lastOneCount lastOneCursor work + +/-- A numeric scan frame on stable controller tapes is the same frame inside +the canonical restored output-probe configuration. -/ +theorem ForwardScanFrame.outputProbeLatchFrameCfg + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor outerExtras) : + ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work := + hframe.outputProbeLatchFrameCfg_internal tm controllerTapes layout cursor + height tokenCount lastOneCount lastOneCursor outerExtras input output + extras + +/-- Complete fixed-tag probing and cleanup advance exactly the shared scan +cursor while preserving all seven private numeric scan registers. -/ +theorem ForwardScanFrame.outputProbeDecodeTokenOuterExtrasAfter + (layout : ForwardScanTokenLayout controllerTapes) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor outerExtras) : + ForwardScanFrame (layout.scanLayout n) (cursor + 3) height tokenCount + lastOneCount lastOneCursor + (outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout outerExtras + cursor tag₀ tag₁ tag₂) := + hframe.outputProbeDecodeTokenOuterExtrasAfter_internal layout cursor height + tokenCount lastOneCount lastOneCursor outerExtras tag₀ tag₁ tag₂ + +/-- Completed bounded variable decoding overwrites exactly the shared scan +cursor with its pure semantic cursor and preserves all other scan registers. -/ +theorem ForwardScanFrame.outputProbeDecodeNatLoopOuterExtras + (layout : ForwardScanTokenLayout controllerTapes) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor outerExtras) : + ForwardScanFrame (layout.scanLayout n) state.cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeDecodeNatLoopOuterExtras n + layout.tokenLayout.natLayout.cursorIdx + layout.tokenLayout.natLayout.valueIdx + layout.tokenLayout.natLayout.activeIdx + layout.tokenLayout.natLayout.loopIdx outerExtras state iteration) := + hframe.outputProbeDecodeNatLoopOuterExtras_internal layout cursor height + tokenCount lastOneCount lastOneCursor outerExtras state iteration + +/-- A numeric token update can run directly from a restored output-probe latch +frame. Its endpoint is the literal updated full work family, ready for exact +sequential composition with the next controller phase. -/ +theorem forwardScanTokenStepTM_latchFrame_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (arity height tokenCount cursor lastOneCount lastOneCursor : ℕ) + (harity : arity ≤ 2) (hpositive : arity = 2 → 1 ≤ height) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work) : + (forwardScanTokenStepTM (layout.scanLayout n) arity).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (fun inp work out => + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).work + arity height tokenCount cursor ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).output) + (forwardScanTokenStepTime arity height tokenCount cursor lastOneCount + lastOneCursor) := + forwardScanTokenStepTM_latchFrame_hoareTime_internal tm controllerTapes + layout arity height tokenCount cursor lastOneCount lastOneCursor harity + hpositive outerExtras input output extras hextras houter houtput hframe + +/-- Normalize the value, active, and loop registers left by completed variable +decoding, preserving every other tape literally. -/ +theorem forwardScanVarResetTM_hoareTime (n controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (value fuel : ℕ) + (inp₀ : Tape) + (work₀ : Fin (0 + outputProbeControllerTapes n + controllerTapes) → + Tape) + (out₀ : Tape) + (hvalue : + (work₀ (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.valueIdx)).HasBinaryNat value) + (hactive : + (work₀ (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.activeIdx)).HasBinaryNat 0) + (hloop : + (work₀ (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.loopIdx)).HasBinaryNat fuel) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanVarResetTM n controllerTapes layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = forwardScanVarResetWork n layout work₀ ∧ + out = out₀) + (forwardScanVarResetTime value fuel) := + forwardScanVarResetTM_hoareTime_internal n controllerTapes layout value + fuel inp₀ work₀ out₀ hvalue hactive hloop hinput hwork houtput + +/-- From a restored completed-variable frame, normalize the private decoder +registers and apply the arity-zero numeric scan update in one exact contract. -/ +theorem forwardScanVarFinishTM_latchFrame_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (value fuel height tokenCount cursor lastOneCount lastOneCursor : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hvalue : + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.valueIdx)).HasBinaryNat value) + (hactive : + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.activeIdx)).HasBinaryNat 0) + (hloop : + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.loopIdx)).HasBinaryNat fuel) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work) : + (forwardScanVarFinishTM n controllerTapes layout).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (fun inp work out => + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + (forwardScanVarResetWork n layout + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).work) + 0 height tokenCount cursor ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).output) + (forwardScanVarFinishTime value fuel height tokenCount cursor + lastOneCount lastOneCursor) := + forwardScanVarFinishTM_latchFrame_hoareTime_internal tm controllerTapes + layout value fuel height tokenCount cursor lastOneCount lastOneCursor + outerExtras input output extras hextras houter houtput hvalue hactive + hloop hframe + +/-- Every non-variable legal tag selects exactly the numeric update named by +its postfix arity, directly from the normalized restored probe frame. -/ +theorem forwardScanFixedContinuationTM_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (tag : OutputProbeTokenTag) (hfixed : tag ≠ .var) + (height tokenCount cursor lastOneCount lastOneCursor : ℕ) + (hpositive : forwardScanTokenTagArity tag = 2 → 1 ≤ height) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work) : + (outputProbeTokenContinuation (some tag) + (forwardScanVarTokenStepTM tm controllerTapes layout) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + (forwardScanTokenStepTM (layout.scanLayout n) 1) + (forwardScanTokenStepTM (layout.scanLayout n) 2) + (forwardScanTokenStepTM (layout.scanLayout n) 2) + skipTM).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (fun inp work out => + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).work + (forwardScanTokenTagArity tag) height tokenCount cursor ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).output) + (forwardScanTokenStepTime (forwardScanTokenTagArity tag) height + tokenCount cursor lastOneCount lastOneCursor) := + forwardScanFixedContinuationTM_hoareTime_internal tm controllerTapes + layout tag hfixed height tokenCount cursor lastOneCount lastOneCursor + hpositive outerExtras input output extras hextras houter houtput hframe + +/-- For every legal non-variable source tag, complete source probing, tag +normalization, dispatch, and the corresponding numeric scan update form one +exact machine contract. -/ +theorem ComputesInSpace.forwardScanDecodedFixedTokenTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras (outputProbeDecodeTagCursorIdx n + layout.tokenLayout.tagLayout)).HasBinaryNat cursor) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.tagLayout.scratchIdx)).HasBinaryNat 0) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₀Idx)).HasBinaryNat 0) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₁Idx)).HasBinaryNat 0) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₂Idx)).HasBinaryNat 0) + (tag : OutputProbeTokenTag) + (htag : outputProbeTokenTag? ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) = some tag) + (hfixed : tag ≠ .var) + (height tokenCount lastOneCount lastOneCursor : ℕ) + (hpositive : forwardScanTokenTagArity tag = 2 → 1 ≤ height) + (hscanFrame : ForwardScanFrame (layout.scanLayout n) cursor height + tokenCount lastOneCount lastOneCursor outerExtras) : + let after := outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout + outerExtras cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + let afterFrame := outputProbeLatchFrameCfg tm controllerTapes after input + output extras false + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (forwardScanDecodedTokenTM tm controllerTapes layout).HoareTime pre + (fun inp work out => + inp = afterFrame.input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + afterFrame.work (forwardScanTokenTagArity tag) height tokenCount + (cursor + 3) ∧ + out = afterFrame.output) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) + (forwardScanTokenStepTime (forwardScanTokenTagArity tag) height + tokenCount (cursor + 3) lastOneCount lastOneCursor)) := + forwardScanDecodedFixedTokenTM_hoareTime_internal hcomp input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes layout + outerExtras houter hcursor hscratch htag₀ htag₁ htag₂ tag htag hfixed + height tokenCount lastOneCount lastOneCursor hpositive hscanFrame + +/-- Under a valid bounded terminated-unary query schedule, the concrete +variable continuation reaches the pure decoder's final cursor and then applies +the exact arity-zero scan update. The two semantic premises isolate the token +codec boundary: the payload has terminated and the final numeric frame agrees +with that pure cursor. -/ +theorem ComputesInSpace.forwardScanVarTokenStepTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.scratchIdx)).HasBinaryNat 0) + (htag₀Zero : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₀Idx)).HasBinaryNat 0) + (htag₁Zero : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₁Idx)).HasBinaryNat 0) + (htag₂Zero : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₂Idx)).HasBinaryNat 0) + (hvalue : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.valueIdx)).HasBinaryNat 0) + (hactive : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.activeIdx)).HasBinaryNat 1) + (hloop : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.loopIdx)).HasBinaryNat 0) + (fuelValue : ℕ) + (hfuel : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.fuelIdx)).HasBinaryNat fuelValue) + (hqueryValid : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor < + (f input).length) + (hqueryLimit : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor + 1) ≤ + cleanupLimit) + (height tokenCount lastOneCount lastOneCursor : ℕ) + (hscanFrame : ForwardScanFrame (layout.scanLayout n) cursor height + tokenCount lastOneCount lastOneCursor outerExtras) : + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + layout.tokenLayout.natLayout.cursorIdx + layout.tokenLayout.natLayout.valueIdx + layout.tokenLayout.natLayout.activeIdx + layout.tokenLayout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout + outerExtras cursor tag₀ tag₁ tag₂) + finalState fuelValue + let finalFrame := outputProbeLatchFrameCfg tm controllerTapes finalOuter + input output extras false + finalState.active = false → + ∃ bodyTime : ℕ → ℕ, + (forwardScanVarTokenStepTM tm controllerTapes layout).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout + outerExtras cursor tag₀ tag₁ tag₂) + input output extras false) + (fun inp work out => + inp = finalFrame.input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + (forwardScanVarResetWork n layout finalFrame.work) + 0 height tokenCount finalState.cursor ∧ + out = finalFrame.output) + (binaryForLoopTime bodyTime fuelValue 0 fuelValue + 1 + + forwardScanVarFinishTime finalState.value fuelValue height + tokenCount finalState.cursor lastOneCount lastOneCursor) := + forwardScanVarTokenStepTM_hoareTime_internal hcomp input output houtput + extras hextras hcleanupCounter cleanupLimit hcleanupLimit controllerTapes + layout outerExtras houter cursor tag₀ tag₁ tag₂ hscratch htag₀Zero + htag₁Zero htag₂Zero hvalue hactive hloop fuelValue hfuel hqueryValid + hqueryLimit height tokenCount lastOneCount lastOneCursor hscanFrame + +/-- Variable-decoder normalization is append-only. -/ +theorem forwardScanVarResetTM_isTransducer (n controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + (forwardScanVarResetTM n controllerTapes layout).IsTransducer := + forwardScanVarResetTM_isTransducer_internal n controllerTapes layout + +/-- Completed-variable normalization plus its numeric scan update is append-only. -/ +theorem forwardScanVarFinishTM_isTransducer (n controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + (forwardScanVarFinishTM n controllerTapes layout).IsTransducer := + forwardScanVarFinishTM_isTransducer_internal n controllerTapes layout + +/-- Variable decoding, normalization, and its leaf scan update are append-only. -/ +theorem forwardScanVarTokenStepTM_isTransducer (tm : TM n) + (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + (forwardScanVarTokenStepTM tm controllerTapes layout).IsTransducer := + forwardScanVarTokenStepTM_isTransducer_internal tm controllerTapes layout + +/-- One complete decoded forward-scan token step is append-only. -/ +theorem forwardScanDecodedTokenTM_isTransducer (tm : TM n) + (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + (forwardScanDecodedTokenTM tm controllerTapes layout).IsTransducer := + forwardScanDecodedTokenTM_isTransducer_internal tm controllerTapes layout + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken/Defs.lean new file mode 100644 index 00000000..ba8af8f3 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken/Defs.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScan.Defs +import Complexitylib.Circuits.FormulaEncoding.ForwardNavigation.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDecodeToken.Defs + +/-! +# Token decoding for the forward postfix scan -- definitions + +This layer connects complete formula-token decoding to the numeric forward +scan controller. The source cursor is shared between both phases, while every +other decoder and scan register is structurally distinct. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Sixteen distinct controller roles used by one decoded forward-scan step. + +Roles zero through eight are the complete token decoder. Role zero is also the +scan cursor. Roles nine through fifteen are the remaining seven scan roles. -/ +structure ForwardScanTokenLayout (controllerTapes : ℕ) where + /-- Injective assignment of logical roles to controller tapes. -/ + roles : Fin 16 ↪ Fin controllerTapes + +/-- The fixed three-bit prefix of one legal formula token. -/ +structure ForwardScanTokenTagBits where + /-- First tag bit. -/ + tag₀ : Bool + /-- Second tag bit. -/ + tag₁ : Bool + /-- Third tag bit. -/ + tag₂ : Bool + deriving DecidableEq + +/-- Fixed tag bits corresponding to one pure formula token. -/ +def forwardScanTokenTagBits : + FormulaCode.Token → ForwardScanTokenTagBits + | .var _ => ⟨false, false, false⟩ + | .tru => ⟨false, false, true⟩ + | .fls => ⟨false, true, false⟩ + | .neg => ⟨false, true, true⟩ + | .conj => ⟨true, false, false⟩ + | .disj => ⟨true, false, true⟩ + +/-- Decoder tag corresponding to one pure formula token. -/ +def forwardScanTokenTag : FormulaCode.Token → TM.OutputProbeTokenTag + | .var _ => .var + | .tru => .tru + | .fls => .fls + | .neg => .neg + | .conj => .conj + | .disj => .disj + +/-- Postfix evaluation-stack arity of each legal formula-token tag. -/ +def forwardScanTokenTagArity : TM.OutputProbeTokenTag → ℕ + | .var | .tru | .fls => 0 + | .neg => 1 + | .conj | .disj => 2 + +/-- Restrict the combined layout to the complete nine-role token decoder. -/ +def ForwardScanTokenLayout.tokenLayout + (layout : ForwardScanTokenLayout controllerTapes) : + TM.OutputProbeDecodeTokenLayout controllerTapes where + roles := + { toFun := fun i => layout.roles ⟨i.val, by omega⟩ + inj' := by + intro i j hij + have hroles := congrArg Fin.val (layout.roles.injective hij) + exact Fin.ext (by simpa using hroles) } + +/-- Map the shared cursor and seven private scan roles into controller space. -/ +def ForwardScanTokenLayout.scanControllerRole + (layout : ForwardScanTokenLayout controllerTapes) (i : Fin 8) : + Fin controllerTapes := + layout.roles + ⟨if i.val = 0 then 0 else i.val + 8, by + split <;> omega⟩ + +/-- Restrict the combined layout to the eight physical work tapes used by the +numeric scan. The logical controller roles are embedded after the output-probe +machine's private middle block. -/ +def ForwardScanTokenLayout.scanLayout (n : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + ForwardScanLayout + (0 + TM.outputProbeControllerTapes n + controllerTapes) where + roles := + { toFun := fun i => TM.outputProbeIndexedControllerIdx n + (layout.scanControllerRole i) + inj' := by + intro i j hij + have hphysical := congrArg Fin.val hij + have hcontroller : layout.scanControllerRole i = + layout.scanControllerRole j := by + apply Fin.ext + simp only [TM.outputProbeIndexedControllerIdx] at hphysical + omega + have hroles := congrArg Fin.val (layout.roles.injective hcontroller) + apply Fin.ext + by_cases hi : i.val = 0 <;> by_cases hj : j.val = 0 <;> + simp [hi, hj] at hroles <;> + omega } + +/-- Overwrite only the shared source cursor with a canonical post-token +position. -/ +def forwardScanTokenCursorWork (n : ℕ) {controllerTapes : ℕ} + (layout : ForwardScanTokenLayout controllerTapes) + (work : Fin (0 + TM.outputProbeControllerTapes n + controllerTapes) → + Tape) + (cursor : ℕ) : + Fin (0 + TM.outputProbeControllerTapes n + controllerTapes) → Tape := + Function.update work (layout.scanLayout n).cursorIdx + (TM.outputProbeCounterTape cursor) + +/-- Canonical stable outer frame after consuming and numerically applying one +pure token from a supplied scan state. -/ +def forwardScanTokenOuterExtrasAfter (n : ℕ) {controllerTapes : ℕ} + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + TM.outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : FormulaCode.ForwardScanState) (token : FormulaCode.Token) : + Fin (0 + TM.outputProbeControllerTapes n + controllerTapes) → Tape := + let tag := forwardScanTokenTagBits token + let tagged := TM.outputProbeDecodeTokenOuterExtrasAfter n + layout.tokenLayout outerExtras state.bitOffset tag.tag₀ tag.tag₁ tag.tag₂ + let advanced := forwardScanTokenCursorWork n layout tagged + (state.bitOffset + token.codeLength) + forwardScanTokenStepWork (layout.scanLayout n) advanced token.arity + state.stackHeight state.tokenCount + (state.bitOffset + token.codeLength) + +/-- Literal controller work family after normalizing a completed variable +decoder for the next token. -/ +def forwardScanVarResetWork (n : ℕ) {controllerTapes : ℕ} + (layout : ForwardScanTokenLayout controllerTapes) + (work : Fin (0 + TM.outputProbeControllerTapes n + controllerTapes) → + Tape) : + Fin (0 + TM.outputProbeControllerTapes n + controllerTapes) → Tape := + let token := layout.tokenLayout + Function.update + (Function.update + (Function.update work + (TM.outputProbeIndexedControllerIdx n token.natLayout.valueIdx) + ((Tape.init []).move Dir3.right)) + (TM.outputProbeIndexedControllerIdx n token.natLayout.activeIdx) + ((Tape.init ((1 : ℕ).bits.map Γ.ofBool)).move Dir3.right)) + (TM.outputProbeIndexedControllerIdx n token.natLayout.loopIdx) + ((Tape.init []).move Dir3.right) + +/-- Clear the decoded variable value, restore the active flag to one, and +clear the completed bounded-loop counter. -/ +def forwardScanVarResetTM (n controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + TM (0 + TM.outputProbeControllerTapes n + controllerTapes) := + let token := layout.tokenLayout + TM.seqTM + (TM.clearWorkTM + (TM.outputProbeIndexedControllerIdx n token.natLayout.valueIdx)) + (TM.seqTM + (TM.binarySuccTM + (TM.outputProbeIndexedControllerIdx n token.natLayout.activeIdx)) + (TM.clearWorkTM + (TM.outputProbeIndexedControllerIdx n token.natLayout.loopIdx))) + +/-- Exact runtime of variable-decoder normalization. -/ +def forwardScanVarResetTime (value fuel : ℕ) : ℕ := + TM.clearWorkTimeBound value.bits.length + 1 + + (TM.binarySuccTime 0 + 1 + TM.clearWorkTimeBound fuel.bits.length) + +/-- Normalize a completed variable decoder and apply its arity-zero numeric +scan update. -/ +def forwardScanVarFinishTM (n controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + TM (0 + TM.outputProbeControllerTapes n + controllerTapes) := + TM.seqTM (forwardScanVarResetTM n controllerTapes layout) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + +/-- Exact runtime of completed-variable normalization and its scan update. -/ +def forwardScanVarFinishTime (value fuel height tokenCount cursor + lastOneCount lastOneCursor : ℕ) : ℕ := + forwardScanVarResetTime value fuel + 1 + + forwardScanTokenStepTime 0 height tokenCount cursor lastOneCount + lastOneCursor + +/-- Decode a terminated-unary variable payload, normalize its private decoder +registers, and apply the leaf update to the forward scan. -/ +def forwardScanVarTokenStepTM (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + TM (0 + TM.outputProbeControllerTapes n + controllerTapes) := + let token := layout.tokenLayout + TM.seqTM + (TM.outputProbeDecodeNatTM tm controllerTapes token.natLayout.cursorIdx + token.natLayout.scratchIdx token.natLayout.valueIdx + token.natLayout.activeIdx token.natLayout.loopIdx + token.natLayout.fuelIdx) + (forwardScanVarFinishTM n controllerTapes layout) + +/-- Decode one complete formula token and apply its postfix arity update. +Invalid tags are a no-op; promised canonical formula codes never select that +branch. -/ +def forwardScanDecodedTokenTM (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + TM (0 + TM.outputProbeControllerTapes n + controllerTapes) := + TM.outputProbeDecodeTokenTM tm controllerTapes layout.tokenLayout + (forwardScanVarTokenStepTM tm controllerTapes layout) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + (forwardScanTokenStepTM (layout.scanLayout n) 1) + (forwardScanTokenStepTM (layout.scanLayout n) 2) + (forwardScanTokenStepTM (layout.scanLayout n) 2) + TM.skipTM + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken/Internal.lean new file mode 100644 index 00000000..bc700193 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/ForwardScanToken/Internal.lean @@ -0,0 +1,1613 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScan +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.ForwardScanToken.Defs +import Complexitylib.Circuits.FormulaEncoding.ForwardNavigation +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation +import Complexitylib.Models.TuringMachine.OutputProbeDecodeToken +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork + +/-! +# Token decoding for the forward postfix scan -- proof internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +theorem forwardScanTokenTagArity_eq_internal (token : FormulaCode.Token) : + forwardScanTokenTagArity (forwardScanTokenTag token) = token.arity := by + cases token <;> rfl + +theorem forwardScanTokenTagBits_classify_internal + (token : FormulaCode.Token) : + let bits := forwardScanTokenTagBits token + outputProbeTokenTag? bits.tag₀ bits.tag₁ bits.tag₂ = + some (forwardScanTokenTag token) := by + cases token <;> rfl + +private theorem outputProbeTokenTag?_of_decodeTokenAt + (query : FormulaCode.BitOracle) (fuel cursor next : ℕ) + (token : FormulaCode.Token) + (hdecode : FormulaCode.BitOracle.decodeTokenAt? query fuel cursor = + some (token, next)) : + ∃ tag₀ tag₁ tag₂, + query cursor = some tag₀ ∧ + query (cursor + 1) = some tag₁ ∧ + query (cursor + 2) = some tag₂ ∧ + outputProbeTokenTag? tag₀ tag₁ tag₂ = + some (forwardScanTokenTag token) := by + cases h₀ : query cursor with + | none => simp [FormulaCode.BitOracle.decodeTokenAt?, h₀] at hdecode + | some tag₀ => + cases h₁ : query (cursor + 1) with + | none => + simp [FormulaCode.BitOracle.decodeTokenAt?, h₀, h₁] at hdecode + | some tag₁ => + cases h₂ : query (cursor + 2) with + | none => + simp [FormulaCode.BitOracle.decodeTokenAt?, h₀, h₁, + h₂] at hdecode + | some tag₂ => + refine ⟨tag₀, tag₁, tag₂, rfl, rfl, rfl, ?_⟩ + cases token <;> cases tag₀ <;> cases tag₁ <;> cases tag₂ <;> + simp [FormulaCode.BitOracle.decodeTokenAt?, h₀, h₁, h₂, + outputProbeTokenTag?, forwardScanTokenTag, + Option.bind_eq_some_iff] at hdecode ⊢ + +theorem outputProbeTokenTag?_ofList_encodeTokenStream_internal + (stream : List FormulaCode.Token) (index : ℕ) + (hindex : index < stream.length) : + let cursor := stream.length + 1 + FormulaCode.tokenBitOffset stream index + ∃ tag₀ tag₁ tag₂, + FormulaCode.BitOracle.ofList (FormulaCode.encodeTokenStream stream) + cursor = some tag₀ ∧ + FormulaCode.BitOracle.ofList (FormulaCode.encodeTokenStream stream) + (cursor + 1) = some tag₁ ∧ + FormulaCode.BitOracle.ofList (FormulaCode.encodeTokenStream stream) + (cursor + 2) = some tag₂ ∧ + outputProbeTokenTag? tag₀ tag₁ tag₂ = + some (forwardScanTokenTag stream[index]) := by + dsimp only + let before := CircuitCode.NatCode.encode stream.length ++ + (stream.take index).flatMap FormulaCode.Token.encode + let after := + (stream.drop (index + 1)).flatMap FormulaCode.Token.encode + have hdrop : stream.drop index = + stream[index] :: stream.drop (index + 1) := + List.drop_eq_getElem_cons hindex + have hflat : stream.flatMap FormulaCode.Token.encode = + (stream.take index).flatMap FormulaCode.Token.encode ++ + FormulaCode.Token.encode stream[index] ++ + (stream.drop (index + 1)).flatMap FormulaCode.Token.encode := by + calc + stream.flatMap FormulaCode.Token.encode = + (stream.take index ++ stream.drop index).flatMap + FormulaCode.Token.encode := by + exact congrArg (List.flatMap FormulaCode.Token.encode) + (List.take_append_drop index stream).symm + _ = _ := by + rw [List.flatMap_append, hdrop, List.flatMap_cons] + simp only [List.append_assoc] + have hstream : FormulaCode.encodeTokenStream stream = + before ++ FormulaCode.Token.encode stream[index] ++ after := by + rw [FormulaCode.encodeTokenStream, hflat] + simp [before, after, List.append_assoc] + have hbefore : before.length = + stream.length + 1 + FormulaCode.tokenBitOffset stream index := by + simp [before, CircuitCode.NatCode.length_encode, + FormulaCode.tokenBitOffset, + FormulaCode.tokensCodeLength_eq_flatMap_length_internal] + have hdecode := + FormulaCode.BitOracle.decodeTokenAt?_ofList_append_encode_internal + before after stream[index] 0 + rw [← hstream, hbefore] at hdecode + exact outputProbeTokenTag?_of_decodeTokenAt _ _ _ _ _ hdecode + +theorem forwardScanTokenTagBits_ofList_encodeTokenStream_internal + (stream : List FormulaCode.Token) (index : ℕ) + (hindex : index < stream.length) : + let bits := FormulaCode.encodeTokenStream stream + let cursor := stream.length + 1 + FormulaCode.tokenBitOffset stream index + let tag := forwardScanTokenTagBits stream[index] + FormulaCode.BitOracle.ofList bits cursor = some tag.tag₀ ∧ + FormulaCode.BitOracle.ofList bits (cursor + 1) = some tag.tag₁ ∧ + FormulaCode.BitOracle.ofList bits (cursor + 2) = some tag.tag₂ := by + dsimp only + obtain ⟨tag₀, tag₁, tag₂, h₀, h₁, h₂, htag⟩ := + outputProbeTokenTag?_ofList_encodeTokenStream_internal stream index hindex + cases htoken : stream[index] <;> + cases tag₀ <;> cases tag₁ <;> cases tag₂ <;> + simp [forwardScanTokenTag, forwardScanTokenTagBits, + outputProbeTokenTag?, htoken] at htag ⊢ <;> + exact ⟨h₀, h₁, h₂⟩ + +theorem outputProbeTokenTag?_getElem_encodeTokenStream_internal + (stream : List FormulaCode.Token) (index : ℕ) + (hindex : index < stream.length) : + let bits := FormulaCode.encodeTokenStream stream + let cursor := stream.length + 1 + FormulaCode.tokenBitOffset stream index + ∃ (h₀ : cursor < bits.length) (h₁ : cursor + 1 < bits.length) + (h₂ : cursor + 2 < bits.length), + outputProbeTokenTag? (bits[cursor]'h₀) (bits[cursor + 1]'h₁) + (bits[cursor + 2]'h₂) = + some (forwardScanTokenTag stream[index]) := by + dsimp only + obtain ⟨tag₀, tag₁, tag₂, h₀, h₁, h₂, htag⟩ := + outputProbeTokenTag?_ofList_encodeTokenStream_internal stream index hindex + simp only [FormulaCode.BitOracle.ofList] at h₀ h₁ h₂ + obtain ⟨hbound₀, hvalue₀⟩ := List.getElem?_eq_some_iff.mp h₀ + obtain ⟨hbound₁, hvalue₁⟩ := List.getElem?_eq_some_iff.mp h₁ + obtain ⟨hbound₂, hvalue₂⟩ := List.getElem?_eq_some_iff.mp h₂ + refine ⟨hbound₀, hbound₁, hbound₂, ?_⟩ + simpa [hvalue₀, hvalue₁, hvalue₂] using htag + +theorem ForwardScanFrame.forwardScanTokenStepWork_internal + (layout : ForwardScanLayout n) + (state : FormulaCode.ForwardScanState) (token : FormulaCode.Token) + (work : Fin n → Tape) + (hframe : ForwardScanFrame layout + (state.bitOffset + token.codeLength) state.stackHeight state.tokenCount + state.lastOneCount state.lastOneBitOffset work) : + ForwardScanFrame layout (state.step token).bitOffset + (state.step token).stackHeight (state.step token).tokenCount + (state.step token).lastOneCount (state.step token).lastOneBitOffset + (forwardScanTokenStepWork layout work token.arity state.stackHeight + state.tokenCount (state.bitOffset + token.codeLength)) := by + rcases hframe with ⟨hcursor, _hheight, _hcount, hlastCount, hlastCursor, + hone, _hresult, hscratch⟩ + have hcursor' : (work (layout.roles 0)).HasBinaryNat + (state.bitOffset + token.codeLength) := by + simpa [ForwardScanLayout.cursorIdx] using hcursor + have hlastCount' : (work (layout.roles 3)).HasBinaryNat + state.lastOneCount := by + simpa [ForwardScanLayout.lastOneCountIdx] using hlastCount + have hlastCursor' : (work (layout.roles 4)).HasBinaryNat + state.lastOneBitOffset := by + simpa [ForwardScanLayout.lastOneCursorIdx] using hlastCursor + have hone' : (work (layout.roles 5)).HasBinaryNat 1 := by + simpa [ForwardScanLayout.oneIdx] using hone + have hscratch' : (work (layout.roles 7)).HasBinaryNat 0 := by + simpa [ForwardScanLayout.copyScratchIdx] using hscratch + simp only [FormulaCode.ForwardScanState.step] + by_cases honeHeight : state.stackHeight + 1 - token.arity = 1 + · simp [forwardScanTokenStepWork, forwardScanAfterHeightWork, + forwardScanBoundaryWork, honeHeight, ForwardScanFrame, + ForwardScanLayout.cursorIdx, ForwardScanLayout.heightIdx, + ForwardScanLayout.tokenCountIdx, ForwardScanLayout.lastOneCountIdx, + ForwardScanLayout.lastOneCursorIdx, ForwardScanLayout.oneIdx, + ForwardScanLayout.resultIdx, ForwardScanLayout.copyScratchIdx, + layout.roles.injective.eq_iff] + exact ⟨hcursor', by simpa using Tape.init_move_right_hasBinaryNat 1, + Tape.init_move_right_hasBinaryNat (state.tokenCount + 1), + Tape.init_move_right_hasBinaryNat + (state.bitOffset + token.codeLength), hone', + Tape.init_move_right_hasBinaryNat 0, hscratch'⟩ + · simp [forwardScanTokenStepWork, forwardScanAfterHeightWork, + honeHeight, ForwardScanFrame, ForwardScanLayout.cursorIdx, + ForwardScanLayout.heightIdx, ForwardScanLayout.tokenCountIdx, + ForwardScanLayout.lastOneCountIdx, + ForwardScanLayout.lastOneCursorIdx, ForwardScanLayout.oneIdx, + ForwardScanLayout.resultIdx, ForwardScanLayout.copyScratchIdx, + layout.roles.injective.eq_iff] + exact ⟨hcursor', Tape.init_move_right_hasBinaryNat + (state.stackHeight + 1 - token.arity), + Tape.init_move_right_hasBinaryNat (state.tokenCount + 1), + hlastCount', hlastCursor', hone', Tape.init_move_right_hasBinaryNat 0, + hscratch'⟩ + +theorem ForwardScanFrame.forwardScanTokenCursorWork_internal + (n : ℕ) (layout : ForwardScanTokenLayout controllerTapes) + (oldCursor cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (hframe : ForwardScanFrame (layout.scanLayout n) oldCursor height + tokenCount lastOneCount lastOneCursor work) : + ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (forwardScanTokenCursorWork n layout work cursor) := by + let scan := layout.scanLayout n + have hne (i : Fin 8) (hi : i ≠ 0) : scan.roles i ≠ scan.cursorIdx := by + unfold scan ForwardScanLayout.cursorIdx + exact scan.roles.injective.ne hi + have hheightNe : + (layout.scanLayout n).heightIdx ≠ (layout.scanLayout n).cursorIdx := by + simpa [scan, ForwardScanLayout.heightIdx] using hne 1 (by decide) + have hcountNe : + (layout.scanLayout n).tokenCountIdx ≠ + (layout.scanLayout n).cursorIdx := by + simpa [scan, ForwardScanLayout.tokenCountIdx] using hne 2 (by decide) + have hlastCountNe : + (layout.scanLayout n).lastOneCountIdx ≠ + (layout.scanLayout n).cursorIdx := by + simpa [scan, ForwardScanLayout.lastOneCountIdx] using hne 3 (by decide) + have hlastCursorNe : + (layout.scanLayout n).lastOneCursorIdx ≠ + (layout.scanLayout n).cursorIdx := by + simpa [scan, ForwardScanLayout.lastOneCursorIdx] using hne 4 (by decide) + have honeNe : + (layout.scanLayout n).oneIdx ≠ (layout.scanLayout n).cursorIdx := by + simpa [scan, ForwardScanLayout.oneIdx] using hne 5 (by decide) + have hresultNe : + (layout.scanLayout n).resultIdx ≠ (layout.scanLayout n).cursorIdx := by + simpa [scan, ForwardScanLayout.resultIdx] using hne 6 (by decide) + have hscratchNe : + (layout.scanLayout n).copyScratchIdx ≠ + (layout.scanLayout n).cursorIdx := by + simpa [scan, ForwardScanLayout.copyScratchIdx] using hne 7 (by decide) + rcases hframe with ⟨_hcursor, hheight, hcount, hlastCount, hlastCursor, + hone, hresult, hscratch⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simp only [forwardScanTokenCursorWork, Function.update_self] + simpa [outputProbeCounterTape] using + Tape.init_move_right_hasBinaryNat cursor + · simpa only [forwardScanTokenCursorWork, + Function.update_of_ne hheightNe] using hheight + · simpa only [forwardScanTokenCursorWork, + Function.update_of_ne hcountNe] using hcount + · simpa only [forwardScanTokenCursorWork, + Function.update_of_ne hlastCountNe] using hlastCount + · simpa only [forwardScanTokenCursorWork, + Function.update_of_ne hlastCursorNe] using hlastCursor + · simpa only [forwardScanTokenCursorWork, + Function.update_of_ne honeNe] using hone + · simpa only [forwardScanTokenCursorWork, + Function.update_of_ne hresultNe] using hresult + · simpa only [forwardScanTokenCursorWork, + Function.update_of_ne hscratchNe] using hscratch + +private theorem outputProbeLatchFramePost_updateScanRole + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) + (i : Fin 8) (tape : Tape) : + outputProbeLatchFramePost tm controllerTapes + (Function.update outerExtras ((layout.scanLayout n).roles i) tape) + input output extras bit inp + (Function.update work ((layout.scanLayout n).roles i) tape) out := by + change outputProbeLatchFramePost tm controllerTapes + (Function.update outerExtras + (outputProbeIndexedControllerIdx n (layout.scanControllerRole i)) tape) + input output extras bit inp + (Function.update work + (outputProbeIndexedControllerIdx n (layout.scanControllerRole i)) tape) + out + exact outputProbeLatchFramePost_updateController tm controllerTapes + outerExtras input output extras bit inp work out hpost + (layout.scanControllerRole i) tape + +theorem outputProbeLatchFramePost_forwardScanTokenStepWork_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) + (arity height tokenCount cursor : ℕ) : + outputProbeLatchFramePost tm controllerTapes + (forwardScanTokenStepWork (layout.scanLayout n) outerExtras arity height + tokenCount cursor) + input output extras bit inp + (forwardScanTokenStepWork (layout.scanLayout n) work arity height + tokenCount cursor) out := by + let scan := layout.scanLayout n + let nextHeight := height + 1 - arity + let heightTape := + ((Tape.init (nextHeight.bits.map Γ.ofBool)).move Dir3.right) + let heightOuter := Function.update outerExtras scan.heightIdx heightTape + let heightWork := Function.update work scan.heightIdx heightTape + have hheight : outputProbeLatchFramePost tm controllerTapes heightOuter + input output extras bit inp heightWork out := by + simpa [heightOuter, heightWork, heightTape, scan, + ForwardScanLayout.heightIdx] using + outputProbeLatchFramePost_updateScanRole tm controllerTapes layout + outerExtras input output extras bit inp work out hpost 1 heightTape + let countTape := + ((Tape.init ((tokenCount + 1).bits.map Γ.ofBool)).move Dir3.right) + let countOuter := Function.update heightOuter scan.tokenCountIdx countTape + let countWork := Function.update heightWork scan.tokenCountIdx countTape + have hcount : outputProbeLatchFramePost tm controllerTapes countOuter + input output extras bit inp countWork out := by + simpa [countOuter, countWork, countTape, scan, + ForwardScanLayout.tokenCountIdx] using + outputProbeLatchFramePost_updateScanRole tm controllerTapes layout + heightOuter input output extras bit inp heightWork out hheight 2 + countTape + let resultTape := + ((Tape.init ([decide (nextHeight = 1)].map Γ.ofBool)).move Dir3.right) + let comparedOuter := Function.update countOuter scan.resultIdx resultTape + let comparedWork := Function.update countWork scan.resultIdx resultTape + have hcompared : outputProbeLatchFramePost tm controllerTapes comparedOuter + input output extras bit inp comparedWork out := by + simpa [comparedOuter, comparedWork, resultTape, scan, + ForwardScanLayout.resultIdx] using + outputProbeLatchFramePost_updateScanRole tm controllerTapes layout + countOuter input output extras bit inp countWork out hcount 6 + resultTape + by_cases hone : nextHeight = 1 + · let lastCountTape := + ((Tape.init ((tokenCount + 1).bits.map Γ.ofBool)).move Dir3.right) + let lastCountOuter := + Function.update comparedOuter scan.lastOneCountIdx lastCountTape + let lastCountWork := + Function.update comparedWork scan.lastOneCountIdx lastCountTape + have hlastCount : outputProbeLatchFramePost tm controllerTapes + lastCountOuter input output extras bit inp lastCountWork out := by + simpa [lastCountOuter, lastCountWork, lastCountTape, scan, + ForwardScanLayout.lastOneCountIdx] using + outputProbeLatchFramePost_updateScanRole tm controllerTapes layout + comparedOuter input output extras bit inp comparedWork out hcompared + 3 lastCountTape + let lastCursorTape := + ((Tape.init (cursor.bits.map Γ.ofBool)).move Dir3.right) + let lastCursorOuter := + Function.update lastCountOuter scan.lastOneCursorIdx lastCursorTape + let lastCursorWork := + Function.update lastCountWork scan.lastOneCursorIdx lastCursorTape + have hlastCursor : outputProbeLatchFramePost tm controllerTapes + lastCursorOuter input output extras bit inp lastCursorWork out := by + simpa [lastCursorOuter, lastCursorWork, lastCursorTape, scan, + ForwardScanLayout.lastOneCursorIdx] using + outputProbeLatchFramePost_updateScanRole tm controllerTapes layout + lastCountOuter input output extras bit inp lastCountWork out + hlastCount 4 lastCursorTape + let zeroTape := ((Tape.init []).move Dir3.right) + have hzero := outputProbeLatchFramePost_updateScanRole tm controllerTapes + layout lastCursorOuter input output extras bit inp lastCursorWork out + hlastCursor 6 zeroTape + simpa [forwardScanTokenStepWork, forwardScanAfterHeightWork, + forwardScanBoundaryWork, scan, nextHeight, heightTape, heightOuter, + heightWork, countTape, countOuter, countWork, resultTape, comparedOuter, + comparedWork, lastCountTape, lastCountOuter, lastCountWork, + lastCursorTape, lastCursorOuter, lastCursorWork, zeroTape, hone] using + hzero + · let zeroTape := ((Tape.init []).move Dir3.right) + have hzero := outputProbeLatchFramePost_updateScanRole tm controllerTapes + layout comparedOuter input output extras bit inp comparedWork out + hcompared 6 zeroTape + simpa [forwardScanTokenStepWork, forwardScanAfterHeightWork, scan, + nextHeight, heightTape, heightOuter, heightWork, countTape, countOuter, + countWork, resultTape, comparedOuter, comparedWork, zeroTape, hone, + ForwardScanLayout.resultIdx, ForwardScanTokenLayout.scanLayout, + ForwardScanTokenLayout.scanControllerRole] using + hzero + +theorem outputProbeLatchFramePost_forwardScanVarResetWork_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) : + outputProbeLatchFramePost tm controllerTapes + (forwardScanVarResetWork n layout outerExtras) + input output extras bit inp (forwardScanVarResetWork n layout work) + out := by + let token := layout.tokenLayout + let zeroTape := ((Tape.init []).move Dir3.right) + let oneTape := + ((Tape.init ((1 : ℕ).bits.map Γ.ofBool)).move Dir3.right) + let valueOuter := Function.update outerExtras + (outputProbeIndexedControllerIdx n token.natLayout.valueIdx) zeroTape + let valueWork := Function.update work + (outputProbeIndexedControllerIdx n token.natLayout.valueIdx) zeroTape + have hvalue : outputProbeLatchFramePost tm controllerTapes valueOuter input + output extras bit inp valueWork out := by + exact outputProbeLatchFramePost_updateController tm controllerTapes + outerExtras input output extras bit inp work out hpost + token.natLayout.valueIdx zeroTape + let activeOuter := Function.update valueOuter + (outputProbeIndexedControllerIdx n token.natLayout.activeIdx) oneTape + let activeWork := Function.update valueWork + (outputProbeIndexedControllerIdx n token.natLayout.activeIdx) oneTape + have hactive : outputProbeLatchFramePost tm controllerTapes activeOuter input + output extras bit inp activeWork out := by + exact outputProbeLatchFramePost_updateController tm controllerTapes + valueOuter input output extras bit inp valueWork out hvalue + token.natLayout.activeIdx oneTape + have hloop := outputProbeLatchFramePost_updateController tm controllerTapes + activeOuter input output extras bit inp activeWork out hactive + token.natLayout.loopIdx zeroTape + simpa [forwardScanVarResetWork, token, zeroTape, oneTape, valueOuter, + valueWork, activeOuter, activeWork] using hloop + +theorem outputProbeDecodeTokenVarFinalState_of_encode_internal + (before after : List Bool) (varValue extraFuel : ℕ) : + (outputProbeDecodeNatStateAt + (before ++ FormulaCode.Token.encode + (FormulaCode.Token.var varValue) ++ after) + (outputProbeDecodeTokenVarInitial before.length) + (varValue + 1 + extraFuel)).result? = + (some (varValue, before.length + varValue + 4) : + Option (ℕ × ℕ)) := + by + rw [outputProbeDecodeNatStateAt] + simp only [outputProbeDecodeTokenVarInitial] + rw [outputProbeDecodeNatRun_result] + simpa [outputProbeDecodeTokenVarInitial, FormulaCode.Token.encode, + List.append_assoc, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using + (FormulaCode.BitOracle.decodeNatAt?_ofList_append_encode + (before ++ [false, false, false]) after varValue extraFuel 0) + +private theorem latchFramePost_transition + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) : + ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false (transitionInput inp) + (fun i => transitionTape (work i)) (transitionTape out) := by + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + rw [hinput.transitionInput_eq_self] + have hworkTransition : (fun i => transitionTape (work i)) = work := by + funext i + exact (hwork i).transitionTape_eq_self + rw [hworkTransition, hout.transitionTape_eq_self] + exact hpost + +theorem ForwardScanTokenLayout.scanLayout_cursorIdx_internal + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).cursorIdx = + outputProbeIndexedControllerIdx n + layout.tokenLayout.tagLayout.cursorIdx := by + rfl + +@[simp] +theorem ForwardScanTokenLayout.scanLayout_heightIdx_internal + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).heightIdx = + outputProbeIndexedControllerIdx n (layout.roles 9) := by + rfl + +@[simp] +theorem ForwardScanTokenLayout.scanLayout_tokenCountIdx_internal + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).tokenCountIdx = + outputProbeIndexedControllerIdx n (layout.roles 10) := by + rfl + +@[simp] +theorem ForwardScanTokenLayout.scanLayout_lastOneCountIdx_internal + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).lastOneCountIdx = + outputProbeIndexedControllerIdx n (layout.roles 11) := by + rfl + +@[simp] +theorem ForwardScanTokenLayout.scanLayout_lastOneCursorIdx_internal + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).lastOneCursorIdx = + outputProbeIndexedControllerIdx n (layout.roles 12) := by + rfl + +@[simp] +theorem ForwardScanTokenLayout.scanLayout_oneIdx_internal + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).oneIdx = + outputProbeIndexedControllerIdx n (layout.roles 13) := by + rfl + +@[simp] +theorem ForwardScanTokenLayout.scanLayout_resultIdx_internal + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).resultIdx = + outputProbeIndexedControllerIdx n (layout.roles 14) := by + rfl + +@[simp] +theorem ForwardScanTokenLayout.scanLayout_copyScratchIdx_internal + (layout : ForwardScanTokenLayout controllerTapes) : + (layout.scanLayout n).copyScratchIdx = + outputProbeIndexedControllerIdx n (layout.roles 15) := by + rfl + +private theorem ForwardScanTokenLayout.scanRole_ne_tokenRole + (layout : ForwardScanTokenLayout controllerTapes) (n : ℕ) + (i : Fin 8) (j : Fin 9) (hj : 5 ≤ j.val) : + (layout.scanLayout n).roles i ≠ + outputProbeIndexedControllerIdx n (layout.tokenLayout.roles j) := by + intro heq + have hcontroller : layout.scanControllerRole i = + layout.tokenLayout.roles j := + outputProbeIndexedControllerIdx_injective n heq + have hcombined : + layout.roles + ⟨if i.val = 0 then 0 else i.val + 8, by split <;> omega⟩ = + layout.roles ⟨j.val, by omega⟩ := by + simpa only [ForwardScanTokenLayout.scanControllerRole, + ForwardScanTokenLayout.tokenLayout] using hcontroller + have hindices : + (⟨if i.val = 0 then 0 else i.val + 8, by split <;> omega⟩ : Fin 16) = + ⟨j.val, by omega⟩ := + layout.roles.injective hcombined + have hroles : (if i.val = 0 then 0 else i.val + 8) = j.val := + congrArg Fin.val hindices + by_cases hi : i.val = 0 + · simp [hi] at hroles + omega + · simp [hi] at hroles + omega + +private theorem ForwardScanTokenLayout.scanControllerRole_ne_tokenRole_of_pos + (layout : ForwardScanTokenLayout controllerTapes) + (i : Fin 8) (hi : i.val ≠ 0) (j : Fin 9) : + layout.scanControllerRole i ≠ layout.tokenLayout.roles j := by + intro heq + have hcombined : + layout.roles ⟨i.val + 8, by omega⟩ = + layout.roles ⟨j.val, by omega⟩ := by + simpa only [ForwardScanTokenLayout.scanControllerRole, + ForwardScanTokenLayout.tokenLayout, if_neg hi] using heq + have hindices : (⟨i.val + 8, by omega⟩ : Fin 16) = + ⟨j.val, by omega⟩ := layout.roles.injective hcombined + have hvals : i.val + 8 = j.val := congrArg Fin.val hindices + omega + +theorem forwardScanVarResetWork_scanRole_internal (n : ℕ) + {controllerTapes : ℕ} + (layout : ForwardScanTokenLayout controllerTapes) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → + Tape) + (i : Fin 8) : + forwardScanVarResetWork n layout work ((layout.scanLayout n).roles i) = + work ((layout.scanLayout n).roles i) := by + have hvalue := layout.scanRole_ne_tokenRole n i 5 (by decide) + have hactive := layout.scanRole_ne_tokenRole n i 6 (by decide) + have hloop := layout.scanRole_ne_tokenRole n i 7 (by decide) + have hvalue' : (layout.scanLayout n).roles i ≠ + outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.valueIdx := by + simpa only [OutputProbeDecodeTokenLayout.natLayout_valueIdx] using hvalue + have hactive' : (layout.scanLayout n).roles i ≠ + outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.activeIdx := by + simpa only [OutputProbeDecodeTokenLayout.natLayout_activeIdx] using hactive + have hloop' : (layout.scanLayout n).roles i ≠ + outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.loopIdx := by + simpa only [OutputProbeDecodeTokenLayout.natLayout_loopIdx] using hloop + simp only [forwardScanVarResetWork, Function.update_of_ne hvalue', + Function.update_of_ne hactive', Function.update_of_ne hloop'] + +theorem ForwardScanFrame.forwardScanVarResetWork_internal + (layout : ForwardScanTokenLayout controllerTapes) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → + Tape) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor work) : + ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor (forwardScanVarResetWork n layout work) := by + rcases hframe with ⟨hcursor, hheight, hcount, hlastCount, hlastCursor, + hone, hresult, hscratch⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa only [ForwardScanLayout.cursorIdx, + forwardScanVarResetWork_scanRole_internal] using hcursor + · simpa only [ForwardScanLayout.heightIdx, + forwardScanVarResetWork_scanRole_internal] using hheight + · simpa only [ForwardScanLayout.tokenCountIdx, + forwardScanVarResetWork_scanRole_internal] using hcount + · simpa only [ForwardScanLayout.lastOneCountIdx, + forwardScanVarResetWork_scanRole_internal] using hlastCount + · simpa only [ForwardScanLayout.lastOneCursorIdx, + forwardScanVarResetWork_scanRole_internal] using hlastCursor + · simpa only [ForwardScanLayout.oneIdx, + forwardScanVarResetWork_scanRole_internal] using hone + · simpa only [ForwardScanLayout.resultIdx, + forwardScanVarResetWork_scanRole_internal] using hresult + · simpa only [ForwardScanLayout.copyScratchIdx, + forwardScanVarResetWork_scanRole_internal] using hscratch + +theorem ForwardScanFrame.outputProbeLatchFrameCfg_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor outerExtras) : + ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work := by + let frame := outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false + have hpost := outputProbeLatchFrameCfg_post tm controllerTapes outerExtras + input output extras false + have hrole (i : Fin 8) : + frame.work ((layout.scanLayout n).roles i) = + outerExtras ((layout.scanLayout n).roles i) := by + change frame.work (outputProbeIndexedControllerIdx n + (layout.scanControllerRole i)) = + outerExtras (outputProbeIndexedControllerIdx n + (layout.scanControllerRole i)) + exact outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false frame.input frame.work frame.output hpost + (layout.scanControllerRole i) + rcases hframe with ⟨hcursor, hheight, hcount, hlastCount, hlastCursor, + hone, hresult, hscratch⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · change (frame.work ((layout.scanLayout n).roles 0)).HasBinaryNat cursor + rw [hrole 0] + exact hcursor + · change (frame.work ((layout.scanLayout n).roles 1)).HasBinaryNat height + rw [hrole 1] + exact hheight + · change (frame.work ((layout.scanLayout n).roles 2)).HasBinaryNat tokenCount + rw [hrole 2] + exact hcount + · change (frame.work ((layout.scanLayout n).roles 3)).HasBinaryNat lastOneCount + rw [hrole 3] + exact hlastCount + · change (frame.work ((layout.scanLayout n).roles 4)).HasBinaryNat lastOneCursor + rw [hrole 4] + exact hlastCursor + · change (frame.work ((layout.scanLayout n).roles 5)).HasBinaryNat 1 + rw [hrole 5] + exact hone + · change (frame.work ((layout.scanLayout n).roles 6)).HasBinaryNat 0 + rw [hrole 6] + exact hresult + · change (frame.work ((layout.scanLayout n).roles 7)).HasBinaryNat 0 + rw [hrole 7] + exact hscratch + +private theorem outputProbeDecodeTokenOuterExtrasAfter_scanRole + (n : ℕ) {controllerTapes : ℕ} + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (i : Fin 8) (hi : i.val ≠ 0) : + outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout outerExtras + cursor tag₀ tag₁ tag₂ ((layout.scanLayout n).roles i) = + outerExtras ((layout.scanLayout n).roles i) := by + change outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout + outerExtras cursor tag₀ tag₁ tag₂ + (outputProbeIndexedControllerIdx n (layout.scanControllerRole i)) = + outerExtras + (outputProbeIndexedControllerIdx n (layout.scanControllerRole i)) + apply outputProbeDecodeTokenOuterExtrasAfter_other n layout.tokenLayout + outerExtras cursor tag₀ tag₁ tag₂ (layout.scanControllerRole i) + · exact layout.scanControllerRole_ne_tokenRole_of_pos i hi 0 + · exact layout.scanControllerRole_ne_tokenRole_of_pos i hi 2 + · exact layout.scanControllerRole_ne_tokenRole_of_pos i hi 3 + · exact layout.scanControllerRole_ne_tokenRole_of_pos i hi 4 + +theorem ForwardScanFrame.outputProbeDecodeTokenOuterExtrasAfter_internal + (layout : ForwardScanTokenLayout controllerTapes) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor outerExtras) : + ForwardScanFrame (layout.scanLayout n) (cursor + 3) height tokenCount + lastOneCount lastOneCursor + (outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout outerExtras + cursor tag₀ tag₁ tag₂) := by + rcases hframe with ⟨hcursor, hheight, hcount, hlastCount, hlastCursor, + hone, hresult, hscratch⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [ForwardScanTokenLayout.scanLayout_cursorIdx_internal] + simpa only [OutputProbeDecodeTokenLayout.tagLayout_cursorIdx] using + outputProbeDecodeTokenOuterExtrasAfter_cursor n layout.tokenLayout + outerExtras cursor tag₀ tag₁ tag₂ + · simpa only [ForwardScanLayout.heightIdx, + outputProbeDecodeTokenOuterExtrasAfter_scanRole n layout outerExtras + cursor tag₀ tag₁ tag₂ 1 (by decide)] using hheight + · simpa only [ForwardScanLayout.tokenCountIdx, + outputProbeDecodeTokenOuterExtrasAfter_scanRole n layout outerExtras + cursor tag₀ tag₁ tag₂ 2 (by decide)] using hcount + · simpa only [ForwardScanLayout.lastOneCountIdx, + outputProbeDecodeTokenOuterExtrasAfter_scanRole n layout outerExtras + cursor tag₀ tag₁ tag₂ 3 (by decide)] using hlastCount + · simpa only [ForwardScanLayout.lastOneCursorIdx, + outputProbeDecodeTokenOuterExtrasAfter_scanRole n layout outerExtras + cursor tag₀ tag₁ tag₂ 4 (by decide)] using hlastCursor + · simpa only [ForwardScanLayout.oneIdx, + outputProbeDecodeTokenOuterExtrasAfter_scanRole n layout outerExtras + cursor tag₀ tag₁ tag₂ 5 (by decide)] using hone + · simpa only [ForwardScanLayout.resultIdx, + outputProbeDecodeTokenOuterExtrasAfter_scanRole n layout outerExtras + cursor tag₀ tag₁ tag₂ 6 (by decide)] using hresult + · simpa only [ForwardScanLayout.copyScratchIdx, + outputProbeDecodeTokenOuterExtrasAfter_scanRole n layout outerExtras + cursor tag₀ tag₁ tag₂ 7 (by decide)] using hscratch + +theorem ForwardScanFrame.forwardScanTokenOuterExtrasAfter_internal + (n : ℕ) (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : FormulaCode.ForwardScanState) (token : FormulaCode.Token) + (hframe : ForwardScanFrame (layout.scanLayout n) state.bitOffset + state.stackHeight state.tokenCount state.lastOneCount + state.lastOneBitOffset outerExtras) : + ForwardScanFrame (layout.scanLayout n) (state.step token).bitOffset + (state.step token).stackHeight (state.step token).tokenCount + (state.step token).lastOneCount (state.step token).lastOneBitOffset + (forwardScanTokenOuterExtrasAfter n layout outerExtras state token) := by + unfold forwardScanTokenOuterExtrasAfter + apply ForwardScanFrame.forwardScanTokenStepWork_internal + exact + (ForwardScanFrame.forwardScanTokenCursorWork_internal n layout + (state.bitOffset + 3) (state.bitOffset + token.codeLength) + state.stackHeight state.tokenCount state.lastOneCount + state.lastOneBitOffset + (outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout outerExtras + state.bitOffset (forwardScanTokenTagBits token).tag₀ + (forwardScanTokenTagBits token).tag₁ + (forwardScanTokenTagBits token).tag₂) + (ForwardScanFrame.outputProbeDecodeTokenOuterExtrasAfter_internal layout + state.bitOffset state.stackHeight state.tokenCount state.lastOneCount + state.lastOneBitOffset outerExtras + (forwardScanTokenTagBits token).tag₀ + (forwardScanTokenTagBits token).tag₁ + (forwardScanTokenTagBits token).tag₂ hframe)) + +private theorem outputProbeDecodeNatLoopOuterExtras_scanRole + (n : ℕ) {controllerTapes : ℕ} + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) + (i : Fin 8) (hi : i.val ≠ 0) : + outputProbeDecodeNatLoopOuterExtras n + layout.tokenLayout.natLayout.cursorIdx + layout.tokenLayout.natLayout.valueIdx + layout.tokenLayout.natLayout.activeIdx + layout.tokenLayout.natLayout.loopIdx outerExtras state iteration + ((layout.scanLayout n).roles i) = + outerExtras ((layout.scanLayout n).roles i) := by + let token := layout.tokenLayout + change outputProbeDecodeNatLoopOuterExtras n token.natLayout.cursorIdx + token.natLayout.valueIdx token.natLayout.activeIdx + token.natLayout.loopIdx outerExtras state iteration + (outputProbeIndexedControllerIdx n (layout.scanControllerRole i)) = + outerExtras + (outputProbeIndexedControllerIdx n (layout.scanControllerRole i)) + apply outputProbeDecodeNatLoopOuterExtras_other n token.natLayout.cursorIdx + token.natLayout.valueIdx token.natLayout.activeIdx + token.natLayout.loopIdx (layout.scanControllerRole i) + · simpa only [OutputProbeDecodeTokenLayout.tagLayout_cursorIdx] using + layout.scanControllerRole_ne_tokenRole_of_pos i hi 0 + · simpa only [OutputProbeDecodeTokenLayout.natLayout_valueIdx] using + layout.scanControllerRole_ne_tokenRole_of_pos i hi 5 + · simpa only [OutputProbeDecodeTokenLayout.natLayout_activeIdx] using + layout.scanControllerRole_ne_tokenRole_of_pos i hi 6 + · simpa only [OutputProbeDecodeTokenLayout.natLayout_loopIdx] using + layout.scanControllerRole_ne_tokenRole_of_pos i hi 7 + +theorem ForwardScanFrame.outputProbeDecodeNatLoopOuterExtras_internal + (layout : ForwardScanTokenLayout controllerTapes) + (cursor height tokenCount lastOneCount lastOneCursor : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor outerExtras) : + ForwardScanFrame (layout.scanLayout n) state.cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeDecodeNatLoopOuterExtras n + layout.tokenLayout.natLayout.cursorIdx + layout.tokenLayout.natLayout.valueIdx + layout.tokenLayout.natLayout.activeIdx + layout.tokenLayout.natLayout.loopIdx outerExtras state iteration) := by + let token := layout.tokenLayout + rcases hframe with ⟨_hcursor, hheight, hcount, hlastCount, hlastCursor, + hone, hresult, hscratch⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [ForwardScanTokenLayout.scanLayout_cursorIdx_internal] + simpa [token, outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatCursorIdx] using + outputProbeDecodeNatStateOuterExtras_cursor n + token.natLayout.cursorIdx token.natLayout.valueIdx + token.natLayout.activeIdx + (token.roles.injective.ne (by decide)) + (token.roles.injective.ne (by decide)) + (Function.update outerExtras + (outputProbeIndexedControllerIdx n token.natLayout.loopIdx) + (outputProbeCounterTape iteration)) state + · simpa only [ForwardScanLayout.heightIdx, + outputProbeDecodeNatLoopOuterExtras_scanRole n layout outerExtras state + iteration 1 (by decide)] using hheight + · simpa only [ForwardScanLayout.tokenCountIdx, + outputProbeDecodeNatLoopOuterExtras_scanRole n layout outerExtras state + iteration 2 (by decide)] using hcount + · simpa only [ForwardScanLayout.lastOneCountIdx, + outputProbeDecodeNatLoopOuterExtras_scanRole n layout outerExtras state + iteration 3 (by decide)] using hlastCount + · simpa only [ForwardScanLayout.lastOneCursorIdx, + outputProbeDecodeNatLoopOuterExtras_scanRole n layout outerExtras state + iteration 4 (by decide)] using hlastCursor + · simpa only [ForwardScanLayout.oneIdx, + outputProbeDecodeNatLoopOuterExtras_scanRole n layout outerExtras state + iteration 5 (by decide)] using hone + · simpa only [ForwardScanLayout.resultIdx, + outputProbeDecodeNatLoopOuterExtras_scanRole n layout outerExtras state + iteration 6 (by decide)] using hresult + · simpa only [ForwardScanLayout.copyScratchIdx, + outputProbeDecodeNatLoopOuterExtras_scanRole n layout outerExtras state + iteration 7 (by decide)] using hscratch + +theorem forwardScanTokenStepTM_latchFrame_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (arity height tokenCount cursor lastOneCount lastOneCursor : ℕ) + (harity : arity ≤ 2) (hpositive : arity = 2 → 1 ≤ height) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work) : + (forwardScanTokenStepTM (layout.scanLayout n) arity).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (fun inp work out => + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).work + arity height tokenCount cursor ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).output) + (forwardScanTokenStepTime arity height tokenCount cursor lastOneCount + lastOneCursor) := by + let frame := outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false + have hframePost := outputProbeLatchFrameCfg_post tm controllerTapes + outerExtras input output extras false + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput frame.input frame.work frame.output hframePost + have hrun := forwardScanTokenStepTM_hoareTime (layout.scanLayout n) arity + height tokenCount cursor lastOneCount lastOneCursor harity hpositive + frame.input frame.work frame.output hframe hinput hwork hout + refine hrun.weaken_pre (fun inp work out hpost => ?_) + obtain ⟨hinp, hworkEq, houtEq⟩ := outputProbeLatchFramePost_eq_frameCfg + tm controllerTapes outerExtras input output extras false inp work out hpost + exact ⟨hinp, hworkEq, houtEq⟩ + +private theorem parked_of_hasBinaryNat {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem forwardScanVarResetWork_parked (n : ℕ) + {controllerTapes : ℕ} + (layout : ForwardScanTokenLayout controllerTapes) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → + Tape) + (hwork : ∀ i, Parked (work i)) : + ∀ i, Parked (forwardScanVarResetWork n layout work i) := by + let token := layout.tokenLayout + let valueIdx := outputProbeIndexedControllerIdx n token.natLayout.valueIdx + let activeIdx := outputProbeIndexedControllerIdx n token.natLayout.activeIdx + let loopIdx := outputProbeIndexedControllerIdx n token.natLayout.loopIdx + intro i + by_cases hloop : i = loopIdx + · subst i + simp only [forwardScanVarResetWork, loopIdx, token, + Function.update_self] + exact parked_of_hasBinaryNat (Tape.init_move_right_hasBinaryNat 0) + rw [forwardScanVarResetWork, Function.update_of_ne hloop] + by_cases hactive : i = activeIdx + · subst i + simp only [activeIdx, token, Function.update_self] + exact parked_of_hasBinaryNat (Tape.init_move_right_hasBinaryNat 1) + rw [Function.update_of_ne hactive] + by_cases hvalue : i = valueIdx + · subst i + simp only [valueIdx, token, Function.update_self] + exact parked_of_hasBinaryNat (Tape.init_move_right_hasBinaryNat 0) + simpa only [valueIdx, token, Function.update_of_ne hvalue] using hwork i + +theorem forwardScanVarResetTM_hoareTime_internal (n controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (value fuel : ℕ) + (inp₀ : Tape) + (work₀ : Fin (0 + outputProbeControllerTapes n + controllerTapes) → + Tape) + (out₀ : Tape) + (hvalue : + (work₀ (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.valueIdx)).HasBinaryNat value) + (hactive : + (work₀ (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.activeIdx)).HasBinaryNat 0) + (hloop : + (work₀ (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.loopIdx)).HasBinaryNat fuel) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (forwardScanVarResetTM n controllerTapes layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = forwardScanVarResetWork n layout work₀ ∧ + out = out₀) + (forwardScanVarResetTime value fuel) := by + let token := layout.tokenLayout + let valueIdx := outputProbeIndexedControllerIdx n token.natLayout.valueIdx + let activeIdx := outputProbeIndexedControllerIdx n token.natLayout.activeIdx + let loopIdx := outputProbeIndexedControllerIdx n token.natLayout.loopIdx + have hvalueActive : valueIdx ≠ activeIdx := by + apply (outputProbeIndexedControllerIdx_injective n).ne + rw [OutputProbeDecodeTokenLayout.natLayout_valueIdx, + OutputProbeDecodeTokenLayout.natLayout_activeIdx] + exact token.roles.injective.ne (by decide) + have hvalueLoop : valueIdx ≠ loopIdx := by + apply (outputProbeIndexedControllerIdx_injective n).ne + rw [OutputProbeDecodeTokenLayout.natLayout_valueIdx, + OutputProbeDecodeTokenLayout.natLayout_loopIdx] + exact token.roles.injective.ne (by decide) + have hactiveLoop : activeIdx ≠ loopIdx := by + apply (outputProbeIndexedControllerIdx_injective n).ne + rw [OutputProbeDecodeTokenLayout.natLayout_activeIdx, + OutputProbeDecodeTokenLayout.natLayout_loopIdx] + exact token.roles.injective.ne (by decide) + let work₁ := Function.update work₀ valueIdx + ((Tape.init []).move Dir3.right) + have hclearValue := clearWorkTM_hoareTime_frame valueIdx value.bits inp₀ + work₀ out₀ hvalue.eq_init_move_right hinput (fun i _ => hwork i) + houtput + have hclearValue' : (clearWorkTM valueIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = work₁ ∧ out = out₀) + (clearWorkTimeBound value.bits.length) := by + simpa [work₁] using hclearValue + have hwork₁ : ∀ i, Parked (work₁ i) := by + intro i + by_cases hi : i = valueIdx + · subst i + simp only [work₁, Function.update_self] + exact parked_of_hasBinaryNat (Tape.init_move_right_hasBinaryNat 0) + simpa only [work₁, Function.update_of_ne hi] using hwork i + have hactive₁ : (work₁ activeIdx).HasBinaryNat 0 := by + simpa only [work₁, Function.update_of_ne hvalueActive.symm] using hactive + let work₂ := Function.update work₁ activeIdx + ((Tape.init ((1 : ℕ).bits.map Γ.ofBool)).move Dir3.right) + have hsucc := binarySuccTM_hoareTime_frame activeIdx 0 inp₀ work₁ out₀ + hactive₁ hinput.read_ne_start (fun i hi => (hwork₁ i).read_ne_start) + houtput.read_ne_start + have hsucc' : (binarySuccTM activeIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₁ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = work₂ ∧ out = out₀) + (binarySuccTime 0) := by + refine hsucc.strengthen_post (fun inp work out hpost => ?_) + rcases hpost with ⟨rfl, hother, hone, rfl⟩ + refine ⟨rfl, ?_, rfl⟩ + apply funext + intro i + by_cases hi : i = activeIdx + · subst i + simp only [work₂, Function.update_self] + exact hone.eq_init_move_right + simpa only [work₂, Function.update_of_ne hi] using hother i hi + have hwork₂ : ∀ i, Parked (work₂ i) := by + intro i + by_cases hi : i = activeIdx + · subst i + simp only [work₂, Function.update_self] + exact parked_of_hasBinaryNat (Tape.init_move_right_hasBinaryNat 1) + simpa only [work₂, Function.update_of_ne hi] using hwork₁ i + have hloop₂ : (work₂ loopIdx).HasBinaryNat fuel := by + simp only [work₂, Function.update_of_ne hactiveLoop.symm] + simpa only [work₁, Function.update_of_ne hvalueLoop.symm] using hloop + let work₃ := Function.update work₂ loopIdx + ((Tape.init []).move Dir3.right) + have hclearLoop := clearWorkTM_hoareTime_frame loopIdx fuel.bits inp₀ work₂ + out₀ hloop₂.eq_init_move_right hinput (fun i _ => hwork₂ i) houtput + have hclearLoop' : (clearWorkTM loopIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₂ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = work₃ ∧ out = out₀) + (clearWorkTimeBound fuel.bits.length) := by + simpa [work₃] using hclearLoop + have htransition₁ : ∀ inp work out, + (inp = inp₀ ∧ work = work₁ ∧ out = out₀) → + (transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₁ ∧ + transitionTape out = out₀) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hwork₁ i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + have htransition₂ : ∀ inp work out, + (inp = inp₀ ∧ work = work₂ ∧ out = out₀) → + (transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₂ ∧ + transitionTape out = out₀) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hwork₂ i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + have htail := seqTM_hoareTime (binarySuccTM activeIdx) + (clearWorkTM loopIdx) hsucc' htransition₂ hclearLoop' + unfold forwardScanVarResetTM forwardScanVarResetTime + simpa [token, valueIdx, activeIdx, loopIdx, work₁, work₂, work₃, + forwardScanVarResetWork] using + seqTM_hoareTime (clearWorkTM valueIdx) + (seqTM (binarySuccTM activeIdx) (clearWorkTM loopIdx)) + hclearValue' htransition₁ htail + +theorem forwardScanVarFinishTM_latchFrame_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (value fuel height tokenCount cursor lastOneCount lastOneCursor : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hvalue : + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.valueIdx)).HasBinaryNat value) + (hactive : + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.activeIdx)).HasBinaryNat 0) + (hloop : + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.loopIdx)).HasBinaryNat fuel) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work) : + (forwardScanVarFinishTM n controllerTapes layout).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (fun inp work out => + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + (forwardScanVarResetWork n layout + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).work) + 0 height tokenCount cursor ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).output) + (forwardScanVarFinishTime value fuel height tokenCount cursor + lastOneCount lastOneCursor) := by + let frame := outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false + let resetWork := forwardScanVarResetWork n layout frame.work + have hframePost := outputProbeLatchFrameCfg_post tm controllerTapes + outerExtras input output extras false + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput frame.input frame.work frame.output hframePost + have hreset := forwardScanVarResetTM_hoareTime_internal n controllerTapes + layout value fuel frame.input frame.work frame.output hvalue hactive hloop + hinput hwork hout + have hresetWork : ∀ i, Parked (resetWork i) := + forwardScanVarResetWork_parked n layout frame.work hwork + have hscanFrame : ForwardScanFrame (layout.scanLayout n) cursor height + tokenCount lastOneCount lastOneCursor resetWork := by + exact hframe.forwardScanVarResetWork_internal layout cursor height + tokenCount lastOneCount lastOneCursor frame.work + have hscan := forwardScanTokenStepTM_hoareTime (layout.scanLayout n) 0 + height tokenCount cursor lastOneCount lastOneCursor (by decide) + (by simp) frame.input resetWork frame.output hscanFrame hinput hresetWork + hout + have htransition : ∀ inp work out, + (inp = frame.input ∧ work = resetWork ∧ out = frame.output) → + (transitionInput inp = frame.input ∧ + (fun i => transitionTape (work i)) = resetWork ∧ + transitionTape out = frame.output) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hresetWork i).transitionTape_eq_self, + hout.transitionTape_eq_self⟩ + have hrun := seqTM_hoareTime (forwardScanVarResetTM n controllerTapes layout) + (forwardScanTokenStepTM (layout.scanLayout n) 0) hreset htransition hscan + refine hrun.weaken_pre (fun inp work out hpost => ?_) + obtain ⟨hinp, hworkEq, houtEq⟩ := outputProbeLatchFramePost_eq_frameCfg + tm controllerTapes outerExtras input output extras false inp work out hpost + simpa [forwardScanVarFinishTM, forwardScanVarFinishTime, frame, resetWork] + using ⟨hinp, hworkEq, houtEq⟩ + +theorem forwardScanFixedContinuationTM_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (tag : OutputProbeTokenTag) (hfixed : tag ≠ .var) + (height tokenCount cursor lastOneCount lastOneCursor : ℕ) + (hpositive : forwardScanTokenTagArity tag = 2 → 1 ≤ height) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hframe : ForwardScanFrame (layout.scanLayout n) cursor height tokenCount + lastOneCount lastOneCursor + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work) : + (outputProbeTokenContinuation (some tag) + (forwardScanVarTokenStepTM tm controllerTapes layout) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + (forwardScanTokenStepTM (layout.scanLayout n) 1) + (forwardScanTokenStepTM (layout.scanLayout n) 2) + (forwardScanTokenStepTM (layout.scanLayout n) 2) + skipTM).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (fun inp work out => + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).work + (forwardScanTokenTagArity tag) height tokenCount cursor ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).output) + (forwardScanTokenStepTime (forwardScanTokenTagArity tag) height + tokenCount cursor lastOneCount lastOneCursor) := by + have hstep₀ := forwardScanTokenStepTM_latchFrame_hoareTime_internal tm + controllerTapes layout 0 height tokenCount cursor lastOneCount + lastOneCursor (by decide) (by simp) outerExtras input output extras + hextras houter houtput hframe + have hstep₁ := forwardScanTokenStepTM_latchFrame_hoareTime_internal tm + controllerTapes layout 1 height tokenCount cursor lastOneCount + lastOneCursor (by decide) (by simp) outerExtras input output extras + hextras houter houtput hframe + cases tag with + | var => exact (hfixed rfl).elim + | tru => simpa [outputProbeTokenContinuation, forwardScanTokenTagArity] + using hstep₀ + | fls => simpa [outputProbeTokenContinuation, forwardScanTokenTagArity] + using hstep₀ + | neg => simpa [outputProbeTokenContinuation, forwardScanTokenTagArity] + using hstep₁ + | conj => + have hstep₂ := forwardScanTokenStepTM_latchFrame_hoareTime_internal tm + controllerTapes layout 2 height tokenCount cursor lastOneCount + lastOneCursor (by decide) (fun _ => hpositive rfl) outerExtras input output + extras hextras houter houtput hframe + simpa [outputProbeTokenContinuation, forwardScanTokenTagArity] using + hstep₂ + | disj => + have hstep₂ := forwardScanTokenStepTM_latchFrame_hoareTime_internal tm + controllerTapes layout 2 height tokenCount cursor lastOneCount + lastOneCursor (by decide) (fun _ => hpositive rfl) outerExtras input output + extras hextras houter houtput hframe + simpa [outputProbeTokenContinuation, forwardScanTokenTagArity] using + hstep₂ + +theorem ComputesInSpace.forwardScanDecodedFixedTokenTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras (outputProbeDecodeTagCursorIdx n + layout.tokenLayout.tagLayout)).HasBinaryNat cursor) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.tagLayout.scratchIdx)).HasBinaryNat 0) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₀Idx)).HasBinaryNat 0) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₁Idx)).HasBinaryNat 0) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₂Idx)).HasBinaryNat 0) + (tag : OutputProbeTokenTag) + (htag : outputProbeTokenTag? ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) = some tag) + (hfixed : tag ≠ .var) + (height tokenCount lastOneCount lastOneCursor : ℕ) + (hpositive : forwardScanTokenTagArity tag = 2 → 1 ≤ height) + (hscanFrame : ForwardScanFrame (layout.scanLayout n) cursor height + tokenCount lastOneCount lastOneCursor outerExtras) : + let after := outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout + outerExtras cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + let afterFrame := outputProbeLatchFrameCfg tm controllerTapes after input + output extras false + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (forwardScanDecodedTokenTM tm controllerTapes layout).HoareTime pre + (fun inp work out => + inp = afterFrame.input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + afterFrame.work (forwardScanTokenTagArity tag) height tokenCount + (cursor + 3) ∧ + out = afterFrame.output) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) + (forwardScanTokenStepTime (forwardScanTokenTagArity tag) height + tokenCount (cursor + 3) lastOneCount lastOneCursor)) := by + dsimp only + let after := outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout + outerExtras cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + let afterFrame := outputProbeLatchFrameCfg tm controllerTapes after input + output extras false + have hafterScanFrame : ForwardScanFrame (layout.scanLayout n) (cursor + 3) + height tokenCount lastOneCount lastOneCursor after := by + exact hscanFrame.outputProbeDecodeTokenOuterExtrasAfter_internal layout + cursor height tokenCount lastOneCount lastOneCursor outerExtras + ((f input)[cursor]) ((f input)[cursor + 1]) ((f input)[cursor + 2]) + have hscanFrame' : ForwardScanFrame (layout.scanLayout n) (cursor + 3) + height tokenCount lastOneCount lastOneCursor afterFrame.work := by + exact hafterScanFrame.outputProbeLatchFrameCfg_internal tm controllerTapes + layout (cursor + 3) height tokenCount lastOneCount lastOneCursor after + input output extras + have hafter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (after i) := by + exact outputProbeDecodeTokenOuterExtrasAfter_parked n layout.tokenLayout + outerExtras houter cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) htag₀ htag₁ htag₂ + have hselected := forwardScanFixedContinuationTM_hoareTime_internal tm + controllerTapes layout tag hfixed height tokenCount (cursor + 3) + lastOneCount lastOneCursor hpositive after input output extras hextras + hafter houtput hscanFrame' + obtain ⟨bound₀, bound₁, bound₂, pre, hpre, hrun⟩ := + hcomp.outputProbeDecodeTokenTM_selected_hoareTime input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes + layout.tokenLayout outerExtras houter hcursor hscratch htag₀ htag₁ htag₂ + (forwardScanVarTokenStepTM tm controllerTapes layout) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + (forwardScanTokenStepTM (layout.scanLayout n) 0) + (forwardScanTokenStepTM (layout.scanLayout n) 1) + (forwardScanTokenStepTM (layout.scanLayout n) 2) + (forwardScanTokenStepTM (layout.scanLayout n) 2) skipTM + (post := fun inp work out => + inp = afterFrame.input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + afterFrame.work (forwardScanTokenTagArity tag) height tokenCount + (cursor + 3) ∧ + out = afterFrame.output) + (selectedTime := forwardScanTokenStepTime + (forwardScanTokenTagArity tag) height tokenCount (cursor + 3) + lastOneCount lastOneCursor) + (by simpa only [htag] using hselected) + exact ⟨bound₀, bound₁, bound₂, pre, hpre, + by simpa [forwardScanDecodedTokenTM, after, afterFrame] using hrun⟩ + +theorem ComputesInSpace.forwardScanVarTokenStepTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.scratchIdx)).HasBinaryNat 0) + (htag₀Zero : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₀Idx)).HasBinaryNat 0) + (htag₁Zero : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₁Idx)).HasBinaryNat 0) + (htag₂Zero : + (outerExtras (outputProbeDecodeTagBitIdx n + layout.tokenLayout.tagLayout.tag₂Idx)).HasBinaryNat 0) + (hvalue : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.valueIdx)).HasBinaryNat 0) + (hactive : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.activeIdx)).HasBinaryNat 1) + (hloop : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.loopIdx)).HasBinaryNat 0) + (fuelValue : ℕ) + (hfuel : + (outerExtras (outputProbeIndexedControllerIdx n + layout.tokenLayout.natLayout.fuelIdx)).HasBinaryNat fuelValue) + (hqueryValid : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor < + (f input).length) + (hqueryLimit : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor + 1) ≤ + cleanupLimit) + (height tokenCount lastOneCount lastOneCursor : ℕ) + (hscanFrame : ForwardScanFrame (layout.scanLayout n) cursor height + tokenCount lastOneCount lastOneCursor outerExtras) : + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + layout.tokenLayout.natLayout.cursorIdx + layout.tokenLayout.natLayout.valueIdx + layout.tokenLayout.natLayout.activeIdx + layout.tokenLayout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout + outerExtras cursor tag₀ tag₁ tag₂) + finalState fuelValue + let finalFrame := outputProbeLatchFrameCfg tm controllerTapes finalOuter + input output extras false + finalState.active = false → + ∃ bodyTime : ℕ → ℕ, + (forwardScanVarTokenStepTM tm controllerTapes layout).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout.tokenLayout + outerExtras cursor tag₀ tag₁ tag₂) + input output extras false) + (fun inp work out => + inp = finalFrame.input ∧ + work = forwardScanTokenStepWork (layout.scanLayout n) + (forwardScanVarResetWork n layout finalFrame.work) + 0 height tokenCount finalState.cursor ∧ + out = finalFrame.output) + (binaryForLoopTime bodyTime fuelValue 0 fuelValue + 1 + + forwardScanVarFinishTime finalState.value fuelValue height + tokenCount finalState.cursor lastOneCount lastOneCursor) := by + dsimp only + let token := layout.tokenLayout + let after := outputProbeDecodeTokenOuterExtrasAfter n token outerExtras + cursor tag₀ tag₁ tag₂ + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + token.natLayout.cursorIdx token.natLayout.valueIdx + token.natLayout.activeIdx token.natLayout.loopIdx after finalState + fuelValue + let finalFrame := outputProbeLatchFrameCfg tm controllerTapes finalOuter + input output extras false + intro hinactive + have hafterScanFrame : ForwardScanFrame (layout.scanLayout n) (cursor + 3) + height tokenCount lastOneCount lastOneCursor after := by + exact hscanFrame.outputProbeDecodeTokenOuterExtrasAfter_internal layout + cursor height tokenCount lastOneCount lastOneCursor outerExtras tag₀ + tag₁ tag₂ + have hfinalOuterScanFrame : ForwardScanFrame (layout.scanLayout n) + finalState.cursor height tokenCount lastOneCount lastOneCursor + finalOuter := by + exact hafterScanFrame.outputProbeDecodeNatLoopOuterExtras_internal layout + (cursor + 3) height tokenCount lastOneCount lastOneCursor after + finalState fuelValue + have hfinalScanFrame : ForwardScanFrame (layout.scanLayout n) + finalState.cursor height tokenCount lastOneCount lastOneCursor + finalFrame.work := by + exact hfinalOuterScanFrame.outputProbeLatchFrameCfg_internal tm + controllerTapes layout finalState.cursor height tokenCount lastOneCount + lastOneCursor finalOuter input output extras + obtain ⟨bodyTime, hdecode⟩ := + hcomp.outputProbeDecodeTokenVar_hoareTime input output houtput extras + hextras hcleanupCounter cleanupLimit hcleanupLimit controllerTapes token + outerExtras houter cursor tag₀ tag₁ tag₂ hscratch htag₀Zero + htag₁Zero htag₂Zero hvalue hactive hloop fuelValue hfuel + hqueryValid hqueryLimit + have hafter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (after i) := by + exact outputProbeDecodeTokenOuterExtrasAfter_parked n token outerExtras + houter cursor tag₀ tag₁ tag₂ htag₀Zero htag₁Zero htag₂Zero + have hfinal : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (finalOuter i) := by + exact outputProbeDecodeNatLoopOuterExtras_parked n + token.natLayout.cursorIdx token.natLayout.valueIdx + token.natLayout.activeIdx token.natLayout.loopIdx after hafter + finalState fuelValue + have hvalueOuter : + (finalOuter (outputProbeIndexedControllerIdx n + token.natLayout.valueIdx)).HasBinaryNat finalState.value := by + simpa [finalOuter, outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatValueIdx] using + outputProbeDecodeNatStateOuterExtras_value n + token.natLayout.cursorIdx token.natLayout.valueIdx + token.natLayout.activeIdx + (token.roles.injective.ne (by decide)) + (Function.update after + (outputProbeIndexedControllerIdx n token.natLayout.loopIdx) + (outputProbeCounterTape fuelValue)) finalState + have hactiveOuter : + (finalOuter (outputProbeIndexedControllerIdx n + token.natLayout.activeIdx)).HasBinaryNat 0 := by + have hraw := outputProbeDecodeNatStateOuterExtras_active n + token.natLayout.cursorIdx token.natLayout.valueIdx + token.natLayout.activeIdx + (Function.update after + (outputProbeIndexedControllerIdx n token.natLayout.loopIdx) + (outputProbeCounterTape fuelValue)) finalState + rw [hinactive] at hraw + simpa [finalOuter, outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatActiveIdx] using hraw + have hloopOuter : + (finalOuter (outputProbeIndexedControllerIdx n + token.natLayout.loopIdx)).HasBinaryNat fuelValue := by + exact outputProbeDecodeNatLoopOuterExtras_loop n + token.natLayout.cursorIdx token.natLayout.valueIdx + token.natLayout.activeIdx token.natLayout.loopIdx + (token.roles.injective.ne (by decide)) + (token.roles.injective.ne (by decide)) + (token.roles.injective.ne (by decide)) after finalState fuelValue + have hfinalPost := outputProbeLatchFrameCfg_post tm controllerTapes + finalOuter input output extras false + have hvalueWork : + (finalFrame.work (outputProbeIndexedControllerIdx n + token.natLayout.valueIdx)).HasBinaryNat finalState.value := by + rw [outputProbeLatchFramePost_controller tm controllerTapes finalOuter + input output extras false finalFrame.input finalFrame.work + finalFrame.output hfinalPost token.natLayout.valueIdx] + exact hvalueOuter + have hactiveWork : + (finalFrame.work (outputProbeIndexedControllerIdx n + token.natLayout.activeIdx)).HasBinaryNat 0 := by + rw [outputProbeLatchFramePost_controller tm controllerTapes finalOuter + input output extras false finalFrame.input finalFrame.work + finalFrame.output hfinalPost token.natLayout.activeIdx] + exact hactiveOuter + have hloopWork : + (finalFrame.work (outputProbeIndexedControllerIdx n + token.natLayout.loopIdx)).HasBinaryNat fuelValue := by + rw [outputProbeLatchFramePost_controller tm controllerTapes finalOuter + input output extras false finalFrame.input finalFrame.work + finalFrame.output hfinalPost token.natLayout.loopIdx] + exact hloopOuter + have hfinish := forwardScanVarFinishTM_latchFrame_hoareTime_internal tm + controllerTapes layout finalState.value fuelValue height tokenCount + finalState.cursor lastOneCount lastOneCursor finalOuter input output extras + hextras hfinal houtput hvalueWork hactiveWork hloopWork hfinalScanFrame + have htransition := latchFramePost_transition tm controllerTapes finalOuter + input output extras hextras hfinal houtput + have hrun := seqTM_hoareTime + (outputProbeDecodeNatTM tm controllerTapes token.natLayout.cursorIdx + token.natLayout.scratchIdx token.natLayout.valueIdx + token.natLayout.activeIdx token.natLayout.loopIdx + token.natLayout.fuelIdx) + (forwardScanVarFinishTM n controllerTapes layout) hdecode htransition + hfinish + refine ⟨bodyTime, ?_⟩ + simpa [forwardScanVarTokenStepTM, token, after, finalState, finalOuter, + finalFrame] using hrun + +theorem forwardScanVarResetTM_isTransducer_internal (n controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + (forwardScanVarResetTM n controllerTapes layout).IsTransducer := by + unfold forwardScanVarResetTM + exact (clearWorkTM_isTransducer _).seqTM + ((binarySuccTM_isTransducer _).seqTM (clearWorkTM_isTransducer _)) + +theorem forwardScanVarFinishTM_isTransducer_internal (n controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + (forwardScanVarFinishTM n controllerTapes layout).IsTransducer := by + unfold forwardScanVarFinishTM + exact (forwardScanVarResetTM_isTransducer_internal n controllerTapes + layout).seqTM (forwardScanTokenStepTM_isTransducer _ 0) + +theorem forwardScanVarTokenStepTM_isTransducer_internal (tm : TM n) + (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + (forwardScanVarTokenStepTM tm controllerTapes layout).IsTransducer := by + unfold forwardScanVarTokenStepTM + exact (outputProbeDecodeNatTM_isTransducer tm controllerTapes _ _ _ _ _ _).seqTM + (forwardScanVarFinishTM_isTransducer_internal n controllerTapes layout) + +theorem forwardScanDecodedTokenTM_isTransducer_internal (tm : TM n) + (controllerTapes : ℕ) + (layout : ForwardScanTokenLayout controllerTapes) : + (forwardScanDecodedTokenTM tm controllerTapes layout).IsTransducer := by + unfold forwardScanDecodedTokenTM + exact (forwardScanVarTokenStepTM_isTransducer_internal tm controllerTapes + layout).outputProbeDecodeTokenTM + (forwardScanTokenStepTM_isTransducer _ 0) + (forwardScanTokenStepTM_isTransducer _ 0) + (forwardScanTokenStepTM_isTransducer _ 1) + (forwardScanTokenStepTM_isTransducer _ 2) + (forwardScanTokenStepTM_isTransducer _ 2) + (by + intro phase iHead wHeads oHead + cases phase <;> simp only [skipTM, idleDir] <;> split <;> decide) + layout.tokenLayout + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr.lean new file mode 100644 index 00000000..28f9925e --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.Instr.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.Instr.Internal + +/-! +# Machine emission of width-five branching-program instructions + +This module exposes the serializer leaf used by the machine-level Barrington +generator. A canonical binary variable register is emitted in terminated unary, +followed by the two fixed seven-bit permutation ranks. The input and complete +work frame are restored literally. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +variable {n : ℕ} + +/-- Emit one complete instruction code from a preserved binary variable +register and two finite-control permutations. -/ +theorem emitInstrTM_hoareTime + (counterIdx varIdx : Fin n) (hne : counterIdx ≠ varIdx) + (varValue : ℕ) (perm0 perm1 : Equiv.Perm (Fin 5)) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp : Parked inp₀) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hvar : (work₀ varIdx).HasBinaryNat varValue) + (hother : ∀ i, i ≠ counterIdx → i ≠ varIdx → Parked (work₀ i)) : + (emitInstrTM counterIdx varIdx perm0 perm1).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ work₀ + (ys ++ Instr.encode + { var := varValue, perm0 := perm0, perm1 := perm1 })) + (emitInstrTime varValue) := + emitInstrTM_hoareTime_internal counterIdx varIdx hne varValue perm0 perm1 + inp₀ work₀ ys hinp hcounter hvar hother + +/-- Time-and-space form of `emitInstrTM_hoareTime`. -/ +theorem emitInstrTM_hoareTimeSpace + (counterIdx varIdx : Fin n) (hne : counterIdx ≠ varIdx) + (varValue inputLength initialSpace : ℕ) + (perm0 perm1 : Equiv.Perm (Fin 5)) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp : Parked inp₀) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hvar : (work₀ varIdx).HasBinaryNat varValue) + (hother : ∀ i, i ≠ counterIdx → i ≠ varIdx → Parked (work₀ i)) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (emitInstrTM counterIdx varIdx perm0 perm1).HoareTimeSpace + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ work₀ + (ys ++ Instr.encode + { var := varValue, perm0 := perm0, perm1 := perm1 })) + (emitInstrTime varValue) inputLength + (emitInstrSpace initialSpace varValue) := + emitInstrTM_hoareTimeSpace_internal counterIdx varIdx hne varValue + inputLength initialSpace perm0 perm1 inp₀ work₀ ys hinp hcounter hvar + hother hworkSpace hinputSpace + +/-- Instruction emission never moves its output head left. -/ +theorem emitInstrTM_isTransducer + (counterIdx varIdx : Fin n) (perm0 perm1 : Equiv.Perm (Fin 5)) : + (emitInstrTM counterIdx varIdx perm0 perm1).IsTransducer := + emitInstrTM_isTransducer_internal counterIdx varIdx perm0 perm1 + +/-- The constant-leaf specialization emits exactly `BPInstr.const target`. -/ +theorem emitConstInstrTM_hoareTime + (counterIdx zeroIdx : Fin n) (hne : counterIdx ≠ zeroIdx) + (target : Equiv.Perm (Fin 5)) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp : Parked inp₀) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hzero : (work₀ zeroIdx).HasBinaryNat 0) + (hother : ∀ i, i ≠ counterIdx → i ≠ zeroIdx → Parked (work₀ i)) : + (emitConstInstrTM counterIdx zeroIdx target).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ work₀ (ys ++ Instr.encode (BPInstr.const target))) + (emitInstrTime 0) := by + simpa [emitConstInstrTM, BPInstr.const] using + emitInstrTM_hoareTime counterIdx zeroIdx hne 0 target target inp₀ work₀ + ys hinp hcounter hzero hother + +/-- The variable-leaf specialization emits exactly the Barrington variable +instruction with identity on zero and `target` on one. -/ +theorem emitVarInstrTM_hoareTime + (counterIdx varIdx : Fin n) (hne : counterIdx ≠ varIdx) + (varValue : ℕ) (target : Equiv.Perm (Fin 5)) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp : Parked inp₀) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hvar : (work₀ varIdx).HasBinaryNat varValue) + (hother : ∀ i, i ≠ counterIdx → i ≠ varIdx → Parked (work₀ i)) : + (emitVarInstrTM counterIdx varIdx target).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ work₀ + (ys ++ Instr.encode ⟨varValue, 1, target⟩)) + (emitInstrTime varValue) := by + simpa [emitVarInstrTM] using + emitInstrTM_hoareTime counterIdx varIdx hne varValue 1 target inp₀ work₀ + ys hinp hcounter hvar hother + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr/Defs.lean new file mode 100644 index 00000000..bb459789 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr/Defs.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Defs +import Complexitylib.Circuits.Encoding.Machine.NatCode.Defs + +/-! +# Machine emission of width-five branching-program instructions -- definitions + +A serialized instruction consists of a terminated-unary variable field followed +by two fixed seven-bit permutation ranks. The variable is read from a preserved +canonical binary work tape, while the two permutations are baked into finite +control. One reusable zero scratch tape drives the natural-code emitter. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Emit one width-five instruction from a canonical binary variable tape and +two finite-control permutations. -/ +def emitInstrTM {n : ℕ} (counterIdx varIdx : Fin n) + (perm0 perm1 : Equiv.Perm (Fin 5)) : TM n := + TM.seqTM + (CircuitCode.Machine.emitNatCodeTM counterIdx varIdx) + (TM.emitBitsTM (Perm5.encode perm0 ++ Perm5.encode perm1)) + +/-- Concrete time bound for one serialized instruction. -/ +def emitInstrTime (varValue : ℕ) : ℕ := + CircuitCode.Machine.emitNatCodeTime varValue + 15 + +/-- All-prefix auxiliary-space bound for one serialized instruction. -/ +def emitInstrSpace (initialSpace varValue : ℕ) : ℕ := + initialSpace + 2 * varValue.size + 14 + +/-- Emit the constant instruction selected by a `true` formula leaf. -/ +def emitConstInstrTM {n : ℕ} (counterIdx zeroIdx : Fin n) + (target : Equiv.Perm (Fin 5)) : TM n := + emitInstrTM counterIdx zeroIdx target target + +/-- Emit the variable instruction selected by a variable formula leaf. -/ +def emitVarInstrTM {n : ℕ} (counterIdx varIdx : Fin n) + (target : Equiv.Perm (Fin 5)) : TM n := + emitInstrTM counterIdx varIdx 1 target + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr/Internal.lean new file mode 100644 index 00000000..b78d9204 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/Instr/Internal.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.Instr.Defs +import Complexitylib.Circuits.Encoding.Machine.NatCode +import Complexitylib.Models.TuringMachine.Hoare.Space + +/-! +# Machine emission of width-five branching-program instructions -- proof internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM +open CircuitCode.Machine + +variable {n : ℕ} + +private theorem instrInitialWork_parked + (counterIdx varIdx : Fin n) (work₀ : Fin n → Tape) (varValue : ℕ) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hvar : (work₀ varIdx).HasBinaryNat varValue) + (hother : ∀ i, i ≠ counterIdx → i ≠ varIdx → Parked (work₀ i)) : + ∀ i, Parked (work₀ i) := by + intro i + by_cases hic : i = counterIdx + · subst i + refine ⟨by rw [hcounter.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hcounter.2.2 + by_cases hiv : i = varIdx + · subst i + refine ⟨by rw [hvar.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hvar.2.2 + · exact hother i hic hiv + +theorem emitInstrTM_hoareTime_internal + (counterIdx varIdx : Fin n) (hne : counterIdx ≠ varIdx) + (varValue : ℕ) (perm0 perm1 : Equiv.Perm (Fin 5)) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp : Parked inp₀) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hvar : (work₀ varIdx).HasBinaryNat varValue) + (hother : ∀ i, i ≠ counterIdx → i ≠ varIdx → Parked (work₀ i)) : + (emitInstrTM counterIdx varIdx perm0 perm1).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ work₀ + (ys ++ Instr.encode + { var := varValue, perm0 := perm0, perm1 := perm1 })) + (emitInstrTime varValue) := by + have hwork := instrInitialWork_parked counterIdx varIdx work₀ varValue + hcounter hvar hother + have hrun := seqTM_hoareTime + (emitNatCodeTM counterIdx varIdx) + (emitBitsTM (Perm5.encode perm0 ++ Perm5.encode perm1)) + (emitNatCodeTM_hoareTime counterIdx varIdx hne varValue inp₀ work₀ ys + hinp hcounter hvar (fun i _ _ => hwork i)) + (emitPred_transition hinp hwork (ys ++ CircuitCode.NatCode.encode varValue)) + (emitBitsTM_hoareTime (Perm5.encode perm0 ++ Perm5.encode perm1) + inp₀ work₀ (ys ++ CircuitCode.NatCode.encode varValue) hinp hwork) + refine hrun.consequence (fun _ _ _ h => h) (fun inp work out h => ?_) ?_ + · simpa [Instr.encode, List.append_assoc] using h + · simp [emitInstrTime, Perm5.bitWidth] + +theorem emitInstrTM_hoareTimeSpace_internal + (counterIdx varIdx : Fin n) (hne : counterIdx ≠ varIdx) + (varValue inputLength initialSpace : ℕ) + (perm0 perm1 : Equiv.Perm (Fin 5)) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp : Parked inp₀) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hvar : (work₀ varIdx).HasBinaryNat varValue) + (hother : ∀ i, i ≠ counterIdx → i ≠ varIdx → Parked (work₀ i)) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (emitInstrTM counterIdx varIdx perm0 perm1).HoareTimeSpace + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ work₀ + (ys ++ Instr.encode + { var := varValue, perm0 := perm0, perm1 := perm1 })) + (emitInstrTime varValue) inputLength + (emitInstrSpace initialSpace varValue) := by + have hwork := instrInitialWork_parked counterIdx varIdx work₀ varValue + hcounter hvar hother + have htailTime := + emitBitsTM_hoareTime (Perm5.encode perm0 ++ Perm5.encode perm1) + inp₀ work₀ (ys ++ CircuitCode.NatCode.encode varValue) hinp hwork + have htail := htailTime.toHoareTimeSpace (fun inp work out h => by + rcases h with ⟨rfl, rfl, -⟩ + exact ⟨hworkSpace, hinputSpace⟩) + have hrun := seqTM_hoareTimeSpace + (emitNatCodeTM counterIdx varIdx) + (emitBitsTM (Perm5.encode perm0 ++ Perm5.encode perm1)) + (emitNatCodeTM_hoareTimeSpace counterIdx varIdx hne varValue inputLength + initialSpace inp₀ work₀ ys hinp hcounter hvar + (fun i _ _ => hwork i) hworkSpace hinputSpace) + (emitPred_transition hinp hwork (ys ++ CircuitCode.NatCode.encode varValue)) + htail + refine hrun.consequence (fun _ _ _ h => h) (fun inp work out h => ?_) + ?_ le_rfl ?_ + · simpa [Instr.encode, List.append_assoc] using h + · simp [emitInstrTime, Perm5.bitWidth] + · simp only [emitInstrSpace, emitNatCodeSpace, Perm5.length_encode, + Perm5.bitWidth, List.length_append] + apply max_le <;> omega + +theorem emitInstrTM_isTransducer_internal + (counterIdx varIdx : Fin n) (perm0 perm1 : Equiv.Perm (Fin 5)) : + (emitInstrTM counterIdx varIdx perm0 perm1).IsTransducer := by + exact (emitNatCodeTM_isTransducer counterIdx varIdx).seqTM + (emitBitsTM_isTransducer (Perm5.encode perm0 ++ Perm5.encode perm1)) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbe.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbe.lean new file mode 100644 index 00000000..a8201db6 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbe.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.OutputProbe.Internal + +/-! +# Branching-program emission from restored output-probe frames + +This adapter lets the Barrington controller emit a canonical instruction +directly from two registers in its restored restartable-query frame. The +output accumulator advances, while the physical input and complete work frame +remain literal fixed points. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- Emit one instruction from controller-local variable and scratch registers +inside a restored zero-latch output-probe frame. -/ +theorem emitInstrTM_latchFrame_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (counterIdx varIdx : Fin controllerTapes) (hne : counterIdx ≠ varIdx) + (varValue : ℕ) (perm0 perm1 : Equiv.Perm (Fin 5)) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (ys : List Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : OutAcc ys output) + (hcounter : + (outerExtras (outputProbeIndexedControllerIdx n counterIdx)) + |>.HasBinaryNat 0) + (hvar : + (outerExtras (outputProbeIndexedControllerIdx n varIdx)) + |>.HasBinaryNat varValue) : + (emitInstrTM (outputProbeIndexedControllerIdx n counterIdx) + (outputProbeIndexedControllerIdx n varIdx) perm0 perm1).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (ys ++ Instr.encode + { var := varValue, perm0 := perm0, perm1 := perm1 })) + (emitInstrTime varValue) := + emitInstrTM_latchFrame_hoareTime_internal tm controllerTapes counterIdx + varIdx hne varValue perm0 perm1 outerExtras input output extras ys + hextras houter houtput hcounter hvar + +/-- The constant-instruction specialization consumes a canonical zero value +register and emits exactly `BPInstr.const target`. -/ +theorem emitConstInstrTM_latchFrame_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (counterIdx zeroIdx : Fin controllerTapes) (hne : counterIdx ≠ zeroIdx) + (target : Equiv.Perm (Fin 5)) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (ys : List Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : OutAcc ys output) + (hcounter : + (outerExtras (outputProbeIndexedControllerIdx n counterIdx)) + |>.HasBinaryNat 0) + (hzero : + (outerExtras (outputProbeIndexedControllerIdx n zeroIdx)) + |>.HasBinaryNat 0) : + (emitConstInstrTM (outputProbeIndexedControllerIdx n counterIdx) + (outputProbeIndexedControllerIdx n zeroIdx) target).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (ys ++ Instr.encode (BPInstr.const target))) + (emitInstrTime 0) := by + simpa [emitConstInstrTM, BPInstr.const] using + emitInstrTM_latchFrame_hoareTime tm controllerTapes counterIdx zeroIdx hne + 0 target target outerExtras input output extras ys hextras houter houtput + hcounter hzero + +/-- The false-leaf continuation emits nothing and converts the restored latch +predicate to its literal accumulator frame. -/ +theorem skipTM_latchFrame_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (ys : List Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : OutAcc ys output) : + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work ys) + 1 := + skipTM_latchFrame_hoareTime_internal tm controllerTapes outerExtras input + output extras ys hextras houter houtput + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbe/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbe/Internal.lean new file mode 100644 index 00000000..0d093843 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbe/Internal.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.Instr +import Complexitylib.Models.TuringMachine.OutputProbeDispatch +import Complexitylib.Models.TuringMachine.OutputProbeIndexed + +/-! +# Branching-program emission from restored output-probe frames -- internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +theorem emitInstrTM_latchFrame_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (counterIdx varIdx : Fin controllerTapes) (hne : counterIdx ≠ varIdx) + (varValue : ℕ) (perm0 perm1 : Equiv.Perm (Fin 5)) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (ys : List Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : OutAcc ys output) + (hcounter : + (outerExtras (outputProbeIndexedControllerIdx n counterIdx)) + |>.HasBinaryNat 0) + (hvar : + (outerExtras (outputProbeIndexedControllerIdx n varIdx)) + |>.HasBinaryNat varValue) : + (emitInstrTM (outputProbeIndexedControllerIdx n counterIdx) + (outputProbeIndexedControllerIdx n varIdx) perm0 perm1).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (ys ++ Instr.encode + { var := varValue, perm0 := perm0, perm1 := perm1 })) + (emitInstrTime varValue) := by + intro inp work out hpost + obtain ⟨hinputParked, hworkParked, houtputParked⟩ := + outputProbeLatchFramePost_parked tm controllerTapes outerExtras input + output extras false hextras houter houtput.parked inp work out hpost + have hcounterWork : + (work (outputProbeIndexedControllerIdx n counterIdx)).HasBinaryNat 0 := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false inp work out hpost counterIdx] + exact hcounter + have hvarWork : + (work (outputProbeIndexedControllerIdx n varIdx)).HasBinaryNat + varValue := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false inp work out hpost varIdx] + exact hvar + have hphysical : outputProbeIndexedControllerIdx n counterIdx ≠ + outputProbeIndexedControllerIdx n varIdx := + (outputProbeIndexedControllerIdx_injective n).ne hne + have hframe := outputProbeLatchFramePost_eq_frameCfg tm controllerTapes + outerExtras input output extras false inp work out hpost + have houtAcc : OutAcc ys out := by + rw [hframe.2.2] + simpa using houtput + have hrun := emitInstrTM_hoareTime + (outputProbeIndexedControllerIdx n counterIdx) + (outputProbeIndexedControllerIdx n varIdx) hphysical varValue perm0 perm1 + inp work ys hinputParked hcounterWork hvarWork + (fun i _ _ => hworkParked i) + obtain ⟨done, elapsed, helapsed, hreach, hhalt, hdone⟩ := + hrun inp work out ⟨rfl, rfl, houtAcc⟩ + refine ⟨done, elapsed, helapsed, hreach, hhalt, ?_⟩ + rcases hdone with ⟨hinputDone, hworkDone, houtputDone⟩ + exact ⟨hinputDone.trans hframe.1, + hworkDone.trans hframe.2.1, houtputDone⟩ + +theorem skipTM_latchFrame_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (ys : List Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : OutAcc ys output) : + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work ys) + 1 := by + intro inp work out hpost + obtain ⟨hinputParked, hworkParked, houtputParked⟩ := + outputProbeLatchFramePost_parked tm controllerTapes outerExtras input + output extras false hextras houter houtput.parked inp work out hpost + have hframe := outputProbeLatchFramePost_eq_frameCfg tm controllerTapes + outerExtras input output extras false inp work out hpost + have houtAcc : OutAcc ys out := by + rw [hframe.2.2] + simpa using houtput + have hrun := skipTM_hoareTime_frame inp work out hinputParked hworkParked + houtputParked + obtain ⟨done, elapsed, helapsed, hreach, hhalt, hdone⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨done, elapsed, helapsed, hreach, hhalt, ?_⟩ + rcases hdone with ⟨hinputDone, hworkDone, houtputDone⟩ + exact ⟨hinputDone.trans hframe.1, + hworkDone.trans hframe.2.1, by rw [houtputDone]; exact houtAcc⟩ + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken.lean new file mode 100644 index 00000000..4548b128 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken.lean @@ -0,0 +1,518 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.OutputProbeToken.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.OutputProbeToken.Internal + +/-! +# Barrington leaf emission after output-probe token decoding + +This module exposes the concrete variable-token continuation: it decodes the +terminated-unary payload, preserves the restartable query frame, and appends +the exact canonical Barrington variable instruction. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- Decode a variable payload from the normalized post-tag frame and append +the resulting canonical Barrington instruction. -/ +theorem outputProbeDecodeVarInstrTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (ys : List Bool) + (houtput : OutAcc ys output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx)) + |>.HasBinaryNat 0) + (hactive : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.activeIdx)) + |>.HasBinaryNat 1) + (hloop : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.loopIdx)) + |>.HasBinaryNat 0) + (fuelValue : ℕ) + (hfuel : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor < + (f input).length) + (hqueryLimit : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor + 1) ≤ + cleanupLimit) + (target : Equiv.Perm (Fin 5)) : + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂) + finalState fuelValue + ∃ bodyTime : ℕ → ℕ, + (outputProbeDecodeVarInstrTM tm controllerTapes layout target).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂) + input output extras false) + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input output + extras false).work + (ys ++ Instr.encode ⟨finalState.value, 1, target⟩)) + (outputProbeDecodeVarInstrTime bodyTime fuelValue finalState.value) := + outputProbeDecodeVarInstrTM_hoareTime_internal hcomp input output ys + houtput extras hextras hcleanupCounter cleanupLimit hcleanupLimit + controllerTapes layout outerExtras houter cursor tag₀ tag₁ tag₂ hscratch + htag₀Zero htag₁Zero htag₂Zero hvalue hactive hloop fuelValue hfuel + hqueryValid hqueryLimit target + +/-- Probe a complete source token and enter only its selected concrete leaf or +caller-supplied recursive continuation. -/ +theorem outputProbeDecodeLeafInstrTM_selected_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : + (outputProbeTokenContinuation + (outputProbeTokenTag? ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + (outputProbeDecodeVarInstrTM tm controllerTapes layout target) + (emitConstInstrTM + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) + target) + skipTM onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + post selectedTime) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeLeafInstrTM tm controllerTapes layout target onNeg + onConj onDisj onInvalid).HoareTime pre post + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) selectedTime) := + outputProbeDecodeLeafInstrTM_selected_hoareTime_internal hcomp input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes layout outerExtras + houter hcursor hscratch htag₀ htag₁ htag₂ target onNeg onConj onDisj + onInvalid hselected + +/-- Decode a complete `true` leaf from the source and append exactly its +canonical Barrington constant instruction. -/ +theorem outputProbeDecodeLeafInstrTM_true_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (hsource₀ : (f input)[cursor] = false) + (hsource₁ : (f input)[cursor + 1] = false) + (hsource₂ : (f input)[cursor + 2] = true) + (output : Tape) (ys : List Bool) (houtput : OutAcc ys output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx)) + |>.HasBinaryNat 0) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + let after := outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeLeafInstrTM tm controllerTapes layout target onNeg + onConj onDisj onInvalid).HoareTime pre + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes after input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes after input output + extras false).work + (ys ++ Instr.encode (BPInstr.const target))) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) + (emitInstrTime 0)) := + outputProbeDecodeLeafInstrTM_true_hoareTime_internal hcomp input cursor + hcursorBound hsource₀ hsource₁ hsource₂ output ys houtput extras hextras + hcleanupCounter cleanupLimit hcleanupLimit hlimit₀ hlimit₁ hlimit₂ + controllerTapes layout outerExtras houter hcursor hscratch htag₀ htag₁ + htag₂ hvalue target onNeg onConj onDisj onInvalid + +/-- Decode a complete variable leaf and append exactly the instruction named +by its terminated-unary payload. Payload validity is required only here. -/ +theorem outputProbeDecodeLeafInstrTM_var_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (hsource₀ : (f input)[cursor] = false) + (hsource₁ : (f input)[cursor + 1] = false) + (hsource₂ : (f input)[cursor + 2] = false) + (output : Tape) (ys : List Bool) (houtput : OutAcc ys output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx)) + |>.HasBinaryNat 0) + (hactive : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.activeIdx)) + |>.HasBinaryNat 1) + (hloop : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.loopIdx)) + |>.HasBinaryNat 0) + (fuelValue : ℕ) + (hfuel : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor < + (f input).length) + (hqueryLimit : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor + 1) ≤ + cleanupLimit) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + finalState fuelValue + ∃ (bodyTime : ℕ → ℕ) (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeLeafInstrTM tm controllerTapes layout target onNeg + onConj onDisj onInvalid).HoareTime pre + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input + output extras false).input + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input + output extras false).work + (ys ++ Instr.encode ⟨finalState.value, 1, target⟩)) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) + (outputProbeDecodeVarInstrTime bodyTime fuelValue + finalState.value)) := + outputProbeDecodeLeafInstrTM_var_hoareTime_internal hcomp input cursor + hcursorBound hsource₀ hsource₁ hsource₂ output ys houtput extras hextras + hcleanupCounter cleanupLimit hcleanupLimit hlimit₀ hlimit₁ hlimit₂ + controllerTapes layout outerExtras houter hcursor hscratch htag₀ htag₁ + htag₂ hvalue hactive hloop fuelValue hfuel hqueryValid hqueryLimit target + onNeg onConj onDisj onInvalid + +/-- Decode a complete `false` leaf while leaving the serialized instruction +accumulator unchanged. -/ +theorem outputProbeDecodeLeafInstrTM_false_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (hsource₀ : (f input)[cursor] = false) + (hsource₁ : (f input)[cursor + 1] = true) + (hsource₂ : (f input)[cursor + 2] = false) + (output : Tape) (ys : List Bool) (houtput : OutAcc ys output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + let after := outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeLeafInstrTM tm controllerTapes layout target onNeg + onConj onDisj onInvalid).HoareTime pre + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes after input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes after input output + extras false).work ys) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) 1) := + outputProbeDecodeLeafInstrTM_false_hoareTime_internal hcomp input cursor + hcursorBound hsource₀ hsource₁ hsource₂ output ys houtput extras hextras + hcleanupCounter cleanupLimit hcleanupLimit hlimit₀ hlimit₁ hlimit₂ + controllerTapes layout outerExtras houter hcursor hscratch htag₀ htag₁ + htag₂ target onNeg onConj onDisj onInvalid + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken/Defs.lean new file mode 100644 index 00000000..27064768 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken/Defs.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.OutputProbe +import Complexitylib.Models.TuringMachine.OutputProbeDecodeToken.Defs + +/-! +# Barrington leaf emission after output-probe token decoding -- definitions + +The variable branch runs the bounded terminated-unary decoder and then emits +the resulting canonical branching-program instruction. The complete leaf +dispatcher also wires true directly to constant-instruction emission and false +to a no-op, leaving only the recursive connective continuations abstract. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Decode a variable payload and emit its Barrington instruction. -/ +def outputProbeDecodeVarInstrTM (tm : TM n) (controllerTapes : ℕ) + (layout : TM.OutputProbeDecodeTokenLayout controllerTapes) + (target : Equiv.Perm (Fin 5)) : + TM (0 + TM.outputProbeControllerTapes n + controllerTapes) := + TM.seqTM + (TM.outputProbeDecodeNatTM tm controllerTapes + layout.natLayout.cursorIdx layout.natLayout.scratchIdx + layout.natLayout.valueIdx layout.natLayout.activeIdx + layout.natLayout.loopIdx layout.natLayout.fuelIdx) + (emitVarInstrTM + (TM.outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (TM.outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) + target) + +/-- Concrete runtime of variable-payload decoding followed by instruction +emission. -/ +def outputProbeDecodeVarInstrTime (bodyTime : ℕ → ℕ) + (fuelValue varValue : ℕ) : ℕ := + TM.binaryForLoopTime bodyTime fuelValue 0 fuelValue + 1 + + emitInstrTime varValue + +/-- Decode one formula token, emit the three leaf cases, and dispatch recursive +connectives to caller-supplied continuations. -/ +def outputProbeDecodeLeafInstrTM (tm : TM n) (controllerTapes : ℕ) + (layout : TM.OutputProbeDecodeTokenLayout controllerTapes) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + TM.outputProbeControllerTapes n + controllerTapes)) : + TM (0 + TM.outputProbeControllerTapes n + controllerTapes) := + TM.outputProbeDecodeTokenTM tm controllerTapes layout + (outputProbeDecodeVarInstrTM tm controllerTapes layout target) + (emitConstInstrTM + (TM.outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (TM.outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) + target) + TM.skipTM onNeg onConj onDisj onInvalid + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken/Internal.lean new file mode 100644 index 00000000..28709317 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/OutputProbeToken/Internal.lean @@ -0,0 +1,737 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.OutputProbeToken.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDecodeToken + +/-! +# Barrington leaf emission after output-probe token decoding -- internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +private theorem latchFramePost_transition + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) : + ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false (transitionInput inp) + (fun i => transitionTape (work i)) (transitionTape out) := by + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + rw [hinput.transitionInput_eq_self] + have hworkTransition : (fun i => transitionTape (work i)) = work := by + funext i + exact (hwork i).transitionTape_eq_self + rw [hworkTransition, hout.transitionTape_eq_self] + exact hpost + +theorem outputProbeDecodeVarInstrTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (ys : List Bool) + (houtput : OutAcc ys output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx)) + |>.HasBinaryNat 0) + (hactive : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.activeIdx)) + |>.HasBinaryNat 1) + (hloop : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.loopIdx)) + |>.HasBinaryNat 0) + (fuelValue : ℕ) + (hfuel : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor < + (f input).length) + (hqueryLimit : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor + 1) ≤ + cleanupLimit) + (target : Equiv.Perm (Fin 5)) : + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂) + finalState fuelValue + ∃ bodyTime : ℕ → ℕ, + (outputProbeDecodeVarInstrTM tm controllerTapes layout target).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂) + input output extras false) + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input output + extras false).work + (ys ++ Instr.encode ⟨finalState.value, 1, target⟩)) + (outputProbeDecodeVarInstrTime bodyTime fuelValue finalState.value) := by + dsimp only + let after := outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor tag₀ tag₁ tag₂ + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx after finalState + fuelValue + obtain ⟨bodyTime, hdecode⟩ := + hcomp.outputProbeDecodeTokenVar_hoareTime input output houtput.parked extras + hextras hcleanupCounter cleanupLimit hcleanupLimit controllerTapes layout + outerExtras houter cursor tag₀ tag₁ tag₂ hscratch htag₀Zero + htag₁Zero htag₂Zero hvalue hactive hloop fuelValue hfuel + hqueryValid hqueryLimit + have hafter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (after i) := by + exact outputProbeDecodeTokenOuterExtrasAfter_parked n layout outerExtras + houter cursor tag₀ tag₁ tag₂ htag₀Zero htag₁Zero htag₂Zero + have hfinal : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (finalOuter i) := by + exact outputProbeDecodeNatLoopOuterExtras_parked n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx after hafter + finalState fuelValue + have hscratchAfter : + (after (outputProbeIndexedControllerIdx n + layout.natLayout.scratchIdx)).HasBinaryNat 0 := by + change (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂ (outputProbeIndexedControllerIdx n + layout.natLayout.scratchIdx)).HasBinaryNat 0 + rw [outputProbeDecodeTokenOuterExtrasAfter_other n layout outerExtras + cursor tag₀ tag₁ tag₂ layout.natLayout.scratchIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide))] + exact hscratch + have hscratchFinal : + (finalOuter (outputProbeIndexedControllerIdx n + layout.natLayout.scratchIdx)).HasBinaryNat 0 := by + change (outputProbeDecodeNatLoopOuterExtras n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx after finalState + fuelValue (outputProbeIndexedControllerIdx n + layout.natLayout.scratchIdx)).HasBinaryNat 0 + rw [outputProbeDecodeNatLoopOuterExtras_other n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + layout.natLayout.scratchIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) after finalState fuelValue] + exact hscratchAfter + have hvalueFinal : + (finalOuter (outputProbeIndexedControllerIdx n + layout.natLayout.valueIdx)).HasBinaryNat finalState.value := by + simpa [finalOuter, outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatValueIdx] using + outputProbeDecodeNatStateOuterExtras_value n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx + (layout.roles.injective.ne (by decide)) + (Function.update after + (outputProbeIndexedControllerIdx n layout.natLayout.loopIdx) + (outputProbeCounterTape fuelValue)) finalState + have hemit := emitInstrTM_latchFrame_hoareTime tm controllerTapes + layout.natLayout.scratchIdx layout.natLayout.valueIdx + (layout.roles.injective.ne (by decide)) finalState.value 1 target + finalOuter input output extras ys hextras hfinal houtput hscratchFinal + hvalueFinal + have htransition := latchFramePost_transition tm controllerTapes finalOuter + input output extras hextras hfinal houtput.parked + have hrun := seqTM_hoareTime + (outputProbeDecodeNatTM tm controllerTapes layout.natLayout.cursorIdx + layout.natLayout.scratchIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + layout.natLayout.fuelIdx) + (emitInstrTM + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) 1 target) + hdecode htransition hemit + refine ⟨bodyTime, ?_⟩ + simpa [outputProbeDecodeVarInstrTM, emitVarInstrTM, + outputProbeDecodeVarInstrTime, after, finalState, finalOuter] using hrun + +theorem outputProbeDecodeLeafInstrTM_selected_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : + (outputProbeTokenContinuation + (outputProbeTokenTag? ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + (outputProbeDecodeVarInstrTM tm controllerTapes layout target) + (emitConstInstrTM + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) + target) + skipTM onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + post selectedTime) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeLeafInstrTM tm controllerTapes layout target onNeg + onConj onDisj onInvalid).HoareTime pre post + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) selectedTime) := by + simpa [outputProbeDecodeLeafInstrTM] using + hcomp.outputProbeDecodeTokenTM_selected_hoareTime input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes layout outerExtras + houter hcursor hscratch htag₀ htag₁ htag₂ + (outputProbeDecodeVarInstrTM tm controllerTapes layout target) + (emitConstInstrTM + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) target) + skipTM onNeg onConj onDisj onInvalid hselected + +theorem outputProbeDecodeLeafInstrTM_true_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (hsource₀ : (f input)[cursor] = false) + (hsource₁ : (f input)[cursor + 1] = false) + (hsource₂ : (f input)[cursor + 2] = true) + (output : Tape) (ys : List Bool) (houtput : OutAcc ys output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx)) + |>.HasBinaryNat 0) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + let after := outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeLeafInstrTM tm controllerTapes layout target onNeg + onConj onDisj onInvalid).HoareTime pre + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes after input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes after input output + extras false).work + (ys ++ Instr.encode (BPInstr.const target))) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) + (emitInstrTime 0)) := by + dsimp only + let after := outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + have hafter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (after i) := by + exact outputProbeDecodeTokenOuterExtrasAfter_parked n layout outerExtras + houter cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) htag₀ htag₁ htag₂ + have hscratchAfter : + (after (outputProbeIndexedControllerIdx n + layout.natLayout.scratchIdx)).HasBinaryNat 0 := by + change (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) ((f input)[cursor + 2]) + (outputProbeIndexedControllerIdx n + layout.natLayout.scratchIdx)).HasBinaryNat 0 + rw [outputProbeDecodeTokenOuterExtrasAfter_other n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) layout.natLayout.scratchIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide))] + exact hscratch + have hvalueAfter : + (after (outputProbeIndexedControllerIdx n + layout.natLayout.valueIdx)).HasBinaryNat 0 := by + change (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) ((f input)[cursor + 2]) + (outputProbeIndexedControllerIdx n + layout.natLayout.valueIdx)).HasBinaryNat 0 + rw [outputProbeDecodeTokenOuterExtrasAfter_other n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) layout.natLayout.valueIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide))] + exact hvalue + have hemit := emitConstInstrTM_latchFrame_hoareTime tm controllerTapes + layout.natLayout.scratchIdx layout.natLayout.valueIdx + (layout.roles.injective.ne (by decide)) target after input output extras ys + hextras hafter houtput hscratchAfter hvalueAfter + have hrun := hcomp.outputProbeDecodeTokenTM_selected_hoareTime input cursor + hcursorBound output houtput.parked extras hextras hcleanupCounter + cleanupLimit hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes + layout outerExtras houter hcursor hscratch htag₀ htag₁ htag₂ + (outputProbeDecodeVarInstrTM tm controllerTapes layout target) + (emitConstInstrTM + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) target) + skipTM onNeg onConj onDisj onInvalid + (post := EmitPred + (outputProbeLatchFrameCfg tm controllerTapes after input output extras + false).input + (outputProbeLatchFrameCfg tm controllerTapes after input output extras + false).work + (ys ++ Instr.encode (BPInstr.const target))) + (selectedTime := emitInstrTime 0) + (by + simpa [after, hsource₀, hsource₁, hsource₂, + outputProbeTokenContinuation, outputProbeTokenTag?] using hemit) + simpa [outputProbeDecodeLeafInstrTM, after] using hrun + +theorem outputProbeDecodeLeafInstrTM_var_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (hsource₀ : (f input)[cursor] = false) + (hsource₁ : (f input)[cursor + 1] = false) + (hsource₂ : (f input)[cursor + 2] = false) + (output : Tape) (ys : List Bool) (houtput : OutAcc ys output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx)) + |>.HasBinaryNat 0) + (hactive : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.activeIdx)) + |>.HasBinaryNat 1) + (hloop : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.loopIdx)) + |>.HasBinaryNat 0) + (fuelValue : ℕ) + (hfuel : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor < + (f input).length) + (hqueryLimit : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor + 1) ≤ + cleanupLimit) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + finalState fuelValue + ∃ (bodyTime : ℕ → ℕ) (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeLeafInstrTM tm controllerTapes layout target onNeg + onConj onDisj onInvalid).HoareTime pre + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input + output extras false).input + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input + output extras false).work + (ys ++ Instr.encode ⟨finalState.value, 1, target⟩)) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) + (outputProbeDecodeVarInstrTime bodyTime fuelValue + finalState.value)) := by + dsimp only + let finalState := outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue + let finalOuter := outputProbeDecodeNatLoopOuterExtras n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) ((f input)[cursor + 2])) + finalState fuelValue + obtain ⟨bodyTime, hvar⟩ := outputProbeDecodeVarInstrTM_hoareTime_internal + hcomp input output ys houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit controllerTapes layout outerExtras houter cursor + ((f input)[cursor]) ((f input)[cursor + 1]) ((f input)[cursor + 2]) + hscratch htag₀ htag₁ htag₂ hvalue hactive hloop fuelValue hfuel + hqueryValid hqueryLimit target + obtain ⟨bound₀, bound₁, bound₂, pre, hpre, hrun⟩ := + hcomp.outputProbeDecodeTokenTM_selected_hoareTime input cursor + hcursorBound output houtput.parked extras hextras hcleanupCounter + cleanupLimit hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes + layout outerExtras houter hcursor hscratch htag₀ htag₁ htag₂ + (outputProbeDecodeVarInstrTM tm controllerTapes layout target) + (emitConstInstrTM + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) target) + skipTM onNeg onConj onDisj onInvalid + (post := EmitPred + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes finalOuter input output + extras false).work + (ys ++ Instr.encode ⟨finalState.value, 1, target⟩)) + (selectedTime := outputProbeDecodeVarInstrTime bodyTime fuelValue + finalState.value) + (by + simpa [finalState, finalOuter, hsource₀, hsource₁, hsource₂, + outputProbeTokenContinuation, outputProbeTokenTag?] using hvar) + exact ⟨bodyTime, bound₀, bound₁, bound₂, pre, hpre, + by simpa [outputProbeDecodeLeafInstrTM] using hrun⟩ + +theorem outputProbeDecodeLeafInstrTM_false_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (hsource₀ : (f input)[cursor] = false) + (hsource₁ : (f input)[cursor + 1] = true) + (hsource₂ : (f input)[cursor + 2] = false) + (output : Tape) (ys : List Bool) (houtput : OutAcc ys output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (target : Equiv.Perm (Fin 5)) + (onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + let after := outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeLeafInstrTM tm controllerTapes layout target onNeg + onConj onDisj onInvalid).HoareTime pre + (EmitPred + (outputProbeLatchFrameCfg tm controllerTapes after input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes after input output + extras false).work ys) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) 1) := by + dsimp only + let after := outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) + have hafter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (after i) := by + exact outputProbeDecodeTokenOuterExtrasAfter_parked n layout outerExtras + houter cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]) htag₀ htag₁ htag₂ + have hskip := skipTM_latchFrame_hoareTime tm controllerTapes after input + output extras ys hextras hafter houtput + have hrun := hcomp.outputProbeDecodeTokenTM_selected_hoareTime input cursor + hcursorBound output houtput.parked extras hextras hcleanupCounter + cleanupLimit hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes + layout outerExtras houter hcursor hscratch htag₀ htag₁ htag₂ + (outputProbeDecodeVarInstrTM tm controllerTapes layout target) + (emitConstInstrTM + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx) + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx) target) + skipTM onNeg onConj onDisj onInvalid + (post := EmitPred + (outputProbeLatchFrameCfg tm controllerTapes after input output extras + false).input + (outputProbeLatchFrameCfg tm controllerTapes after input output extras + false).work ys) + (selectedTime := 1) + (by + simpa [after, hsource₀, hsource₁, hsource₂, + outputProbeTokenContinuation, outputProbeTokenTag?] using hskip) + simpa [outputProbeDecodeLeafInstrTM, after] using hrun + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch.lean new file mode 100644 index 00000000..672c04a2 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotBranch.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotBranch.Internal + +/-! +# Barrington slot-bit branch machine + +This module exposes the concrete four-way continuation dispatcher used after +capturing the two binary address bits of one stack-free slot-cursor step. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- The raw-bit continuation selected by the concrete dispatcher agrees with +the semantic right-child and inverse-block decisions of the slot cursor. -/ +theorem barringtonSlotContinuation_cursor + (cursor : BarringtonSlotCursor) (fuel : ℕ) + (onLeft onRight onInverseLeft onInverseRight : TM n) : + barringtonSlotContinuation cursor.reversed (cursor.rawLowBit fuel) + (cursor.rawHighBit fuel) onLeft onRight onInverseLeft onInverseRight = + if cursor.selectsInverse fuel then + if cursor.selectsRight fuel then onInverseRight else onInverseLeft + else if cursor.selectsRight fuel then onRight else onLeft := + barringtonSlotContinuation_cursor_internal cursor fuel onLeft onRight + onInverseLeft onInverseRight + +/-- Two captured raw address bits and one finite reflection flag select exactly +one Barrington child continuation in two tape-preserving dispatch steps. -/ +theorem barringtonSlotBranchTM_selected_hoareTime + (lowIdx highIdx : Fin n) + (reversed low high : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + {pre post : TapePred n} {time : ℕ} + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hlow : ∀ inp work out, pre inp work out → + (work lowIdx).HasBinaryNat (if low then 1 else 0)) + (hhigh : ∀ inp work out, pre inp work out → + (work highIdx).HasBinaryNat (if high then 1 else 0)) + (hselected : + (barringtonSlotContinuation reversed low high onLeft onRight + onInverseLeft onInverseRight).HoareTime pre post time) : + (barringtonSlotBranchTM lowIdx highIdx reversed onLeft onRight + onInverseLeft onInverseRight).HoareTime pre post (time + 2) := + barringtonSlotBranchTM_selected_hoareTime_internal lowIdx highIdx reversed + low high onLeft onRight onInverseLeft onInverseRight hinput hwork houtput + hlow hhigh hselected + +/-- The selected two-bit dispatch adds exactly two transitions and no auxiliary +space beyond the chosen continuation's all-prefix budget. -/ +theorem barringtonSlotBranchTM_selected_hoareTimeSpace + (lowIdx highIdx : Fin n) + (reversed low high : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + {pre post : TapePred n} {time inputLength space : ℕ} + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hlow : ∀ inp work out, pre inp work out → + (work lowIdx).HasBinaryNat (if low then 1 else 0)) + (hhigh : ∀ inp work out, pre inp work out → + (work highIdx).HasBinaryNat (if high then 1 else 0)) + (hselected : + (barringtonSlotContinuation reversed low high onLeft onRight + onInverseLeft onInverseRight).HoareTimeSpace pre post time + inputLength space) : + (barringtonSlotBranchTM lowIdx highIdx reversed onLeft onRight + onInverseLeft onInverseRight).HoareTimeSpace pre post (time + 2) + inputLength space := + barringtonSlotBranchTM_selected_hoareTimeSpace_internal lowIdx highIdx + reversed low high onLeft onRight onInverseLeft onInverseRight hinput + hwork houtput hlow hhigh hselected + +/-- The two-bit Barrington dispatcher preserves one-way output behavior when +all four child continuations do. -/ +theorem barringtonSlotBranchTM_isTransducer + (lowIdx highIdx : Fin n) (reversed : Bool) + {onLeft onRight onInverseLeft onInverseRight : TM n} + (hleft : onLeft.IsTransducer) (hright : onRight.IsTransducer) + (hinverseLeft : onInverseLeft.IsTransducer) + (hinverseRight : onInverseRight.IsTransducer) : + (barringtonSlotBranchTM lowIdx highIdx reversed onLeft onRight + onInverseLeft onInverseRight).IsTransducer := + barringtonSlotBranchTM_isTransducer_internal lowIdx highIdx reversed hleft + hright hinverseLeft hinverseRight + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch/Defs.lean new file mode 100644 index 00000000..b801bad4 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch/Defs.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonSlotQuery.Defs +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs + +/-! +# Barrington slot-bit branch machine -- definitions + +The stack-free slot cursor reduces one recursive address step to two raw +binary bits and one finite-control reflection flag. This module turns two +captured bit tapes into the corresponding four-way continuation branch. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Select the continuation named by two raw slot bits and the pending +reflection flag. -/ +def barringtonSlotContinuation {n : ℕ} (reversed low high : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) : TM n := + if high != reversed then + if low != reversed then onInverseRight else onInverseLeft + else if low != reversed then onRight else onLeft + +/-- Branch to the selected Barrington child using two canonical one-bit work +tapes. The high bit is read first, then the low bit; both dispatch steps +preserve every tape. -/ +def barringtonSlotBranchTM {n : ℕ} (lowIdx highIdx : Fin n) + (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) : TM n := + TM.branchWorkSymbolTM highIdx Γ.one + (TM.branchWorkSymbolTM lowIdx Γ.one + (barringtonSlotContinuation reversed true true + onLeft onRight onInverseLeft onInverseRight) + (barringtonSlotContinuation reversed false true + onLeft onRight onInverseLeft onInverseRight)) + (TM.branchWorkSymbolTM lowIdx Γ.one + (barringtonSlotContinuation reversed true false + onLeft onRight onInverseLeft onInverseRight) + (barringtonSlotContinuation reversed false false + onLeft onRight onInverseLeft onInverseRight)) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch/Internal.lean new file mode 100644 index 00000000..ab9d2df7 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotBranch/Internal.lean @@ -0,0 +1,224 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotBranch.Defs +import Complexitylib.Circuits.BarringtonSlotQuery +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Barrington slot-bit branch machine -- internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +private theorem hasBinaryNat_bool_read_eq_one + {tape : Tape} {bit : Bool} + (hbit : tape.HasBinaryNat (if bit then 1 else 0)) : + tape.read = Γ.one ↔ bit = true := by + cases bit <;> rw [hbit.eq_init_move_right] <;> + simp [Tape.read, Tape.init, Tape.move, Γ.ofBool] + +private theorem branchWorkBitTM_selected_hoareTime + (idx : Fin n) (bit : Bool) (onTrue onFalse : TM n) + {pre post : TapePred n} {time : ℕ} + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbit : ∀ inp work out, pre inp work out → + (work idx).HasBinaryNat (if bit then 1 else 0)) + (hselected : (if bit then onTrue else onFalse).HoareTime + pre post time) : + (branchWorkSymbolTM idx Γ.one onTrue onFalse).HoareTime + pre post (time + 1) := by + cases hvalue : bit + · apply branchWorkSymbolTM_hoareTime_different + · intro inp work out hpre hone + have hfalse := + (hasBinaryNat_bool_read_eq_one (hbit inp work out hpre)).mp hone + simp [hvalue] at hfalse + · exact hinput + · exact hwork + · exact houtput + · simpa [hvalue] using hselected + · apply branchWorkSymbolTM_hoareTime_equal + · intro inp work out hpre + exact (hasBinaryNat_bool_read_eq_one + (hbit inp work out hpre)).mpr hvalue + · exact hinput + · exact hwork + · exact houtput + · simpa [hvalue] using hselected + +private theorem branchWorkBitTM_selected_hoareTimeSpace + (idx : Fin n) (bit : Bool) (onTrue onFalse : TM n) + {pre post : TapePred n} {time inputLength space : ℕ} + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbit : ∀ inp work out, pre inp work out → + (work idx).HasBinaryNat (if bit then 1 else 0)) + (hselected : (if bit then onTrue else onFalse).HoareTimeSpace + pre post time inputLength space) : + (branchWorkSymbolTM idx Γ.one onTrue onFalse).HoareTimeSpace + pre post (time + 1) inputLength space := by + cases hvalue : bit + · apply branchWorkSymbolTM_hoareTimeSpace_different + · intro inp work out hpre hone + have hfalse := + (hasBinaryNat_bool_read_eq_one (hbit inp work out hpre)).mp hone + simp [hvalue] at hfalse + · exact hinput + · exact hwork + · exact houtput + · simpa [hvalue] using hselected + · apply branchWorkSymbolTM_hoareTimeSpace_equal + · intro inp work out hpre + exact (hasBinaryNat_bool_read_eq_one + (hbit inp work out hpre)).mpr hvalue + · exact hinput + · exact hwork + · exact houtput + · simpa [hvalue] using hselected + +theorem barringtonSlotContinuation_cursor_internal + (cursor : BarringtonSlotCursor) (fuel : ℕ) + (onLeft onRight onInverseLeft onInverseRight : TM n) : + barringtonSlotContinuation cursor.reversed (cursor.rawLowBit fuel) + (cursor.rawHighBit fuel) onLeft onRight onInverseLeft onInverseRight = + if cursor.selectsInverse fuel then + if cursor.selectsRight fuel then onInverseRight else onInverseLeft + else if cursor.selectsRight fuel then onRight else onLeft := by + rw [cursor.selectsRight_eq_rawLowBit fuel, + cursor.selectsInverse_eq_rawHighBit fuel] + rfl + +theorem barringtonSlotBranchTM_selected_hoareTime_internal + (lowIdx highIdx : Fin n) + (reversed low high : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + {pre post : TapePred n} {time : ℕ} + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hlow : ∀ inp work out, pre inp work out → + (work lowIdx).HasBinaryNat (if low then 1 else 0)) + (hhigh : ∀ inp work out, pre inp work out → + (work highIdx).HasBinaryNat (if high then 1 else 0)) + (hselected : + (barringtonSlotContinuation reversed low high onLeft onRight + onInverseLeft onInverseRight).HoareTime pre post time) : + (barringtonSlotBranchTM lowIdx highIdx reversed onLeft onRight + onInverseLeft onInverseRight).HoareTime pre post (time + 2) := by + let inner (rawHigh : Bool) := + branchWorkSymbolTM lowIdx Γ.one + (barringtonSlotContinuation reversed true rawHigh + onLeft onRight onInverseLeft onInverseRight) + (barringtonSlotContinuation reversed false rawHigh + onLeft onRight onInverseLeft onInverseRight) + have hinner : (inner high).HoareTime pre post (time + 1) := by + apply branchWorkBitTM_selected_hoareTime lowIdx low + · exact hinput + · exact hwork + · exact houtput + · exact hlow + · cases low <;> simpa [inner] using hselected + have houter := branchWorkBitTM_selected_hoareTime highIdx high + (inner true) (inner false) hinput hwork houtput hhigh (by + cases high <;> simpa using hinner) + simpa [barringtonSlotBranchTM, inner, Nat.add_assoc] using houter + +theorem barringtonSlotBranchTM_selected_hoareTimeSpace_internal + (lowIdx highIdx : Fin n) + (reversed low high : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + {pre post : TapePred n} {time inputLength space : ℕ} + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hlow : ∀ inp work out, pre inp work out → + (work lowIdx).HasBinaryNat (if low then 1 else 0)) + (hhigh : ∀ inp work out, pre inp work out → + (work highIdx).HasBinaryNat (if high then 1 else 0)) + (hselected : + (barringtonSlotContinuation reversed low high onLeft onRight + onInverseLeft onInverseRight).HoareTimeSpace pre post time + inputLength space) : + (barringtonSlotBranchTM lowIdx highIdx reversed onLeft onRight + onInverseLeft onInverseRight).HoareTimeSpace pre post (time + 2) + inputLength space := by + let inner (rawHigh : Bool) := + branchWorkSymbolTM lowIdx Γ.one + (barringtonSlotContinuation reversed true rawHigh + onLeft onRight onInverseLeft onInverseRight) + (barringtonSlotContinuation reversed false rawHigh + onLeft onRight onInverseLeft onInverseRight) + have hinner : (inner high).HoareTimeSpace pre post (time + 1) + inputLength space := by + apply branchWorkBitTM_selected_hoareTimeSpace lowIdx low + · exact hinput + · exact hwork + · exact houtput + · exact hlow + · cases low <;> simpa [inner] using hselected + have houter := branchWorkBitTM_selected_hoareTimeSpace highIdx high + (inner true) (inner false) hinput hwork houtput hhigh (by + cases high <;> simpa using hinner) + simpa [barringtonSlotBranchTM, inner, Nat.add_assoc] using houter + +private theorem barringtonSlotContinuation_isTransducer_internal + (reversed low high : Bool) + {onLeft onRight onInverseLeft onInverseRight : TM n} + (hleft : onLeft.IsTransducer) (hright : onRight.IsTransducer) + (hinverseLeft : onInverseLeft.IsTransducer) + (hinverseRight : onInverseRight.IsTransducer) : + (barringtonSlotContinuation reversed low high onLeft onRight + onInverseLeft onInverseRight).IsTransducer := by + cases reversed <;> cases low <;> cases high <;> + simp [barringtonSlotContinuation] <;> assumption + +theorem barringtonSlotBranchTM_isTransducer_internal + (lowIdx highIdx : Fin n) (reversed : Bool) + {onLeft onRight onInverseLeft onInverseRight : TM n} + (hleft : onLeft.IsTransducer) (hright : onRight.IsTransducer) + (hinverseLeft : onInverseLeft.IsTransducer) + (hinverseRight : onInverseRight.IsTransducer) : + (barringtonSlotBranchTM lowIdx highIdx reversed onLeft onRight + onInverseLeft onInverseRight).IsTransducer := by + apply IsTransducer.branchWorkSymbolTM + · apply IsTransducer.branchWorkSymbolTM + · exact barringtonSlotContinuation_isTransducer_internal + reversed true true hleft hright hinverseLeft hinverseRight + · exact barringtonSlotContinuation_isTransducer_internal + reversed false true hleft hright hinverseLeft hinverseRight + · apply IsTransducer.branchWorkSymbolTM + · exact barringtonSlotContinuation_isTransducer_internal + reversed true false hleft hright hinverseLeft hinverseRight + · exact barringtonSlotContinuation_isTransducer_internal + reversed false false hleft hright hinverseLeft hinverseRight + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture.lean new file mode 100644 index 00000000..cb66fbf9 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotCapture.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotCapture.Internal + +/-! +# Barrington slot-bit capture + +This module exposes the framed one-step primitive that captures a positioned +binary address bit into a canonical controller tape. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- A positioned tape with the cells of a canonical binary tape exposes the +corresponding `Nat.testBit`, including implicit false high bits. -/ +theorem slotBitAtHead_eq_testBit_of_cells + (tape original : Tape) (value offset : ℕ) + (hvalue : original.HasBinaryNat value) + (hcells : tape.cells = original.cells) + (hhead : tape.head = offset + 1) : + slotBitAtHead tape = value.testBit offset := + slotBitAtHead_eq_testBit_of_cells_internal tape original value offset hvalue + hcells hhead + +/-- A canonical binary tape positioned on bit `offset` exposes exactly +`Nat.testBit value offset`; positions beyond the canonical bit string read as +false through the terminating blank. -/ +theorem slotBitAtHead_eq_testBit + (tape : Tape) (value offset : ℕ) + (hvalue : tape.HasBinaryNat value) + (hhead : tape.head = offset + 1) : + slotBitAtHead tape = value.testBit offset := + slotBitAtHead_eq_testBit_internal tape value offset hvalue hhead + +/-- One positioned source symbol becomes a canonical Boolean controller tape; +the source may simultaneously move one cell left. -/ +theorem captureSlotBitTM_hoareTime + (sourceIdx targetIdx : Fin n) (hne : sourceIdx ≠ targetIdx) + (moveLeft : Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hzero : (work₀ targetIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) : + (captureSlotBitTM sourceIdx targetIdx moveLeft).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = + (if moveLeft then (work₀ sourceIdx).move Dir3.left + else work₀ sourceIdx) ∧ + (work targetIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → work i = work₀ i) ∧ + out = out₀) + 1 := + captureSlotBitTM_hoareTime_internal sourceIdx targetIdx hne moveLeft inp₀ + work₀ out₀ hinput hsource hwork hzero houtput + +/-- A positioned capture adds at most one cell to the starting all-prefix +auxiliary-space budget. -/ +theorem captureSlotBitTM_hoareTimeSpace + (sourceIdx targetIdx : Fin n) (hne : sourceIdx ≠ targetIdx) + (moveLeft : Bool) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hzero : (work₀ targetIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (captureSlotBitTM sourceIdx targetIdx moveLeft).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (captureSlotBitTM sourceIdx targetIdx moveLeft).Q) + |>.WithinAuxSpace inputLength initialSpace) : + (captureSlotBitTM sourceIdx targetIdx moveLeft).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = + (if moveLeft then (work₀ sourceIdx).move Dir3.left + else work₀ sourceIdx) ∧ + (work targetIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → work i = work₀ i) ∧ + out = out₀) + 1 inputLength (initialSpace + 1) := + captureSlotBitTM_hoareTimeSpace_internal sourceIdx targetIdx hne moveLeft + inputLength initialSpace inp₀ work₀ out₀ hinput hsource hwork hzero + houtput hinitial + +/-- Capturing one adjacent base-four digit costs exactly three framed +transitions and leaves the source head on its low bit. -/ +theorem captureSlotBitsTM_hoareTime + (sourceIdx lowIdx highIdx : Fin n) + (hsl : sourceIdx ≠ lowIdx) (hsh : sourceIdx ≠ highIdx) + (hlh : lowIdx ≠ highIdx) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceHigh : (work₀ sourceIdx).read ≠ Γ.start) + (hsourceLow : ((work₀ sourceIdx).move Dir3.left).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hlowZero : (work₀ lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ highIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) : + (captureSlotBitsTM sourceIdx lowIdx highIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = (work₀ sourceIdx).move Dir3.left ∧ + (work lowIdx).HasBinaryNat + (if slotBitAtHead ((work₀ sourceIdx).move Dir3.left) then 1 else 0) ∧ + (work highIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) ∧ + (∀ i, i ≠ sourceIdx → i ≠ lowIdx → i ≠ highIdx → + work i = work₀ i) ∧ + out = out₀) + 3 := + captureSlotBitsTM_hoareTime_internal sourceIdx lowIdx highIdx hsl hsh hlh + inp₀ work₀ out₀ hinput hsourceHigh hsourceLow hwork hlowZero hhighZero + houtput + +/-- Adjacent high/low capture adds at most three cells to the starting +all-prefix auxiliary-space budget. -/ +theorem captureSlotBitsTM_hoareTimeSpace + (sourceIdx lowIdx highIdx : Fin n) + (hsl : sourceIdx ≠ lowIdx) (hsh : sourceIdx ≠ highIdx) + (hlh : lowIdx ≠ highIdx) + (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceHigh : (work₀ sourceIdx).read ≠ Γ.start) + (hsourceLow : ((work₀ sourceIdx).move Dir3.left).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hlowZero : (work₀ lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ highIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (captureSlotBitsTM sourceIdx lowIdx highIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (captureSlotBitsTM sourceIdx lowIdx highIdx).Q) + |>.WithinAuxSpace inputLength initialSpace) : + (captureSlotBitsTM sourceIdx lowIdx highIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = (work₀ sourceIdx).move Dir3.left ∧ + (work lowIdx).HasBinaryNat + (if slotBitAtHead ((work₀ sourceIdx).move Dir3.left) then 1 else 0) ∧ + (work highIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) ∧ + (∀ i, i ≠ sourceIdx → i ≠ lowIdx → i ≠ highIdx → + work i = work₀ i) ∧ + out = out₀) + 3 inputLength (initialSpace + 3) := + captureSlotBitsTM_hoareTimeSpace_internal sourceIdx lowIdx highIdx hsl hsh + hlh inputLength initialSpace inp₀ work₀ out₀ hinput hsourceHigh + hsourceLow hwork hlowZero hhighZero houtput hinitial + +/-- Slot-bit capture never moves the output head left. -/ +theorem captureSlotBitTM_isTransducer + (sourceIdx targetIdx : Fin n) (moveLeft : Bool) : + (captureSlotBitTM sourceIdx targetIdx moveLeft).IsTransducer := + captureSlotBitTM_isTransducer_internal sourceIdx targetIdx moveLeft + +/-- Adjacent high/low capture never moves the output head left. -/ +theorem captureSlotBitsTM_isTransducer + (sourceIdx lowIdx highIdx : Fin n) : + (captureSlotBitsTM sourceIdx lowIdx highIdx).IsTransducer := + captureSlotBitsTM_isTransducer_internal sourceIdx lowIdx highIdx + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture/Defs.lean new file mode 100644 index 00000000..d7a2e0fb --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture/Defs.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators + +/-! +# Barrington slot-bit capture -- definitions + +One transition copies the Boolean value under a positioned binary slot tape +head into a canonical one-bit controller tape. The source head can either stay +put or move one cell left, supporting high-then-low base-four digit scans. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Interpret only `1` as true; canonical `0` and implicit blank high bits are +both false. -/ +def slotBitAtHead (tape : Tape) : Bool := + tape.read == Γ.one + +/-- Writable symbol used for a canonical captured Boolean tape. -/ +def slotBitWrite : Bool → Γw + | false => .blank + | true => .one + +/-- Two-state controller for one positioned slot-bit capture. -/ +inductive SlotBitCapturePhase where + | capture + | done + deriving DecidableEq + +/-- The capture controller has exactly two states. -/ +instance instFintypeSlotBitCapturePhase : Fintype SlotBitCapturePhase where + elems := {.capture, .done} + complete := fun phase => by cases phase <;> simp + +/-- Exact work frame produced by one slot-bit capture. -/ +def captureSlotBitWork {n : ℕ} (sourceIdx targetIdx : Fin n) + (moveLeft : Bool) (work : Fin n → Tape) : Fin n → Tape := + fun i => + if i = sourceIdx then + (work i).writeAndMove (TM.readBackWrite (work i).read) + (if moveLeft then Dir3.left else Dir3.stay) + else if i = targetIdx then + (work i).writeAndMove (slotBitWrite (slotBitAtHead (work sourceIdx))) + Dir3.stay + else + (work i).writeAndMove (TM.readBackWrite (work i).read) + (TM.idleDir (work i).read) + +/-- Capture the bit currently under `sourceIdx` into the canonical-zero tape +`targetIdx`, optionally moving the source head one cell left. -/ +def captureSlotBitTM {n : ℕ} (sourceIdx targetIdx : Fin n) + (moveLeft : Bool) : TM n where + Q := SlotBitCapturePhase + qstart := .capture + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .capture => + if wHeads sourceIdx = Γ.start then + TM.allIdle .capture iHead wHeads oHead + else + (.done, + fun i => + if i = targetIdx then + slotBitWrite (wHeads sourceIdx == Γ.one) + else + TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, + TM.idleDir iHead, + fun i => + if moveLeft && i = sourceIdx then Dir3.left + else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + cases phase with + | capture => + dsimp only + split + · exact TM.rightOfStart_allIdle iHead wHeads oHead + · next hsource => + refine ⟨TM.idleDir_right_of_start, ?_, + TM.idleDir_right_of_start⟩ + intro i hi + cases moveLeft + · exact TM.idleDir_right_of_start hi + · by_cases his : i = sourceIdx + · subst i + exact absurd hi hsource + · simp [his, TM.idleDir_right_of_start hi] + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Exact work frame after capturing the high bit, moving the source left, and +then capturing the adjacent low bit. -/ +def captureSlotBitsWork {n : ℕ} (sourceIdx lowIdx highIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := + captureSlotBitWork sourceIdx lowIdx false + (captureSlotBitWork sourceIdx highIdx true work) + +/-- Capture one adjacent base-four address digit, high bit first and then low +bit, leaving the preserved source head on the low bit. -/ +def captureSlotBitsTM {n : ℕ} (sourceIdx lowIdx highIdx : Fin n) : TM n := + TM.seqTM (captureSlotBitTM sourceIdx highIdx true) + (captureSlotBitTM sourceIdx lowIdx false) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture/Internal.lean new file mode 100644 index 00000000..52e8b3ae --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotCapture/Internal.lean @@ -0,0 +1,430 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotCapture.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import Mathlib.Data.Nat.Bitwise + +/-! +# Barrington slot-bit capture -- internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +theorem slotBitAtHead_eq_testBit_of_cells_internal + (tape original : Tape) (value offset : ℕ) + (hvalue : original.HasBinaryNat value) + (hcells : tape.cells = original.cells) + (hhead : tape.head = offset + 1) : + slotBitAtHead tape = value.testBit offset := by + rw [slotBitAtHead, Nat.testBit_eq_inth] + by_cases hi : offset < value.bits.length + · rw [Tape.read, hhead, hcells, hvalue.2.2.1 offset hi, + List.getI_eq_getElem (l := value.bits) hi] + cases value.bits[offset] <;> rfl + · have hle : value.bits.length ≤ offset := Nat.le_of_not_gt hi + rw [Tape.read, hhead, hcells, hvalue.2.2.2 offset hle, + List.getI_eq_default (l := value.bits) hle] + rfl + +theorem slotBitAtHead_eq_testBit_internal + (tape : Tape) (value offset : ℕ) + (hvalue : tape.HasBinaryNat value) + (hhead : tape.head = offset + 1) : + slotBitAtHead tape = value.testBit offset := + slotBitAtHead_eq_testBit_of_cells_internal tape tape value offset hvalue rfl + hhead + +private theorem captureSlotBitTM_step + (sourceIdx targetIdx : Fin n) (hne : sourceIdx ≠ targetIdx) + (moveLeft : Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (captureSlotBitTM sourceIdx targetIdx moveLeft).step + { state := (captureSlotBitTM sourceIdx targetIdx moveLeft).qstart + input := inp₀ + work := work₀ + output := out₀ } = + some + { state := (captureSlotBitTM sourceIdx targetIdx moveLeft).qhalt + input := inp₀ + work := captureSlotBitWork sourceIdx targetIdx moveLeft work₀ + output := out₀ } := by + rw [TM.step, if_neg (by simp [captureSlotBitTM])] + simp only [captureSlotBitTM, hsource, ↓reduceIte] + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · dsimp only + simp [TM.idleDir, hinput, Tape.move] + · dsimp only + funext i + by_cases his : i = sourceIdx + · subst i + cases moveLeft + · simp [captureSlotBitWork, hne, TM.idleDir, hsource] + · simp only [Bool.true_and, if_pos, captureSlotBitWork, + if_neg hne] + simp + · by_cases hit : i = targetIdx + · subst i + simp [captureSlotBitWork, his, slotBitAtHead, TM.idleDir, + hwork targetIdx] + · simp only [captureSlotBitWork, if_neg his, if_neg hit] + simp [his, TM.idleDir, hwork i, Tape.move] + · dsimp only + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out₀ houtput Dir3.stay + +theorem captureSlotBitWork_source_internal + (sourceIdx targetIdx : Fin n) + (moveLeft : Bool) (work : Fin n → Tape) + (hsource : (work sourceIdx).read ≠ Γ.start) : + captureSlotBitWork sourceIdx targetIdx moveLeft work sourceIdx = + if moveLeft then (work sourceIdx).move Dir3.left + else work sourceIdx := by + rw [captureSlotBitWork, if_pos rfl] + cases moveLeft + · simp only [Bool.false_eq_true, if_false] + exact TM.writeAndMove_readBack (work sourceIdx) hsource Dir3.stay + · simp only [if_true] + exact TM.writeAndMove_readBack (work sourceIdx) hsource Dir3.left + +theorem captureSlotBitWork_other_internal + (sourceIdx targetIdx : Fin n) (moveLeft : Bool) + (work : Fin n → Tape) (i : Fin n) + (his : i ≠ sourceIdx) (hit : i ≠ targetIdx) + (hread : (work i).read ≠ Γ.start) : + captureSlotBitWork sourceIdx targetIdx moveLeft work i = work i := by + simpa [captureSlotBitWork, his, hit, TM.idleDir, hread, Tape.move] using + TM.writeAndMove_readBack (work i) hread Dir3.stay + +theorem captureSlotBitWork_target_internal + (sourceIdx targetIdx : Fin n) (hne : sourceIdx ≠ targetIdx) + (moveLeft : Bool) (work : Fin n → Tape) + (hzero : (work targetIdx).HasBinaryNat 0) : + (captureSlotBitWork sourceIdx targetIdx moveLeft work targetIdx) + |>.HasBinaryNat + (if slotBitAtHead (work sourceIdx) then 1 else 0) := by + simp only [captureSlotBitWork, if_neg hne.symm, if_pos] + rw [hzero.eq_init_move_right] + cases hbit : slotBitAtHead (work sourceIdx) <;> + simp [slotBitWrite, Tape.writeAndMove, Tape.write, Tape.move, + Tape.init, Γ.ofBool, Tape.HasBinaryNat, Tape.HasBinaryString] + · intro i + by_cases hi : i = 0 + · subst i + simp + · rw [Function.update_of_ne (by omega)] + simp [hi] + · intro i hi + rw [Function.update_of_ne (by omega)] + simp + +theorem captureSlotBitTM_hoareTime_frame_internal + (sourceIdx targetIdx : Fin n) (hne : sourceIdx ≠ targetIdx) + (moveLeft : Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (captureSlotBitTM sourceIdx targetIdx moveLeft).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = captureSlotBitWork sourceIdx targetIdx moveLeft work₀ ∧ + out = out₀) + 1 := by + intro inp work out hpre + obtain ⟨hinp, hworkEq, hout⟩ := hpre + rw [hinp, hworkEq, hout] + have hstep := captureSlotBitTM_step sourceIdx targetIdx hne moveLeft + inp₀ work₀ out₀ hinput hsource hwork houtput + exact ⟨_, 1, le_rfl, .step hstep .zero, rfl, rfl, rfl, rfl⟩ + +theorem captureSlotBitTM_hoareTime_internal + (sourceIdx targetIdx : Fin n) (hne : sourceIdx ≠ targetIdx) + (moveLeft : Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hzero : (work₀ targetIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) : + (captureSlotBitTM sourceIdx targetIdx moveLeft).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = + (if moveLeft then (work₀ sourceIdx).move Dir3.left + else work₀ sourceIdx) ∧ + (work targetIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → work i = work₀ i) ∧ + out = out₀) + 1 := by + intro inp work out hpre + obtain ⟨hinp, hworkEq, hout⟩ := hpre + rw [hinp, hworkEq, hout] + have hstep := captureSlotBitTM_step sourceIdx targetIdx hne moveLeft + inp₀ work₀ out₀ hinput hsource hwork houtput + refine ⟨_, 1, le_rfl, .step hstep .zero, rfl, ?_⟩ + refine ⟨rfl, + captureSlotBitWork_source_internal sourceIdx targetIdx moveLeft work₀ + hsource, + captureSlotBitWork_target_internal sourceIdx targetIdx hne moveLeft work₀ + hzero, + ?_, rfl⟩ + intro i his hit + exact captureSlotBitWork_other_internal sourceIdx targetIdx moveLeft work₀ i + his hit (hwork i) + +theorem captureSlotBitTM_hoareTimeSpace_internal + (sourceIdx targetIdx : Fin n) (hne : sourceIdx ≠ targetIdx) + (moveLeft : Bool) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hzero : (work₀ targetIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (captureSlotBitTM sourceIdx targetIdx moveLeft).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (captureSlotBitTM sourceIdx targetIdx moveLeft).Q) + |>.WithinAuxSpace inputLength initialSpace) : + (captureSlotBitTM sourceIdx targetIdx moveLeft).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = + (if moveLeft then (work₀ sourceIdx).move Dir3.left + else work₀ sourceIdx) ∧ + (work targetIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → work i = work₀ i) ∧ + out = out₀) + 1 inputLength (initialSpace + 1) := by + apply (captureSlotBitTM_hoareTime_internal sourceIdx targetIdx hne moveLeft + inp₀ work₀ out₀ hinput hsource hwork hzero houtput).toHoareTimeSpace + intro inp work out hpre + obtain ⟨hinp, hworkEq, hout⟩ := hpre + subst inp + subst work + subst out + exact hinitial + +theorem captureSlotBitsTM_hoareTime_frame_internal + (sourceIdx lowIdx highIdx : Fin n) + (hsl : sourceIdx ≠ lowIdx) (hsh : sourceIdx ≠ highIdx) + (hlh : lowIdx ≠ highIdx) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceHigh : (work₀ sourceIdx).read ≠ Γ.start) + (hsourceLow : ((work₀ sourceIdx).move Dir3.left).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hhighZero : (work₀ highIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) : + (captureSlotBitsTM sourceIdx lowIdx highIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = captureSlotBitsWork sourceIdx lowIdx highIdx work₀ ∧ + out = out₀) + 3 := by + let work₁ := captureSlotBitWork sourceIdx highIdx true work₀ + have hsource₁ : work₁ sourceIdx = + (work₀ sourceIdx).move Dir3.left := by + simpa [work₁] using + captureSlotBitWork_source_internal sourceIdx highIdx true work₀ + hsourceHigh + have hhigh₁ : (work₁ highIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) := by + simpa [work₁] using + captureSlotBitWork_target_internal sourceIdx highIdx hsh true work₀ + hhighZero + have hlow₁ : work₁ lowIdx = work₀ lowIdx := by + simpa [work₁] using + captureSlotBitWork_other_internal sourceIdx highIdx true work₀ lowIdx + hsl.symm hlh (hwork lowIdx) + have hsource₁read : (work₁ sourceIdx).read ≠ Γ.start := by + rw [hsource₁] + exact hsourceLow + have hwork₁ : ∀ i, (work₁ i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + exact hsource₁read + by_cases hih : i = highIdx + · subst i + exact hhigh₁.2.hasBinarySuffix.read_ne_start + · rw [show work₁ i = work₀ i by + simpa [work₁] using + captureSlotBitWork_other_internal sourceIdx highIdx true work₀ i + his hih (hwork i)] + exact hwork i + have hhigh := captureSlotBitTM_hoareTime_frame_internal sourceIdx highIdx + hsh true inp₀ work₀ out₀ hinput hsourceHigh hwork houtput + have hlow := captureSlotBitTM_hoareTime_frame_internal sourceIdx lowIdx + hsl false inp₀ work₁ out₀ hinput hsource₁read hwork₁ houtput + have htransition : ∀ inp work out, + (inp = inp₀ ∧ work = work₁ ∧ out = out₀) → + transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₁ ∧ + transitionTape out = out₀ := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact phaseTransition_eq_self_of_reads_ne_start hinput hwork₁ houtput + simpa [captureSlotBitsTM, captureSlotBitsWork, work₁] using + seqTM_hoareTime (captureSlotBitTM sourceIdx highIdx true) + (captureSlotBitTM sourceIdx lowIdx false) hhigh htransition hlow + +theorem captureSlotBitsTM_hoareTime_internal + (sourceIdx lowIdx highIdx : Fin n) + (hsl : sourceIdx ≠ lowIdx) (hsh : sourceIdx ≠ highIdx) + (hlh : lowIdx ≠ highIdx) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceHigh : (work₀ sourceIdx).read ≠ Γ.start) + (hsourceLow : ((work₀ sourceIdx).move Dir3.left).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hlowZero : (work₀ lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ highIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) : + (captureSlotBitsTM sourceIdx lowIdx highIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = (work₀ sourceIdx).move Dir3.left ∧ + (work lowIdx).HasBinaryNat + (if slotBitAtHead ((work₀ sourceIdx).move Dir3.left) then 1 else 0) ∧ + (work highIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) ∧ + (∀ i, i ≠ sourceIdx → i ≠ lowIdx → i ≠ highIdx → + work i = work₀ i) ∧ + out = out₀) + 3 := by + let work₁ := captureSlotBitWork sourceIdx highIdx true work₀ + have hsource₁ : work₁ sourceIdx = + (work₀ sourceIdx).move Dir3.left := by + simpa [work₁] using + captureSlotBitWork_source_internal sourceIdx highIdx true work₀ + hsourceHigh + have hsource₁read : (work₁ sourceIdx).read ≠ Γ.start := by + rw [hsource₁] + exact hsourceLow + have hlow₁ : work₁ lowIdx = work₀ lowIdx := by + simpa [work₁] using + captureSlotBitWork_other_internal sourceIdx highIdx true work₀ lowIdx + hsl.symm hlh (hwork lowIdx) + have hframe := captureSlotBitsTM_hoareTime_frame_internal sourceIdx lowIdx + highIdx hsl hsh hlh inp₀ work₀ out₀ hinput hsourceHigh hsourceLow hwork + hhighZero houtput + refine hframe.consequence (fun _ _ _ h => h) (fun inp work out h => ?_) + le_rfl + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨rfl, ?_, ?_, ?_, ?_, rfl⟩ + · simp [captureSlotBitsWork, + captureSlotBitWork_source_internal sourceIdx lowIdx false work₁ + hsource₁read, hsource₁, work₁] + · have hlow₁zero : (work₁ lowIdx).HasBinaryNat 0 := by + simpa [hlow₁] using hlowZero + have hlow := captureSlotBitWork_target_internal sourceIdx lowIdx hsl + false work₁ hlow₁zero + simpa [captureSlotBitsWork, work₁, hsource₁] using hlow + · have hhigh₁ : (work₁ highIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) := by + simpa [work₁] using + captureSlotBitWork_target_internal sourceIdx highIdx hsh true work₀ + hhighZero + rw [captureSlotBitsWork, + captureSlotBitWork_other_internal sourceIdx lowIdx false work₁ highIdx + hsh.symm hlh.symm hhigh₁.2.hasBinarySuffix.read_ne_start] + exact hhigh₁ + · intro i his hil hih + rw [captureSlotBitsWork, + captureSlotBitWork_other_internal sourceIdx lowIdx false work₁ i his hil] + · exact captureSlotBitWork_other_internal sourceIdx highIdx true work₀ i + his hih (hwork i) + · by_cases hi : i = highIdx + · exact absurd hi hih + · rw [show work₁ i = work₀ i by + simpa [work₁] using + captureSlotBitWork_other_internal sourceIdx highIdx true work₀ i + his hi (hwork i)] + exact hwork i + +theorem captureSlotBitsTM_hoareTimeSpace_internal + (sourceIdx lowIdx highIdx : Fin n) + (hsl : sourceIdx ≠ lowIdx) (hsh : sourceIdx ≠ highIdx) + (hlh : lowIdx ≠ highIdx) + (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceHigh : (work₀ sourceIdx).read ≠ Γ.start) + (hsourceLow : ((work₀ sourceIdx).move Dir3.left).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hlowZero : (work₀ lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ highIdx).HasBinaryNat 0) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (captureSlotBitsTM sourceIdx lowIdx highIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (captureSlotBitsTM sourceIdx lowIdx highIdx).Q) + |>.WithinAuxSpace inputLength initialSpace) : + (captureSlotBitsTM sourceIdx lowIdx highIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = (work₀ sourceIdx).move Dir3.left ∧ + (work lowIdx).HasBinaryNat + (if slotBitAtHead ((work₀ sourceIdx).move Dir3.left) then 1 else 0) ∧ + (work highIdx).HasBinaryNat + (if slotBitAtHead (work₀ sourceIdx) then 1 else 0) ∧ + (∀ i, i ≠ sourceIdx → i ≠ lowIdx → i ≠ highIdx → + work i = work₀ i) ∧ + out = out₀) + 3 inputLength (initialSpace + 3) := by + apply (captureSlotBitsTM_hoareTime_internal sourceIdx lowIdx highIdx hsl hsh + hlh inp₀ work₀ out₀ hinput hsourceHigh hsourceLow hwork hlowZero + hhighZero houtput).toHoareTimeSpace + intro inp work out hpre + obtain ⟨hinp, hworkEq, hout⟩ := hpre + subst inp + subst work + subst out + exact hinitial + +theorem captureSlotBitTM_isTransducer_internal + (sourceIdx targetIdx : Fin n) (moveLeft : Bool) : + (captureSlotBitTM sourceIdx targetIdx moveLeft).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | capture => + cases hsource : wHeads sourceIdx <;> + cases oHead <;> + simp [captureSlotBitTM, hsource, TM.allIdle, TM.idleDir] + | done => + cases oHead <;> simp [captureSlotBitTM, TM.allIdle, TM.idleDir] + +theorem captureSlotBitsTM_isTransducer_internal + (sourceIdx lowIdx highIdx : Fin n) : + (captureSlotBitsTM sourceIdx lowIdx highIdx).IsTransducer := by + exact (captureSlotBitTM_isTransducer_internal sourceIdx highIdx true).seqTM + (captureSlotBitTM_isTransducer_internal sourceIdx lowIdx false) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend.lean new file mode 100644 index 00000000..f3d82701 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend.lean @@ -0,0 +1,257 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotDescend.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotDescend.Internal + +/-! +# Barrington recursive slot descent + +This module exposes the constant-cost preparation step used after the initial +slot digit has been captured. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- Move onto the next lower digit's high bit and reset both captured-bit +latches in one transition. -/ +theorem prepareNextSlotDigitTM_hoareTime + (sourceIdx lowIdx highIdx : Fin n) + (hsl : sourceIdx ≠ lowIdx) (hsh : sourceIdx ≠ highIdx) + (low high : Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hlow : (work₀ lowIdx).HasBinaryNat (if low then 1 else 0)) + (hhigh : (work₀ highIdx).HasBinaryNat (if high then 1 else 0)) + (houtput : out₀.read ≠ Γ.start) : + (prepareNextSlotDigitTM sourceIdx lowIdx highIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = (work₀ sourceIdx).move Dir3.left ∧ + (work lowIdx).HasBinaryNat 0 ∧ + (work highIdx).HasBinaryNat 0 ∧ + (∀ i, i ≠ sourceIdx → i ≠ lowIdx → i ≠ highIdx → + work i = work₀ i) ∧ + out = out₀) + 1 := + prepareNextSlotDigitTM_hoareTime_internal sourceIdx lowIdx highIdx hsl hsh + low high inp₀ work₀ out₀ hinput hsource hwork hlow hhigh houtput + +/-- One constant-cost recursive descent exposes exactly the next lower raw +base-four digit of the preserved canonical slot address. -/ +theorem recaptureSlotBitsTM_hoareTime + (layout : BarringtonSlotLayout n) (slotValue fuel : ℕ) + (previousLow previousHigh : Bool) + (original : Tape) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : original.HasBinaryNat slotValue) + (hsourceHead : (work₀ layout.sourceIdx).head = + original.head + 2 * (fuel + 1)) + (hsourceCells : (work₀ layout.sourceIdx).cells = original.cells) + (hlow : (work₀ layout.lowIdx).HasBinaryNat + (if previousLow then 1 else 0)) + (hhigh : (work₀ layout.highIdx).HasBinaryNat + (if previousHigh then 1 else 0)) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (recaptureSlotBitsTM layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + recaptureSlotBitsTime := + recaptureSlotBitsTM_hoareTime_internal layout slotValue fuel previousLow + previousHigh original inp₀ work₀ out₀ hinput hslot hsourceHead hsourceCells + hlow hhigh hwork houtput + +/-- Recursive digit capture has a constant additive all-prefix space cost. -/ +theorem recaptureSlotBitsTM_hoareTimeSpace + (layout : BarringtonSlotLayout n) (slotValue fuel : ℕ) + (previousLow previousHigh : Bool) + (original : Tape) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : original.HasBinaryNat slotValue) + (hsourceHead : (work₀ layout.sourceIdx).head = + original.head + 2 * (fuel + 1)) + (hsourceCells : (work₀ layout.sourceIdx).cells = original.cells) + (hlow : (work₀ layout.lowIdx).HasBinaryNat + (if previousLow then 1 else 0)) + (hhigh : (work₀ layout.highIdx).HasBinaryNat + (if previousHigh then 1 else 0)) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (recaptureSlotBitsTM layout).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + recaptureSlotBitsTime inputLength + (recaptureSlotBitsSpace initialSpace) := + recaptureSlotBitsTM_hoareTimeSpace_internal layout slotValue fuel previousLow + previousHigh original inputLength initialSpace inp₀ work₀ out₀ hinput hslot + hsourceHead hsourceCells hlow hhigh hwork houtput hworkSpace hinputSpace + +/-- Recursive digit capture feeds its exact raw bits to the selected four-way +continuation without increasing the continuation's space budget. -/ +theorem barringtonNextSlotBranchTM_selected_hoareTimeSpace + (layout : BarringtonSlotLayout n) (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + (slotValue fuel : ℕ) (previousLow previousHigh : Bool) + (original : Tape) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : original.HasBinaryNat slotValue) + (hsourceHead : (work₀ layout.sourceIdx).head = + original.head + 2 * (fuel + 1)) + (hsourceCells : (work₀ layout.sourceIdx).cells = original.cells) + (hlow : (work₀ layout.lowIdx).HasBinaryNat + (if previousLow then 1 else 0)) + (hhigh : (work₀ layout.highIdx).HasBinaryNat + (if previousHigh then 1 else 0)) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) + {post : TapePred n} {selectedTime : ℕ} + (hselected : + (barringtonSlotContinuation reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight).HoareTimeSpace + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + post selectedTime inputLength + (recaptureSlotBitsSpace initialSpace)) : + (barringtonNextSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + post (barringtonNextSlotBranchTime selectedTime) inputLength + (recaptureSlotBitsSpace initialSpace) := + barringtonNextSlotBranchTM_selected_hoareTimeSpace_internal layout reversed + onLeft onRight onInverseLeft onInverseRight slotValue fuel previousLow + previousHigh original inputLength initialSpace inp₀ work₀ out₀ hinput hslot + hsourceHead hsourceCells hlow hhigh hwork houtput hworkSpace hinputSpace + hselected + +/-- Recursive digit capture selects the semantic child named by the slot +cursor, hiding raw bit and reflection arithmetic from the caller. -/ +theorem barringtonNextSlotBranchTM_cursor_hoareTimeSpace + (layout : BarringtonSlotLayout n) (cursor : BarringtonSlotCursor) + (onLeft onRight onInverseLeft onInverseRight : TM n) + (fuel : ℕ) (previousLow previousHigh : Bool) + (original : Tape) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : original.HasBinaryNat cursor.slot) + (hsourceHead : (work₀ layout.sourceIdx).head = + original.head + 2 * (fuel + 1)) + (hsourceCells : (work₀ layout.sourceIdx).cells = original.cells) + (hlow : (work₀ layout.lowIdx).HasBinaryNat + (if previousLow then 1 else 0)) + (hhigh : (work₀ layout.highIdx).HasBinaryNat + (if previousHigh then 1 else 0)) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) + {post : TapePred n} {selectedTime : ℕ} + (hselected : + (if cursor.selectsInverse fuel then + if cursor.selectsRight fuel then onInverseRight else onInverseLeft + else if cursor.selectsRight fuel then onRight else onLeft + ).HoareTimeSpace + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if cursor.slot.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if cursor.slot.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + post selectedTime inputLength + (recaptureSlotBitsSpace initialSpace)) : + (barringtonNextSlotBranchTM layout cursor.reversed onLeft onRight + onInverseLeft onInverseRight).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + post (barringtonNextSlotBranchTime selectedTime) inputLength + (recaptureSlotBitsSpace initialSpace) := by + rw [← barringtonSlotContinuation_cursor cursor fuel onLeft onRight + onInverseLeft onInverseRight] at hselected + exact barringtonNextSlotBranchTM_selected_hoareTimeSpace layout + cursor.reversed onLeft onRight onInverseLeft onInverseRight cursor.slot fuel + previousLow previousHigh original inputLength initialSpace inp₀ work₀ out₀ + hinput hslot hsourceHead hsourceCells hlow hhigh hwork houtput hworkSpace + hinputSpace hselected + +/-- Preparing a lower digit never moves the output head left. -/ +theorem prepareNextSlotDigitTM_isTransducer + (sourceIdx lowIdx highIdx : Fin n) : + (prepareNextSlotDigitTM sourceIdx lowIdx highIdx).IsTransducer := + prepareNextSlotDigitTM_isTransducer_internal sourceIdx lowIdx highIdx + +/-- Recursive digit recapture never moves the output head left. -/ +theorem recaptureSlotBitsTM_isTransducer + (layout : BarringtonSlotLayout n) : + (recaptureSlotBitsTM layout).IsTransducer := + recaptureSlotBitsTM_isTransducer_internal layout + +/-- Recursive digit recapture and dispatch remain one-way on output when all +four continuations are. -/ +theorem barringtonNextSlotBranchTM_isTransducer + (layout : BarringtonSlotLayout n) (reversed : Bool) + {onLeft onRight onInverseLeft onInverseRight : TM n} + (hleft : onLeft.IsTransducer) (hright : onRight.IsTransducer) + (hinverseLeft : onInverseLeft.IsTransducer) + (hinverseRight : onInverseRight.IsTransducer) : + (barringtonNextSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).IsTransducer := + barringtonNextSlotBranchTM_isTransducer_internal layout reversed hleft hright + hinverseLeft hinverseRight + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend/Defs.lean new file mode 100644 index 00000000..18ee80f1 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend/Defs.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotStep.Defs + +/-! +# Barrington recursive slot descent -- definitions + +After the initial slot positioner captures one base-four digit, the preserved +address head sits on that digit's low bit. Descending to the next digit needs +only one left move, resetting the two one-bit latches, and another adjacent-bit +capture. This module defines that constant-cost machine layer. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Two-state controller for preparing the next lower base-four digit. -/ +inductive PrepareNextSlotDigitPhase where + | prepare + | done + deriving DecidableEq + +/-- The preparation controller has exactly two states. -/ +instance instFintypePrepareNextSlotDigitPhase : + Fintype PrepareNextSlotDigitPhase where + elems := {.prepare, .done} + complete := fun phase => by cases phase <;> simp + +/-- Exact work frame after moving the address one cell left and blanking both +captured-bit latches. -/ +def prepareNextSlotDigitWork {n : ℕ} (sourceIdx lowIdx highIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := + fun i => + if i = sourceIdx then + (work i).writeAndMove (TM.readBackWrite (work i).read) Dir3.left + else if i = lowIdx ∨ i = highIdx then + (work i).writeAndMove .blank Dir3.stay + else + (work i).writeAndMove (TM.readBackWrite (work i).read) + (TM.idleDir (work i).read) + +/-- Move the preserved address from the current low bit onto the next lower +digit's high bit while resetting both captured-bit latches to canonical zero. -/ +def prepareNextSlotDigitTM {n : ℕ} (sourceIdx lowIdx highIdx : Fin n) : TM n where + Q := PrepareNextSlotDigitPhase + qstart := .prepare + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .prepare => + (.done, + fun i => + if i = lowIdx ∨ i = highIdx then .blank + else TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, + TM.idleDir iHead, + fun i => + if i = sourceIdx then + if wHeads i = Γ.start then Dir3.right else Dir3.left + else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + cases phase with + | prepare => + refine ⟨TM.idleDir_right_of_start, ?_, + TM.idleDir_right_of_start⟩ + intro i hi + by_cases his : i = sourceIdx + · subst i + simp [hi] + · simp [his, TM.idleDir_right_of_start hi] + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Prepare the next digit, then capture its high and low bits. -/ +def recaptureSlotBitsTM {n : ℕ} (layout : BarringtonSlotLayout n) : TM n := + TM.seqTM + (prepareNextSlotDigitTM layout.sourceIdx layout.lowIdx layout.highIdx) + (captureSlotBitsTM layout.sourceIdx layout.lowIdx layout.highIdx) + +/-- Exact runtime of one recursive digit preparation and capture. -/ +def recaptureSlotBitsTime : ℕ := + 1 + 1 + 3 + +/-- Safe all-prefix space envelope for one recursive digit preparation and +capture. -/ +def recaptureSlotBitsSpace (initialSpace : ℕ) : ℕ := + initialSpace + recaptureSlotBitsTime + +/-- Capture the next lower slot digit and dispatch through its semantic raw +bits and the current reflection flag. -/ +def barringtonNextSlotBranchTM {n : ℕ} + (layout : BarringtonSlotLayout n) (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) : TM n := + TM.seqTM (recaptureSlotBitsTM layout) + (barringtonSlotBranchTM layout.lowIdx layout.highIdx reversed + onLeft onRight onInverseLeft onInverseRight) + +/-- Runtime of recursive digit capture, two dispatch transitions, and the +selected continuation. -/ +def barringtonNextSlotBranchTime (selectedTime : ℕ) : ℕ := + recaptureSlotBitsTime + 1 + (selectedTime + 2) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend/Internal.lean new file mode 100644 index 00000000..c55fb97c --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotDescend/Internal.lean @@ -0,0 +1,496 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotDescend.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotBranch +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotCapture + +/-! +# Barrington recursive slot descent -- internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +private theorem prepareNextSlotDigitTM_step + (sourceIdx lowIdx highIdx : Fin n) + (hsl : sourceIdx ≠ lowIdx) (hsh : sourceIdx ≠ highIdx) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (prepareNextSlotDigitTM sourceIdx lowIdx highIdx).step + { state := (prepareNextSlotDigitTM sourceIdx lowIdx highIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } = + some + { state := (prepareNextSlotDigitTM sourceIdx lowIdx highIdx).qhalt + input := inp₀ + work := prepareNextSlotDigitWork sourceIdx lowIdx highIdx work₀ + output := out₀ } := by + rw [TM.step, if_neg (by simp [prepareNextSlotDigitTM])] + simp only [prepareNextSlotDigitTM] + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · dsimp only + simp [TM.idleDir, hinput, Tape.move] + · dsimp only + funext i + by_cases his : i = sourceIdx + · subst i + simp [prepareNextSlotDigitWork, hsl, hsh, hsource] + · by_cases hil : i = lowIdx + · subst i + simp [prepareNextSlotDigitWork, his, TM.idleDir, hwork lowIdx] + · by_cases hih : i = highIdx + · subst i + simp [prepareNextSlotDigitWork, his, TM.idleDir, + hwork highIdx] + · simp [prepareNextSlotDigitWork, his, hil, hih, TM.idleDir, + hwork i, Tape.move] + · dsimp only + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out₀ houtput Dir3.stay + +private theorem prepareNextSlotDigitWork_source + (sourceIdx lowIdx highIdx : Fin n) (work : Fin n → Tape) + (hsource : (work sourceIdx).read ≠ Γ.start) : + prepareNextSlotDigitWork sourceIdx lowIdx highIdx work sourceIdx = + (work sourceIdx).move Dir3.left := by + simp only [prepareNextSlotDigitWork, if_pos] + exact TM.writeAndMove_readBack (work sourceIdx) hsource Dir3.left + +private theorem prepareNextSlotDigitWork_bit + (sourceIdx lowIdx highIdx idx : Fin n) + (his : idx ≠ sourceIdx) (hbit : idx = lowIdx ∨ idx = highIdx) + (bit : Bool) (work : Fin n → Tape) + (hvalue : (work idx).HasBinaryNat (if bit then 1 else 0)) : + (prepareNextSlotDigitWork sourceIdx lowIdx highIdx work idx) + |>.HasBinaryNat 0 := by + simp only [prepareNextSlotDigitWork, if_neg his, if_pos hbit] + rw [hvalue.eq_init_move_right] + cases bit with + | false => + change + (((Tape.init []).move Dir3.right).writeAndMove .blank Dir3.stay) + |>.HasBinaryNat 0 + rw [show + (((Tape.init []).move Dir3.right).writeAndMove .blank Dir3.stay) = + (Tape.init []).move Dir3.right by + apply Tape.ext + · rfl + · funext i + cases i with + | zero => + simp [Tape.writeAndMove, Tape.write, Tape.move, Tape.init] + | succ i => + cases i with + | zero => + simp [Tape.writeAndMove, Tape.write, Tape.move, Tape.init] + | succ i => + simp [Tape.writeAndMove, Tape.write, Tape.move, + Tape.init]] + exact Tape.init_move_right_hasBinaryNat 0 + | true => + change + (((Tape.init [Γ.one]).move Dir3.right).writeAndMove .blank Dir3.stay) + |>.HasBinaryNat 0 + rw [show + (((Tape.init [Γ.one]).move Dir3.right).writeAndMove .blank Dir3.stay) = + (Tape.init []).move Dir3.right by + apply Tape.ext + · rfl + · funext i + cases i with + | zero => + simp [Tape.writeAndMove, Tape.write, Tape.move, Tape.init] + | succ i => + cases i with + | zero => + simp [Tape.writeAndMove, Tape.write, Tape.move, Tape.init] + | succ i => + simp [Tape.writeAndMove, Tape.write, Tape.move, + Tape.init]] + exact Tape.init_move_right_hasBinaryNat 0 + +private theorem prepareNextSlotDigitWork_other + (sourceIdx lowIdx highIdx : Fin n) (work : Fin n → Tape) (i : Fin n) + (his : i ≠ sourceIdx) (hil : i ≠ lowIdx) (hih : i ≠ highIdx) + (hread : (work i).read ≠ Γ.start) : + prepareNextSlotDigitWork sourceIdx lowIdx highIdx work i = work i := by + simpa [prepareNextSlotDigitWork, his, hil, hih, TM.idleDir, hread, + Tape.move] using + TM.writeAndMove_readBack (work i) hread Dir3.stay + +theorem prepareNextSlotDigitTM_hoareTime_internal + (sourceIdx lowIdx highIdx : Fin n) + (hsl : sourceIdx ≠ lowIdx) (hsh : sourceIdx ≠ highIdx) + (low high : Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsource : (work₀ sourceIdx).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (hlow : (work₀ lowIdx).HasBinaryNat (if low then 1 else 0)) + (hhigh : (work₀ highIdx).HasBinaryNat (if high then 1 else 0)) + (houtput : out₀.read ≠ Γ.start) : + (prepareNextSlotDigitTM sourceIdx lowIdx highIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work sourceIdx = (work₀ sourceIdx).move Dir3.left ∧ + (work lowIdx).HasBinaryNat 0 ∧ + (work highIdx).HasBinaryNat 0 ∧ + (∀ i, i ≠ sourceIdx → i ≠ lowIdx → i ≠ highIdx → + work i = work₀ i) ∧ + out = out₀) + 1 := by + intro inp work out hpre + obtain ⟨hinp, hworkEq, hout⟩ := hpre + subst inp + subst work + subst out + have hstep := prepareNextSlotDigitTM_step sourceIdx lowIdx highIdx hsl hsh + inp₀ work₀ out₀ hinput hsource hwork houtput + refine ⟨_, 1, le_rfl, .step hstep .zero, rfl, ?_⟩ + refine ⟨rfl, + prepareNextSlotDigitWork_source sourceIdx lowIdx highIdx work₀ hsource, + prepareNextSlotDigitWork_bit sourceIdx lowIdx highIdx lowIdx hsl.symm + (Or.inl rfl) low work₀ hlow, + prepareNextSlotDigitWork_bit sourceIdx lowIdx highIdx highIdx hsh.symm + (Or.inr rfl) high work₀ hhigh, ?_, rfl⟩ + intro i his hil hih + exact prepareNextSlotDigitWork_other sourceIdx lowIdx highIdx work₀ i his hil + hih (hwork i) + +theorem recaptureSlotBitsTM_hoareTime_internal + (layout : BarringtonSlotLayout n) (slotValue fuel : ℕ) + (previousLow previousHigh : Bool) + (original : Tape) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : original.HasBinaryNat slotValue) + (hsourceHead : (work₀ layout.sourceIdx).head = + original.head + 2 * (fuel + 1)) + (hsourceCells : (work₀ layout.sourceIdx).cells = original.cells) + (hlow : (work₀ layout.lowIdx).HasBinaryNat + (if previousLow then 1 else 0)) + (hhigh : (work₀ layout.highIdx).HasBinaryNat + (if previousHigh then 1 else 0)) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (recaptureSlotBitsTM layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + recaptureSlotBitsTime := by + have hrole : ∀ i j : Fin 5, i ≠ j → layout.roles i ≠ layout.roles j := + fun _ _ hij => layout.roles.injective.ne hij + have hsl : layout.sourceIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.lowIdx + exact hrole 0 3 (by decide) + have hsh : layout.sourceIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.highIdx + exact hrole 0 4 (by decide) + have hlh : layout.lowIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.lowIdx BarringtonSlotLayout.highIdx + exact hrole 3 4 (by decide) + let prepared : TapePred n := fun inp work out => + inp = inp₀ ∧ + work layout.sourceIdx = (work₀ layout.sourceIdx).move Dir3.left ∧ + (work layout.lowIdx).HasBinaryNat 0 ∧ + (work layout.highIdx).HasBinaryNat 0 ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀ + have hprepare := prepareNextSlotDigitTM_hoareTime_internal layout.sourceIdx + layout.lowIdx layout.highIdx hsl hsh previousLow previousHigh inp₀ work₀ + out₀ hinput (hwork layout.sourceIdx) hwork hlow hhigh houtput + have hpreparedReads : ∀ inp work out, prepared inp work out → + ∀ i, (work i).read ≠ Γ.start := by + intro inp work out hpre i + rcases hpre with ⟨-, hsource, hlowZero, hhighZero, hother, -⟩ + by_cases his : i = layout.sourceIdx + · subst i + rw [hsource, Tape.read, Tape.move, hsourceCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + ((work₀ layout.sourceIdx).head - 1) + (by rw [hsourceHead, hslot.2.1]; omega) + by_cases hil : i = layout.lowIdx + · subst i + exact hlowZero.2.hasBinarySuffix.read_ne_start + by_cases hih : i = layout.highIdx + · subst i + exact hhighZero.2.hasBinarySuffix.read_ne_start + · rw [hother i his hil hih] + exact hwork i + have hcapture : + (captureSlotBitsTM layout.sourceIdx layout.lowIdx layout.highIdx) + |>.HoareTime prepared + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + 3 := by + intro inp work out hpre + rcases hpre with ⟨hinp, hsource, hlowZero, hhighZero, hother, hout⟩ + have hsourceHigh : (work layout.sourceIdx).read ≠ Γ.start := + hpreparedReads inp work out + ⟨hinp, hsource, hlowZero, hhighZero, hother, hout⟩ layout.sourceIdx + have hsourceLow : ((work layout.sourceIdx).move Dir3.left).read ≠ + Γ.start := by + rw [Tape.read, Tape.move, hsource, Tape.move, hsourceCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + (((work₀ layout.sourceIdx).head - 1) - 1) + (by rw [hsourceHead, hslot.2.1]; omega) + have hrun := captureSlotBitsTM_hoareTime layout.sourceIdx layout.lowIdx + layout.highIdx hsl hsh hlh inp work out + (by rw [hinp]; exact hinput) hsourceHigh hsourceLow + (hpreparedReads inp work out + ⟨hinp, hsource, hlowZero, hhighZero, hother, hout⟩) + hlowZero hhighZero (by rw [hout]; exact houtput) + obtain ⟨c, time, htime, hreach, hhalt, hpost⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + rcases hpost with + ⟨hcInput, hcSource, hcLow, hcHigh, hcOther, hcOutput⟩ + refine ⟨c, time, htime, hreach, hhalt, ?_⟩ + refine ⟨hcInput.trans hinp, + ?_, ?_, ?_, ?_, ?_, hcOutput.trans hout⟩ + · rw [hcSource, hsource, Tape.move, Tape.move, hsourceHead] + have horiginalHead : original.head = 1 := hslot.2.1 + dsimp only + omega + · rw [hcSource, hsource, Tape.move, Tape.move, hsourceCells] + · rw [← slotBitAtHead_eq_testBit_of_cells + ((work layout.sourceIdx).move Dir3.left) original slotValue + (2 * fuel) hslot] + · exact hcLow + · rw [hsource, Tape.move, Tape.move, hsourceCells] + · rw [hsource, Tape.move, Tape.move, hsourceHead, hslot.2.1] + have horiginalHead : original.head = 1 := hslot.2.1 + dsimp only + omega + · rw [← slotBitAtHead_eq_testBit_of_cells + (work layout.sourceIdx) original slotValue (2 * fuel + 1) hslot] + · exact hcHigh + · rw [hsource, Tape.move, hsourceCells] + · rw [hsource, Tape.move, hsourceHead, hslot.2.1] + have horiginalHead : original.head = 1 := hslot.2.1 + dsimp only + omega + · intro i his hil hih + rw [hcOther i his hil hih] + exact hother i his hil hih + have htransition : ∀ inp work out, prepared inp work out → + prepared (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out hpre + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + (inp := inp) (work := work) (out := out) + (by rw [hpre.1]; exact hinput) (hpreparedReads inp work out hpre) + (by rw [hpre.2.2.2.2.2]; exact houtput) + rw [hi, hw, ho] + exact hpre + simpa [recaptureSlotBitsTM, recaptureSlotBitsTime, prepared] using + TM.seqTM_hoareTime _ _ hprepare htransition hcapture + +theorem recaptureSlotBitsTM_hoareTimeSpace_internal + (layout : BarringtonSlotLayout n) (slotValue fuel : ℕ) + (previousLow previousHigh : Bool) + (original : Tape) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : original.HasBinaryNat slotValue) + (hsourceHead : (work₀ layout.sourceIdx).head = + original.head + 2 * (fuel + 1)) + (hsourceCells : (work₀ layout.sourceIdx).cells = original.cells) + (hlow : (work₀ layout.lowIdx).HasBinaryNat + (if previousLow then 1 else 0)) + (hhigh : (work₀ layout.highIdx).HasBinaryNat + (if previousHigh then 1 else 0)) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (recaptureSlotBitsTM layout).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + recaptureSlotBitsTime inputLength + (recaptureSlotBitsSpace initialSpace) := by + apply (recaptureSlotBitsTM_hoareTime_internal layout slotValue fuel + previousLow previousHigh original inp₀ work₀ out₀ hinput hslot hsourceHead + hsourceCells hlow hhigh hwork houtput).toHoareTimeSpace + intro inp work out hpre + rcases hpre with ⟨rfl, rfl, rfl⟩ + constructor + · exact hworkSpace + · exact hinputSpace + +theorem barringtonNextSlotBranchTM_selected_hoareTimeSpace_internal + (layout : BarringtonSlotLayout n) (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + (slotValue fuel : ℕ) (previousLow previousHigh : Bool) + (original : Tape) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : original.HasBinaryNat slotValue) + (hsourceHead : (work₀ layout.sourceIdx).head = + original.head + 2 * (fuel + 1)) + (hsourceCells : (work₀ layout.sourceIdx).cells = original.cells) + (hlow : (work₀ layout.lowIdx).HasBinaryNat + (if previousLow then 1 else 0)) + (hhigh : (work₀ layout.highIdx).HasBinaryNat + (if previousHigh then 1 else 0)) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) + {post : TapePred n} {selectedTime : ℕ} + (hselected : + (barringtonSlotContinuation reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight).HoareTimeSpace + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + post selectedTime inputLength + (recaptureSlotBitsSpace initialSpace)) : + (barringtonNextSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + post (barringtonNextSlotBranchTime selectedTime) inputLength + (recaptureSlotBitsSpace initialSpace) := by + let captured : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = original.head + 2 * fuel ∧ + (work layout.sourceIdx).cells = original.cells ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀ + have hcapture := recaptureSlotBitsTM_hoareTimeSpace_internal layout + slotValue fuel previousLow previousHigh original inputLength initialSpace + inp₀ work₀ out₀ hinput hslot hsourceHead hsourceCells hlow hhigh hwork + houtput hworkSpace hinputSpace + have hcapturedReads : ∀ inp work out, captured inp work out → + ∀ i, (work i).read ≠ Γ.start := by + intro inp work out hcap i + rcases hcap with + ⟨-, hcapturedHead, hcapturedCells, hcapturedLow, hcapturedHigh, + hother, -⟩ + by_cases his : i = layout.sourceIdx + · subst i + rw [Tape.read, hcapturedCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + ((work layout.sourceIdx).head) + (by rw [hcapturedHead, hslot.2.1]; omega) + by_cases hil : i = layout.lowIdx + · subst i + exact hcapturedLow.2.hasBinarySuffix.read_ne_start + by_cases hih : i = layout.highIdx + · subst i + exact hcapturedHigh.2.hasBinarySuffix.read_ne_start + · rw [hother i his hil hih] + exact hwork i + have hbranch := barringtonSlotBranchTM_selected_hoareTimeSpace layout.lowIdx + layout.highIdx reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight + (fun inp work out hcap => by rw [hcap.1]; exact hinput) + hcapturedReads + (fun inp work out hcap => by rw [hcap.2.2.2.2.2.2]; exact houtput) + (fun _ _ _ hcap => hcap.2.2.2.1) + (fun _ _ _ hcap => hcap.2.2.2.2.1) + hselected + have htransition : ∀ inp work out, captured inp work out → + captured (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out hcap + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + (inp := inp) (work := work) (out := out) + (by rw [hcap.1]; exact hinput) (hcapturedReads inp work out hcap) + (by rw [hcap.2.2.2.2.2.2]; exact houtput) + rw [hi, hw, ho] + exact hcap + simpa [barringtonNextSlotBranchTM, barringtonNextSlotBranchTime, captured] + using TM.seqTM_hoareTimeSpace _ _ hcapture htransition hbranch + +theorem prepareNextSlotDigitTM_isTransducer_internal + (sourceIdx lowIdx highIdx : Fin n) : + (prepareNextSlotDigitTM sourceIdx lowIdx highIdx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | prepare => + cases oHead <;> simp [prepareNextSlotDigitTM, TM.idleDir] + | done => + cases oHead <;> simp [prepareNextSlotDigitTM, TM.allIdle, TM.idleDir] + +theorem recaptureSlotBitsTM_isTransducer_internal + (layout : BarringtonSlotLayout n) : + (recaptureSlotBitsTM layout).IsTransducer := by + exact (prepareNextSlotDigitTM_isTransducer_internal layout.sourceIdx + layout.lowIdx layout.highIdx).seqTM + (captureSlotBitsTM_isTransducer layout.sourceIdx layout.lowIdx + layout.highIdx) + +theorem barringtonNextSlotBranchTM_isTransducer_internal + (layout : BarringtonSlotLayout n) (reversed : Bool) + {onLeft onRight onInverseLeft onInverseRight : TM n} + (hleft : onLeft.IsTransducer) (hright : onRight.IsTransducer) + (hinverseLeft : onInverseLeft.IsTransducer) + (hinverseRight : onInverseRight.IsTransducer) : + (barringtonNextSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).IsTransducer := by + exact (recaptureSlotBitsTM_isTransducer_internal layout).seqTM + (barringtonSlotBranchTM_isTransducer layout.lowIdx layout.highIdx reversed + hleft hright hinverseLeft hinverseRight) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition.lean new file mode 100644 index 00000000..64079e9e --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotPosition.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotPosition.Internal + +/-! +# Barrington slot positioning + +This module exposes the certified constant-time movement bodies used by the +runtime binary-loop positioner for a preserved slot address. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- One positioning step moves only the designated slot-address head right. -/ +theorem moveSlotRightTM_hoareTime + (sourceIdx : Fin n) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (moveSlotRightTM sourceIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = moveSlotRightWork sourceIdx work₀ ∧ out = out₀) + 1 := + moveSlotRightTM_hoareTime_internal sourceIdx inp₀ work₀ out₀ hinput hwork + houtput + +/-- One positioning-loop body moves only the designated slot-address head two +cells right. -/ +theorem advanceSlotDigitTM_hoareTime + (sourceIdx : Fin n) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceNext : ((work₀ sourceIdx).move Dir3.right).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (advanceSlotDigitTM sourceIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = moveSlotRightWork sourceIdx (moveSlotRightWork sourceIdx work₀) ∧ + out = out₀) + 2 := + advanceSlotDigitTM_hoareTime_internal sourceIdx inp₀ work₀ out₀ hinput + hsourceNext hwork houtput + +/-- The runtime binary loop places a canonical slot-address head on bit +`2 * fuel + 1`, preserving its cells and every unrelated tape. -/ +theorem positionSlotTM_hoareTime + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (positionSlotTM sourceIdx counterIdx limitIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work sourceIdx).head = (work₀ sourceIdx).head + 2 * fuel + 1 ∧ + (work sourceIdx).cells = (work₀ sourceIdx).cells ∧ + (work counterIdx).HasBinaryNat fuel ∧ + work limitIdx = work₀ limitIdx ∧ + (∀ i, i ≠ sourceIdx → i ≠ counterIdx → i ≠ limitIdx → + work i = work₀ i) ∧ + out = out₀) + (positionSlotTime fuel) := + positionSlotTM_hoareTime_internal sourceIdx counterIdx limitIdx hsc hcl hsl + slotValue fuel inp₀ work₀ out₀ hinput hslot hcounter hlimit hwork houtput + +/-- Runtime positioning has a linear-in-`fuel` all-prefix space bound: the +main term is the `2 * fuel` source-head displacement, while binary-loop control +uses only the bit width of `fuel`. -/ +theorem positionSlotTM_hoareTimeSpace + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (positionSlotTM sourceIdx counterIdx limitIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work sourceIdx).head = (work₀ sourceIdx).head + 2 * fuel + 1 ∧ + (work sourceIdx).cells = (work₀ sourceIdx).cells ∧ + (work counterIdx).HasBinaryNat fuel ∧ + work limitIdx = work₀ limitIdx ∧ + (∀ i, i ≠ sourceIdx → i ≠ counterIdx → i ≠ limitIdx → + work i = work₀ i) ∧ + out = out₀) + (positionSlotTime fuel) inputLength + (positionSlotSpace initialSpace fuel) := + positionSlotTM_hoareTimeSpace_internal sourceIdx counterIdx limitIdx hsc hcl + hsl slotValue fuel inputLength initialSpace inp₀ work₀ out₀ hinput hslot + hcounter hlimit hwork houtput hworkSpace hinputSpace + +/-- One rightward positioning step adds at most one cell to the starting +all-prefix auxiliary-space budget. -/ +theorem moveSlotRightTM_hoareTimeSpace + (sourceIdx : Fin n) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (moveSlotRightTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : Cfg n (moveSlotRightTM sourceIdx).Q) + |>.WithinAuxSpace inputLength initialSpace) : + (moveSlotRightTM sourceIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = moveSlotRightWork sourceIdx work₀ ∧ out = out₀) + 1 inputLength (initialSpace + 1) := + moveSlotRightTM_hoareTimeSpace_internal sourceIdx inputLength initialSpace + inp₀ work₀ out₀ hinput hwork houtput hinitial + +/-- One two-cell positioning body adds at most two cells to the starting +all-prefix auxiliary-space budget. -/ +theorem advanceSlotDigitTM_hoareTimeSpace + (sourceIdx : Fin n) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceNext : ((work₀ sourceIdx).move Dir3.right).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (advanceSlotDigitTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : Cfg n (advanceSlotDigitTM sourceIdx).Q) + |>.WithinAuxSpace inputLength initialSpace) : + (advanceSlotDigitTM sourceIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = moveSlotRightWork sourceIdx (moveSlotRightWork sourceIdx work₀) ∧ + out = out₀) + 2 inputLength (initialSpace + 2) := + advanceSlotDigitTM_hoareTimeSpace_internal sourceIdx inputLength initialSpace + inp₀ work₀ out₀ hinput hsourceNext hwork houtput hinitial + +/-- The constant-time slot movement bodies never move output left. -/ +theorem moveSlotRightTM_isTransducer (sourceIdx : Fin n) : + (moveSlotRightTM sourceIdx).IsTransducer := + moveSlotRightTM_isTransducer_internal sourceIdx + +/-- Advancing across one base-four digit never moves output left. -/ +theorem advanceSlotDigitTM_isTransducer (sourceIdx : Fin n) : + (advanceSlotDigitTM sourceIdx).IsTransducer := + advanceSlotDigitTM_isTransducer_internal sourceIdx + +/-- The complete binary-loop slot positioner never moves output left. -/ +theorem positionSlotTM_isTransducer + (sourceIdx counterIdx limitIdx : Fin n) : + (positionSlotTM sourceIdx counterIdx limitIdx).IsTransducer := + positionSlotTM_isTransducer_internal sourceIdx counterIdx limitIdx + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition/Defs.lean new file mode 100644 index 00000000..ff60f629 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition/Defs.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs + +/-! +# Barrington slot positioning -- definitions + +These constant-time bodies move a preserved binary slot-address cursor to the +right. A later binary count-up loop applies the two-cell body once per base-four +digit and then the one-cell body once, reaching the current high address bit. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Exact work frame after moving one designated head one cell right. -/ +def moveSlotRightWork {n : ℕ} (sourceIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := + Function.update work sourceIdx ((work sourceIdx).move Dir3.right) + +/-- Controller for one rightward slot-head movement. -/ +inductive MoveSlotRightPhase where + | move + | done + deriving DecidableEq + +/-- The one-cell movement controller has exactly two states. -/ +instance instFintypeMoveSlotRightPhase : Fintype MoveSlotRightPhase where + elems := {.move, .done} + complete := fun phase => by cases phase <;> simp + +/-- Move one designated work-tape head one cell right in one transition. -/ +def moveSlotRightTM {n : ℕ} (sourceIdx : Fin n) : TM n where + Q := MoveSlotRightPhase + qstart := .move + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .move => + (.done, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => if i = sourceIdx then Dir3.right else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + cases phase with + | move => + refine ⟨TM.idleDir_right_of_start, ?_, TM.idleDir_right_of_start⟩ + intro i hi + by_cases his : i = sourceIdx + · simp [his] + · simp [his, TM.idleDir_right_of_start hi] + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Controller for advancing across one two-bit base-four digit. -/ +inductive AdvanceSlotDigitPhase where + | first + | second + | done + deriving DecidableEq + +/-- The two-cell digit movement controller has exactly three states. -/ +instance instFintypeAdvanceSlotDigitPhase : Fintype AdvanceSlotDigitPhase where + elems := {.first, .second, .done} + complete := fun phase => by cases phase <;> simp + +/-- Move one designated work-tape head two cells right in two transitions. -/ +def advanceSlotDigitTM {n : ℕ} (sourceIdx : Fin n) : TM n where + Q := AdvanceSlotDigitPhase + qstart := .first + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .first => + (.second, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => if i = sourceIdx then Dir3.right else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .second => + (.done, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => if i = sourceIdx then Dir3.right else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + cases phase with + | first | second => + refine ⟨TM.idleDir_right_of_start, ?_, TM.idleDir_right_of_start⟩ + intro i hi + by_cases his : i = sourceIdx + · simp [his] + · simp [his, TM.idleDir_right_of_start hi] + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Binary count-up loop that advances the source head across one base-four +digit per iteration. -/ +def positionSlotLoopTM {n : ℕ} + (sourceIdx counterIdx limitIdx : Fin n) : TM n := + TM.binaryForTM (advanceSlotDigitTM sourceIdx) counterIdx limitIdx + +/-- Runtime slot positioner: advance two cells per binary loop iteration, then +one more cell to land on bit `2 * fuel + 1`. -/ +def positionSlotTM {n : ℕ} (sourceIdx counterIdx limitIdx : Fin n) : TM n := + TM.seqTM (positionSlotLoopTM sourceIdx counterIdx limitIdx) + (moveSlotRightTM sourceIdx) + +/-- Exact time of the binary loop that advances across `fuel` base-four +digits. -/ +def positionSlotLoopTime (fuel : ℕ) : ℕ := + TM.binaryForLoopTime (fun _ => 2) fuel 0 fuel + +/-- Exact time bound of loop positioning followed by the final one-cell move. -/ +def positionSlotTime (fuel : ℕ) : ℕ := + positionSlotLoopTime fuel + 1 + 1 + +/-- Shared all-prefix space budget for positioning from a frame bounded by +`initialSpace`. The linear `2 * fuel` term is the address-head displacement; +the smaller `Nat.size` term covers the binary loop controller. -/ +def positionSlotSpace (initialSpace fuel : ℕ) : ℕ := + initialSpace + 2 * fuel + 2 * fuel.size + 6 + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition/Internal.lean new file mode 100644 index 00000000..cfccb843 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotPosition/Internal.lean @@ -0,0 +1,1080 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotPosition.Defs +import Complexitylib.Models.TuringMachine.Hoare.Space +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Barrington slot positioning -- internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +private theorem moveSlotRightWork_apply + (sourceIdx : Fin n) (work : Fin n → Tape) + (hwork : ∀ i, (work i).read ≠ Γ.start) (i : Fin n) : + (fun j => + (work j).writeAndMove (TM.readBackWrite (work j).read) + (if j = sourceIdx then Dir3.right else TM.idleDir (work j).read)) i = + moveSlotRightWork sourceIdx work i := by + by_cases his : i = sourceIdx + · subst i + simp only [moveSlotRightWork, Function.update_self, ↓reduceIte] + exact TM.writeAndMove_readBack (work sourceIdx) (hwork sourceIdx) + Dir3.right + · simp only [moveSlotRightWork, Function.update_of_ne his, if_neg his] + simpa [TM.idleDir, hwork i, Tape.move] using + TM.writeAndMove_readBack (work i) (hwork i) Dir3.stay + +private theorem moveSlotRightTM_step + (sourceIdx : Fin n) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (moveSlotRightTM sourceIdx).step + { state := (moveSlotRightTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } = + some + { state := (moveSlotRightTM sourceIdx).qhalt + input := inp₀ + work := moveSlotRightWork sourceIdx work₀ + output := out₀ } := by + rw [TM.step, if_neg (by simp [moveSlotRightTM])] + simp only [moveSlotRightTM] + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · dsimp only + exact TM.transitionInput_eq_self hinput + · dsimp only + funext i + exact moveSlotRightWork_apply sourceIdx work₀ hwork i + · dsimp only + exact TM.transitionTape_eq_self houtput + +theorem moveSlotRightTM_hoareTime_internal + (sourceIdx : Fin n) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (moveSlotRightTM sourceIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = moveSlotRightWork sourceIdx work₀ ∧ out = out₀) + 1 := by + intro inp work out hpre + obtain ⟨hinp, hworkEq, hout⟩ := hpre + rw [hinp, hworkEq, hout] + have hstep := moveSlotRightTM_step sourceIdx inp₀ work₀ out₀ hinput hwork + houtput + exact ⟨_, 1, le_rfl, .step hstep .zero, rfl, rfl, rfl, rfl⟩ + +private theorem advanceSlotDigitTM_step + (sourceIdx : Fin n) (phase next : AdvanceSlotDigitPhase) + (hphase : phase = .first ∧ next = .second ∨ + phase = .second ∧ next = .done) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (advanceSlotDigitTM sourceIdx).step + { state := phase, input := inp₀, work := work₀, output := out₀ } = + some + { state := next + input := inp₀ + work := moveSlotRightWork sourceIdx work₀ + output := out₀ } := by + rcases hphase with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ <;> + rw [TM.step, if_neg (by simp [advanceSlotDigitTM])] <;> + simp only [advanceSlotDigitTM] <;> + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + all_goals dsimp only + · exact TM.transitionInput_eq_self hinput + · funext i + exact moveSlotRightWork_apply sourceIdx work₀ hwork i + · exact TM.transitionTape_eq_self houtput + · exact TM.transitionInput_eq_self hinput + · funext i + exact moveSlotRightWork_apply sourceIdx work₀ hwork i + · exact TM.transitionTape_eq_self houtput + +theorem advanceSlotDigitTM_reachesIn_frame_internal + (sourceIdx : Fin n) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceNext : ((work₀ sourceIdx).move Dir3.right).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (advanceSlotDigitTM sourceIdx).reachesIn 2 + { state := (advanceSlotDigitTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } + { state := (advanceSlotDigitTM sourceIdx).qhalt + input := inp₀ + work := moveSlotRightWork sourceIdx (moveSlotRightWork sourceIdx work₀) + output := out₀ } := by + let work₁ := moveSlotRightWork sourceIdx work₀ + have hwork₁source : work₁ sourceIdx = + (work₀ sourceIdx).move Dir3.right := by + simp [work₁, moveSlotRightWork] + have hwork₁ : ∀ i, (work₁ i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + rw [hwork₁source] + exact hsourceNext + · simp [work₁, moveSlotRightWork, his] + exact hwork i + have hfirst := advanceSlotDigitTM_step sourceIdx .first .second + (Or.inl ⟨rfl, rfl⟩) inp₀ work₀ out₀ hinput hwork houtput + have hsecond := advanceSlotDigitTM_step sourceIdx .second .done + (Or.inr ⟨rfl, rfl⟩) inp₀ work₁ out₀ hinput hwork₁ houtput + exact .step hfirst (.step (by simpa [work₁] using hsecond) .zero) + +theorem advanceSlotDigitTM_hoareTime_internal + (sourceIdx : Fin n) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceNext : ((work₀ sourceIdx).move Dir3.right).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (advanceSlotDigitTM sourceIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = moveSlotRightWork sourceIdx (moveSlotRightWork sourceIdx work₀) ∧ + out = out₀) + 2 := by + intro inp work out hpre + obtain ⟨hinp, hworkEq, hout⟩ := hpre + rw [hinp, hworkEq, hout] + let final : Cfg n (advanceSlotDigitTM sourceIdx).Q := + { state := .done + input := inp₀ + work := moveSlotRightWork sourceIdx (moveSlotRightWork sourceIdx work₀) + output := out₀ } + refine ⟨final, 2, le_rfl, ?_, ?_, ?_⟩ + · exact advanceSlotDigitTM_reachesIn_frame_internal sourceIdx inp₀ work₀ + out₀ hinput hsourceNext hwork houtput + · rfl + · exact ⟨rfl, rfl, rfl⟩ + +private def positionSlotTapeAt (tape : Tape) (value : ℕ) : Tape := + { tape with head := tape.head + 2 * value } + +private def positionSlotWorkAt (work : Fin n → Tape) + (sourceIdx counterIdx : Fin n) (value : ℕ) : Fin n → Tape := + Function.update + (Function.update work sourceIdx (positionSlotTapeAt (work sourceIdx) value)) + counterIdx ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + +private theorem positionSlotWorkAt_source + (work : Fin n → Tape) (sourceIdx counterIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (value : ℕ) : + positionSlotWorkAt work sourceIdx counterIdx value sourceIdx = + positionSlotTapeAt (work sourceIdx) value := by + simp [positionSlotWorkAt, hsc] + +private theorem positionSlotWorkAt_counter + (work : Fin n → Tape) (sourceIdx counterIdx : Fin n) (value : ℕ) : + (positionSlotWorkAt work sourceIdx counterIdx value counterIdx) + |>.HasBinaryNat value := by + simp only [positionSlotWorkAt, Function.update_self] + exact Tape.init_move_right_hasBinaryNat value + +private theorem positionSlotWorkAt_other + (work : Fin n → Tape) (sourceIdx counterIdx i : Fin n) + (his : i ≠ sourceIdx) (hic : i ≠ counterIdx) (value : ℕ) : + positionSlotWorkAt work sourceIdx counterIdx value i = work i := by + simp [positionSlotWorkAt, his, hic] + +private theorem positionSlotWorkAt_zero_eq + (work : Fin n → Tape) (sourceIdx counterIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) + (hcounter : (work counterIdx).HasBinaryNat 0) : + positionSlotWorkAt work sourceIdx counterIdx 0 = work := by + funext i + by_cases hic : i = counterIdx + · subst i + simp only [positionSlotWorkAt, Function.update_self] + exact (Tape.HasBinaryNat.eq_init_move_right hcounter).symm + by_cases his : i = sourceIdx + · subst i + simp [positionSlotWorkAt, hsc, positionSlotTapeAt] + · exact positionSlotWorkAt_other work sourceIdx counterIdx i his hic 0 + +private theorem positionSlotTapeAt_read_ne_start + {tape : Tape} {slotValue value : ℕ} + (hslot : tape.HasBinaryNat slotValue) : + (positionSlotTapeAt tape value).read ≠ Γ.start := by + rw [Tape.read] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + (tape.head + 2 * value) (by rw [hslot.2.1]; omega) + +private theorem positionSlotTapeAt_move_read_ne_start + {tape : Tape} {slotValue value : ℕ} + (hslot : tape.HasBinaryNat slotValue) : + ((positionSlotTapeAt tape value).move Dir3.right).read ≠ Γ.start := by + rw [Tape.read] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + (tape.head + 2 * value + 1) (by rw [hslot.2.1]; omega) + +private theorem positionSlotWorkAt_read_ne_start + (work : Fin n → Tape) (sourceIdx counterIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (slotValue value : ℕ) + (hslot : (work sourceIdx).HasBinaryNat slotValue) + (hwork : ∀ i, (work i).read ≠ Γ.start) : + ∀ i, (positionSlotWorkAt work sourceIdx counterIdx value i).read ≠ + Γ.start := by + intro i + by_cases hic : i = counterIdx + · subst i + exact (positionSlotWorkAt_counter work sourceIdx counterIdx value).2 + |>.hasBinarySuffix.read_ne_start + by_cases his : i = sourceIdx + · subst i + rw [positionSlotWorkAt_source work sourceIdx counterIdx hsc] + exact positionSlotTapeAt_read_ne_start hslot + · rw [positionSlotWorkAt_other work sourceIdx counterIdx i his hic] + exact hwork i + +private theorem moveSlotRightWork_twice_source + (work : Fin n → Tape) (sourceIdx counterIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (value : ℕ) : + moveSlotRightWork sourceIdx + (moveSlotRightWork sourceIdx + (positionSlotWorkAt work sourceIdx counterIdx value)) sourceIdx = + positionSlotTapeAt (work sourceIdx) (value + 1) := by + rw [moveSlotRightWork, Function.update_self, moveSlotRightWork, + Function.update_self, + positionSlotWorkAt_source work sourceIdx counterIdx hsc] + cases work sourceIdx + simp [positionSlotTapeAt, Tape.move] + omega + +private theorem moveSlotRightWork_twice_counter + (work : Fin n → Tape) (sourceIdx counterIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (value : ℕ) : + moveSlotRightWork sourceIdx + (moveSlotRightWork sourceIdx + (positionSlotWorkAt work sourceIdx counterIdx value)) counterIdx = + positionSlotWorkAt work sourceIdx counterIdx value counterIdx := by + simp [moveSlotRightWork, hsc.symm] + +private theorem moveSlotRightWork_twice_other + (work : Fin n → Tape) (sourceIdx counterIdx i : Fin n) + (his : i ≠ sourceIdx) (hic : i ≠ counterIdx) (value : ℕ) : + moveSlotRightWork sourceIdx + (moveSlotRightWork sourceIdx + (positionSlotWorkAt work sourceIdx counterIdx value)) i = work i := by + simp [moveSlotRightWork, his, + positionSlotWorkAt_other work sourceIdx counterIdx i his hic] + +private def positionSlotScanCfg + (sourceIdx counterIdx limitIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) (value : ℕ) : + Cfg n (positionSlotLoopTM sourceIdx counterIdx limitIdx).Q := + { state := .inl (.scan true) + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx value + output := out } + +private def positionSlotIterationStartCfg + (sourceIdx counterIdx limitIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) (value : ℕ) : + Cfg n (positionSlotLoopTM sourceIdx counterIdx limitIdx).Q := + { state := .inr + (TM.binaryForIterationTM (advanceSlotDigitTM sourceIdx) counterIdx).qstart + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx value + output := out } + +private def positionSlotIterationDoneCfg + (sourceIdx counterIdx limitIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) (value : ℕ) : + Cfg n (positionSlotLoopTM sourceIdx counterIdx limitIdx).Q := + { state := .inr + (TM.binaryForIterationTM (advanceSlotDigitTM sourceIdx) counterIdx).qhalt + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx (value + 1) + output := out } + +private def positionSlotDoneCfg + (sourceIdx counterIdx limitIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) (fuel : ℕ) : + Cfg n (positionSlotLoopTM sourceIdx counterIdx limitIdx).Q := + { state := .inl .done + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx fuel + output := out } + +private theorem positionSlotAdvance_reachesIn + (sourceIdx counterIdx : Fin n) (hsc : sourceIdx ≠ counterIdx) + (slotValue value : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinput : inp.read ≠ Γ.start) + (hslot : (work sourceIdx).HasBinaryNat slotValue) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + (advanceSlotDigitTM sourceIdx).reachesIn 2 + { state := (advanceSlotDigitTM sourceIdx).qstart + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx value + output := out } + { state := (advanceSlotDigitTM sourceIdx).qhalt + input := inp + work := moveSlotRightWork sourceIdx + (moveSlotRightWork sourceIdx + (positionSlotWorkAt work sourceIdx counterIdx value)) + output := out } := by + apply advanceSlotDigitTM_reachesIn_frame_internal sourceIdx inp + · exact hinput + · rw [positionSlotWorkAt_source work sourceIdx counterIdx hsc] + exact positionSlotTapeAt_move_read_ne_start hslot + · exact positionSlotWorkAt_read_ne_start work sourceIdx counterIdx hsc + slotValue value hslot hwork + · exact houtput + +private theorem positionSlotSucc_reachesIn + (sourceIdx counterIdx : Fin n) (hsc : sourceIdx ≠ counterIdx) + (slotValue value : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinput : inp.read ≠ Γ.start) + (hslot : (work sourceIdx).HasBinaryNat slotValue) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + (TM.binarySuccTM counterIdx).reachesIn (TM.binarySuccTime value) + { state := (TM.binarySuccTM counterIdx).qstart + input := inp + work := moveSlotRightWork sourceIdx + (moveSlotRightWork sourceIdx + (positionSlotWorkAt work sourceIdx counterIdx value)) + output := out } + { state := (TM.binarySuccTM counterIdx).qhalt + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx (value + 1) + output := out } := by + let advanced := moveSlotRightWork sourceIdx + (moveSlotRightWork sourceIdx + (positionSlotWorkAt work sourceIdx counterIdx value)) + have hcounter : (advanced counterIdx).HasBinaryNat value := by + rw [show advanced counterIdx = + positionSlotWorkAt work sourceIdx counterIdx value counterIdx by + exact moveSlotRightWork_twice_counter work sourceIdx counterIdx hsc value] + exact positionSlotWorkAt_counter work sourceIdx counterIdx value + have hadvancedRead : ∀ i, (advanced i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + rw [show advanced sourceIdx = + positionSlotTapeAt (work sourceIdx) (value + 1) by + exact moveSlotRightWork_twice_source work sourceIdx counterIdx hsc value] + exact positionSlotTapeAt_read_ne_start hslot + by_cases hic : i = counterIdx + · subst i + exact hcounter.2.hasBinarySuffix.read_ne_start + · rw [show advanced i = work i by + exact moveSlotRightWork_twice_other work sourceIdx counterIdx i his + hic value] + exact hwork i + obtain ⟨c', hreach, hhalt, hinp, hother, hcounter', hout⟩ := + TM.binarySuccTM_reachesIn_frame counterIdx value inp advanced out hcounter + hinput (fun i _ => hadvancedRead i) houtput + have hworkEq : c'.work = + positionSlotWorkAt work sourceIdx counterIdx (value + 1) := by + funext i + by_cases hic : i = counterIdx + · subst i + simp only [positionSlotWorkAt, Function.update_self] + exact Tape.HasBinaryNat.eq_init_move_right hcounter' + by_cases his : i = sourceIdx + · subst i + rw [hother sourceIdx hsc, + positionSlotWorkAt_source work sourceIdx counterIdx hsc] + exact moveSlotRightWork_twice_source work sourceIdx counterIdx hsc value + · rw [hother i hic, + positionSlotWorkAt_other work sourceIdx counterIdx i his hic] + exact moveSlotRightWork_twice_other work sourceIdx counterIdx i his hic + value + have hc' : c' = + { state := (TM.binarySuccTM counterIdx).qhalt + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx (value + 1) + output := out } := + Cfg.ext hhalt hinp hworkEq hout + simpa [advanced, hc'] using hreach + +private theorem positionSlotIteration_reachesIn + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (slotValue value : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinput : inp.read ≠ Γ.start) + (hslot : (work sourceIdx).HasBinaryNat slotValue) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reachesIn + (TM.binaryForIterationTime (fun _ => 2) value) + (positionSlotIterationStartCfg sourceIdx counterIdx limitIdx inp work out + value) + (positionSlotIterationDoneCfg sourceIdx counterIdx limitIdx inp work out + value) := by + let body := advanceSlotDigitTM sourceIdx + let succ := TM.binarySuccTM counterIdx + let current := positionSlotWorkAt work sourceIdx counterIdx value + let advanced := moveSlotRightWork sourceIdx (moveSlotRightWork sourceIdx current) + have hbody := positionSlotAdvance_reachesIn sourceIdx counterIdx hsc + slotValue value inp work out hinput hslot hwork houtput + have hsucc := positionSlotSucc_reachesIn sourceIdx counterIdx hsc + slotValue value inp work out hinput hslot hwork houtput + have hadvancedRead : ∀ i, (advanced i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + rw [show advanced sourceIdx = + positionSlotTapeAt (work sourceIdx) (value + 1) by + exact moveSlotRightWork_twice_source work sourceIdx counterIdx hsc value] + exact positionSlotTapeAt_read_ne_start hslot + by_cases hic : i = counterIdx + · subst i + rw [show advanced counterIdx = current counterIdx by + exact moveSlotRightWork_twice_counter work sourceIdx counterIdx hsc value] + exact (positionSlotWorkAt_counter work sourceIdx counterIdx value).2 + |>.hasBinarySuffix.read_ne_start + · rw [show advanced i = work i by + exact moveSlotRightWork_twice_other work sourceIdx counterIdx i his + hic value] + exact hwork i + obtain ⟨hinpTransition, hworkTransition, houtTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start hinput hadvancedRead houtput + have hsucc' : succ.reachesIn (TM.binarySuccTime value) + { state := succ.qstart + input := TM.transitionInput inp + work := fun i => TM.transitionTape (advanced i) + output := TM.transitionTape out } + { state := succ.qhalt + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx (value + 1) + output := out } := by + rw [hinpTransition, hworkTransition, houtTransition] + exact hsucc + have hseq := TM.seqTM_reachesIn_of_reachesIn body succ hbody rfl hsucc' + have hlift := TM.binaryForTM_iteration_reachesIn_internal body counterIdx + limitIdx hseq + simpa [body, succ, current, advanced, positionSlotLoopTM, + positionSlotIterationStartCfg, positionSlotIterationDoneCfg, + TM.binaryForIterationTime, TM.binaryForIterationTM, + TM.binaryForIterationWrap, TM.phase1Wrap, TM.phase2Wrap] using hlift + +private theorem positionSlotLoopback_step + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (slotValue value : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinput : inp.read ≠ Γ.start) + (hslot : (work sourceIdx).HasBinaryNat slotValue) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).step + (positionSlotIterationDoneCfg sourceIdx counterIdx limitIdx inp work out + value) = + some (positionSlotScanCfg sourceIdx counterIdx limitIdx inp work out + (value + 1)) := by + let iteration := + TM.binaryForIterationTM (advanceSlotDigitTM sourceIdx) counterIdx + let c : Cfg n iteration.Q := + { state := iteration.qhalt + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx (value + 1) + output := out } + have hworkAt := positionSlotWorkAt_read_ne_start work sourceIdx counterIdx hsc + slotValue (value + 1) hslot hwork + have hstep := TM.binaryForTM_step_iteration_halt_internal + (advanceSlotDigitTM sourceIdx) counterIdx limitIdx c rfl hinput hworkAt + houtput + simpa [c, iteration, positionSlotLoopTM, positionSlotIterationDoneCfg, + positionSlotScanCfg, TM.binaryForIterationWrap] using hstep + +private theorem positionSlotTest_reachesIn + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel value : ℕ) (hlt : value < fuel) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinput : inp.read ≠ Γ.start) + (hslot : (work sourceIdx).HasBinaryNat slotValue) + (hlimit : (work limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reachesIn + (TM.binaryForCompareTime fuel) + (positionSlotScanCfg sourceIdx counterIdx limitIdx inp work out value) + (positionSlotIterationStartCfg sourceIdx counterIdx limitIdx inp work out + value) := by + have hlimitAt : + (positionSlotWorkAt work sourceIdx counterIdx value limitIdx) + |>.HasBinaryNat fuel := by + rw [positionSlotWorkAt_other work sourceIdx counterIdx limitIdx hsl.symm + hcl.symm] + exact hlimit + have hrun := TM.binaryForTM_compare_reachesIn_frame_of_lt + (advanceSlotDigitTM sourceIdx) counterIdx limitIdx hcl value fuel hlt inp + (positionSlotWorkAt work sourceIdx counterIdx value) out + (positionSlotWorkAt_counter work sourceIdx counterIdx value) hlimitAt + hinput + (fun i _ _ => positionSlotWorkAt_read_ne_start work sourceIdx counterIdx + hsc slotValue value hslot hwork i) + houtput + simpa [positionSlotLoopTM, positionSlotScanCfg, + positionSlotIterationStartCfg] using hrun + +private theorem positionSlotDone_reachesIn + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinput : inp.read ≠ Γ.start) + (hslot : (work sourceIdx).HasBinaryNat slotValue) + (hlimit : (work limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reachesIn + (TM.binaryForCompareTime fuel) + (positionSlotScanCfg sourceIdx counterIdx limitIdx inp work out fuel) + (positionSlotDoneCfg sourceIdx counterIdx limitIdx inp work out fuel) := by + have hlimitAt : + (positionSlotWorkAt work sourceIdx counterIdx fuel limitIdx) + |>.HasBinaryNat fuel := by + rw [positionSlotWorkAt_other work sourceIdx counterIdx limitIdx hsl.symm + hcl.symm] + exact hlimit + have hrun := TM.binaryForTM_compare_reachesIn_frame_of_eq + (advanceSlotDigitTM sourceIdx) counterIdx limitIdx hcl fuel inp + (positionSlotWorkAt work sourceIdx counterIdx fuel) out + (positionSlotWorkAt_counter work sourceIdx counterIdx fuel) hlimitAt hinput + (fun i _ _ => positionSlotWorkAt_read_ne_start work sourceIdx counterIdx + hsc slotValue fuel hslot hwork i) + houtput + simpa [positionSlotLoopTM, positionSlotScanCfg, positionSlotDoneCfg] using hrun + +private def positionSlotLoopSpec + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinput : inp.read ≠ Γ.start) + (hslot : (work sourceIdx).HasBinaryNat slotValue) + (hlimit : (work limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + TM.BinaryForLoopSpec (advanceSlotDigitTM sourceIdx) counterIdx limitIdx + (fun _ => 2) fuel where + counter_ne_limit := hcl + scanCfg := positionSlotScanCfg sourceIdx counterIdx limitIdx inp work out + iterationStartCfg := + positionSlotIterationStartCfg sourceIdx counterIdx limitIdx inp work out + iterationDoneCfg := + positionSlotIterationDoneCfg sourceIdx counterIdx limitIdx inp work out + doneCfg := positionSlotDoneCfg sourceIdx counterIdx limitIdx inp work out fuel + testRun value hvalue := positionSlotTest_reachesIn sourceIdx counterIdx + limitIdx hsc hcl hsl slotValue fuel value hvalue inp work out hinput hslot + hlimit hwork houtput + iterationRun value _ := positionSlotIteration_reachesIn sourceIdx counterIdx + limitIdx hsc slotValue value inp work out hinput hslot hwork houtput + loopbackStep value _ := positionSlotLoopback_step sourceIdx counterIdx + limitIdx hsc slotValue value inp work out hinput hslot hwork houtput + doneRun := positionSlotDone_reachesIn sourceIdx counterIdx limitIdx hsc hcl + hsl slotValue fuel inp work out hinput hslot hlimit hwork houtput + +theorem positionSlotLoopTM_reachesIn_frame_internal + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reachesIn + (positionSlotLoopTime fuel) + { state := (positionSlotLoopTM sourceIdx counterIdx limitIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } + { state := (positionSlotLoopTM sourceIdx counterIdx limitIdx).qhalt + input := inp₀ + work := positionSlotWorkAt work₀ sourceIdx counterIdx fuel + output := out₀ } := by + let spec := positionSlotLoopSpec sourceIdx counterIdx limitIdx hsc hcl hsl + slotValue fuel inp₀ work₀ out₀ hinput hslot hlimit hwork houtput + have hrun := spec.reachesIn fuel 0 (by omega) + have hstart : spec.scanCfg 0 = + { state := (positionSlotLoopTM sourceIdx counterIdx limitIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } := by + dsimp only [spec, positionSlotLoopSpec, positionSlotScanCfg] + rw [positionSlotWorkAt_zero_eq work₀ sourceIdx counterIdx hsc hcounter] + rfl + rw [hstart] at hrun + simpa [spec, positionSlotLoopSpec, positionSlotDoneCfg, + positionSlotLoopTime, positionSlotLoopTM, TM.binaryForTM] using hrun + +theorem positionSlotLoopTM_hoareTime_internal + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = positionSlotWorkAt work₀ sourceIdx counterIdx fuel ∧ + out = out₀) + (positionSlotLoopTime fuel) := by + intro inp work out hpre + obtain ⟨hinp, hworkEq, hout⟩ := hpre + rw [hinp, hworkEq, hout] + let final : Cfg n (positionSlotLoopTM sourceIdx counterIdx limitIdx).Q := + { state := (positionSlotLoopTM sourceIdx counterIdx limitIdx).qhalt + input := inp₀ + work := positionSlotWorkAt work₀ sourceIdx counterIdx fuel + output := out₀ } + exact ⟨final, positionSlotLoopTime fuel, le_rfl, + positionSlotLoopTM_reachesIn_frame_internal sourceIdx counterIdx limitIdx + hsc hcl hsl slotValue fuel inp₀ work₀ out₀ hinput hslot hcounter hlimit + hwork houtput, + rfl, rfl, rfl, rfl⟩ + +private theorem positionSlotWorkAt_cfg_withinAuxSpace + {Q : Type} (state : Q) (sourceIdx counterIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) + (fuel current inputLength initialSpace : ℕ) (hcurrent : current ≤ fuel) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hcounter : (work counterIdx).HasBinaryNat 0) + (hworkSpace : ∀ i, (work i).head ≤ initialSpace) + (hinputSpace : inp.head ≤ inputLength + initialSpace + 1) : + ({ state := state + input := inp + work := positionSlotWorkAt work sourceIdx counterIdx current + output := out } : Cfg n Q).WithinAuxSpace + inputLength (initialSpace + 2 * fuel) := by + constructor + · intro i + change (positionSlotWorkAt work sourceIdx counterIdx current i).head ≤ + initialSpace + 2 * fuel + by_cases hic : i = counterIdx + · subst i + have hone : 1 ≤ initialSpace := by + rw [← hcounter.2.1] + exact hworkSpace counterIdx + rw [(positionSlotWorkAt_counter work sourceIdx counterIdx current).2.1] + omega + by_cases his : i = sourceIdx + · subst i + rw [positionSlotWorkAt_source work sourceIdx counterIdx hsc] + simp only [positionSlotTapeAt] + have hsourceSpace := hworkSpace sourceIdx + omega + · rw [positionSlotWorkAt_other work sourceIdx counterIdx i his hic] + exact le_trans (hworkSpace i) (by omega) + · change inp.head ≤ inputLength + (initialSpace + 2 * fuel) + 1 + omega + +private def positionSlotLoopSpaceSpec + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + TM.BinaryForLoopSpaceSpec + (positionSlotLoopSpec sourceIdx counterIdx limitIdx hsc hcl hsl + slotValue fuel inp₀ work₀ out₀ hinput hslot hlimit hwork houtput) + inputLength (positionSlotSpace initialSpace fuel) where + testPrefixWithin := by + intro current time cfg hcurrent htime hreach + have hstart : + (positionSlotScanCfg sourceIdx counterIdx limitIdx inp₀ work₀ out₀ + current).WithinAuxSpace inputLength (initialSpace + 2 * fuel) := by + simpa [positionSlotScanCfg] using + positionSlotWorkAt_cfg_withinAuxSpace + (positionSlotScanCfg sourceIdx counterIdx limitIdx inp₀ work₀ out₀ + current).state sourceIdx counterIdx hsc fuel current inputLength + initialSpace hcurrent inp₀ work₀ out₀ hcounter hworkSpace hinputSpace + have hreach' : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reachesIn time + (positionSlotScanCfg sourceIdx counterIdx limitIdx inp₀ work₀ out₀ + current) cfg := by + simpa [positionSlotLoopSpec] using hreach + exact (hstart.reachesIn hreach').mono le_rfl (by + simp [TM.binaryForCompareTime, positionSlotSpace] at htime ⊢ + omega) + iterationPrefixWithin := by + intro current time cfg hcurrent htime hreach + have hcurrentLe : current ≤ fuel := Nat.le_of_lt hcurrent + have hstart : + (positionSlotIterationStartCfg sourceIdx counterIdx limitIdx inp₀ + work₀ out₀ current).WithinAuxSpace inputLength + (initialSpace + 2 * fuel) := by + simpa [positionSlotIterationStartCfg] using + positionSlotWorkAt_cfg_withinAuxSpace + (positionSlotIterationStartCfg sourceIdx counterIdx limitIdx inp₀ + work₀ out₀ current).state sourceIdx counterIdx hsc fuel current + inputLength initialSpace hcurrentLe inp₀ work₀ out₀ hcounter + hworkSpace hinputSpace + have hreach' : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reachesIn time + (positionSlotIterationStartCfg sourceIdx counterIdx limitIdx inp₀ + work₀ out₀ current) cfg := by + simpa [positionSlotLoopSpec] using hreach + have hsucc := TM.binarySuccTime_le current + have hsize := Nat.size_le_size hcurrentLe + exact (hstart.reachesIn hreach').mono le_rfl (by + simp [TM.binaryForIterationTime, positionSlotSpace] at htime ⊢ + omega) + +private theorem positionSlotLoopTM_hoareSpace + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).HoareSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + inputLength (positionSlotSpace initialSpace fuel) := by + intro inp work out hpre cfg hreach + obtain ⟨hinp, hworkEq, hout⟩ := hpre + subst inp + subst work + subst out + obtain ⟨time, hreachIn⟩ := + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reaches_to_reachesIn + hreach + let spec := positionSlotLoopSpec sourceIdx counterIdx limitIdx hsc hcl hsl + slotValue fuel inp₀ work₀ out₀ hinput hslot hlimit hwork houtput + have hstart : spec.scanCfg 0 = + { state := (positionSlotLoopTM sourceIdx counterIdx limitIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } := by + dsimp only [spec, positionSlotLoopSpec, positionSlotScanCfg] + rw [positionSlotWorkAt_zero_eq work₀ sourceIdx counterIdx hsc hcounter] + rfl + have hfull := spec.reachesIn fuel 0 (by omega) + rw [hstart] at hfull + have htime : time ≤ TM.binaryForLoopTime (fun _ => 2) fuel 0 fuel := + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reachesIn_le_halt + hreachIn hfull (by + dsimp only [spec, positionSlotLoopSpec, positionSlotDoneCfg] + rfl) + have hreachSpec : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).reachesIn time + (spec.scanCfg 0) cfg := by + rw [hstart] + exact hreachIn + exact (positionSlotLoopSpaceSpec sourceIdx counterIdx limitIdx hsc hcl hsl + slotValue fuel inputLength initialSpace inp₀ work₀ out₀ hinput hslot + hcounter hlimit hwork houtput hworkSpace hinputSpace) + |>.prefix_withinAuxSpace fuel 0 time cfg (by omega) + (by simpa [spec] using hreachSpec) htime + +theorem positionSlotLoopTM_hoareTimeSpace_internal + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (positionSlotLoopTM sourceIdx counterIdx limitIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = positionSlotWorkAt work₀ sourceIdx counterIdx fuel ∧ + out = out₀) + (positionSlotLoopTime fuel) inputLength + (positionSlotSpace initialSpace fuel) := + (positionSlotLoopTM_hoareTime_internal sourceIdx counterIdx limitIdx hsc hcl + hsl slotValue fuel inp₀ work₀ out₀ hinput hslot hcounter hlimit hwork + houtput).and_hoareSpace + (positionSlotLoopTM_hoareSpace sourceIdx counterIdx limitIdx hsc hcl hsl + slotValue fuel inputLength initialSpace inp₀ work₀ out₀ hinput hslot + hcounter hlimit hwork houtput hworkSpace hinputSpace) + +theorem positionSlotTM_hoareTime_frame_internal + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (positionSlotTM sourceIdx counterIdx limitIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = moveSlotRightWork sourceIdx + (positionSlotWorkAt work₀ sourceIdx counterIdx fuel) ∧ + out = out₀) + (positionSlotTime fuel) := by + let positioned := positionSlotWorkAt work₀ sourceIdx counterIdx fuel + have hpositionedRead : ∀ i, (positioned i).read ≠ Γ.start := + positionSlotWorkAt_read_ne_start work₀ sourceIdx counterIdx hsc slotValue + fuel hslot hwork + have hloop := positionSlotLoopTM_hoareTime_internal sourceIdx counterIdx + limitIdx hsc hcl hsl slotValue fuel inp₀ work₀ out₀ hinput hslot hcounter + hlimit hwork houtput + have hmove := moveSlotRightTM_hoareTime_internal sourceIdx inp₀ positioned + out₀ hinput hpositionedRead houtput + have htransition : ∀ inp work out, + (inp = inp₀ ∧ work = positioned ∧ out = out₀) → + TM.transitionInput inp = inp₀ ∧ + (fun i => TM.transitionTape (work i)) = positioned ∧ + TM.transitionTape out = out₀ := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact TM.phaseTransition_eq_self_of_reads_ne_start hinput hpositionedRead + houtput + simpa [positionSlotTM, positionSlotTime, positioned] using + TM.seqTM_hoareTime _ _ hloop htransition hmove + +theorem positionSlotTM_hoareTime_internal + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (positionSlotTM sourceIdx counterIdx limitIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work sourceIdx).head = (work₀ sourceIdx).head + 2 * fuel + 1 ∧ + (work sourceIdx).cells = (work₀ sourceIdx).cells ∧ + (work counterIdx).HasBinaryNat fuel ∧ + work limitIdx = work₀ limitIdx ∧ + (∀ i, i ≠ sourceIdx → i ≠ counterIdx → i ≠ limitIdx → + work i = work₀ i) ∧ + out = out₀) + (positionSlotTime fuel) := by + have hframe := positionSlotTM_hoareTime_frame_internal sourceIdx counterIdx + limitIdx hsc hcl hsl slotValue fuel inp₀ work₀ out₀ hinput hslot hcounter + hlimit hwork houtput + refine hframe.consequence (fun _ _ _ h => h) (fun inp work out h => ?_) + le_rfl + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨rfl, ?_, ?_, ?_, ?_, ?_, rfl⟩ + · simp [moveSlotRightWork, + positionSlotWorkAt_source work₀ sourceIdx counterIdx hsc, + positionSlotTapeAt, Tape.move] + · simp [moveSlotRightWork, + positionSlotWorkAt_source work₀ sourceIdx counterIdx hsc, + positionSlotTapeAt, Tape.move] + · rw [moveSlotRightWork, Function.update_of_ne hsc.symm] + exact positionSlotWorkAt_counter work₀ sourceIdx counterIdx fuel + · rw [moveSlotRightWork, Function.update_of_ne hsl.symm, + positionSlotWorkAt_other work₀ sourceIdx counterIdx limitIdx hsl.symm + hcl.symm] + · intro i his hic hil + rw [moveSlotRightWork, Function.update_of_ne his, + positionSlotWorkAt_other work₀ sourceIdx counterIdx i his hic] + +theorem positionSlotTM_hoareTimeSpace_internal + (sourceIdx counterIdx limitIdx : Fin n) + (hsc : sourceIdx ≠ counterIdx) (hcl : counterIdx ≠ limitIdx) + (hsl : sourceIdx ≠ limitIdx) + (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat fuel) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (positionSlotTM sourceIdx counterIdx limitIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work sourceIdx).head = (work₀ sourceIdx).head + 2 * fuel + 1 ∧ + (work sourceIdx).cells = (work₀ sourceIdx).cells ∧ + (work counterIdx).HasBinaryNat fuel ∧ + work limitIdx = work₀ limitIdx ∧ + (∀ i, i ≠ sourceIdx → i ≠ counterIdx → i ≠ limitIdx → + work i = work₀ i) ∧ + out = out₀) + (positionSlotTime fuel) inputLength + (positionSlotSpace initialSpace fuel) := by + let positioned := positionSlotWorkAt work₀ sourceIdx counterIdx fuel + have hpositionedRead : ∀ i, (positioned i).read ≠ Γ.start := + positionSlotWorkAt_read_ne_start work₀ sourceIdx counterIdx hsc slotValue + fuel hslot hwork + have hloop := positionSlotLoopTM_hoareTimeSpace_internal sourceIdx counterIdx + limitIdx hsc hcl hsl slotValue fuel inputLength initialSpace inp₀ work₀ + out₀ hinput hslot hcounter hlimit hwork houtput hworkSpace hinputSpace + have hpositionedWithin : + ({ state := (moveSlotRightTM sourceIdx).qstart + input := inp₀ + work := positioned + output := out₀ } : Cfg n (moveSlotRightTM sourceIdx).Q) + |>.WithinAuxSpace inputLength (initialSpace + 2 * fuel) := by + exact positionSlotWorkAt_cfg_withinAuxSpace + (moveSlotRightTM sourceIdx).qstart sourceIdx counterIdx hsc fuel fuel + inputLength initialSpace le_rfl inp₀ work₀ out₀ hcounter hworkSpace + hinputSpace + have hmove := (moveSlotRightTM_hoareTime_internal sourceIdx inp₀ positioned + out₀ hinput hpositionedRead houtput).toHoareTimeSpace (by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact hpositionedWithin) + have htransition : ∀ inp work out, + (inp = inp₀ ∧ work = positioned ∧ out = out₀) → + TM.transitionInput inp = inp₀ ∧ + (fun i => TM.transitionTape (work i)) = positioned ∧ + TM.transitionTape out = out₀ := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact TM.phaseTransition_eq_self_of_reads_ne_start hinput hpositionedRead + houtput + have hseq := TM.seqTM_hoareTimeSpace _ _ hloop htransition hmove + refine hseq.consequence (fun _ _ _ h => h) (fun inp work out h => ?_) + le_rfl le_rfl ?_ + · obtain ⟨rfl, rfl, rfl⟩ := h + dsimp only [positioned] + refine ⟨rfl, ?_, ?_, ?_, ?_, ?_, rfl⟩ + · simp [moveSlotRightWork, + positionSlotWorkAt_source work₀ sourceIdx counterIdx hsc, + positionSlotTapeAt, Tape.move] + · simp [moveSlotRightWork, + positionSlotWorkAt_source work₀ sourceIdx counterIdx hsc, + positionSlotTapeAt, Tape.move] + · rw [moveSlotRightWork, Function.update_of_ne hsc.symm] + exact positionSlotWorkAt_counter work₀ sourceIdx counterIdx fuel + · rw [moveSlotRightWork, Function.update_of_ne hsl.symm, + positionSlotWorkAt_other work₀ sourceIdx counterIdx limitIdx hsl.symm + hcl.symm] + · intro i his hic hil + rw [moveSlotRightWork, Function.update_of_ne his, + positionSlotWorkAt_other work₀ sourceIdx counterIdx i his hic] + · simp [positionSlotSpace] + omega + +theorem moveSlotRightTM_hoareTimeSpace_internal + (sourceIdx : Fin n) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (moveSlotRightTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : Cfg n (moveSlotRightTM sourceIdx).Q) + |>.WithinAuxSpace inputLength initialSpace) : + (moveSlotRightTM sourceIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = moveSlotRightWork sourceIdx work₀ ∧ out = out₀) + 1 inputLength (initialSpace + 1) := by + apply (moveSlotRightTM_hoareTime_internal sourceIdx inp₀ work₀ out₀ hinput + hwork houtput).toHoareTimeSpace + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact hinitial + +theorem advanceSlotDigitTM_hoareTimeSpace_internal + (sourceIdx : Fin n) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hsourceNext : ((work₀ sourceIdx).move Dir3.right).read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (advanceSlotDigitTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : Cfg n (advanceSlotDigitTM sourceIdx).Q) + |>.WithinAuxSpace inputLength initialSpace) : + (advanceSlotDigitTM sourceIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = moveSlotRightWork sourceIdx (moveSlotRightWork sourceIdx work₀) ∧ + out = out₀) + 2 inputLength (initialSpace + 2) := by + apply (advanceSlotDigitTM_hoareTime_internal sourceIdx inp₀ work₀ out₀ hinput + hsourceNext hwork houtput).toHoareTimeSpace + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact hinitial + +theorem moveSlotRightTM_isTransducer_internal (sourceIdx : Fin n) : + (moveSlotRightTM sourceIdx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase <;> cases oHead <;> + simp [moveSlotRightTM, TM.allIdle, TM.idleDir] + +theorem advanceSlotDigitTM_isTransducer_internal (sourceIdx : Fin n) : + (advanceSlotDigitTM sourceIdx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase <;> cases oHead <;> + simp [advanceSlotDigitTM, TM.allIdle, TM.idleDir] + +theorem positionSlotTM_isTransducer_internal + (sourceIdx counterIdx limitIdx : Fin n) : + (positionSlotTM sourceIdx counterIdx limitIdx).IsTransducer := by + exact ((advanceSlotDigitTM_isTransducer_internal sourceIdx).binaryForTM + counterIdx limitIdx).seqTM + (moveSlotRightTM_isTransducer_internal sourceIdx) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep.lean new file mode 100644 index 00000000..fe6a7170 --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotStep.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotStep.Internal + +/-! +# Barrington initial slot step + +This module exposes the end-to-end contract from a parked binary address to +the two canonical raw bits consumed by the recursive four-way dispatcher. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +/-- Initial positioning and capture expose exactly the low and high raw bits +of the requested base-four slot digit. -/ +theorem positionCaptureSlotBitsTM_hoareTime + (layout : BarringtonSlotLayout n) (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (positionCaptureSlotBitsTM layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → i ≠ layout.highIdx → + work i = work₀ i) ∧ + out = out₀) + (positionCaptureSlotBitsTime fuel) := + positionCaptureSlotBitsTM_hoareTime_internal layout slotValue fuel inp₀ work₀ + out₀ hinput hslot hcounter hlimit hlowZero hhighZero hwork houtput + +/-- Initial positioning and capture retain a tight all-prefix space bound: +positioning's certified budget plus the three capture transitions. -/ +theorem positionCaptureSlotBitsTM_hoareTimeSpace + (layout : BarringtonSlotLayout n) (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (positionCaptureSlotBitsTM layout).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → i ≠ layout.highIdx → + work i = work₀ i) ∧ + out = out₀) + (positionCaptureSlotBitsTime fuel) inputLength + (positionCaptureSlotBitsSpace initialSpace fuel) := + positionCaptureSlotBitsTM_hoareTimeSpace_internal layout slotValue fuel + inputLength initialSpace inp₀ work₀ out₀ hinput hslot hcounter hlimit + hlowZero hhighZero hwork houtput hworkSpace hinputSpace + +/-- Initial positioning and capture feed their exact raw bits to the selected +four-way continuation. -/ +theorem barringtonInitialSlotBranchTM_selected_hoareTime + (layout : BarringtonSlotLayout n) (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + {post : TapePred n} {selectedTime : ℕ} + (hselected : + (barringtonSlotContinuation reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = + (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + post selectedTime) : + (barringtonInitialSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + post (barringtonInitialSlotBranchTime fuel selectedTime) := + barringtonInitialSlotBranchTM_selected_hoareTime_internal layout reversed + onLeft onRight onInverseLeft onInverseRight slotValue fuel inp₀ work₀ out₀ + hinput hslot hcounter hlimit hlowZero hhighZero hwork houtput hselected + +/-- Initial positioning, exact bit capture, and two-step dispatch add no space +beyond the certified capture budget and the selected continuation's budget. -/ +theorem barringtonInitialSlotBranchTM_selected_hoareTimeSpace + (layout : BarringtonSlotLayout n) (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) + {post : TapePred n} {selectedTime : ℕ} + (hselected : + (barringtonSlotContinuation reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight).HoareTimeSpace + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = + (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + post selectedTime inputLength + (positionCaptureSlotBitsSpace initialSpace fuel)) : + (barringtonInitialSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + post (barringtonInitialSlotBranchTime fuel selectedTime) inputLength + (positionCaptureSlotBitsSpace initialSpace fuel) := + barringtonInitialSlotBranchTM_selected_hoareTimeSpace_internal layout + reversed onLeft onRight onInverseLeft onInverseRight slotValue fuel + inputLength initialSpace inp₀ work₀ out₀ hinput hslot hcounter hlimit + hlowZero hhighZero hwork houtput hworkSpace hinputSpace hselected + +/-- The initial slot controller selects the semantic child named by a +`BarringtonSlotCursor`; callers need not expose the underlying raw bits. -/ +theorem barringtonInitialSlotBranchTM_cursor_hoareTimeSpace + (layout : BarringtonSlotLayout n) (cursor : BarringtonSlotCursor) + (onLeft onRight onInverseLeft onInverseRight : TM n) + (fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat cursor.slot) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) + {post : TapePred n} {selectedTime : ℕ} + (hselected : + (if cursor.selectsInverse fuel then + if cursor.selectsRight fuel then onInverseRight else onInverseLeft + else if cursor.selectsRight fuel then onRight else onLeft + ).HoareTimeSpace + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = + (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if cursor.slot.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if cursor.slot.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + post selectedTime inputLength + (positionCaptureSlotBitsSpace initialSpace fuel)) : + (barringtonInitialSlotBranchTM layout cursor.reversed onLeft onRight + onInverseLeft onInverseRight).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + post (barringtonInitialSlotBranchTime fuel selectedTime) inputLength + (positionCaptureSlotBitsSpace initialSpace fuel) := by + rw [← barringtonSlotContinuation_cursor cursor fuel onLeft onRight + onInverseLeft onInverseRight] at hselected + exact barringtonInitialSlotBranchTM_selected_hoareTimeSpace layout + cursor.reversed onLeft onRight onInverseLeft onInverseRight cursor.slot fuel + inputLength initialSpace inp₀ work₀ out₀ hinput hslot hcounter hlimit + hlowZero hhighZero hwork houtput hworkSpace hinputSpace hselected + +/-- Initial positioning and capture preserve one-way output behavior. -/ +theorem positionCaptureSlotBitsTM_isTransducer + (layout : BarringtonSlotLayout n) : + (positionCaptureSlotBitsTM layout).IsTransducer := + positionCaptureSlotBitsTM_isTransducer_internal layout + +/-- The complete initial slot branch is one-way on output when all four +continuations are. -/ +theorem barringtonInitialSlotBranchTM_isTransducer + (layout : BarringtonSlotLayout n) (reversed : Bool) + {onLeft onRight onInverseLeft onInverseRight : TM n} + (hleft : onLeft.IsTransducer) (hright : onRight.IsTransducer) + (hinverseLeft : onInverseLeft.IsTransducer) + (hinverseRight : onInverseRight.IsTransducer) : + (barringtonInitialSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).IsTransducer := + barringtonInitialSlotBranchTM_isTransducer_internal layout reversed hleft + hright hinverseLeft hinverseRight + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep/Defs.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep/Defs.lean new file mode 100644 index 00000000..ba179f2a --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep/Defs.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotBranch.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotCapture.Defs +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotPosition.Defs + +/-! +# Barrington initial slot step -- definitions + +The initial recursive slot step positions a preserved canonical address on its +highest relevant base-four digit, captures that digit's two raw bits, and then +hands the canonical bit tapes to the four-way continuation dispatcher. +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +/-- Five structurally distinct tapes used by the initial slot controller. + +The role order is source address, loop counter, preserved fuel, captured low +bit, and captured high bit. -/ +structure BarringtonSlotLayout (controllerTapes : ℕ) where + /-- Injective assignment of the five logical slot-controller roles. -/ + roles : Fin 5 ↪ Fin controllerTapes + +/-- Preserved binary slot-address tape. -/ +def BarringtonSlotLayout.sourceIdx + (layout : BarringtonSlotLayout controllerTapes) : Fin controllerTapes := + layout.roles 0 + +/-- Scratch counter used to position the source address. -/ +def BarringtonSlotLayout.counterIdx + (layout : BarringtonSlotLayout controllerTapes) : Fin controllerTapes := + layout.roles 1 + +/-- Preserved binary recursion fuel. -/ +def BarringtonSlotLayout.limitIdx + (layout : BarringtonSlotLayout controllerTapes) : Fin controllerTapes := + layout.roles 2 + +/-- Canonical captured low-bit tape. -/ +def BarringtonSlotLayout.lowIdx + (layout : BarringtonSlotLayout controllerTapes) : Fin controllerTapes := + layout.roles 3 + +/-- Canonical captured high-bit tape. -/ +def BarringtonSlotLayout.highIdx + (layout : BarringtonSlotLayout controllerTapes) : Fin controllerTapes := + layout.roles 4 + +/-- Position the address on the current high bit, then capture the adjacent +high/low base-four digit. -/ +def positionCaptureSlotBitsTM {n : ℕ} (layout : BarringtonSlotLayout n) : TM n := + TM.seqTM + (positionSlotTM layout.sourceIdx layout.counterIdx layout.limitIdx) + (captureSlotBitsTM layout.sourceIdx layout.lowIdx layout.highIdx) + +/-- Exact time bound for initial positioning and adjacent bit capture. -/ +def positionCaptureSlotBitsTime (fuel : ℕ) : ℕ := + positionSlotTime fuel + 1 + 3 + +/-- All-prefix space budget for initial positioning and bit capture. -/ +def positionCaptureSlotBitsSpace (initialSpace fuel : ℕ) : ℕ := + positionSlotSpace initialSpace fuel + 3 + +/-- Position and capture the current raw digit, then dispatch through its two +bits and the finite-control reflection flag. -/ +def barringtonInitialSlotBranchTM {n : ℕ} + (layout : BarringtonSlotLayout n) (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) : TM n := + TM.seqTM (positionCaptureSlotBitsTM layout) + (barringtonSlotBranchTM layout.lowIdx layout.highIdx reversed + onLeft onRight onInverseLeft onInverseRight) + +/-- Time bound of initial positioning, capture, two dispatch transitions, and +the selected continuation. -/ +def barringtonInitialSlotBranchTime (fuel selectedTime : ℕ) : ℕ := + positionCaptureSlotBitsTime fuel + 1 + (selectedTime + 2) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep/Internal.lean b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep/Internal.lean new file mode 100644 index 00000000..8846005c --- /dev/null +++ b/Complexitylib/Circuits/BranchingProgramEncoding/Machine/SlotStep/Internal.lean @@ -0,0 +1,669 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotCapture +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotPosition +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotBranch +import Complexitylib.Circuits.BranchingProgramEncoding.Machine.SlotStep.Defs + +/-! +# Barrington initial slot step -- internals +-/ + +namespace Complexity + +namespace BPCode + +namespace Machine + +open TM + +theorem positionCaptureSlotBitsTM_hoareTime_internal + (layout : BarringtonSlotLayout n) (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (positionCaptureSlotBitsTM layout).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → i ≠ layout.highIdx → + work i = work₀ i) ∧ + out = out₀) + (positionCaptureSlotBitsTime fuel) := by + have hrole : ∀ i j : Fin 5, i ≠ j → layout.roles i ≠ layout.roles j := + fun _ _ hij => layout.roles.injective.ne hij + have hsc : layout.sourceIdx ≠ layout.counterIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.counterIdx + exact hrole 0 1 (by decide) + have hslimit : layout.sourceIdx ≠ layout.limitIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.limitIdx + exact hrole 0 2 (by decide) + have hslow : layout.sourceIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.lowIdx + exact hrole 0 3 (by decide) + have hshigh : layout.sourceIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.highIdx + exact hrole 0 4 (by decide) + have hclimit : layout.counterIdx ≠ layout.limitIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.limitIdx + exact hrole 1 2 (by decide) + have hclow : layout.counterIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.lowIdx + exact hrole 1 3 (by decide) + have hchigh : layout.counterIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.highIdx + exact hrole 1 4 (by decide) + have hlimitLow : layout.limitIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.limitIdx BarringtonSlotLayout.lowIdx + exact hrole 2 3 (by decide) + have hlimitHigh : layout.limitIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.limitIdx BarringtonSlotLayout.highIdx + exact hrole 2 4 (by decide) + have hlowHigh : layout.lowIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.lowIdx BarringtonSlotLayout.highIdx + exact hrole 3 4 (by decide) + let positioned : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel + 1 ∧ + (work layout.sourceIdx).cells = (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → work i = work₀ i) ∧ + out = out₀ + have hposition := positionSlotTM_hoareTime layout.sourceIdx + layout.counterIdx layout.limitIdx hsc hclimit hslimit slotValue fuel inp₀ + work₀ out₀ hinput hslot hcounter hlimit hwork houtput + have hpositionedReads : ∀ inp work out, positioned inp work out → + ∀ i, (work i).read ≠ Γ.start := by + intro inp work out hpos i + rcases hpos with ⟨-, hsourceHead, hsourceCells, hcounterFuel, + hlimitEq, hother, -⟩ + by_cases his : i = layout.sourceIdx + · subst i + rw [Tape.read, hsourceCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + ((work layout.sourceIdx).head) (by rw [hsourceHead, hslot.2.1]; omega) + by_cases hic : i = layout.counterIdx + · subst i + exact hcounterFuel.2.hasBinarySuffix.read_ne_start + by_cases hil : i = layout.limitIdx + · subst i + rw [hlimitEq] + exact hwork layout.limitIdx + · rw [hother i his hic hil] + exact hwork i + have hcapture : + (captureSlotBitsTM layout.sourceIdx layout.lowIdx layout.highIdx) + |>.HoareTime positioned + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = + (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + 3 := by + intro inp work out hpos + rcases hpos with ⟨hinp, hsourceHead, hsourceCells, hcounterFuel, + hlimitEq, hother, hout⟩ + have hlowEq : work layout.lowIdx = work₀ layout.lowIdx := + hother layout.lowIdx hslow.symm hclow.symm hlimitLow.symm + have hhighEq : work layout.highIdx = work₀ layout.highIdx := + hother layout.highIdx hshigh.symm hchigh.symm hlimitHigh.symm + have hsourceHighRead : (work layout.sourceIdx).read ≠ Γ.start := + hpositionedReads inp work out + ⟨hinp, hsourceHead, hsourceCells, hcounterFuel, hlimitEq, hother, hout⟩ + layout.sourceIdx + have hsourceLowRead : + ((work layout.sourceIdx).move Dir3.left).read ≠ Γ.start := by + simp only [Tape.read, Tape.move] + rw [hsourceCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + ((work layout.sourceIdx).head - 1) + (by rw [hsourceHead, hslot.2.1]; omega) + have hrun := captureSlotBitsTM_hoareTime layout.sourceIdx layout.lowIdx + layout.highIdx hslow hshigh hlowHigh inp work out + (by rw [hinp]; exact hinput) hsourceHighRead hsourceLowRead + (hpositionedReads inp work out + ⟨hinp, hsourceHead, hsourceCells, hcounterFuel, hlimitEq, hother, hout⟩) + (by rw [hlowEq]; exact hlowZero) (by rw [hhighEq]; exact hhighZero) + (by rw [hout]; exact houtput) + obtain ⟨c, time, htime, hreach, hhalt, hpost⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + rcases hpost with ⟨hfinalInput, hfinalSource, hfinalLow, hfinalHigh, + hfinalOther, hfinalOutput⟩ + have hhighBit : slotBitAtHead (work layout.sourceIdx) = + slotValue.testBit (2 * fuel + 1) := by + apply slotBitAtHead_eq_testBit_of_cells + (work layout.sourceIdx) (work₀ layout.sourceIdx) slotValue + (2 * fuel + 1) hslot hsourceCells + rw [hsourceHead, hslot.2.1] + omega + have hlowBit : slotBitAtHead ((work layout.sourceIdx).move Dir3.left) = + slotValue.testBit (2 * fuel) := by + apply slotBitAtHead_eq_testBit_of_cells + ((work layout.sourceIdx).move Dir3.left) (work₀ layout.sourceIdx) + slotValue (2 * fuel) hslot + · exact hsourceCells + · simp only [Tape.move] + rw [hsourceHead, hslot.2.1] + omega + refine ⟨c, time, htime, hreach, hhalt, hfinalInput.trans hinp, ?_, ?_, ?_, + ?_, ?_, ?_, ?_, hfinalOutput.trans hout⟩ + · rw [hfinalSource] + simp only [Tape.move] + rw [hsourceHead, hslot.2.1] + omega + · rw [hfinalSource, Tape.move_cells] + exact hsourceCells + · rw [hfinalOther layout.counterIdx hsc.symm hclow hchigh] + exact hcounterFuel + · rw [hfinalOther layout.limitIdx hslimit.symm hlimitLow hlimitHigh] + exact hlimitEq + · simpa [hlowBit] using hfinalLow + · simpa [hhighBit] using hfinalHigh + · intro i his hic hil hilow hihigh + rw [hfinalOther i his hilow hihigh] + exact hother i his hic hil + have htransition : ∀ inp work out, positioned inp work out → + positioned (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out hpos + rcases hpos with ⟨hinp, hsourceHead, hsourceCells, hcounterFuel, + hlimitEq, hother, hout⟩ + have hpos' : positioned inp work out := + ⟨hinp, hsourceHead, hsourceCells, hcounterFuel, hlimitEq, hother, hout⟩ + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) (hpositionedReads inp work out hpos') + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact hpos' + simpa [positionCaptureSlotBitsTM, positionCaptureSlotBitsTime, positioned] + using TM.seqTM_hoareTime _ _ hposition htransition hcapture + +theorem positionCaptureSlotBitsTM_hoareTimeSpace_internal + (layout : BarringtonSlotLayout n) (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (positionCaptureSlotBitsTM layout).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → i ≠ layout.highIdx → + work i = work₀ i) ∧ + out = out₀) + (positionCaptureSlotBitsTime fuel) inputLength + (positionCaptureSlotBitsSpace initialSpace fuel) := by + have hrole : ∀ i j : Fin 5, i ≠ j → layout.roles i ≠ layout.roles j := + fun _ _ hij => layout.roles.injective.ne hij + have hsc : layout.sourceIdx ≠ layout.counterIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.counterIdx + exact hrole 0 1 (by decide) + have hslimit : layout.sourceIdx ≠ layout.limitIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.limitIdx + exact hrole 0 2 (by decide) + have hslow : layout.sourceIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.lowIdx + exact hrole 0 3 (by decide) + have hshigh : layout.sourceIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.highIdx + exact hrole 0 4 (by decide) + have hclimit : layout.counterIdx ≠ layout.limitIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.limitIdx + exact hrole 1 2 (by decide) + have hclow : layout.counterIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.lowIdx + exact hrole 1 3 (by decide) + have hchigh : layout.counterIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.highIdx + exact hrole 1 4 (by decide) + have hlimitLow : layout.limitIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.limitIdx BarringtonSlotLayout.lowIdx + exact hrole 2 3 (by decide) + have hlimitHigh : layout.limitIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.limitIdx BarringtonSlotLayout.highIdx + exact hrole 2 4 (by decide) + have hlowHigh : layout.lowIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.lowIdx BarringtonSlotLayout.highIdx + exact hrole 3 4 (by decide) + let positioned : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel + 1 ∧ + (work layout.sourceIdx).cells = (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → work i = work₀ i) ∧ + out = out₀ + have hpositionedReads : ∀ inp work out, positioned inp work out → + ∀ i, (work i).read ≠ Γ.start := by + intro inp work out hpos i + rcases hpos with ⟨-, hsourceHead, hsourceCells, hcounterFuel, + hlimitEq, hother, -⟩ + by_cases his : i = layout.sourceIdx + · subst i + rw [Tape.read, hsourceCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + ((work layout.sourceIdx).head) (by rw [hsourceHead, hslot.2.1]; omega) + by_cases hic : i = layout.counterIdx + · subst i + exact hcounterFuel.2.hasBinarySuffix.read_ne_start + by_cases hil : i = layout.limitIdx + · subst i + rw [hlimitEq] + exact hwork layout.limitIdx + · rw [hother i his hic hil] + exact hwork i + have hposition := positionSlotTM_hoareTimeSpace layout.sourceIdx + layout.counterIdx layout.limitIdx hsc hclimit hslimit slotValue fuel + inputLength initialSpace inp₀ work₀ out₀ hinput hslot hcounter hlimit hwork + houtput hworkSpace hinputSpace + have hcaptureTime : + (captureSlotBitsTM layout.sourceIdx layout.lowIdx layout.highIdx) + |>.HoareTime positioned (fun _ _ _ => True) 3 := by + intro inp work out hpos + rcases hpos with ⟨hinp, hsourceHead, hsourceCells, hcounterFuel, + hlimitEq, hother, hout⟩ + have hlowEq : work layout.lowIdx = work₀ layout.lowIdx := + hother layout.lowIdx hslow.symm hclow.symm hlimitLow.symm + have hhighEq : work layout.highIdx = work₀ layout.highIdx := + hother layout.highIdx hshigh.symm hchigh.symm hlimitHigh.symm + have hsourceLowRead : + ((work layout.sourceIdx).move Dir3.left).read ≠ Γ.start := by + simp only [Tape.read, Tape.move] + rw [hsourceCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + ((work layout.sourceIdx).head - 1) + (by rw [hsourceHead, hslot.2.1]; omega) + have hrun := captureSlotBitsTM_hoareTime layout.sourceIdx layout.lowIdx + layout.highIdx hslow hshigh hlowHigh inp work out + (by rw [hinp]; exact hinput) + (hpositionedReads inp work out + ⟨hinp, hsourceHead, hsourceCells, hcounterFuel, hlimitEq, hother, hout⟩ + layout.sourceIdx) + hsourceLowRead + (hpositionedReads inp work out + ⟨hinp, hsourceHead, hsourceCells, hcounterFuel, hlimitEq, hother, hout⟩) + (by rw [hlowEq]; exact hlowZero) (by rw [hhighEq]; exact hhighZero) + (by rw [hout]; exact houtput) + obtain ⟨c, time, htime, hreach, hhalt, -⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨c, time, htime, hreach, hhalt, trivial⟩ + have hpositionedWithin : ∀ inp work out, positioned inp work out → + ({ state := + (captureSlotBitsTM layout.sourceIdx layout.lowIdx layout.highIdx).qstart, + input := inp, + work := work, + output := out } : + Cfg n (captureSlotBitsTM layout.sourceIdx layout.lowIdx + layout.highIdx).Q).WithinAuxSpace inputLength + (positionSlotSpace initialSpace fuel) := by + intro inp work out hpos + rcases hpos with ⟨hinp, hsourceHead, -, hcounterFuel, hlimitEq, hother, -⟩ + constructor + · intro i + by_cases his : i = layout.sourceIdx + · subst i + change (work layout.sourceIdx).head ≤ positionSlotSpace initialSpace fuel + have hsourceInitial := hworkSpace layout.sourceIdx + rw [hsourceHead] + simp [positionSlotSpace] + omega + by_cases hic : i = layout.counterIdx + · subst i + change (work layout.counterIdx).head ≤ positionSlotSpace initialSpace fuel + rw [hcounterFuel.2.1] + have hone : 1 ≤ initialSpace := by + rw [← hcounter.2.1] + exact hworkSpace layout.counterIdx + simp [positionSlotSpace] + by_cases hil : i = layout.limitIdx + · subst i + change (work layout.limitIdx).head ≤ positionSlotSpace initialSpace fuel + rw [hlimitEq] + exact le_trans (hworkSpace layout.limitIdx) (by + simp [positionSlotSpace]; omega) + · change (work i).head ≤ positionSlotSpace initialSpace fuel + rw [hother i his hic hil] + exact le_trans (hworkSpace i) (by simp [positionSlotSpace]; omega) + · change inp.head ≤ inputLength + positionSlotSpace initialSpace fuel + 1 + rw [hinp] + exact le_trans hinputSpace (by simp [positionSlotSpace]; omega) + have hcaptureSpace := hcaptureTime.toHoareTimeSpace hpositionedWithin + have htransition : ∀ inp work out, positioned inp work out → + positioned (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out hpos + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + (inp := inp) (work := work) (out := out) + (by rw [hpos.1]; exact hinput) (hpositionedReads inp work out hpos) + (by rw [hpos.2.2.2.2.2.2]; exact houtput) + rw [hi, hw, ho] + exact hpos + have hseq := TM.seqTM_hoareTimeSpace _ _ hposition htransition hcaptureSpace + have htime := positionCaptureSlotBitsTM_hoareTime_internal layout slotValue + fuel inp₀ work₀ out₀ hinput hslot hcounter hlimit hlowZero hhighZero hwork + houtput + refine htime.and_hoareSpace ?_ + simpa [positionCaptureSlotBitsTM, positionCaptureSlotBitsSpace, positioned] + using hseq.2 + +theorem barringtonInitialSlotBranchTM_selected_hoareTime_internal + (layout : BarringtonSlotLayout n) (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + (slotValue fuel : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + {post : TapePred n} {selectedTime : ℕ} + (hselected : + (barringtonSlotContinuation reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = + (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + post selectedTime) : + (barringtonInitialSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + post (barringtonInitialSlotBranchTime fuel selectedTime) := by + have hrole : ∀ i j : Fin 5, i ≠ j → layout.roles i ≠ layout.roles j := + fun _ _ hij => layout.roles.injective.ne hij + have hsc : layout.sourceIdx ≠ layout.counterIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.counterIdx + exact hrole 0 1 (by decide) + have hslimit : layout.sourceIdx ≠ layout.limitIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.limitIdx + exact hrole 0 2 (by decide) + have hslow : layout.sourceIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.lowIdx + exact hrole 0 3 (by decide) + have hshigh : layout.sourceIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.sourceIdx BarringtonSlotLayout.highIdx + exact hrole 0 4 (by decide) + have hclimit : layout.counterIdx ≠ layout.limitIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.limitIdx + exact hrole 1 2 (by decide) + have hclow : layout.counterIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.lowIdx + exact hrole 1 3 (by decide) + have hchigh : layout.counterIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.counterIdx BarringtonSlotLayout.highIdx + exact hrole 1 4 (by decide) + have hlimitLow : layout.limitIdx ≠ layout.lowIdx := by + unfold BarringtonSlotLayout.limitIdx BarringtonSlotLayout.lowIdx + exact hrole 2 3 (by decide) + have hlimitHigh : layout.limitIdx ≠ layout.highIdx := by + unfold BarringtonSlotLayout.limitIdx BarringtonSlotLayout.highIdx + exact hrole 2 4 (by decide) + let captured : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → i ≠ layout.highIdx → + work i = work₀ i) ∧ + out = out₀ + have hcapture := positionCaptureSlotBitsTM_hoareTime_internal layout + slotValue fuel inp₀ work₀ out₀ hinput hslot hcounter hlimit hlowZero + hhighZero hwork houtput + have hcapturedReads : ∀ inp work out, captured inp work out → + ∀ i, (work i).read ≠ Γ.start := by + intro inp work out hcap i + rcases hcap with ⟨-, hsourceHead, hsourceCells, hcounterFuel, + hlimitEq, hlow, hhigh, hother, -⟩ + by_cases his : i = layout.sourceIdx + · subst i + rw [Tape.read, hsourceCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + ((work layout.sourceIdx).head) (by rw [hsourceHead, hslot.2.1]; omega) + by_cases hic : i = layout.counterIdx + · subst i + exact hcounterFuel.2.hasBinarySuffix.read_ne_start + by_cases hil : i = layout.limitIdx + · subst i + rw [hlimitEq] + exact hwork layout.limitIdx + by_cases hilow : i = layout.lowIdx + · subst i + exact hlow.2.hasBinarySuffix.read_ne_start + by_cases hihigh : i = layout.highIdx + · subst i + exact hhigh.2.hasBinarySuffix.read_ne_start + · rw [hother i his hic hil hilow hihigh] + exact hwork i + have hbranch := barringtonSlotBranchTM_selected_hoareTime layout.lowIdx + layout.highIdx reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight + (fun inp work out hcap => by rw [hcap.1]; exact hinput) + hcapturedReads + (fun inp work out hcap => by rw [hcap.2.2.2.2.2.2.2.2]; exact houtput) + (fun _ _ _ hcap => hcap.2.2.2.2.2.1) + (fun _ _ _ hcap => hcap.2.2.2.2.2.2.1) + hselected + have htransition : ∀ inp work out, captured inp work out → + captured (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out hcap + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + (inp := inp) (work := work) (out := out) + (by rw [hcap.1]; exact hinput) (hcapturedReads inp work out hcap) + (by rw [hcap.2.2.2.2.2.2.2.2]; exact houtput) + rw [hi, hw, ho] + exact hcap + simpa [barringtonInitialSlotBranchTM, barringtonInitialSlotBranchTime, + captured] using TM.seqTM_hoareTime _ _ hcapture htransition hbranch + +theorem barringtonInitialSlotBranchTM_selected_hoareTimeSpace_internal + (layout : BarringtonSlotLayout n) (reversed : Bool) + (onLeft onRight onInverseLeft onInverseRight : TM n) + (slotValue fuel inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.read ≠ Γ.start) + (hslot : (work₀ layout.sourceIdx).HasBinaryNat slotValue) + (hcounter : (work₀ layout.counterIdx).HasBinaryNat 0) + (hlimit : (work₀ layout.limitIdx).HasBinaryNat fuel) + (hlowZero : (work₀ layout.lowIdx).HasBinaryNat 0) + (hhighZero : (work₀ layout.highIdx).HasBinaryNat 0) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) + {post : TapePred n} {selectedTime : ℕ} + (hselected : + (barringtonSlotContinuation reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight).HoareTimeSpace + (fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = + (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → + i ≠ layout.highIdx → work i = work₀ i) ∧ + out = out₀) + post selectedTime inputLength + (positionCaptureSlotBitsSpace initialSpace fuel)) : + (barringtonInitialSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + post (barringtonInitialSlotBranchTime fuel selectedTime) inputLength + (positionCaptureSlotBitsSpace initialSpace fuel) := by + let captured : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work layout.sourceIdx).head = + (work₀ layout.sourceIdx).head + 2 * fuel ∧ + (work layout.sourceIdx).cells = (work₀ layout.sourceIdx).cells ∧ + (work layout.counterIdx).HasBinaryNat fuel ∧ + work layout.limitIdx = work₀ layout.limitIdx ∧ + (work layout.lowIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel) then 1 else 0) ∧ + (work layout.highIdx).HasBinaryNat + (if slotValue.testBit (2 * fuel + 1) then 1 else 0) ∧ + (∀ i, i ≠ layout.sourceIdx → i ≠ layout.counterIdx → + i ≠ layout.limitIdx → i ≠ layout.lowIdx → i ≠ layout.highIdx → + work i = work₀ i) ∧ + out = out₀ + have hcapture := positionCaptureSlotBitsTM_hoareTimeSpace_internal layout + slotValue fuel inputLength initialSpace inp₀ work₀ out₀ hinput hslot + hcounter hlimit hlowZero hhighZero hwork houtput hworkSpace hinputSpace + have hcapturedReads : ∀ inp work out, captured inp work out → + ∀ i, (work i).read ≠ Γ.start := by + intro inp work out hcap i + rcases hcap with ⟨-, hsourceHead, hsourceCells, hcounterFuel, + hlimitEq, hlow, hhigh, hother, -⟩ + by_cases his : i = layout.sourceIdx + · subst i + rw [Tape.read, hsourceCells] + exact Tape.HasBinaryContent.cells_ne_start hslot.2.2 + ((work layout.sourceIdx).head) (by rw [hsourceHead, hslot.2.1]; omega) + by_cases hic : i = layout.counterIdx + · subst i + exact hcounterFuel.2.hasBinarySuffix.read_ne_start + by_cases hil : i = layout.limitIdx + · subst i + rw [hlimitEq] + exact hwork layout.limitIdx + by_cases hilow : i = layout.lowIdx + · subst i + exact hlow.2.hasBinarySuffix.read_ne_start + by_cases hihigh : i = layout.highIdx + · subst i + exact hhigh.2.hasBinarySuffix.read_ne_start + · rw [hother i his hic hil hilow hihigh] + exact hwork i + have hbranch := barringtonSlotBranchTM_selected_hoareTimeSpace layout.lowIdx + layout.highIdx reversed (slotValue.testBit (2 * fuel)) + (slotValue.testBit (2 * fuel + 1)) onLeft onRight onInverseLeft + onInverseRight + (fun inp work out hcap => by rw [hcap.1]; exact hinput) + hcapturedReads + (fun inp work out hcap => by rw [hcap.2.2.2.2.2.2.2.2]; exact houtput) + (fun _ _ _ hcap => hcap.2.2.2.2.2.1) + (fun _ _ _ hcap => hcap.2.2.2.2.2.2.1) + hselected + have htransition : ∀ inp work out, captured inp work out → + captured (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out hcap + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + (inp := inp) (work := work) (out := out) + (by rw [hcap.1]; exact hinput) (hcapturedReads inp work out hcap) + (by rw [hcap.2.2.2.2.2.2.2.2]; exact houtput) + rw [hi, hw, ho] + exact hcap + simpa [barringtonInitialSlotBranchTM, barringtonInitialSlotBranchTime, + captured] using TM.seqTM_hoareTimeSpace _ _ hcapture htransition hbranch + +theorem positionCaptureSlotBitsTM_isTransducer_internal + (layout : BarringtonSlotLayout n) : + (positionCaptureSlotBitsTM layout).IsTransducer := by + exact (positionSlotTM_isTransducer layout.sourceIdx layout.counterIdx + layout.limitIdx).seqTM + (captureSlotBitsTM_isTransducer layout.sourceIdx layout.lowIdx + layout.highIdx) + +theorem barringtonInitialSlotBranchTM_isTransducer_internal + (layout : BarringtonSlotLayout n) (reversed : Bool) + {onLeft onRight onInverseLeft onInverseRight : TM n} + (hleft : onLeft.IsTransducer) (hright : onRight.IsTransducer) + (hinverseLeft : onInverseLeft.IsTransducer) + (hinverseRight : onInverseRight.IsTransducer) : + (barringtonInitialSlotBranchTM layout reversed onLeft onRight onInverseLeft + onInverseRight).IsTransducer := by + exact (positionCaptureSlotBitsTM_isTransducer_internal layout).seqTM + (barringtonSlotBranchTM_isTransducer layout.lowIdx layout.highIdx reversed + hleft hright hinverseLeft hinverseRight) + +end Machine + +end BPCode + +end Complexity diff --git a/Complexitylib/Circuits/CircuitFormula.lean b/Complexitylib/Circuits/CircuitFormula.lean new file mode 100644 index 00000000..89b516f7 --- /dev/null +++ b/Complexitylib/Circuits/CircuitFormula.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.CircuitFormula.Defs +import Complexitylib.Circuits.CircuitFormula.Internal + +/-! +# Unfolding fan-in-two circuit outputs into Boolean formulas + +This module recursively unfolds a selected wire or output of a typed fan-in-two +AND/OR circuit into a `BoolFormula`. The translation preserves evaluation +exactly. Since edge negations are explicit formula nodes, formula depth is at +most twice the corresponding circuit depth. + +Circuit gates form a DAG, while formulas are trees. Consequently this unfolding +duplicates shared subcircuits, and these theorems deliberately make no formula +size claim. + +## Main results + +- `Complexity.Circuit.eval_wireFormula` — exact semantics for an unfolded wire. +- `Complexity.Circuit.eval_outputFormula` — exact semantics for a selected output. +- `Complexity.Circuit.depth_wireFormula_le` — wire-formula depth is at most twice + wire depth. +- `Complexity.Circuit.depth_outputFormula_le_outputDepth` — output-formula depth + is at most twice the selected output depth. +-/ + +namespace Complexity + +namespace BoolFormula + +/-- Conditional formula negation agrees with Boolean exclusive-or semantics. -/ +theorem eval_negateIf (assignment : ℕ → Bool) + (negated : Bool) (formula : BoolFormula) : + eval assignment (negateIf negated formula) = + negated.xor (eval assignment formula) := + eval_negateIf_internal assignment negated formula + +end BoolFormula + +namespace Gate + +/-- Replacing a fan-in-two gate's source wires by formulas preserves its +evaluation. -/ +theorem eval_toBoolFormula {W : ℕ} + (gate : Gate Basis.andOr2 W) (wireFormula : Fin W → BoolFormula) + (assignment : ℕ → Bool) : + BoolFormula.eval assignment (gate.toBoolFormula wireFormula) = + gate.eval fun wire => BoolFormula.eval assignment (wireFormula wire) := + eval_toBoolFormula_internal gate wireFormula assignment + +end Gate + + +namespace Circuit + +variable {N M G : ℕ} [NeZero N] [NeZero M] + +/-- Unfolding an internal circuit wire into a formula preserves its value. -/ +theorem eval_wireFormula + (circuit : Circuit Basis.andOr2 N M G) (assignment : ℕ → Bool) + (wire : Fin (N + G)) : + BoolFormula.eval assignment (circuit.wireFormula wire) = + circuit.wireValue (fun input => assignment input.val) wire := + eval_wireFormula_internal circuit assignment wire + +/-- Unfolding one selected circuit output into a formula preserves that output's +value exactly. -/ +theorem eval_outputFormula + (circuit : Circuit Basis.andOr2 N M G) (assignment : ℕ → Bool) + (output : Fin M) : + BoolFormula.eval assignment (circuit.outputFormula output) = + circuit.eval (fun input => assignment input.val) output := + eval_outputFormula_internal circuit assignment output + +/-- The unfolded formula below a wire has depth at most twice the wire's DAG +depth. The factor two accounts for an edge negation followed by its gate. -/ +theorem depth_wireFormula_le + (circuit : Circuit Basis.andOr2 N M G) (wire : Fin (N + G)) : + (circuit.wireFormula wire).depth ≤ 2 * circuit.wireDepth wire := + depth_wireFormula_le_internal circuit wire + +/-- The formula for a selected output has depth at most twice that output's +circuit depth. No formula-size bound is asserted because DAG sharing is +duplicated by unfolding. -/ +theorem depth_outputFormula_le_outputDepth + (circuit : Circuit Basis.andOr2 N M G) (output : Fin M) : + (circuit.outputFormula output).depth ≤ + 2 * circuit.outputDepth output := + depth_outputFormula_le_outputDepth_internal circuit output + +end Circuit + +end Complexity diff --git a/Complexitylib/Circuits/CircuitFormula/Defs.lean b/Complexitylib/Circuits/CircuitFormula/Defs.lean new file mode 100644 index 00000000..4515d77f --- /dev/null +++ b/Complexitylib/Circuits/CircuitFormula/Defs.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.AndOrNot.Defs +import Complexitylib.Circuits.Formula + +/-! +# Unfolding fan-in-two circuit outputs into Boolean formulas -- definitions + +These definitions recursively unfold the DAG below one selected circuit wire or +output gate. Shared subcircuits are intentionally duplicated in the resulting +formula tree; no formula-size claim is implicit in this bridge. +-/ + +namespace Complexity + +namespace BoolFormula + +/-- Negate a formula exactly when the Boolean edge flag is set. -/ +def negateIf (negated : Bool) (formula : BoolFormula) : BoolFormula := + if negated then .neg formula else formula + +end BoolFormula + +namespace Gate + +/-- Replace the two inputs of a fan-in-two AND/OR gate by formulas, retaining +the gate operation and its two edge-negation flags. -/ +def toBoolFormula {W : ℕ} (gate : Gate Basis.andOr2 W) + (wireFormula : Fin W → BoolFormula) : BoolFormula := + have hfan : gate.fanIn = 2 := fanIn_andOr2 gate + let input₀ : Fin gate.fanIn := ⟨0, by omega⟩ + let input₁ : Fin gate.fanIn := ⟨1, by omega⟩ + let formula₀ := BoolFormula.negateIf (gate.negated input₀) + (wireFormula (gate.inputs input₀)) + let formula₁ := BoolFormula.negateIf (gate.negated input₁) + (wireFormula (gate.inputs input₁)) + match gate.op with + | .and => .conj formula₀ formula₁ + | .or => .disj formula₀ formula₁ + +end Gate + +namespace Circuit + +variable {N M G : ℕ} [NeZero N] [NeZero M] + +/-- Recursively unfold the fan-in-two circuit DAG below wire `wire` into a +Boolean formula over the primary-input indices. -/ +def wireFormula (circuit : Circuit Basis.andOr2 N M G) + (wire : Fin (N + G)) : BoolFormula := + if hinput : wire.val < N then + .var wire.val + else + have hgate : wire.val - N < G := by omega + let gate := circuit.gates ⟨wire.val - N, hgate⟩ + have hfan : gate.fanIn = 2 := fanIn_andOr2 gate + let input₀ : Fin gate.fanIn := ⟨0, by omega⟩ + let input₁ : Fin gate.fanIn := ⟨1, by omega⟩ + let formula₀ := BoolFormula.negateIf (gate.negated input₀) + (circuit.wireFormula (gate.inputs input₀)) + let formula₁ := BoolFormula.negateIf (gate.negated input₁) + (circuit.wireFormula (gate.inputs input₁)) + match gate.op with + | .and => .conj formula₀ formula₁ + | .or => .disj formula₀ formula₁ +termination_by wire.val +decreasing_by + all_goals + have hacyclic₀ := + circuit.acyclic ⟨wire.val - N, hgate⟩ input₀ + have hacyclic₁ := + circuit.acyclic ⟨wire.val - N, hgate⟩ input₁ + simp only [gate, input₀, input₁] at hacyclic₀ hacyclic₁ ⊢ + omega + +/-- Unfold one selected output gate into a Boolean formula. -/ +def outputFormula (circuit : Circuit Basis.andOr2 N M G) + (output : Fin M) : BoolFormula := + (circuit.outputs output).toBoolFormula fun wire => circuit.wireFormula wire + +end Circuit + +end Complexity diff --git a/Complexitylib/Circuits/CircuitFormula/Family.lean b/Complexitylib/Circuits/CircuitFormula/Family.lean new file mode 100644 index 00000000..294a8a9a --- /dev/null +++ b/Complexitylib/Circuits/CircuitFormula/Family.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonConverse +import Complexitylib.Circuits.CircuitFormula.Family.Defs +import Complexitylib.Circuits.CircuitFormula.Family.Internal + +/-! +# Circuit-family outputs as formula families + +This module lifts selected-output circuit unfolding to total families. A typed +fan-in-two circuit family yields a formula family with identical semantics and +at most twice its depth. Consequently the total-assignment view of every +`NC1` Boolean-function family lies in `FormulaNC1` and hence in the width-`5` +branching-program class `Width5BP`. + +No formula-size bound is used: shared circuit DAGs may expand exponentially +when unfolded. Barrington's construction depends on formula depth, which the +translation controls directly. +-/ + +namespace Complexity + +namespace Circuit + +/-- A single-output circuit's global depth is the depth of its unique output. -/ +theorem depth_eq_outputDepth_zero {N G : ℕ} [NeZero N] + (circuit : Circuit Basis.andOr2 N 1 G) : + circuit.depth = circuit.outputDepth 0 := + depth_eq_outputDepth_zero_internal circuit + +end Circuit + +namespace CircuitFamily + +/-- The unfolded formula at length `n` has exactly the circuit family's +length-`n` semantics on the corresponding total assignment. -/ +theorem eval_outputFormulaFamily + (F : CircuitFamily Basis.andOr2) (n : ℕ) (assignment : ℕ → Bool) : + BoolFormula.eval assignment (F.outputFormulaFamily n) = + F.function n (fun input => assignment input.val) := + eval_outputFormulaFamily_internal F n assignment + +/-- Family-level selected-output unfolding increases depth by at most a factor +of two. -/ +theorem depth_outputFormulaFamily_le + (F : CircuitFamily Basis.andOr2) (n : ℕ) : + (F.outputFormulaFamily n).depth ≤ 2 * F.depth n := + depth_outputFormulaFamily_le_internal F n + +/-- Unfolding a circuit family computes its total-assignment semantics. -/ +theorem outputFormulaFamily_computes + {F : CircuitFamily Basis.andOr2} {f : BoolFunFamily} + (hcomputes : F.Computes f) : + F.outputFormulaFamily.Computes f.onTotalAssignments := + outputFormulaFamily_computes_internal hcomputes + +/-- A `c * log₂ n + c` circuit-depth bound produces a logarithmic-depth +formula family. -/ +theorem outputFormulaFamily_logDepth + {F : CircuitFamily Basis.andOr2} {c : ℕ} + (hdepth : F.DepthBoundedBy fun n => c * Nat.log 2 n + c) : + F.outputFormulaFamily.LogDepth := + outputFormulaFamily_logDepth_internal hdepth + +end CircuitFamily + +/-- The total-assignment views of `NC1` Boolean-function families are +logarithmic-depth formula families. -/ +theorem NC1_onTotalAssignments_subset_FormulaNC1 : + BoolFunFamily.onTotalAssignments '' NC1 ⊆ FormulaNC1 := + NC1_onTotalAssignments_subset_FormulaNC1_internal + +/-- Pointwise form of the bridge from typed `NC1` circuit families to +logarithmic-depth formula families. -/ +theorem BoolFunFamily.onTotalAssignments_mem_FormulaNC1 + {f : BoolFunFamily} (hf : f ∈ NC1) : + f.onTotalAssignments ∈ FormulaNC1 := + NC1_onTotalAssignments_subset_FormulaNC1 ⟨f, hf, rfl⟩ + +/-- **Barrington for typed `NC1` circuit families.** Their total-assignment +views have polynomial-length width-`5` permutation branching programs. -/ +theorem NC1_onTotalAssignments_subset_Width5BP : + BoolFunFamily.onTotalAssignments '' NC1 ⊆ Width5BP := + NC1_onTotalAssignments_subset_FormulaNC1.trans + formulaNC1_subset_width5BP + +/-- Pointwise Barrington theorem for a typed `NC1` Boolean-function family. -/ +theorem BoolFunFamily.onTotalAssignments_mem_Width5BP + {f : BoolFunFamily} (hf : f ∈ NC1) : + f.onTotalAssignments ∈ Width5BP := + NC1_onTotalAssignments_subset_Width5BP ⟨f, hf, rfl⟩ + +end Complexity diff --git a/Complexitylib/Circuits/CircuitFormula/Family/Defs.lean b/Complexitylib/Circuits/CircuitFormula/Family/Defs.lean new file mode 100644 index 00000000..07f93415 --- /dev/null +++ b/Complexitylib/Circuits/CircuitFormula/Family/Defs.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.BarringtonConverse.Defs +import Complexitylib.Circuits.CircuitFormula.Defs +import Complexitylib.Circuits.Family.Defs + +/-! +# Circuit-family outputs as formula families -- definitions + +These definitions connect typed, length-indexed `CircuitFamily` semantics to +the total-assignment convention used by the Barrington development. +-/ + +namespace Complexity + +namespace BoolFunFamily + +/-- View a typed Boolean-function family on total assignments by restricting an +assignment to the first `n` variables at family index `n`. -/ +def onTotalAssignments (f : BoolFunFamily) : + ℕ → (ℕ → Bool) → Bool := + fun n assignment => f n fun input => assignment input.val + +end BoolFunFamily + +namespace CircuitFamily + +/-- Unfold the unique output of each positive-length fan-in-two circuit into a +formula. The explicit empty-input answer becomes a Boolean constant. -/ +def outputFormulaFamily (F : CircuitFamily Basis.andOr2) : FormulaFamily + | 0 => if F.emptyOutput then .tru else .fls + | n + 1 => (F.circuit (n + 1)).outputFormula 0 + +end CircuitFamily + +end Complexity diff --git a/Complexitylib/Circuits/CircuitFormula/Family/Internal.lean b/Complexitylib/Circuits/CircuitFormula/Family/Internal.lean new file mode 100644 index 00000000..928abae1 --- /dev/null +++ b/Complexitylib/Circuits/CircuitFormula/Family/Internal.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.CircuitFormula +import Complexitylib.Circuits.CircuitFormula.Family.Defs +import Complexitylib.Circuits.DepthClasses + +/-! +# Circuit-family outputs as formula families -- proof internals +-/ + +namespace Complexity + +namespace Circuit + +theorem depth_eq_outputDepth_zero_internal {N G : ℕ} [NeZero N] + (circuit : Circuit Basis.andOr2 N 1 G) : + circuit.depth = circuit.outputDepth 0 := by + unfold Circuit.depth + rw [Fin.foldl_succ_last] + simp [Fin.foldl_zero] + +end Circuit + +namespace CircuitFamily + +theorem eval_outputFormulaFamily_internal + (F : CircuitFamily Basis.andOr2) (n : ℕ) (assignment : ℕ → Bool) : + BoolFormula.eval assignment (F.outputFormulaFamily n) = + F.function n (fun input => assignment input.val) := by + cases n with + | zero => + cases houtput : F.emptyOutput <;> + simp [outputFormulaFamily, CircuitFamily.function, houtput, BoolFormula.eval] + | succ n => + exact Circuit.eval_outputFormula (F.circuit (n + 1)) assignment 0 + +theorem depth_outputFormulaFamily_le_internal + (F : CircuitFamily Basis.andOr2) (n : ℕ) : + (F.outputFormulaFamily n).depth ≤ 2 * F.depth n := by + cases n with + | zero => + cases houtput : F.emptyOutput <;> + simp [outputFormulaFamily, CircuitFamily.depth, houtput, BoolFormula.depth] + | succ n => + rw [outputFormulaFamily, CircuitFamily.depth_succ, + Circuit.depth_eq_outputDepth_zero_internal] + exact Circuit.depth_outputFormula_le_outputDepth (F.circuit (n + 1)) 0 + +theorem outputFormulaFamily_computes_internal + {F : CircuitFamily Basis.andOr2} {f : BoolFunFamily} + (hcomputes : F.Computes f) : + F.outputFormulaFamily.Computes f.onTotalAssignments := by + intro n assignment + rw [eval_outputFormulaFamily_internal] + exact CircuitFamily.Computes.apply hcomputes n + (fun input => assignment input.val) + +theorem outputFormulaFamily_logDepth_internal + {F : CircuitFamily Basis.andOr2} {c : ℕ} + (hdepth : F.DepthBoundedBy fun n => c * Nat.log 2 n + c) : + F.outputFormulaFamily.LogDepth := by + refine ⟨2 * c, fun n => ?_⟩ + calc + (F.outputFormulaFamily n).depth + ≤ 2 * F.depth n := depth_outputFormulaFamily_le_internal F n + _ ≤ 2 * (c * Nat.log 2 n + c) := Nat.mul_le_mul_left 2 (hdepth n) + _ = (2 * c) * Nat.log 2 n + 2 * c := by ring + +end CircuitFamily + +theorem NC1_onTotalAssignments_subset_FormulaNC1_internal : + BoolFunFamily.onTotalAssignments '' NC1 ⊆ FormulaNC1 := by + rintro _ ⟨f, hf, rfl⟩ + rw [mem_NC1_iff] at hf + obtain ⟨F, c, hcomputes, -, hdepth⟩ := hf + exact ⟨F.outputFormulaFamily, + CircuitFamily.outputFormulaFamily_logDepth_internal hdepth, + CircuitFamily.outputFormulaFamily_computes_internal hcomputes⟩ + +end Complexity diff --git a/Complexitylib/Circuits/CircuitFormula/Internal.lean b/Complexitylib/Circuits/CircuitFormula/Internal.lean new file mode 100644 index 00000000..d818ca03 --- /dev/null +++ b/Complexitylib/Circuits/CircuitFormula/Internal.lean @@ -0,0 +1,259 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.CircuitFormula.Defs + +/-! +# Unfolding fan-in-two circuit outputs into Boolean formulas -- proof internals +-/ + +namespace Complexity + +namespace BoolFormula + +theorem eval_negateIf_internal (assignment : ℕ → Bool) + (negated : Bool) (formula : BoolFormula) : + eval assignment (negateIf negated formula) = + negated.xor (eval assignment formula) := by + cases negated <;> simp [negateIf, eval] + +theorem depth_negateIf_le_internal (negated : Bool) + (formula : BoolFormula) : + (negateIf negated formula).depth ≤ formula.depth + 1 := by + cases negated <;> simp [negateIf, depth] + +theorem depth_andOr_negateIf_le_internal (op : AndOrOp) + (negated₀ negated₁ : Bool) (formula₀ formula₁ : BoolFormula) : + (match op with + | .and => BoolFormula.conj (negateIf negated₀ formula₀) + (negateIf negated₁ formula₁) + | .or => BoolFormula.disj (negateIf negated₀ formula₀) + (negateIf negated₁ formula₁)).depth ≤ + 2 + max formula₀.depth formula₁.depth := by + have h₀ := depth_negateIf_le_internal negated₀ formula₀ + have h₁ := depth_negateIf_le_internal negated₁ formula₁ + have hmax := max_le + (le_trans h₀ (Nat.add_le_add_right (le_max_left _ _) 1)) + (le_trans h₁ (Nat.add_le_add_right (le_max_right _ _) 1)) + cases op <;> change max _ _ + 1 ≤ _ + all_goals + omega + +end BoolFormula + +namespace Gate + +theorem eval_toBoolFormula_internal {W : ℕ} + (gate : Gate Basis.andOr2 W) (wireFormula : Fin W → BoolFormula) + (assignment : ℕ → Bool) : + BoolFormula.eval assignment (gate.toBoolFormula wireFormula) = + gate.eval fun wire => BoolFormula.eval assignment (wireFormula wire) := by + obtain ⟨op, fanIn, arityOk, inputs, negated⟩ := gate + change fanIn = 2 at arityOk + subst arityOk + cases op <;> + simp [Gate.toBoolFormula, Gate.eval, Basis.andOr2, AndOrOp.eval, + BoolFormula.eval, BoolFormula.eval_negateIf_internal, + Fin.foldl_succ_last, Fin.foldl_zero] + +theorem depth_toBoolFormula_le_internal {W : ℕ} + (gate : Gate Basis.andOr2 W) (wireFormula : Fin W → BoolFormula) : + let input₀ : Fin gate.fanIn := + ⟨0, by rw [fanIn_andOr2 gate]; omega⟩ + let input₁ : Fin gate.fanIn := + ⟨1, by rw [fanIn_andOr2 gate]; omega⟩ + (gate.toBoolFormula wireFormula).depth ≤ + 2 + max (wireFormula (gate.inputs input₀)).depth + (wireFormula (gate.inputs input₁)).depth := by + dsimp only + unfold Gate.toBoolFormula + dsimp only + exact BoolFormula.depth_andOr_negateIf_le_internal gate.op + (gate.negated ⟨0, by rw [fanIn_andOr2 gate]; omega⟩) + (gate.negated ⟨1, by rw [fanIn_andOr2 gate]; omega⟩) + (wireFormula (gate.inputs ⟨0, by rw [fanIn_andOr2 gate]; omega⟩)) + (wireFormula (gate.inputs ⟨1, by rw [fanIn_andOr2 gate]; omega⟩)) + +end Gate + +namespace Circuit + +variable {N M G : ℕ} [NeZero N] [NeZero M] + +theorem wireFormula_of_lt_internal + (circuit : Circuit Basis.andOr2 N M G) (wire : Fin (N + G)) + (hinput : wire.val < N) : + circuit.wireFormula wire = .var wire.val := by + conv_lhs => unfold wireFormula + simp only [hinput, dite_true] + +theorem wireFormula_of_not_lt_internal + (circuit : Circuit Basis.andOr2 N M G) (wire : Fin (N + G)) + (hinput : ¬ wire.val < N) : + circuit.wireFormula wire = + (circuit.gates ⟨wire.val - N, by omega⟩).toBoolFormula + fun source => circuit.wireFormula source := by + conv_lhs => unfold wireFormula + simp only [hinput, dite_false] + rfl + +theorem wireDepth_of_not_lt_two_internal + (circuit : Circuit Basis.andOr2 N M G) (wire : Fin (N + G)) + (hinput : ¬ wire.val < N) : + let gate := circuit.gates ⟨wire.val - N, by omega⟩ + let input₀ : Fin gate.fanIn := + ⟨0, by rw [fanIn_andOr2 gate]; omega⟩ + let input₁ : Fin gate.fanIn := + ⟨1, by rw [fanIn_andOr2 gate]; omega⟩ + circuit.wireDepth wire = + 1 + max (circuit.wireDepth (gate.inputs input₀)) + (circuit.wireDepth (gate.inputs input₁)) := by + rw [Circuit.wireDepth_of_not_lt circuit wire hinput] + dsimp only + generalize circuit.gates ⟨wire.val - N, by omega⟩ = gate + obtain ⟨op, fanIn, arityOk, inputs, negated⟩ := gate + change fanIn = 2 at arityOk + subst arityOk + simp [Fin.foldl_succ_last, Fin.foldl_zero] + +theorem outputDepth_two_internal + (circuit : Circuit Basis.andOr2 N M G) (output : Fin M) : + let gate := circuit.outputs output + let input₀ : Fin gate.fanIn := + ⟨0, by rw [fanIn_andOr2 gate]; omega⟩ + let input₁ : Fin gate.fanIn := + ⟨1, by rw [fanIn_andOr2 gate]; omega⟩ + circuit.outputDepth output = + 1 + max (circuit.wireDepth (gate.inputs input₀)) + (circuit.wireDepth (gate.inputs input₁)) := by + unfold Circuit.outputDepth + dsimp only + generalize circuit.outputs output = gate + obtain ⟨op, fanIn, arityOk, inputs, negated⟩ := gate + change fanIn = 2 at arityOk + subst arityOk + simp [Fin.foldl_succ_last, Fin.foldl_zero] + +theorem eval_wireFormula_internal + (circuit : Circuit Basis.andOr2 N M G) (assignment : ℕ → Bool) + (wire : Fin (N + G)) : + BoolFormula.eval assignment (circuit.wireFormula wire) = + circuit.wireValue (fun input => assignment input.val) wire := by + induction hwire : wire.val using Nat.strong_induction_on generalizing wire with + | h index ih => + by_cases hinput : wire.val < N + · rw [wireFormula_of_lt_internal circuit wire hinput, + Circuit.wireValue_of_lt circuit _ wire hinput] + rfl + · rw [wireFormula_of_not_lt_internal circuit wire hinput, + Circuit.wireValue_of_not_lt circuit _ wire hinput, + Gate.eval_toBoolFormula_internal] + unfold Gate.eval + congr 1 + funext input + apply congrArg (fun value => + Bool.xor ((circuit.gates ⟨wire.val - N, by omega⟩).negated input) value) + apply ih ((circuit.gates ⟨wire.val - N, by omega⟩).inputs input).val + · have hacyclic := + circuit.acyclic ⟨wire.val - N, by omega⟩ input + change ((circuit.gates ⟨wire.val - N, by omega⟩).inputs input).val < + N + (wire.val - N) at hacyclic + omega + · rfl + +theorem eval_outputFormula_internal + (circuit : Circuit Basis.andOr2 N M G) (assignment : ℕ → Bool) + (output : Fin M) : + BoolFormula.eval assignment (circuit.outputFormula output) = + circuit.eval (fun input => assignment input.val) output := by + rw [outputFormula, Gate.eval_toBoolFormula_internal] + unfold Circuit.eval Gate.eval + congr 1 + funext input + exact congrArg (fun value => Bool.xor ((circuit.outputs output).negated input) value) + (eval_wireFormula_internal circuit assignment ((circuit.outputs output).inputs input)) + +theorem depth_wireFormula_le_internal + (circuit : Circuit Basis.andOr2 N M G) (wire : Fin (N + G)) : + (circuit.wireFormula wire).depth ≤ 2 * circuit.wireDepth wire := by + induction hwire : wire.val using Nat.strong_induction_on generalizing wire with + | h index ih => + by_cases hinput : wire.val < N + · rw [wireFormula_of_lt_internal circuit wire hinput, + Circuit.wireDepth_of_lt circuit wire hinput] + rfl + · have hgate : wire.val - N < G := by omega + let gate := circuit.gates ⟨wire.val - N, hgate⟩ + let input₀ : Fin gate.fanIn := + ⟨0, by rw [fanIn_andOr2 gate]; omega⟩ + let input₁ : Fin gate.fanIn := + ⟨1, by rw [fanIn_andOr2 gate]; omega⟩ + have hacyclic₀ : (gate.inputs input₀).val < wire.val := by + have h := circuit.acyclic ⟨wire.val - N, hgate⟩ input₀ + change (gate.inputs input₀).val < N + (wire.val - N) at h + omega + have hacyclic₁ : (gate.inputs input₁).val < wire.val := by + have h := circuit.acyclic ⟨wire.val - N, hgate⟩ input₁ + change (gate.inputs input₁).val < N + (wire.val - N) at h + omega + have ih₀ := ih (gate.inputs input₀).val (by omega) + (gate.inputs input₀) rfl + have ih₁ := ih (gate.inputs input₁).val (by omega) + (gate.inputs input₁) rfl + have hformula := Gate.depth_toBoolFormula_le_internal gate + fun source => circuit.wireFormula source + dsimp only at hformula + change (gate.toBoolFormula fun source => circuit.wireFormula source).depth ≤ + 2 + max (circuit.wireFormula (gate.inputs input₀)).depth + (circuit.wireFormula (gate.inputs input₁)).depth at hformula + have hmax : + max (circuit.wireFormula (gate.inputs input₀)).depth + (circuit.wireFormula (gate.inputs input₁)).depth ≤ + 2 * max (circuit.wireDepth (gate.inputs input₀)) + (circuit.wireDepth (gate.inputs input₁)) := + max_le + (le_trans ih₀ (Nat.mul_le_mul_left 2 (le_max_left _ _))) + (le_trans ih₁ (Nat.mul_le_mul_left 2 (le_max_right _ _))) + rw [wireFormula_of_not_lt_internal circuit wire hinput, + wireDepth_of_not_lt_two_internal circuit wire hinput] + change (gate.toBoolFormula fun source => circuit.wireFormula source).depth ≤ + 2 * (1 + max (circuit.wireDepth (gate.inputs input₀)) + (circuit.wireDepth (gate.inputs input₁))) + omega + +theorem depth_outputFormula_le_outputDepth_internal + (circuit : Circuit Basis.andOr2 N M G) (output : Fin M) : + (circuit.outputFormula output).depth ≤ + 2 * circuit.outputDepth output := by + let gate := circuit.outputs output + let input₀ : Fin gate.fanIn := + ⟨0, by rw [fanIn_andOr2 gate]; omega⟩ + let input₁ : Fin gate.fanIn := + ⟨1, by rw [fanIn_andOr2 gate]; omega⟩ + have hformula := Gate.depth_toBoolFormula_le_internal gate + fun source => circuit.wireFormula source + dsimp only at hformula + change (gate.toBoolFormula fun source => circuit.wireFormula source).depth ≤ + 2 + max (circuit.wireFormula (gate.inputs input₀)).depth + (circuit.wireFormula (gate.inputs input₁)).depth at hformula + have h₀ := depth_wireFormula_le_internal circuit (gate.inputs input₀) + have h₁ := depth_wireFormula_le_internal circuit (gate.inputs input₁) + have hmax : + max (circuit.wireFormula (gate.inputs input₀)).depth + (circuit.wireFormula (gate.inputs input₁)).depth ≤ + 2 * max (circuit.wireDepth (gate.inputs input₀)) + (circuit.wireDepth (gate.inputs input₁)) := + max_le + (le_trans h₀ (Nat.mul_le_mul_left 2 (le_max_left _ _))) + (le_trans h₁ (Nat.mul_le_mul_left 2 (le_max_right _ _))) + rw [outputFormula, outputDepth_two_internal circuit output] + change (gate.toBoolFormula fun source => circuit.wireFormula source).depth ≤ + 2 * (1 + max (circuit.wireDepth (gate.inputs input₀)) + (circuit.wireDepth (gate.inputs input₁))) + omega + +end Circuit + +end Complexity diff --git a/Complexitylib/Circuits/DepthClasses.lean b/Complexitylib/Circuits/DepthClasses.lean new file mode 100644 index 00000000..62d78b63 --- /dev/null +++ b/Complexitylib/Circuits/DepthClasses.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.DepthClasses.Defs +import Complexitylib.Circuits.DepthClasses.Internal + +/-! +# Circuit depth classes + +This module defines nonuniform `DEPTH`, `NC^i`, and `AC^i` classes using the +library's total circuit-family convention. Every class therefore includes a +specified answer on the empty input. `NC i` uses fan-in two, `AC i` uses +unbounded fan-in, and both impose polynomial size. + +The concrete polylogarithmic envelope is +`c * (Nat.log 2 n + 1) ^ i`. Thus `NC0` and `AC0` are constant-depth classes, +while `NC1` is logarithmic depth with the same `c * log₂ n + c` convention as +the Barrington formula-family development. + +These definitions are explicitly nonuniform. Generator uniformity is an +additional predicate and is not implicit in the names `NC` or `AC`. +-/ + +namespace Complexity + +/-- The exponent-zero polylogarithmic envelope is the constant `c`. -/ +theorem polylogDepth_zero (c n : ℕ) : polylogDepth 0 c n = c := + polylogDepth_zero_internal c n + +/-- The exponent-one envelope agrees with the Barrington convention +`c * log₂ n + c`. -/ +theorem polylogDepth_one (c n : ℕ) : + polylogDepth 1 c n = c * Nat.log 2 n + c := + polylogDepth_one_internal c n + +/-- Increasing the multiplicative constant weakens a polylogarithmic depth +bound. -/ +theorem polylogDepth_mono_constant {c c' : ℕ} (hcc' : c ≤ c') + (i n : ℕ) : + polylogDepth i c n ≤ polylogDepth i c' n := + polylogDepth_mono_constant_internal hcc' i n + +/-- Increasing the polylogarithmic exponent weakens the depth bound. -/ +theorem polylogDepth_mono_exponent {i j : ℕ} (hij : i ≤ j) + (c n : ℕ) : + polylogDepth i c n ≤ polylogDepth j c n := + polylogDepth_mono_exponent_internal hij c n + +/-- `DEPTHWithBasis` is monotone in its pointwise depth envelope. -/ +theorem DEPTHWithBasis_mono (B : Basis) {d e : ℕ → ℕ} + (hde : ∀ n, d n ≤ e n) : + DEPTHWithBasis B d ⊆ DEPTHWithBasis B e := + DEPTHWithBasis_mono_internal B hde + +/-- The `NC` hierarchy is monotone in its polylogarithmic exponent. -/ +theorem NC_mono {i j : ℕ} (hij : i ≤ j) : NC i ⊆ NC j := + NC_mono_internal hij + +/-- The `AC` hierarchy is monotone in its polylogarithmic exponent. -/ +theorem AC_mono {i j : ℕ} (hij : i ≤ j) : AC i ⊆ AC j := + AC_mono_internal hij + +/-- In particular, constant-depth bounded-fan-in families are logarithmic +depth. -/ +theorem NC0_subset_NC1 : NC0 ⊆ NC1 := + NC_mono (by omega) + +/-- Membership in `NC1` is exactly polynomial size and a +`c * log₂ n + c` pointwise depth bound for one fan-in-two family. -/ +theorem mem_NC1_iff {f : BoolFunFamily} : + f ∈ NC1 ↔ + ∃ (F : CircuitFamily Basis.andOr2) (c : ℕ), + F.Computes f ∧ F.PolynomialSize ∧ + F.DepthBoundedBy (fun n => c * Nat.log 2 n + c) := + mem_NC1_iff_internal + +/-- Membership in `AC0` is exactly polynomial size and a constant pointwise +depth bound for one total unbounded-fan-in circuit family. -/ +theorem mem_AC0_iff {f : BoolFunFamily} : + f ∈ AC0 ↔ + ∃ (F : CircuitFamily Basis.unboundedAndOr) (c : ℕ), + F.Computes f ∧ F.PolynomialSize ∧ + F.DepthBoundedBy (fun _ => c) := + mem_AC0_iff_internal + +end Complexity diff --git a/Complexitylib/Circuits/DepthClasses/Defs.lean b/Complexitylib/Circuits/DepthClasses/Defs.lean new file mode 100644 index 00000000..059baaad --- /dev/null +++ b/Complexitylib/Circuits/DepthClasses/Defs.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.AndOrNot.Defs +import Complexitylib.Circuits.Family.Defs +import Mathlib.Data.Nat.Log + +/-! +# Circuit depth classes -- definitions + +This module defines exact depth classes for Boolean-function families using the +library's `CircuitFamily` convention. In particular, the unique length-zero +input is represented by `CircuitFamily.emptyOutput` rather than omitted. + +`NC i` uses fan-in-two AND/OR circuits, while `AC i` uses unbounded-fan-in +AND/OR circuits. Both require polynomial size and depth +`O((log n + 1)^i)` in an explicit pointwise form. +-/ + +namespace Complexity + +/-- A concrete `O((log₂ n + 1)^i)` depth envelope with multiplicative +constant `c`. The `+ 1` makes the base positive and gives constant depth when +`i = 0`. -/ +def polylogDepth (i c n : ℕ) : ℕ := + c * (Nat.log 2 n + 1) ^ i + +/-- Boolean-function families computed by `B`-circuit families under the +pointwise depth bound `d`. No size restriction is implicit in `DEPTHWithBasis`. +-/ +def DEPTHWithBasis (B : Basis) (d : ℕ → ℕ) : Set BoolFunFamily := + {f | ∃ F : CircuitFamily B, F.Computes f ∧ F.DepthBoundedBy d} + +/-- The bounded-fan-in AND/OR depth class under the pointwise bound `d`. -/ +def DEPTH (d : ℕ → ℕ) : Set BoolFunFamily := + DEPTHWithBasis Basis.andOr2 d + +/-- **`NC^i`**, in its nonuniform circuit-family form: polynomial-size, +fan-in-two AND/OR circuits of depth `O((log n + 1)^i)`. -/ +def NC (i : ℕ) : Set BoolFunFamily := + {f | ∃ (F : CircuitFamily Basis.andOr2) (c : ℕ), + F.Computes f ∧ F.PolynomialSize ∧ + F.DepthBoundedBy (polylogDepth i c)} + +/-- **`AC^i`**, in its nonuniform circuit-family form: polynomial-size, +unbounded-fan-in AND/OR circuits of depth `O((log n + 1)^i)`. -/ +def AC (i : ℕ) : Set BoolFunFamily := + {f | ∃ (F : CircuitFamily Basis.unboundedAndOr) (c : ℕ), + F.Computes f ∧ F.PolynomialSize ∧ + F.DepthBoundedBy (polylogDepth i c)} + +/-- Constant-depth, polynomial-size bounded-fan-in circuits. -/ +def NC0 : Set BoolFunFamily := NC 0 + +/-- Logarithmic-depth, polynomial-size bounded-fan-in circuits. -/ +def NC1 : Set BoolFunFamily := NC 1 + +/-- Constant-depth, polynomial-size unbounded-fan-in circuits. -/ +def AC0 : Set BoolFunFamily := AC 0 + +end Complexity diff --git a/Complexitylib/Circuits/DepthClasses/Internal.lean b/Complexitylib/Circuits/DepthClasses/Internal.lean new file mode 100644 index 00000000..8286c8ae --- /dev/null +++ b/Complexitylib/Circuits/DepthClasses/Internal.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.DepthClasses.Defs +import Complexitylib.Circuits.Family + +/-! +# Circuit depth classes -- proof internals +-/ + +namespace Complexity + +theorem polylogDepth_zero_internal (c n : ℕ) : + polylogDepth 0 c n = c := by + simp [polylogDepth] + +theorem polylogDepth_one_internal (c n : ℕ) : + polylogDepth 1 c n = c * Nat.log 2 n + c := by + simp [polylogDepth, Nat.mul_add] + +theorem polylogDepth_mono_constant_internal {c c' : ℕ} (hcc' : c ≤ c') + (i n : ℕ) : + polylogDepth i c n ≤ polylogDepth i c' n := by + exact Nat.mul_le_mul_right ((Nat.log 2 n + 1) ^ i) hcc' + +theorem polylogDepth_mono_exponent_internal {i j : ℕ} (hij : i ≤ j) + (c n : ℕ) : + polylogDepth i c n ≤ polylogDepth j c n := by + apply Nat.mul_le_mul_left c + exact pow_le_pow_right' (by omega) hij + +theorem DEPTHWithBasis_mono_internal (B : Basis) {d e : ℕ → ℕ} + (hde : ∀ n, d n ≤ e n) : + DEPTHWithBasis B d ⊆ DEPTHWithBasis B e := by + rintro f ⟨F, hcomputes, hdepth⟩ + exact ⟨F, hcomputes, F.depthBoundedBy_mono hdepth hde⟩ + +theorem NC_mono_internal {i j : ℕ} (hij : i ≤ j) : + NC i ⊆ NC j := by + rintro f ⟨F, c, hcomputes, hsize, hdepth⟩ + refine ⟨F, c, hcomputes, hsize, F.depthBoundedBy_mono hdepth ?_⟩ + exact fun n => polylogDepth_mono_exponent_internal hij c n + +theorem AC_mono_internal {i j : ℕ} (hij : i ≤ j) : + AC i ⊆ AC j := by + rintro f ⟨F, c, hcomputes, hsize, hdepth⟩ + refine ⟨F, c, hcomputes, hsize, F.depthBoundedBy_mono hdepth ?_⟩ + exact fun n => polylogDepth_mono_exponent_internal hij c n + +theorem mem_NC1_iff_internal {f : BoolFunFamily} : + f ∈ NC1 ↔ + ∃ (F : CircuitFamily Basis.andOr2) (c : ℕ), + F.Computes f ∧ F.PolynomialSize ∧ + F.DepthBoundedBy (fun n => c * Nat.log 2 n + c) := by + simp only [NC1, NC, Set.mem_setOf_eq] + constructor + · rintro ⟨F, c, hcomputes, hsize, hdepth⟩ + exact ⟨F, c, hcomputes, hsize, fun n => by + simpa only [polylogDepth_one_internal] using hdepth n⟩ + · rintro ⟨F, c, hcomputes, hsize, hdepth⟩ + exact ⟨F, c, hcomputes, hsize, fun n => by + simpa only [polylogDepth_one_internal] using hdepth n⟩ + +theorem mem_AC0_iff_internal {f : BoolFunFamily} : + f ∈ AC0 ↔ + ∃ (F : CircuitFamily Basis.unboundedAndOr) (c : ℕ), + F.Computes f ∧ F.PolynomialSize ∧ + F.DepthBoundedBy (fun _ => c) := by + simp only [AC0, AC, Set.mem_setOf_eq] + constructor + · rintro ⟨F, c, hcomputes, hsize, hdepth⟩ + exact ⟨F, c, hcomputes, hsize, fun n => by + simpa only [polylogDepth_zero_internal] using hdepth n⟩ + · rintro ⟨F, c, hcomputes, hsize, hdepth⟩ + exact ⟨F, c, hcomputes, hsize, fun n => by + simpa only [polylogDepth_zero_internal] using hdepth n⟩ + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding.lean b/Complexitylib/Circuits/FormulaEncoding.lean new file mode 100644 index 00000000..3116466b --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.Defs +import Complexitylib.Circuits.FormulaEncoding.Internal + +/-! +# Canonical postfix encoding of Boolean formulas + +This module exposes the machine-facing input format for the uniform Barrington +generator. Formula nodes become a postfix stream of six three-bit token kinds; +variable tokens carry a terminated-unary index, and a terminated-unary token +count frames the complete stream. + +The stack decoder is iterative, exact decoding is a left inverse, canonical +serialization is injective, and the code-length equation records every bit. + +## Main results + +- `FormulaCode.run?_tokens` -- postfix execution reconstructs a formula on any + stack. +- `FormulaCode.decode?_encode` -- whole-formula round trip. +- `FormulaCode.encode_injective` -- canonical codes are unambiguous. +- `FormulaCode.length_encode` -- exact serialized length. +-/ + +namespace Complexity + +namespace FormulaCode + +namespace Token + +/-- The declared token cost is its exact encoded length. -/ +@[simp] theorem length_encode (token : Token) : + token.encode.length = token.codeLength := + length_encode_internal token + +/-- Decoding an encoded token in front of any suffix recovers both. -/ +@[simp] theorem decodePrefix?_encode_append + (token : Token) (suffix : List Bool) : + decodePrefix? (token.encode ++ suffix) = some (token, suffix) := + decodePrefix?_encode_append_internal token suffix + +end Token + +/-- Running concatenated token streams is sequential stack execution. -/ +theorem run?_append (first second : List Token) + (stack : List BoolFormula) : + run? (first ++ second) stack = + (run? first stack).bind (run? second) := + run?_append_internal first second stack + +/-- Running a formula's postfix tokens pushes exactly that formula. -/ +@[simp] theorem run?_tokens (formula : BoolFormula) + (stack : List BoolFormula) : + run? (tokens formula) stack = some (formula :: stack) := + run?_tokens_internal formula stack + +/-- Building from a formula's postfix stream recovers the formula. -/ +@[simp] theorem build?_tokens (formula : BoolFormula) : + build? (tokens formula) = some formula := + build?_tokens_internal formula + +/-- The postfix stream has one token per formula node. -/ +@[simp] theorem length_tokens (formula : BoolFormula) : + (tokens formula).length = formula.size := + length_tokens_internal formula + +/-- Fixed-count token decoding consumes exactly the supplied encoded stream. -/ +@[simp] theorem decodeTokens?_flatMap_encode_append + (stream : List Token) (suffix : List Bool) : + decodeTokens? stream.length (stream.flatMap Token.encode ++ suffix) = + some (stream, suffix) := + decodeTokens?_flatMap_encode_append_internal stream suffix + +/-- Prefix decoding preserves a caller-supplied suffix. -/ +@[simp] theorem decodePrefix?_encode_append + (formula : BoolFormula) (suffix : List Bool) : + decodePrefix? (encode formula ++ suffix) = some (formula, suffix) := + decodePrefix?_encode_append_internal formula suffix + +/-- Exact decoding is a left inverse of canonical serialization. -/ +@[simp] theorem decode?_encode (formula : BoolFormula) : + decode? (encode formula) = some formula := + decode?_encode_internal formula + +/-- Canonical formula serialization is injective. -/ +theorem encode_injective : Function.Injective encode := + encode_injective_internal + +/-- Exact decoding rejects nonempty trailing data. -/ +theorem decode?_encode_append_eq_none + (formula : BoolFormula) {suffix : List Bool} (hsuffix : suffix ≠ []) : + decode? (encode formula ++ suffix) = none := + decode?_encode_append_eq_none_internal formula hsuffix + +/-- Exact formula-code length: one framed token count followed by every token. -/ +@[simp] theorem length_encode (formula : BoolFormula) : + (encode formula).length = + formula.size + 1 + + ((tokens formula).map Token.codeLength).sum := + length_encode_internal formula + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/BitNavigation.lean b/Complexitylib/Circuits/FormulaEncoding/BitNavigation.lean new file mode 100644 index 00000000..8949c16b --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/BitNavigation.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.BitNavigation.Defs +import Complexitylib.Circuits.FormulaEncoding.BitNavigation.Internal + +/-! +# Bit-level navigation in canonical formula codes + +This module gives the uniform Barrington controller an exact sequential-cursor +view of canonical formula bits. A token ordinal determines its token and exact +half-open bit span without reconstructing an inductive formula. + +## Main results + +- `FormulaCode.Token.decodeAt?_append_encode` -- exact absolute token cursor. +- `FormulaCode.tokenAt?_encodeTokenStream` -- exact access in framed streams. +- `FormulaCode.tokenHeader?_encode` -- exact count and payload cursor. +- `FormulaCode.tokenAt?_encode` -- exact token and bit span by ordinal. +- `FormulaCode.encodedSubtreeWidth?_encode` -- encoded and token scans agree. +- `FormulaCode.encodedBinaryChildren?_encodeTokenStream` -- exact child spans. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- Extending a valid token prefix by one advances its encoded-bit length by +exactly the selected token's code length. -/ +theorem tokensCodeLength_take_succ (stream : List Token) + (index : ℕ) (hindex : index < stream.length) : + tokensCodeLength (stream.take (index + 1)) = + tokensCodeLength (stream.take index) + stream[index].codeLength := + tokensCodeLength_take_succ_internal stream index hindex + +namespace Token + +/-- Decoding at the boundary after `prefix` recovers the token and advances +by exactly its declared encoded length. -/ +theorem decodeAt?_append_encode (beforeBits : List Bool) + (token : Token) (suffix : List Bool) : + decodeAt? (beforeBits ++ token.encode ++ suffix) beforeBits.length = + some (token, beforeBits.length + token.codeLength) := + decodeAt?_append_encode_internal beforeBits token suffix + +end Token + +/-- Locating a valid ordinal in any canonically framed token stream returns +the exact token and half-open bit span. -/ +theorem tokenAt?_encodeTokenStream (stream : List Token) + (index : ℕ) (hindex : index < stream.length) : + tokenAt? (encodeTokenStream stream) index = + some + ⟨stream[index], stream.length + 1 + tokenBitOffset stream index, + stream.length + 1 + tokenBitOffset stream index + + stream[index].codeLength⟩ := + tokenAt?_encodeTokenStream_internal stream index hindex + +/-- The encoded token count is followed immediately by the token payload. -/ +theorem tokenHeader?_encode (formula : BoolFormula) : + tokenHeader? (encode formula) = + some ⟨formula.size, formula.size + 1⟩ := + tokenHeader?_encode_internal formula + +/-- Locating a valid token ordinal in a canonical formula code returns the +exact postfix token and its exact half-open bit span. -/ +theorem tokenAt?_encode (formula : BoolFormula) + (index : ℕ) (hindex : index < (tokens formula).length) : + tokenAt? (encode formula) index = + some + ⟨(tokens formula)[index], formula.size + 1 + + tokenBitOffset (tokens formula) index, + formula.size + 1 + tokenBitOffset (tokens formula) index + + ((tokens formula)[index]).codeLength⟩ := + tokenAt?_encode_internal formula index hindex + +/-- Token-only access to a valid canonical ordinal returns its exact postfix +token. -/ +theorem tokenValueAt?_encode (formula : BoolFormula) + (index : ℕ) (hindex : index < (tokens formula).length) : + tokenValueAt? (encode formula) index = some (tokens formula)[index] := + tokenValueAt?_encode_internal formula index hindex + +/-- Token-only access agrees with indexing any canonically framed token +stream. -/ +theorem tokenValueAt?_encodeTokenStream (stream : List Token) + (index : ℕ) (hindex : index < stream.length) : + tokenValueAt? (encodeTokenStream stream) index = some stream[index] := + tokenValueAt?_encodeTokenStream_internal stream index hindex + +/-- Query-driven subtree scanning agrees with token-list navigation for any +canonically framed token stream. -/ +theorem encodedSubtreeWidth?_encodeTokenStream + (stream : List Token) (root : ℕ) (hroot : root < stream.length) : + encodedSubtreeWidth? (encodeTokenStream stream) root = + subtreeWidth? stream root := + encodedSubtreeWidth?_encodeTokenStream_internal stream root hroot + +/-- Query-driven scanning recovers a canonical subtree embedded between +arbitrary token prefixes and suffixes. -/ +theorem encodedSubtreeWidth?_encodeTokenStream_context + (before after : List Token) (formula : BoolFormula) : + encodedSubtreeWidth? + (encodeTokenStream (before ++ tokens formula ++ after)) + (before.length + formula.size - 1) = some formula.size := + encodedSubtreeWidth?_encodeTokenStream_context_internal before after formula + +/-- Splitting a canonical binary postfix segment inside an arbitrary framed +token stream recovers the exact left and right child segments. -/ +theorem encodedBinaryChildren?_encodeTokenStream + (before after : List Token) (left right : BoolFormula) + (op : Token) : + encodedBinaryChildren? + (encodeTokenStream + (before ++ tokens left ++ tokens right ++ [op] ++ after)) + ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := + encodedBinaryChildren?_encodeTokenStream_internal before after left right op + +/-- The owed-subtree scan implemented by repeated encoded-token queries agrees +with navigation on the canonical postfix token stream. -/ +theorem encodedSubtreeWidth?_encode (formula : BoolFormula) + (root : ℕ) (hroot : root < (tokens formula).length) : + encodedSubtreeWidth? (encode formula) root = + subtreeWidth? (tokens formula) root := + encodedSubtreeWidth?_encode_internal formula root hroot + +/-- Encoded scanning recovers the same subtree start as token-stream +navigation. -/ +theorem encodedSubtreeStart?_encode (formula : BoolFormula) + (root : ℕ) (hroot : root < (tokens formula).length) : + encodedSubtreeStart? (encode formula) root = + subtreeStart? (tokens formula) root := + encodedSubtreeStart?_encode_internal formula root hroot + +/-- The complete canonical encoded formula is one postfix subtree. -/ +theorem encodedSubtreeWidth?_encode_root (formula : BoolFormula) : + encodedSubtreeWidth? (encode formula) (formula.size - 1) = + some formula.size := + encodedSubtreeWidth?_encode_root_internal formula + +/-- At a canonical encoded conjunction, the right child occupies its exact +postfix token width immediately before the root. -/ +theorem encodedSubtreeWidth?_encode_conj_right + (left right : BoolFormula) : + encodedSubtreeWidth? (encode (.conj left right)) + (left.size + right.size - 1) = some right.size := + encodedSubtreeWidth?_encode_conj_right_internal left right + +/-- At a canonical encoded disjunction, the right child occupies its exact +postfix token width immediately before the root. -/ +theorem encodedSubtreeWidth?_encode_disj_right + (left right : BoolFormula) : + encodedSubtreeWidth? (encode (.disj left right)) + (left.size + right.size - 1) = some right.size := + encodedSubtreeWidth?_encode_disj_right_internal left right + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/BitNavigation/Defs.lean b/Complexitylib/Circuits/FormulaEncoding/BitNavigation/Defs.lean new file mode 100644 index 00000000..dbc4f13c --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/BitNavigation/Defs.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.Navigation.Defs + +/-! +# Bit-level navigation in canonical formula codes -- definitions + +The uniform Barrington controller receives formula bits from a restartable +transducer rather than an in-memory token list. These definitions expose the +sequential cursor semantics needed by that controller: decode one token at a +bit position, seek to a token ordinal, and retain the exact half-open bit span +of the selected token. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- A decoded token together with its half-open interval in the complete +formula code. -/ +structure LocatedToken where + /-- The decoded postfix token. -/ + token : Token + /-- Bit position of the token's first tag bit. -/ + startBit : ℕ + /-- First bit position after the complete token encoding. -/ + nextBit : ℕ + deriving DecidableEq + +/-- The decoded token count and the first bit position of the token payload. -/ +structure TokenHeader where + /-- Number of postfix tokens declared by the terminated-unary header. -/ + count : ℕ + /-- First bit position following the header. -/ + payloadStart : ℕ + deriving DecidableEq + +/-- A half-open interval of token ordinals in one framed postfix stream. -/ +structure TokenSegment where + /-- First token ordinal in the segment. -/ + start : ℕ + /-- Number of tokens in the segment. -/ + width : ℕ + deriving DecidableEq + +namespace TokenSegment + +/-- Root ordinal of a nonempty postfix segment. -/ +def root? : TokenSegment → Option ℕ + | ⟨_, 0⟩ => none + | ⟨start, width + 1⟩ => some (start + width) + +/-- Remove the final root token from a nonempty postfix segment. -/ +def dropRoot? : TokenSegment → Option TokenSegment + | ⟨_, 0⟩ => none + | ⟨start, width + 1⟩ => some ⟨start, width⟩ + +end TokenSegment + +namespace Token + +/-- Decode one token starting at an absolute bit cursor. The returned cursor +is the first bit after that token. -/ +def decodeAt? (bits : List Bool) (cursor : ℕ) : Option (Token × ℕ) := do + let (token, rest) ← decodePrefix? (bits.drop cursor) + some (token, bits.length - rest.length) + +end Token + +/-- Total encoded length of a postfix token stream, excluding the formula +header. -/ +def tokensCodeLength (stream : List Token) : ℕ := + (stream.map Token.codeLength).sum + +/-- Encoded payload offset of token ordinal `index`. For an out-of-range +ordinal this is the length of the complete available prefix. -/ +def tokenBitOffset (stream : List Token) (index : ℕ) : ℕ := + tokensCodeLength (stream.take index) + +/-- Frame an arbitrary postfix token stream with its terminated-unary token +count. Canonical formula codes are this construction applied to `tokens`. -/ +def encodeTokenStream (stream : List Token) : List Bool := + CircuitCode.NatCode.encode stream.length ++ + stream.flatMap Token.encode + +/-- Decode the formula token-count header and retain the absolute payload +cursor. -/ +def tokenHeader? (bits : List Bool) : Option TokenHeader := do + let (count, rest) ← CircuitCode.NatCode.decodePrefix? bits + some ⟨count, bits.length - rest.length⟩ + +/-- Seek forward from an already-known token boundary and locate the token at +the supplied relative ordinal. -/ +def seekToken? (bits : List Bool) (cursor : ℕ) : ℕ → Option LocatedToken + | 0 => do + let (token, nextBit) ← Token.decodeAt? bits cursor + some ⟨token, cursor, nextBit⟩ + | index + 1 => do + let (_, nextBit) ← Token.decodeAt? bits cursor + seekToken? bits nextBit index + +/-- Locate one declared token ordinal in a complete encoded formula. Malformed +headers, malformed token prefixes, and out-of-range ordinals fail. -/ +def tokenAt? (bits : List Bool) (index : ℕ) : Option LocatedToken := do + let header ← tokenHeader? bits + if index < header.count then + seekToken? bits header.payloadStart index + else + none + +/-- Forget the bit span and query only the decoded token value. -/ +def tokenValueAt? (bits : List Bool) (index : ℕ) : Option Token := + (tokenAt? bits index).map LocatedToken.token + +/-- Predecessor of a token ordinal, with `none` before ordinal zero. -/ +def previousToken? : ℕ → Option ℕ + | 0 => none + | cursor + 1 => some cursor + +/-- Run the owed-subtree scan through a random-access token query. `fuel` +bounds the number of inspected ordinals, while `cursor` moves strictly +backwards. -/ +def backwardScanQuery? (query : ℕ → Option Token) : + ℕ → Option ℕ → ℕ → Option ℕ + | _, _, 0 => some 0 + | 0, _, _ + 1 => none + | _ + 1, none, _ + 1 => none + | fuel + 1, some cursor, owed + 1 => do + let token ← query cursor + let consumed ← backwardScanQuery? query fuel + (previousToken? cursor) (owed + token.arity) + some (consumed + 1) + +/-- Width in tokens of the postfix subtree ending at `root`, obtained solely +through repeated token-ordinal queries on encoded bits. -/ +def encodedSubtreeWidth? (bits : List Bool) (root : ℕ) : Option ℕ := + backwardScanQuery? (tokenValueAt? bits) (root + 1) (some root) 1 + +/-- Start token ordinal of the encoded postfix subtree ending at `root`. -/ +def encodedSubtreeStart? (bits : List Bool) (root : ℕ) : Option ℕ := do + let width ← encodedSubtreeWidth? bits root + if width ≤ root + 1 then some (root + 1 - width) else none + +/-- Split a postfix segment below a binary root. The right-child width is +recovered by the query-driven backwards scan; both children must be nonempty +and contained in the rootless body. -/ +def encodedBinaryChildren? (bits : List Bool) + (segment : TokenSegment) : Option (TokenSegment × TokenSegment) := do + let root ← segment.root? + let body ← segment.dropRoot? + let rightRoot ← previousToken? root + let rightWidth ← encodedSubtreeWidth? bits rightRoot + if 0 < rightWidth ∧ rightWidth < body.width then + let leftWidth := body.width - rightWidth + some (⟨body.start, leftWidth⟩, + ⟨body.start + leftWidth, rightWidth⟩) + else + none + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/BitNavigation/Internal.lean b/Complexitylib/Circuits/FormulaEncoding/BitNavigation/Internal.lean new file mode 100644 index 00000000..1ec18721 --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/BitNavigation/Internal.lean @@ -0,0 +1,332 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding +import Complexitylib.Circuits.FormulaEncoding.BitNavigation.Defs +import Complexitylib.Circuits.FormulaEncoding.Navigation.Internal + +/-! +# Bit-level navigation in canonical formula codes -- proof internals +-/ + +namespace Complexity + +namespace FormulaCode + +namespace Token + +theorem decodeAt?_append_encode_internal (beforeBits : List Bool) + (token : Token) (suffix : List Bool) : + decodeAt? (beforeBits ++ token.encode ++ suffix) beforeBits.length = + some (token, beforeBits.length + token.codeLength) := by + simp [decodeAt?, List.append_assoc] + omega + +end Token + +theorem tokensCodeLength_append_internal (first second : List Token) : + tokensCodeLength (first ++ second) = + tokensCodeLength first + tokensCodeLength second := by + simp [tokensCodeLength, List.sum_append] + +theorem tokensCodeLength_take_succ_internal (stream : List Token) + (index : ℕ) (hindex : index < stream.length) : + tokensCodeLength (stream.take (index + 1)) = + tokensCodeLength (stream.take index) + stream[index].codeLength := by + rw [← List.take_concat_get' stream index hindex, + tokensCodeLength_append_internal] + simp [tokensCodeLength] + +theorem tokensCodeLength_eq_flatMap_length_internal + (stream : List Token) : + tokensCodeLength stream = (stream.flatMap Token.encode).length := by + simp [tokensCodeLength, List.length_flatMap] + +theorem seekToken?_flatMap_encode_internal + (beforeBits suffix : List Bool) (stream : List Token) + (index : ℕ) (hindex : index < stream.length) : + seekToken? (beforeBits ++ stream.flatMap Token.encode ++ suffix) + beforeBits.length index = + some + ⟨stream[index], beforeBits.length + tokenBitOffset stream index, + beforeBits.length + tokenBitOffset stream index + + (stream[index]).codeLength⟩ := by + induction stream generalizing beforeBits index with + | nil => simp at hindex + | cons token stream ih => + cases index with + | zero => + simp only [seekToken?, List.flatMap_cons, List.getElem_cons_zero, + tokenBitOffset, List.take_zero, tokensCodeLength, List.map_nil, + List.sum_nil, Nat.add_zero] + rw [show beforeBits ++ + (token.encode ++ stream.flatMap Token.encode) ++ suffix = + beforeBits ++ token.encode ++ + (stream.flatMap Token.encode ++ suffix) by + simp [List.append_assoc]] + rw [Token.decodeAt?_append_encode_internal] + rfl + | succ index => + have htail : index < stream.length := by + simpa using hindex + simp only [seekToken?, List.flatMap_cons] + rw [show beforeBits ++ + (token.encode ++ stream.flatMap Token.encode) ++ suffix = + beforeBits ++ token.encode ++ + (stream.flatMap Token.encode ++ suffix) by + simp [List.append_assoc]] + rw [Token.decodeAt?_append_encode_internal] + simpa [List.append_assoc, tokenBitOffset, tokensCodeLength, + Nat.add_assoc] using + ih (beforeBits ++ token.encode) index htail + +theorem tokenHeader?_encode_internal (formula : BoolFormula) : + tokenHeader? (encode formula) = + some ⟨formula.size, formula.size + 1⟩ := by + rw [tokenHeader?, encode] + simp only [CircuitCode.NatCode.decodePrefix?_encode_append, + length_tokens_internal] + simp [CircuitCode.NatCode.length_encode] + +theorem tokenHeader?_encodeTokenStream_internal (stream : List Token) : + tokenHeader? (encodeTokenStream stream) = + some ⟨stream.length, stream.length + 1⟩ := by + rw [tokenHeader?, encodeTokenStream] + simp [CircuitCode.NatCode.length_encode] + +theorem tokenAt?_encodeTokenStream_internal (stream : List Token) + (index : ℕ) (hindex : index < stream.length) : + tokenAt? (encodeTokenStream stream) index = + some + ⟨stream[index], stream.length + 1 + tokenBitOffset stream index, + stream.length + 1 + tokenBitOffset stream index + + stream[index].codeLength⟩ := by + rw [tokenAt?, tokenHeader?_encodeTokenStream_internal] + change (if index < stream.length then + seekToken? (encodeTokenStream stream) (stream.length + 1) index + else none) = _ + rw [if_pos hindex, encodeTokenStream] + simpa [CircuitCode.NatCode.length_encode] using + seekToken?_flatMap_encode_internal + (CircuitCode.NatCode.encode stream.length) [] stream index hindex + +theorem tokenAt?_encode_internal (formula : BoolFormula) + (index : ℕ) (hindex : index < (tokens formula).length) : + tokenAt? (encode formula) index = + some + ⟨(tokens formula)[index], formula.size + 1 + + tokenBitOffset (tokens formula) index, + formula.size + 1 + tokenBitOffset (tokens formula) index + + ((tokens formula)[index]).codeLength⟩ := by + rw [tokenAt?, tokenHeader?_encode_internal] + have hsize : index < formula.size := by + simpa only [length_tokens_internal] using hindex + change (if index < formula.size then + seekToken? (encode formula) (formula.size + 1) index else none) = _ + rw [if_pos hsize] + rw [encode] + simpa [CircuitCode.NatCode.length_encode, length_tokens_internal] using + seekToken?_flatMap_encode_internal + (CircuitCode.NatCode.encode (tokens formula).length) [] + (tokens formula) index hindex + +theorem backwardScanQuery?_eq_backwardScan_internal + (stream : List Token) (query : ℕ → Option Token) + (root : ℕ) (hroot : root < stream.length) + (hquery : ∀ index, index ≤ root → query index = stream[index]?) + (owed : ℕ) : + backwardScanQuery? query (root + 1) (some root) owed = + backwardScan (stream.take (root + 1)).reverse owed := by + induction root generalizing owed with + | zero => + cases owed with + | zero => simp [backwardScanQuery?, backwardScan] + | succ owed => + rw [List.take_succ_eq_append_getElem hroot] + simp only [List.take_zero, List.nil_append, List.reverse_singleton, + backwardScanQuery?, previousToken?, backwardScan] + rw [hquery 0 le_rfl, List.getElem?_eq_getElem hroot] + cases hnext : owed + stream[0].arity <;> + simp [hnext, backwardScanQuery?, backwardScan] + | succ root ih => + cases owed with + | zero => simp [backwardScanQuery?, backwardScan] + | succ owed => + have hroot' : root < stream.length := by omega + rw [List.take_succ_eq_append_getElem hroot] + simp only [List.reverse_append, List.reverse_singleton, + List.singleton_append, backwardScanQuery?, previousToken?, + backwardScan] + rw [hquery (root + 1) le_rfl, + List.getElem?_eq_getElem hroot] + simp only [Option.bind_eq_bind, Option.bind_some] + change (backwardScanQuery? query (root + 1) (some root) + (owed + stream[root + 1].arity)).bind (fun consumed => + some (consumed + 1)) = _ + rw [ih hroot' (fun index hindex => + hquery index (by omega))] + cases backwardScan (stream.take (root + 1)).reverse + (owed + stream[root + 1].arity) <;> rfl + +theorem tokenValueAt?_encode_internal (formula : BoolFormula) + (index : ℕ) (hindex : index < (tokens formula).length) : + tokenValueAt? (encode formula) index = some (tokens formula)[index] := by + rw [tokenValueAt?, tokenAt?_encode_internal formula index hindex] + rfl + +theorem tokenValueAt?_encodeTokenStream_internal (stream : List Token) + (index : ℕ) (hindex : index < stream.length) : + tokenValueAt? (encodeTokenStream stream) index = some stream[index] := by + rw [tokenValueAt?, + tokenAt?_encodeTokenStream_internal stream index hindex] + rfl + +theorem encodedSubtreeWidth?_encodeTokenStream_internal + (stream : List Token) (root : ℕ) (hroot : root < stream.length) : + encodedSubtreeWidth? (encodeTokenStream stream) root = + subtreeWidth? stream root := by + rw [encodedSubtreeWidth?, subtreeWidth?] + apply backwardScanQuery?_eq_backwardScan_internal stream + (tokenValueAt? (encodeTokenStream stream)) root hroot + intro index hindex + have hvalid : index < stream.length := by omega + rw [tokenValueAt?_encodeTokenStream_internal stream index hvalid, + List.getElem?_eq_getElem hvalid] + +theorem subtreeWidth?_tokens_context_internal (before after : List Token) + (formula : BoolFormula) : + subtreeWidth? (before ++ tokens formula ++ after) + (before.length + formula.size - 1) = some formula.size := by + rw [subtreeWidth?] + have hpositive : 0 < formula.size := by + cases formula <;> simp [BoolFormula.size] + rw [show before.length + formula.size - 1 + 1 = + before.length + formula.size by omega] + have hprefixLength : (before ++ tokens formula).length = + before.length + formula.size := by + simp + have htake : (before ++ tokens formula ++ after).take + (before.length + formula.size) = before ++ tokens formula := by + rw [← hprefixLength] + exact List.take_left + rw [htake, List.reverse_append] + have hscan := backwardScan_tokens_reverse_append_internal + formula before.reverse 0 + simpa [backwardScan] using hscan + +theorem encodedSubtreeWidth?_encodeTokenStream_context_internal + (before after : List Token) (formula : BoolFormula) : + encodedSubtreeWidth? + (encodeTokenStream (before ++ tokens formula ++ after)) + (before.length + formula.size - 1) = some formula.size := by + have hpositive : 0 < formula.size := by + cases formula <;> simp [BoolFormula.size] + rw [encodedSubtreeWidth?_encodeTokenStream_internal] + · exact subtreeWidth?_tokens_context_internal before after formula + · simp + omega + +theorem encodedBinaryChildren?_encodeTokenStream_internal + (before after : List Token) (left right : BoolFormula) + (op : Token) : + encodedBinaryChildren? + (encodeTokenStream + (before ++ tokens left ++ tokens right ++ [op] ++ after)) + ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + have hleftPositive : 0 < left.size := by + cases left <;> simp [BoolFormula.size] + have hrightPositive : 0 < right.size := by + cases right <;> simp [BoolFormula.size] + rw [encodedBinaryChildren?] + simp only [TokenSegment.root?, TokenSegment.dropRoot?, + Option.bind_eq_bind, Option.bind_some] + rw [show before.length + (left.size + right.size) = + (before.length + left.size + right.size - 1) + 1 by omega] + simp only [previousToken?, Option.bind_some] + change (do + let rightWidth ← encodedSubtreeWidth? + (encodeTokenStream + (before ++ tokens left ++ tokens right ++ [op] ++ after)) + (before.length + left.size + right.size - 1) + if 0 < rightWidth ∧ rightWidth < left.size + right.size then + some (TokenSegment.mk before.length + (left.size + right.size - rightWidth), + TokenSegment.mk + (before.length + (left.size + right.size - rightWidth)) + rightWidth) + else none) = _ + rw [show before ++ tokens left ++ tokens right ++ [op] ++ after = + (before ++ tokens left) ++ tokens right ++ ([op] ++ after) by + simp [List.append_assoc]] + rw [show before.length + left.size + right.size - 1 = + (before ++ tokens left).length + right.size - 1 by + simp] + rw [encodedSubtreeWidth?_encodeTokenStream_context_internal] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [if_pos (by omega)] + congr <;> omega + +theorem encodedSubtreeWidth?_encode_internal (formula : BoolFormula) + (root : ℕ) (hroot : root < (tokens formula).length) : + encodedSubtreeWidth? (encode formula) root = + subtreeWidth? (tokens formula) root := by + rw [encodedSubtreeWidth?, subtreeWidth?] + apply backwardScanQuery?_eq_backwardScan_internal + (tokens formula) (tokenValueAt? (encode formula)) root hroot + intro index hindex + have hvalid : index < (tokens formula).length := by omega + rw [tokenValueAt?_encode_internal formula index hvalid, + List.getElem?_eq_getElem hvalid] + +theorem encodedSubtreeStart?_encode_internal (formula : BoolFormula) + (root : ℕ) (hroot : root < (tokens formula).length) : + encodedSubtreeStart? (encode formula) root = + subtreeStart? (tokens formula) root := by + rw [encodedSubtreeStart?, subtreeStart?, + encodedSubtreeWidth?_encode_internal formula root hroot] + +theorem encodedSubtreeWidth?_encode_root_internal + (formula : BoolFormula) : + encodedSubtreeWidth? (encode formula) (formula.size - 1) = + some formula.size := by + have hpositive : 0 < formula.size := by + cases formula <;> simp [BoolFormula.size] + rw [encodedSubtreeWidth?_encode_internal] + · exact subtreeWidth?_tokens_root_internal formula + · simpa [length_tokens_internal] using hpositive + +theorem encodedSubtreeWidth?_encode_conj_right_internal + (left right : BoolFormula) : + encodedSubtreeWidth? (encode (.conj left right)) + (left.size + right.size - 1) = some right.size := by + have hroot : left.size + right.size - 1 < + (tokens (.conj left right)).length := by + have hrightPositive : 0 < right.size := by + cases right <;> simp [BoolFormula.size] + simp only [tokens, List.length_append, List.length_singleton, + length_tokens_internal] + omega + rw [encodedSubtreeWidth?_encode_internal _ _ hroot] + exact subtreeWidth?_tokens_binary_right_internal left right Token.conj + +theorem encodedSubtreeWidth?_encode_disj_right_internal + (left right : BoolFormula) : + encodedSubtreeWidth? (encode (.disj left right)) + (left.size + right.size - 1) = some right.size := by + have hroot : left.size + right.size - 1 < + (tokens (.disj left right)).length := by + have hrightPositive : 0 < right.size := by + cases right <;> simp [BoolFormula.size] + simp only [tokens, List.length_append, List.length_singleton, + length_tokens_internal] + omega + rw [encodedSubtreeWidth?_encode_internal _ _ hroot] + exact subtreeWidth?_tokens_binary_right_internal left right Token.disj + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/Defs.lean b/Complexitylib/Circuits/FormulaEncoding/Defs.lean new file mode 100644 index 00000000..cb13a09e --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/Defs.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.Encoding.Defs +import Complexitylib.Circuits.Formula + +/-! +# Machine-facing encoding of Boolean formulas + +This file defines a canonical postfix encoding of `BoolFormula`. Six three-bit +tags represent variables, constants, and connectives. A variable tag is +followed by the existing terminated-unary natural code. The complete stream +starts with its terminated-unary token count. + +Postfix order makes decoding iterative: the parser first reads a flat token +stream, then a stack machine reconstructs the formula. This avoids a recursive +on-tape tree parser and gives the later Barrington generator a simple, +self-delimiting input language. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- Proof-free postfix tokens for Boolean formulas. -/ +inductive Token where + /-- A variable with its natural-number index. -/ + | var (index : ℕ) + /-- The constant true. -/ + | tru + /-- The constant false. -/ + | fls + /-- Unary negation. -/ + | neg + /-- Binary conjunction. -/ + | conj + /-- Binary disjunction. -/ + | disj + deriving DecidableEq, Repr + +namespace Token + +/-- Serialize one postfix token. Tags `110` and `111` are reserved. -/ +def encode : Token → List Bool + | .var index => [false, false, false] ++ CircuitCode.NatCode.encode index + | .tru => [false, false, true] + | .fls => [false, true, false] + | .neg => [false, true, true] + | .conj => [true, false, false] + | .disj => [true, false, true] + +/-- Parse one token prefix and return the unused suffix. -/ +def decodePrefix? : List Bool → Option (Token × List Bool) + | false :: false :: false :: rest => do + let (index, rest) ← CircuitCode.NatCode.decodePrefix? rest + some (.var index, rest) + | false :: false :: true :: rest => some (.tru, rest) + | false :: true :: false :: rest => some (.fls, rest) + | false :: true :: true :: rest => some (.neg, rest) + | true :: false :: false :: rest => some (.conj, rest) + | true :: false :: true :: rest => some (.disj, rest) + | _ => none + +/-- The exact number of bits in a token encoding. -/ +def codeLength : Token → ℕ + | .var index => index + 4 + | _ => 3 + +/-- Apply one postfix token to a formula stack. -/ +def apply? : Token → List BoolFormula → Option (List BoolFormula) + | .var index, stack => some (.var index :: stack) + | .tru, stack => some (.tru :: stack) + | .fls, stack => some (.fls :: stack) + | .neg, formula :: stack => some (.neg formula :: stack) + | .conj, right :: left :: stack => some (.conj left right :: stack) + | .disj, right :: left :: stack => some (.disj left right :: stack) + | _, _ => none + +end Token + +/-- Canonical postfix tokens of a formula. -/ +def tokens : BoolFormula → List Token + | .var index => [.var index] + | .tru => [.tru] + | .fls => [.fls] + | .neg formula => tokens formula ++ [.neg] + | .conj left right => tokens left ++ tokens right ++ [.conj] + | .disj left right => tokens left ++ tokens right ++ [.disj] + +/-- Execute a postfix token stream from an initial formula stack. -/ +def run? : List Token → List BoolFormula → Option (List BoolFormula) + | [], stack => some stack + | token :: tokens, stack => do + let stack ← token.apply? stack + run? tokens stack + +/-- Reconstruct exactly one formula from a postfix token stream. -/ +def build? (stream : List Token) : Option BoolFormula := do + let stack ← run? stream [] + match stack with + | [formula] => some formula + | _ => none + +/-- Decode exactly `count` token prefixes and return the unused bit suffix. -/ +def decodeTokens? : ℕ → List Bool → Option (List Token × List Bool) + | 0, bits => some ([], bits) + | count + 1, bits => do + let (token, rest) ← Token.decodePrefix? bits + let (stream, rest) ← decodeTokens? count rest + some (token :: stream, rest) + +/-- Canonically encode a Boolean formula. -/ +def encode (formula : BoolFormula) : List Bool := + CircuitCode.NatCode.encode (tokens formula).length ++ + (tokens formula).flatMap Token.encode + +/-- Decode one complete formula prefix and return the unused suffix. -/ +def decodePrefix? (bits : List Bool) : Option (BoolFormula × List Bool) := do + let (count, rest) ← CircuitCode.NatCode.decodePrefix? bits + let (stream, rest) ← decodeTokens? count rest + let formula ← build? stream + some (formula, rest) + +/-- Decode exactly one formula. Trailing bits are rejected. -/ +def decode? (bits : List Bool) : Option BoolFormula := + match decodePrefix? bits with + | some (formula, []) => some formula + | _ => none + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation.lean b/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation.lean new file mode 100644 index 00000000..ccbd3b88 --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.ForwardNavigation.Defs +import Complexitylib.Circuits.FormulaEncoding.ForwardNavigation.Internal + +/-! +# Forward navigation in postfix formula codes + +This module exposes the streaming invariant that locates a binary postfix +formula's child boundary in one left-to-right pass. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- Scanning a concatenated stream is the sequential composition of its two +parts. -/ +theorem forwardScan_append (first second : List Token) + (state : ForwardScanState) : + forwardScan (first ++ second) state = + forwardScan second (forwardScan first state) := + forwardScan_append_internal first second state + +/-- Extending a valid token prefix by one applies exactly one pure scan step. -/ +theorem forwardScan_take_succ (stream : List Token) + (state : ForwardScanState) (index : ℕ) + (hindex : index < stream.length) : + forwardScan (stream.take (index + 1)) state = + (forwardScan (stream.take index) state).step stream[index] := + forwardScan_take_succ_internal stream state index hindex + +/-- Scanning one canonical formula raises the postfix stack height by one and +has the closed numeric effect recorded by `afterFormula`. -/ +theorem forwardScan_tokens + (formula : BoolFormula) (state : ForwardScanState) : + forwardScan (tokens formula) state = state.afterFormula formula := + forwardScan_tokens_internal formula state + +/-- In the rootless body of a canonical binary formula, the last height-one +boundary is exactly the end of the left child, both in tokens and encoded +bits. -/ +theorem forwardScan_binary_body + (left right : BoolFormula) : + forwardScan (tokens left ++ tokens right) ForwardScanState.initial = + { stackHeight := 2 + tokenCount := left.size + right.size + bitOffset := tokensCodeLength (tokens left) + + tokensCodeLength (tokens right) + lastOneCount := left.size + lastOneBitOffset := tokensCodeLength (tokens left) } := + forwardScan_binary_body_internal left right + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation/Defs.lean b/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation/Defs.lean new file mode 100644 index 00000000..b20ebfe2 --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation/Defs.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.BitNavigation.Defs +import Complexitylib.Circuits.FormulaEncoding.Navigation.Defs + +/-! +# Forward navigation in postfix formula codes -- definitions + +A streaming machine decodes token bits from left to right. This navigation +state tracks the postfix evaluation-stack height and remembers the last token +and bit boundary at which that height was one. In the rootless body of a +binary formula, that last boundary is exactly the end of the left child. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- Logarithmic numeric state retained by one forward postfix scan. -/ +structure ForwardScanState where + /-- Current number of completed formula values on the postfix stack. -/ + stackHeight : ℕ + /-- Number of tokens consumed by this scan. -/ + tokenCount : ℕ + /-- Number of encoded token bits consumed by this scan. -/ + bitOffset : ℕ + /-- Most recent token count at which `stackHeight` became one. -/ + lastOneCount : ℕ + /-- Matching encoded-bit offset at that same boundary. -/ + lastOneBitOffset : ℕ + deriving DecidableEq + +/-- Canonical zero state for scanning a complete postfix segment body. -/ +def ForwardScanState.initial : ForwardScanState := + { stackHeight := 0 + tokenCount := 0 + bitOffset := 0 + lastOneCount := 0 + lastOneBitOffset := 0 } + +/-- Consume one token, using saturated subtraction on malformed prefixes. -/ +def ForwardScanState.step (state : ForwardScanState) + (token : Token) : ForwardScanState := + let nextHeight := state.stackHeight + 1 - token.arity + let nextCount := state.tokenCount + 1 + let nextBitOffset := state.bitOffset + token.codeLength + { stackHeight := nextHeight + tokenCount := nextCount + bitOffset := nextBitOffset + lastOneCount := + if nextHeight = 1 then nextCount else state.lastOneCount + lastOneBitOffset := + if nextHeight = 1 then nextBitOffset else state.lastOneBitOffset } + +/-- Stream a list of postfix tokens from an arbitrary retained state. -/ +def forwardScan : List Token → ForwardScanState → ForwardScanState + | [], state => state + | token :: stream, state => forwardScan stream (state.step token) + +/-- Closed form of scanning one canonical formula from an arbitrary stack +height. When the incoming height is zero, the formula's final boundary becomes +the last height-one boundary; above zero no height-one boundary is crossed. -/ +def ForwardScanState.afterFormula (state : ForwardScanState) + (formula : BoolFormula) : ForwardScanState := + let nextCount := state.tokenCount + formula.size + let nextBitOffset := state.bitOffset + tokensCodeLength (tokens formula) + { stackHeight := state.stackHeight + 1 + tokenCount := nextCount + bitOffset := nextBitOffset + lastOneCount := + if state.stackHeight = 0 then nextCount else state.lastOneCount + lastOneBitOffset := + if state.stackHeight = 0 then nextBitOffset else state.lastOneBitOffset } + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation/Internal.lean b/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation/Internal.lean new file mode 100644 index 00000000..cbcc66cb --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/ForwardNavigation/Internal.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding +import Complexitylib.Circuits.FormulaEncoding.ForwardNavigation.Defs + +/-! +# Forward navigation in postfix formula codes -- internals +-/ + +namespace Complexity + +namespace FormulaCode + +theorem forwardScan_append_internal + (first second : List Token) (state : ForwardScanState) : + forwardScan (first ++ second) state = + forwardScan second (forwardScan first state) := by + induction first generalizing state with + | nil => rfl + | cons token first ih => + simp only [List.cons_append, forwardScan] + exact ih (state.step token) + +theorem forwardScan_take_succ_internal (stream : List Token) + (state : ForwardScanState) (index : ℕ) + (hindex : index < stream.length) : + forwardScan (stream.take (index + 1)) state = + (forwardScan (stream.take index) state).step stream[index] := by + rw [← List.take_concat_get' stream index hindex, + forwardScan_append_internal] + rfl + +theorem forwardScan_tokens_internal + (formula : BoolFormula) (state : ForwardScanState) : + forwardScan (tokens formula) state = state.afterFormula formula := by + induction formula generalizing state with + | var index => + simp [tokens, forwardScan, ForwardScanState.step, + ForwardScanState.afterFormula, tokensCodeLength, Token.arity, + Token.codeLength, BoolFormula.size] + | tru => + simp [tokens, forwardScan, ForwardScanState.step, + ForwardScanState.afterFormula, tokensCodeLength, Token.arity, + Token.codeLength, BoolFormula.size] + | fls => + simp [tokens, forwardScan, ForwardScanState.step, + ForwardScanState.afterFormula, tokensCodeLength, Token.arity, + Token.codeLength, BoolFormula.size] + | neg formula ih => + rw [tokens, forwardScan_append_internal, ih] + simp [tokens, forwardScan, ForwardScanState.step, + ForwardScanState.afterFormula, tokensCodeLength, Token.arity, + Token.codeLength, BoolFormula.size] + split <;> omega + | conj left right ihLeft ihRight => + rw [tokens, forwardScan_append_internal, + forwardScan_append_internal, ihLeft, ihRight] + simp [tokens, forwardScan, ForwardScanState.step, + ForwardScanState.afterFormula, tokensCodeLength, Token.arity, + Token.codeLength, BoolFormula.size] + split <;> omega + | disj left right ihLeft ihRight => + rw [tokens, forwardScan_append_internal, + forwardScan_append_internal, ihLeft, ihRight] + simp [tokens, forwardScan, ForwardScanState.step, + ForwardScanState.afterFormula, tokensCodeLength, Token.arity, + Token.codeLength, BoolFormula.size] + split <;> omega + +theorem forwardScan_binary_body_internal + (left right : BoolFormula) : + forwardScan (tokens left ++ tokens right) ForwardScanState.initial = + { stackHeight := 2 + tokenCount := left.size + right.size + bitOffset := tokensCodeLength (tokens left) + + tokensCodeLength (tokens right) + lastOneCount := left.size + lastOneBitOffset := tokensCodeLength (tokens left) } := by + rw [forwardScan_append_internal, forwardScan_tokens_internal, + forwardScan_tokens_internal] + simp [ForwardScanState.initial, ForwardScanState.afterFormula, + tokensCodeLength] + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/Internal.lean b/Complexitylib/Circuits/FormulaEncoding/Internal.lean new file mode 100644 index 00000000..0a70dd6b --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/Internal.lean @@ -0,0 +1,145 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.Encoding +import Complexitylib.Circuits.FormulaEncoding.Defs + +/-! +# Boolean-formula codec internals + +This module proves the stack-machine, round-trip, injectivity, and length +properties of the canonical postfix formula encoding. +-/ + +namespace Complexity + +namespace FormulaCode + +namespace Token + +/-- Internal exact length of one encoded token. -/ +theorem length_encode_internal (token : Token) : + token.encode.length = token.codeLength := by + cases token <;> + simp [encode, codeLength, CircuitCode.NatCode.length_encode] + +/-- Internal token-prefix round trip. -/ +theorem decodePrefix?_encode_append_internal + (token : Token) (suffix : List Bool) : + decodePrefix? (token.encode ++ suffix) = some (token, suffix) := by + cases token <;> + simp [encode, decodePrefix?] + +end Token + +/-- Internal composition law for the postfix stack machine. -/ +theorem run?_append_internal + (first second : List Token) (stack : List BoolFormula) : + run? (first ++ second) stack = + (run? first stack).bind (run? second) := by + induction first generalizing stack with + | nil => simp [run?] + | cons token first ih => + simp only [List.cons_append, run?] + cases happly : token.apply? stack with + | none => simp + | some next => simp [ih] + +/-- Internal stack specification for the postfix tokens of a formula. -/ +theorem run?_tokens_internal (formula : BoolFormula) + (stack : List BoolFormula) : + run? (tokens formula) stack = some (formula :: stack) := by + induction formula generalizing stack with + | var index => simp [tokens, run?, Token.apply?] + | tru => simp [tokens, run?, Token.apply?] + | fls => simp [tokens, run?, Token.apply?] + | neg formula ih => + rw [tokens, run?_append_internal, ih] + simp [run?, Token.apply?] + | conj left right ihLeft ihRight => + rw [tokens, run?_append_internal, + run?_append_internal, ihLeft] + simp only [Option.bind_some] + rw [ihRight] + simp [run?, Token.apply?] + | disj left right ihLeft ihRight => + rw [tokens, run?_append_internal, + run?_append_internal, ihLeft] + simp only [Option.bind_some] + rw [ihRight] + simp [run?, Token.apply?] + +/-- Internal reconstruction of a formula from its own postfix tokens. -/ +theorem build?_tokens_internal (formula : BoolFormula) : + build? (tokens formula) = some formula := by + simp [build?, run?_tokens_internal] + +/-- Internal exact token-count theorem. -/ +theorem length_tokens_internal (formula : BoolFormula) : + (tokens formula).length = formula.size := by + induction formula with + | var index => simp [tokens, BoolFormula.size] + | tru => simp [tokens, BoolFormula.size] + | fls => simp [tokens, BoolFormula.size] + | neg formula ih => simp [tokens, BoolFormula.size, ih] + | conj left right ihLeft ihRight => + simp [tokens, BoolFormula.size, ihLeft, ihRight] + omega + | disj left right ihLeft ihRight => + simp [tokens, BoolFormula.size, ihLeft, ihRight] + omega + +/-- Internal fixed-count token-list round trip. -/ +theorem decodeTokens?_flatMap_encode_append_internal + (stream : List Token) (suffix : List Bool) : + decodeTokens? stream.length (stream.flatMap Token.encode ++ suffix) = + some (stream, suffix) := by + induction stream with + | nil => simp [decodeTokens?] + | cons token stream ih => + simp [decodeTokens?, ih, List.append_assoc, + Token.decodePrefix?_encode_append_internal] + +/-- Internal formula-prefix round trip. -/ +theorem decodePrefix?_encode_append_internal + (formula : BoolFormula) (suffix : List Bool) : + decodePrefix? (encode formula ++ suffix) = some (formula, suffix) := by + simp [decodePrefix?, encode, List.append_assoc, + decodeTokens?_flatMap_encode_append_internal, build?_tokens_internal] + +/-- Internal exact-decoder round trip. -/ +theorem decode?_encode_internal (formula : BoolFormula) : + decode? (encode formula) = some formula := by + unfold decode? + rw [show encode formula = encode formula ++ [] by simp, + decodePrefix?_encode_append_internal] + +/-- Internal injectivity of canonical formula serialization. -/ +theorem encode_injective_internal : Function.Injective encode := by + intro left right heq + have hleft := decode?_encode_internal left + have hright := decode?_encode_internal right + rw [heq] at hleft + exact Option.some.inj (hleft.symm.trans hright) + +/-- Internal rejection of nonempty trailing data by exact decoding. -/ +theorem decode?_encode_append_eq_none_internal + (formula : BoolFormula) {suffix : List Bool} (hsuffix : suffix ≠ []) : + decode? (encode formula ++ suffix) = none := by + unfold decode? + rw [decodePrefix?_encode_append_internal] + simp [hsuffix] + +/-- Internal exact formula-code length. -/ +theorem length_encode_internal (formula : BoolFormula) : + (encode formula).length = + formula.size + 1 + + ((tokens formula).map Token.codeLength).sum := by + simp [encode, CircuitCode.NatCode.length_encode, List.length_flatMap, + Token.length_encode_internal, length_tokens_internal] + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/Navigation.lean b/Complexitylib/Circuits/FormulaEncoding/Navigation.lean new file mode 100644 index 00000000..8ff31eb5 --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/Navigation.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.Navigation.Defs +import Complexitylib.Circuits.FormulaEncoding.Navigation.Internal + +/-! +# Navigation in postfix formula codes + +The backward scan finds canonical subtree boundaries using only a token cursor +and one owed-subtree counter. These results supply the stack-free navigation +primitive used by streaming Barrington compilation. + +## Main results + +- `FormulaCode.backwardScan_tokens_reverse` -- a canonical subtree consumes + exactly one owed obligation. +- `FormulaCode.subtreeWidth?_tokens_root` -- exact whole-tree width. +- `FormulaCode.subtreeWidth?_tokens_neg_child` -- exact unary-child width. +- `FormulaCode.subtreeWidth?_tokens_binary_right` -- exact right-child width. +- `FormulaCode.subtreeWidth?_tokens_binary_left` -- exact left-child width. +- `FormulaCode.subtreeStart?_tokens_binary_right` -- exact right-child start. +- `FormulaCode.subtreeStart?_tokens_binary_left` -- exact left-child start. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- Scanning a canonical subtree backwards consumes exactly its token count +and then resumes with one fewer owed subtree. -/ +theorem backwardScan_tokens_reverse (formula : BoolFormula) + (suffix : List Token) (owed : ℕ) : + backwardScan ((tokens formula).reverse ++ suffix) (owed + 1) = + (backwardScan suffix owed).map fun consumed => + formula.size + consumed := + backwardScan_tokens_reverse_append_internal formula suffix owed + +/-- The whole canonical token stream is one subtree of width `formula.size`. -/ +theorem subtreeWidth?_tokens_root (formula : BoolFormula) : + subtreeWidth? (tokens formula) (formula.size - 1) = some formula.size := + subtreeWidth?_tokens_root_internal formula + +/-- The only child of a postfix negation has its formula's exact width. -/ +theorem subtreeWidth?_tokens_neg_child (formula : BoolFormula) : + subtreeWidth? (tokens (.neg formula)) (formula.size - 1) = + some formula.size := + subtreeWidth?_tokens_neg_child_internal formula + +/-- The only child of a canonical postfix negation starts at index zero. -/ +theorem subtreeStart?_tokens_neg_child (formula : BoolFormula) : + subtreeStart? (tokens (.neg formula)) (formula.size - 1) = some 0 := + subtreeStart?_tokens_neg_child_internal formula + +/-- In a canonical binary postfix stream, the right child ends immediately +before the operator and has its formula's exact width. -/ +theorem subtreeWidth?_tokens_binary_right + (left right : BoolFormula) (op : Token) : + subtreeWidth? (tokens left ++ tokens right ++ [op]) + (left.size + right.size - 1) = some right.size := + subtreeWidth?_tokens_binary_right_internal left right op + +/-- In a canonical binary postfix stream, the left child's own root query +recovers its exact width independently of the following right subtree. -/ +theorem subtreeWidth?_tokens_binary_left + (left right : BoolFormula) (op : Token) : + subtreeWidth? (tokens left ++ tokens right ++ [op]) + (left.size - 1) = some left.size := + subtreeWidth?_tokens_binary_left_internal left right op + +/-- The right subtree in a canonical binary postfix stream begins immediately +after the complete left subtree. -/ +theorem subtreeStart?_tokens_binary_right + (left right : BoolFormula) (op : Token) : + subtreeStart? (tokens left ++ tokens right ++ [op]) + (left.size + right.size - 1) = some left.size := + subtreeStart?_tokens_binary_right_internal left right op + +/-- The left subtree in a canonical binary postfix stream starts at zero. -/ +theorem subtreeStart?_tokens_binary_left + (left right : BoolFormula) (op : Token) : + subtreeStart? (tokens left ++ tokens right ++ [op]) + (left.size - 1) = some 0 := + subtreeStart?_tokens_binary_left_internal left right op + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/Navigation/Defs.lean b/Complexitylib/Circuits/FormulaEncoding/Navigation/Defs.lean new file mode 100644 index 00000000..9aeebb74 --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/Navigation/Defs.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.Defs + +/-! +# Navigation in postfix formula codes -- definitions + +Scanning a postfix token stream backwards makes subtree boundaries visible +with one counter. The counter records how many child subtrees are still owed: +a leaf discharges one obligation, a unary node replaces it by one, and a +binary node replaces it by two. +-/ + +namespace Complexity + +namespace FormulaCode + +namespace Token + +/-- Number of immediate formula children represented by a token. -/ +def arity : Token → ℕ + | .var _ | .tru | .fls => 0 + | .neg => 1 + | .conj | .disj => 2 + +end Token + +/-- Scan tokens in root-to-left order until every owed subtree has been +consumed, returning the number of inspected tokens. -/ +def backwardScan : List Token → ℕ → Option ℕ + | _, 0 => some 0 + | [], _ + 1 => none + | token :: rest, owed + 1 => + (backwardScan rest (owed + token.arity)).map (· + 1) + +/-- Width in tokens of the postfix subtree ending at `root`. The scan uses +only the prefix through `root`, read backwards. -/ +def subtreeWidth? (stream : List Token) (root : ℕ) : Option ℕ := + backwardScan (stream.take (root + 1)).reverse 1 + +/-- Start index of the postfix subtree ending at `root`. -/ +def subtreeStart? (stream : List Token) (root : ℕ) : Option ℕ := do + let width ← subtreeWidth? stream root + if width ≤ root + 1 then some (root + 1 - width) else none + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/Navigation/Internal.lean b/Complexitylib/Circuits/FormulaEncoding/Navigation/Internal.lean new file mode 100644 index 00000000..769ed381 --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/Navigation/Internal.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.Internal +import Complexitylib.Circuits.FormulaEncoding.Navigation.Defs + +/-! +# Navigation in postfix formula codes -- proof internals +-/ + +namespace Complexity + +namespace FormulaCode + +/-- Scanning one complete canonical subtree reduces the owed count by exactly +one and then continues into the supplied suffix. -/ +theorem backwardScan_tokens_reverse_append_internal + (formula : BoolFormula) (suffix : List Token) (owed : ℕ) : + backwardScan ((tokens formula).reverse ++ suffix) (owed + 1) = + (backwardScan suffix owed).map fun consumed => + formula.size + consumed := by + induction formula generalizing suffix owed with + | var index => + change (backwardScan suffix owed).map (· + 1) = + (backwardScan suffix owed).map fun consumed => 1 + consumed + cases backwardScan suffix owed with + | none => rfl + | some consumed => simp; omega + | tru => + change (backwardScan suffix owed).map (· + 1) = + (backwardScan suffix owed).map fun consumed => 1 + consumed + cases backwardScan suffix owed with + | none => rfl + | some consumed => simp; omega + | fls => + change (backwardScan suffix owed).map (· + 1) = + (backwardScan suffix owed).map fun consumed => 1 + consumed + cases backwardScan suffix owed with + | none => rfl + | some consumed => simp; omega + | neg formula ih => + simp only [tokens, List.reverse_append, List.reverse_singleton, + List.singleton_append, BoolFormula.size] + change (backwardScan ((tokens formula).reverse ++ suffix) + (owed + 1)).map (· + 1) = _ + rw [ih] + cases backwardScan suffix owed with + | none => rfl + | some consumed => simp; omega + | conj left right ihLeft ihRight => + simp only [tokens, List.reverse_append, List.reverse_singleton, + List.singleton_append, List.append_assoc, BoolFormula.size] + change (backwardScan ((tokens right).reverse ++ + ((tokens left).reverse ++ suffix)) (owed + 2)).map (· + 1) = _ + rw [show owed + 2 = (owed + 1) + 1 by omega] + rw [ihRight, ihLeft] + cases backwardScan suffix owed with + | none => rfl + | some consumed => simp; omega + | disj left right ihLeft ihRight => + simp only [tokens, List.reverse_append, List.reverse_singleton, + List.singleton_append, List.append_assoc, BoolFormula.size] + change (backwardScan ((tokens right).reverse ++ + ((tokens left).reverse ++ suffix)) (owed + 2)).map (· + 1) = _ + rw [show owed + 2 = (owed + 1) + 1 by omega] + rw [ihRight, ihLeft] + cases backwardScan suffix owed with + | none => rfl + | some consumed => simp; omega + +private theorem formula_size_pos_internal (formula : BoolFormula) : + 0 < formula.size := by + cases formula <;> simp [BoolFormula.size] + +theorem backwardScan_tokens_reverse_internal (formula : BoolFormula) : + backwardScan (tokens formula).reverse 1 = some formula.size := by + simpa using backwardScan_tokens_reverse_append_internal formula [] 0 + +theorem subtreeWidth?_tokens_root_internal (formula : BoolFormula) : + subtreeWidth? (tokens formula) (formula.size - 1) = some formula.size := by + rw [subtreeWidth?] + have hpositive := formula_size_pos_internal formula + have htake : (tokens formula).take (formula.size - 1 + 1) = + tokens formula := by + rw [show formula.size - 1 + 1 = formula.size by omega] + rw [← length_tokens_internal formula, List.take_length] + rw [htake] + exact backwardScan_tokens_reverse_internal formula + +theorem subtreeStart?_tokens_root_internal (formula : BoolFormula) : + subtreeStart? (tokens formula) (formula.size - 1) = some 0 := by + rw [subtreeStart?, subtreeWidth?_tokens_root_internal] + change (if formula.size ≤ formula.size - 1 + 1 then + some (formula.size - 1 + 1 - formula.size) else none) = some 0 + rw [if_pos (by + have hpositive := formula_size_pos_internal formula + omega)] + congr + have hpositive := formula_size_pos_internal formula + omega + +theorem subtreeWidth?_tokens_neg_child_internal (formula : BoolFormula) : + subtreeWidth? (tokens (.neg formula)) (formula.size - 1) = + some formula.size := by + rw [subtreeWidth?, tokens] + have hpositive := formula_size_pos_internal formula + have htake : (tokens formula ++ [Token.neg]).take + (formula.size - 1 + 1) = tokens formula := by + rw [show formula.size - 1 + 1 = formula.size by omega] + rw [← length_tokens_internal formula] + simp + rw [htake] + exact backwardScan_tokens_reverse_internal formula + +theorem subtreeStart?_tokens_neg_child_internal (formula : BoolFormula) : + subtreeStart? (tokens (.neg formula)) (formula.size - 1) = some 0 := by + rw [subtreeStart?, subtreeWidth?_tokens_neg_child_internal] + change (if formula.size ≤ formula.size - 1 + 1 then + some (formula.size - 1 + 1 - formula.size) else none) = some 0 + have hpositive := formula_size_pos_internal formula + rw [if_pos (by omega)] + congr + omega + +theorem subtreeWidth?_tokens_binary_right_internal + (left right : BoolFormula) (op : Token) : + subtreeWidth? (tokens left ++ tokens right ++ [op]) + (left.size + right.size - 1) = some right.size := by + rw [subtreeWidth?] + have hleftPositive := formula_size_pos_internal left + have hrightPositive := formula_size_pos_internal right + rw [show left.size + right.size - 1 + 1 = left.size + right.size by omega] + have hprefixLength : (tokens left ++ tokens right).length = + left.size + right.size := by + simp [length_tokens_internal] + have htake : (tokens left ++ tokens right ++ [op]).take + (left.size + right.size) = tokens left ++ tokens right := by + rw [← hprefixLength] + exact List.take_left + rw [htake] + rw [List.reverse_append] + have hscan := backwardScan_tokens_reverse_append_internal + right (tokens left).reverse 0 + simpa [backwardScan] using hscan + +theorem subtreeWidth?_tokens_binary_left_internal + (left right : BoolFormula) (op : Token) : + subtreeWidth? (tokens left ++ tokens right ++ [op]) + (left.size - 1) = some left.size := by + rw [subtreeWidth?] + have hleftPositive := formula_size_pos_internal left + have htake : (tokens left ++ tokens right ++ [op]).take + (left.size - 1 + 1) = tokens left := by + rw [show left.size - 1 + 1 = left.size by omega] + rw [← length_tokens_internal left] + simp + rw [htake] + exact backwardScan_tokens_reverse_internal left + +theorem subtreeStart?_tokens_binary_right_internal + (left right : BoolFormula) (op : Token) : + subtreeStart? (tokens left ++ tokens right ++ [op]) + (left.size + right.size - 1) = some left.size := by + rw [subtreeStart?, subtreeWidth?_tokens_binary_right_internal] + change (if right.size ≤ left.size + right.size - 1 + 1 then + some (left.size + right.size - 1 + 1 - right.size) else none) = + some left.size + have hleftPositive := formula_size_pos_internal left + have hrightPositive := formula_size_pos_internal right + rw [if_pos (by omega)] + congr + omega + +theorem subtreeStart?_tokens_binary_left_internal + (left right : BoolFormula) (op : Token) : + subtreeStart? (tokens left ++ tokens right ++ [op]) + (left.size - 1) = some 0 := by + rw [subtreeStart?, subtreeWidth?_tokens_binary_left_internal] + change (if left.size ≤ left.size - 1 + 1 then + some (left.size - 1 + 1 - left.size) else none) = some 0 + have hleftPositive := formula_size_pos_internal left + rw [if_pos (by omega)] + congr + omega + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation.lean b/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation.lean new file mode 100644 index 00000000..ec0293ef --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation.Defs +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation.Internal + +/-! +# Probe-oriented navigation in canonical formula codes + +This module replaces an in-memory formula bit list by a position-indexed bit +oracle. Explicit fuel makes every decoder total on malformed sources. On a +canonical encoded token stream, enough fuel recovers exactly the same tokens, +bit spans, subtree widths, and binary child segments as list-backed navigation. + +## Main results + +- `FormulaCode.BitOracle.tokenAt?_ofList_encodeTokenStream` gives exact token + access and its half-open bit span. +- `FormulaCode.BitOracle.encodedSubtreeWidth?_ofList_encodeTokenStream` agrees + with postfix token navigation. +- `FormulaCode.BitOracle.encodedBinaryChildren?_ofList_encodeTokenStream` + recovers exact child segments in arbitrary token context. +-/ + +namespace Complexity + +namespace FormulaCode + +namespace BitOracle + +/-- A terminated-unary natural can be decoded through position-indexed probes +at an arbitrary canonical field boundary. -/ +theorem decodeNatAt?_ofList_append_encode + (before after : List Bool) (value extraFuel accumulator : ℕ) : + decodeNatAt? + (ofList (before ++ CircuitCode.NatCode.encode value ++ after)) + (value + 1 + extraFuel) before.length accumulator = + some (accumulator + value, before.length + value + 1) := + decodeNatAt?_ofList_append_encode_internal before after value extraFuel + accumulator + +/-- Probing a canonical token field recovers the token and advances by exactly +its encoded length. -/ +theorem decodeTokenAt?_ofList_append_encode + (before after : List Bool) (token : Token) (extraFuel : ℕ) : + decodeTokenAt? (ofList (before ++ token.encode ++ after)) + (token.codeLength + extraFuel) before.length = + some (token, before.length + token.codeLength) := + decodeTokenAt?_ofList_append_encode_internal before after token extraFuel + +/-- The oracle decoder recovers the exact count and payload cursor of a +canonically framed token stream. -/ +theorem tokenHeader?_ofList_encodeTokenStream + (stream : List Token) (extraFuel : ℕ) : + tokenHeader? (ofList (encodeTokenStream stream)) + (stream.length + 1 + extraFuel) = + some ⟨stream.length, stream.length + 1⟩ := + tokenHeader?_ofList_encodeTokenStream_internal stream extraFuel + +/-- With enough fuel for the header and every token field, a valid ordinal +returns its exact token and half-open bit span. -/ +theorem tokenAt?_ofList_encodeTokenStream + (stream : List Token) (bitFuel index : ℕ) + (hheader : stream.length + 1 ≤ bitFuel) + (hindex : index < stream.length) + (hbound : ∀ token ∈ stream, token.codeLength ≤ bitFuel) : + tokenAt? (ofList (encodeTokenStream stream)) bitFuel index = + some + ⟨stream[index], stream.length + 1 + tokenBitOffset stream index, + stream.length + 1 + tokenBitOffset stream index + + stream[index].codeLength⟩ := + tokenAt?_ofList_encodeTokenStream_internal stream bitFuel index hheader + hindex hbound + +/-- Oracle token access returns the canonical token at every valid ordinal. -/ +theorem tokenValueAt?_ofList_encodeTokenStream + (stream : List Token) (bitFuel index : ℕ) + (hheader : stream.length + 1 ≤ bitFuel) + (hindex : index < stream.length) + (hbound : ∀ token ∈ stream, token.codeLength ≤ bitFuel) : + tokenValueAt? (ofList (encodeTokenStream stream)) bitFuel index = + some stream[index] := + tokenValueAt?_ofList_encodeTokenStream_internal stream bitFuel index hheader + hindex hbound + +/-- Oracle-driven backwards scanning agrees with token-list navigation on a +canonical framed stream. -/ +theorem encodedSubtreeWidth?_ofList_encodeTokenStream + (stream : List Token) (bitFuel root : ℕ) + (hheader : stream.length + 1 ≤ bitFuel) + (hroot : root < stream.length) + (hbound : ∀ token ∈ stream, token.codeLength ≤ bitFuel) : + encodedSubtreeWidth? (ofList (encodeTokenStream stream)) + bitFuel root = subtreeWidth? stream root := + encodedSubtreeWidth?_ofList_encodeTokenStream_internal stream bitFuel root + hheader hroot hbound + +/-- Oracle-driven scanning recovers a canonical subtree embedded between +arbitrary token prefixes and suffixes. -/ +theorem encodedSubtreeWidth?_ofList_encodeTokenStream_context + (before after : List Token) (formula : BoolFormula) (bitFuel : ℕ) + (hheader : (before ++ tokens formula ++ after).length + 1 ≤ bitFuel) + (hbound : ∀ token ∈ before ++ tokens formula ++ after, + token.codeLength ≤ bitFuel) : + encodedSubtreeWidth? + (ofList (encodeTokenStream (before ++ tokens formula ++ after))) + bitFuel (before.length + formula.size - 1) = + some formula.size := + encodedSubtreeWidth?_ofList_encodeTokenStream_context_internal before after + formula bitFuel hheader hbound + +/-- At a canonical binary postfix segment, oracle navigation recovers the +exact left and right child segments. -/ +theorem encodedBinaryChildren?_ofList_encodeTokenStream + (before after : List Token) (left right : BoolFormula) + (op : Token) (bitFuel : ℕ) + (hheader : + (before ++ tokens left ++ tokens right ++ [op] ++ after).length + 1 ≤ + bitFuel) + (hbound : ∀ token ∈ + before ++ tokens left ++ tokens right ++ [op] ++ after, + token.codeLength ≤ bitFuel) : + encodedBinaryChildren? + (ofList (encodeTokenStream + (before ++ tokens left ++ tokens right ++ [op] ++ after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := + encodedBinaryChildren?_ofList_encodeTokenStream_internal before after left + right op bitFuel hheader hbound + +end BitOracle + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation/Defs.lean b/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation/Defs.lean new file mode 100644 index 00000000..899d92af --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation/Defs.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.BitNavigation.Defs + +/-! +# Probe-oriented navigation in formula codes -- definitions + +An `OutputProbe` invocation exposes one source-output bit at a numeric position; +it does not expose the complete output list. This layer expresses formula-code +navigation against exactly that oracle. The explicit bit fuel makes malformed +or unterminated fields total, while canonical fields succeed once the fuel +covers the inspected prefix. +-/ + +namespace Complexity + +namespace FormulaCode + +/-- A random-access bit source. `none` denotes an unavailable position. -/ +abbrev BitOracle := ℕ → Option Bool + +namespace BitOracle + +/-- The random-access oracle backed by an in-memory bit list. -/ +def ofList (bits : List Bool) : BitOracle := fun index => bits[index]? + +/-- Scan one terminated-unary natural field. The cursor returned on success is +the first position following the zero terminator. -/ +def decodeNatAt? (query : BitOracle) : ℕ → ℕ → ℕ → + Option (ℕ × ℕ) + | 0, _, _ => none + | fuel + 1, cursor, value => do + let bit ← query cursor + if bit then + decodeNatAt? query fuel (cursor + 1) (value + 1) + else + some (value, cursor + 1) + +/-- Decode one postfix token by probing its three tag positions and, for a +variable, its following terminated-unary index. -/ +def decodeTokenAt? (query : BitOracle) (bitFuel cursor : ℕ) : + Option (Token × ℕ) := do + let tag₀ ← query cursor + let tag₁ ← query (cursor + 1) + let tag₂ ← query (cursor + 2) + match tag₀, tag₁, tag₂ with + | false, false, false => + let (index, nextBit) ← + decodeNatAt? query bitFuel (cursor + 3) 0 + some (.var index, nextBit) + | false, false, true => some (.tru, cursor + 3) + | false, true, false => some (.fls, cursor + 3) + | false, true, true => some (.neg, cursor + 3) + | true, false, false => some (.conj, cursor + 3) + | true, false, true => some (.disj, cursor + 3) + | true, true, _ => none + +/-- Decode the terminated-unary token count at the beginning of a formula +code. -/ +def tokenHeader? (query : BitOracle) (bitFuel : ℕ) : + Option TokenHeader := do + let (count, payloadStart) ← decodeNatAt? query bitFuel 0 0 + some ⟨count, payloadStart⟩ + +/-- Seek from a known token boundary to a relative postfix-token ordinal. -/ +def seekToken? (query : BitOracle) (bitFuel cursor : ℕ) : + ℕ → Option LocatedToken + | 0 => do + let (token, nextBit) ← decodeTokenAt? query bitFuel cursor + some ⟨token, cursor, nextBit⟩ + | index + 1 => do + let (_, nextBit) ← decodeTokenAt? query bitFuel cursor + seekToken? query bitFuel nextBit index + +/-- Locate one declared postfix-token ordinal using only position-indexed bit +queries. -/ +def tokenAt? (query : BitOracle) (bitFuel index : ℕ) : + Option LocatedToken := do + let header ← tokenHeader? query bitFuel + if index < header.count then + seekToken? query bitFuel header.payloadStart index + else + none + +/-- Query only the token value at one declared ordinal. -/ +def tokenValueAt? (query : BitOracle) (bitFuel index : ℕ) : Option Token := + (tokenAt? query bitFuel index).map LocatedToken.token + +/-- Width of the postfix subtree rooted at `root`, using only oracle token +queries. -/ +def encodedSubtreeWidth? (query : BitOracle) (bitFuel root : ℕ) : + Option ℕ := + backwardScanQuery? (tokenValueAt? query bitFuel) + (root + 1) (some root) 1 + +/-- Split a binary postfix segment using only oracle token queries. -/ +def encodedBinaryChildren? (query : BitOracle) (bitFuel : ℕ) + (segment : TokenSegment) : Option (TokenSegment × TokenSegment) := do + let root ← segment.root? + let body ← segment.dropRoot? + let rightRoot ← previousToken? root + let rightWidth ← encodedSubtreeWidth? query bitFuel rightRoot + if 0 < rightWidth ∧ rightWidth < body.width then + let leftWidth := body.width - rightWidth + some (⟨body.start, leftWidth⟩, + ⟨body.start + leftWidth, rightWidth⟩) + else + none + +end BitOracle + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation/Internal.lean b/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation/Internal.lean new file mode 100644 index 00000000..2ead9ddc --- /dev/null +++ b/Complexitylib/Circuits/FormulaEncoding/ProbeNavigation/Internal.lean @@ -0,0 +1,295 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation.Defs +import Complexitylib.Circuits.FormulaEncoding.BitNavigation.Internal + +/-! +# Probe-oriented navigation in formula codes -- proof internals +-/ + +namespace Complexity + +namespace FormulaCode + +namespace BitOracle + +private theorem ofList_append_boundary (before after : List Bool) + (bit : Bool) : + ofList (before ++ bit :: after) before.length = some bit := by + rw [ofList, List.getElem?_append_right (Nat.le_refl _)] + simp + +private theorem ofList_append_getElem (before payload after : List Bool) + (index : ℕ) (hindex : index < payload.length) : + ofList (before ++ payload ++ after) (before.length + index) = + some payload[index] := by + rw [show before ++ payload ++ after = before ++ (payload ++ after) by + simp [List.append_assoc]] + rw [ofList, List.getElem?_append_right (by omega)] + rw [show before.length + index - before.length = index by omega] + rw [List.getElem?_append_left hindex] + exact List.getElem?_eq_getElem hindex + +theorem decodeNatAt?_ofList_append_encode_internal + (before after : List Bool) (value extraFuel accumulator : ℕ) : + decodeNatAt? + (ofList + (before ++ CircuitCode.NatCode.encode value ++ after)) + (value + 1 + extraFuel) before.length accumulator = + some (accumulator + value, before.length + value + 1) := by + induction value generalizing before accumulator with + | zero => + simp only [CircuitCode.NatCode.encode, List.replicate_zero, + List.nil_append, Nat.zero_add, Nat.one_add] + rw [show before ++ [false] ++ after = before ++ false :: after by simp] + simp only [decodeNatAt?] + rw [ofList_append_boundary] + rfl + | succ value ih => + have hcode : CircuitCode.NatCode.encode (value + 1) = + true :: CircuitCode.NatCode.encode value := by + simp [CircuitCode.NatCode.encode, List.replicate_succ] + rw [hcode] + rw [show before ++ (true :: CircuitCode.NatCode.encode value) ++ after = + before ++ true :: (CircuitCode.NatCode.encode value ++ after) by + simp [List.append_assoc]] + rw [show value + 1 + 1 + extraFuel = + Nat.succ (value + 1 + extraFuel) by omega] + simp only [decodeNatAt?] + rw [ofList_append_boundary] + simpa [Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using + ih (before ++ [true]) (accumulator + 1) + +theorem decodeTokenAt?_ofList_append_encode_internal + (before after : List Bool) (token : Token) (extraFuel : ℕ) : + decodeTokenAt? (ofList (before ++ token.encode ++ after)) + (token.codeLength + extraFuel) before.length = + some (token, before.length + token.codeLength) := by + have h₀ := ofList_append_getElem before token.encode after 0 + (by cases token <;> simp [Token.encode]) + simp only [Nat.add_zero] at h₀ + have h₁ := ofList_append_getElem before token.encode after 1 + (by cases token <;> simp [Token.encode]) + have h₂ := ofList_append_getElem before token.encode after 2 + (by cases token <;> simp [Token.encode]) + rw [decodeTokenAt?, h₀, h₁, h₂] + cases token with + | var index => + have hnat : + decodeNatAt? + (ofList (before ++ Token.encode (.var index) ++ after)) + (Token.codeLength (.var index) + extraFuel) + (before.length + 3) 0 = + some (index, + before.length + Token.codeLength (.var index)) := by + simpa [Token.encode, Token.codeLength, List.append_assoc, + Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using + decodeNatAt?_ofList_append_encode_internal + (before ++ [false, false, false]) after index + (3 + extraFuel) 0 + rw [hnat] + simp [Token.encode] + | tru => rfl + | fls => rfl + | neg => rfl + | conj => rfl + | disj => rfl + +theorem decodeTokenAt?_ofList_append_encode_of_le_internal + (before after : List Bool) (token : Token) (bitFuel : ℕ) + (hfuel : token.codeLength ≤ bitFuel) : + decodeTokenAt? (ofList (before ++ token.encode ++ after)) + bitFuel before.length = + some (token, before.length + token.codeLength) := by + simpa [Nat.add_sub_of_le hfuel] using + decodeTokenAt?_ofList_append_encode_internal before after token + (bitFuel - token.codeLength) + +theorem tokenHeader?_ofList_encodeTokenStream_internal + (stream : List Token) (extraFuel : ℕ) : + tokenHeader? (ofList (encodeTokenStream stream)) + (stream.length + 1 + extraFuel) = + some ⟨stream.length, stream.length + 1⟩ := by + rw [tokenHeader?, encodeTokenStream] + have hnat := decodeNatAt?_ofList_append_encode_internal [] + (stream.flatMap Token.encode) stream.length extraFuel 0 + simp only [List.nil_append, List.length_nil] at hnat + rw [hnat] + simp + +theorem seekToken?_ofList_flatMap_encode_internal + (beforeBits suffix : List Bool) (stream : List Token) + (bitFuel index : ℕ) (hindex : index < stream.length) + (hbound : ∀ token ∈ stream, token.codeLength ≤ bitFuel) : + seekToken? + (ofList (beforeBits ++ stream.flatMap Token.encode ++ suffix)) + bitFuel beforeBits.length index = + some + ⟨stream[index], beforeBits.length + tokenBitOffset stream index, + beforeBits.length + tokenBitOffset stream index + + stream[index].codeLength⟩ := by + induction stream generalizing beforeBits index with + | nil => simp at hindex + | cons token stream ih => + have htoken : token.codeLength ≤ bitFuel := hbound token (by simp) + have htail : ∀ item ∈ stream, item.codeLength ≤ bitFuel := by + intro item hitem + exact hbound item (by simp [hitem]) + cases index with + | zero => + simp only [seekToken?, List.flatMap_cons, List.getElem_cons_zero, + tokenBitOffset, List.take_zero, tokensCodeLength, List.map_nil, + List.sum_nil, Nat.add_zero] + rw [show beforeBits ++ + (token.encode ++ stream.flatMap Token.encode) ++ suffix = + beforeBits ++ token.encode ++ + (stream.flatMap Token.encode ++ suffix) by + simp [List.append_assoc]] + rw [decodeTokenAt?_ofList_append_encode_of_le_internal + beforeBits (stream.flatMap Token.encode ++ suffix) token bitFuel + htoken] + rfl + | succ index => + have htailIndex : index < stream.length := by + simpa using hindex + simp only [seekToken?, List.flatMap_cons] + rw [show beforeBits ++ + (token.encode ++ stream.flatMap Token.encode) ++ suffix = + beforeBits ++ token.encode ++ + (stream.flatMap Token.encode ++ suffix) by + simp [List.append_assoc]] + rw [decodeTokenAt?_ofList_append_encode_of_le_internal + beforeBits (stream.flatMap Token.encode ++ suffix) token bitFuel + htoken] + simpa [List.append_assoc, tokenBitOffset, tokensCodeLength, + Nat.add_assoc] using + ih (beforeBits ++ token.encode) index htailIndex htail + +theorem tokenAt?_ofList_encodeTokenStream_internal + (stream : List Token) (bitFuel index : ℕ) + (hheader : stream.length + 1 ≤ bitFuel) + (hindex : index < stream.length) + (hbound : ∀ token ∈ stream, token.codeLength ≤ bitFuel) : + tokenAt? (ofList (encodeTokenStream stream)) bitFuel index = + some + ⟨stream[index], stream.length + 1 + tokenBitOffset stream index, + stream.length + 1 + tokenBitOffset stream index + + stream[index].codeLength⟩ := by + have hheaderExact : + tokenHeader? (ofList (encodeTokenStream stream)) bitFuel = + some ⟨stream.length, stream.length + 1⟩ := by + simpa [Nat.add_sub_of_le hheader] using + tokenHeader?_ofList_encodeTokenStream_internal stream + (bitFuel - (stream.length + 1)) + rw [tokenAt?, hheaderExact] + change (if index < stream.length then + seekToken? (ofList (encodeTokenStream stream)) bitFuel + (stream.length + 1) index + else none) = _ + rw [if_pos hindex, encodeTokenStream] + simpa [CircuitCode.NatCode.length_encode] using + seekToken?_ofList_flatMap_encode_internal + (CircuitCode.NatCode.encode stream.length) [] stream bitFuel index + hindex hbound + +theorem tokenValueAt?_ofList_encodeTokenStream_internal + (stream : List Token) (bitFuel index : ℕ) + (hheader : stream.length + 1 ≤ bitFuel) + (hindex : index < stream.length) + (hbound : ∀ token ∈ stream, token.codeLength ≤ bitFuel) : + tokenValueAt? (ofList (encodeTokenStream stream)) bitFuel index = + some stream[index] := by + rw [tokenValueAt?, tokenAt?_ofList_encodeTokenStream_internal stream + bitFuel index hheader hindex hbound] + rfl + +theorem encodedSubtreeWidth?_ofList_encodeTokenStream_internal + (stream : List Token) (bitFuel root : ℕ) + (hheader : stream.length + 1 ≤ bitFuel) + (hroot : root < stream.length) + (hbound : ∀ token ∈ stream, token.codeLength ≤ bitFuel) : + encodedSubtreeWidth? (ofList (encodeTokenStream stream)) + bitFuel root = subtreeWidth? stream root := by + rw [encodedSubtreeWidth?, subtreeWidth?] + apply backwardScanQuery?_eq_backwardScan_internal stream + (tokenValueAt? (ofList (encodeTokenStream stream)) bitFuel) + root hroot + intro index hindex + have hvalid : index < stream.length := by omega + rw [tokenValueAt?_ofList_encodeTokenStream_internal stream bitFuel + index hheader hvalid hbound, List.getElem?_eq_getElem hvalid] + +theorem encodedSubtreeWidth?_ofList_encodeTokenStream_context_internal + (before after : List Token) (formula : BoolFormula) (bitFuel : ℕ) + (hheader : (before ++ tokens formula ++ after).length + 1 ≤ bitFuel) + (hbound : ∀ token ∈ before ++ tokens formula ++ after, + token.codeLength ≤ bitFuel) : + encodedSubtreeWidth? + (ofList (encodeTokenStream (before ++ tokens formula ++ after))) + bitFuel (before.length + formula.size - 1) = + some formula.size := by + have hpositive : 0 < formula.size := by + cases formula <;> simp [BoolFormula.size] + rw [encodedSubtreeWidth?_ofList_encodeTokenStream_internal] + · exact subtreeWidth?_tokens_context_internal before after formula + · exact hheader + · simp + omega + · exact hbound + +theorem encodedBinaryChildren?_ofList_encodeTokenStream_internal + (before after : List Token) (left right : BoolFormula) + (op : Token) (bitFuel : ℕ) + (hheader : + (before ++ tokens left ++ tokens right ++ [op] ++ after).length + 1 ≤ + bitFuel) + (hbound : ∀ token ∈ + before ++ tokens left ++ tokens right ++ [op] ++ after, + token.codeLength ≤ bitFuel) : + encodedBinaryChildren? + (ofList (encodeTokenStream + (before ++ tokens left ++ tokens right ++ [op] ++ after))) + bitFuel ⟨before.length, left.size + right.size + 1⟩ = + some (⟨before.length, left.size⟩, + ⟨before.length + left.size, right.size⟩) := by + have hleftPositive : 0 < left.size := by + cases left <;> simp [BoolFormula.size] + have hrightPositive : 0 < right.size := by + cases right <;> simp [BoolFormula.size] + rw [encodedBinaryChildren?] + simp only [TokenSegment.root?, TokenSegment.dropRoot?, + Option.bind_eq_bind, Option.bind_some] + rw [show before.length + (left.size + right.size) = + (before.length + left.size + right.size - 1) + 1 by omega] + simp only [previousToken?, Option.bind_some] + change (do + let rightWidth ← encodedSubtreeWidth? + (ofList (encodeTokenStream + (before ++ tokens left ++ tokens right ++ [op] ++ after))) + bitFuel (before.length + left.size + right.size - 1) + if 0 < rightWidth ∧ rightWidth < left.size + right.size then + some (TokenSegment.mk before.length + (left.size + right.size - rightWidth), + TokenSegment.mk + (before.length + (left.size + right.size - rightWidth)) + rightWidth) + else none) = _ + rw [show before ++ tokens left ++ tokens right ++ [op] ++ after = + (before ++ tokens left) ++ tokens right ++ ([op] ++ after) by + simp [List.append_assoc]] at hheader hbound ⊢ + rw [show before.length + left.size + right.size - 1 = + (before ++ tokens left).length + right.size - 1 by simp] + rw [encodedSubtreeWidth?_ofList_encodeTokenStream_context_internal + (before ++ tokens left) ([op] ++ after) right bitFuel hheader hbound] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [if_pos (by omega)] + congr <;> omega + +end BitOracle + +end FormulaCode + +end Complexity diff --git a/Complexitylib/Classes.lean b/Complexitylib/Classes.lean index dc8ceb19..e3496645 100644 --- a/Complexitylib/Classes.lean +++ b/Complexitylib/Classes.lean @@ -15,6 +15,7 @@ import Complexitylib.Classes.PPoly import Complexitylib.Classes.PPoly.Advice import Complexitylib.Classes.PPoly.Unrolling import Complexitylib.Classes.PPoly.Uniform +import Complexitylib.Classes.BarringtonUniform import Complexitylib.Classes.PPoly.Uniform.Unrolling import Complexitylib.Classes.PPoly.Uniform.Unrolling.Padded import Complexitylib.Classes.PPoly.Uniform.Unrolling.Containment @@ -71,6 +72,6 @@ import Complexitylib.Classes.Hierarchy Aggregation module for the class definitions and their relationships: time and space classes, `P`, `NP`, randomized and nonuniform classes, the -logspace-uniform circuit containment in `P`, function classes, reductions, -containments, and the time hierarchy. +logspace-uniform circuit containment in `P`, uniform Barrington family classes, +function classes, reductions, containments, and the time hierarchy. -/ diff --git a/Complexitylib/Classes/BarringtonUniform.lean b/Complexitylib/Classes/BarringtonUniform.lean new file mode 100644 index 00000000..3cb41ce4 --- /dev/null +++ b/Complexitylib/Classes/BarringtonUniform.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Classes.BarringtonUniform.Defs +import Complexitylib.Classes.BarringtonUniform.Internal + +/-! +# Log-space-uniform Barrington families + +Formula and width-`5` branching-program families are uniform when an `FL` +transducer emits their canonical member code on unary input. The executable +Barrington compiler gives a concrete program family with one fixed decision +point, exact semantics, and polynomial length for every log-depth source +family. + +The only missing forward-uniformity statement is isolated as +`UniformBarringtonCompilation`: the concrete compiled family of a uniform +log-depth formula family is itself uniform. The conditional containment theorem +shows that proving this one machine-level obligation completes the forward +uniform Barrington theorem. No claim is made that the unbounded formula-code +compiler lies in `FL` on arbitrary inputs. + +## Main results + +- `FormulaFamily.barringtonProgram_polynomialLength` -- explicit polynomial + length. +- `FormulaFamily.Uniform.code_polynomial_length` -- uniform source codes have + polynomial length. +- `FormulaFamily.barringtonProgram_code_polynomial_length` -- the complete + compiled program code, including variable fields, has polynomial length. +- `FormulaFamily.barringtonProgram_code_index_width_log` -- a binary cursor + into that code is logarithmic-width. +- `FormulaFamily.barringtonProgram_decides` -- exact fixed-point semantics. +- `uniformFormulaNC1_subset_uniformWidth5BP_of_compilation` -- reduction of the + uniform forward theorem to the named generator obligation. +-/ + +namespace Complexity + +/-- Forgetting formula-family uniformity gives the nonuniform formula class. -/ +theorem uniformFormulaNC1_subset_formulaNC1 : + UniformFormulaNC1 ⊆ FormulaNC1 := + uniformFormulaNC1_subset_formulaNC1_internal + +/-- Forgetting branching-program uniformity gives the nonuniform class. -/ +theorem uniformWidth5BP_subset_width5BP : + UniformWidth5BP ⊆ Width5BP := + uniformWidth5BP_subset_width5BP_internal + +namespace FormulaFamily + +/-- The canonical codes of a log-space-uniform formula family have polynomial +length in the unary family index. -/ +theorem Uniform.code_polynomial_length + {family : FormulaFamily} (huniform : family.Uniform) : + ∃ p : Polynomial ℕ, ∀ n, + (FormulaCode.encode (family n)).length ≤ p.eval n := + huniform.code_polynomial_length_internal + +/-- A log-depth formula family compiles through the executable construction to +a concrete polynomial-length width-`5` family. -/ +theorem barringtonProgram_polynomialLength + (family : FormulaFamily) (hdepth : family.LogDepth) : + family.barringtonProgram.PolynomialLength := + family.barringtonProgram_polynomialLength_internal hdepth + +/-- The full canonical code of the concrete Barrington family has polynomial +length whenever the source family is both log-depth and uniform. This bound +includes the terminated-unary variable indices, not just the number of +instructions. -/ +theorem barringtonProgram_code_polynomial_length + (family : FormulaFamily) (hdepth : family.LogDepth) + (huniform : family.Uniform) : + ∃ p : Polynomial ℕ, ∀ n, + (BPCode.Program.encode (family.barringtonProgram n)).length ≤ + p.eval n := + family.barringtonProgram_code_polynomial_length_internal hdepth huniform + +/-- A binary cursor into the complete canonical code of the concrete +Barrington family occupies logarithmic space. This is the numeric resource +bound needed by the remaining streaming/recomputation generator. -/ +theorem barringtonProgram_code_index_width_log + (family : FormulaFamily) (hdepth : family.LogDepth) + (huniform : family.Uniform) : + (fun n => + (BPCode.Program.encode (family.barringtonProgram n)).length.size) =O + (fun n => Nat.log 2 n) := + family.barringtonProgram_code_index_width_log_internal hdepth huniform + +/-- The concrete compiled family decides source-formula evaluation by testing +whether the fixed point zero moves. -/ +theorem barringtonProgram_decides (family : FormulaFamily) : + family.barringtonProgram.Decides (fun _ => 0) + (fun n assignment => BoolFormula.eval assignment (family n)) := + family.barringtonProgram_decides_internal + +/-- The concrete compiled family decides any function computed by the source +formula family. -/ +theorem barringtonProgram_decides_of_computes + {family : FormulaFamily} {function : ℕ → (ℕ → Bool) → Bool} + (hcomputes : family.Computes function) : + family.barringtonProgram.Decides (fun _ => 0) function := + family.barringtonProgram_decides_of_computes_internal hcomputes + +end FormulaFamily + +/-- Once explicit compilation is proved to preserve promised family +uniformity, uniform log-depth formulas are contained in uniform width-`5` +branching programs. -/ +theorem uniformFormulaNC1_subset_uniformWidth5BP_of_compilation + (hcompilation : UniformBarringtonCompilation) : + UniformFormulaNC1 ⊆ UniformWidth5BP := + uniformFormulaNC1_subset_uniformWidth5BP_of_compilation_internal hcompilation + +end Complexity diff --git a/Complexitylib/Classes/BarringtonUniform/Defs.lean b/Complexitylib/Classes/BarringtonUniform/Defs.lean new file mode 100644 index 00000000..c74ff21d --- /dev/null +++ b/Complexitylib/Classes/BarringtonUniform/Defs.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Classes.PPoly.Uniform +import Complexitylib.Circuits.BarringtonCodeGenerator +import Complexitylib.Circuits.BarringtonConverse + +/-! +# Uniform Barrington classes -- definitions + +This file gives formula families and width-`5` branching-program families the +same canonical log-space uniformity contract already used for circuit families: +an `FL` transducer emits the codec for the length-`n` member on unary input +`1^n`. + +It also names the exact remaining forward-uniformity obligation. The executable +compiler defines a concrete program family; `UniformBarringtonCompilation` says +that a log-depth uniform formula family makes that concrete family uniform. +Unlike a claim about the unbounded formula-code transformer on every input, +this promise-family statement permits a total generator to stay polynomial on +off-family inputs. +-/ + +namespace Complexity + +namespace FormulaFamily + +/-- A formula family is log-space uniform when an `FL` generator emits its +canonical postfix code on unary family indices. -/ +def Uniform (family : FormulaFamily) : Prop := + ∃ generator ∈ FL, ∀ n, + generator (unaryList n) = FormulaCode.encode (family n) + +/-- The concrete width-`5` family produced by the executable Barrington +compiler at its fixed canonical target cycle. -/ +def barringtonProgram (family : FormulaFamily) : BPFamily 5 := + fun n => barringtonCompile (family n) barringtonTargetBase + +end FormulaFamily + +namespace BPFamily + +/-- A width-`5` branching-program family is log-space uniform when an `FL` +generator emits its canonical program code on unary family indices. -/ +def Uniform (family : BPFamily 5) : Prop := + ∃ generator ∈ FL, ∀ n, + generator (unaryList n) = BPCode.Program.encode (family n) + +end BPFamily + +/-- Functions computed by log-depth, log-space-uniform formula families. -/ +def UniformFormulaNC1 : Set (ℕ → (ℕ → Bool) → Bool) := + {function | ∃ family : FormulaFamily, + family.LogDepth ∧ family.Uniform ∧ family.Computes function} + +/-- Functions decided by polynomial-length, log-space-uniform width-`5` +permutation branching-program families. -/ +def UniformWidth5BP : Set (ℕ → (ℕ → Bool) → Bool) := + {function | ∃ (family : BPFamily 5) (point : ℕ → Fin 5), + family.PolynomialLength ∧ family.Uniform ∧ + family.Decides point function} + +/-- The exact remaining forward-uniformity obligation: explicit Barrington +compilation preserves uniformity under the logarithmic-depth promise. -/ +def UniformBarringtonCompilation : Prop := + ∀ family : FormulaFamily, + family.LogDepth → family.Uniform → family.barringtonProgram.Uniform + +end Complexity diff --git a/Complexitylib/Classes/BarringtonUniform/Internal.lean b/Complexitylib/Classes/BarringtonUniform/Internal.lean new file mode 100644 index 00000000..3398390a --- /dev/null +++ b/Complexitylib/Classes/BarringtonUniform/Internal.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Classes.BarringtonUniform.Defs +import Complexitylib.Classes.L.PolynomialTime + +/-! +# Uniform Barrington classes -- proof internals +-/ + +namespace Complexity + +/-- Internal forgetful containment for uniform formula families. -/ +theorem uniformFormulaNC1_subset_formulaNC1_internal : + UniformFormulaNC1 ⊆ FormulaNC1 := by + rintro function ⟨family, hdepth, _huniform, hcomputes⟩ + exact ⟨family, hdepth, hcomputes⟩ + +/-- Internal forgetful containment for uniform branching-program families. -/ +theorem uniformWidth5BP_subset_width5BP_internal : + UniformWidth5BP ⊆ Width5BP := by + rintro function ⟨family, point, hlength, _huniform, hdecides⟩ + exact ⟨family, point, hlength, hdecides⟩ + +/-- Internal polynomial bound for the canonical codes emitted by a uniform +formula family. -/ +theorem FormulaFamily.Uniform.code_polynomial_length_internal + {family : FormulaFamily} (huniform : family.Uniform) : + ∃ p : Polynomial ℕ, ∀ n, + (FormulaCode.encode (family n)).length ≤ p.eval n := by + obtain ⟨generator, hgenerator, hcorrect⟩ := huniform + obtain ⟨p, hp⟩ := mem_FL_polynomial_output_length hgenerator + refine ⟨p, fun n => ?_⟩ + rw [← hcorrect n] + simpa only [unaryList, List.length_replicate] using + hp (unaryList n) + +/-- Internal polynomial-length theorem for the concrete compiled family. -/ +theorem FormulaFamily.barringtonProgram_polynomialLength_internal + (family : FormulaFamily) (hdepth : family.LogDepth) : + family.barringtonProgram.PolynomialLength := by + obtain ⟨constant, hconstant⟩ := hdepth + refine ⟨4 ^ constant, 2 * constant, fun n => ?_⟩ + calc + (family.barringtonProgram n).length ≤ 4 ^ (family n).depth := + barringtonCompile_length_le (family n) barringtonTargetBase + _ ≤ 4 ^ (constant * Nat.log 2 n + constant) := + Nat.pow_le_pow_right (by omega) (hconstant n) + _ ≤ 4 ^ constant * (n + 1) ^ (2 * constant) := + pow4_poly constant n + +/-- Internal polynomial bound for the complete canonical code of the concrete +compiled family. Unlike instruction-count polynomiality, this also accounts +for the terminated-unary variable fields. -/ +theorem FormulaFamily.barringtonProgram_code_polynomial_length_internal + (family : FormulaFamily) (hdepth : family.LogDepth) + (huniform : family.Uniform) : + ∃ p : Polynomial ℕ, ∀ n, + (BPCode.Program.encode (family.barringtonProgram n)).length ≤ + p.eval n := by + obtain ⟨constant, hconstant⟩ := hdepth + obtain ⟨codePolynomial, hcode⟩ := + huniform.code_polynomial_length_internal + let constructionBound : Polynomial ℕ := + Polynomial.C (4 ^ constant) * + (Polynomial.X + 1) ^ (2 * constant) + let outputPolynomial : Polynomial ℕ := + constructionBound + 1 + + constructionBound * (codePolynomial + 15) + refine ⟨outputPolynomial, fun n => ?_⟩ + have hconstruction : + 4 ^ (family n).depth ≤ + 4 ^ constant * (n + 1) ^ (2 * constant) := by + calc + 4 ^ (family n).depth ≤ + 4 ^ (constant * Nat.log 2 n + constant) := + Nat.pow_le_pow_right (by omega) (hconstant n) + _ ≤ 4 ^ constant * (n + 1) ^ (2 * constant) := + pow4_poly constant n + calc + (BPCode.Program.encode (family.barringtonProgram n)).length = + (barringtonCompileCode + (FormulaCode.encode (family n))).length := by + rw [barringtonCompileCode_encode] + rfl + _ ≤ 4 ^ (family n).depth + 1 + + 4 ^ (family n).depth * + ((FormulaCode.encode (family n)).length + 15) := + length_barringtonCompileCode_encode_le (family n) + _ ≤ 4 ^ constant * (n + 1) ^ (2 * constant) + 1 + + (4 ^ constant * (n + 1) ^ (2 * constant)) * + (codePolynomial.eval n + 15) := by + gcongr + exact hcode n + _ = outputPolynomial.eval n := by + simp [outputPolynomial, constructionBound] + +/-- Internal logarithmic-width bound for an index into the concrete compiled +program code. -/ +theorem FormulaFamily.barringtonProgram_code_index_width_log_internal + (family : FormulaFamily) (hdepth : family.LogDepth) + (huniform : family.Uniform) : + (fun n => + (BPCode.Program.encode (family.barringtonProgram n)).length.size) =O + (fun n => Nat.log 2 n) := by + obtain ⟨p, hp⟩ := + family.barringtonProgram_code_polynomial_length_internal hdepth huniform + exact BigO.natSize_of_pow (BigO.of_polynomial_bound p hp) + +/-- Internal exact decision semantics of the concrete compiled family. -/ +theorem FormulaFamily.barringtonProgram_decides_internal + (family : FormulaFamily) : + family.barringtonProgram.Decides (fun _ => 0) + (fun n assignment => BoolFormula.eval assignment (family n)) := by + intro n assignment + change BP.eval assignment + (barringtonCompile (family n) barringtonTargetBase) 0 ≠ 0 ↔ + BoolFormula.eval assignment (family n) = true + rw [(barringtonCompile_computes (family n) barringtonTargetBase + barringtonTargetBase_spec.1 barringtonTargetBase_spec.2) assignment] + cases heval : BoolFormula.eval assignment (family n) <;> + simp [heval, barringtonTargetBase_moves_zero] + +/-- Internal decision theorem after identifying the formula family's semantic +function. -/ +theorem FormulaFamily.barringtonProgram_decides_of_computes_internal + {family : FormulaFamily} {function : ℕ → (ℕ → Bool) → Bool} + (hcomputes : family.Computes function) : + family.barringtonProgram.Decides (fun _ => 0) function := by + intro n assignment + simpa only [hcomputes n assignment] using + family.barringtonProgram_decides_internal n assignment + +/-- Internal reduction of uniform Barrington's forward direction to the one +named compilation-uniformity obligation. -/ +theorem uniformFormulaNC1_subset_uniformWidth5BP_of_compilation_internal + (hcompilation : UniformBarringtonCompilation) : + UniformFormulaNC1 ⊆ UniformWidth5BP := by + rintro function ⟨family, hdepth, huniform, hcomputes⟩ + refine ⟨family.barringtonProgram, fun _ => 0, + family.barringtonProgram_polynomialLength_internal hdepth, + hcompilation family hdepth huniform, + family.barringtonProgram_decides_of_computes_internal hcomputes⟩ + +end Complexity diff --git a/Complexitylib/Classes/L/PolynomialTime.lean b/Complexitylib/Classes/L/PolynomialTime.lean index 950065c9..244e961e 100644 --- a/Complexitylib/Classes/L/PolynomialTime.lean +++ b/Complexitylib/Classes/L/PolynomialTime.lean @@ -18,6 +18,10 @@ bound. Consequently `L ⊆ P` and `FL ⊆ FP`. polynomial reduced-configuration bound - `L_subset_P` — deterministic log-space languages are polynomial-time - `FL_subset_FP` — deterministic log-space functions are polynomial-time +- `mem_FL_polynomial_output_length` — their output length is polynomially + bounded +- `mem_FL_output_bound_log_width` — an index into that bound fits in + logarithmic space -/ namespace Complexity @@ -48,4 +52,25 @@ computable in polynomial time.** -/ theorem FL_subset_FP : FL ⊆ FP := FL_subset_FP_internal +/-- Every deterministic log-space transducer function has output length +bounded pointwise by a polynomial in its input length. This is the key size +fact used by recomputation-based log-space composition: an output position +needs only logarithmically many bits. -/ +theorem mem_FL_polynomial_output_length + {f : List Bool → List Bool} (hf : f ∈ FL) : + ∃ p : Polynomial ℕ, ∀ input, + (f input).length ≤ p.eval input.length := + mem_FL_polynomial_output_length_internal hf + +/-- Every `FL` function admits a polynomial output bound whose binary width is +logarithmic. Thus a recomputation-based consumer can keep an output position +in `O(log n)` auxiliary space even though the output itself may be +polynomially long. -/ +theorem mem_FL_output_bound_log_width + {f : List Bool → List Bool} (hf : f ∈ FL) : + ∃ p : Polynomial ℕ, + (∀ input, (f input).length ≤ p.eval input.length) ∧ + (fun n => (p.eval n).size) =O (fun n => Nat.log 2 n) := + mem_FL_output_bound_log_width_internal hf + end Complexity diff --git a/Complexitylib/Classes/L/PolynomialTime/Internal.lean b/Complexitylib/Classes/L/PolynomialTime/Internal.lean index 59b4ec05..a28facb9 100644 --- a/Complexitylib/Classes/L/PolynomialTime/Internal.lean +++ b/Complexitylib/Classes/L/PolynomialTime/Internal.lean @@ -5,6 +5,7 @@ Authors: Samuel Schlesinger -/ import Complexitylib.Classes.L import Complexitylib.Classes.P.Defs +import Complexitylib.Models.TuringMachine.OutputBounds import Complexitylib.Models.TuringMachine.SpaceTime /-! @@ -130,4 +131,27 @@ theorem FL_subset_FP_internal : FL ⊆ FP := by fun n => tm.transducerConfigBound n (S n), hcomp.computesInTime_configBound, htime⟩ +/-- Internal polynomial output-length bound for every log-space transducer +function. -/ +theorem mem_FL_polynomial_output_length_internal + {f : List Bool → List Bool} (hf : f ∈ FL) : + ∃ p : Polynomial ℕ, ∀ input, + (f input).length ≤ p.eval input.length := by + obtain ⟨_d, _k, tm, time, hcomputes, htime⟩ := + FL_subset_FP_internal hf + obtain ⟨p, hp⟩ := BigO.pow_polynomial_bound htime + exact ⟨p, fun input => + (hcomputes.output_length_le input).trans (hp input.length)⟩ + +/-- Internal logarithmic-width corollary for a polynomial output bound. -/ +theorem mem_FL_output_bound_log_width_internal + {f : List Bool → List Bool} (hf : f ∈ FL) : + ∃ p : Polynomial ℕ, + (∀ input, (f input).length ≤ p.eval input.length) ∧ + (fun n => (p.eval n).size) =O (fun n => Nat.log 2 n) := by + obtain ⟨p, hp⟩ := mem_FL_polynomial_output_length_internal hf + refine ⟨p, hp, ?_⟩ + exact BigO.natSize_of_pow + (BigO.of_polynomial_bound p (fun _ => le_rfl)) + end Complexity diff --git a/Complexitylib/Models.lean b/Complexitylib/Models.lean index 49b039cb..55b9b15b 100644 --- a/Complexitylib/Models.lean +++ b/Complexitylib/Models.lean @@ -7,6 +7,7 @@ import Complexitylib.Models.TuringMachine import Complexitylib.Models.TuringMachine.Trace import Complexitylib.Models.TuringMachine.SingleTape import Complexitylib.Models.TuringMachine.Combinators +import Complexitylib.Models.TuringMachine.Combinators.Started import Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork import Complexitylib.Models.TuringMachine.Combinators.ForInput import Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes @@ -37,6 +38,8 @@ import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor import Complexitylib.Models.TuringMachine.Subroutines.BinaryLength import Complexitylib.Models.TuringMachine.Subroutines.BinaryPred import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefix +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefixMany import Complexitylib.Models.TuringMachine.Subroutines.ClearWork import Complexitylib.Models.TuringMachine.Subroutines.CopyOutput import Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput @@ -46,9 +49,25 @@ import Complexitylib.Models.TuringMachine.Subroutines.PairSplit import Complexitylib.Models.TuringMachine.Subroutines.ScanRight import Complexitylib.Models.TuringMachine.Subroutines.ResetBinary import Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +import Complexitylib.Models.TuringMachine.Subroutines.RewindInputSpace import Complexitylib.Models.TuringMachine.Subroutines.UnaryLength import Complexitylib.Models.TuringMachine.OutputBounds +import Complexitylib.Models.TuringMachine.OutputCursor +import Complexitylib.Models.TuringMachine.OutputProbe +import Complexitylib.Models.TuringMachine.OutputProbeConsume +import Complexitylib.Models.TuringMachine.OutputProbeCountOnes +import Complexitylib.Models.TuringMachine.OutputProbeDecodeNat +import Complexitylib.Models.TuringMachine.OutputProbeDecodeTag +import Complexitylib.Models.TuringMachine.OutputProbeDecodeToken +import Complexitylib.Models.TuringMachine.OutputProbeDispatch +import Complexitylib.Models.TuringMachine.OutputProbeLatch +import Complexitylib.Models.TuringMachine.OutputProbeIndexed +import Complexitylib.Models.TuringMachine.OutputProbeScan +import Complexitylib.Models.TuringMachine.OutputProbeCleanup +import Complexitylib.Models.TuringMachine.OutputProbeFrame +import Complexitylib.Models.TuringMachine.RetargetOutputFrame import Complexitylib.Models.TuringMachine.SpaceTime +import Complexitylib.Models.TuringMachine.SpaceTime.WorkSupport import Complexitylib.Models.TuringMachine.Placement import Complexitylib.Models.TuringMachine.Composition import Complexitylib.Models.TuringMachine.Composition.PairWithInput @@ -80,7 +99,7 @@ reusable read-only-input and binary-work-tape loops, binary count-up loops, binary successor, binary predecessor and length, value-iterating and width-linear canonical binary addition, fixed-constant addition, copying, multiply-add, and fixed-polynomial -evaluation, framed work-tape clearing, +evaluation, framed work-tape clearing and binary-bounded sparse-prefix reset, unary length, and pair-emission subroutines, computed-value/input fanout, finite space-to-time bounds, determinism results, the universal machine, and the logarithmic-cost random access machine diff --git a/Complexitylib/Models/TuringMachine/Combinators/Started.lean b/Complexitylib/Models/TuringMachine/Combinators/Started.lean new file mode 100644 index 00000000..078524d6 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Combinators/Started.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators.Started.Defs +import Complexitylib.Models.TuringMachine.Combinators.Started.Internal + +/-! +# Resuming a machine after its sentinel transition + +`TM.startedTM` gives phase composition a reusable way to enter an ordinary +machine after its compulsory first transition from the all-`▷` configuration. +It changes only the start state; concrete stepping, halting, and the transducer +discipline are inherited exactly. + +## Main results + +- `TM.startedTM_step_eq` -- started and source concrete steps are identical. +- `TM.startedTM_reachesIn_of_source` -- source runs transfer unchanged. +- `TM.source_reachesIn_of_startedTM` -- started runs transfer back unchanged. +- `TM.IsTransducer.startedTM` -- one-way output safety is preserved. +-/ + +namespace Complexity + +namespace TM + +/-- The started wrapper and source have identical concrete step functions. -/ +theorem startedTM_step_eq (tm : TM n) (cfg : Cfg n tm.Q) : + tm.startedTM.step cfg = tm.step cfg := + startedTM_step_eq_internal tm cfg + +/-- Every exact source run is an exact run of the started wrapper from the +same configuration. -/ +theorem startedTM_reachesIn_of_source (tm : TM n) + {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') : + tm.startedTM.reachesIn steps cfg cfg' := + startedTM_reachesIn_of_source_internal tm hreach + +/-- Every exact started-wrapper run is an exact source run from the same +configuration. -/ +theorem source_reachesIn_of_startedTM (tm : TM n) + {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.startedTM.reachesIn steps cfg cfg') : + tm.reachesIn steps cfg cfg' := + source_reachesIn_of_startedTM_internal tm hreach + +/-- A nonhalted source gives the wrapper exactly its post-sentinel control +state. -/ +theorem startedTM_qstart_eq_startedState (tm : TM n) + (hne : tm.qstart ≠ tm.qhalt) : + tm.startedTM.qstart = tm.startedState := + startedTM_qstart_eq_startedState_internal tm hne + +/-- Resuming after the sentinel transition preserves append-only output. -/ +theorem IsTransducer.startedTM {tm : TM n} + (htrans : tm.IsTransducer) : tm.startedTM.IsTransducer := + htrans.startedTM_internal + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Combinators/Started/Defs.lean b/Complexitylib/Models/TuringMachine/Combinators/Started/Defs.lean new file mode 100644 index 00000000..728228df --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Combinators/Started/Defs.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators + +/-! +# Resuming a machine after its sentinel transition -- definitions + +Every nonhalted machine takes one forced first transition while all tape heads +read `▷`. Phase composition usually enters a component with those heads already +parked at cell one. `TM.startedTM` keeps the source transition function and halt +state but uses the post-sentinel control state as its start state. +-/ + +namespace Complexity + +namespace TM + +/-- The source control state reached by its all-sentinel transition. -/ +def startedState (tm : TM n) : tm.Q := + (tm.δ tm.qstart Γ.start (fun _ => Γ.start) Γ.start).1 + +/-- A source machine resumed after its compulsory all-sentinel transition. +The transition function and halt state are unchanged. If the source already +starts halted, so does the wrapper. -/ +def startedTM (tm : TM n) : TM n where + Q := tm.Q + qstart := if tm.qstart = tm.qhalt then tm.qhalt else tm.startedState + qhalt := tm.qhalt + δ := tm.δ + δ_right_of_start := tm.δ_right_of_start + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Combinators/Started/Internal.lean b/Complexitylib/Models/TuringMachine/Combinators/Started/Internal.lean new file mode 100644 index 00000000..18126ba8 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Combinators/Started/Internal.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators.Started.Defs +import Complexitylib.Models.TuringMachine.Combinators.Internal.Generic + +/-! +# Resuming a machine after its sentinel transition -- proof internals +-/ + +namespace Complexity + +namespace TM + +theorem startedTM_step_eq_internal (tm : TM n) (cfg : Cfg n tm.Q) : + tm.startedTM.step cfg = tm.step cfg := by + rfl + +theorem startedTM_reachesIn_of_source_internal (tm : TM n) + {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') : + tm.startedTM.reachesIn steps cfg cfg' := by + induction hreach with + | zero => exact .zero + | step hstep _ ih => + exact .step (by rw [startedTM_step_eq_internal]; exact hstep) ih + +theorem source_reachesIn_of_startedTM_internal (tm : TM n) + {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.startedTM.reachesIn steps cfg cfg') : + tm.reachesIn steps cfg cfg' := by + apply reachesIn_map (tm := tm.startedTM) (tm' := tm) + (fun cfg => cfg) _ hreach + intro before after hstep + rw [← startedTM_step_eq_internal] + exact hstep + +theorem startedTM_qstart_eq_startedState_internal (tm : TM n) + (hne : tm.qstart ≠ tm.qhalt) : + tm.startedTM.qstart = tm.startedState := by + simp [startedTM, hne] + +theorem IsTransducer.startedTM_internal {tm : TM n} + (htrans : tm.IsTransducer) : tm.startedTM.IsTransducer := by + intro state inputHead workHeads outputHead + exact htrans state inputHead workHeads outputHead + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean b/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean index 722098d1..7acfc1f3 100644 --- a/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean +++ b/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean @@ -66,6 +66,82 @@ theorem branchWorkSymbolTM_reachesIn_different_frame branchWorkSymbolTM_reachesIn_different_frame_internal idx symbol onEqual onDifferent inp work out hdifferent hinp hwork hout hreach hhalt +/-- A direct symbol dispatch followed by the equal branch preserves its +time-only Hoare contract. -/ +theorem branchWorkSymbolTM_hoareTime_equal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {pre post : TapePred n} {time : ℕ} + (hequal : ∀ inp work out, pre inp work out → + (work idx).read = symbol) + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbranch : onEqual.HoareTime pre post time) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).HoareTime + pre post (time + 1) := + branchWorkSymbolTM_hoareTime_equal_internal idx symbol onEqual onDifferent + hequal hinput hwork houtput hbranch + +/-- A direct symbol dispatch followed by the different branch preserves its +time-only Hoare contract. -/ +theorem branchWorkSymbolTM_hoareTime_different + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {pre post : TapePred n} {time : ℕ} + (hdifferent : ∀ inp work out, pre inp work out → + (work idx).read ≠ symbol) + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbranch : onDifferent.HoareTime pre post time) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).HoareTime + pre post (time + 1) := + branchWorkSymbolTM_hoareTime_different_internal idx symbol onEqual + onDifferent hdifferent hinput hwork houtput hbranch + +/-- A direct symbol dispatch followed by the equal branch preserves the +branch's all-prefix space bound. -/ +theorem branchWorkSymbolTM_hoareTimeSpace_equal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {pre post : TapePred n} {time inputLength space : ℕ} + (hequal : ∀ inp work out, pre inp work out → + (work idx).read = symbol) + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbranch : onEqual.HoareTimeSpace pre post time inputLength space) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).HoareTimeSpace + pre post (time + 1) inputLength space := + branchWorkSymbolTM_hoareTimeSpace_equal_internal idx symbol onEqual + onDifferent hequal hinput hwork houtput hbranch + +/-- A direct symbol dispatch followed by the different branch preserves the +branch's all-prefix space bound. -/ +theorem branchWorkSymbolTM_hoareTimeSpace_different + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {pre post : TapePred n} {time inputLength space : ℕ} + (hdifferent : ∀ inp work out, pre inp work out → + (work idx).read ≠ symbol) + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbranch : onDifferent.HoareTimeSpace pre post time inputLength space) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).HoareTimeSpace + pre post (time + 1) inputLength space := + branchWorkSymbolTM_hoareTimeSpace_different_internal idx symbol onEqual + onDifferent hdifferent hinput hwork houtput hbranch + /-- A direct work-symbol branch is a transducer when both selected branches are transducers. -/ theorem IsTransducer.branchWorkSymbolTM diff --git a/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean b/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean index d9c5d1fd..00c9326e 100644 --- a/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean +++ b/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean @@ -5,6 +5,7 @@ Authors: Samuel Schlesinger -/ import Complexitylib.Models.TuringMachine.Combinators.Internal.Generic import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +import Complexitylib.Models.TuringMachine.Hoare.Space /-! # Direct work-symbol branch combinator — proof internals @@ -225,6 +226,214 @@ theorem branchWorkSymbolTM_reachesIn_different_frame_internal exact (workSymbolDifferentWrap_halted_iff idx symbol onEqual onDifferent c').2 hhalt +theorem branchWorkSymbolTM_hoareTime_equal_internal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {pre post : TapePred n} {time : ℕ} + (hequal : ∀ inp work out, pre inp work out → + (work idx).read = symbol) + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbranch : onEqual.HoareTime pre post time) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).HoareTime + pre post (time + 1) := by + intro inp work out hpre + obtain ⟨done, branchSteps, hsteps, hreach, hhalt, hpost⟩ := + hbranch inp work out hpre + obtain ⟨wrapped, hwrapped, hwrappedHalt, hwrappedInput, + hwrappedWork, hwrappedOutput⟩ := + branchWorkSymbolTM_reachesIn_equal_frame_internal idx symbol onEqual + onDifferent inp work out (hequal inp work out hpre) + (hinput inp work out hpre) (hwork inp work out hpre) + (houtput inp work out hpre) hreach hhalt + refine ⟨wrapped, branchSteps + 1, by omega, hwrapped, hwrappedHalt, ?_⟩ + simpa only [hwrappedInput, hwrappedWork, hwrappedOutput] using hpost + +theorem branchWorkSymbolTM_hoareTime_different_internal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {pre post : TapePred n} {time : ℕ} + (hdifferent : ∀ inp work out, pre inp work out → + (work idx).read ≠ symbol) + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbranch : onDifferent.HoareTime pre post time) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).HoareTime + pre post (time + 1) := by + intro inp work out hpre + obtain ⟨done, branchSteps, hsteps, hreach, hhalt, hpost⟩ := + hbranch inp work out hpre + obtain ⟨wrapped, hwrapped, hwrappedHalt, hwrappedInput, + hwrappedWork, hwrappedOutput⟩ := + branchWorkSymbolTM_reachesIn_different_frame_internal idx symbol onEqual + onDifferent inp work out (hdifferent inp work out hpre) + (hinput inp work out hpre) (hwork inp work out hpre) + (houtput inp work out hpre) hreach hhalt + refine ⟨wrapped, branchSteps + 1, by omega, hwrapped, hwrappedHalt, ?_⟩ + simpa only [hwrappedInput, hwrappedWork, hwrappedOutput] using hpost + +theorem branchWorkSymbolTM_hoareTimeSpace_equal_internal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {pre post : TapePred n} {time inputLength space : ℕ} + (hequal : ∀ inp work out, pre inp work out → + (work idx).read = symbol) + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbranch : onEqual.HoareTimeSpace pre post time inputLength space) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).HoareTimeSpace + pre post (time + 1) inputLength space := by + constructor + · intro inp work out hpre + obtain ⟨done, branchSteps, hsteps, hreach, hhalt, hpost⟩ := + hbranch.1 inp work out hpre + obtain ⟨wrapped, hwrapped, hwrappedHalt, hwrappedInput, + hwrappedWork, hwrappedOutput⟩ := + branchWorkSymbolTM_reachesIn_equal_frame_internal idx symbol onEqual + onDifferent inp work out (hequal inp work out hpre) + (hinput inp work out hpre) (hwork inp work out hpre) + (houtput inp work out hpre) hreach hhalt + refine ⟨wrapped, branchSteps + 1, by omega, hwrapped, + hwrappedHalt, ?_⟩ + simpa only [hwrappedInput, hwrappedWork, hwrappedOutput] using hpost + · intro inp work out hpre current hcurrent + obtain ⟨currentSteps, hcurrentRun⟩ := + (branchWorkSymbolTM idx symbol onEqual onDifferent).reaches_to_reachesIn + hcurrent + obtain ⟨done, branchSteps, _hsteps, hbranchRun, hbranchHalt, _hpost⟩ := + hbranch.1 inp work out hpre + obtain ⟨wrapped, hfullRun, hfullHalt, _hwrappedInput, + _hwrappedWork, _hwrappedOutput⟩ := + branchWorkSymbolTM_reachesIn_equal_frame_internal idx symbol onEqual + onDifferent inp work out (hequal inp work out hpre) + (hinput inp work out hpre) (hwork inp work out hpre) + (houtput inp work out hpre) hbranchRun hbranchHalt + have hcurrentLe : currentSteps ≤ branchSteps + 1 := + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn_le_halt + hcurrentRun hfullRun hfullHalt + cases currentSteps with + | zero => + cases hcurrentRun + exact hbranch.2 inp work out hpre _ Relation.ReflTransGen.refl + | succ tailSteps => + have htailLe : tailSteps ≤ branchSteps := by omega + obtain ⟨branchCurrent, hbranchPrefix, _hbranchSuffix⟩ := + reachesIn_prefix_internal hbranchRun htailLe + have hwrappedPrefix := + branchWorkSymbolTM_equal_reachesIn idx symbol onEqual onDifferent + hbranchPrefix + have hdispatch := branchWorkSymbolTM_dispatch_equal idx symbol + onEqual onDifferent inp work out (hequal inp work out hpre) + (hinput inp work out hpre) (hwork inp work out hpre) + (houtput inp work out hpre) + have hcanonical : + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn + (tailSteps + 1) + { state := + (branchWorkSymbolTM idx symbol onEqual onDifferent).qstart + input := inp + work := work + output := out } + (workSymbolEqualWrap idx symbol onEqual onDifferent + branchCurrent) := + .step hdispatch hwrappedPrefix + have hcurrentEq : current = + workSymbolEqualWrap idx symbol onEqual onDifferent + branchCurrent := + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn_right_unique + hcurrentRun hcanonical + subst current + simpa [workSymbolEqualWrap] using + hbranch.2 inp work out hpre branchCurrent + (reaches_of_reachesIn hbranchPrefix) + +theorem branchWorkSymbolTM_hoareTimeSpace_different_internal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {pre post : TapePred n} {time inputLength space : ℕ} + (hdifferent : ∀ inp work out, pre inp work out → + (work idx).read ≠ symbol) + (hinput : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start) + (hwork : ∀ inp work out, pre inp work out → + ∀ i, (work i).read ≠ Γ.start) + (houtput : ∀ inp work out, pre inp work out → + out.read ≠ Γ.start) + (hbranch : onDifferent.HoareTimeSpace pre post time inputLength space) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).HoareTimeSpace + pre post (time + 1) inputLength space := by + constructor + · intro inp work out hpre + obtain ⟨done, branchSteps, hsteps, hreach, hhalt, hpost⟩ := + hbranch.1 inp work out hpre + obtain ⟨wrapped, hwrapped, hwrappedHalt, hwrappedInput, + hwrappedWork, hwrappedOutput⟩ := + branchWorkSymbolTM_reachesIn_different_frame_internal idx symbol + onEqual onDifferent inp work out (hdifferent inp work out hpre) + (hinput inp work out hpre) (hwork inp work out hpre) + (houtput inp work out hpre) hreach hhalt + refine ⟨wrapped, branchSteps + 1, by omega, hwrapped, + hwrappedHalt, ?_⟩ + simpa only [hwrappedInput, hwrappedWork, hwrappedOutput] using hpost + · intro inp work out hpre current hcurrent + obtain ⟨currentSteps, hcurrentRun⟩ := + (branchWorkSymbolTM idx symbol onEqual onDifferent).reaches_to_reachesIn + hcurrent + obtain ⟨done, branchSteps, _hsteps, hbranchRun, hbranchHalt, _hpost⟩ := + hbranch.1 inp work out hpre + obtain ⟨wrapped, hfullRun, hfullHalt, _hwrappedInput, + _hwrappedWork, _hwrappedOutput⟩ := + branchWorkSymbolTM_reachesIn_different_frame_internal idx symbol + onEqual onDifferent inp work out (hdifferent inp work out hpre) + (hinput inp work out hpre) (hwork inp work out hpre) + (houtput inp work out hpre) hbranchRun hbranchHalt + have hcurrentLe : currentSteps ≤ branchSteps + 1 := + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn_le_halt + hcurrentRun hfullRun hfullHalt + cases currentSteps with + | zero => + cases hcurrentRun + exact hbranch.2 inp work out hpre _ Relation.ReflTransGen.refl + | succ tailSteps => + have htailLe : tailSteps ≤ branchSteps := by omega + obtain ⟨branchCurrent, hbranchPrefix, _hbranchSuffix⟩ := + reachesIn_prefix_internal hbranchRun htailLe + have hwrappedPrefix := + branchWorkSymbolTM_different_reachesIn idx symbol onEqual + onDifferent hbranchPrefix + have hdispatch := branchWorkSymbolTM_dispatch_different idx symbol + onEqual onDifferent inp work out (hdifferent inp work out hpre) + (hinput inp work out hpre) (hwork inp work out hpre) + (houtput inp work out hpre) + have hcanonical : + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn + (tailSteps + 1) + { state := + (branchWorkSymbolTM idx symbol onEqual onDifferent).qstart + input := inp + work := work + output := out } + (workSymbolDifferentWrap idx symbol onEqual onDifferent + branchCurrent) := + .step hdispatch hwrappedPrefix + have hcurrentEq : current = + workSymbolDifferentWrap idx symbol onEqual onDifferent + branchCurrent := + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn_right_unique + hcurrentRun hcanonical + subst current + simpa [workSymbolDifferentWrap] using + hbranch.2 inp work out hpre branchCurrent + (reaches_of_reachesIn hbranchPrefix) + theorem IsTransducer.branchWorkSymbolTM_internal {idx : Fin n} {symbol : Γ} {onEqual onDifferent : TM n} (hequal : onEqual.IsTransducer) (hdifferent : onDifferent.IsTransducer) : diff --git a/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control.lean b/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control.lean index 0a8c048b..30f2bfa8 100644 --- a/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control.lean +++ b/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control.lean @@ -28,45 +28,6 @@ Thus many iterations can retain logarithmic auxiliary space. namespace Complexity -namespace TM - -variable {n : ℕ} - -/-- A bounded reachable-segment certificate terminates within the standard -recursive binary-loop bound. -/ -theorem BinaryForSegmentSpec.reachesIn {body : TM n} - {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} - {startValue limitValue : ℕ} - (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime - startValue limitValue) - (count value : ℕ) (hstart : startValue ≤ value) - (hlimit : value + count = limitValue) : - ∃ time, time ≤ binaryForLoopTime bodyTime limitValue value count ∧ - (binaryForTM body counterIdx limitIdx).reachesIn time - (spec.scanCfg value) spec.doneCfg := - spec.reachesIn_internal count value hstart hlimit - -/-- Phase-local segment bounds cover every reachable prefix of the whole -count-up loop. -/ -theorem BinaryForSegmentSpaceSpec.prefix_withinAuxSpace - {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} - {startValue limitValue inputLength spaceBound : ℕ} - {spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime - startValue limitValue} - (spaceSpec : BinaryForSegmentSpaceSpec spec inputLength spaceBound) - (count value time : ℕ) - (cfg : Cfg n (binaryForTM body counterIdx limitIdx).Q) - (hstart : startValue ≤ value) - (hlimit : value + count = limitValue) - (hreach : (binaryForTM body counterIdx limitIdx).reachesIn time - (spec.scanCfg value) cfg) - (htime : time ≤ binaryForLoopTime bodyTime limitValue value count) : - cfg.WithinAuxSpace inputLength spaceBound := - spaceSpec.prefix_withinAuxSpace_internal count value time cfg hstart - hlimit hreach htime - -end TM - namespace BinaryRoutine variable {n : ℕ} diff --git a/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control/Defs.lean b/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control/Defs.lean index 3008ccb8..2190df16 100644 --- a/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control/Defs.lean +++ b/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control/Defs.lean @@ -13,82 +13,16 @@ import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs This module adds value-level zero branching and canonical binary count-up loops to `BinaryRoutine`. -The loop certificate here deliberately differs from `TM.BinaryForLoopSpec` in -two ways required by the routine interface. It starts at an arbitrary value, -so body obligations are restricted to the reachable segment, and it accepts -bounded iteration witnesses because `BinaryRoutine.Sound` advertises an upper -bound rather than an exact runtime. Comparisons and endpoints remain exact. +The routine adapter uses the public `TM.BinaryForSegmentSpec`, which differs +from `TM.BinaryForLoopSpec` in two ways required by the routine interface. It +starts at an arbitrary value, so body obligations are restricted to the +reachable segment, and it accepts bounded iteration witnesses because +`BinaryRoutine.Sound` advertises an upper bound rather than an exact runtime. +Comparisons and endpoints remain exact. -/ namespace Complexity -namespace TM - -/-- A bounded execution certificate for the reachable segment of a canonical -binary count-up loop. - -Unlike `BinaryForLoopSpec`, iterations may finish before their advertised -bound and obligations below `startValue` are not requested. -/ -structure BinaryForSegmentSpec {n : ℕ} (body : TM n) - (counterIdx limitIdx : Fin n) (bodyTime : ℕ → ℕ) - (startValue limitValue : ℕ) where - /-- The counter and preserved-limit tapes are distinct. -/ - counter_ne_limit : counterIdx ≠ limitIdx - /-- Canonical scanner configuration at each reachable counter value. -/ - scanCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q - /-- Configuration at the composite body-plus-successor entry. -/ - iterationStartCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q - /-- Configuration after the composite body-plus-successor iteration. -/ - iterationDoneCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q - /-- Final halted driver configuration. -/ - doneCfg : Cfg n (binaryForTM body counterIdx limitIdx).Q - /-- A nonterminal comparison enters the composite iteration exactly. -/ - testRun : ∀ value, startValue ≤ value → value < limitValue → - (binaryForTM body counterIdx limitIdx).reachesIn - (binaryForCompareTime limitValue) (scanCfg value) - (iterationStartCfg value) - /-- Selected actual runtime of each reachable composite iteration. -/ - iterationTime : ℕ → ℕ - /-- The selected runtime stays within the advertised iteration bound. -/ - iterationTime_le : ∀ value, startValue ≤ value → value < limitValue → - iterationTime value ≤ binaryForIterationTime bodyTime value - /-- The composite iteration runs for its selected actual runtime. -/ - iterationRun : ∀ value, startValue ≤ value → value < limitValue → - (binaryForTM body counterIdx limitIdx).reachesIn (iterationTime value) - (iterationStartCfg value) (iterationDoneCfg value) - /-- The preserving loopback seam starts the next comparison. -/ - loopbackStep : ∀ value, startValue ≤ value → value < limitValue → - (binaryForTM body counterIdx limitIdx).step (iterationDoneCfg value) = - some (scanCfg (value + 1)) - /-- Equality at the limit completes the final comparison exactly. -/ - doneRun : - (binaryForTM body counterIdx limitIdx).reachesIn - (binaryForCompareTime limitValue) (scanCfg limitValue) doneCfg - /-- The supplied final driver configuration is genuinely halted. -/ - doneHalted : (binaryForTM body counterIdx limitIdx).halted doneCfg - -/-- All-prefix auxiliary-space obligations for a bounded reachable loop -segment. -/ -structure BinaryForSegmentSpaceSpec {n : ℕ} {body : TM n} - {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} - {startValue limitValue : ℕ} - (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime - startValue limitValue) (inputLength spaceBound : ℕ) where - /-- Every reachable comparison prefix stays inside the shared budget. -/ - testPrefixWithin : ∀ value time cfg, startValue ≤ value → - value ≤ limitValue → time ≤ binaryForCompareTime limitValue → - (binaryForTM body counterIdx limitIdx).reachesIn time - (spec.scanCfg value) cfg → - cfg.WithinAuxSpace inputLength spaceBound - /-- Every reachable composite-iteration prefix stays inside the budget. -/ - iterationPrefixWithin : ∀ value time cfg, startValue ≤ value → - value < limitValue → time ≤ spec.iterationTime value → - (binaryForTM body counterIdx limitIdx).reachesIn time - (spec.iterationStartCfg value) cfg → - cfg.WithinAuxSpace inputLength spaceBound - -end TM - namespace BinaryRoutine /-- Select between two routines by whether a canonical binary work value is diff --git a/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control/Internal.lean b/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control/Internal.lean index 7b65655f..4600bbba 100644 --- a/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control/Internal.lean +++ b/Complexitylib/Models/TuringMachine/Experimental/BinaryRoutine/Control/Internal.lean @@ -17,156 +17,6 @@ import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc namespace Complexity -namespace TM - -variable {n : ℕ} - -/-- A bounded segment certificate supplies a terminating run within the -standard recursive count-up-loop bound. -/ -theorem BinaryForSegmentSpec.reachesIn_internal {body : TM n} - {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} - {startValue limitValue : ℕ} - (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime - startValue limitValue) : - ∀ count value, startValue ≤ value → value + count = limitValue → - ∃ time, time ≤ binaryForLoopTime bodyTime limitValue value count ∧ - (binaryForTM body counterIdx limitIdx).reachesIn time - (spec.scanCfg value) spec.doneCfg := by - intro count - induction count with - | zero => - intro value _hstart hlimit - have hvalue : value = limitValue := by omega - subst value - exact ⟨binaryForCompareTime limitValue, le_rfl, spec.doneRun⟩ - | succ count ih => - intro value hstart hlimit - have hvalue : value < limitValue := by omega - let iterationTime := spec.iterationTime value - have hiterationTime := spec.iterationTime_le value hstart hvalue - have hiteration := spec.iterationRun value hstart hvalue - obtain ⟨tailTime, htailTime, htail⟩ := - ih (value + 1) (by omega) (by omega) - have hloopback : (binaryForTM body counterIdx limitIdx).reachesIn 1 - (spec.iterationDoneCfg value) (spec.scanCfg (value + 1)) := - .step (spec.loopbackStep value hstart hvalue) .zero - have hreach := reachesIn_trans (binaryForTM body counterIdx limitIdx) - (spec.testRun value hstart hvalue) - (reachesIn_trans (binaryForTM body counterIdx limitIdx) hiteration - (reachesIn_trans (binaryForTM body counterIdx limitIdx) - hloopback htail)) - refine ⟨binaryForCompareTime limitValue + - (iterationTime + (1 + tailTime)), ?_, hreach⟩ - rw [binaryForLoopTime] - omega - -/-- Phase-local space obligations cover every prefix of a bounded loop -segment, even when an iteration terminates strictly before its time bound. -/ -theorem BinaryForSegmentSpaceSpec.prefix_withinAuxSpace_internal - {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} - {startValue limitValue inputLength spaceBound : ℕ} - {spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime - startValue limitValue} - (spaceSpec : BinaryForSegmentSpaceSpec spec inputLength spaceBound) : - ∀ count value time (cfg : Cfg n (binaryForTM body counterIdx limitIdx).Q), - startValue ≤ value → value + count = limitValue → - (binaryForTM body counterIdx limitIdx).reachesIn time - (spec.scanCfg value) cfg → - time ≤ binaryForLoopTime bodyTime limitValue value count → - cfg.WithinAuxSpace inputLength spaceBound := by - intro count - induction count with - | zero => - intro value time cfg hstart hlimit hreach _htime - have hvalue : value = limitValue := by omega - subst value - have hactual : time ≤ binaryForCompareTime limitValue := - (binaryForTM body counterIdx limitIdx).reachesIn_le_halt hreach - spec.doneRun spec.doneHalted - exact spaceSpec.testPrefixWithin limitValue time cfg hstart le_rfl - hactual hreach - | succ count ih => - intro value time cfg hstart hlimit hreach _htime - have hvalue : value < limitValue := by omega - let iterationTime := spec.iterationTime value - have hiterationRun := spec.iterationRun value hstart hvalue - obtain ⟨tailFullTime, htailBound, htailFull⟩ := - spec.reachesIn_internal count (value + 1) (by omega) (by omega) - have hloopback : (binaryForTM body counterIdx limitIdx).reachesIn 1 - (spec.iterationDoneCfg value) (spec.scanCfg (value + 1)) := - .step (spec.loopbackStep value hstart hvalue) .zero - have hfull := reachesIn_trans (binaryForTM body counterIdx limitIdx) - (spec.testRun value hstart hvalue) - (reachesIn_trans (binaryForTM body counterIdx limitIdx) - hiterationRun - (reachesIn_trans (binaryForTM body counterIdx limitIdx) - hloopback htailFull)) - have hactual : - time ≤ binaryForCompareTime limitValue + - (iterationTime + (1 + tailFullTime)) := - (binaryForTM body counterIdx limitIdx).reachesIn_le_halt hreach - hfull spec.doneHalted - by_cases htest : time ≤ binaryForCompareTime limitValue - · exact spaceSpec.testPrefixWithin value time cfg hstart - (Nat.le_of_lt hvalue) htest hreach - · let afterTestTime := time - binaryForCompareTime limitValue - have htimeEq : binaryForCompareTime limitValue + afterTestTime = - time := by - dsimp only [afterTestTime] - exact Nat.add_sub_of_le (by omega) - by_cases hiteration : afterTestTime ≤ iterationTime - · obtain ⟨d, hprefix, _hsuffix⟩ := - reachesIn_prefix_internal hiterationRun hiteration - have hcanonical : - (binaryForTM body counterIdx limitIdx).reachesIn time - (spec.scanCfg value) d := by - have hrun := reachesIn_trans - (binaryForTM body counterIdx limitIdx) - (spec.testRun value hstart hvalue) hprefix - simpa [htimeEq] using hrun - have hcfg := - (binaryForTM body counterIdx limitIdx).reachesIn_right_unique - hreach hcanonical - rw [hcfg] - exact spaceSpec.iterationPrefixWithin value afterTestTime d - hstart hvalue hiteration hprefix - · let prefixTime := binaryForCompareTime limitValue + - iterationTime + 1 - have hprefixTime : prefixTime ≤ time := by - dsimp only [prefixTime, afterTestTime] at ⊢ hiteration - omega - let tailTime := time - prefixTime - have htailEq : prefixTime + tailTime = time := by - dsimp only [tailTime] - exact Nat.add_sub_of_le hprefixTime - have htailActual : tailTime ≤ tailFullTime := by - dsimp only [prefixTime, tailTime] at ⊢ hactual - omega - obtain ⟨d, htail, _hsuffix⟩ := - reachesIn_prefix_internal htailFull htailActual - have hcanonical : - (binaryForTM body counterIdx limitIdx).reachesIn time - (spec.scanCfg value) d := by - have hrun := reachesIn_trans - (binaryForTM body counterIdx limitIdx) - (spec.testRun value hstart hvalue) - (reachesIn_trans (binaryForTM body counterIdx limitIdx) - hiterationRun - (reachesIn_trans (binaryForTM body counterIdx limitIdx) - hloopback htail)) - convert hrun using 1 - all_goals - dsimp only [prefixTime] at htailEq ⊢ - omega - have hcfg := - (binaryForTM body counterIdx limitIdx).reachesIn_right_unique - hreach hcanonical - rw [hcfg] - exact ih (value + 1) tailTime d (by omega) (by omega) htail - (le_trans htailActual htailBound) - -end TM - namespace BinaryRoutine variable {n : ℕ} diff --git a/Complexitylib/Models/TuringMachine/OutputCursor.lean b/Complexitylib/Models/TuringMachine/OutputCursor.lean new file mode 100644 index 00000000..a1a2c244 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputCursor.lean @@ -0,0 +1,316 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputCursor.Defs +import Complexitylib.Models.TuringMachine.OutputCursor.Internal + +/-! +# Finite cursors for append-only output tapes + +`TM.OutputCursor` replaces an append-only output prefix by the finite data that +can affect the next transition: whether the head is still on the left marker +and the current symbol. The blank-frontier invariant proves that a right move +always enters a fresh blank cell. This is the finite-control basis for +log-space output probing and recomputation without materializing a polynomial +output string on work tape. + +## Main results + +- `TM.OutputCursor.read_outputCursor` -- the cursor supplies the real symbol. +- `Tape.outputCursor_writeAndMove` -- exact cursor update for a non-left move. +- `TM.IsTransducer.cursorStep_commute` -- cursor stepping commutes with a + concrete transducer step. +- `TM.IsTransducer.cursorStepObserved_commute` -- the same step exposes its + zero-or-one output-frontier advance. +- `TM.exists_output_crossing` -- every run from at or before a cell to beyond + it exposes the unique one-step frontier crossing. +- `TM.IsTransducer.cursorTrace_commute` -- the quotient simulates a complete + exact-step run. +- `TM.IsTransducer.cursorTraceObserved_initCfg` -- from an initial + configuration, accumulated advances equal the final output-head position. +- `TM.IsTransducer.cursorTrace_initCfg` -- initial runs need no manual frontier + hypotheses. +- `TM.suppressOutputTM_isTransducer` -- the concrete realization remains an + append-only transducer. +- `TM.suppressOutputTM_step` -- one concrete step implements one cursor step. +- `TM.suppressOutputTapeTrace_succ_init` -- canonical suppressed output is + parked blank at cell one after every positive-length trace. +- `TM.IsTransducer.suppressOutputTM_reachesIn` -- complete source runs lift to + the concrete output-suppressing machine. +- `TM.IsTransducer.suppressOutputTM_reachesIn_halt` -- source halting runs lift + through the final normalization seam. +- `TM.IsTransducer.suppressOutputTM_computesNil` -- suppressing a function + transducer gives a genuine machine computing the empty string. +-/ + +namespace Complexity + +namespace TM.OutputCursor + +/-- A cursor built from a well-formed tape supplies exactly the symbol read by +that tape. -/ +theorem read_outputCursor {tape : Tape} (hstart : tape.StartInvariant) : + tape.outputCursor.read = tape.read := + read_outputCursor_internal hstart + +@[simp] theorem next_start_right (write : Γw) : + OutputCursor.next .start write .right = .cell Γ.blank := + next_start_right_internal write + +@[simp] theorem next_cell_right (symbol : Γ) (write : Γw) : + OutputCursor.next (.cell symbol) write .right = .cell Γ.blank := + next_cell_right_internal symbol write + +@[simp] theorem next_cell_stay (symbol : Γ) (write : Γw) : + OutputCursor.next (.cell symbol) write .stay = .cell write.toΓ := + next_cell_stay_internal symbol write + +end TM.OutputCursor + +namespace Tape + +/-- A write followed by a non-left move updates the finite output cursor +exactly. The proof uses `BlankAfterHead` in the right-moving case to show that +the newly visited cell is blank. -/ +theorem outputCursor_writeAndMove {tape : Tape} + (hblank : tape.BlankAfterHead) (write : Γw) (direction : Dir3) + (hnoleft : direction ≠ Dir3.left) : + (tape.writeAndMove write.toΓ direction).outputCursor = + tape.outputCursor.next write direction := + outputCursor_writeAndMove_internal hblank write direction hnoleft + +end Tape + +namespace TM + +/-- Quotienting the output tape to a finite cursor commutes with every concrete +step of a transducer whose output has the standard start-marker and blank-tail +invariants. No already-written output cell appears in the cursor +configuration. -/ +theorem IsTransducer.cursorStep_commute {tm : TM n} + (htrans : tm.IsTransducer) {cfg cfg' : Cfg n tm.Q} + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) + (hstep : tm.step cfg = some cfg') : + tm.cursorStep (.ofCfg cfg) = some (.ofCfg cfg') := + htrans.cursorStep_commute_internal hstart hblank hstep + +/-- The observed cursor step commutes with a concrete transducer step. Its +numeric event is the selected output direction's zero-or-one frontier +contribution. -/ +theorem IsTransducer.cursorStepObserved_commute {tm : TM n} + (htrans : tm.IsTransducer) {cfg cfg' : Cfg n tm.Q} + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) + (hstep : tm.step cfg = some cfg') : + tm.cursorStepObserved (.ofCfg cfg) = + some (.ofCfg cfg', tm.cursorOutputEvent (.ofCfg cfg)) := + htrans.cursorStepObserved_commute_internal hstart hblank hstep + +/-- Exact runs preserve the structural output-tape start-marker invariant. -/ +theorem output_startInvariant_reachesIn {tm : TM n} + {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) : + cfg'.output.StartInvariant := + output_startInvariant_reachesIn_internal hreach hstart + +/-- A transducer output head never moves left in one concrete step. -/ +theorem IsTransducer.output_head_mono_step {tm : TM n} + (htrans : tm.IsTransducer) {cfg cfg' : Cfg n tm.Q} + (hstep : tm.step cfg = some cfg') : + cfg.output.head ≤ cfg'.output.head := + htrans.output_head_mono_step_internal hstep + +/-- A transducer output head never moves left along an exact run. -/ +theorem IsTransducer.output_head_mono_reachesIn {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') : + cfg.output.head ≤ cfg'.output.head := + htrans.output_head_mono_reachesIn_internal hreach + +/-- Once a transducer output head lies strictly beyond a cell, no later step +in the run can change that cell. -/ +theorem IsTransducer.output_cells_lt_head_reachesIn {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') {position : ℕ} + (hposition : position < cfg.output.head) : + cfg'.output.cells position = cfg.output.cells position := + htrans.output_cells_lt_head_reachesIn_internal hreach hposition + +/-- If one concrete step increases the output head, its finite-cursor output +direction is `right`. -/ +theorem cursorOutputDirection_eq_right_of_output_head_lt + {tm : TM n} {cfg cfg' : Cfg n tm.Q} + (hstart : cfg.output.StartInvariant) + (hstep : tm.step cfg = some cfg') + (hhead : cfg.output.head < cfg'.output.head) : + tm.cursorOutputDirection (.ofCfg cfg) = Dir3.right := + cursorOutputDirection_eq_right_of_output_head_lt_internal + hstart hstep hhead + +/-- Away from the immutable marker, one concrete step writes its advertised +finite-cursor output symbol at the old output-head cell. -/ +theorem cursorOutputWrite_step_cell {tm : TM n} + {cfg cfg' : Cfg n tm.Q} (hstart : cfg.output.StartInvariant) + (hstep : tm.step cfg = some cfg') + (hpositive : 0 < cfg.output.head) : + cfg'.output.cells cfg.output.head = + (tm.cursorOutputWrite (.ofCfg cfg)).toΓ := + cursorOutputWrite_step_cell_internal hstart hstep hpositive + +/-- Any exact run that begins at or before `position` and finishes beyond it +contains a concrete step from head `position` to `position + 1`. The statement +does not need the transducer discipline; one-step head travel alone forces the +crossing. -/ +theorem exists_output_crossing {tm : TM n} {steps position : ℕ} + {cfg final : Cfg n tm.Q} (hreach : tm.reachesIn steps cfg final) + (hbefore : cfg.output.head ≤ position) + (hafter : position < final.output.head) : + ∃ prefixSteps suffixSteps selected next, + tm.reachesIn prefixSteps cfg selected ∧ + tm.step selected = some next ∧ + tm.reachesIn suffixSteps next final ∧ + selected.output.head = position ∧ + next.output.head = position + 1 := + exists_output_crossing_internal hreach hbefore hafter + +/-- Quotienting the output tape commutes with an entire exact-step transducer +run. The cursor trace retains the source state, input, and work tapes exactly +while replacing the potentially polynomial output prefix by one finite cursor. +-/ +theorem IsTransducer.cursorTrace_commute {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) : + tm.cursorTrace steps (.ofCfg cfg) = some (.ofCfg cfg') := + htrans.cursorTrace_commute_internal hreach hstart hblank + +/-- An observed exact cursor run counts precisely how far the physical output +head advanced. The statement is relative to the starting head, so it also +applies to subruns. -/ +theorem IsTransducer.cursorTraceObserved_commute {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) : + ∃ advances, + tm.cursorTraceObserved steps (.ofCfg cfg) = + some (.ofCfg cfg', advances) ∧ + cfg'.output.head = cfg.output.head + advances := + htrans.cursorTraceObserved_commute_internal hreach hstart hblank + +/-- From the canonical initial configuration, the observed cursor count is +exactly the final physical output-head position. This is the accounting fact +used by binary output-position probes. -/ +theorem IsTransducer.cursorTraceObserved_initCfg {tm : TM n} + (htrans : tm.IsTransducer) {input : List Bool} {steps : ℕ} + {cfg : Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg input) cfg) : + tm.cursorTraceObserved steps (.ofCfg (tm.initCfg input)) = + some (.ofCfg cfg, cfg.output.head) := + htrans.cursorTraceObserved_initCfg_internal hreach + +/-- Specialized complete-run simulation from an ordinary initial +configuration. The start-marker and blank-frontier obligations are discharged +by the canonical blank output tape. -/ +theorem IsTransducer.cursorTrace_initCfg {tm : TM n} + (htrans : tm.IsTransducer) {input : List Bool} {steps : ℕ} + {cfg : Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg input) cfg) : + tm.cursorTrace steps (.ofCfg (tm.initCfg input)) = + some (.ofCfg cfg) := + htrans.cursorTrace_initCfg_internal hreach + +/-- The concrete output-suppressing realization never moves its real output +head left. -/ +theorem suppressOutputTM_isTransducer (tm : TM n) : + (suppressOutputTM tm).IsTransducer := + suppressOutputTM_isTransducer_internal tm + +/-- One step of the concrete output-suppressing machine implements one pure +cursor step exactly, including the source input/work actions. -/ +theorem suppressOutputTM_step (tm : TM n) + {cfg cfg' : CursorCfg n tm.Q} (realOutput : Tape) + (hcursor : tm.cursorStep cfg = some cfg') : + (suppressOutputTM tm).step (suppressOutputCfg tm cfg realOutput) = + some (suppressOutputCfg tm cfg' + (suppressOutputTapeStep realOutput)) := + suppressOutputTM_step_internal tm realOutput hcursor + +/-- A complete source-transducer run lifts to the concrete output-suppressing +machine with exactly the same number of simulated steps. The final input and +work tapes are the source final tapes; only the real output follows the idle +blank-tape evolution. -/ +theorem IsTransducer.suppressOutputTM_reachesIn {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) (realOutput : Tape) : + (suppressOutputTM tm).reachesIn steps + (suppressOutputCfg tm (.ofCfg cfg) realOutput) + (suppressOutputCfg tm (.ofCfg cfg') + (suppressOutputTapeTrace steps realOutput)) := + htrans.suppressOutputTM_reachesIn_internal hreach hstart hblank realOutput + +/-- A halted source-transducer run lifts through the one-step normalization +seam to the genuine halt state of `suppressOutputTM`. -/ +theorem IsTransducer.suppressOutputTM_reachesIn_halt {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) (hhalt : tm.halted cfg') + (realOutput : Tape) : + (suppressOutputTM tm).reachesIn (steps + 1) + (suppressOutputCfg tm (.ofCfg cfg) realOutput) + (suppressOutputDoneCfg tm (.ofCfg cfg') + (suppressOutputTapeTrace steps realOutput)) := + htrans.suppressOutputTM_reachesIn_halt_internal hreach hstart hblank + hhalt realOutput + +/-- Idling the real blank output while simulating any fixed number of source +steps still represents the empty output string. -/ +theorem suppressOutputTapeTrace_init_hasOutput_nil (steps : ℕ) : + (suppressOutputTapeTrace steps (Tape.init [])).HasOutput [] := + suppressOutputTapeTrace_init_hasOutput_nil_internal steps + +/-- Once a suppressed trace from the canonical blank output takes one step, +its physical output is exactly the same blank tape parked at cell one. -/ +theorem suppressOutputTapeTrace_succ_init (steps : ℕ) : + suppressOutputTapeTrace (steps + 1) (Tape.init []) = + (Tape.init []).move Dir3.right := + suppressOutputTapeTrace_succ_init_internal steps + +/-- Every positive-length suppressed trace from canonical blank output has +physical head one. -/ +theorem suppressOutputTapeTrace_succ_init_head (steps : ℕ) : + (suppressOutputTapeTrace (steps + 1) (Tape.init [])).head = 1 := by + rw [suppressOutputTapeTrace_succ_init] + simp [Tape.move] + +/-- Every positive-length suppressed trace preserves the canonical blank +physical cells exactly. -/ +theorem suppressOutputTapeTrace_succ_init_cells (steps : ℕ) : + (suppressOutputTapeTrace (steps + 1) (Tape.init [])).cells = + (Tape.init []).cells := by + rw [suppressOutputTapeTrace_succ_init] + simp [Tape.move] + +/-- Suppressing the output of a bounded-time function transducer yields a +genuine machine computation of the empty string. The simulator retains the +source input and work-tape behavior, replaces the growing output prefix by a +finite cursor in control state, and spends one final step entering its own +halt state. -/ +theorem IsTransducer.suppressOutputTM_computesNil {tm : TM n} + {f : List Bool → List Bool} {T : ℕ → ℕ} + (htrans : tm.IsTransducer) (hcomp : tm.ComputesInTime f T) : + (suppressOutputTM tm).ComputesInTime (fun _ => []) + (fun inputLength => T inputLength + 1) := + htrans.suppressOutputTM_computesNil_internal hcomp + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputCursor/Defs.lean b/Complexitylib/Models/TuringMachine/OutputCursor/Defs.lean new file mode 100644 index 00000000..6dc813fa --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputCursor/Defs.lean @@ -0,0 +1,279 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators +import Complexitylib.Models.TuringMachine.SpaceTime.Internal.OutputFrontier +import Mathlib.Data.Fintype.Prod + +/-! +# Finite cursors for append-only output tapes -- definitions + +An append-only output computation never needs its already-written prefix to +determine the next transition. It needs only to distinguish the exceptional +left-end cell from an ordinary cell and to remember the symbol under the +current head. `TM.OutputCursor` is exactly that finite summary. +-/ + +namespace Complexity + +namespace TM + +/-- Finite observable state of an append-only output head. -/ +inductive OutputCursor where + /-- The head is on the immutable left-end marker. -/ + | start + /-- The head is on an ordinary cell reading `symbol`. -/ + | cell (symbol : Γ) + deriving DecidableEq, Repr + +instance : Fintype OutputCursor where + elems := {.start, .cell Γ.zero, .cell Γ.one, .cell Γ.blank, + .cell Γ.start} + complete := by + intro cursor + cases cursor with + | start => simp + | cell symbol => cases symbol <;> simp + +namespace OutputCursor + +/-- Symbol presented to a simulated transition. -/ +def read : OutputCursor → Γ + | .start => Γ.start + | .cell symbol => symbol + +/-- Update the finite cursor after one write-and-move action. The `.left` +case is deliberately assigned a dummy ordinary blank cursor: correctness is +claimed only for the non-left directions allowed by `TM.IsTransducer`. -/ +def next (cursor : OutputCursor) (write : Γw) (direction : Dir3) : + OutputCursor := + match cursor, direction with + | .start, .right => .cell Γ.blank + | .start, .stay => .start + | .start, .left => .cell Γ.blank + | .cell _, .right => .cell Γ.blank + | .cell _, .stay => .cell write.toΓ + | .cell _, .left => .cell Γ.blank + +/-- Whether the logical output frontier advanced in this transition. -/ +def advanced (direction : Dir3) : Bool := + direction == Dir3.right + +/-- Numeric contribution of one output move to the append-only frontier. -/ +def advanceCount : Dir3 → ℕ + | .right => 1 + | .left | .stay => 0 + +/-- Observable output effect of one source transition. `finalized` is present +exactly when a right move leaves an ordinary output cell, at which point the +written symbol can no longer be changed by an append-only transducer. -/ +structure Event where + /-- Zero-or-one frontier contribution of the output direction. -/ + advance : ℕ + /-- Symbol finalized by leaving an ordinary cell to the right. -/ + finalized : Option Γw + deriving DecidableEq + +end OutputCursor + +end TM + +namespace Tape + +/-- Observe only the finite state relevant to future append-only output +transitions. -/ +def outputCursor (tape : Tape) : TM.OutputCursor := + if tape.head = 0 then .start else .cell tape.read + +end Tape + +namespace TM + +/-- A machine configuration with its append-only output tape quotiented to a +finite cursor. The input and work tapes remain concrete. -/ +structure CursorCfg (n : ℕ) (Q : Type) where + /-- Simulated finite-control state. -/ + state : Q + /-- Simulated read-only input tape. -/ + input : Tape + /-- Simulated work tapes. -/ + work : Fin n → Tape + /-- Finite state of the suppressed append-only output tape. -/ + output : OutputCursor + +namespace CursorCfg + +/-- Quotient a concrete configuration's output tape to its finite cursor. -/ +def ofCfg {n : ℕ} {State : Type} (cfg : Cfg n State) : + CursorCfg n State where + state := cfg.state + input := cfg.input + work := cfg.work + output := cfg.output.outputCursor + +end CursorCfg + +/-- One pure source-machine step with the append-only output tape represented +only by a finite cursor. A right output move records a fresh blank cell; a +stay records the symbol just written. Correctness for concrete executions is +proved under `IsTransducer` and the blank-frontier invariant. -/ +def cursorStep (tm : TM n) (cfg : CursorCfg n tm.Q) : + Option (CursorCfg n tm.Q) := + if cfg.state = tm.qhalt then none + else + let (state, workWrites, outputWrite, inputDir, workDirs, outputDir) := + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read + some + { state := state + input := cfg.input.move inputDir + work := fun i => + (cfg.work i).writeAndMove (workWrites i) (workDirs i) + output := cfg.output.next outputWrite outputDir } + +/-- Output direction selected by the source transition visible from a cursor +configuration. It is observed only when `cursorStep` succeeds. -/ +def cursorOutputDirection (tm : TM n) (cfg : CursorCfg n tm.Q) : Dir3 := + let (_, _, _, _, _, outputDir) := + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read + outputDir + +/-- Output symbol selected by the source transition visible from a cursor +configuration. -/ +def cursorOutputWrite (tm : TM n) (cfg : CursorCfg n tm.Q) : Γw := + let (_, _, outputWrite, _, _, _) := + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read + outputWrite + +/-- Complete observable output event selected at a cursor configuration. -/ +def cursorOutputEvent (tm : TM n) (cfg : CursorCfg n tm.Q) : + OutputCursor.Event := + let direction := tm.cursorOutputDirection cfg + { advance := OutputCursor.advanceCount direction + finalized := + if direction = Dir3.right then + match cfg.output with + | .start => none + | .cell _ => some (tm.cursorOutputWrite cfg) + else none } + +/-- One cursor step paired with the number of newly crossed output cells. +For a transducer this is exactly zero or one. -/ +def cursorStepObserved (tm : TM n) (cfg : CursorCfg n tm.Q) : + Option (CursorCfg n tm.Q × OutputCursor.Event) := + (tm.cursorStep cfg).map fun next => + (next, tm.cursorOutputEvent cfg) + +/-- Execute an exact number of pure cursor steps, failing if the simulated +source machine halts before the requested horizon. -/ +def cursorTrace (tm : TM n) : ℕ → CursorCfg n tm.Q → + Option (CursorCfg n tm.Q) + | 0, cfg => some cfg + | steps + 1, cfg => do + let cfg ← tm.cursorStep cfg + tm.cursorTrace steps cfg + +/-- Execute an exact cursor run while counting output-frontier advances. -/ +def cursorTraceObserved (tm : TM n) : ℕ → CursorCfg n tm.Q → + Option (CursorCfg n tm.Q × ℕ) + | 0, cfg => some (cfg, 0) + | steps + 1, cfg => do + let (next, event) ← tm.cursorStepObserved cfg + let (final, later) ← tm.cursorTraceObserved steps next + pure (final, event.advance + later) + +/-- Finite-control states of the output-suppressing realization. The left +summand carries the simulated source state and output cursor; the right +summand is the unique normalized halt state. -/ +abbrev SuppressOutputQ (State : Type) := + (State × OutputCursor) ⊕ Unit + +/-- Execute a source machine while suppressing its append-only output prefix +into `OutputCursor`. Input and work-tape actions are those of the source; +the real output tape is kept idle and blank. Source-halt detection takes one +normalizing seam step to the unique target halt state. Correct simulation +requires the source to satisfy `IsTransducer`. -/ +def suppressOutputTM (tm : TM n) : TM n := + haveI : Fintype tm.Q := tm.finQ + haveI : DecidableEq tm.Q := tm.decEq + haveI : Fintype (SuppressOutputQ tm.Q) := inferInstance + haveI : DecidableEq (SuppressOutputQ tm.Q) := inferInstance + { Q := SuppressOutputQ tm.Q + qstart := Sum.inl (tm.qstart, .start) + qhalt := Sum.inr () + δ := fun state inputHead workHeads outputHead => + match state with + | Sum.inl (sourceState, cursor) => + if sourceState = tm.qhalt then + allReadBack (Sum.inr ()) inputHead workHeads outputHead + else + let (nextState, workWrites, outputWrite, inputDir, workDirs, + outputDir) := + tm.δ sourceState inputHead workHeads cursor.read + (Sum.inl (nextState, cursor.next outputWrite outputDir), + workWrites, readBackWrite outputHead, inputDir, workDirs, + idleDir outputHead) + | Sum.inr _ => + allIdle (Sum.inr ()) inputHead workHeads outputHead + δ_right_of_start := by + intro state inputHead workHeads outputHead + match state with + | Sum.inl (sourceState, cursor) => + dsimp only + split + · exact rightOfStart_allReadBack inputHead workHeads outputHead + · generalize htransition : + tm.δ sourceState inputHead workHeads cursor.read = transition + obtain ⟨nextState, workWrites, outputWrite, inputDir, + workDirs, outputDir⟩ := transition + have hsource := tm.δ_right_of_start sourceState inputHead + workHeads cursor.read + rw [htransition] at hsource + simp only [htransition] + exact ⟨hsource.1, hsource.2.1, idleDir_right_of_start⟩ + | Sum.inr _ => + exact rightOfStart_allIdle inputHead workHeads outputHead } + +/-- Embed a cursor configuration into the simulating phase of +`suppressOutputTM`, with an independently supplied real output tape. -/ +def suppressOutputCfg (tm : TM n) (cfg : CursorCfg n tm.Q) + (realOutput : Tape) : Cfg n (suppressOutputTM tm).Q where + state := by + change SuppressOutputQ tm.Q + exact Sum.inl (cfg.state, cfg.output) + input := cfg.input + work := cfg.work + output := realOutput + +/-- Normalized halted configuration after the suppressing machine detects a +source halt. The seam uses the standard read-back/idle tape action. -/ +def suppressOutputDoneCfg (tm : TM n) (cfg : CursorCfg n tm.Q) + (realOutput : Tape) : Cfg n (suppressOutputTM tm).Q where + state := by + change SuppressOutputQ tm.Q + exact Sum.inr () + input := cfg.input.move (idleDir cfg.input.read) + work := fun i => + (cfg.work i).writeAndMove (readBackWrite (cfg.work i).read) + (idleDir (cfg.work i).read) + output := realOutput.writeAndMove (readBackWrite realOutput.read) + (idleDir realOutput.read) + +/-- One idle physical-output transition used by the suppressing machine. -/ +def suppressOutputTapeStep (tape : Tape) : Tape := + tape.writeAndMove (readBackWrite tape.read) (idleDir tape.read) + +/-- Physical-output evolution across a fixed number of suppressed source +steps. -/ +def suppressOutputTapeTrace : ℕ → Tape → Tape + | 0, tape => tape + | steps + 1, tape => + suppressOutputTapeTrace steps (suppressOutputTapeStep tape) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputCursor/Internal.lean b/Complexitylib/Models/TuringMachine/OutputCursor/Internal.lean new file mode 100644 index 00000000..7133654e --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputCursor/Internal.lean @@ -0,0 +1,590 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputCursor.Defs + +/-! +# Finite cursors for append-only output tapes -- proof internals +-/ + +namespace Complexity + +namespace TM.OutputCursor + +theorem read_outputCursor_internal {tape : Tape} + (hstart : tape.StartInvariant) : + tape.outputCursor.read = tape.read := by + unfold Tape.outputCursor + split + · next hhead => + simp only [read, Tape.read, hhead] + exact hstart.1.symm + · rfl + +@[simp] theorem next_start_right_internal (write : Γw) : + OutputCursor.next .start write .right = .cell Γ.blank := rfl + +@[simp] theorem next_cell_right_internal (symbol : Γ) (write : Γw) : + OutputCursor.next (.cell symbol) write .right = .cell Γ.blank := rfl + +@[simp] theorem next_cell_stay_internal (symbol : Γ) (write : Γw) : + OutputCursor.next (.cell symbol) write .stay = .cell write.toΓ := rfl + +end TM.OutputCursor + +namespace Tape + +theorem outputCursor_writeAndMove_internal {tape : Tape} + (hblank : tape.BlankAfterHead) (write : Γw) (direction : Dir3) + (hnoleft : direction ≠ Dir3.left) : + (tape.writeAndMove write.toΓ direction).outputCursor = + tape.outputCursor.next write direction := by + cases direction with + | left => exact (hnoleft rfl).elim + | right => + unfold outputCursor TM.OutputCursor.next + by_cases hhead : tape.head = 0 + · have hnext : tape.cells (tape.head + 1) = Γ.blank := + hblank _ (by omega) + have hcell : tape.cells 1 = Γ.blank := by + simpa only [hhead, zero_add] using hnext + simp [Tape.writeAndMove, Tape.move, Tape.write, Tape.read, hhead, + hcell] + · have hnext : tape.cells (tape.head + 1) = Γ.blank := + hblank _ (by omega) + simp [Tape.writeAndMove, Tape.move, Tape.write, Tape.read, hhead, + hnext] + | stay => + unfold outputCursor TM.OutputCursor.next + by_cases hhead : tape.head = 0 + · simp [Tape.writeAndMove, Tape.move, Tape.write, hhead] + · simp [Tape.writeAndMove, Tape.move, Tape.write, Tape.read, hhead] + +end Tape + +namespace TM + +theorem output_startInvariant_step_internal {tm : TM n} + {cfg cfg' : Cfg n tm.Q} (hstart : cfg.output.StartInvariant) + (hstep : tm.step cfg = some cfg') : + cfg'.output.StartInvariant := by + simp only [TM.step] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + rw [← hstep] + exact hstart.writeAndMove _ _ + +theorem output_startInvariant_reachesIn_internal {tm : TM n} + {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) : + cfg'.output.StartInvariant := by + induction hreach with + | zero => exact hstart + | step hstep _ ih => + exact ih (output_startInvariant_step_internal hstart hstep) + +theorem IsTransducer.cursorStep_commute_internal {tm : TM n} + (htrans : tm.IsTransducer) {cfg cfg' : Cfg n tm.Q} + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) + (hstep : tm.step cfg = some cfg') : + tm.cursorStep (.ofCfg cfg) = some (.ofCfg cfg') := by + have hread : cfg.output.outputCursor.read = cfg.output.read := + OutputCursor.read_outputCursor_internal hstart + generalize htransition : + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = transition + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + have hnoleft : outputDir ≠ Dir3.left := by + have := htrans cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read + rw [htransition] at this + exact this + simp only [TM.step, htransition] at hstep + by_cases hhalt : cfg.state = tm.qhalt + · simp [hhalt] at hstep + · simp only [hhalt, if_false, Option.some.injEq] at hstep + subst cfg' + unfold cursorStep CursorCfg.ofCfg + rw [hread, htransition] + simp only [hhalt, if_false, Option.some.injEq, CursorCfg.mk.injEq, + true_and] + exact (Tape.outputCursor_writeAndMove_internal hblank outputWrite + outputDir hnoleft).symm + +private theorem writeAndMove_head_eq_add_advanceCount + (tape : Tape) (write : Γw) (direction : Dir3) + (hnoleft : direction ≠ Dir3.left) : + (tape.writeAndMove write direction).head = + tape.head + OutputCursor.advanceCount direction := by + cases direction with + | left => exact (hnoleft rfl).elim + | right => + simp [Tape.writeAndMove, Tape.move, Tape.write_head, + OutputCursor.advanceCount] + | stay => + simp [Tape.writeAndMove, Tape.move, Tape.write_head, + OutputCursor.advanceCount] + +theorem IsTransducer.cursorStepObserved_commute_internal {tm : TM n} + (htrans : tm.IsTransducer) {cfg cfg' : Cfg n tm.Q} + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) + (hstep : tm.step cfg = some cfg') : + tm.cursorStepObserved (.ofCfg cfg) = + some (.ofCfg cfg', tm.cursorOutputEvent (.ofCfg cfg)) := by + rw [cursorStepObserved, + htrans.cursorStep_commute_internal hstart hblank hstep] + rfl + +theorem IsTransducer.cursorStepObserved_head_internal {tm : TM n} + (htrans : tm.IsTransducer) {cfg cfg' : Cfg n tm.Q} + (hstart : cfg.output.StartInvariant) + (hstep : tm.step cfg = some cfg') : + cfg'.output.head = cfg.output.head + + (tm.cursorOutputEvent (.ofCfg cfg)).advance := by + have hread : cfg.output.outputCursor.read = cfg.output.read := + OutputCursor.read_outputCursor_internal hstart + generalize htransition : + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = transition + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + have hnoleft : outputDir ≠ Dir3.left := by + have := htrans cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read + rw [htransition] at this + exact this + have hdir : tm.cursorOutputDirection (.ofCfg cfg) = outputDir := by + unfold cursorOutputDirection CursorCfg.ofCfg + rw [hread, htransition] + simp only [TM.step, htransition] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + subst cfg' + simp only [cursorOutputEvent, hdir] + exact writeAndMove_head_eq_add_advanceCount cfg.output outputWrite + outputDir hnoleft + +theorem IsTransducer.output_head_mono_step_internal {tm : TM n} + (htrans : tm.IsTransducer) {cfg cfg' : Cfg n tm.Q} + (hstep : tm.step cfg = some cfg') : + cfg.output.head ≤ cfg'.output.head := by + generalize htransition : + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = transition + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + have hnoleft : outputDir ≠ Dir3.left := by + have := htrans cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read + rw [htransition] at this + exact this + simp only [TM.step, htransition] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + subst cfg' + cases outputDir with + | left => exact (hnoleft rfl).elim + | right => simp [Tape.writeAndMove, Tape.move, Tape.write_head] + | stay => simp [Tape.writeAndMove, Tape.move, Tape.write_head] + +private theorem output_head_step_le_internal {tm : TM n} + {cfg cfg' : Cfg n tm.Q} (hstep : tm.step cfg = some cfg') : + cfg'.output.head ≤ cfg.output.head + 1 := by + simp only [TM.step] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + rw [← hstep] + generalize hdir : + (tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read).2.2.2.2.2 = direction + cases direction with + | left => + simp [Tape.writeAndMove, Tape.move, Tape.write_head] + omega + | right => simp [Tape.writeAndMove, Tape.move, Tape.write_head] + | stay => simp [Tape.writeAndMove, Tape.move, Tape.write_head] + +theorem IsTransducer.output_head_mono_reachesIn_internal {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') : + cfg.output.head ≤ cfg'.output.head := by + induction hreach with + | zero => exact le_rfl + | step hstep _ ih => + exact (htrans.output_head_mono_step_internal hstep).trans ih + +private theorem output_cells_lt_head_step_internal {tm : TM n} + {cfg cfg' : Cfg n tm.Q} (hstep : tm.step cfg = some cfg') + {position : ℕ} (hposition : position < cfg.output.head) : + cfg'.output.cells position = cfg.output.cells position := by + simp only [TM.step] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + rw [← hstep] + have hhead : cfg.output.head ≠ 0 := by omega + have hne : cfg.output.head ≠ position := by omega + cases (tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read).2.2.2.2.2 <;> + simp [Tape.writeAndMove, Tape.move, Tape.write, hhead, + Function.update_of_ne (Ne.symm hne)] + +theorem IsTransducer.output_cells_lt_head_reachesIn_internal {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') {position : ℕ} + (hposition : position < cfg.output.head) : + cfg'.output.cells position = cfg.output.cells position := by + induction hreach with + | zero => rfl + | step hstep _ ih => + have hmono := htrans.output_head_mono_step_internal hstep + rw [ih (hposition.trans_le hmono)] + exact output_cells_lt_head_step_internal hstep hposition + +theorem cursorOutputDirection_eq_right_of_output_head_lt_internal + {tm : TM n} {cfg cfg' : Cfg n tm.Q} + (hstart : cfg.output.StartInvariant) + (hstep : tm.step cfg = some cfg') + (hhead : cfg.output.head < cfg'.output.head) : + tm.cursorOutputDirection (.ofCfg cfg) = Dir3.right := by + generalize htransition : + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = transition + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + have hdirection : + tm.cursorOutputDirection (.ofCfg cfg) = outputDir := by + have hread := OutputCursor.read_outputCursor_internal hstart + unfold cursorOutputDirection CursorCfg.ofCfg + rw [hread, htransition] + simp only [TM.step, htransition] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + subst cfg' + rw [hdirection] + cases outputDir with + | left => + simp [Tape.writeAndMove, Tape.move, Tape.write_head] at hhead + omega + | right => rfl + | stay => simp [Tape.writeAndMove, Tape.move, Tape.write_head] at hhead + +theorem cursorOutputWrite_step_cell_internal {tm : TM n} + {cfg cfg' : Cfg n tm.Q} (hstart : cfg.output.StartInvariant) + (hstep : tm.step cfg = some cfg') + (hpositive : 0 < cfg.output.head) : + cfg'.output.cells cfg.output.head = + (tm.cursorOutputWrite (.ofCfg cfg)).toΓ := by + generalize htransition : + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = transition + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + have hwrite : tm.cursorOutputWrite (.ofCfg cfg) = outputWrite := by + have hread := OutputCursor.read_outputCursor_internal hstart + unfold cursorOutputWrite CursorCfg.ofCfg + rw [hread, htransition] + simp only [TM.step, htransition] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + subst cfg' + rw [hwrite] + have hhead : cfg.output.head ≠ 0 := by omega + cases outputDir <;> + simp [Tape.writeAndMove, Tape.move, Tape.write, hhead] + +theorem exists_output_crossing_internal {tm : TM n} + {steps position : ℕ} + {cfg final : Cfg n tm.Q} (hreach : tm.reachesIn steps cfg final) + (hbefore : cfg.output.head ≤ position) + (hafter : position < final.output.head) : + ∃ prefixSteps suffixSteps selected next, + tm.reachesIn prefixSteps cfg selected ∧ + tm.step selected = some next ∧ + tm.reachesIn suffixSteps next final ∧ + selected.output.head = position ∧ + next.output.head = position + 1 := by + induction hreach with + | zero => omega + | @step source next remaining final hstep hrest ih => + by_cases hcrossed : position < next.output.head + · have hbound := output_head_step_le_internal hstep + refine ⟨0, remaining, source, next, .zero, hstep, hrest, ?_, ?_⟩ + · omega + · omega + · obtain ⟨prefixSteps, suffixSteps, selected, crossed, hprefix, hstep', + hsuffix, hselected, hcrossed'⟩ := + ih (Nat.le_of_not_gt hcrossed) hafter + exact ⟨prefixSteps + 1, suffixSteps, selected, crossed, + .step hstep hprefix, hstep', hsuffix, hselected, hcrossed'⟩ + +theorem IsTransducer.cursorTrace_commute_internal {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) : + tm.cursorTrace steps (.ofCfg cfg) = some (.ofCfg cfg') := by + induction hreach with + | zero => rfl + | @step next steps cfg final hstep hrest ih => + have hcursor := htrans.cursorStep_commute_internal + hstart hblank hstep + have hstart' := output_startInvariant_step_internal hstart hstep + have hblank' := htrans.output_blankAfterHead_step hblank hstep + simp only [cursorTrace, hcursor] + exact ih hstart' hblank' + +theorem IsTransducer.cursorTraceObserved_commute_internal {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) : + ∃ advances, + tm.cursorTraceObserved steps (.ofCfg cfg) = + some (.ofCfg cfg', advances) ∧ + cfg'.output.head = cfg.output.head + advances := by + induction hreach with + | zero => + exact ⟨0, rfl, by simp⟩ + | @step source next remaining final hstep hrest ih => + have hobserved := htrans.cursorStepObserved_commute_internal + hstart hblank hstep + have hhead := htrans.cursorStepObserved_head_internal hstart hstep + have hstart' := output_startInvariant_step_internal hstart hstep + have hblank' := htrans.output_blankAfterHead_step hblank hstep + obtain ⟨later, hlater, hfinalHead⟩ := ih hstart' hblank' + let advanced := (tm.cursorOutputEvent (.ofCfg source)).advance + refine ⟨advanced + later, ?_, ?_⟩ + · simp only [cursorTraceObserved, hobserved, hlater, + Option.bind_eq_bind, Option.bind_some, pure, advanced] + · rw [hfinalHead, hhead] + omega + +theorem IsTransducer.cursorTraceObserved_initCfg_internal {tm : TM n} + (htrans : tm.IsTransducer) {input : List Bool} {steps : ℕ} + {cfg : Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg input) cfg) : + tm.cursorTraceObserved steps (.ofCfg (tm.initCfg input)) = + some (.ofCfg cfg, cfg.output.head) := by + obtain ⟨advances, htrace, hhead⟩ := + htrans.cursorTraceObserved_commute_internal hreach + Tape.StartInvariant.init_nil Tape.BlankAfterHead.init_nil + have hadvances : advances = cfg.output.head := by + simpa using hhead.symm + simpa only [hadvances] using htrace + +theorem IsTransducer.cursorTrace_initCfg_internal {tm : TM n} + (htrans : tm.IsTransducer) {input : List Bool} {steps : ℕ} + {cfg : Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg input) cfg) : + tm.cursorTrace steps (.ofCfg (tm.initCfg input)) = + some (.ofCfg cfg) := + htrans.cursorTrace_commute_internal hreach + Tape.StartInvariant.init_nil Tape.BlankAfterHead.init_nil + +theorem suppressOutputTM_isTransducer_internal (tm : TM n) : + (suppressOutputTM tm).IsTransducer := by + intro state inputHead workHeads outputHead + rcases state with ⟨source⟩ | ⟨⟩ + · rcases source with ⟨sourceState, cursor⟩ + simp only [suppressOutputTM] + split + · cases outputHead <;> simp [allReadBack, idleDir] + · cases outputHead <;> simp [idleDir] + · cases outputHead <;> simp [suppressOutputTM, allIdle, idleDir] + +theorem suppressOutputTM_step_internal (tm : TM n) + {cfg cfg' : CursorCfg n tm.Q} (realOutput : Tape) + (hcursor : tm.cursorStep cfg = some cfg') : + (suppressOutputTM tm).step (suppressOutputCfg tm cfg realOutput) = + some (suppressOutputCfg tm cfg' + (suppressOutputTapeStep realOutput)) := by + by_cases hhalt : cfg.state = tm.qhalt + · simp [cursorStep, hhalt] at hcursor + · generalize htransition : + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = transition + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + simp only [cursorStep, hhalt, if_false, htransition, + Option.some.injEq] at hcursor + subst cfg' + simp [TM.step, suppressOutputTM, suppressOutputCfg, + suppressOutputTapeStep, hhalt, htransition] + +theorem suppressOutputTM_reachesIn_cursorTrace_internal (tm : TM n) + {steps : ℕ} {cfg cfg' : CursorCfg n tm.Q} (realOutput : Tape) + (htrace : tm.cursorTrace steps cfg = some cfg') : + (suppressOutputTM tm).reachesIn steps + (suppressOutputCfg tm cfg realOutput) + (suppressOutputCfg tm cfg' + (suppressOutputTapeTrace steps realOutput)) := by + induction steps generalizing cfg realOutput with + | zero => + simp only [cursorTrace, Option.some.injEq] at htrace + subst cfg' + exact .zero + | succ steps ih => + simp only [cursorTrace] at htrace + cases hstep : tm.cursorStep cfg with + | none => simp [hstep] at htrace + | some next => + simp only [hstep] at htrace + exact .step (suppressOutputTM_step_internal tm realOutput hstep) + (ih (suppressOutputTapeStep realOutput) htrace) + +theorem IsTransducer.suppressOutputTM_reachesIn_internal {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) (realOutput : Tape) : + (suppressOutputTM tm).reachesIn steps + (suppressOutputCfg tm (.ofCfg cfg) realOutput) + (suppressOutputCfg tm (.ofCfg cfg') + (suppressOutputTapeTrace steps realOutput)) := + suppressOutputTM_reachesIn_cursorTrace_internal tm realOutput + (htrans.cursorTrace_commute_internal hreach hstart hblank) + +theorem suppressOutputTM_halt_step_internal (tm : TM n) + (cfg : CursorCfg n tm.Q) (realOutput : Tape) + (hhalt : cfg.state = tm.qhalt) : + (suppressOutputTM tm).step (suppressOutputCfg tm cfg realOutput) = + some (suppressOutputDoneCfg tm cfg realOutput) := by + simp [TM.step, suppressOutputTM, suppressOutputCfg, + suppressOutputDoneCfg, hhalt, allReadBack] + +theorem IsTransducer.suppressOutputTM_reachesIn_halt_internal {tm : TM n} + (htrans : tm.IsTransducer) {steps : ℕ} {cfg cfg' : Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg cfg') + (hstart : cfg.output.StartInvariant) + (hblank : cfg.output.BlankAfterHead) (hhalt : tm.halted cfg') + (realOutput : Tape) : + (suppressOutputTM tm).reachesIn (steps + 1) + (suppressOutputCfg tm (.ofCfg cfg) realOutput) + (suppressOutputDoneCfg tm (.ofCfg cfg') + (suppressOutputTapeTrace steps realOutput)) := by + apply (suppressOutputTM tm).reachesIn_snoc + (htrans.suppressOutputTM_reachesIn_internal hreach hstart hblank + realOutput) + exact suppressOutputTM_halt_step_internal tm _ _ hhalt + +private theorem suppressOutputTapeStep_cells_internal {tape : Tape} + (hstart : tape.StartInvariant) : + (suppressOutputTapeStep tape).cells = tape.cells := by + unfold suppressOutputTapeStep Tape.writeAndMove + rw [Tape.move_cells] + by_cases hhead : tape.head = 0 + · simp [Tape.write, hhead] + · have hread : tape.read ≠ Γ.start := by + exact hstart.2 tape.head (by omega) + exact congrArg Tape.cells (write_readBack tape hread) + +theorem suppressOutputTapeTrace_cells_internal (steps : ℕ) {tape : Tape} + (hstart : tape.StartInvariant) : + (suppressOutputTapeTrace steps tape).cells = tape.cells := by + induction steps generalizing tape with + | zero => rfl + | succ steps ih => + rw [suppressOutputTapeTrace] + have hstart' : (suppressOutputTapeStep tape).StartInvariant := by + exact hstart.writeAndMove _ _ + calc + (suppressOutputTapeTrace steps + (suppressOutputTapeStep tape)).cells = + (suppressOutputTapeStep tape).cells := ih hstart' + _ = tape.cells := suppressOutputTapeStep_cells_internal hstart + +private theorem suppressOutputTapeStep_eq_self_internal {tape : Tape} + (hread : tape.read ≠ Γ.start) : + suppressOutputTapeStep tape = tape := by + rw [suppressOutputTapeStep] + rw [writeAndMove_readBack tape hread] + simp [idleDir, hread, Tape.move] + +theorem suppressOutputTapeTrace_eq_self_internal (steps : ℕ) {tape : Tape} + (hread : tape.read ≠ Γ.start) : + suppressOutputTapeTrace steps tape = tape := by + induction steps with + | zero => rfl + | succ steps ih => + rw [suppressOutputTapeTrace, + suppressOutputTapeStep_eq_self_internal hread, ih] + +theorem suppressOutputTapeTrace_succ_init_internal (steps : ℕ) : + suppressOutputTapeTrace (steps + 1) (Tape.init []) = + (Tape.init []).move Dir3.right := by + rw [suppressOutputTapeTrace] + have hfirst : suppressOutputTapeStep (Tape.init []) = + (Tape.init []).move Dir3.right := by + simp [suppressOutputTapeStep, Tape.writeAndMove, Tape.write, + Tape.read, Tape.move, Tape.init, idleDir] + rw [hfirst] + apply suppressOutputTapeTrace_eq_self_internal + simp [Tape.read, Tape.move, Tape.init] + +private theorem suppressOutputTapeTrace_startInvariant_internal + (steps : ℕ) {tape : Tape} (hstart : tape.StartInvariant) : + (suppressOutputTapeTrace steps tape).StartInvariant := by + induction steps generalizing tape with + | zero => exact hstart + | succ steps ih => + rw [suppressOutputTapeTrace] + exact ih (hstart.writeAndMove _ _) + +theorem suppressOutputTapeTrace_init_hasOutput_nil_internal (steps : ℕ) : + (suppressOutputTapeTrace steps (Tape.init [])).HasOutput [] := by + rw [Tape.HasOutput] + refine ⟨fun _ h => (by simp at h), ?_⟩ + rw [suppressOutputTapeTrace_cells_internal steps + Tape.StartInvariant.init_nil] + exact Tape.init_nil_cells_succ 0 + +private theorem suppressOutputDoneCfg_init_hasOutput_nil_internal + (tm : TM n) (cfg : CursorCfg n tm.Q) (steps : ℕ) : + (suppressOutputDoneCfg tm cfg + (suppressOutputTapeTrace steps (Tape.init []))).output.HasOutput [] := by + change (suppressOutputTapeStep + (suppressOutputTapeTrace steps (Tape.init []))).HasOutput [] + have hstart := suppressOutputTapeTrace_startInvariant_internal steps + Tape.StartInvariant.init_nil + rw [Tape.HasOutput] + refine ⟨fun _ h => (by simp at h), ?_⟩ + rw [suppressOutputTapeStep_cells_internal hstart, + suppressOutputTapeTrace_cells_internal steps + Tape.StartInvariant.init_nil] + exact Tape.init_nil_cells_succ 0 + +theorem IsTransducer.suppressOutputTM_computesNil_internal {tm : TM n} + {f : List Bool → List Bool} {T : ℕ → ℕ} + (htrans : tm.IsTransducer) (hcomp : tm.ComputesInTime f T) : + (suppressOutputTM tm).ComputesInTime (fun _ => []) + (fun inputLength => T inputLength + 1) := by + intro input + obtain ⟨cfg, steps, hsteps, hreach, hhalt, _hout⟩ := hcomp input + let finalCfg := suppressOutputDoneCfg tm (.ofCfg cfg) + (suppressOutputTapeTrace steps (Tape.init [])) + refine ⟨finalCfg, steps + 1, Nat.add_le_add_right hsteps 1, ?_, ?_, ?_⟩ + · simpa [finalCfg, suppressOutputTM, suppressOutputCfg, + CursorCfg.ofCfg, Tape.outputCursor] using + htrans.suppressOutputTM_reachesIn_halt_internal hreach + Tape.StartInvariant.init_nil Tape.BlankAfterHead.init_nil hhalt + (Tape.init []) + · rfl + · exact suppressOutputDoneCfg_init_hasOutput_nil_internal tm + (.ofCfg cfg) steps + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbe.lean b/Complexitylib/Models/TuringMachine/OutputProbe.lean new file mode 100644 index 00000000..60913b1b --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbe.lean @@ -0,0 +1,681 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbe.Defs +import Complexitylib.Models.TuringMachine.OutputProbe.Internal + +/-! +# Random-access probes for append-only transducer output + +`TM.outputProbeTM` adds one canonical binary countdown tape to a source +transducer. The source output is represented only by `TM.OutputCursor`. A +right output move decrements the countdown with the verified binary +predecessor machine; once it reaches zero, leaving the selected ordinary cell +captures the finalized bit. A source halt on that cell captures the cursor's +current bit. The physical output tape receives only the one-bit answer. + +This is the executable recomputation kernel needed for log-space composition: +the potentially polynomial source output is never copied to work tape, while +the requested position occupies only its binary width. + +## Main results + +- `TM.outputProbeTM_isTransducer` -- the probe retains append-only output. +- `TM.IsTransducer.outputProbeTM_step_startedCfg` -- the compulsory first + probe transition reaches the canonical restartable entry configuration. +- `TM.outputProbeTM_step_source` -- exact simulation of one source step. +- `TM.outputProbeTM_reachesIn_source_not_right` -- a non-right source step + preserves the countdown. +- `TM.outputProbeTM_reachesIn_source_positive` -- a right source step followed + by verified binary predecessor decrements a positive countdown. +- `TM.outputProbeTM_source_positive_prefix_withinAuxSpace` -- every prefix of + that countdown invocation uses only the represented binary width. +- `TM.outputProbeTM_reachesIn_cursorTraceObserved` -- an entire observed + source run consumes exactly its counted output advances. +- `TM.outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace` -- the + entire replay has an all-prefix source-space-plus-binary-width bound. +- `TM.outputProbeTM_step_halt_capture` -- zero countdown at a halted Boolean + cursor selects that bit for physical output. +- `TM.outputProbeTM_reachesIn_cursorTraceObserved_capture` -- end-to-end + replay and one-bit output when the selected frontier cell is final. +- `TM.outputProbeTM_reachesIn_cursorTraceObserved_capture_init` -- the same + theorem from canonical blank physical output, with no tape-shape premises. +- `TM.outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture` -- the + corresponding end-to-end theorem for a cell finalized before source halt. +- `TM.IsTransducer.outputProbeTM_reachesIn_getElem` -- any valid output index + of a successful concrete transducer run can be captured. +- `TM.ComputesInSpace.outputProbeTM_getElem` -- the same valid-index interface + for an abstract space-bounded function computation. +- `TM.ComputesInSpace.outputProbeTM_getElem_withinAuxSpace` -- the valid-index + query with an all-prefix space certificate through capture. +- `TM.ComputesInSpace.outputProbeTM_index_halts_withinAuxSpace` -- every + positive-position query terminates with a Boolean result and the same + all-prefix bound, including blank and beyond-frontier positions. +- `TM.ComputesInSpace.outputProbeStartedTM_getElem` -- the valid-index query + from the canonical post-sentinel frame used by phase composition. +- `TM.ComputesInSpace.outputProbeStartedTM_getElem_withinAuxSpace` -- the + restartable query with the same all-prefix certificate. +- `TM.ComputesInSpace.outputProbeStartedRetargetTM_getElem` -- the same query + with the captured bit redirected to a fresh work tape. +- `TM.ComputesInSpace.outputProbeStartedRetargetTM_getElem_withinAuxSpace` -- + the retargeted query with all physical work tapes covered by the bound. +- `TM.ComputesInSpace.placeOutputProbeStartedRetargetTM_getElem_withinAuxSpace` + -- the same query inside an arbitrary stable controller-tape frame. +- `TM.outputProbeSourceResultCfg_capture` -- a right move with a zero + countdown selects the finalized bit for capture. +- `TM.outputProbeTM_capture_hasOutput` -- capture reaches the unique halt state + with exactly the selected one-bit output. +-/ + +namespace Complexity + +namespace TM + +/-- The output-position probe never moves its physical output head left. -/ +theorem outputProbeTM_isTransducer (tm : TM n) : + (outputProbeTM tm).IsTransducer := + outputProbeTM_isTransducer_internal tm + +/-- The compulsory first probe transition reaches the canonical restartable +entry configuration, with every owned tape parked at cell one. -/ +theorem IsTransducer.outputProbeTM_step_startedCfg + {tm : TM n} (htrans : tm.IsTransducer) (input : List Bool) + (value : ℕ) (hne : tm.qstart ≠ tm.qhalt) : + (outputProbeTM tm).step + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape value) (Tape.init [])) = + some (outputProbeStartedCfg tm input + (outputProbeCounterTape value)) := + htrans.outputProbeTM_step_startedCfg_internal input value hne + +/-- One probe source-phase step implements one finite-cursor source step. The +source input/work actions are exact, the countdown is preserved during this +transition, and the independent physical output performs its idle action. -/ +theorem outputProbeTM_step_source (tm : TM n) + {cfg cfg' : CursorCfg n tm.Q} (counter output : Tape) + (hcounter : counter.read ≠ Γ.start) + (hcursor : tm.cursorStep cfg = some cfg') : + (outputProbeTM tm).step (outputProbeCfg tm cfg counter output) = + some (outputProbeSourceResultCfg tm cfg cfg' counter + (suppressOutputTapeStep output)) := + outputProbeTM_step_source_internal tm counter output hcounter hcursor + +/-- A source step whose logical output head does not move right takes one +probe transition and preserves the binary countdown exactly. -/ +theorem outputProbeTM_reachesIn_source_not_right (tm : TM n) + {before after : CursorCfg n tm.Q} (counter output : Tape) + (hcursor : tm.cursorStep before = some after) + (hdir : tm.cursorOutputDirection before ≠ Dir3.right) + (hcounter : counter.read ≠ Γ.start) : + (outputProbeTM tm).reachesIn 1 + (outputProbeCfg tm before counter output) + (outputProbeCfg tm after counter + (suppressOutputTapeStep output)) := + outputProbeTM_reachesIn_source_not_right_internal tm counter output + hcursor hdir hcounter + +/-- A right-moving source step followed by marker normalization, the verified +binary predecessor, and exact marker restoration changes a canonical positive +countdown `value + 1` to canonical `value`. The source configuration after its +one step is retained exactly, even when its input or work heads rest on `▷`. -/ +theorem outputProbeTM_reachesIn_source_positive (tm : TM n) + {before after : CursorCfg n tm.Q} {value : ℕ} + (counter output : Tape) + (hcursor : tm.cursorStep before = some after) + (hdir : tm.cursorOutputDirection before = Dir3.right) + (hcounter : counter.HasBinaryNat (value + 1)) + (hinput : after.input.StartInvariant) + (hwork : ∀ i, (after.work i).StartInvariant) + (houtput : (suppressOutputTapeStep output).read ≠ Γ.start) : + (outputProbeTM tm).reachesIn (binaryPredTime value + 3) + (outputProbeCfg tm before counter output) + (outputProbeCfg tm after (outputProbeCounterTape value) + (suppressOutputTapeStep output)) := + outputProbeTM_reachesIn_source_positive_internal tm counter output + hcursor hdir hcounter hinput hwork houtput + +/-- Every prefix of one positive-countdown source invocation stays inside the +initial auxiliary-space budget plus the represented counter's binary width +and a constant seam allowance. -/ +theorem outputProbeTM_source_positive_prefix_withinAuxSpace + (tm : TM n) {value inputLength initialSpace elapsed : ℕ} + {before : CursorCfg n tm.Q} (counter output : Tape) + {cfg : Cfg (n + 1) (outputProbeTM tm).Q} + (hinitial : + (outputProbeCfg tm before counter output).WithinAuxSpace + inputLength initialSpace) + (hprefix : elapsed ≤ binaryPredTime value + 3) + (hreach : (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg) : + cfg.WithinAuxSpace inputLength + (outputProbePositiveSpace initialSpace value) := + outputProbeTM_source_positive_prefix_withinAuxSpace_internal tm + counter output hinitial hprefix hreach + +/-- When the countdown is canonical zero, leaving an ordinary source-output +cell to the right selects the just-written Boolean symbol for capture. -/ +theorem outputProbeSourceResultCfg_capture (tm : TM n) + (before after : CursorCfg n tm.Q) (counter output : Tape) + (bit : Bool) (symbol : Γ) + (hcursor : before.output = .cell symbol) + (hdir : tm.cursorOutputDirection before = Dir3.right) + (hwrite : tm.cursorOutputWrite before = + if bit then Γw.one else Γw.zero) + (hcounter : counter.HasBinaryNat 0) : + outputProbeSourceResultCfg tm before after counter output = + outputProbeCaptureCfg tm bit after.input + (fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ else counter) + output := + outputProbeSourceResultCfg_capture_internal tm before after counter output + bit symbol hcursor hdir hwrite hcounter + +/-- An entire finite-cursor source run can be replayed by the concrete probe +without materializing its output. If the initial counter is `remaining` plus +the run's observed frontier advances, the final counter is canonical +`remaining`; the source input/work configuration is retained exactly. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved (tm : TM n) + {steps advances remaining : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat (remaining + advances)) + (houtput : output.StartInvariant) : + ∃ probeSteps, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) + (outputProbeCfg tm after (outputProbeCounterTape remaining) + (suppressOutputTapeTrace steps output)) := + outputProbeTM_reachesIn_cursorTraceObserved_internal tm counter output + htrace hinput hwork hcounter houtput + +/-- Replay an observed source run with an all-prefix auxiliary-space bound. +`Inv` may be any source invariant preserved by cursor steps whose input and +work heads stay inside `sourceSpace`. The probe adds only the binary width of +the initial countdown, independently of the number of predecessor calls. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace + (tm : TM n) (Inv : CursorCfg n tm.Q → Prop) + {steps advances remaining inputLength sourceSpace : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinv : Inv before) + (hinvStep : ∀ {cfg next}, Inv cfg → + tm.cursorStep cfg = some next → Inv next) + (hinvSpace : ∀ cfg, Inv cfg → + (∀ i, (cfg.work i).head ≤ sourceSpace) ∧ + cfg.input.head ≤ inputLength + sourceSpace + 1) + (hsourceSpace : 1 ≤ sourceSpace) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat (remaining + advances)) + (houtput : output.StartInvariant) : + ∃ probeSteps, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) + (outputProbeCfg tm after (outputProbeCounterTape remaining) + (suppressOutputTapeTrace steps output)) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg → + cfg.WithinAuxSpace inputLength + (outputProbeReplaySpace sourceSpace (remaining + advances)) := + outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace_internal tm + Inv counter output htrace hinv hinvStep hinvSpace hsourceSpace hinput + hwork hcounter houtput le_rfl + +/-- At a halted source state, a canonical zero countdown and Boolean cursor +select that cursor bit for capture. The normalization action is explicit so +the theorem applies even when source heads are parked on `▷`. -/ +theorem outputProbeTM_step_halt_capture (tm : TM n) + (cfg : CursorCfg n tm.Q) (counter output : Tape) (bit : Bool) + (hhalt : cfg.state = tm.qhalt) + (hcursor : cfg.output = .cell (Γ.ofBool bit)) + (hcounter : counter.HasBinaryNat 0) : + (outputProbeTM tm).step (outputProbeCfg tm cfg counter output) = + some (outputProbeCaptureCfg tm bit + (outputProbeNormalizeInput cfg.input) + (outputProbeNormalizeWork fun i => + if h : i.val < n then cfg.work ⟨i.val, h⟩ else counter) + (outputProbeNormalizeTape output)) := + outputProbeTM_step_halt_capture_internal tm cfg counter output bit + hhalt hcursor hcounter + +/-- From a blank physical output parked at cell one, the capture phase takes +one transition to the unique probe halt state and exposes exactly `[bit]` as +its output string. -/ +theorem outputProbeTM_capture_hasOutput (tm : TM n) (bit : Bool) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) + (hhead : output.head = 1) + (hcells : output.cells = (Tape.init []).cells) : + (outputProbeTM tm).reachesIn 1 + (outputProbeCaptureCfg tm bit input work output) + (outputProbeDoneCfg tm bit input work output) ∧ + (outputProbeTM tm).halted + (outputProbeDoneCfg tm bit input work output) ∧ + (outputProbeDoneCfg tm bit input work output).output.HasOutput [bit] := + outputProbeTM_capture_hasOutput_internal tm bit input work output + hhead hcells + +/-- Replay an entire observed source run and emit its selected final frontier +bit. The initial countdown equals the run's exact number of output advances; +the source must halt with the Boolean bit under its cursor. The two physical +output hypotheses state that suppressed execution left the blank output parked +at cell one, as it does for every positive-length run from `Tape.init []`. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_capture (tm : TM n) + {steps advances : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) (bit : Bool) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hhalt : after.state = tm.qhalt) + (hcursor : after.output = .cell (Γ.ofBool bit)) + (hphysicalHead : (suppressOutputTapeTrace steps output).head = 1) + (hphysicalCells : (suppressOutputTapeTrace steps output).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ done.output.HasOutput [bit] := + outputProbeTM_reachesIn_cursorTraceObserved_capture_internal tm counter + output bit htrace hinput hwork hcounter houtput hhalt hcursor + hphysicalHead hphysicalCells + +/-- Positive-length specialization of +`outputProbeTM_reachesIn_cursorTraceObserved_capture` from canonical blank +physical output. Suppressed execution parks that output at cell one and leaves +its cells unchanged, so callers need no physical-tape side conditions. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_capture_init (tm : TM n) + {steps advances : ℕ} + {before after : CursorCfg n tm.Q} (counter : Tape) (bit : Bool) + (htrace : tm.cursorTraceObserved (steps + 1) before = + some (after, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (hhalt : after.state = tm.qhalt) + (hcursor : after.output = .cell (Γ.ofBool bit)) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ done.output.HasOutput [bit] := + outputProbeTM_reachesIn_cursorTraceObserved_capture tm counter + (Tape.init []) bit htrace hinput hwork hcounter + Tape.StartInvariant.init_nil hhalt hcursor + (suppressOutputTapeTrace_succ_init_head steps) + (suppressOutputTapeTrace_succ_init_cells steps) + +/-- Replay an observed source prefix and emit the bit finalized by its next +right output move. This is the earlier-cell counterpart of +`outputProbeTM_reachesIn_cursorTraceObserved_capture`: together the two +theorems cover capture either when a cell is left or when the source halts on +the selected frontier cell. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture + (tm : TM n) {steps advances : ℕ} + {before selected next : CursorCfg n tm.Q} + (counter output : Tape) (bit : Bool) (symbol : Γ) + (htrace : tm.cursorTraceObserved steps before = + some (selected, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hnext : tm.cursorStep selected = some next) + (hcursor : selected.output = .cell symbol) + (hdir : tm.cursorOutputDirection selected = Dir3.right) + (hwrite : tm.cursorOutputWrite selected = + if bit then Γw.one else Γw.zero) + (hphysicalHead : (suppressOutputTapeTrace steps output).head = 1) + (hphysicalCells : (suppressOutputTapeTrace steps output).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ done.output.HasOutput [bit] := + outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture_internal tm + counter output bit symbol htrace hinput hwork hcounter houtput hnext + hcursor hdir hwrite hphysicalHead hphysicalCells + +/-- Positive-length specialization of the earlier-finalized-cell theorem from +canonical blank physical output. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture_init + (tm : TM n) {steps advances : ℕ} + {before selected next : CursorCfg n tm.Q} + (counter : Tape) (bit : Bool) (symbol : Γ) + (htrace : tm.cursorTraceObserved (steps + 1) before = + some (selected, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (hnext : tm.cursorStep selected = some next) + (hcursor : selected.output = .cell symbol) + (hdir : tm.cursorOutputDirection selected = Dir3.right) + (hwrite : tm.cursorOutputWrite selected = + if bit then Γw.one else Γw.zero) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ done.output.HasOutput [bit] := + outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture tm counter + (Tape.init []) bit symbol htrace hinput hwork hcounter + Tape.StartInvariant.init_nil hnext hcursor hdir hwrite + (suppressOutputTapeTrace_succ_init_head steps) + (suppressOutputTapeTrace_succ_init_cells steps) + +/-- Replay a successful complete transducer run to capture any valid output +index. The theorem hides whether the selected cell was finalized by an earlier +right move or remained under the source head at halt. -/ +theorem IsTransducer.outputProbeTM_reachesIn_getElem + {tm : TM n} (htrans : tm.IsTransducer) + {input bits : List Bool} {steps : ℕ} {final : Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg input) final) + (hhalt : tm.halted final) (hout : final.output.HasOutput bits) + (index : ℕ) (hindex : index < bits.length) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [bits[index]'hindex] := + htrans.outputProbeTM_reachesIn_getElem_internal + hreach hhalt hout index hindex + +/-- Every valid output index of a space-bounded function transducer is +captured by its concrete output probe from the canonical source input and +binary position tape. -/ +theorem ComputesInSpace.outputProbeTM_getElem + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [(f input)[index]'hindex] := + hcomp.outputProbeTM_getElem_internal input index hindex + +/-- Every prefix of a valid output-bit query stays within the source space +plus the binary index width and the constant capture seam. The query consumes +its countdown exactly, leaving the canonical zero tape for reuse. -/ +theorem ComputesInSpace.outputProbeTM_getElem_withinAuxSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [(f input)[index]'hindex] ∧ + done.work (Fin.last n) = outputProbeCounterTape 0 ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := + hcomp.outputProbeTM_getElem_withinAuxSpace_internal input index hindex + +/-- Every output-position query terminates with one Boolean result. Valid +indices retain the stronger exact theorem above; blank cells and positions +beyond the source frontier return zero. Every execution prefix satisfies the +same source-space-plus-binary-index bound. -/ +theorem ComputesInSpace.outputProbeTM_index_halts_withinAuxSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ + (∃ bit, done.output.HasOutput [bit]) ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := + hcomp.outputProbeTM_index_halts_withinAuxSpace_internal input index + +/-- The canonical post-sentinel probe is total at every numeric output +position and preserves the complete all-prefix space certificate. -/ +theorem ComputesInSpace.outputProbeStartedTM_index_halts_withinAuxSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) : + ∃ probeSteps done, + (outputProbeStartedTM tm).reachesIn probeSteps + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) done ∧ + (outputProbeStartedTM tm).halted done ∧ + (∃ bit, done.output.HasOutput [bit]) ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeStartedTM tm).reachesIn elapsed + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := + hcomp.outputProbeStartedTM_index_halts_withinAuxSpace_internal input index + +/-- Retargeting a total restartable query exposes one Boolean on a fresh work +tape, preserves a blank-support envelope for cleanup, and keeps the real output +parked. -/ +theorem + ComputesInSpace.outputProbeStartedRetargetTM_index_halts_withinAuxSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (∃ bit, (done.work (Fin.last (n + 1))).HasOutput [bit]) ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + done.output = (Tape.init []).move Dir3.right ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + ((outputProbeStartedTM tm).retargetOutput).reachesIn elapsed + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := + hcomp.outputProbeStartedRetargetTM_index_halts_withinAuxSpace_internal + input index + +/-- A total retargeted query preserves its Boolean result and cleanup support +when placed inside an arbitrary stable controller frame. -/ +theorem + ComputesInSpace.placeOutputProbeStartedRetargetTM_index_halts_withinAuxSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (pre post : ℕ) + (input : List Bool) (index : ℕ) + (extras : Fin (pre + (n + 2) + post) → Tape) + {frameSpace : ℕ} + (hextra : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let start := (outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) + ∃ probeSteps done, + (placeWorkTM pre post queryTM).reachesIn probeSteps + (placeWorkCfg queryTM pre post extras start) + (placeWorkCfg queryTM pre post extras done) ∧ + (placeWorkTM pre post queryTM).halted + (placeWorkCfg queryTM pre post extras done) ∧ + (∃ bit, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post (Fin.last (n + 1)))).HasOutput [bit]) ∧ + (∀ i, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post i)).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + (placeWorkCfg queryTM pre post extras done).output = + (Tape.init []).move Dir3.right ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (placeWorkTM pre post queryTM).reachesIn elapsed + (placeWorkCfg queryTM pre post extras start) cfg → + cfg.WithinAuxSpace input.length + (max + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) + frameSpace) := + hcomp.placeOutputProbeStartedRetargetTM_index_halts_withinAuxSpace_internal + pre post input index extras hextra hframe + +/-- Every valid output index of a space-bounded transducer can be queried from +the canonical post-sentinel frame. This removes the one compulsory source +transition that a caller has already paid at the enclosing machine boundary. -/ +theorem ComputesInSpace.outputProbeStartedTM_getElem + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + (outputProbeStartedTM tm).reachesIn probeSteps + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) done ∧ + (outputProbeStartedTM tm).halted done ∧ + done.output.HasOutput [(f input)[index]'hindex] := + hcomp.outputProbeStartedTM_getElem_internal input index hindex + +/-- The post-sentinel valid-index query retains the complete all-prefix +auxiliary-space certificate and leaves its countdown at canonical zero. -/ +theorem ComputesInSpace.outputProbeStartedTM_getElem_withinAuxSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + (outputProbeStartedTM tm).reachesIn probeSteps + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) done ∧ + (outputProbeStartedTM tm).halted done ∧ + done.output.HasOutput [(f input)[index]'hindex] ∧ + done.work (Fin.last n) = outputProbeCounterTape 0 ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeStartedTM tm).reachesIn elapsed + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := + hcomp.outputProbeStartedTM_getElem_withinAuxSpace_internal + input index hindex + +/-- Redirecting the restartable query writes its captured bit on the fresh +last work tape and leaves the enclosing machine's real output parked blank. -/ +theorem ComputesInSpace.outputProbeStartedRetargetTM_getElem + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (done.work (Fin.last (n + 1))).HasOutput + [(f input)[index]'hindex] ∧ + done.output = (Tape.init []).move Dir3.right := + hcomp.outputProbeStartedRetargetTM_getElem_internal input index hindex + +/-- Redirecting a restartable valid-index query to a fresh work tape covers +that tape, all source tapes, and every intermediate configuration with the +same explicit auxiliary-space budget. Its physical countdown tape is restored +to canonical zero. -/ +theorem ComputesInSpace.outputProbeStartedRetargetTM_getElem_withinAuxSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (done.work (Fin.last (n + 1))).HasOutput + [(f input)[index]'hindex] ∧ + done.work ⟨n, by omega⟩ = outputProbeCounterTape 0 ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + done.output = (Tape.init []).move Dir3.right ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + ((outputProbeStartedTM tm).retargetOutput).reachesIn elapsed + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := + hcomp.outputProbeStartedRetargetTM_getElem_withinAuxSpace_internal + input index hindex + +/-- Place a restartable retargeted query between persistent controller tapes. +The stable frame is preserved exactly, its largest head is charged alongside +the query budget, the captured bit remains available at the corresponding +physical work-tape index, and the placed countdown is canonical zero. -/ +theorem ComputesInSpace.placeOutputProbeStartedRetargetTM_getElem_withinAuxSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (pre post : ℕ) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (extras : Fin (pre + (n + 2) + post) → Tape) + {frameSpace : ℕ} + (hextra : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let start := (outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) + ∃ probeSteps done, + (placeWorkTM pre post queryTM).reachesIn probeSteps + (placeWorkCfg queryTM pre post extras start) + (placeWorkCfg queryTM pre post extras done) ∧ + (placeWorkTM pre post queryTM).halted + (placeWorkCfg queryTM pre post extras done) ∧ + ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post (Fin.last (n + 1)))).HasOutput + [(f input)[index]'hindex] ∧ + (placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post ⟨n, by omega⟩) = + outputProbeCounterTape 0 ∧ + (∀ i, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post i)).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + (placeWorkCfg queryTM pre post extras done).output = + (Tape.init []).move Dir3.right ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (placeWorkTM pre post queryTM).reachesIn elapsed + (placeWorkCfg queryTM pre post extras start) cfg → + cfg.WithinAuxSpace input.length + (max + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) + frameSpace) := + hcomp.placeOutputProbeStartedRetargetTM_getElem_withinAuxSpace_internal + pre post input index hindex extras hextra hframe + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbe/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbe/Defs.lean new file mode 100644 index 00000000..56af615c --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbe/Defs.lean @@ -0,0 +1,514 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputCursor +import Complexitylib.Models.TuringMachine.Combinators.Started +import Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs + +/-! +# Random-access probes for append-only transducer output -- definitions + +`TM.outputProbeTM` simulates a source transducer without materializing its +output. One additional work tape holds a canonical positive binary cell +position. Every right move of the simulated output head runs the verified +binary predecessor controller on that tape. Once the counter is zero, leaving +the selected logical cell captures its final written bit; halting on that cell +captures the cursor's current bit. + +The machine-level correctness and resource theorems live in the internal and +surface modules. This file contains only the finite controller and transition +construction. +-/ + +namespace Complexity + +namespace TM + +/-- Which source tapes were parked on the left-end marker before a binary +countdown phase. The probe normalizes those heads to cell one, then uses this +finite mask to restore them exactly after the predecessor halts. -/ +structure OutputProbeStartMask (n : ℕ) where + /-- Whether the source input head was on the left-end marker. -/ + input : Bool + /-- Whether each source work head was on the left-end marker. -/ + work : Fin n → Bool + deriving DecidableEq + +instance : Fintype (OutputProbeStartMask n) := + Fintype.ofEquiv (Bool × (Fin n → Bool)) + { toFun := fun data => ⟨data.1, data.2⟩ + invFun := fun mask => (mask.input, mask.work) + left_inv := fun data => by cases data; rfl + right_inv := fun mask => by cases mask; rfl } + +/-- Finite control of the output-position probe. -/ +inductive OutputProbeQ (n : ℕ) (State : Type) where + /-- Simulate one source transition with a finite output cursor. -/ + | source (state : State) (cursor : OutputCursor) + /-- Record source heads on `▷` and normalize them to cell one. -/ + | prepare (state : State) (cursor : OutputCursor) + /-- Run binary predecessor while the source configuration is frozen. -/ + | pred (state : State) (cursor : OutputCursor) + (mask : OutputProbeStartMask n) + (phase : BinaryPredPhase) + /-- Restore source heads that were normalized away from `▷`. -/ + | restore (state : State) (cursor : OutputCursor) + (mask : OutputProbeStartMask n) + /-- Emit a captured Boolean result on the physical output tape. -/ + | capture (bit : Bool) + /-- The requested position did not contain a Boolean symbol. -/ + | missing + /-- Unique normalized halt state. -/ + | done + deriving DecidableEq + +/-- The probe controller is finite whenever the source controller is finite. -/ +instance [Fintype State] [DecidableEq State] : + Fintype (OutputProbeQ n State) where + elems := + (Finset.univ.image fun pair : State × OutputCursor => + OutputProbeQ.source pair.1 pair.2) ∪ + (Finset.univ.image fun pair : State × OutputCursor => + OutputProbeQ.prepare pair.1 pair.2) ∪ + (Finset.univ.image fun data : + State × OutputCursor × OutputProbeStartMask n × BinaryPredPhase => + OutputProbeQ.pred data.1 data.2.1 data.2.2.1 data.2.2.2) ∪ + (Finset.univ.image fun data : + State × OutputCursor × OutputProbeStartMask n => + OutputProbeQ.restore data.1 data.2.1 data.2.2) ∪ + {.capture false, .capture true, .missing, .done} + complete := by + intro state + cases state <;> simp + +/-- The final work tape is the probe's canonical binary countdown. -/ +def outputProbeCounterIdx (n : ℕ) : Fin (n + 1) := + Fin.last n + +/-- Canonical rewound binary countdown supplied to the probe. -/ +def outputProbeCounterTape (value : ℕ) : Tape := + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right + +/-- All-prefix auxiliary-space budget for one positive countdown invocation. +The source/counter configuration starts inside `initialSpace`; the three probe +seams plus binary predecessor add only the represented binary width. -/ +def outputProbePositiveSpace (initialSpace value : ℕ) : ℕ := + binaryPredSpace initialSpace value + 3 + +/-- Uniform auxiliary-space budget for replay while the countdown never +exceeds `maxCounter`. -/ +def outputProbeReplaySpace (sourceSpace maxCounter : ℕ) : ℕ := + outputProbePositiveSpace sourceSpace maxCounter + +/-- All-prefix auxiliary-space budget for a successful replay followed by the +two transitions that select and emit the captured bit. -/ +def outputProbeCaptureSpace (sourceSpace maxCounter : ℕ) : ℕ := + outputProbeReplaySpace sourceSpace maxCounter + 2 + +/-- Read the source machine's work heads from the prefix of the probe layout. -/ +def outputProbeSourceHeads {n : ℕ} (workHeads : Fin (n + 1) → Γ) : + Fin n → Γ := + fun i => workHeads (Fin.castAdd 1 i) + +/-- Apply source work writes to the prefix and preserve the countdown tape. -/ +def outputProbeSourceWrites {n : ℕ} (sourceWrites : Fin n → Γw) + (workHeads : Fin (n + 1) → Γ) : Fin (n + 1) → Γw := + fun i => + if h : i.val < n then sourceWrites ⟨i.val, h⟩ + else readBackWrite (workHeads i) + +/-- Apply source work directions to the prefix and park the countdown tape. -/ +def outputProbeSourceDirs {n : ℕ} (sourceDirs : Fin n → Dir3) + (workHeads : Fin (n + 1) → Γ) : Fin (n + 1) → Dir3 := + fun i => + if h : i.val < n then sourceDirs ⟨i.val, h⟩ + else idleDir (workHeads i) + +/-- A source-simulation action with suppressed physical output. -/ +def outputProbeSourceAction {n : ℕ} {State : Type} + (nextState : OutputProbeQ n State) (sourceWrites : Fin n → Γw) + (inputDir : Dir3) (sourceDirs : Fin n → Dir3) + (workHeads : Fin (n + 1) → Γ) (outputHead : Γ) : + OutputProbeQ n State × (Fin (n + 1) → Γw) × Γw × Dir3 × + (Fin (n + 1) → Dir3) × Dir3 := + (nextState, outputProbeSourceWrites sourceWrites workHeads, + readBackWrite outputHead, inputDir, + outputProbeSourceDirs sourceDirs workHeads, idleDir outputHead) + +/-- Choose the result state for a symbol finalized by a right move. -/ +def outputProbeCaptureWrite {n : ℕ} {State : Type} : + Γw → OutputProbeQ n State + | .zero => .capture false + | .one => .capture true + | .blank => .missing + +/-- Choose the result state for the symbol under a halted source cursor. -/ +def outputProbeCaptureCursor {n : ℕ} {State : Type} : + OutputCursor → OutputProbeQ n State + | .cell .zero => .capture false + | .cell .one => .capture true + | .start | .cell .blank | .cell .start => .missing + +/-- Select the probe phase after one nonhalting source transition. -/ +def outputProbeAfterSourceTransition {n : ℕ} {State : Type} + (nextState : State) + (cursor nextCursor : OutputCursor) (outputWrite : Γw) + (outputDir : Dir3) (counterHead : Γ) : OutputProbeQ n State := + if outputDir = Dir3.right then + match cursor with + | .start => .prepare nextState nextCursor + | .cell _ => + if counterHead = Γ.blank then outputProbeCaptureWrite outputWrite + else .prepare nextState nextCursor + else .source nextState nextCursor + +/-- Record which source heads currently read the left-end marker. -/ +def outputProbeStartMask {n : ℕ} (inputHead : Γ) + (workHeads : Fin (n + 1) → Γ) : OutputProbeStartMask n where + input := inputHead == Γ.start + work := fun i => outputProbeSourceHeads workHeads i == Γ.start + +/-- Record the source-prefix start-marker mask of concrete probe tapes. -/ +def outputProbeCfgStartMask {n : ℕ} (input : Tape) + (work : Fin (n + 1) → Tape) : OutputProbeStartMask n := + outputProbeStartMask input.read (fun i => (work i).read) + +/-- Normalize one tape away from `▷` using the standard read-back idle +action. Off the marker this is the identity; on the marker it moves to cell +one. -/ +def outputProbeNormalizeTape (tape : Tape) : Tape := + tape.writeAndMove (readBackWrite tape.read) (idleDir tape.read) + +/-- Normalize the read-only input head away from `▷`. -/ +def outputProbeNormalizeInput (input : Tape) : Tape := + input.move (idleDir input.read) + +/-- Normalize all probe work tapes before running binary predecessor. -/ +def outputProbeNormalizeWork {n : ℕ} (work : Fin (n + 1) → Tape) : + Fin (n + 1) → Tape := + fun i => outputProbeNormalizeTape (work i) + +/-- Wrap the next predecessor phase, entering a restoration seam as soon as +the canonical countdown has been rewound to cell one. -/ +def outputProbeAfterPred {n : ℕ} {State : Type} (sourceState : State) + (cursor : OutputCursor) (mask : OutputProbeStartMask n) + (phase : BinaryPredPhase) : OutputProbeQ n State := + if phase = .done then .restore sourceState cursor mask + else .pred sourceState cursor mask phase + +/-- Restore a head recorded on `▷`, while retaining structural safety on +malformed configurations that still read `▷` during restoration. -/ +def outputProbeRestoreDir (wasStart : Bool) (head : Γ) : Dir3 := + if head = Γ.start then .right + else if wasStart then .left else .stay + +/-- Restore source work heads and leave the countdown head parked. -/ +def outputProbeRestoreWorkDirs {n : ℕ} (mask : OutputProbeStartMask n) + (workHeads : Fin (n + 1) → Γ) : Fin (n + 1) → Dir3 := + fun i => + if h : i.val < n then + outputProbeRestoreDir (mask.work ⟨i.val, h⟩) (workHeads i) + else idleDir (workHeads i) + +/-- Apply the restoration transition to one tape. -/ +def outputProbeRestoreTape (wasStart : Bool) (tape : Tape) : Tape := + tape.writeAndMove (readBackWrite tape.read) + (outputProbeRestoreDir wasStart tape.read) + +/-- Apply the restoration direction to the read-only input head. -/ +def outputProbeRestoreInput (wasStart : Bool) (input : Tape) : Tape := + input.move (outputProbeRestoreDir wasStart input.read) + +/-- Restore source-prefix work heads while leaving the countdown parked. -/ +def outputProbeRestoreWork {n : ℕ} (mask : OutputProbeStartMask n) + (work : Fin (n + 1) → Tape) : Fin (n + 1) → Tape := + fun i => + if h : i.val < n then + outputProbeRestoreTape (mask.work ⟨i.val, h⟩) (work i) + else outputProbeNormalizeTape (work i) + +private theorem outputProbeSourceAction_right_of_start + {n : ℕ} + {sourceOutputSafe : Prop} + {inputDir : Dir3} + {sourceDirs : Fin n → Dir3} {inputHead outputHead : Γ} + {workHeads : Fin (n + 1) → Γ} + (hsource : + (inputHead = Γ.start → inputDir = Dir3.right) ∧ + (∀ i, outputProbeSourceHeads workHeads i = Γ.start → + sourceDirs i = Dir3.right) ∧ sourceOutputSafe) : + (inputHead = Γ.start → inputDir = Dir3.right) ∧ + (∀ i, workHeads i = Γ.start → + outputProbeSourceDirs sourceDirs workHeads i = Dir3.right) ∧ + (outputHead = Γ.start → + idleDir outputHead = Dir3.right) := by + refine ⟨hsource.1, fun i hi => ?_, idleDir_right_of_start⟩ + unfold outputProbeSourceDirs + split + · next hlt => + apply hsource.2.1 ⟨i.val, hlt⟩ + simpa [outputProbeSourceHeads] using hi + · exact idleDir_right_of_start hi + +/-- Simulate a source transducer while probing one output cell. + +The first `n` work tapes are the source tapes. Work tape `n` is a canonical +binary countdown initialized by the caller. The physical output tape is not +used by the source simulation; it receives exactly the captured result bit. +Correctness is specified for positive requested cell positions and canonical +countdown tapes. -/ +def outputProbeTM (tm : TM n) : TM (n + 1) := + haveI : Fintype tm.Q := tm.finQ + haveI : DecidableEq tm.Q := tm.decEq + haveI : Fintype (OutputProbeQ n tm.Q) := inferInstance + haveI : DecidableEq (OutputProbeQ n tm.Q) := inferInstance + { Q := OutputProbeQ n tm.Q + qstart := .source tm.qstart .start + qhalt := .done + δ := fun phase inputHead workHeads outputHead => + match phase with + | .source sourceState cursor => + if sourceState = tm.qhalt then + if workHeads (outputProbeCounterIdx n) = Γ.blank then + allReadBack (outputProbeCaptureCursor cursor) + inputHead workHeads outputHead + else + allReadBack OutputProbeQ.missing inputHead workHeads outputHead + else + let (nextState, sourceWrites, outputWrite, inputDir, + sourceDirs, outputDir) := + tm.δ sourceState inputHead + (outputProbeSourceHeads workHeads) cursor.read + let nextCursor := cursor.next outputWrite outputDir + let nextPhase := outputProbeAfterSourceTransition nextState + cursor nextCursor outputWrite outputDir + (workHeads (outputProbeCounterIdx n)) + outputProbeSourceAction nextPhase sourceWrites inputDir + sourceDirs workHeads outputHead + | .prepare sourceState cursor => + let mask := outputProbeStartMask inputHead workHeads + allReadBack (.pred sourceState cursor mask .borrow) + inputHead workHeads outputHead + | .pred sourceState cursor mask predPhase => + let transition := + (binaryPredTM (outputProbeCounterIdx n)).δ predPhase inputHead + workHeads outputHead + (outputProbeAfterPred sourceState cursor mask transition.1, + transition.2.1, transition.2.2.1, transition.2.2.2.1, + transition.2.2.2.2.1, transition.2.2.2.2.2) + | .restore sourceState cursor mask => + (.source sourceState cursor, + fun i => readBackWrite (workHeads i), + readBackWrite outputHead, + outputProbeRestoreDir mask.input inputHead, + outputProbeRestoreWorkDirs mask workHeads, + idleDir outputHead) + | .capture bit => + if outputHead = Γ.start then + allReadBack (.capture bit) inputHead workHeads outputHead + else + (.done, fun i => readBackWrite (workHeads i), + if bit then .one else .zero, idleDir inputHead, + fun i => idleDir (workHeads i), .right) + | .missing => + if outputHead = Γ.start then + allReadBack .missing inputHead workHeads outputHead + else + (.done, fun i => readBackWrite (workHeads i), .zero, + idleDir inputHead, fun i => idleDir (workHeads i), .right) + | .done => + allIdle .done inputHead workHeads outputHead + δ_right_of_start := by + intro phase inputHead workHeads outputHead + match phase with + | .source sourceState cursor => + dsimp only + split + · split + · exact rightOfStart_allReadBack inputHead workHeads outputHead + · exact rightOfStart_allReadBack inputHead workHeads outputHead + · generalize htransition : + tm.δ sourceState inputHead + (outputProbeSourceHeads workHeads) cursor.read = transition + obtain ⟨nextState, sourceWrites, outputWrite, inputDir, + sourceDirs, outputDir⟩ := transition + have hsource := tm.δ_right_of_start sourceState inputHead + (outputProbeSourceHeads workHeads) cursor.read + rw [htransition] at hsource + simp only [htransition] + change + (inputHead = Γ.start → inputDir = Dir3.right) ∧ + (∀ i, workHeads i = Γ.start → + outputProbeSourceDirs sourceDirs workHeads i = + Dir3.right) ∧ + (outputHead = Γ.start → + idleDir outputHead = Dir3.right) + exact outputProbeSourceAction_right_of_start hsource + | .prepare sourceState cursor => + exact rightOfStart_allReadBack inputHead workHeads outputHead + | .pred sourceState cursor mask predPhase => + dsimp only + generalize htransition : + (binaryPredTM (outputProbeCounterIdx n)).δ predPhase inputHead + workHeads outputHead = transition + obtain ⟨nextPhase, workWrites, outputWrite, inputDir, + workDirs, outputDir⟩ := transition + have hpred := + (binaryPredTM (outputProbeCounterIdx n)).δ_right_of_start + predPhase inputHead workHeads outputHead + rw [htransition] at hpred + exact hpred + | .restore sourceState cursor mask => + refine ⟨?_, ?_, idleDir_right_of_start⟩ + · intro hinput + simp [outputProbeRestoreDir, hinput] + · intro i hi + unfold outputProbeRestoreWorkDirs + split + · simp [outputProbeRestoreDir, hi] + · exact idleDir_right_of_start hi + | .capture bit => + dsimp only + split + · exact rightOfStart_allReadBack inputHead workHeads outputHead + · next houtput => + exact ⟨idleDir_right_of_start, fun i hi => + idleDir_right_of_start hi, fun _ => rfl⟩ + | .missing => + dsimp only + split + · exact rightOfStart_allReadBack inputHead workHeads outputHead + · next houtput => + exact ⟨idleDir_right_of_start, fun i hi => + idleDir_right_of_start hi, fun _ => rfl⟩ + | .done => + exact rightOfStart_allIdle inputHead workHeads outputHead } + +/-- The output probe resumed after its compulsory first source/sentinel +transition. This form can be invoked repeatedly from parked tape frames. -/ +abbrev outputProbeStartedTM (tm : TM n) : TM (n + 1) := + (outputProbeTM tm).startedTM + +/-- Canonical restartable probe entry: source input and scratch tapes are +parked at cell one, the caller supplies a parked binary countdown, and the +physical one-bit output is blank and parked. -/ +def outputProbeStartedCfg (tm : TM n) (input : List Bool) + (counter : Tape) : Cfg (n + 1) (outputProbeStartedTM tm).Q where + state := (outputProbeStartedTM tm).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := fun i => + if i.val < n then (Tape.init []).move Dir3.right else counter + output := (Tape.init []).move Dir3.right + +/-- Embed a source cursor configuration, a physical binary countdown, and an +independent real output tape into the source-simulation phase of the probe. -/ +def outputProbeCfg (tm : TM n) (cfg : CursorCfg n tm.Q) + (counter output : Tape) : Cfg (n + 1) (outputProbeTM tm).Q where + state := .source cfg.state cfg.output + input := cfg.input + work := fun i => + if h : i.val < n then cfg.work ⟨i.val, h⟩ else counter + output := output + +/-- Configuration immediately after one simulated source step, before any +requested predecessor phase has run. -/ +def outputProbeSourceResultCfg (tm : TM n) + (before after : CursorCfg n tm.Q) (counter output : Tape) : + Cfg (n + 1) (outputProbeTM tm).Q where + state := outputProbeAfterSourceTransition after.state before.output + after.output (tm.cursorOutputWrite before) + (tm.cursorOutputDirection before) counter.read + input := after.input + work := fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ else counter + output := output + +/-- Configuration that records and normalizes source heads before a +predecessor phase. -/ +def outputProbePrepareCfg (tm : TM n) (sourceState : tm.Q) + (cursor : OutputCursor) (input : Tape) + (work : Fin (n + 1) → Tape) (output : Tape) : + Cfg (n + 1) (outputProbeTM tm).Q where + state := .prepare sourceState cursor + input := input + work := work + output := output + +/-- Canonical predecessor start obtained by normalizing every framed tape. -/ +def outputProbePredStartCfg {n : ℕ} (input : Tape) + (work : Fin (n + 1) → Tape) (output : Tape) : + Cfg (n + 1) (binaryPredTM (outputProbeCounterIdx n)).Q where + state := BinaryPredPhase.borrow + input := outputProbeNormalizeInput input + work := outputProbeNormalizeWork work + output := outputProbeNormalizeTape output + +/-- View a predecessor-machine configuration inside the probe controller. Its +halt phase is collapsed directly into the restoration seam. -/ +def outputProbePredCfg (tm : TM n) (sourceState : tm.Q) + (cursor : OutputCursor) (mask : OutputProbeStartMask n) + (cfg : Cfg (n + 1) (binaryPredTM (outputProbeCounterIdx n)).Q) : + Cfg (n + 1) (outputProbeTM tm).Q where + state := outputProbeAfterPred sourceState cursor mask cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Configuration that restores the source heads recorded on the left-end +marker before returning to source simulation. -/ +def outputProbeRestoreCfg (tm : TM n) (sourceState : tm.Q) + (cursor : OutputCursor) (mask : OutputProbeStartMask n) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) : + Cfg (n + 1) (outputProbeTM tm).Q where + state := .restore sourceState cursor mask + input := input + work := work + output := output + +/-- Configuration that is ready to emit a successfully captured bit. -/ +def outputProbeCaptureCfg (tm : TM n) (bit : Bool) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) : + Cfg (n + 1) (outputProbeTM tm).Q where + state := .capture bit + input := input + work := work + output := output + +/-- Configuration reached when a requested output position is absent. -/ +def outputProbeMissingCfg (tm : TM n) (input : Tape) + (work : Fin (n + 1) → Tape) (output : Tape) : + Cfg (n + 1) (outputProbeTM tm).Q where + state := .missing + input := input + work := work + output := output + +/-- Halted configuration after an absent-position result. -/ +def outputProbeMissingDoneCfg (tm : TM n) (input : Tape) + (work : Fin (n + 1) → Tape) (output : Tape) : + Cfg (n + 1) (outputProbeTM tm).Q where + state := .done + input := input.move (idleDir input.read) + work := fun i => + (work i).writeAndMove (readBackWrite (work i).read) + (idleDir (work i).read) + output := output.writeAndMove Γw.zero Dir3.right + +/-- Halted configuration after emitting a captured bit from an off-marker +physical output head. -/ +def outputProbeDoneCfg (tm : TM n) (bit : Bool) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) : + Cfg (n + 1) (outputProbeTM tm).Q where + state := .done + input := input.move (idleDir input.read) + work := fun i => + (work i).writeAndMove (readBackWrite (work i).read) + (idleDir (work i).read) + output := output.writeAndMove (if bit then Γw.one else Γw.zero) + Dir3.right + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbe/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbe/Internal.lean new file mode 100644 index 00000000..6cffd343 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbe/Internal.lean @@ -0,0 +1,3168 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbe.Defs +import Complexitylib.Models.TuringMachine.Combinators.Internal.Retarget +import Complexitylib.Models.TuringMachine.Combinators.WorkBranch +import Complexitylib.Models.TuringMachine.Hoare.Space +import Complexitylib.Models.TuringMachine.Lift +import Complexitylib.Models.TuringMachine.Placement.Internal +import Complexitylib.Models.TuringMachine.SpaceTime.WorkSupport +import Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Random-access probes for append-only transducer output -- proof internals +-/ + +namespace Complexity + +namespace TM + +private theorem hasBinaryNat_positive_read_ne_blank_internal + {tape : Tape} {value : ℕ} (hvalue : tape.HasBinaryNat value) + (hpositive : 0 < value) : tape.read ≠ Γ.blank := by + intro hblank + have := hvalue.read_eq_blank_iff.mp hblank + omega + +theorem outputProbeCfg_sourceHeads_internal (tm : TM n) + (cfg : CursorCfg n tm.Q) (counter output : Tape) : + outputProbeSourceHeads + (fun i => ((outputProbeCfg tm cfg counter output).work i).read) = + fun i => (cfg.work i).read := by + funext i + simp [outputProbeSourceHeads, outputProbeCfg] + +@[simp] theorem outputProbeCfg_counter_internal (tm : TM n) + (cfg : CursorCfg n tm.Q) (counter output : Tape) : + (outputProbeCfg tm cfg counter output).work + (outputProbeCounterIdx n) = counter := by + simp [outputProbeCfg, outputProbeCounterIdx] + +theorem outputProbeTM_isTransducer_internal (tm : TM n) : + (outputProbeTM tm).IsTransducer := by + intro phase inputHead workHeads outputHead + cases phase with + | source sourceState cursor => + simp only [outputProbeTM] + split + · split <;> cases outputHead <;> simp [allReadBack, idleDir] + · generalize htransition : + tm.δ sourceState inputHead + (outputProbeSourceHeads workHeads) cursor.read = transition + obtain ⟨nextState, sourceWrites, outputWrite, inputDir, + sourceDirs, outputDir⟩ := transition + cases outputHead <;> + simp [htransition, outputProbeSourceAction, idleDir] + | prepare sourceState cursor => + cases outputHead <;> simp [outputProbeTM, allReadBack, idleDir] + | pred sourceState cursor mask predPhase => + simp only [outputProbeTM] + generalize htransition : + (binaryPredTM (outputProbeCounterIdx n)).δ predPhase inputHead + workHeads outputHead = transition + obtain ⟨nextPhase, workWrites, outputWrite, inputDir, + workDirs, outputDir⟩ := transition + have htrans := binaryPredTM_isTransducer + (outputProbeCounterIdx n) predPhase inputHead workHeads outputHead + rw [htransition] at htrans + exact htrans + | restore sourceState cursor mask => + cases outputHead <;> + simp [outputProbeTM, outputProbeRestoreDir, idleDir] + | capture bit => + simp only [outputProbeTM] + split + · cases outputHead <;> simp [allReadBack, idleDir] + · cases bit <;> simp + | missing => + cases outputHead <;> simp [outputProbeTM, allReadBack, idleDir] + | done => + cases outputHead <;> simp [outputProbeTM, allIdle, idleDir] + +theorem outputProbeTM_step_source_internal (tm : TM n) + {cfg cfg' : CursorCfg n tm.Q} (counter output : Tape) + (hcounter : counter.read ≠ Γ.start) + (hcursor : tm.cursorStep cfg = some cfg') : + (outputProbeTM tm).step (outputProbeCfg tm cfg counter output) = + some (outputProbeSourceResultCfg tm cfg cfg' counter + (suppressOutputTapeStep output)) := by + by_cases hhalt : cfg.state = tm.qhalt + · simp [cursorStep, hhalt] at hcursor + · generalize htransition : + tm.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = transition + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + simp only [cursorStep, hhalt, if_false, htransition, + Option.some.injEq] at hcursor + subst cfg' + have hheads : + outputProbeSourceHeads + (fun i => + ((if h : i.val < n then cfg.work ⟨i.val, h⟩ + else counter) : Tape).read) = + fun i => (cfg.work i).read := by + funext i + simp [outputProbeSourceHeads] + have hcounterIdle : + counter.writeAndMove (readBackWrite counter.read) + (idleDir counter.read) = counter := by + rw [writeAndMove_readBack counter hcounter] + simp [idleDir, hcounter, Tape.move] + simp [TM.step, outputProbeTM, outputProbeCfg, + outputProbeSourceResultCfg, + outputProbeSourceWrites, outputProbeSourceDirs, + outputProbeSourceAction, cursorOutputWrite, cursorOutputDirection, + suppressOutputTapeStep, outputProbeCounterIdx, hhalt, hheads, + htransition] + funext i + split + · rfl + · exact hcounterIdle + +theorem outputProbeTM_step_pred_internal (tm : TM n) + (sourceState : tm.Q) (cursor : OutputCursor) + (mask : OutputProbeStartMask n) + {cfg cfg' : Cfg (n + 1) + (binaryPredTM (outputProbeCounterIdx n)).Q} + (hstep : (binaryPredTM (outputProbeCounterIdx n)).step cfg = + some cfg') : + (outputProbeTM tm).step + (outputProbePredCfg tm sourceState cursor mask cfg) = + some (outputProbePredCfg tm sourceState cursor mask cfg') := by + have hstate : cfg.state ≠ BinaryPredPhase.done := by + exact state_ne_qhalt_of_step hstep + have hhalt : + cfg.state ≠ (binaryPredTM (outputProbeCounterIdx n)).qhalt := + hstate + generalize htransition : + (binaryPredTM (outputProbeCounterIdx n)).δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read = transition + obtain ⟨nextPhase, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + rw [TM.step, if_neg hhalt, htransition] at hstep + simp only [Option.some.injEq] at hstep + subst cfg' + have hcurrent : outputProbeAfterPred sourceState cursor mask cfg.state = + .pred sourceState cursor mask cfg.state := by + unfold outputProbeAfterPred + exact if_neg hstate + have hprobeNotHalt : + (OutputProbeQ.pred sourceState cursor mask cfg.state : + OutputProbeQ n tm.Q) ≠ + .done := by + simp + have hwrappedNotHalt : + outputProbeAfterPred sourceState cursor mask cfg.state ≠ + (outputProbeTM tm).qhalt := by + rw [hcurrent] + exact hprobeNotHalt + rw [TM.step] + simp only [outputProbePredCfg, hcurrent] + split + · next heq => exact (hwrappedNotHalt heq).elim + · simp only [outputProbeTM, htransition] + +theorem outputProbeTM_reachesIn_pred_internal (tm : TM n) + (sourceState : tm.Q) (cursor : OutputCursor) + (mask : OutputProbeStartMask n) + {steps : ℕ} + {cfg cfg' : Cfg (n + 1) + (binaryPredTM (outputProbeCounterIdx n)).Q} + (hreach : (binaryPredTM (outputProbeCounterIdx n)).reachesIn + steps cfg cfg') : + (outputProbeTM tm).reachesIn steps + (outputProbePredCfg tm sourceState cursor mask cfg) + (outputProbePredCfg tm sourceState cursor mask cfg') := by + induction hreach with + | zero => exact .zero + | step hstep _ ih => + exact .step + (outputProbeTM_step_pred_internal tm sourceState cursor mask hstep) ih + +private theorem startInvariant_read_eq_start_iff_internal (tape : Tape) + (hinv : tape.StartInvariant) : + tape.read = Γ.start ↔ tape.head = 0 := by + constructor + · intro hread + by_contra hhead + exact hinv.2 tape.head (by omega) (by simpa [Tape.read] using hread) + · intro hhead + simp [Tape.read, hhead, hinv.1] + +private theorem outputProbeNormalizeTape_eq_self_internal {tape : Tape} + (hread : tape.read ≠ Γ.start) : + outputProbeNormalizeTape tape = tape := by + rw [outputProbeNormalizeTape, writeAndMove_readBack tape hread] + simp [idleDir, hread, Tape.move] + +private theorem outputProbeNormalizeInput_eq_self_internal {input : Tape} + (hread : input.read ≠ Γ.start) : + outputProbeNormalizeInput input = input := by + simp [outputProbeNormalizeInput, idleDir, hread, Tape.move] + +private theorem outputProbeNormalizeTape_read_ne_start_internal {tape : Tape} + (hinv : tape.StartInvariant) : + (outputProbeNormalizeTape tape).read ≠ Γ.start := by + by_cases hread : tape.read = Γ.start + · have hhead := + (startInvariant_read_eq_start_iff_internal tape hinv).mp hread + have hnormalized : outputProbeNormalizeTape tape = tape.move .right := by + unfold outputProbeNormalizeTape + simp only [hread, readBackWrite, idleDir] + change (tape.write Γ.blank).move Dir3.right = tape.move Dir3.right + rw [show tape.write Γ.blank = tape by simp [Tape.write, hhead]] + rw [hnormalized] + exact (hinv.move .right).read_ne_start (by simp [Tape.move, hhead]) + · rw [outputProbeNormalizeTape_eq_self_internal hread] + exact hread + +private theorem outputProbeNormalizeInput_read_ne_start_internal {input : Tape} + (hinv : input.StartInvariant) : + (outputProbeNormalizeInput input).read ≠ Γ.start := by + by_cases hread : input.read = Γ.start + · have hhead := + (startInvariant_read_eq_start_iff_internal input hinv).mp hread + rw [show outputProbeNormalizeInput input = input.move .right by + simp [outputProbeNormalizeInput, idleDir, hread]] + exact (hinv.move .right).read_ne_start (by simp [Tape.move, hhead]) + · rw [outputProbeNormalizeInput_eq_self_internal hread] + exact hread + +private theorem suppressOutputTapeTrace_startInvariant_probe_internal + (steps : ℕ) {tape : Tape} (hinv : tape.StartInvariant) : + (suppressOutputTapeTrace steps tape).StartInvariant := by + induction steps generalizing tape with + | zero => exact hinv + | succ steps ih => + exact ih (hinv.writeAndMove _ _) + +private theorem outputProbeNormalize_suppress_init_head_internal + (steps : ℕ) : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps (Tape.init []))).head = 1 := by + cases steps with + | zero => + change (outputProbeNormalizeTape (Tape.init [])).head = 1 + rfl + | succ steps => + rw [suppressOutputTapeTrace_succ_init] + rw [outputProbeNormalizeTape_eq_self_internal (by + simp [Tape.read, Tape.move, Tape.init])] + rfl + +private theorem outputProbeNormalize_suppress_init_cells_internal + (steps : ℕ) : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps (Tape.init []))).cells = + (Tape.init []).cells := by + cases steps with + | zero => + change (outputProbeNormalizeTape (Tape.init [])).cells = + (Tape.init []).cells + rfl + | succ steps => + rw [suppressOutputTapeTrace_succ_init] + rw [outputProbeNormalizeTape_eq_self_internal (by + simp [Tape.read, Tape.move, Tape.init])] + rfl + +private theorem outputProbeRestoreInput_normalize_internal {input : Tape} + (hinv : input.StartInvariant) : + outputProbeRestoreInput (input.read == Γ.start) + (outputProbeNormalizeInput input) = input := by + by_cases hread : input.read = Γ.start + · have hhead := + (startInvariant_read_eq_start_iff_internal input hinv).mp hread + have hnormalized : outputProbeNormalizeInput input = input.move .right := by + simp [outputProbeNormalizeInput, idleDir, hread] + have hnormalizedRead : (input.move .right).read ≠ Γ.start := + (hinv.move .right).read_ne_start (by simp [Tape.move, hhead]) + simp only [hread, beq_self_eq_true, hnormalized, + outputProbeRestoreInput] + rw [show outputProbeRestoreDir true (input.move .right).read = .left by + simp [outputProbeRestoreDir, hnormalizedRead]] + apply Tape.ext + · simp [Tape.move, hhead] + · simp [Tape.move] + · have hbeq : (input.read == Γ.start) = false := by + exact beq_eq_false_iff_ne.mpr hread + rw [hbeq, outputProbeNormalizeInput_eq_self_internal hread] + simp [outputProbeRestoreInput, outputProbeRestoreDir, hread, Tape.move] + +private theorem outputProbeRestoreTape_normalize_internal {tape : Tape} + (hinv : tape.StartInvariant) : + outputProbeRestoreTape (tape.read == Γ.start) + (outputProbeNormalizeTape tape) = tape := by + by_cases hread : tape.read = Γ.start + · have hhead := + (startInvariant_read_eq_start_iff_internal tape hinv).mp hread + have hnormalized : outputProbeNormalizeTape tape = tape.move .right := by + unfold outputProbeNormalizeTape + simp only [hread, readBackWrite, idleDir] + change (tape.write Γ.blank).move Dir3.right = tape.move Dir3.right + rw [show tape.write Γ.blank = tape by simp [Tape.write, hhead]] + have hnormalizedRead : (tape.move .right).read ≠ Γ.start := + (hinv.move .right).read_ne_start (by simp [Tape.move, hhead]) + simp only [hread, beq_self_eq_true, hnormalized, outputProbeRestoreTape] + rw [writeAndMove_readBack _ hnormalizedRead] + rw [show outputProbeRestoreDir true (tape.move .right).read = .left by + simp [outputProbeRestoreDir, hnormalizedRead]] + apply Tape.ext + · simp [Tape.move, hhead] + · simp [Tape.move] + · have hbeq : (tape.read == Γ.start) = false := by + exact beq_eq_false_iff_ne.mpr hread + rw [hbeq, outputProbeNormalizeTape_eq_self_internal hread, + outputProbeRestoreTape, writeAndMove_readBack _ hread] + simp [outputProbeRestoreDir, hread, Tape.move] + +theorem outputProbeTM_step_prepare_internal (tm : TM n) + (sourceState : tm.Q) (cursor : OutputCursor) (input : Tape) + (work : Fin (n + 1) → Tape) (output : Tape) : + (outputProbeTM tm).step + (outputProbePrepareCfg tm sourceState cursor input work output) = + some (outputProbePredCfg tm sourceState cursor + (outputProbeCfgStartMask input work) + (outputProbePredStartCfg input work output)) := by + simp [TM.step, outputProbeTM, outputProbePrepareCfg, + outputProbePredCfg, outputProbePredStartCfg, + outputProbeCfgStartMask, outputProbeStartMask, + outputProbeAfterPred, allReadBack, outputProbeNormalizeInput, + outputProbeNormalizeTape] + funext i + rfl + +theorem outputProbeTM_step_restore_internal (tm : TM n) + (sourceState : tm.Q) (cursor : OutputCursor) + (mask : OutputProbeStartMask n) (input : Tape) + (work : Fin (n + 1) → Tape) (output : Tape) : + (outputProbeTM tm).step + (outputProbeRestoreCfg tm sourceState cursor mask input work output) = + some + { state := OutputProbeQ.source sourceState cursor + input := outputProbeRestoreInput mask.input input + work := outputProbeRestoreWork mask work + output := outputProbeNormalizeTape output } := by + simp only [TM.step, outputProbeTM, outputProbeRestoreCfg, + outputProbeRestoreInput, + outputProbeNormalizeTape, outputProbeRestoreWorkDirs] + rw [if_neg (by simp)] + congr 2 + funext i + unfold outputProbeRestoreWork + split <;> rfl + +theorem outputProbeSourceResultCfg_positive_internal (tm : TM n) + (before after : CursorCfg n tm.Q) (counter output : Tape) + (hdir : tm.cursorOutputDirection before = Dir3.right) + {value : ℕ} (hcounter : counter.HasBinaryNat (value + 1)) : + outputProbeSourceResultCfg tm before after counter output = + outputProbePrepareCfg tm after.state after.output after.input + (fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ else counter) + output := by + apply Cfg.ext + · cases houtput : before.output with + | start => + simp [outputProbeSourceResultCfg, outputProbePrepareCfg, + outputProbeAfterSourceTransition, hdir, + houtput] + | cell symbol => + have hnotblank : counter.read ≠ Γ.blank := + hasBinaryNat_positive_read_ne_blank_internal hcounter (by omega) + simp [outputProbeSourceResultCfg, outputProbePrepareCfg, + outputProbeAfterSourceTransition, hdir, + houtput, hnotblank] + · rfl + · rfl + · rfl + +theorem outputProbeSourceResultCfg_not_right_internal (tm : TM n) + (before after : CursorCfg n tm.Q) (counter output : Tape) + (hdir : tm.cursorOutputDirection before ≠ Dir3.right) : + outputProbeSourceResultCfg tm before after counter output = + outputProbeCfg tm after counter output := by + apply Cfg.ext + · simp [outputProbeSourceResultCfg, outputProbeCfg, + outputProbeAfterSourceTransition, hdir] + · rfl + · rfl + · rfl + +theorem outputProbeSourceResultCfg_capture_internal (tm : TM n) + (before after : CursorCfg n tm.Q) (counter output : Tape) + (bit : Bool) (symbol : Γ) + (hcursor : before.output = .cell symbol) + (hdir : tm.cursorOutputDirection before = Dir3.right) + (hwrite : tm.cursorOutputWrite before = + if bit then Γw.one else Γw.zero) + (hcounter : counter.HasBinaryNat 0) : + outputProbeSourceResultCfg tm before after counter output = + outputProbeCaptureCfg tm bit after.input + (fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ else counter) + output := by + have hblank : counter.read = Γ.blank := + hcounter.read_eq_blank_iff.mpr rfl + apply Cfg.ext + · cases bit <;> + simp [outputProbeSourceResultCfg, outputProbeCaptureCfg, + outputProbeAfterSourceTransition, outputProbeCaptureWrite, + hcursor, hdir, hwrite, hblank] + · rfl + · rfl + · rfl + +theorem outputProbeSourceResultCfg_missing_internal (tm : TM n) + (before after : CursorCfg n tm.Q) (counter output : Tape) + (symbol : Γ) + (hcursor : before.output = .cell symbol) + (hdir : tm.cursorOutputDirection before = Dir3.right) + (hwrite : tm.cursorOutputWrite before = Γw.blank) + (hcounter : counter.HasBinaryNat 0) : + outputProbeSourceResultCfg tm before after counter output = + outputProbeMissingCfg tm after.input + (fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ else counter) + output := by + have hblank : counter.read = Γ.blank := + hcounter.read_eq_blank_iff.mpr rfl + apply Cfg.ext + · simp [outputProbeSourceResultCfg, outputProbeMissingCfg, + outputProbeAfterSourceTransition, outputProbeCaptureWrite, + hcursor, hdir, hwrite, hblank] + · rfl + · rfl + · rfl + +theorem outputProbeTM_reachesIn_source_not_right_internal (tm : TM n) + {before after : CursorCfg n tm.Q} (counter output : Tape) + (hcursor : tm.cursorStep before = some after) + (hdir : tm.cursorOutputDirection before ≠ Dir3.right) + (hcounter : counter.read ≠ Γ.start) : + (outputProbeTM tm).reachesIn 1 + (outputProbeCfg tm before counter output) + (outputProbeCfg tm after counter + (suppressOutputTapeStep output)) := by + have hstep := outputProbeTM_step_source_internal tm counter output + hcounter hcursor + rw [outputProbeSourceResultCfg_not_right_internal tm before after + counter (suppressOutputTapeStep output) hdir] at hstep + exact .step hstep .zero + +theorem outputProbeTM_reachesIn_source_positive_internal (tm : TM n) + {before after : CursorCfg n tm.Q} {value : ℕ} + (counter output : Tape) + (hcursor : tm.cursorStep before = some after) + (hdir : tm.cursorOutputDirection before = Dir3.right) + (hcounter : counter.HasBinaryNat (value + 1)) + (hinput : after.input.StartInvariant) + (hwork : ∀ i, (after.work i).StartInvariant) + (houtput : (suppressOutputTapeStep output).read ≠ Γ.start) : + (outputProbeTM tm).reachesIn (binaryPredTime value + 3) + (outputProbeCfg tm before counter output) + (outputProbeCfg tm after (outputProbeCounterTape value) + (suppressOutputTapeStep output)) := by + let nextOutput := suppressOutputTapeStep output + let framedWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ else counter + let mask := outputProbeCfgStartMask after.input framedWork + let predStart := outputProbePredStartCfg after.input framedWork nextOutput + have hcounterRead : counter.read ≠ Γ.start := by + rw [Tape.read, hcounter.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hcounter.2 1 le_rfl + have hcounterNormalized : outputProbeNormalizeTape counter = counter := + outputProbeNormalizeTape_eq_self_internal hcounterRead + have hcounterAt : + (predStart.work (outputProbeCounterIdx n)).HasBinaryNat + (value + 1) := by + simpa [predStart, outputProbePredStartCfg, outputProbeNormalizeWork, + framedWork, outputProbeCounterIdx, hcounterNormalized] using hcounter + have hother : ∀ i, i ≠ outputProbeCounterIdx n → + (predStart.work i).read ≠ Γ.start := by + intro i hi + have hlt : i.val < n := by + apply Fin.val_lt_last + simpa [outputProbeCounterIdx] using hi + simpa [predStart, outputProbePredStartCfg, outputProbeNormalizeWork, + framedWork, hlt] using + outputProbeNormalizeTape_read_ne_start_internal (hwork ⟨i.val, hlt⟩) + obtain ⟨predFinal, hpredRun, hpredHalt, hpredInput, + hpredOther, hpredCounter, hpredOutput⟩ := + binaryPredTM_reachesIn_frame (outputProbeCounterIdx n) value + predStart.input predStart.work predStart.output hcounterAt + (by + simpa [predStart, outputProbePredStartCfg] using + outputProbeNormalizeInput_read_ne_start_internal hinput) + hother + (by + simpa [predStart, outputProbePredStartCfg, nextOutput, + outputProbeNormalizeTape_eq_self_internal houtput] using houtput) + have hfirst := outputProbeTM_step_source_internal tm counter output + hcounterRead hcursor + have hsourceResult : + outputProbeSourceResultCfg tm before after counter nextOutput = + outputProbePrepareCfg tm after.state after.output after.input + framedWork nextOutput := by + simpa [framedWork, nextOutput] using + outputProbeSourceResultCfg_positive_internal tm before after + counter nextOutput hdir hcounter + have hprepare := outputProbeTM_step_prepare_internal tm after.state + after.output after.input framedWork nextOutput + have hprepareTarget : + outputProbePredCfg tm after.state after.output mask predStart = + outputProbePredCfg tm after.state after.output + (outputProbeCfgStartMask after.input framedWork) + (outputProbePredStartCfg after.input framedWork nextOutput) := by + rfl + rw [hprepareTarget] at hprepare + have hwrappedRun := outputProbeTM_reachesIn_pred_internal tm + after.state after.output mask hpredRun + have hrestoreCfg : + outputProbePredCfg tm after.state after.output mask predFinal = + outputProbeRestoreCfg tm after.state after.output mask + predFinal.input predFinal.work predFinal.output := by + apply Cfg.ext + · have hstate : predFinal.state = BinaryPredPhase.done := hpredHalt + simp [outputProbePredCfg, outputProbeRestoreCfg, outputProbeAfterPred, + hstate] + · rfl + · rfl + · rfl + have hrestore := outputProbeTM_step_restore_internal tm after.state + after.output mask predFinal.input predFinal.work predFinal.output + rw [← hrestoreCfg] at hrestore + have hcounterEq : + predFinal.work (outputProbeCounterIdx n) = + outputProbeCounterTape value := by + exact Tape.eq_init_move_right_of_hasBinaryString hpredCounter.2 + hpredCounter.1 + have hrestored : + ({ state := OutputProbeQ.source after.state after.output + input := outputProbeRestoreInput mask.input predFinal.input + work := outputProbeRestoreWork mask predFinal.work + output := outputProbeNormalizeTape predFinal.output } : + Cfg (n + 1) (outputProbeTM tm).Q) = + outputProbeCfg tm after (outputProbeCounterTape value) nextOutput := by + apply Cfg.ext + · rfl + · rw [hpredInput] + simpa [mask, predStart, outputProbePredStartCfg, + outputProbeCfgStartMask, outputProbeStartMask] using + outputProbeRestoreInput_normalize_internal hinput + · change outputProbeRestoreWork mask predFinal.work = + fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ + else outputProbeCounterTape value + funext i + by_cases hi : i = outputProbeCounterIdx n + · subst i + have hcounterFinalRead : + (outputProbeCounterTape value).read ≠ Γ.start := by + rw [← hcounterEq] + rw [Tape.read, hpredCounter.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hpredCounter.2 1 le_rfl + have hlast : ¬ (outputProbeCounterIdx n).val < n := by + simp [outputProbeCounterIdx] + rw [show outputProbeRestoreWork mask predFinal.work + (outputProbeCounterIdx n) = outputProbeNormalizeTape + (predFinal.work (outputProbeCounterIdx n)) by + simp [outputProbeRestoreWork, hlast], dif_neg hlast] + rw [hcounterEq, + outputProbeNormalizeTape_eq_self_internal hcounterFinalRead] + · have hlt : i.val < n := by + apply Fin.val_lt_last + simpa [outputProbeCounterIdx] using hi + have hsame := hpredOther i hi + rw [dif_pos hlt] + unfold outputProbeRestoreWork + rw [dif_pos hlt] + rw [hsame] + have hmask : mask.work ⟨i.val, hlt⟩ = + ((after.work ⟨i.val, hlt⟩).read == Γ.start) := by + simp [mask, outputProbeCfgStartMask, outputProbeStartMask, + outputProbeSourceHeads, framedWork] + rw [hmask] + simpa [predStart, outputProbePredStartCfg, + outputProbeNormalizeWork, framedWork, hlt] using + outputProbeRestoreTape_normalize_internal (hwork ⟨i.val, hlt⟩) + · change outputProbeNormalizeTape predFinal.output = nextOutput + rw [hpredOutput] + change outputProbeNormalizeTape + (outputProbeNormalizeTape nextOutput) = nextOutput + rw [outputProbeNormalizeTape_eq_self_internal houtput, + outputProbeNormalizeTape_eq_self_internal houtput] + rw [hsourceResult] at hfirst + rw [hrestored] at hrestore + have hpredAndRestore := + (outputProbeTM tm).reachesIn_snoc hwrappedRun hrestore + have hrun := TM.reachesIn.step hfirst + (TM.reachesIn.step hprepare hpredAndRestore) + have htime : binaryPredTime value + 1 + 1 + 1 = + binaryPredTime value + 3 := by omega + rw [← htime] + simpa [nextOutput] using hrun + +/-- Every prefix of one positive-countdown source invocation stays within the +explicit binary-width budget. This formulation is independent of the exact +phase reached by the prefix, so it composes directly across observed runs. -/ +theorem outputProbeTM_source_positive_prefix_withinAuxSpace_internal + (tm : TM n) {value inputLength initialSpace elapsed : ℕ} + {before : CursorCfg n tm.Q} (counter output : Tape) + {cfg : Cfg (n + 1) (outputProbeTM tm).Q} + (hinitial : + (outputProbeCfg tm before counter output).WithinAuxSpace + inputLength initialSpace) + (hprefix : elapsed ≤ binaryPredTime value + 3) + (hreach : (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg) : + cfg.WithinAuxSpace inputLength + (outputProbePositiveSpace initialSpace value) := by + have hspace := hinitial.reachesIn hreach + apply hspace.mono le_rfl + have htime := binaryPredTime_le value + simp only [outputProbePositiveSpace, binaryPredSpace] + omega + +private theorem cursorStep_startInvariant_internal (tm : TM n) + {before after : CursorCfg n tm.Q} + (hstep : tm.cursorStep before = some after) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) : + after.input.StartInvariant ∧ + ∀ i, (after.work i).StartInvariant := by + by_cases hhalt : before.state = tm.qhalt + · simp [cursorStep, hhalt] at hstep + · generalize htransition : + tm.δ before.state before.input.read + (fun i => (before.work i).read) before.output.read = transition + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + simp only [cursorStep, hhalt, if_false, htransition, + Option.some.injEq] at hstep + subst after + exact ⟨hinput.move inputDir, + fun i => (hwork i).writeAndMove (workWrites i) (workDirs i)⟩ + +private theorem suppressOutputTapeStep_startInvariant_internal {output : Tape} + (hinv : output.StartInvariant) : + (suppressOutputTapeStep output).StartInvariant := + hinv.writeAndMove _ _ + +private theorem suppressOutputTapeStep_read_ne_start_internal {output : Tape} + (hinv : output.StartInvariant) : + (suppressOutputTapeStep output).read ≠ Γ.start := by + simpa [suppressOutputTapeStep, outputProbeNormalizeTape] using + outputProbeNormalizeTape_read_ne_start_internal hinv + +private theorem outputProbeCounterTape_hasBinaryNat_internal (value : ℕ) : + (outputProbeCounterTape value).HasBinaryNat value := by + simpa [outputProbeCounterTape] using Tape.init_move_right_hasBinaryNat value + +theorem IsTransducer.outputProbeTM_step_startedCfg_internal + {tm : TM n} (htrans : tm.IsTransducer) (input : List Bool) + (value : ℕ) (hne : tm.qstart ≠ tm.qhalt) : + (outputProbeTM tm).step + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape value) (Tape.init [])) = + some (outputProbeStartedCfg tm input + (outputProbeCounterTape value)) := by + let sourceStarted := startedCfg tm input hne + have hsourceStep : tm.step (tm.initCfg input) = some sourceStarted := + step_initCfg_startedCfg tm input hne + have hcursorStep : tm.cursorStep (.ofCfg (tm.initCfg input)) = + some (.ofCfg sourceStarted) := + htrans.cursorStep_commute Tape.StartInvariant.init_nil + Tape.BlankAfterHead.init_nil hsourceStep + have hcounter := outputProbeCounterTape_hasBinaryNat_internal value + have hcounterRead : (outputProbeCounterTape value).read ≠ Γ.start := by + rw [Tape.read, hcounter.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hcounter.2 1 le_rfl + have hprobeStep := outputProbeTM_step_source_internal tm + (outputProbeCounterTape value) (Tape.init []) hcounterRead hcursorStep + rw [hprobeStep] + apply congrArg some + apply Cfg.ext + · have hsourceState : sourceStarted.state = tm.startedState := by + simp [sourceStarted, startedCfg, TM.step, hne, startedState, + Tape.read, Tape.init] + have hsourceOutput : sourceStarted.output.outputCursor = + OutputCursor.cell Γ.blank := by + rw [startedCfg_output_eq_init_move_right tm input hne] + rfl + have hdir : tm.cursorOutputDirection (.ofCfg (tm.initCfg input)) = + Dir3.right := by + apply cursorOutputDirection_eq_right_of_output_head_lt + Tape.StartInvariant.init_nil hsourceStep + rw [startedCfg_output_eq_init_move_right tm input hne] + simp [Tape.move] + have hstartOutputDir : + (tm.δ tm.qstart Γ.start (fun _ => Γ.start) Γ.start).2.2.2.2.2 = + Dir3.right := by + exact (tm.δ_right_of_start tm.qstart Γ.start + (fun _ => Γ.start) Γ.start).2.2 rfl + have hstartHeads : + outputProbeSourceHeads (n := n) (fun _ => Γ.start) = + (fun _ => Γ.start) := by + rfl + have hprobeNe : + (outputProbeTM tm).qstart ≠ (outputProbeTM tm).qhalt := by + intro h + cases h + rw [show (outputProbeStartedCfg tm input + (outputProbeCounterTape value)).state = + (outputProbeStartedTM tm).qstart from rfl] + rw [startedTM_qstart_eq_startedState (outputProbeTM tm) hprobeNe] + simp only [outputProbeSourceResultCfg] + rw [hdir] + dsimp only [CursorCfg.ofCfg] + rw [hsourceState, hsourceOutput] + simp [startedState, outputProbeTM, outputProbeAfterSourceTransition, + outputProbeSourceAction, OutputCursor.read, OutputCursor.next, + Tape.outputCursor, hstartHeads, hstartOutputDir, hne, Tape.init] + · rw [show (outputProbeSourceResultCfg tm + (.ofCfg (tm.initCfg input)) (.ofCfg sourceStarted) + (outputProbeCounterTape value) + (suppressOutputTapeStep (Tape.init []))).input = + sourceStarted.input from rfl] + exact startedCfg_input_eq tm input hne + · funext i + by_cases hi : i.val < n + · rw [show (outputProbeSourceResultCfg tm + (.ofCfg (tm.initCfg input)) (.ofCfg sourceStarted) + (outputProbeCounterTape value) + (suppressOutputTapeStep (Tape.init []))).work i = + sourceStarted.work ⟨i.val, hi⟩ by + simp [outputProbeSourceResultCfg, CursorCfg.ofCfg, hi]] + rw [startedCfg_work_eq_init_move_right tm input hne] + simp [outputProbeStartedCfg, hi] + · simp [outputProbeSourceResultCfg, outputProbeStartedCfg, hi] + · change suppressOutputTapeStep (Tape.init []) = + (Tape.init []).move Dir3.right + simpa [suppressOutputTapeTrace] using suppressOutputTapeTrace_succ_init 0 + +private theorem outputProbeCfg_withinAuxSpace_internal (tm : TM n) + {cfg : CursorCfg n tm.Q} {counter output : Tape} + {inputLength sourceSpace : ℕ} + (hwork : ∀ i, (cfg.work i).head ≤ sourceSpace) + (hinput : cfg.input.head ≤ inputLength + sourceSpace + 1) + (hcounter : counter.head ≤ sourceSpace) : + (outputProbeCfg tm cfg counter output).WithinAuxSpace + inputLength sourceSpace := by + constructor + · intro i + by_cases hi : i.val < n + · simpa [outputProbeCfg, hi] using hwork ⟨i.val, hi⟩ + · simpa [outputProbeCfg, hi] using hcounter + · simpa [outputProbeCfg] using hinput + +/-- Simulate an entire observed cursor run while retaining `remaining` +uncrossed output cells in the countdown. The starting counter represents the +sum of `remaining` and all right moves in the source run; the final counter is +canonical `remaining`. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_internal (tm : TM n) + {steps advances remaining : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat (remaining + advances)) + (houtput : output.StartInvariant) : + ∃ probeSteps, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) + (outputProbeCfg tm after (outputProbeCounterTape remaining) + (suppressOutputTapeTrace steps output)) := by + induction steps generalizing before counter output advances with + | zero => + simp only [cursorTraceObserved, Option.some.injEq, + Prod.mk.injEq] at htrace + obtain ⟨rfl, rfl⟩ := htrace + refine ⟨0, ?_⟩ + have hcounterEq := hcounter.eq_init_move_right + simpa [outputProbeCounterTape, hcounterEq] using + (TM.reachesIn.zero : + (outputProbeTM tm).reachesIn 0 + (outputProbeCfg tm before counter output) + (outputProbeCfg tm before counter output)) + | succ steps ih => + cases hfirst : tm.cursorStep before with + | none => + simp [cursorTraceObserved, cursorStepObserved, hfirst] at htrace + | some next => + cases hlater : tm.cursorTraceObserved steps next with + | none => + simp [cursorTraceObserved, cursorStepObserved, hfirst, + hlater] at htrace + | some result => + obtain ⟨final, later⟩ := result + simp [cursorTraceObserved, cursorStepObserved, hfirst, + hlater] at htrace + obtain ⟨hfinal, hadvances⟩ := htrace + subst after + subst advances + obtain ⟨hnextInput, hnextWork⟩ := + cursorStep_startInvariant_internal tm hfirst hinput hwork + have hnextOutputInv := + suppressOutputTapeStep_startInvariant_internal houtput + have hnextOutputRead := + suppressOutputTapeStep_read_ne_start_internal houtput + by_cases hdir : + tm.cursorOutputDirection before = Dir3.right + · have hadvance : + (tm.cursorOutputEvent before).advance = 1 := by + cases hdirection : tm.cursorOutputDirection before <;> + simp_all [cursorOutputEvent, OutputCursor.advanceCount] + have hcounterPositive : counter.HasBinaryNat + ((remaining + later) + 1) := by + convert hcounter using 1 + simp [hadvance] + omega + have hsource := + outputProbeTM_reachesIn_source_positive_internal tm + counter output hfirst hdir hcounterPositive hnextInput + hnextWork hnextOutputRead + obtain ⟨laterSteps, hlaterRun⟩ := ih + (outputProbeCounterTape (remaining + later)) + (suppressOutputTapeStep output) hlater hnextInput hnextWork + (outputProbeCounterTape_hasBinaryNat_internal + (remaining + later)) hnextOutputInv + refine ⟨(binaryPredTime (remaining + later) + 3) + + laterSteps, ?_⟩ + simpa [suppressOutputTapeTrace] using + (outputProbeTM tm).reachesIn_trans hsource hlaterRun + · have hadvance : + (tm.cursorOutputEvent before).advance = 0 := by + cases hdirection : tm.cursorOutputDirection before <;> + simp_all [cursorOutputEvent, OutputCursor.advanceCount] + have hcounterSame : + counter.HasBinaryNat (remaining + later) := by + simpa [hadvance] using hcounter + have hcounterRead : counter.read ≠ Γ.start := by + rw [Tape.read, hcounterSame.2.1] + exact Tape.cells_ne_start_of_hasBinaryString + hcounterSame.2 1 le_rfl + have hsource := + outputProbeTM_reachesIn_source_not_right_internal tm + counter output hfirst hdir hcounterRead + obtain ⟨laterSteps, hlaterRun⟩ := ih counter + (suppressOutputTapeStep output) hlater hnextInput hnextWork + hcounterSame hnextOutputInv + refine ⟨1 + laterSteps, ?_⟩ + simpa [suppressOutputTapeTrace] using + (outputProbeTM tm).reachesIn_trans hsource hlaterRun + +/-- Replay an observed run with a uniform all-prefix auxiliary-space bound. +The abstract predicate `Inv` packages any source-machine invariant that is +preserved by cursor steps and bounds the source input/work heads. The extra +probe tape then costs only the binary width of `maxCounter`. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace_internal + (tm : TM n) (Inv : CursorCfg n tm.Q → Prop) + {steps advances remaining maxCounter inputLength sourceSpace : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinv : Inv before) + (hinvStep : ∀ {cfg next}, Inv cfg → + tm.cursorStep cfg = some next → Inv next) + (hinvSpace : ∀ cfg, Inv cfg → + (∀ i, (cfg.work i).head ≤ sourceSpace) ∧ + cfg.input.head ≤ inputLength + sourceSpace + 1) + (hsourceSpace : 1 ≤ sourceSpace) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat (remaining + advances)) + (houtput : output.StartInvariant) + (hmax : remaining + advances ≤ maxCounter) : + ∃ probeSteps, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) + (outputProbeCfg tm after (outputProbeCounterTape remaining) + (suppressOutputTapeTrace steps output)) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg → + cfg.WithinAuxSpace inputLength + (outputProbeReplaySpace sourceSpace maxCounter) := by + induction steps generalizing before counter output advances with + | zero => + simp only [cursorTraceObserved, Option.some.injEq, + Prod.mk.injEq] at htrace + obtain ⟨rfl, rfl⟩ := htrace + have hcounterHead : counter.head ≤ sourceSpace := by + rw [hcounter.2.1] + exact hsourceSpace + have hinitial := outputProbeCfg_withinAuxSpace_internal + (output := output) tm + (hinvSpace before hinv).1 (hinvSpace before hinv).2 hcounterHead + refine ⟨0, ?_, ?_⟩ + · have hcounterEq := hcounter.eq_init_move_right + simpa [outputProbeCounterTape, hcounterEq] using + (TM.reachesIn.zero : + (outputProbeTM tm).reachesIn 0 + (outputProbeCfg tm before counter output) + (outputProbeCfg tm before counter output)) + · intro elapsed cfg helapsed hreach + have helapsedZero : elapsed = 0 := by omega + subst elapsed + have hcfg : cfg = outputProbeCfg tm before counter output := + (outputProbeTM tm).reachesIn_right_unique hreach .zero + subst cfg + exact hinitial.mono le_rfl (by + simp [outputProbeReplaySpace, outputProbePositiveSpace, + binaryPredSpace] + omega) + | succ steps ih => + cases hfirst : tm.cursorStep before with + | none => + simp [cursorTraceObserved, cursorStepObserved, hfirst] at htrace + | some next => + cases hlater : tm.cursorTraceObserved steps next with + | none => + simp [cursorTraceObserved, cursorStepObserved, hfirst, + hlater] at htrace + | some result => + obtain ⟨final, later⟩ := result + simp [cursorTraceObserved, cursorStepObserved, hfirst, + hlater] at htrace + obtain ⟨hfinal, hadvances⟩ := htrace + subst after + subst advances + have hnextInv := hinvStep hinv hfirst + obtain ⟨hnextInput, hnextWork⟩ := + cursorStep_startInvariant_internal tm hfirst hinput hwork + have hnextOutputInv := + suppressOutputTapeStep_startInvariant_internal houtput + have hnextOutputRead := + suppressOutputTapeStep_read_ne_start_internal houtput + have hcounterHead : counter.head ≤ sourceSpace := by + rw [hcounter.2.1] + exact hsourceSpace + have hinitial := outputProbeCfg_withinAuxSpace_internal + (output := output) tm + (hinvSpace before hinv).1 (hinvSpace before hinv).2 + hcounterHead + by_cases hdir : + tm.cursorOutputDirection before = Dir3.right + · have hadvance : + (tm.cursorOutputEvent before).advance = 1 := by + cases hdirection : tm.cursorOutputDirection before <;> + simp_all [cursorOutputEvent, OutputCursor.advanceCount] + have hcounterPositive : counter.HasBinaryNat + ((remaining + later) + 1) := by + convert hcounter using 1 + simp [hadvance] + omega + have hvalueMax : remaining + later ≤ maxCounter := by + simp [hadvance] at hmax + omega + have hsource := + outputProbeTM_reachesIn_source_positive_internal tm + counter output hfirst hdir hcounterPositive hnextInput + hnextWork hnextOutputRead + obtain ⟨laterSteps, hlaterRun, hlaterSpace⟩ := ih + (outputProbeCounterTape (remaining + later)) + (suppressOutputTapeStep output) hlater hnextInv + hnextInput hnextWork + (outputProbeCounterTape_hasBinaryNat_internal + (remaining + later)) hnextOutputInv hvalueMax + let firstSteps := binaryPredTime (remaining + later) + 3 + refine ⟨firstSteps + laterSteps, ?_, ?_⟩ + · simpa [firstSteps, suppressOutputTapeTrace] using + (outputProbeTM tm).reachesIn_trans hsource hlaterRun + · intro elapsed cfg helapsed hreach + by_cases hwithinFirst : elapsed ≤ firstSteps + · have hlocal := + outputProbeTM_source_positive_prefix_withinAuxSpace_internal + tm counter output hinitial (by + simpa [firstSteps] using hwithinFirst) hreach + apply hlocal.mono le_rfl + have hsize := Nat.size_le_size + (Nat.add_le_add_right hvalueMax 1) + simp only [outputProbeReplaySpace, + outputProbePositiveSpace, binaryPredSpace] + omega + · have hfirstLe : firstSteps ≤ elapsed := by omega + let tailSteps := elapsed - firstSteps + have htime : firstSteps + tailSteps = elapsed := by + dsimp only [tailSteps] + omega + rw [← htime] at hreach + obtain ⟨middle, hprefix, htail⟩ := + reachesIn_split_internal hreach + have hmiddle : middle = + outputProbeCfg tm next + (outputProbeCounterTape (remaining + later)) + (suppressOutputTapeStep output) := + (outputProbeTM tm).reachesIn_right_unique hprefix + (by simpa [firstSteps] using hsource) + subst middle + apply hlaterSpace tailSteps cfg + · dsimp only [tailSteps] + omega + · exact htail + + · have hadvance : + (tm.cursorOutputEvent before).advance = 0 := by + cases hdirection : tm.cursorOutputDirection before <;> + simp_all [cursorOutputEvent, OutputCursor.advanceCount] + have hcounterSame : + counter.HasBinaryNat (remaining + later) := by + simpa [hadvance] using hcounter + have hcounterRead : counter.read ≠ Γ.start := by + rw [Tape.read, hcounterSame.2.1] + exact Tape.cells_ne_start_of_hasBinaryString + hcounterSame.2 1 le_rfl + have hlaterMax : remaining + later ≤ maxCounter := by + simpa [hadvance] using hmax + have hsource := + outputProbeTM_reachesIn_source_not_right_internal tm + counter output hfirst hdir hcounterRead + obtain ⟨laterSteps, hlaterRun, hlaterSpace⟩ := ih counter + (suppressOutputTapeStep output) hlater hnextInv + hnextInput hnextWork hcounterSame + hnextOutputInv hlaterMax + refine ⟨1 + laterSteps, ?_, ?_⟩ + · simpa [suppressOutputTapeTrace] using + (outputProbeTM tm).reachesIn_trans hsource hlaterRun + · intro elapsed cfg helapsed hreach + by_cases hwithinFirst : elapsed ≤ 1 + · have hlocal := hinitial.reachesIn hreach + apply hlocal.mono le_rfl + simp [outputProbeReplaySpace, + outputProbePositiveSpace, binaryPredSpace] + omega + · have honeLe : 1 ≤ elapsed := by omega + let tailSteps := elapsed - 1 + have htime : 1 + tailSteps = elapsed := by + dsimp only [tailSteps] + omega + rw [← htime] at hreach + obtain ⟨middle, hprefix, htail⟩ := + reachesIn_split_internal hreach + have hmiddle : middle = + outputProbeCfg tm next counter + (suppressOutputTapeStep output) := + (outputProbeTM tm).reachesIn_right_unique hprefix hsource + subst middle + apply hlaterSpace tailSteps cfg + · dsimp only [tailSteps] + omega + · exact htail + +/-- Two post-replay capture transitions enlarge an all-prefix replay-space +bound by at most two cells. -/ +private theorem outputProbeTM_captureTail_prefix_withinAuxSpace_internal + (tm : TM n) {sourceSteps elapsed inputLength space : ℕ} + {start middle done cfg : Cfg (n + 1) (outputProbeTM tm).Q} + (hsource : (outputProbeTM tm).reachesIn sourceSteps start middle) + (hsourceSpace : ∀ t c, t ≤ sourceSteps → + (outputProbeTM tm).reachesIn t start c → + c.WithinAuxSpace inputLength space) + (_htail : (outputProbeTM tm).reachesIn 2 middle done) + (helapsed : elapsed ≤ sourceSteps + 2) + (hreach : (outputProbeTM tm).reachesIn elapsed start cfg) : + cfg.WithinAuxSpace inputLength (space + 2) := by + by_cases hbefore : elapsed ≤ sourceSteps + · exact (hsourceSpace elapsed cfg hbefore hreach).mono le_rfl (by omega) + · have hsourceLe : sourceSteps ≤ elapsed := by omega + let tailSteps := elapsed - sourceSteps + have helapsedEq : sourceSteps + tailSteps = elapsed := by + dsimp only [tailSteps] + omega + rw [← helapsedEq] at hreach + obtain ⟨replayEnd, hreplay, htailPrefix⟩ := + reachesIn_split_internal hreach + have hreplayEnd : replayEnd = middle := + (outputProbeTM tm).reachesIn_right_unique hreplay hsource + subst replayEnd + have hmiddle := hsourceSpace sourceSteps middle le_rfl hsource + have htailSteps : tailSteps ≤ 2 := by + dsimp only [tailSteps] + omega + have htailWithin := hmiddle.reachesIn htailPrefix + exact htailWithin.mono le_rfl (Nat.add_le_add_left htailSteps space) + +theorem outputProbeTM_step_halt_capture_internal (tm : TM n) + (cfg : CursorCfg n tm.Q) (counter output : Tape) (bit : Bool) + (hhalt : cfg.state = tm.qhalt) + (hcursor : cfg.output = .cell (Γ.ofBool bit)) + (hcounter : counter.HasBinaryNat 0) : + (outputProbeTM tm).step (outputProbeCfg tm cfg counter output) = + some (outputProbeCaptureCfg tm bit + (outputProbeNormalizeInput cfg.input) + (outputProbeNormalizeWork fun i => + if h : i.val < n then cfg.work ⟨i.val, h⟩ else counter) + (outputProbeNormalizeTape output)) := by + have hblank : counter.read = Γ.blank := + hcounter.read_eq_blank_iff.mpr rfl + cases bit <;> + simp [TM.step, outputProbeTM, outputProbeCfg, outputProbeCaptureCfg, + outputProbeCaptureCursor, outputProbeNormalizeInput, + outputProbeNormalizeTape, allReadBack, outputProbeCounterIdx, + Γ.ofBool, hhalt, hcursor, hblank] <;> + funext i <;> rfl + +theorem outputProbeTM_step_halt_missing_zero_internal (tm : TM n) + (cfg : CursorCfg n tm.Q) (counter output : Tape) + (hhalt : cfg.state = tm.qhalt) + (hcursor : (outputProbeCaptureCursor cfg.output : + OutputProbeQ n tm.Q) = .missing) + (hcounter : counter.HasBinaryNat 0) : + (outputProbeTM tm).step (outputProbeCfg tm cfg counter output) = + some (outputProbeMissingCfg tm + (outputProbeNormalizeInput cfg.input) + (outputProbeNormalizeWork fun i => + if h : i.val < n then cfg.work ⟨i.val, h⟩ else counter) + (outputProbeNormalizeTape output)) := by + have hblank : counter.read = Γ.blank := + hcounter.read_eq_blank_iff.mpr rfl + simp [TM.step, outputProbeTM, outputProbeCfg, outputProbeMissingCfg, + outputProbeNormalizeInput, outputProbeNormalizeTape, allReadBack, + outputProbeCounterIdx, hhalt, hcursor, hblank] + funext i + rfl + +theorem outputProbeTM_step_halt_missing_positive_internal (tm : TM n) + (cfg : CursorCfg n tm.Q) (counter output : Tape) (remaining : ℕ) + (hhalt : cfg.state = tm.qhalt) + (hcounter : counter.HasBinaryNat (remaining + 1)) : + (outputProbeTM tm).step (outputProbeCfg tm cfg counter output) = + some (outputProbeMissingCfg tm + (outputProbeNormalizeInput cfg.input) + (outputProbeNormalizeWork fun i => + if h : i.val < n then cfg.work ⟨i.val, h⟩ else counter) + (outputProbeNormalizeTape output)) := by + have hnotblank : counter.read ≠ Γ.blank := by + intro hblank + have hzero := hcounter.read_eq_blank_iff.mp hblank + omega + simp [TM.step, outputProbeTM, outputProbeCfg, outputProbeMissingCfg, + outputProbeNormalizeInput, + outputProbeNormalizeTape, allReadBack, outputProbeCounterIdx, hhalt, + hnotblank] + funext i + rfl + +theorem outputProbeTM_step_missing_internal (tm : TM n) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) + (houtput : output.read ≠ Γ.start) : + (outputProbeTM tm).step + (outputProbeMissingCfg tm input work output) = + some (outputProbeMissingDoneCfg tm input work output) := by + simp [TM.step, outputProbeTM, outputProbeMissingCfg, + outputProbeMissingDoneCfg, houtput] + +theorem outputProbeMissingDone_hasOutput_internal (tm : TM n) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) + (hhead : output.head = 1) + (hcells : output.cells = (Tape.init []).cells) : + (outputProbeMissingDoneCfg tm input work output).output.HasOutput + [false] := by + simp [outputProbeMissingDoneCfg, Tape.HasOutput, Tape.writeAndMove, + Tape.write, Tape.move, hhead, hcells, Tape.init, + Function.update_apply, Γ.ofBool] + +theorem outputProbeMissingDone_head_internal (tm : TM n) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) + (hhead : output.head = 1) : + (outputProbeMissingDoneCfg tm input work output).output.head = 2 := by + simp [outputProbeMissingDoneCfg, Tape.writeAndMove, Tape.move, + Tape.write_head, hhead] + +/-- End-to-end termination when the source halts before the requested output +position. The positive residual countdown is preserved by the two terminal +read-back transitions. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_missing_positive_internal + (tm : TM n) {steps advances remaining : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat ((remaining + 1) + advances)) + (houtput : output.StartInvariant) + (hhalt : after.state = tm.qhalt) + (hmissingHead : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps output)).head = 1) + (hmissingCells : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps output)).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [false] := by + obtain ⟨sourceSteps, hsourceRun⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_internal + (remaining := remaining + 1) tm counter output htrace hinput hwork + (by simpa [Nat.add_assoc] using hcounter) houtput + let finalOutput := suppressOutputTapeTrace steps output + let framedWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ + else outputProbeCounterTape (remaining + 1) + let missingInput := outputProbeNormalizeInput after.input + let missingWork := outputProbeNormalizeWork framedWork + let missingOutput := outputProbeNormalizeTape finalOutput + let done := outputProbeMissingDoneCfg tm missingInput missingWork + missingOutput + have hhaltStep := outputProbeTM_step_halt_missing_positive_internal tm + after (outputProbeCounterTape (remaining + 1)) finalOutput remaining + hhalt (outputProbeCounterTape_hasBinaryNat_internal (remaining + 1)) + have hhaltStep' : + (outputProbeTM tm).step + (outputProbeCfg tm after (outputProbeCounterTape (remaining + 1)) + finalOutput) = + some (outputProbeMissingCfg tm missingInput missingWork + missingOutput) := by + simpa [missingInput, missingWork, missingOutput, framedWork] using + hhaltStep + have hmissingRead : missingOutput.read ≠ Γ.start := by + exact outputProbeNormalizeTape_read_ne_start_internal + (suppressOutputTapeTrace_startInvariant_probe_internal steps houtput) + have hmissingStep := outputProbeTM_step_missing_internal tm missingInput + missingWork missingOutput hmissingRead + have htail : (outputProbeTM tm).reachesIn 2 + (outputProbeCfg tm after (outputProbeCounterTape (remaining + 1)) + finalOutput) done := by + simpa [done] using TM.reachesIn.step hhaltStep' + (TM.reachesIn.step hmissingStep .zero) + refine ⟨sourceSteps + 2, done, ?_, rfl, ?_⟩ + · exact (outputProbeTM tm).reachesIn_trans hsourceRun htail + · exact outputProbeMissingDone_hasOutput_internal tm missingInput + missingWork missingOutput hmissingHead hmissingCells + +/-- The absent-position path retains the replay bound plus the two terminal +read-back transitions. -/ +theorem + outputProbeTM_reachesIn_cursorTraceObserved_missing_positive_withinAuxSpace_internal + (tm : TM n) (Inv : CursorCfg n tm.Q → Prop) (sourceSpace : ℕ) + {steps advances remaining maxCounter inputLength : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinv : Inv before) + (hinvStep : ∀ {cfg next}, Inv cfg → + tm.cursorStep cfg = some next → Inv next) + (hinvSpace : ∀ cfg, Inv cfg → + (∀ i, (cfg.work i).head ≤ sourceSpace) ∧ + cfg.input.head ≤ inputLength + sourceSpace + 1) + (hsourceSpace : 1 ≤ sourceSpace) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat ((remaining + 1) + advances)) + (houtput : output.StartInvariant) + (hmax : (remaining + 1) + advances ≤ maxCounter) + (hhalt : after.state = tm.qhalt) + (hmissingHead : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps output)).head = 1) + (hmissingCells : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps output)).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [false] ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg → + cfg.WithinAuxSpace inputLength + (outputProbeCaptureSpace sourceSpace maxCounter) := by + obtain ⟨sourceSteps, hsourceRun, hsourcePrefix⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace_internal + (remaining := remaining + 1) tm Inv counter output htrace hinv + hinvStep hinvSpace hsourceSpace hinput hwork + (by simpa [Nat.add_assoc] using hcounter) houtput hmax + let finalOutput := suppressOutputTapeTrace steps output + let framedWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ + else outputProbeCounterTape (remaining + 1) + let missingInput := outputProbeNormalizeInput after.input + let missingWork := outputProbeNormalizeWork framedWork + let missingOutput := outputProbeNormalizeTape finalOutput + let done := outputProbeMissingDoneCfg tm missingInput missingWork + missingOutput + have hhaltStep := outputProbeTM_step_halt_missing_positive_internal tm + after (outputProbeCounterTape (remaining + 1)) finalOutput remaining + hhalt (outputProbeCounterTape_hasBinaryNat_internal (remaining + 1)) + have hhaltStep' : + (outputProbeTM tm).step + (outputProbeCfg tm after (outputProbeCounterTape (remaining + 1)) + finalOutput) = + some (outputProbeMissingCfg tm missingInput missingWork + missingOutput) := by + simpa [missingInput, missingWork, missingOutput, framedWork] using + hhaltStep + have hmissingRead : missingOutput.read ≠ Γ.start := by + exact outputProbeNormalizeTape_read_ne_start_internal + (suppressOutputTapeTrace_startInvariant_probe_internal steps houtput) + have hmissingStep := outputProbeTM_step_missing_internal tm missingInput + missingWork missingOutput hmissingRead + have htail : (outputProbeTM tm).reachesIn 2 + (outputProbeCfg tm after (outputProbeCounterTape (remaining + 1)) + finalOutput) done := by + simpa [done] using TM.reachesIn.step hhaltStep' + (TM.reachesIn.step hmissingStep .zero) + have hrun := (outputProbeTM tm).reachesIn_trans hsourceRun htail + refine ⟨sourceSteps + 2, done, hrun, rfl, ?_, ?_, ?_⟩ + · exact outputProbeMissingDone_hasOutput_internal tm missingInput + missingWork missingOutput hmissingHead hmissingCells + · exact outputProbeMissingDone_head_internal tm missingInput missingWork + missingOutput hmissingHead + · intro elapsed cfg helapsed hprefix + have hbound := outputProbeTM_captureTail_prefix_withinAuxSpace_internal + tm hsourceRun hsourcePrefix htail helapsed hprefix + simpa [outputProbeCaptureSpace] using hbound + +/-- End-to-end termination when a zero countdown selects a non-Boolean source +frontier cell at halt. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_missing_zero_internal + (tm : TM n) {steps advances : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hhalt : after.state = tm.qhalt) + (hcursor : (outputProbeCaptureCursor after.output : + OutputProbeQ n tm.Q) = .missing) + (hmissingHead : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps output)).head = 1) + (hmissingCells : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps output)).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [false] := by + obtain ⟨sourceSteps, hsourceRun⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_internal + (remaining := 0) tm counter output htrace hinput hwork + (by simpa using hcounter) houtput + let finalOutput := suppressOutputTapeTrace steps output + let framedWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ + else outputProbeCounterTape 0 + let missingInput := outputProbeNormalizeInput after.input + let missingWork := outputProbeNormalizeWork framedWork + let missingOutput := outputProbeNormalizeTape finalOutput + let done := outputProbeMissingDoneCfg tm missingInput missingWork + missingOutput + have hhaltStep := outputProbeTM_step_halt_missing_zero_internal tm after + (outputProbeCounterTape 0) finalOutput hhalt hcursor + (outputProbeCounterTape_hasBinaryNat_internal 0) + have hhaltStep' : + (outputProbeTM tm).step + (outputProbeCfg tm after (outputProbeCounterTape 0) finalOutput) = + some (outputProbeMissingCfg tm missingInput missingWork + missingOutput) := by + simpa [missingInput, missingWork, missingOutput, framedWork] using + hhaltStep + have hmissingRead : missingOutput.read ≠ Γ.start := by + exact outputProbeNormalizeTape_read_ne_start_internal + (suppressOutputTapeTrace_startInvariant_probe_internal steps houtput) + have hmissingStep := outputProbeTM_step_missing_internal tm missingInput + missingWork missingOutput hmissingRead + have htail : (outputProbeTM tm).reachesIn 2 + (outputProbeCfg tm after (outputProbeCounterTape 0) finalOutput) + done := by + simpa [done] using TM.reachesIn.step hhaltStep' + (TM.reachesIn.step hmissingStep .zero) + refine ⟨sourceSteps + 2, done, ?_, rfl, ?_⟩ + · exact (outputProbeTM tm).reachesIn_trans hsourceRun htail + · exact outputProbeMissingDone_hasOutput_internal tm missingInput + missingWork missingOutput hmissingHead hmissingCells + +/-- The halted non-Boolean frontier path uses the same replay-plus-two space +budget as successful capture. -/ +theorem + outputProbeTM_reachesIn_cursorTraceObserved_missing_zero_withinAuxSpace_internal + (tm : TM n) (Inv : CursorCfg n tm.Q → Prop) (sourceSpace : ℕ) + {steps advances maxCounter inputLength : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinv : Inv before) + (hinvStep : ∀ {cfg next}, Inv cfg → + tm.cursorStep cfg = some next → Inv next) + (hinvSpace : ∀ cfg, Inv cfg → + (∀ i, (cfg.work i).head ≤ sourceSpace) ∧ + cfg.input.head ≤ inputLength + sourceSpace + 1) + (hsourceSpace : 1 ≤ sourceSpace) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hmax : advances ≤ maxCounter) + (hhalt : after.state = tm.qhalt) + (hcursor : (outputProbeCaptureCursor after.output : + OutputProbeQ n tm.Q) = .missing) + (hmissingHead : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps output)).head = 1) + (hmissingCells : + (outputProbeNormalizeTape + (suppressOutputTapeTrace steps output)).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [false] ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg → + cfg.WithinAuxSpace inputLength + (outputProbeCaptureSpace sourceSpace maxCounter) := by + obtain ⟨sourceSteps, hsourceRun, hsourcePrefix⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace_internal + (remaining := 0) tm Inv counter output htrace hinv hinvStep + hinvSpace hsourceSpace hinput hwork (by simpa using hcounter) + houtput (by simpa using hmax) + let finalOutput := suppressOutputTapeTrace steps output + let framedWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ + else outputProbeCounterTape 0 + let missingInput := outputProbeNormalizeInput after.input + let missingWork := outputProbeNormalizeWork framedWork + let missingOutput := outputProbeNormalizeTape finalOutput + let done := outputProbeMissingDoneCfg tm missingInput missingWork + missingOutput + have hhaltStep := outputProbeTM_step_halt_missing_zero_internal tm after + (outputProbeCounterTape 0) finalOutput hhalt hcursor + (outputProbeCounterTape_hasBinaryNat_internal 0) + have hhaltStep' : + (outputProbeTM tm).step + (outputProbeCfg tm after (outputProbeCounterTape 0) finalOutput) = + some (outputProbeMissingCfg tm missingInput missingWork + missingOutput) := by + simpa [missingInput, missingWork, missingOutput, framedWork] using + hhaltStep + have hmissingRead : missingOutput.read ≠ Γ.start := by + exact outputProbeNormalizeTape_read_ne_start_internal + (suppressOutputTapeTrace_startInvariant_probe_internal steps houtput) + have hmissingStep := outputProbeTM_step_missing_internal tm missingInput + missingWork missingOutput hmissingRead + have htail : (outputProbeTM tm).reachesIn 2 + (outputProbeCfg tm after (outputProbeCounterTape 0) finalOutput) + done := by + simpa [done] using TM.reachesIn.step hhaltStep' + (TM.reachesIn.step hmissingStep .zero) + have hrun := (outputProbeTM tm).reachesIn_trans hsourceRun htail + refine ⟨sourceSteps + 2, done, hrun, rfl, ?_, ?_, ?_⟩ + · exact outputProbeMissingDone_hasOutput_internal tm missingInput + missingWork missingOutput hmissingHead hmissingCells + · exact outputProbeMissingDone_head_internal tm missingInput missingWork + missingOutput hmissingHead + · intro elapsed cfg helapsed hprefix + have hbound := outputProbeTM_captureTail_prefix_withinAuxSpace_internal + tm hsourceRun hsourcePrefix htail helapsed hprefix + simpa [outputProbeCaptureSpace] using hbound + +/-- The compulsory probe transition reaches the canonical restartable frame +even when the source machine is already halted at its start state. -/ +theorem IsTransducer.outputProbeTM_step_startedCfg_total_internal + {tm : TM n} (htrans : tm.IsTransducer) (input : List Bool) + (value : ℕ) : + (outputProbeTM tm).step + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape value) (Tape.init [])) = + some (outputProbeStartedCfg tm input + (outputProbeCounterTape value)) := by + by_cases hne : tm.qstart ≠ tm.qhalt + · exact htrans.outputProbeTM_step_startedCfg_internal input value hne + · have hstart : tm.qstart = tm.qhalt := not_ne_iff.mp hne + have hcounter := outputProbeCounterTape_hasBinaryNat_internal value + have hcounterRead : (outputProbeCounterTape value).read ≠ Γ.start := by + rw [Tape.read, hcounter.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hcounter.2 1 le_rfl + have hprobeNe : + (outputProbeTM tm).qstart ≠ (outputProbeTM tm).qhalt := by + intro h + cases h + have hhalt : (CursorCfg.ofCfg (tm.initCfg input)).state = tm.qhalt := by + simpa [CursorCfg.ofCfg, Cfg.init] using hstart + have hstartedState : + (outputProbeStartedCfg tm input + (outputProbeCounterTape value)).state = .missing := by + rw [show (outputProbeStartedCfg tm input + (outputProbeCounterTape value)).state = + (outputProbeStartedTM tm).qstart from rfl] + rw [startedTM_qstart_eq_startedState (outputProbeTM tm) hprobeNe] + simp [startedState, outputProbeTM, hstart, allReadBack] + have hcounterNormalized : + outputProbeNormalizeTape (outputProbeCounterTape value) = + outputProbeCounterTape value := + outputProbeNormalizeTape_eq_self_internal hcounterRead + have hnormalizeNil : outputProbeNormalizeTape (Tape.init []) = + (Tape.init []).move Dir3.right := by + rfl + have hframe : + outputProbeMissingCfg tm + (outputProbeNormalizeInput + (CursorCfg.ofCfg (tm.initCfg input)).input) + (outputProbeNormalizeWork fun i => + if h : i.val < n then + (CursorCfg.ofCfg (tm.initCfg input)).work ⟨i.val, h⟩ + else outputProbeCounterTape value) + (outputProbeNormalizeTape (Tape.init [])) = + outputProbeStartedCfg tm input + (outputProbeCounterTape value) := by + apply Cfg.ext + · exact hstartedState.symm + · rfl + · funext i + by_cases hi : i.val < n + · simp only [outputProbeMissingCfg, outputProbeNormalizeWork, + outputProbeStartedCfg, hi, ↓reduceDIte] + change outputProbeNormalizeTape (Tape.init []) = + (Tape.init []).move Dir3.right + exact hnormalizeNil + · simp only [outputProbeMissingCfg, outputProbeNormalizeWork, + outputProbeStartedCfg, hi, ↓reduceDIte] + change outputProbeNormalizeTape (outputProbeCounterTape value) = + outputProbeCounterTape value + exact hcounterNormalized + · rfl + cases value with + | zero => + have hstep := outputProbeTM_step_halt_missing_zero_internal tm + (.ofCfg (tm.initCfg input)) (outputProbeCounterTape 0) + (Tape.init []) hhalt rfl + (outputProbeCounterTape_hasBinaryNat_internal 0) + rw [hframe] at hstep + exact hstep + | succ value => + have hstep := outputProbeTM_step_halt_missing_positive_internal tm + (.ofCfg (tm.initCfg input)) (outputProbeCounterTape (value + 1)) + (Tape.init []) value hhalt + (outputProbeCounterTape_hasBinaryNat_internal (value + 1)) + rw [hframe] at hstep + exact hstep + +theorem outputProbeTM_step_capture_internal (tm : TM n) (bit : Bool) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) + (houtput : output.read ≠ Γ.start) : + (outputProbeTM tm).step + (outputProbeCaptureCfg tm bit input work output) = + some (outputProbeDoneCfg tm bit input work output) := by + cases bit <;> + simp [TM.step, outputProbeTM, outputProbeCaptureCfg, + outputProbeDoneCfg, houtput] + +theorem outputProbeTM_capture_hasOutput_internal (tm : TM n) (bit : Bool) + (input : Tape) (work : Fin (n + 1) → Tape) (output : Tape) + (hhead : output.head = 1) + (hcells : output.cells = (Tape.init []).cells) : + (outputProbeTM tm).reachesIn 1 + (outputProbeCaptureCfg tm bit input work output) + (outputProbeDoneCfg tm bit input work output) ∧ + (outputProbeTM tm).halted + (outputProbeDoneCfg tm bit input work output) ∧ + (outputProbeDoneCfg tm bit input work output).output.HasOutput [bit] := by + have hread : output.read = Γ.blank := by + rw [Tape.read, hhead, hcells] + rfl + refine ⟨TM.reachesIn.step + (outputProbeTM_step_capture_internal tm bit input work output + (by rw [hread]; decide)) .zero, rfl, ?_⟩ + cases bit <;> + simp [outputProbeDoneCfg, Tape.HasOutput, Tape.writeAndMove, + Tape.write, Tape.move, hhead, hcells, Tape.init, + Function.update_apply, Γ.ofBool] + +/-- End-to-end capture when an observed source run halts on the selected +Boolean frontier cell. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_capture_internal + (tm : TM n) {steps advances : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) (bit : Bool) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hhalt : after.state = tm.qhalt) + (hcursor : after.output = .cell (Γ.ofBool bit)) + (hphysicalHead : (suppressOutputTapeTrace steps output).head = 1) + (hphysicalCells : (suppressOutputTapeTrace steps output).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ done.output.HasOutput [bit] := by + obtain ⟨sourceSteps, hsourceRun⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_internal + (remaining := 0) tm counter output htrace hinput hwork + (by simpa using hcounter) houtput + let finalOutput := suppressOutputTapeTrace steps output + let framedWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ + else outputProbeCounterTape 0 + let captureInput := outputProbeNormalizeInput after.input + let captureWork := outputProbeNormalizeWork framedWork + have hhaltStep := outputProbeTM_step_halt_capture_internal tm after + (outputProbeCounterTape 0) finalOutput bit hhalt hcursor + (outputProbeCounterTape_hasBinaryNat_internal 0) + have hfinalRead : finalOutput.read ≠ Γ.start := by + rw [Tape.read, hphysicalHead] + intro hstart + rw [hphysicalCells] at hstart + simp [Tape.init] at hstart + have hfinalNormalize : outputProbeNormalizeTape finalOutput = finalOutput := + outputProbeNormalizeTape_eq_self_internal hfinalRead + have hhaltStep' : + (outputProbeTM tm).step + (outputProbeCfg tm after (outputProbeCounterTape 0) finalOutput) = + some (outputProbeCaptureCfg tm bit captureInput captureWork + finalOutput) := by + simpa [captureInput, captureWork, framedWork, hfinalNormalize] using + hhaltStep + obtain ⟨hcaptureRun, hdoneHalt, hdoneOutput⟩ := + outputProbeTM_capture_hasOutput_internal tm bit captureInput captureWork + finalOutput hphysicalHead hphysicalCells + let done := outputProbeDoneCfg tm bit captureInput captureWork finalOutput + have htoCapture := + (outputProbeTM tm).reachesIn_snoc hsourceRun hhaltStep' + have hrun := (outputProbeTM tm).reachesIn_trans htoCapture hcaptureRun + refine ⟨sourceSteps + 2, done, ?_, ?_, ?_⟩ + · simpa [done, finalOutput, Nat.add_assoc] using hrun + · simpa [done] using hdoneHalt + · simpa [done] using hdoneOutput + +/-- Space-aware end-to-end capture when an observed source run halts on the +selected Boolean frontier cell. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_capture_withinAuxSpace_internal + (tm : TM n) (Inv : CursorCfg n tm.Q → Prop) (sourceSpace : ℕ) + {steps advances inputLength : ℕ} + {before after : CursorCfg n tm.Q} (counter output : Tape) (bit : Bool) + (htrace : tm.cursorTraceObserved steps before = some (after, advances)) + (hinv : Inv before) + (hinvStep : ∀ {cfg next}, Inv cfg → + tm.cursorStep cfg = some next → Inv next) + (hinvSpace : ∀ cfg, Inv cfg → + (∀ i, (cfg.work i).head ≤ sourceSpace) ∧ + cfg.input.head ≤ inputLength + sourceSpace + 1) + (hsourceSpace : 1 ≤ sourceSpace) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hhalt : after.state = tm.qhalt) + (hcursor : after.output = .cell (Γ.ofBool bit)) + (hphysicalHead : (suppressOutputTapeTrace steps output).head = 1) + (hphysicalCells : (suppressOutputTapeTrace steps output).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ done.output.HasOutput [bit] ∧ + done.work (Fin.last n) = outputProbeCounterTape 0 ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg → + cfg.WithinAuxSpace inputLength + (outputProbeCaptureSpace sourceSpace advances) := by + obtain ⟨sourceSteps, hsourceRun, hsourcePrefix⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace_internal + (remaining := 0) (maxCounter := advances) tm Inv counter output + htrace hinv hinvStep hinvSpace hsourceSpace hinput hwork + (by simpa using hcounter) houtput (by omega) + let finalOutput := suppressOutputTapeTrace steps output + let framedWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then after.work ⟨i.val, h⟩ + else outputProbeCounterTape 0 + let captureInput := outputProbeNormalizeInput after.input + let captureWork := outputProbeNormalizeWork framedWork + have hhaltStep := outputProbeTM_step_halt_capture_internal tm after + (outputProbeCounterTape 0) finalOutput bit hhalt hcursor + (outputProbeCounterTape_hasBinaryNat_internal 0) + have hfinalRead : finalOutput.read ≠ Γ.start := by + rw [Tape.read, hphysicalHead] + intro hstart + rw [hphysicalCells] at hstart + simp [Tape.init] at hstart + have hfinalNormalize : outputProbeNormalizeTape finalOutput = finalOutput := + outputProbeNormalizeTape_eq_self_internal hfinalRead + have hhaltStep' : + (outputProbeTM tm).step + (outputProbeCfg tm after (outputProbeCounterTape 0) finalOutput) = + some (outputProbeCaptureCfg tm bit captureInput captureWork + finalOutput) := by + simpa [captureInput, captureWork, framedWork, hfinalNormalize] using + hhaltStep + obtain ⟨hcaptureRun, hdoneHalt, hdoneOutput⟩ := + outputProbeTM_capture_hasOutput_internal tm bit captureInput captureWork + finalOutput hphysicalHead hphysicalCells + let done := outputProbeDoneCfg tm bit captureInput captureWork finalOutput + have htoCapture := + (outputProbeTM tm).reachesIn_snoc hsourceRun hhaltStep' + have hrun := (outputProbeTM tm).reachesIn_trans htoCapture hcaptureRun + have htail : (outputProbeTM tm).reachesIn 2 + (outputProbeCfg tm after (outputProbeCounterTape 0) finalOutput) + done := by + simpa [done, Nat.add_assoc] using + (TM.reachesIn.step hhaltStep' hcaptureRun) + refine ⟨sourceSteps + 2, done, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [done, finalOutput, Nat.add_assoc] using hrun + · simpa [done] using hdoneHalt + · simpa [done] using hdoneOutput + · have hzero := outputProbeCounterTape_hasBinaryNat_internal 0 + have hzeroRead : (outputProbeCounterTape 0).read ≠ Γ.start := by + rw [Tape.read, hzero.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hzero.2 1 le_rfl + have hstable : + (outputProbeNormalizeTape (outputProbeCounterTape 0)).writeAndMove + (readBackWrite + (outputProbeNormalizeTape (outputProbeCounterTape 0)).read) + (idleDir + (outputProbeNormalizeTape (outputProbeCounterTape 0)).read) = + outputProbeCounterTape 0 := by + rw [outputProbeNormalizeTape_eq_self_internal hzeroRead] + exact Tape.writeAndMove_readBack_idle_of_ne_start _ hzeroRead + simpa [done, outputProbeDoneCfg, captureWork, + outputProbeNormalizeWork, framedWork] using hstable + · have hfinalHead : finalOutput.head = 1 := by + simpa [finalOutput] using hphysicalHead + simp [done, outputProbeDoneCfg, Tape.writeAndMove, Tape.move, + Tape.write_head, hfinalHead] + · intro elapsed cfg helapsed hprefix + have hbound := outputProbeTM_captureTail_prefix_withinAuxSpace_internal + tm hsourceRun hsourcePrefix htail helapsed hprefix + simpa [outputProbeCaptureSpace] using hbound + +/-- End-to-end capture when the next source step finalizes the selected +Boolean cell by moving right. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture_internal + (tm : TM n) {steps advances : ℕ} + {before selected next : CursorCfg n tm.Q} + (counter output : Tape) (bit : Bool) (symbol : Γ) + (htrace : tm.cursorTraceObserved steps before = + some (selected, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hnext : tm.cursorStep selected = some next) + (hcursor : selected.output = .cell symbol) + (hdir : tm.cursorOutputDirection selected = Dir3.right) + (hwrite : tm.cursorOutputWrite selected = + if bit then Γw.one else Γw.zero) + (hphysicalHead : (suppressOutputTapeTrace steps output).head = 1) + (hphysicalCells : (suppressOutputTapeTrace steps output).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ done.output.HasOutput [bit] := by + obtain ⟨sourceSteps, hsourceRun⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_internal + (remaining := 0) tm counter output htrace hinput hwork + (by simpa using hcounter) houtput + let finalOutput := suppressOutputTapeTrace steps output + have hzero := outputProbeCounterTape_hasBinaryNat_internal 0 + have hzeroRead : (outputProbeCounterTape 0).read ≠ Γ.start := by + rw [Tape.read, hzero.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hzero.2 1 le_rfl + have hsourceStep := outputProbeTM_step_source_internal tm + (outputProbeCounterTape 0) finalOutput hzeroRead hnext + have hsourceCapture := outputProbeSourceResultCfg_capture_internal tm + selected next (outputProbeCounterTape 0) + (suppressOutputTapeStep finalOutput) bit symbol hcursor hdir hwrite hzero + have hfinalRead : finalOutput.read ≠ Γ.start := by + rw [Tape.read, hphysicalHead] + intro hstart + rw [hphysicalCells] at hstart + simp [Tape.init] at hstart + have hfinalStable : suppressOutputTapeStep finalOutput = finalOutput := by + simpa [suppressOutputTapeStep, outputProbeNormalizeTape] using + outputProbeNormalizeTape_eq_self_internal hfinalRead + rw [hsourceCapture, hfinalStable] at hsourceStep + let captureWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then next.work ⟨i.val, h⟩ + else outputProbeCounterTape 0 + obtain ⟨hcaptureRun, hdoneHalt, hdoneOutput⟩ := + outputProbeTM_capture_hasOutput_internal tm bit next.input captureWork + finalOutput hphysicalHead hphysicalCells + let done := outputProbeDoneCfg tm bit next.input captureWork finalOutput + have htoCapture := + (outputProbeTM tm).reachesIn_snoc hsourceRun (by + simpa [captureWork, finalOutput] using hsourceStep) + have hrun := (outputProbeTM tm).reachesIn_trans htoCapture hcaptureRun + refine ⟨sourceSteps + 2, done, ?_, ?_, ?_⟩ + · simpa [done, finalOutput, Nat.add_assoc] using hrun + · simpa [done] using hdoneHalt + · simpa [done] using hdoneOutput + +/-- End-to-end termination when the next source step crosses the selected +cell while writing a blank symbol. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_finalize_missing_internal + (tm : TM n) {steps advances : ℕ} + {before selected next : CursorCfg n tm.Q} + (counter output : Tape) (symbol : Γ) + (htrace : tm.cursorTraceObserved steps before = + some (selected, advances)) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hnext : tm.cursorStep selected = some next) + (hcursor : selected.output = .cell symbol) + (hdir : tm.cursorOutputDirection selected = Dir3.right) + (hwrite : tm.cursorOutputWrite selected = Γw.blank) + (hphysicalHead : (suppressOutputTapeTrace steps output).head = 1) + (hphysicalCells : (suppressOutputTapeTrace steps output).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [false] := by + obtain ⟨sourceSteps, hsourceRun⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_internal + (remaining := 0) tm counter output htrace hinput hwork + (by simpa using hcounter) houtput + let finalOutput := suppressOutputTapeTrace steps output + have hzero := outputProbeCounterTape_hasBinaryNat_internal 0 + have hzeroRead : (outputProbeCounterTape 0).read ≠ Γ.start := by + rw [Tape.read, hzero.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hzero.2 1 le_rfl + have hsourceStep := outputProbeTM_step_source_internal tm + (outputProbeCounterTape 0) finalOutput hzeroRead hnext + have hsourceMissing := outputProbeSourceResultCfg_missing_internal tm + selected next (outputProbeCounterTape 0) + (suppressOutputTapeStep finalOutput) symbol hcursor hdir hwrite hzero + have hfinalRead : finalOutput.read ≠ Γ.start := by + rw [Tape.read, hphysicalHead] + intro hstart + rw [hphysicalCells] at hstart + simp [Tape.init] at hstart + have hfinalStable : suppressOutputTapeStep finalOutput = finalOutput := by + simpa [suppressOutputTapeStep, outputProbeNormalizeTape] using + outputProbeNormalizeTape_eq_self_internal hfinalRead + rw [hsourceMissing, hfinalStable] at hsourceStep + let missingWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then next.work ⟨i.val, h⟩ + else outputProbeCounterTape 0 + let done := outputProbeMissingDoneCfg tm next.input missingWork finalOutput + have hsourceStep' : + (outputProbeTM tm).step + (outputProbeCfg tm selected (outputProbeCounterTape 0) + finalOutput) = + some (outputProbeMissingCfg tm next.input missingWork + finalOutput) := by + simpa [missingWork, finalOutput] using hsourceStep + have hmissingStep := outputProbeTM_step_missing_internal tm next.input + missingWork finalOutput hfinalRead + have htail : (outputProbeTM tm).reachesIn 2 + (outputProbeCfg tm selected (outputProbeCounterTape 0) finalOutput) + done := by + simpa [done] using TM.reachesIn.step hsourceStep' + (TM.reachesIn.step hmissingStep .zero) + refine ⟨sourceSteps + 2, done, ?_, rfl, ?_⟩ + · exact (outputProbeTM tm).reachesIn_trans hsourceRun htail + · exact outputProbeMissingDone_hasOutput_internal tm next.input + missingWork finalOutput hphysicalHead hphysicalCells + +/-- Space-aware end-to-end capture when the next source step finalizes the +selected Boolean cell by moving right. -/ +theorem outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture_withinAuxSpace_internal + (tm : TM n) (Inv : CursorCfg n tm.Q → Prop) (sourceSpace : ℕ) + {steps advances inputLength : ℕ} + {before selected next : CursorCfg n tm.Q} + (counter output : Tape) (bit : Bool) (symbol : Γ) + (htrace : tm.cursorTraceObserved steps before = + some (selected, advances)) + (hinv : Inv before) + (hinvStep : ∀ {cfg next}, Inv cfg → + tm.cursorStep cfg = some next → Inv next) + (hinvSpace : ∀ cfg, Inv cfg → + (∀ i, (cfg.work i).head ≤ sourceSpace) ∧ + cfg.input.head ≤ inputLength + sourceSpace + 1) + (hsourceSpace : 1 ≤ sourceSpace) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hnext : tm.cursorStep selected = some next) + (hcursor : selected.output = .cell symbol) + (hdir : tm.cursorOutputDirection selected = Dir3.right) + (hwrite : tm.cursorOutputWrite selected = + if bit then Γw.one else Γw.zero) + (hphysicalHead : (suppressOutputTapeTrace steps output).head = 1) + (hphysicalCells : (suppressOutputTapeTrace steps output).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ done.output.HasOutput [bit] ∧ + done.work (Fin.last n) = outputProbeCounterTape 0 ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg → + cfg.WithinAuxSpace inputLength + (outputProbeCaptureSpace sourceSpace advances) := by + obtain ⟨sourceSteps, hsourceRun, hsourcePrefix⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace_internal + (remaining := 0) (maxCounter := advances) tm Inv counter output + htrace hinv hinvStep hinvSpace hsourceSpace hinput hwork + (by simpa using hcounter) houtput (by omega) + let finalOutput := suppressOutputTapeTrace steps output + have hzero := outputProbeCounterTape_hasBinaryNat_internal 0 + have hzeroRead : (outputProbeCounterTape 0).read ≠ Γ.start := by + rw [Tape.read, hzero.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hzero.2 1 le_rfl + have hsourceStep := outputProbeTM_step_source_internal tm + (outputProbeCounterTape 0) finalOutput hzeroRead hnext + have hsourceCapture := outputProbeSourceResultCfg_capture_internal tm + selected next (outputProbeCounterTape 0) + (suppressOutputTapeStep finalOutput) bit symbol hcursor hdir hwrite hzero + have hfinalRead : finalOutput.read ≠ Γ.start := by + rw [Tape.read, hphysicalHead] + intro hstart + rw [hphysicalCells] at hstart + simp [Tape.init] at hstart + have hfinalStable : suppressOutputTapeStep finalOutput = finalOutput := by + simpa [suppressOutputTapeStep, outputProbeNormalizeTape] using + outputProbeNormalizeTape_eq_self_internal hfinalRead + rw [hsourceCapture, hfinalStable] at hsourceStep + let captureWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then next.work ⟨i.val, h⟩ + else outputProbeCounterTape 0 + have hsourceStep' : + (outputProbeTM tm).step + (outputProbeCfg tm selected (outputProbeCounterTape 0) + finalOutput) = + some (outputProbeCaptureCfg tm bit next.input captureWork + finalOutput) := by + simpa [captureWork, finalOutput] using hsourceStep + obtain ⟨hcaptureRun, hdoneHalt, hdoneOutput⟩ := + outputProbeTM_capture_hasOutput_internal tm bit next.input captureWork + finalOutput hphysicalHead hphysicalCells + let done := outputProbeDoneCfg tm bit next.input captureWork finalOutput + have htoCapture := + (outputProbeTM tm).reachesIn_snoc hsourceRun hsourceStep' + have hrun := (outputProbeTM tm).reachesIn_trans htoCapture hcaptureRun + have htail : (outputProbeTM tm).reachesIn 2 + (outputProbeCfg tm selected (outputProbeCounterTape 0) finalOutput) + done := by + simpa [done, Nat.add_assoc] using + (TM.reachesIn.step hsourceStep' hcaptureRun) + refine ⟨sourceSteps + 2, done, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [done, finalOutput, Nat.add_assoc] using hrun + · simpa [done] using hdoneHalt + · simpa [done] using hdoneOutput + · have hstable : + (outputProbeCounterTape 0).writeAndMove + (readBackWrite (outputProbeCounterTape 0).read) + (idleDir (outputProbeCounterTape 0).read) = + outputProbeCounterTape 0 := + Tape.writeAndMove_readBack_idle_of_ne_start _ hzeroRead + simpa [done, outputProbeDoneCfg, captureWork] using hstable + · have hfinalHead : finalOutput.head = 1 := by + simpa [finalOutput] using hphysicalHead + simp [done, outputProbeDoneCfg, Tape.writeAndMove, Tape.move, + Tape.write_head, hfinalHead] + · intro elapsed cfg helapsed hprefix + have hbound := outputProbeTM_captureTail_prefix_withinAuxSpace_internal + tm hsourceRun hsourcePrefix htail helapsed hprefix + simpa [outputProbeCaptureSpace] using hbound + +/-- Space-aware termination when a right move finalizes the selected cell as +blank. -/ +theorem + outputProbeTM_reachesIn_cursorTraceObserved_finalize_missing_withinAuxSpace_internal + (tm : TM n) (Inv : CursorCfg n tm.Q → Prop) (sourceSpace : ℕ) + {steps advances maxCounter inputLength : ℕ} + {before selected next : CursorCfg n tm.Q} + (counter output : Tape) (symbol : Γ) + (htrace : tm.cursorTraceObserved steps before = + some (selected, advances)) + (hinv : Inv before) + (hinvStep : ∀ {cfg next}, Inv cfg → + tm.cursorStep cfg = some next → Inv next) + (hinvSpace : ∀ cfg, Inv cfg → + (∀ i, (cfg.work i).head ≤ sourceSpace) ∧ + cfg.input.head ≤ inputLength + sourceSpace + 1) + (hsourceSpace : 1 ≤ sourceSpace) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) + (hcounter : counter.HasBinaryNat advances) + (houtput : output.StartInvariant) + (hmax : advances ≤ maxCounter) + (hnext : tm.cursorStep selected = some next) + (hcursor : selected.output = .cell symbol) + (hdir : tm.cursorOutputDirection selected = Dir3.right) + (hwrite : tm.cursorOutputWrite selected = Γw.blank) + (hphysicalHead : (suppressOutputTapeTrace steps output).head = 1) + (hphysicalCells : (suppressOutputTapeTrace steps output).cells = + (Tape.init []).cells) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm before counter output) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [false] ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm before counter output) cfg → + cfg.WithinAuxSpace inputLength + (outputProbeCaptureSpace sourceSpace maxCounter) := by + obtain ⟨sourceSteps, hsourceRun, hsourcePrefix⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_withinAuxSpace_internal + (remaining := 0) tm Inv counter output htrace hinv hinvStep + hinvSpace hsourceSpace hinput hwork (by simpa using hcounter) + houtput (by simpa using hmax) + let finalOutput := suppressOutputTapeTrace steps output + have hzero := outputProbeCounterTape_hasBinaryNat_internal 0 + have hzeroRead : (outputProbeCounterTape 0).read ≠ Γ.start := by + rw [Tape.read, hzero.2.1] + exact Tape.cells_ne_start_of_hasBinaryString hzero.2 1 le_rfl + have hsourceStep := outputProbeTM_step_source_internal tm + (outputProbeCounterTape 0) finalOutput hzeroRead hnext + have hsourceMissing := outputProbeSourceResultCfg_missing_internal tm + selected next (outputProbeCounterTape 0) + (suppressOutputTapeStep finalOutput) symbol hcursor hdir hwrite hzero + have hfinalRead : finalOutput.read ≠ Γ.start := by + rw [Tape.read, hphysicalHead] + intro hstart + rw [hphysicalCells] at hstart + simp [Tape.init] at hstart + have hfinalStable : suppressOutputTapeStep finalOutput = finalOutput := by + simpa [suppressOutputTapeStep, outputProbeNormalizeTape] using + outputProbeNormalizeTape_eq_self_internal hfinalRead + rw [hsourceMissing, hfinalStable] at hsourceStep + let missingWork : Fin (n + 1) → Tape := fun i => + if h : i.val < n then next.work ⟨i.val, h⟩ + else outputProbeCounterTape 0 + let done := outputProbeMissingDoneCfg tm next.input missingWork finalOutput + have hsourceStep' : + (outputProbeTM tm).step + (outputProbeCfg tm selected (outputProbeCounterTape 0) + finalOutput) = + some (outputProbeMissingCfg tm next.input missingWork + finalOutput) := by + simpa [missingWork, finalOutput] using hsourceStep + have hmissingStep := outputProbeTM_step_missing_internal tm next.input + missingWork finalOutput hfinalRead + have htail : (outputProbeTM tm).reachesIn 2 + (outputProbeCfg tm selected (outputProbeCounterTape 0) finalOutput) + done := by + simpa [done] using TM.reachesIn.step hsourceStep' + (TM.reachesIn.step hmissingStep .zero) + have hrun := (outputProbeTM tm).reachesIn_trans hsourceRun htail + refine ⟨sourceSteps + 2, done, hrun, rfl, ?_, ?_, ?_⟩ + · exact outputProbeMissingDone_hasOutput_internal tm next.input + missingWork finalOutput hphysicalHead hphysicalCells + · exact outputProbeMissingDone_head_internal tm next.input missingWork + finalOutput hphysicalHead + · intro elapsed cfg helapsed hprefix + have hbound := outputProbeTM_captureTail_prefix_withinAuxSpace_internal + tm hsourceRun hsourcePrefix htail helapsed hprefix + simpa [outputProbeCaptureSpace] using hbound + +/-- A successful complete transducer run can be replayed to capture any valid +output index. The proof splits according to whether the source halts on the +selected frontier cell or crossed and finalized it earlier. -/ +theorem IsTransducer.outputProbeTM_reachesIn_getElem_internal + {tm : TM n} (htrans : tm.IsTransducer) + {input bits : List Bool} {steps : ℕ} {final : Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg input) final) + (hhalt : tm.halted final) (hout : final.output.HasOutput bits) + (index : ℕ) (hindex : index < bits.length) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [bits[index]'hindex] := by + let position := index + 1 + let bit := bits[index]'hindex + have hcell : final.output.cells position = Γ.ofBool bit := by + simpa [position, bit] using hout.1 index hindex + have hblank := htrans.initCfg_output_blankAfterHead_reachesIn hreach + have hpositionLe : position ≤ final.output.head := by + by_contra hnot + have hblankCell := hblank position (by omega) + rw [hcell] at hblankCell + exact Γ.ofBool_ne_blank bit hblankCell + by_cases hfrontier : final.output.head = position + · have hstepsPositive : 0 < steps := by + by_contra hnot + have hzero : steps = 0 := by omega + subst steps + cases hreach + simp [position] at hfrontier + obtain ⟨replaySteps, hsteps⟩ : ∃ replaySteps, steps = replaySteps + 1 := + ⟨steps - 1, by omega⟩ + subst steps + have htrace := htrans.cursorTraceObserved_initCfg hreach + rw [hfrontier] at htrace + have hcursor : (CursorCfg.ofCfg final).output = + .cell (Γ.ofBool bit) := by + unfold CursorCfg.ofCfg Tape.outputCursor + simp [hfrontier, position, Tape.read, hcell] + exact outputProbeTM_reachesIn_cursorTraceObserved_capture_internal tm + (outputProbeCounterTape position) (Tape.init []) bit htrace + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil hhalt hcursor + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps) + · have hpositionLt : position < final.output.head := by omega + obtain ⟨prefixSteps, suffixSteps, selected, next, hprefix, hstep, + hsuffix, hselectedHead, hnextHead⟩ := + exists_output_crossing hreach (by simp [position]) hpositionLt + have hprefixPositive : 0 < prefixSteps := by + by_contra hnot + have hzero : prefixSteps = 0 := by omega + subst prefixSteps + cases hprefix + simp [position] at hselectedHead + obtain ⟨replaySteps, hprefixSteps⟩ : + ∃ replaySteps, prefixSteps = replaySteps + 1 := + ⟨prefixSteps - 1, by omega⟩ + subst prefixSteps + have htrace := htrans.cursorTraceObserved_initCfg hprefix + rw [hselectedHead] at htrace + have hselectedStart : selected.output.StartInvariant := + output_startInvariant_reachesIn hprefix Tape.StartInvariant.init_nil + have hselectedBlank : selected.output.BlankAfterHead := + htrans.initCfg_output_blankAfterHead_reachesIn hprefix + have hnextCursor : tm.cursorStep (.ofCfg selected) = + some (.ofCfg next) := + htrans.cursorStep_commute hselectedStart hselectedBlank hstep + have hcursor : (CursorCfg.ofCfg selected).output = + .cell selected.output.read := by + unfold CursorCfg.ofCfg Tape.outputCursor + simp [hselectedHead, position] + have hdir : tm.cursorOutputDirection (.ofCfg selected) = + Dir3.right := + cursorOutputDirection_eq_right_of_output_head_lt + hselectedStart hstep (by omega) + have hstepCell := cursorOutputWrite_step_cell hselectedStart hstep + (show 0 < selected.output.head by omega) + have hpast := htrans.output_cells_lt_head_reachesIn hsuffix + (show position < next.output.head by omega) + have hwriteToΓ : + (tm.cursorOutputWrite (.ofCfg selected)).toΓ = Γ.ofBool bit := by + calc + (tm.cursorOutputWrite (.ofCfg selected)).toΓ = + next.output.cells selected.output.head := hstepCell.symm + _ = next.output.cells position := by rw [hselectedHead] + _ = final.output.cells position := hpast.symm + _ = Γ.ofBool bit := hcell + have hwrite : tm.cursorOutputWrite (.ofCfg selected) = + if bit then Γw.one else Γw.zero := by + cases hbit : bit <;> + cases hsymbol : tm.cursorOutputWrite (.ofCfg selected) <;> + simp [hbit, hsymbol, Γ.ofBool, Γw.toΓ] at hwriteToΓ ⊢ + exact + outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture_internal + tm (outputProbeCounterTape position) (Tape.init []) bit + selected.output.read htrace (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil hnextCursor hcursor hdir hwrite + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps) + +/-- Cursor states arising from a concrete source run on one fixed input. -/ +private def outputProbeSourceInv (tm : TM n) (input : List Bool) + (cfg : CursorCfg n tm.Q) : Prop := + ∃ steps source, + tm.reachesIn steps (tm.initCfg input) source ∧ + CursorCfg.ofCfg source = cfg + +private theorem outputProbeSourceInv_init_internal (tm : TM n) + (input : List Bool) : + outputProbeSourceInv tm input (.ofCfg (tm.initCfg input)) := + ⟨0, tm.initCfg input, .zero, rfl⟩ + +private theorem outputProbeSourceInv_step_internal + {tm : TM n} (htrans : tm.IsTransducer) (input : List Bool) + {cfg next : CursorCfg n tm.Q} + (hinv : outputProbeSourceInv tm input cfg) + (hcursor : tm.cursorStep cfg = some next) : + outputProbeSourceInv tm input next := by + obtain ⟨steps, source, hreach, rfl⟩ := hinv + cases hstep : tm.step source with + | none => + have hhalt : source.state = tm.qhalt := + step_eq_none_iff_halted.mp hstep + simp [cursorStep, CursorCfg.ofCfg, hhalt] at hcursor + | some sourceNext => + have hstart : source.output.StartInvariant := + output_startInvariant_reachesIn hreach Tape.StartInvariant.init_nil + have hblank : source.output.BlankAfterHead := + htrans.initCfg_output_blankAfterHead_reachesIn hreach + have hcommute := htrans.cursorStep_commute hstart hblank hstep + have hnext : next = CursorCfg.ofCfg sourceNext := + Option.some.inj (hcursor.symm.trans hcommute) + subst next + exact ⟨steps + 1, sourceNext, tm.reachesIn_snoc hreach hstep, rfl⟩ + +private theorem ComputesInSpace.outputProbeSourceInv_space_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (cfg : CursorCfg n tm.Q) + (hinv : outputProbeSourceInv tm input cfg) : + (∀ i, (cfg.work i).head ≤ max 1 (space input.length)) ∧ + cfg.input.head ≤ input.length + max 1 (space input.length) + 1 := by + obtain ⟨steps, source, hreach, rfl⟩ := hinv + have hsource := hcomp.2.1 input source + (tm.reaches_of_reachesIn hreach) + refine ⟨fun i => le_trans (hsource.1 i) (le_max_right _ _), ?_⟩ + dsimp only [CursorCfg.ofCfg] + exact le_trans hsource.2 (by omega) + +/-- Every positive output position query terminates, whether it selects a bit, +a blank cell crossed by the source, or a position beyond the final source +frontier. -/ +theorem ComputesInSpace.outputProbeTM_index_halts_withinAuxSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ + (∃ bit, done.output.HasOutput [bit]) ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + obtain ⟨final, hreach, hhalt, _hout⟩ := hcomp.2.2 input + obtain ⟨steps, hreachIn⟩ := tm.reaches_to_reachesIn hreach + let position := index + 1 + have htrace := hcomp.1.cursorTraceObserved_initCfg hreachIn + by_cases habove : final.output.head < position + · let remaining := position - final.output.head - 1 + have hvalue : (remaining + 1) + final.output.head = position := by + dsimp only [remaining] + omega + have hcounter : (outputProbeCounterTape position).HasBinaryNat + ((remaining + 1) + final.output.head) := by + rw [hvalue] + exact outputProbeCounterTape_hasBinaryNat_internal position + obtain ⟨probeSteps, done, hrun, hdone, hout, hhead, hspace⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_missing_positive_withinAuxSpace_internal + (inputLength := input.length) (maxCounter := position) tm + (outputProbeSourceInv tm input) (max 1 (space input.length)) + (remaining := remaining) (outputProbeCounterTape position) + (Tape.init []) htrace (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) hcounter + Tape.StartInvariant.init_nil (by omega) hhalt + (outputProbeNormalize_suppress_init_head_internal steps) + (outputProbeNormalize_suppress_init_cells_internal steps) + exact ⟨probeSteps, done, by simpa [position] using hrun, hdone, + ⟨false, hout⟩, hhead, by simpa [position] using hspace⟩ + · have hpositionLe : position ≤ final.output.head := by omega + by_cases hfrontier : final.output.head = position + · have hstepsPositive : 0 < steps := by + by_contra hnot + have hzero : steps = 0 := by omega + subst steps + cases hreachIn + simp [position] at hfrontier + obtain ⟨replaySteps, hsteps⟩ : ∃ replaySteps, steps = replaySteps + 1 := + ⟨steps - 1, by omega⟩ + subst steps + rw [hfrontier] at htrace + have hcursor : (CursorCfg.ofCfg final).output = + .cell final.output.read := by + unfold CursorCfg.ofCfg Tape.outputCursor + simp [hfrontier, position] + have hfinalStart : final.output.StartInvariant := + output_startInvariant_reachesIn hreachIn Tape.StartInvariant.init_nil + have hreadNotStart : final.output.read ≠ Γ.start := + hfinalStart.read_ne_start (by simp [hfrontier, position]) + cases hsymbol : final.output.read with + | start => exact (hreadNotStart hsymbol).elim + | zero => + have hcursorBit : (CursorCfg.ofCfg final).output = + .cell (Γ.ofBool false) := by + simpa [hsymbol, Γ.ofBool] using hcursor + obtain ⟨probeSteps, done, hrun, hdone, hout, _hcounter, + hhead, hspace⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_capture_withinAuxSpace_internal + (inputLength := input.length) tm + (outputProbeSourceInv tm input) + (max 1 (space input.length)) (outputProbeCounterTape position) + (Tape.init []) false htrace + (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (by simpa using + outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil hhalt hcursorBit + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps) + exact ⟨probeSteps, done, hrun, hdone, ⟨false, hout⟩, hhead, by + simpa [position] using hspace⟩ + | one => + have hcursorBit : (CursorCfg.ofCfg final).output = + .cell (Γ.ofBool true) := by + simpa [hsymbol, Γ.ofBool] using hcursor + obtain ⟨probeSteps, done, hrun, hdone, hout, _hcounter, + hhead, hspace⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_capture_withinAuxSpace_internal + (inputLength := input.length) tm + (outputProbeSourceInv tm input) + (max 1 (space input.length)) (outputProbeCounterTape position) + (Tape.init []) true htrace + (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (by simpa using + outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil hhalt hcursorBit + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps) + exact ⟨probeSteps, done, hrun, hdone, ⟨true, hout⟩, hhead, by + simpa [position] using hspace⟩ + | blank => + have hmissing : (outputProbeCaptureCursor + (CursorCfg.ofCfg final).output : OutputProbeQ n tm.Q) = + .missing := by + rw [hcursor, hsymbol] + rfl + obtain ⟨probeSteps, done, hrun, hdone, hout, hhead, hspace⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_missing_zero_withinAuxSpace_internal + (inputLength := input.length) (maxCounter := position) tm + (outputProbeSourceInv tm input) + (max 1 (space input.length)) + (outputProbeCounterTape position) (Tape.init []) htrace + (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (by simpa using + outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil (by omega) hhalt hmissing + (outputProbeNormalize_suppress_init_head_internal + (replaySteps + 1)) + (outputProbeNormalize_suppress_init_cells_internal + (replaySteps + 1)) + exact ⟨probeSteps, done, by simpa [position] using hrun, hdone, + ⟨false, hout⟩, hhead, by simpa [position] using hspace⟩ + · have hpositionLt : position < final.output.head := by omega + obtain ⟨prefixSteps, suffixSteps, selected, next, hprefix, hstep, + hsuffix, hselectedHead, hnextHead⟩ := + exists_output_crossing hreachIn (by simp [position]) hpositionLt + have hprefixPositive : 0 < prefixSteps := by + by_contra hnot + have hzero : prefixSteps = 0 := by omega + subst prefixSteps + cases hprefix + simp [position] at hselectedHead + obtain ⟨replaySteps, hprefixSteps⟩ : + ∃ replaySteps, prefixSteps = replaySteps + 1 := + ⟨prefixSteps - 1, by omega⟩ + subst prefixSteps + have hprefixTrace := hcomp.1.cursorTraceObserved_initCfg hprefix + rw [hselectedHead] at hprefixTrace + have hselectedStart : selected.output.StartInvariant := + output_startInvariant_reachesIn hprefix Tape.StartInvariant.init_nil + have hselectedBlank : selected.output.BlankAfterHead := + hcomp.1.initCfg_output_blankAfterHead_reachesIn hprefix + have hnextCursor : tm.cursorStep (.ofCfg selected) = + some (.ofCfg next) := + hcomp.1.cursorStep_commute hselectedStart hselectedBlank hstep + have hcursor : (CursorCfg.ofCfg selected).output = + .cell selected.output.read := by + unfold CursorCfg.ofCfg Tape.outputCursor + simp [hselectedHead, position] + have hdir : tm.cursorOutputDirection (.ofCfg selected) = + Dir3.right := + cursorOutputDirection_eq_right_of_output_head_lt + hselectedStart hstep (by omega) + cases hwrite : tm.cursorOutputWrite (.ofCfg selected) with + | zero => + obtain ⟨probeSteps, done, hrun, hdone, hout, _hcounter, + hhead, hspace⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture_withinAuxSpace_internal + (inputLength := input.length) tm + (outputProbeSourceInv tm input) + (max 1 (space input.length)) + (outputProbeCounterTape position) (Tape.init []) false + selected.output.read hprefixTrace + (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (by simpa using + outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil hnextCursor hcursor hdir + (by simpa using hwrite) + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps) + exact ⟨probeSteps, done, hrun, hdone, ⟨false, hout⟩, hhead, by + simpa [position] using hspace⟩ + | one => + obtain ⟨probeSteps, done, hrun, hdone, hout, _hcounter, + hhead, hspace⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture_withinAuxSpace_internal + (inputLength := input.length) tm + (outputProbeSourceInv tm input) + (max 1 (space input.length)) + (outputProbeCounterTape position) (Tape.init []) true + selected.output.read hprefixTrace + (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (by simpa using + outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil hnextCursor hcursor hdir + (by simpa using hwrite) + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps) + exact ⟨probeSteps, done, hrun, hdone, ⟨true, hout⟩, hhead, by + simpa [position] using hspace⟩ + | blank => + obtain ⟨probeSteps, done, hrun, hdone, hout, hhead, hspace⟩ := + outputProbeTM_reachesIn_cursorTraceObserved_finalize_missing_withinAuxSpace_internal + (inputLength := input.length) (maxCounter := position) tm + (outputProbeSourceInv tm input) + (max 1 (space input.length)) + (outputProbeCounterTape position) (Tape.init []) + selected.output.read hprefixTrace + (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (by simpa using + outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil (by omega) hnextCursor hcursor + hdir hwrite + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps) + exact ⟨probeSteps, done, by simpa [position] using hrun, hdone, + ⟨false, hout⟩, hhead, by simpa [position] using hspace⟩ + +/-- Total arbitrary-index queries transfer to the canonical post-sentinel +wrapper with the same Boolean result and all-prefix space bound. -/ +theorem + ComputesInSpace.outputProbeStartedTM_index_halts_withinAuxSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) : + ∃ probeSteps done, + (outputProbeStartedTM tm).reachesIn probeSteps + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) done ∧ + (outputProbeStartedTM tm).halted done ∧ + (∃ bit, done.output.HasOutput [bit]) ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeStartedTM tm).reachesIn elapsed + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + obtain ⟨probeSteps, done, hreach, hhalt, hbit, hhead, hspace⟩ := + hcomp.outputProbeTM_index_halts_withinAuxSpace_internal input index + have hprobeNe : + (outputProbeTM tm).qstart ≠ (outputProbeTM tm).qhalt := by + intro h + cases h + have hstepsNe : probeSteps ≠ 0 := by + intro hzero + subst probeSteps + cases hreach + exact hprobeNe hhalt + obtain ⟨tailSteps, hsteps⟩ := Nat.exists_eq_succ_of_ne_zero hstepsNe + subst probeSteps + cases hreach with + | step hstep hrest => + rename_i intermediate + have hmid : intermediate = outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)) := by + apply Option.some.inj + rw [← hstep] + exact hcomp.1.outputProbeTM_step_startedCfg_total_internal input + (index + 1) + subst intermediate + refine ⟨tailSteps, done, + (outputProbeTM tm).startedTM_reachesIn_of_source hrest, + hhalt, hbit, hhead, ?_⟩ + intro elapsed cfg helapsed hstarted + have hsource := (outputProbeTM tm).source_reachesIn_of_startedTM + hstarted + apply hspace (elapsed + 1) cfg + · omega + · exact TM.reachesIn.step hstep hsource + +/-- A valid output-bit query from a space-bounded transducer carries an +all-prefix auxiliary-space certificate through the final capture seam. -/ +theorem ComputesInSpace.outputProbeTM_getElem_withinAuxSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [(f input)[index]'hindex] ∧ + done.work (Fin.last n) = outputProbeCounterTape 0 ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeTM tm).reachesIn elapsed + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + obtain ⟨final, hreach, hhalt, hout⟩ := hcomp.2.2 input + obtain ⟨steps, hreachIn⟩ := tm.reaches_to_reachesIn hreach + let position := index + 1 + let bit := (f input)[index]'hindex + have hcell : final.output.cells position = Γ.ofBool bit := by + simpa [position, bit] using hout.1 index hindex + have hblank := hcomp.1.initCfg_output_blankAfterHead_reachesIn hreachIn + have hpositionLe : position ≤ final.output.head := by + by_contra hnot + have hblankCell := hblank position (by omega) + rw [hcell] at hblankCell + exact Γ.ofBool_ne_blank bit hblankCell + by_cases hfrontier : final.output.head = position + · have hstepsPositive : 0 < steps := by + by_contra hnot + have hzero : steps = 0 := by omega + subst steps + cases hreachIn + simp [position] at hfrontier + obtain ⟨replaySteps, hsteps⟩ : ∃ replaySteps, steps = replaySteps + 1 := + ⟨steps - 1, by omega⟩ + subst steps + have htrace := hcomp.1.cursorTraceObserved_initCfg hreachIn + rw [hfrontier] at htrace + have hcursor : (CursorCfg.ofCfg final).output = + .cell (Γ.ofBool bit) := by + unfold CursorCfg.ofCfg Tape.outputCursor + simp [hfrontier, position, Tape.read, hcell] + simpa [position, bit] using + (outputProbeTM_reachesIn_cursorTraceObserved_capture_withinAuxSpace_internal + (inputLength := input.length) tm (outputProbeSourceInv tm input) + (max 1 (space input.length)) + (outputProbeCounterTape position) (Tape.init []) bit htrace + (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil hhalt hcursor + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps)) + · have hpositionLt : position < final.output.head := by omega + obtain ⟨prefixSteps, suffixSteps, selected, next, hprefix, hstep, + hsuffix, hselectedHead, hnextHead⟩ := + exists_output_crossing hreachIn (by simp [position]) hpositionLt + have hprefixPositive : 0 < prefixSteps := by + by_contra hnot + have hzero : prefixSteps = 0 := by omega + subst prefixSteps + cases hprefix + simp [position] at hselectedHead + obtain ⟨replaySteps, hprefixSteps⟩ : + ∃ replaySteps, prefixSteps = replaySteps + 1 := + ⟨prefixSteps - 1, by omega⟩ + subst prefixSteps + have htrace := hcomp.1.cursorTraceObserved_initCfg hprefix + rw [hselectedHead] at htrace + have hselectedStart : selected.output.StartInvariant := + output_startInvariant_reachesIn hprefix Tape.StartInvariant.init_nil + have hselectedBlank : selected.output.BlankAfterHead := + hcomp.1.initCfg_output_blankAfterHead_reachesIn hprefix + have hnextCursor : tm.cursorStep (.ofCfg selected) = + some (.ofCfg next) := + hcomp.1.cursorStep_commute hselectedStart hselectedBlank hstep + have hcursor : (CursorCfg.ofCfg selected).output = + .cell selected.output.read := by + unfold CursorCfg.ofCfg Tape.outputCursor + simp [hselectedHead, position] + have hdir : tm.cursorOutputDirection (.ofCfg selected) = Dir3.right := + cursorOutputDirection_eq_right_of_output_head_lt + hselectedStart hstep (by omega) + have hstepCell := cursorOutputWrite_step_cell hselectedStart hstep + (show 0 < selected.output.head by omega) + have hpast := hcomp.1.output_cells_lt_head_reachesIn hsuffix + (show position < next.output.head by omega) + have hwriteToΓ : + (tm.cursorOutputWrite (.ofCfg selected)).toΓ = Γ.ofBool bit := by + calc + (tm.cursorOutputWrite (.ofCfg selected)).toΓ = + next.output.cells selected.output.head := hstepCell.symm + _ = next.output.cells position := by rw [hselectedHead] + _ = final.output.cells position := hpast.symm + _ = Γ.ofBool bit := hcell + have hwrite : tm.cursorOutputWrite (.ofCfg selected) = + if bit then Γw.one else Γw.zero := by + cases hbit : bit <;> + cases hsymbol : tm.cursorOutputWrite (.ofCfg selected) <;> + simp [hbit, hsymbol, Γ.ofBool, Γw.toΓ] at hwriteToΓ ⊢ + simpa [position, bit] using + (outputProbeTM_reachesIn_cursorTraceObserved_finalize_capture_withinAuxSpace_internal + (inputLength := input.length) tm (outputProbeSourceInv tm input) + (max 1 (space input.length)) + (outputProbeCounterTape position) (Tape.init []) bit + selected.output.read htrace + (outputProbeSourceInv_init_internal tm input) + (outputProbeSourceInv_step_internal hcomp.1 input) + (hcomp.outputProbeSourceInv_space_internal input) + (le_max_left 1 (space input.length)) + (Tape.StartInvariant.init_ofBool input) + (fun _ => Tape.StartInvariant.init_nil) + (outputProbeCounterTape_hasBinaryNat_internal position) + Tape.StartInvariant.init_nil hnextCursor hcursor hdir hwrite + (suppressOutputTapeTrace_succ_init_head replaySteps) + (suppressOutputTapeTrace_succ_init_cells replaySteps)) + +/-- A space-bounded function transducer's probe captures every valid output +index from the canonical source input and binary position tape. -/ +theorem ComputesInSpace.outputProbeTM_getElem_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + (outputProbeTM tm).reachesIn probeSteps + (outputProbeCfg tm (.ofCfg (tm.initCfg input)) + (outputProbeCounterTape (index + 1)) (Tape.init [])) done ∧ + (outputProbeTM tm).halted done ∧ + done.output.HasOutput [(f input)[index]'hindex] := by + obtain ⟨probeSteps, done, hreach, hhalt, hout, _hcounter, _hhead, + _hspace⟩ := + hcomp.outputProbeTM_getElem_withinAuxSpace_internal input index hindex + exact ⟨probeSteps, done, hreach, hhalt, hout⟩ + +private theorem qstart_ne_qhalt_of_computesInSpace_getElem_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + tm.qstart ≠ tm.qhalt := by + intro hstart + obtain ⟨final, hreach, _hhalt, hout⟩ := hcomp.2.2 input + obtain ⟨steps, hreachIn⟩ := tm.reaches_to_reachesIn hreach + have hinitHalt : tm.halted (tm.initCfg input) := by + simpa [TM.halted, Cfg.isHalted, Cfg.init] using hstart + have hsteps : steps = 0 := by + have hle := tm.reachesIn_le_halt hreachIn + (TM.reachesIn.zero : + tm.reachesIn 0 (tm.initCfg input) (tm.initCfg input)) hinitHalt + omega + subst steps + cases hreachIn + have hcell := hout.1 index hindex + cases hbit : (f input)[index] <;> + simp [Tape.init, Γ.ofBool, hbit] at hcell + +/-- A valid output-bit query from the canonical post-sentinel frame preserves +the complete all-prefix auxiliary-space certificate. -/ +theorem ComputesInSpace.outputProbeStartedTM_getElem_withinAuxSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + (outputProbeStartedTM tm).reachesIn probeSteps + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) done ∧ + (outputProbeStartedTM tm).halted done ∧ + done.output.HasOutput [(f input)[index]'hindex] ∧ + done.work (Fin.last n) = outputProbeCounterTape 0 ∧ + done.output.head = 2 ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (outputProbeStartedTM tm).reachesIn elapsed + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + have hne := qstart_ne_qhalt_of_computesInSpace_getElem_internal + hcomp input index hindex + obtain ⟨probeSteps, done, hreach, hhalt, hout, hcounter, hhead, + hspace⟩ := + hcomp.outputProbeTM_getElem_withinAuxSpace_internal input index hindex + have hprobeNe : + (outputProbeTM tm).qstart ≠ (outputProbeTM tm).qhalt := by + intro h + cases h + have hstepsNe : probeSteps ≠ 0 := by + intro hzero + subst probeSteps + cases hreach + exact hprobeNe hhalt + obtain ⟨tailSteps, hsteps⟩ := Nat.exists_eq_succ_of_ne_zero hstepsNe + subst probeSteps + cases hreach with + | step hstep hrest => + rename_i intermediate + have hmid : intermediate = outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)) := by + apply Option.some.inj + rw [← hstep] + exact hcomp.1.outputProbeTM_step_startedCfg_internal input + (index + 1) hne + subst intermediate + refine ⟨tailSteps, done, + (outputProbeTM tm).startedTM_reachesIn_of_source hrest, + hhalt, hout, hcounter, hhead, ?_⟩ + intro elapsed cfg helapsed hstarted + have hsource := (outputProbeTM tm).source_reachesIn_of_startedTM + hstarted + apply hspace (elapsed + 1) cfg + · omega + · exact TM.reachesIn.step hstep hsource + +/-- A space-bounded transducer's valid output bit can be queried from the +canonical post-sentinel probe frame. -/ +theorem ComputesInSpace.outputProbeStartedTM_getElem_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + (outputProbeStartedTM tm).reachesIn probeSteps + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) done ∧ + (outputProbeStartedTM tm).halted done ∧ + done.output.HasOutput [(f input)[index]'hindex] := by + obtain ⟨probeSteps, done, hreach, hhalt, hout, _hcounter, _hhead, + _hspace⟩ := + hcomp.outputProbeStartedTM_getElem_withinAuxSpace_internal + input index hindex + exact ⟨probeSteps, done, hreach, hhalt, hout⟩ + +/-- Total restartable queries can be retargeted into a fresh work tape while +retaining their Boolean result, blank-support envelope, and all-prefix space +bound. -/ +theorem + ComputesInSpace.outputProbeStartedRetargetTM_index_halts_withinAuxSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (∃ bit, (done.work (Fin.last (n + 1))).HasOutput [bit]) ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + done.output = (Tape.init []).move Dir3.right ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + ((outputProbeStartedTM tm).retargetOutput).reachesIn elapsed + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + obtain ⟨probeSteps, sourceDone, hsourceRun, hhalt, hbit, hhead, + hsourcePrefix⟩ := + hcomp.outputProbeStartedTM_index_halts_withinAuxSpace_internal + input index + let sourceTM := outputProbeStartedTM tm + let budget := outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) + have hsourceTrans : sourceTM.IsTransducer := + (outputProbeTM_isTransducer_internal tm).startedTM_internal + have hretargetRun := + retargetOutput_reachesIn_retargetCfg_frame sourceTM hsourceRun + have hretargetPrefix : ∀ elapsed cfg, elapsed ≤ probeSteps → + sourceTM.retargetOutput.reachesIn elapsed + (sourceTM.retargetCfg (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) cfg → + cfg.WithinAuxSpace input.length budget := by + intro elapsed cfg helapsed hretarget + let remaining := probeSteps - elapsed + have htime : elapsed + remaining = probeSteps := by + dsimp only [remaining] + omega + rw [← htime] at hsourceRun + obtain ⟨sourceMid, hsourceMid, hsourceRest⟩ := + reachesIn_split_internal hsourceRun + have hretargetMid := + retargetOutput_reachesIn_retargetCfg_frame sourceTM hsourceMid + have hcfg : cfg = sourceTM.retargetCfg sourceMid := + (sourceTM.retargetOutput).reachesIn_right_unique hretarget hretargetMid + subst cfg + have hmidSpace : sourceMid.WithinAuxSpace input.length budget := by + simpa [budget] using + hsourcePrefix elapsed sourceMid helapsed hsourceMid + have hmidOutput : sourceMid.output.head ≤ 2 := by + have hmono := hsourceTrans.output_head_mono_reachesIn hsourceRest + omega + constructor + · intro i + by_cases hi : i.val < n + 1 + · rw [retargetCfg_work_lt sourceTM sourceMid i hi] + exact hmidSpace.1 ⟨i.val, hi⟩ + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfg_work_last] + apply le_trans hmidOutput + dsimp only [budget, outputProbeCaptureSpace, + outputProbeReplaySpace, outputProbePositiveSpace, binaryPredSpace] + omega + · simpa only [retargetCfg_input] using hmidSpace.2 + have hblankParked : ((Tape.init []).move Dir3.right).BlankAfter budget := by + simpa only [Tape.BlankAfter, Tape.move_cells] using + Tape.BlankAfter.init_nil budget + have hstartBlank : ∀ i, + ((sourceTM.retargetCfg (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))).work i).BlankAfter budget := by + intro i + by_cases hi : i.val < n + 1 + · rw [retargetCfg_work_lt sourceTM _ i hi] + by_cases hsource : i.val < n + · simpa [outputProbeStartedCfg, hsource] using hblankParked + · have hilast : (⟨i.val, hi⟩ : Fin (n + 1)) = Fin.last n := by + apply Fin.ext + simp only [Fin.val_last] + omega + rw [hilast] + have hcounterBlank : + (outputProbeCounterTape (index + 1)).BlankAfter budget := by + have hcontent : (outputProbeCounterTape + (index + 1)).HasBinaryContent (index + 1).bits := + (outputProbeCounterTape_hasBinaryNat_internal (index + 1)).2.2 + apply hcontent.blankAfter_of_length_le + rw [Nat.size_eq_bits_len] + have hsize := Nat.size_le_size + (show index + 1 ≤ index + 1 + 1 by omega) + dsimp only [budget, outputProbeCaptureSpace, + outputProbeReplaySpace, outputProbePositiveSpace, binaryPredSpace] + omega + simpa [outputProbeStartedCfg] using hcounterBlank + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfg_work_last] + simpa [outputProbeStartedCfg] using hblankParked + refine ⟨probeSteps, sourceTM.retargetCfg sourceDone, hretargetRun, + hhalt, ?_, ?_, rfl, hretargetPrefix⟩ + · obtain ⟨bit, hout⟩ := hbit + exact ⟨bit, by rw [retargetCfg_work_last]; exact hout⟩ + · intro i + exact work_blankAfter_reachesIn i (hstartBlank i) hretargetRun + hretargetPrefix + +/-- Redirecting the restartable query preserves its all-prefix space bound; +the captured one-bit output has head two and therefore fits inside the same +budget on the fresh final work tape. -/ +theorem ComputesInSpace.outputProbeStartedRetargetTM_getElem_withinAuxSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (done.work (Fin.last (n + 1))).HasOutput + [(f input)[index]'hindex] ∧ + done.work ⟨n, by omega⟩ = outputProbeCounterTape 0 ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + done.output = (Tape.init []).move Dir3.right ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + ((outputProbeStartedTM tm).retargetOutput).reachesIn elapsed + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + obtain ⟨probeSteps, sourceDone, hsourceRun, hhalt, hout, hcounter, + hhead, hsourcePrefix⟩ := + hcomp.outputProbeStartedTM_getElem_withinAuxSpace_internal + input index hindex + let sourceTM := outputProbeStartedTM tm + let budget := outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) + have hsourceTrans : sourceTM.IsTransducer := + (outputProbeTM_isTransducer_internal tm).startedTM_internal + have hretargetRun := + retargetOutput_reachesIn_retargetCfg_frame sourceTM hsourceRun + have hretargetPrefix : ∀ elapsed cfg, elapsed ≤ probeSteps → + sourceTM.retargetOutput.reachesIn elapsed + (sourceTM.retargetCfg (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) cfg → + cfg.WithinAuxSpace input.length budget := by + intro elapsed cfg helapsed hretarget + let remaining := probeSteps - elapsed + have htime : elapsed + remaining = probeSteps := by + dsimp only [remaining] + omega + rw [← htime] at hsourceRun + obtain ⟨sourceMid, hsourceMid, hsourceRest⟩ := + reachesIn_split_internal hsourceRun + have hretargetMid := + retargetOutput_reachesIn_retargetCfg_frame sourceTM hsourceMid + have hcfg : cfg = sourceTM.retargetCfg sourceMid := + (sourceTM.retargetOutput).reachesIn_right_unique hretarget hretargetMid + subst cfg + have hmidSpace : sourceMid.WithinAuxSpace input.length budget := by + simpa [budget] using + hsourcePrefix elapsed sourceMid helapsed hsourceMid + have hmidOutput : sourceMid.output.head ≤ 2 := by + have hmono := hsourceTrans.output_head_mono_reachesIn hsourceRest + omega + constructor + · intro i + by_cases hi : i.val < n + 1 + · rw [retargetCfg_work_lt sourceTM sourceMid i hi] + exact hmidSpace.1 ⟨i.val, hi⟩ + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfg_work_last] + apply le_trans hmidOutput + dsimp only [budget, outputProbeCaptureSpace, + outputProbeReplaySpace, outputProbePositiveSpace, binaryPredSpace] + omega + · simpa only [retargetCfg_input] using hmidSpace.2 + have hblankParked : ((Tape.init []).move Dir3.right).BlankAfter budget := by + simpa only [Tape.BlankAfter, Tape.move_cells] using + Tape.BlankAfter.init_nil budget + have hstartBlank : ∀ i, + ((sourceTM.retargetCfg (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))).work i).BlankAfter budget := by + intro i + by_cases hi : i.val < n + 1 + · rw [retargetCfg_work_lt sourceTM _ i hi] + by_cases hsource : i.val < n + · simpa [outputProbeStartedCfg, hsource] using hblankParked + · have hilast : (⟨i.val, hi⟩ : Fin (n + 1)) = Fin.last n := by + apply Fin.ext + simp only [Fin.val_last] + omega + rw [hilast] + have hcounterBlank : + (outputProbeCounterTape (index + 1)).BlankAfter budget := by + have hcontent : (outputProbeCounterTape + (index + 1)).HasBinaryContent (index + 1).bits := + (outputProbeCounterTape_hasBinaryNat_internal (index + 1)).2.2 + apply hcontent.blankAfter_of_length_le + rw [Nat.size_eq_bits_len] + have hsize := Nat.size_le_size + (show index + 1 ≤ index + 1 + 1 by omega) + dsimp only [budget, outputProbeCaptureSpace, + outputProbeReplaySpace, outputProbePositiveSpace, binaryPredSpace] + omega + simpa [outputProbeStartedCfg] using hcounterBlank + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfg_work_last] + simpa [outputProbeStartedCfg] using hblankParked + refine ⟨probeSteps, sourceTM.retargetCfg sourceDone, hretargetRun, + hhalt, ?_, ?_, ?_, rfl, hretargetPrefix⟩ + · rw [retargetCfg_work_last] + exact hout + · rw [retargetCfg_work_lt] + exact hcounter + · intro i + exact work_blankAfter_reachesIn i (hstartBlank i) hretargetRun + hretargetPrefix + +/-- Redirect the restartable probe's captured output bit to a fresh work tape, +leaving the enclosing machine's real output parked and blank. -/ +theorem ComputesInSpace.outputProbeStartedRetargetTM_getElem_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1)))) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (done.work (Fin.last (n + 1))).HasOutput + [(f input)[index]'hindex] ∧ + done.output = (Tape.init []).move Dir3.right := by + obtain ⟨probeSteps, done, hreach, hhalt, hout, _hcounter, _hblank, + houtput, _hspace⟩ := + hcomp.outputProbeStartedRetargetTM_getElem_withinAuxSpace_internal + input index hindex + exact ⟨probeSteps, done, hreach, hhalt, hout, houtput⟩ + +/-- A total retargeted query can run inside an arbitrary stable controller +frame, preserving one Boolean result and the complete cleanup support bound. -/ +theorem + ComputesInSpace.placeOutputProbeStartedRetargetTM_index_halts_withinAuxSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (pre post : ℕ) + (input : List Bool) (index : ℕ) + (extras : Fin (pre + (n + 2) + post) → Tape) + {frameSpace : ℕ} + (hextra : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let start := (outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) + ∃ probeSteps done, + (placeWorkTM pre post queryTM).reachesIn probeSteps + (placeWorkCfg queryTM pre post extras start) + (placeWorkCfg queryTM pre post extras done) ∧ + (placeWorkTM pre post queryTM).halted + (placeWorkCfg queryTM pre post extras done) ∧ + (∃ bit, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post (Fin.last (n + 1)))).HasOutput [bit]) ∧ + (∀ i, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post i)).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + (placeWorkCfg queryTM pre post extras done).output = + (Tape.init []).move Dir3.right ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (placeWorkTM pre post queryTM).reachesIn elapsed + (placeWorkCfg queryTM pre post extras start) cfg → + cfg.WithinAuxSpace input.length + (max + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) + frameSpace) := by + dsimp only + obtain ⟨probeSteps, done, hreach, hhalt, hbit, hblank, houtput, + hprefix⟩ := + hcomp.outputProbeStartedRetargetTM_index_halts_withinAuxSpace_internal + input index + obtain ⟨hplaced, hplacedPrefix⟩ := + placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace_internal + ((outputProbeStartedTM tm).retargetOutput) pre post extras hreach + hextra hprefix hframe + refine ⟨probeSteps, done, hplaced, hhalt, ?_, ?_, ?_, hplacedPrefix⟩ + · obtain ⟨bit, hout⟩ := hbit + refine ⟨bit, ?_⟩ + rw [placeWorkCfg_work_middle] + exact hout + · intro i + rw [placeWorkCfg_work_middle] + exact hblank i + · simpa only [placeWorkCfg_output] using houtput + +/-- A restartable retargeted output query can run inside an arbitrary stable +controller frame. The exact source endpoint is embedded back into that frame, +the captured bit is exposed at its physical placed tape, and every prefix uses +at most the maximum of the query and frame budgets. -/ +theorem ComputesInSpace.placeOutputProbeStartedRetargetTM_getElem_withinAuxSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (pre post : ℕ) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (extras : Fin (pre + (n + 2) + post) → Tape) + {frameSpace : ℕ} + (hextra : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let start := (outputProbeStartedTM tm).retargetCfg + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) + ∃ probeSteps done, + (placeWorkTM pre post queryTM).reachesIn probeSteps + (placeWorkCfg queryTM pre post extras start) + (placeWorkCfg queryTM pre post extras done) ∧ + (placeWorkTM pre post queryTM).halted + (placeWorkCfg queryTM pre post extras done) ∧ + ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post (Fin.last (n + 1)))).HasOutput + [(f input)[index]'hindex] ∧ + (placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post ⟨n, by omega⟩) = + outputProbeCounterTape 0 ∧ + (∀ i, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post i)).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + (placeWorkCfg queryTM pre post extras done).output = + (Tape.init []).move Dir3.right ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (placeWorkTM pre post queryTM).reachesIn elapsed + (placeWorkCfg queryTM pre post extras start) cfg → + cfg.WithinAuxSpace input.length + (max + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) + frameSpace) := by + dsimp only + obtain ⟨probeSteps, done, hreach, hhalt, hout, hcounter, hblank, + houtput, hprefix⟩ := + hcomp.outputProbeStartedRetargetTM_getElem_withinAuxSpace_internal + input index hindex + obtain ⟨hplaced, hplacedPrefix⟩ := + placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace_internal + ((outputProbeStartedTM tm).retargetOutput) pre post extras hreach + hextra hprefix hframe + refine ⟨probeSteps, done, hplaced, ?_, ?_, ?_, ?_, ?_, hplacedPrefix⟩ + · exact hhalt + · rw [placeWorkCfg_work_middle] + exact hout + · rw [placeWorkCfg_work_middle] + exact hcounter + · intro i + rw [placeWorkCfg_work_middle] + exact hblank i + · simpa only [placeWorkCfg_output] using houtput + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeCleanup.lean b/Complexitylib/Models/TuringMachine/OutputProbeCleanup.lean new file mode 100644 index 00000000..83c94e23 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeCleanup.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeCleanup.Defs +import Complexitylib.Models.TuringMachine.OutputProbeCleanup.Internal + +/-! +# Restartable output-probe cleanup + +This module exposes the full-frame cleanup phase used between output-probe +queries. It rewinds the shared input and restores every probe-owned work tape +under one reusable logarithmic-space bound. +-/ + +namespace Complexity + +namespace TM + +theorem outputProbeCleanupTargets_nodup (n : ℕ) : + (outputProbeCleanupTargets n).Nodup := + outputProbeCleanupTargets_nodup_internal n + +theorem outputProbeCleanupSourceIdx_mem {n : ℕ} (idx : Fin n) : + outputProbeCleanupSourceIdx idx ∈ outputProbeCleanupTargets n := + outputProbeCleanupSourceIdx_mem_internal idx + +theorem outputProbeCleanupCaptureIdx_mem (n : ℕ) : + outputProbeCleanupCaptureIdx n ∈ outputProbeCleanupTargets n := + outputProbeCleanupCaptureIdx_mem_internal n + +theorem outputProbeCleanupCountdownIdx_mem (n : ℕ) : + outputProbeCleanupCountdownIdx n ∈ outputProbeCleanupTargets n := + outputProbeCleanupCountdownIdx_mem_internal n + +/-- The complete cleanup phase preserves its frame and has an explicit +all-prefix auxiliary-space envelope. -/ +theorem outputProbeCleanupTM_hoareTimeSpace_frame + (n inputHeadBound limit inputLength initialSpace : ℕ) + (headBound : Fin (outputProbeControllerTapes n) → ℕ) + (inp₀ : Tape) + (work₀ : Fin (outputProbeControllerTapes n) → Tape) (out₀ : Tape) + (hinputInvariant : inp₀.StartInvariant) (hinput : Parked inp₀) + (hinputHead : inp₀.head ≤ inputHeadBound) + (hwork : ∀ i, Parked (work₀ i)) + (htargetInvariant : ∀ i, i ∈ outputProbeCleanupTargets n → + (work₀ i).StartInvariant) + (htargetHead : ∀ i, i ∈ outputProbeCleanupTargets n → + (work₀ i).head ≤ headBound i) + (hcounter : (work₀ (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hlimit : (work₀ (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (houtput : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (outputProbeCleanupTM n).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = outputProbeRewoundInput inp₀ ∧ + work = rewindBlankWorkPrefixManyResult limit work₀ + (outputProbeCleanupTargets n) ∧ + out = out₀) + (outputProbeCleanupTime n inputHeadBound limit headBound) + inputLength (outputProbeCleanupSpace n initialSpace limit headBound) := + outputProbeCleanupTM_hoareTimeSpace_frame_internal n inputHeadBound limit + inputLength initialSpace headBound inp₀ work₀ out₀ hinputInvariant + hinput hinputHead hwork htargetInvariant htargetHead hcounter hlimit houtput + hworkSpace hinputSpace + +theorem outputProbeCleanupTM_isTransducer (n : ℕ) : + (outputProbeCleanupTM n).IsTransducer := + outputProbeCleanupTM_isTransducer_internal n + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeCleanup/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeCleanup/Defs.lean new file mode 100644 index 00000000..9b6fb97c --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeCleanup/Defs.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbe.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefixMany.Defs + +/-! +# Restartable output-probe cleanup -- definitions + +The retargeted probe owns `n` source scratch tapes, one query countdown, and +one captured-bit tape. Cleanup adds one reusable zero counter and one preserved +binary limit, rewinds the input, and blanks every probe-owned tape. +-/ + +namespace Complexity + +namespace TM + +/-- Syntactic work-tape arity of a retargeted `n`-tape probe placed before its +two cleanup tapes. This expression is propositionally equal to `n + 4`; its +placement-normal form avoids casts in controller compositions. -/ +abbrev outputProbeControllerTapes (n : ℕ) : ℕ := + 0 + (n + 1 + 1) + 2 + +/-- Embed one source work index in the full cleanup frame. -/ +def outputProbeCleanupSourceIdx {n : ℕ} (idx : Fin n) : + Fin (outputProbeControllerTapes n) := + ⟨idx, by dsimp only [outputProbeControllerTapes]; omega⟩ + +/-- Physical query-countdown index. -/ +def outputProbeCleanupCountdownIdx (n : ℕ) : + Fin (outputProbeControllerTapes n) := + ⟨n, by dsimp only [outputProbeControllerTapes]; omega⟩ + +/-- Physical captured-bit index. -/ +def outputProbeCleanupCaptureIdx (n : ℕ) : + Fin (outputProbeControllerTapes n) := + ⟨n + 1, by dsimp only [outputProbeControllerTapes]; omega⟩ + +/-- Reusable zero counter used by sparse-prefix cleanup. -/ +def outputProbeCleanupCounterIdx (n : ℕ) : + Fin (outputProbeControllerTapes n) := + ⟨n + 2, by dsimp only [outputProbeControllerTapes]; omega⟩ + +/-- Preserved binary cleanup limit. -/ +def outputProbeCleanupLimitIdx (n : ℕ) : + Fin (outputProbeControllerTapes n) := + ⟨n + 3, by dsimp only [outputProbeControllerTapes]; omega⟩ + +/-- Source scratch tapes followed by the countdown and captured-bit tapes. -/ +def outputProbeCleanupTargets (n : ℕ) : + List (Fin (outputProbeControllerTapes n)) := + List.ofFn outputProbeCleanupSourceIdx ++ + [outputProbeCleanupCountdownIdx n, outputProbeCleanupCaptureIdx n] + +/-- Literal input tape after rewinding to the first ordinary cell. -/ +def outputProbeRewoundInput (tape : Tape) : Tape where + head := 1 + cells := tape.cells + +/-- Rewind the shared input, then reset every dirty probe-owned work tape. -/ +def outputProbeCleanupTM (n : ℕ) : TM (outputProbeControllerTapes n) := + seqTM rewindInputTM + (rewindBlankWorkPrefixManyTM (outputProbeCleanupCounterIdx n) + (outputProbeCleanupLimitIdx n) (outputProbeCleanupTargets n)) + +/-- Exact cleanup runtime. -/ +def outputProbeCleanupTime (n inputHeadBound limit : ℕ) + (headBound : Fin (outputProbeControllerTapes n) → ℕ) : ℕ := + inputHeadBound + 2 + 1 + + rewindBlankWorkPrefixManyTime headBound limit + (outputProbeCleanupTargets n) + +/-- All-prefix cleanup space envelope. -/ +def outputProbeCleanupSpace (n initialSpace limit : ℕ) + (headBound : Fin (outputProbeControllerTapes n) → ℕ) : ℕ := + max initialSpace + (rewindBlankWorkPrefixManySpace initialSpace headBound limit + (outputProbeCleanupTargets n)) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeCleanup/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeCleanup/Internal.lean new file mode 100644 index 00000000..73946596 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeCleanup/Internal.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeCleanup.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefixMany +import Complexitylib.Models.TuringMachine.Subroutines.RewindInputSpace + +/-! +# Restartable output-probe cleanup -- proof internals +-/ + +namespace Complexity + +namespace TM + +theorem outputProbeCleanupSourceIdx_injective_internal {n : ℕ} : + Function.Injective (@outputProbeCleanupSourceIdx n) := by + intro left right heq + apply Fin.ext + exact Fin.mk.inj heq + +theorem outputProbeCleanupTargets_nodup_internal (n : ℕ) : + (outputProbeCleanupTargets n).Nodup := by + rw [outputProbeCleanupTargets, List.nodup_append] + refine ⟨List.nodup_ofFn_ofInjective + outputProbeCleanupSourceIdx_injective_internal, ?_, ?_⟩ + · simp [outputProbeCleanupCountdownIdx, outputProbeCleanupCaptureIdx] + intro idx hsource target htarget heq + obtain ⟨source, rfl⟩ := List.mem_ofFn.mp hsource + simp only [List.mem_cons, List.not_mem_nil, or_false] at htarget + rcases htarget with rfl | rfl <;> + apply congrArg Fin.val at heq <;> + simp [outputProbeCleanupSourceIdx, outputProbeCleanupCountdownIdx, + outputProbeCleanupCaptureIdx] at heq <;> omega + +theorem outputProbeCleanupSourceIdx_mem_internal {n : ℕ} (idx : Fin n) : + outputProbeCleanupSourceIdx idx ∈ outputProbeCleanupTargets n := by + simp [outputProbeCleanupTargets, List.mem_ofFn] + +theorem outputProbeCleanupCaptureIdx_mem_internal (n : ℕ) : + outputProbeCleanupCaptureIdx n ∈ outputProbeCleanupTargets n := by + simp [outputProbeCleanupTargets] + +theorem outputProbeCleanupCountdownIdx_mem_internal (n : ℕ) : + outputProbeCleanupCountdownIdx n ∈ outputProbeCleanupTargets n := by + simp [outputProbeCleanupTargets] + +theorem outputProbeCleanupTarget_lt_counter_internal {n : ℕ} + {idx : Fin (outputProbeControllerTapes n)} + (hidx : idx ∈ outputProbeCleanupTargets n) : + idx.val < (outputProbeCleanupCounterIdx n).val := by + rw [outputProbeCleanupTargets, List.mem_append] at hidx + rcases hidx with hsource | htail + · obtain ⟨source, rfl⟩ := List.mem_ofFn.mp hsource + simp only [outputProbeCleanupSourceIdx, outputProbeCleanupCounterIdx, + Fin.val_mk] + omega + · simp only [List.mem_cons, List.not_mem_nil, or_false] at htail + rcases htail with rfl | rfl <;> + simp [outputProbeCleanupCountdownIdx, outputProbeCleanupCaptureIdx, + outputProbeCleanupCounterIdx] + +theorem outputProbeCleanupTarget_distinct_internal {n : ℕ} + {idx : Fin (outputProbeControllerTapes n)} + (hidx : idx ∈ outputProbeCleanupTargets n) : + BlankWorkPrefixDistinct idx (outputProbeCleanupCounterIdx n) + (outputProbeCleanupLimitIdx n) := by + have hlt := outputProbeCleanupTarget_lt_counter_internal hidx + constructor + · exact Fin.ne_of_lt hlt + constructor + · apply Fin.ne_of_lt + exact lt_trans hlt (by + simp [outputProbeCleanupCounterIdx, outputProbeCleanupLimitIdx]) + · apply Fin.ne_of_lt + simp [outputProbeCleanupCounterIdx, outputProbeCleanupLimitIdx] + +private theorem outputProbeRewoundInput_parked (tape : Tape) + (hinvariant : tape.StartInvariant) : + Parked (outputProbeRewoundInput tape) := by + constructor + · simp [outputProbeRewoundInput] + · intro index hindex + exact hinvariant.2 index hindex + +theorem outputProbeCleanupTM_hoareTimeSpace_frame_internal + (n inputHeadBound limit inputLength initialSpace : ℕ) + (headBound : Fin (outputProbeControllerTapes n) → ℕ) + (inp₀ : Tape) + (work₀ : Fin (outputProbeControllerTapes n) → Tape) (out₀ : Tape) + (hinputInvariant : inp₀.StartInvariant) (hinput : Parked inp₀) + (hinputHead : inp₀.head ≤ inputHeadBound) + (hwork : ∀ i, Parked (work₀ i)) + (htargetInvariant : ∀ i, i ∈ outputProbeCleanupTargets n → + (work₀ i).StartInvariant) + (htargetHead : ∀ i, i ∈ outputProbeCleanupTargets n → + (work₀ i).head ≤ headBound i) + (hcounter : (work₀ (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hlimit : (work₀ (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (houtput : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (outputProbeCleanupTM n).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = outputProbeRewoundInput inp₀ ∧ + work = rewindBlankWorkPrefixManyResult limit work₀ + (outputProbeCleanupTargets n) ∧ + out = out₀) + (outputProbeCleanupTime n inputHeadBound limit headBound) + inputLength (outputProbeCleanupSpace n initialSpace limit headBound) := by + let inp₁ := outputProbeRewoundInput inp₀ + let cleanup := rewindBlankWorkPrefixManyTM + (outputProbeCleanupCounterIdx n) (outputProbeCleanupLimitIdx n) + (outputProbeCleanupTargets n) + have hrewindBase := rewindInputTM_hoareTimeSpace_frame inputHeadBound + inputLength initialSpace inp₀ work₀ out₀ hinputInvariant hinput + hinputHead hwork houtput hworkSpace hinputSpace + have hrewind : + (rewindInputTM (n := outputProbeControllerTapes n)).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₁ ∧ work = work₀ ∧ out = out₀) + (inputHeadBound + 2) inputLength initialSpace := + hrewindBase.consequence (fun _ _ _ h => h) (by + rintro inp work out ⟨hhead, hcells, hworkEq, houtputEq⟩ + refine ⟨?_, hworkEq, houtputEq⟩ + apply Tape.ext + · simpa [inp₁, outputProbeRewoundInput] using hhead + · simpa [inp₁, outputProbeRewoundInput] using hcells) le_rfl le_rfl + le_rfl + have hinput₁ : Parked inp₁ := by + exact outputProbeRewoundInput_parked inp₀ hinputInvariant + have hcleanup := rewindBlankWorkPrefixManyTM_hoareTimeSpace_frame + (outputProbeCleanupCounterIdx n) (outputProbeCleanupLimitIdx n) + (outputProbeCleanupTargets n) headBound limit inputLength initialSpace + inp₁ work₀ out₀ (outputProbeCleanupTargets_nodup_internal n) + (fun _ hi => outputProbeCleanupTarget_distinct_internal hi) + htargetInvariant htargetHead hinput₁ hwork hcounter hlimit houtput + hworkSpace (by simp [inp₁, outputProbeRewoundInput]) + have hseq := seqTM_hoareTimeSpace + (rewindInputTM (n := outputProbeControllerTapes n)) cleanup + hrewind (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hinput₁.transitionInput_eq_self, + funext fun i => (hwork i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩) hcleanup + simpa [outputProbeCleanupTM, outputProbeCleanupTime, + outputProbeCleanupSpace, cleanup, inp₁] using hseq + +theorem outputProbeCleanupTM_isTransducer_internal (n : ℕ) : + (outputProbeCleanupTM n).IsTransducer := by + unfold outputProbeCleanupTM + exact (rewindInputTM_isTransducer + (n := outputProbeControllerTapes n)).seqTM + (rewindBlankWorkPrefixManyTM_isTransducer + (outputProbeCleanupCounterIdx n) (outputProbeCleanupLimitIdx n) + (outputProbeCleanupTargets n)) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeConsume.lean b/Complexitylib/Models/TuringMachine/OutputProbeConsume.lean new file mode 100644 index 00000000..9e670d02 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeConsume.lean @@ -0,0 +1,212 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeConsume.Internal + +/-! +# Restartable output-probe consumption + +This combinator converts a captured query bit into a finite-control branch, +cleans the probe-owned tapes, and only then enters the selected continuation. +-/ + +namespace Complexity + +namespace TM + +/-- A restartable output probe reads the selected source bit, restores its +canonical frame, and then runs the matching continuation within an explicit +all-prefix space envelope. -/ +theorem ComputesInSpace.outputProbeConsumeTM_hoareTimeSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (onZero onOne : TM (outputProbeControllerTapes n)) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + {post : Bool → TapePred (outputProbeControllerTapes n)} + {zeroTime oneTime zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post false) zeroTime input.length zeroSpace) + (hone : onOne.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post true) oneTime input.length oneSpace) : + ∃ consumeTime, + (outputProbeConsumeTM tm onZero onOne).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (post ((f input)[index]'hindex)) consumeTime input.length + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (if (f input)[index]'hindex then oneSpace else zeroSpace)) := + hcomp.outputProbeConsumeTM_hoareTimeSpace_internal onZero onOne input + index hindex output houtput extras frameSpace limit hextras hframe + hcleanupCounter hcleanupLimit hlimit hzero hone + +/-- A restartable output probe also consumes every numeric query position, +selects a Boolean continuation, and restores the same reusable frame and +space envelope. -/ +theorem ComputesInSpace.outputProbeConsumeTM_index_halts_hoareTimeSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (onZero onOne : TM (outputProbeControllerTapes n)) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + {post : Bool → TapePred (outputProbeControllerTapes n)} + {zeroTime oneTime zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post false) zeroTime input.length zeroSpace) + (hone : onOne.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post true) oneTime input.length oneSpace) : + ∃ bit consumeTime, + (outputProbeConsumeTM tm onZero onOne).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (post bit) consumeTime input.length + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit (if bit then oneSpace else zeroSpace)) := + hcomp.outputProbeConsumeTM_index_halts_hoareTimeSpace_internal + onZero onOne input index output houtput extras frameSpace limit hextras + hframe hcleanupCounter hcleanupLimit hlimit hzero hone + +/-- The complete consume/reset step may occupy a middle work block while an +arbitrary stable serializer frame is preserved around it. -/ +theorem ComputesInSpace.outputProbeConsumeTM_hoareTimeSpace_frame + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (onZero onOne : TM (outputProbeControllerTapes n)) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + {post : Bool → TapePred (outputProbeControllerTapes n)} + {zeroTime oneTime zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post false) zeroTime input.length zeroSpace) + (hone : onOne.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post true) oneTime input.length oneSpace) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) : + ∃ consumeTime, + (placeWorkTM 0 controllerTapes + (outputProbeConsumeTM tm onZero onOne)).HoareTimeSpace + (placeWorkPred (outputProbeConsumeTM tm onZero onOne) 0 + controllerTapes outerExtras + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output)) + (placeWorkPred (outputProbeConsumeTM tm onZero onOne) 0 + controllerTapes outerExtras (post ((f input)[index]'hindex))) + consumeTime input.length + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (if (f input)[index]'hindex then oneSpace else zeroSpace)) + outerFrameSpace) := + hcomp.outputProbeConsumeTM_hoareTimeSpace_frame_internal onZero onOne input + index hindex output houtput extras frameSpace limit hextras hframe + hcleanupCounter hcleanupLimit hlimit hzero hone controllerTapes + outerExtras outerFrameSpace houterRead houterFrame + +/-- The placed restartable query never moves the real output head left. -/ +theorem outputProbePlacedTM_isTransducer (tm : TM n) : + (outputProbePlacedTM tm).IsTransducer := + outputProbePlacedTM_isTransducer_internal tm + +/-- Probe consumption is a transducer whenever both continuations are. -/ +theorem IsTransducer.outputProbeConsumeTM + {tm : TM n} + {onZero onOne : TM (outputProbeControllerTapes n)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeConsumeTM tm onZero onOne).IsTransducer := + hzero.outputProbeConsumeTM_internal hone + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeConsume/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeConsume/Defs.lean new file mode 100644 index 00000000..abd0fe06 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeConsume/Defs.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +import Complexitylib.Models.TuringMachine.OutputProbeCleanup.Defs +import Complexitylib.Models.TuringMachine.Placement.Defs +import Complexitylib.Models.TuringMachine.RetargetOutputFrame.Defs +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs + +/-! +# Restartable output-probe consumption -- definitions + +The query is placed in the first `n + 2` work tapes of the cleanup frame. Its +captured bit is rewound to cell one and dispatched into one of two continuations. +The chosen branch cleans the query-owned frame before entering its continuation, +so the bit survives only in finite control. +-/ + +namespace Complexity + +namespace TM + +/-- The retargeted restartable query occupying the query block of the cleanup +frame. -/ +def outputProbePlacedTM (tm : TM n) : TM (outputProbeControllerTapes n) := + placeWorkTM 0 2 ((outputProbeStartedTM tm).retargetOutput) + +/-- Literal controller frame for one query countdown. The source scratch block +and captured-bit tape are canonical, while the final two cleanup tapes come +from `extras`. -/ +def outputProbePlacedFrameCfg (tm : TM n) (input : List Bool) + (counter output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) : + Cfg (outputProbeControllerTapes n) (outputProbePlacedTM tm).Q := + placeWorkCfg ((outputProbeStartedTM tm).retargetOutput) 0 2 extras + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input counter) output) + +/-- Rewind only the captured-bit tape to cell one while retaining every tape +cell literally. -/ +def outputProbeCaptureRewoundWork {n : ℕ} + (work : Fin (outputProbeControllerTapes n) → Tape) : + Fin (outputProbeControllerTapes n) → Tape := + Function.update work (outputProbeCleanupCaptureIdx n) + { head := 1, cells := (work (outputProbeCleanupCaptureIdx n)).cells } + +/-- Peak space of the placed query, including its stable two-tape cleanup +frame. -/ +def outputProbeConsumeQuerySpace (sourceSpace index frameSpace : ℕ) : ℕ := + max (outputProbeCaptureSpace sourceSpace (index + 1)) frameSpace + +/-- Coarse but logarithmically faithful space bound for rewinding the captured +bit tape. -/ +def outputProbeConsumeRewindSpace (sourceSpace index frameSpace : ℕ) : ℕ := + let querySpace := outputProbeConsumeQuerySpace sourceSpace index frameSpace + querySpace + (querySpace + 2) + +/-- Cleanup space after the captured bit has been rewound. -/ +def outputProbeConsumeCleanupSpace (n sourceSpace index frameSpace limit : ℕ) : + ℕ := + let querySpace := outputProbeConsumeQuerySpace sourceSpace index frameSpace + let rewindSpace := outputProbeConsumeRewindSpace sourceSpace index frameSpace + outputProbeCleanupSpace n rewindSpace limit (fun _ => querySpace) + +/-- Peak space of one complete query-consume-reset step and its selected +continuation. -/ +def outputProbeConsumeSpace (n sourceSpace index frameSpace limit + continuationSpace : ℕ) : ℕ := + let querySpace := outputProbeConsumeQuerySpace sourceSpace index frameSpace + let rewindSpace := outputProbeConsumeRewindSpace sourceSpace index frameSpace + let cleanupSpace := outputProbeConsumeCleanupSpace n sourceSpace index + frameSpace limit + max querySpace (max rewindSpace (max cleanupSpace continuationSpace)) + +/-- Query a source-output bit, branch on the captured value, clean the source +frame, and enter the corresponding continuation. -/ +def outputProbeConsumeTM (tm : TM n) + (onZero onOne : TM (outputProbeControllerTapes n)) : + TM (outputProbeControllerTapes n) := + seqTM (outputProbePlacedTM tm) + (seqTM (rewindWorkTM (outputProbeCleanupCaptureIdx n)) + (branchWorkSymbolTM (outputProbeCleanupCaptureIdx n) Γ.one + (seqTM (outputProbeCleanupTM n) onOne) + (seqTM (outputProbeCleanupTM n) onZero))) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeConsume/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeConsume/Internal.lean new file mode 100644 index 00000000..ca9ba2e3 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeConsume/Internal.lean @@ -0,0 +1,1195 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +import Complexitylib.Models.TuringMachine.OutputProbeConsume.Defs +import Complexitylib.Models.TuringMachine.OutputProbeCleanup +import Complexitylib.Models.TuringMachine.OutputProbeFrame +import Complexitylib.Models.TuringMachine.Placement +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork + +/-! +# Restartable output-probe consumption -- proof internals +-/ + +namespace Complexity + +namespace TM + +@[simp] theorem outputProbeCaptureRewoundWork_capture_internal + {n : ℕ} (work : Fin (outputProbeControllerTapes n) → Tape) : + outputProbeCaptureRewoundWork work (outputProbeCleanupCaptureIdx n) = + { head := 1, + cells := (work (outputProbeCleanupCaptureIdx n)).cells } := by + simp [outputProbeCaptureRewoundWork] + +theorem outputProbeCaptureRewoundWork_ne_internal + {n : ℕ} (work : Fin (outputProbeControllerTapes n) → Tape) + (idx : Fin (outputProbeControllerTapes n)) + (hne : idx ≠ outputProbeCleanupCaptureIdx n) : + outputProbeCaptureRewoundWork work idx = work idx := by + simp [outputProbeCaptureRewoundWork, hne] + +private theorem hasBinaryNat_parked {tape : Tape} {value : ℕ} + (hvalue : tape.HasBinaryNat value) : Parked tape := by + refine ⟨by rw [hvalue.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hvalue.2.2 + +private theorem outputProbeCaptureRewoundWork_parked {n : ℕ} + (work : Fin (outputProbeControllerTapes n) → Tape) + (hwork : ∀ i, Parked (work i)) : + ∀ i, Parked (outputProbeCaptureRewoundWork work i) := by + intro i + by_cases hi : i = outputProbeCleanupCaptureIdx n + · subst i + rw [outputProbeCaptureRewoundWork_capture_internal] + exact ⟨le_rfl, (hwork (outputProbeCleanupCaptureIdx n)).2⟩ + · rw [outputProbeCaptureRewoundWork_ne_internal work i hi] + exact hwork i + +private theorem outputProbeCaptureRewoundWork_startInvariant {n : ℕ} + (work : Fin (outputProbeControllerTapes n) → Tape) + (hwork : ∀ i, (work i).StartInvariant) : + ∀ i, (outputProbeCaptureRewoundWork work i).StartInvariant := by + intro i + by_cases hi : i = outputProbeCleanupCaptureIdx n + · subst i + rw [outputProbeCaptureRewoundWork_capture_internal] + exact hwork (outputProbeCleanupCaptureIdx n) + · rw [outputProbeCaptureRewoundWork_ne_internal work i hi] + exact hwork i + +private theorem outputProbeCaptureRewoundWork_blankAfter {n : ℕ} + (work : Fin (outputProbeControllerTapes n) → Tape) + (bound : ℕ) (hwork : ∀ i, (work i).BlankAfter bound) : + ∀ i, (outputProbeCaptureRewoundWork work i).BlankAfter bound := by + intro i index hindex + by_cases hi : i = outputProbeCleanupCaptureIdx n + · subst i + simpa only [outputProbeCaptureRewoundWork_capture_internal] using + hwork (outputProbeCleanupCaptureIdx n) index hindex + · rw [outputProbeCaptureRewoundWork_ne_internal work i hi] + exact hwork i index hindex + +private theorem parked_rewoundInput (tape : Tape) + (hinvariant : tape.StartInvariant) : + Parked (outputProbeRewoundInput tape) := by + exact ⟨le_rfl, hinvariant.2⟩ + +private theorem outputProbeCleanupTarget_middle {n : ℕ} + (idx : Fin (outputProbeControllerTapes n)) + (hidx : idx ∈ outputProbeCleanupTargets n) : + placeWorkInMiddle 0 (n + 2) idx := by + rw [outputProbeCleanupTargets, List.mem_append] at hidx + rcases hidx with hsource | htail + · obtain ⟨source, rfl⟩ := List.mem_ofFn.mp hsource + simp [placeWorkInMiddle, outputProbeCleanupSourceIdx] + omega + · simp only [List.mem_cons, List.not_mem_nil, or_false] at htail + rcases htail with rfl | rfl <;> + simp [placeWorkInMiddle, outputProbeCleanupCountdownIdx, + outputProbeCleanupCaptureIdx] + +theorem outputProbeCleanupResult_eq_frame_internal + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (queryDone : Cfg (n + 2) ((outputProbeStartedTM tm).retargetOutput).Q) + (hinvariant : ∀ i, i ∈ outputProbeCleanupTargets n → + (outputProbeCaptureRewoundWork + (placeWorkCfg ((outputProbeStartedTM tm).retargetOutput) 0 2 + extras queryDone).work i).StartInvariant) + (hblank : ∀ i, i ∈ outputProbeCleanupTargets n → + (outputProbeCaptureRewoundWork + (placeWorkCfg ((outputProbeStartedTM tm).retargetOutput) 0 2 + extras queryDone).work i).BlankAfter limit) : + rewindBlankWorkPrefixManyResult limit + (outputProbeCaptureRewoundWork + (placeWorkCfg ((outputProbeStartedTM tm).retargetOutput) 0 2 + extras queryDone).work) + (outputProbeCleanupTargets n) = + (outputProbePlacedFrameCfg tm input (outputProbeCounterTape 0) + output extras).work := by + let queryTM := (outputProbeStartedTM tm).retargetOutput + let queriedWork := + (placeWorkCfg queryTM 0 2 extras queryDone).work + let rewoundWork := outputProbeCaptureRewoundWork queriedWork + funext idx + by_cases htarget : idx ∈ outputProbeCleanupTargets n + · rw [rewindBlankWorkPrefixManyResult_eq_parkedBlank_of_mem limit + rewoundWork (outputProbeCleanupTargets n) + (outputProbeCleanupTargets_nodup n) hinvariant hblank idx htarget] + rw [outputProbeCleanupTargets, List.mem_append] at htarget + rcases htarget with hsource | htail + · obtain ⟨source, hidx⟩ := List.mem_ofFn.mp hsource + subst idx + let sourceIdx : Fin (n + 2) := ⟨source.val, by omega⟩ + have hphysical : outputProbeCleanupSourceIdx source = + placeWorkIdx 0 2 sourceIdx := by + apply Fin.ext + simp [outputProbeCleanupSourceIdx, sourceIdx] + rw [show (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work + (outputProbeCleanupSourceIdx source) = + (Tape.init []).move Dir3.right by + rw [hphysical, outputProbePlacedFrameCfg, + placeWorkCfg_work_middle] + rw [retargetCfgFrame_work_lt _ _ _ sourceIdx (by + dsimp only [sourceIdx] + omega)] + simp [outputProbeStartedCfg, sourceIdx]] + · simp only [List.mem_cons, List.not_mem_nil, or_false] at htail + rcases htail with hcountdown | hcapture + · subst idx + let countdownIdx : Fin (n + 2) := ⟨n, by omega⟩ + have hphysical : outputProbeCleanupCountdownIdx n = + placeWorkIdx 0 2 countdownIdx := by + apply Fin.ext + simp [outputProbeCleanupCountdownIdx, countdownIdx] + rw [show (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work + (outputProbeCleanupCountdownIdx n) = + (Tape.init []).move Dir3.right by + rw [hphysical, outputProbePlacedFrameCfg, + placeWorkCfg_work_middle] + rw [retargetCfgFrame_work_lt _ _ _ countdownIdx (by + dsimp only [countdownIdx] + omega)] + simp [outputProbeStartedCfg, countdownIdx, + outputProbeCounterTape]] + · subst idx + have hphysical : outputProbeCleanupCaptureIdx n = + placeWorkIdx 0 2 (Fin.last (n + 1)) := by + apply Fin.ext + simp [outputProbeCleanupCaptureIdx] + rw [show (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work + (outputProbeCleanupCaptureIdx n) = + (Tape.init []).move Dir3.right by + rw [hphysical, outputProbePlacedFrameCfg, + placeWorkCfg_work_middle] + rw [retargetCfgFrame_work_last] + simp [outputProbeStartedCfg]] + · rw [rewindBlankWorkPrefixManyResult_eq_of_not_mem limit rewoundWork + (outputProbeCleanupTargets n) idx htarget] + by_cases hmiddle : placeWorkInMiddle 0 (n + 2) idx + · have hcountdownIdx : idx = outputProbeCleanupCountdownIdx n := by + have hnotSource : ¬idx.val < n := by + intro hlt + apply htarget + rw [outputProbeCleanupTargets, List.mem_append] + left + apply List.mem_ofFn.mpr + refine ⟨⟨idx.val, hlt⟩, ?_⟩ + apply Fin.ext + simp [outputProbeCleanupSourceIdx] + have hnotCapture : idx.val ≠ n + 1 := by + intro heq + apply htarget + rw [outputProbeCleanupTargets, List.mem_append] + right + simp only [List.mem_cons, List.not_mem_nil, or_false] + right + apply Fin.ext + simp [outputProbeCleanupCaptureIdx, heq] + apply Fin.ext + simp only [outputProbeCleanupCountdownIdx] + simp [placeWorkInMiddle] at hmiddle + omega + subst idx + exact (htarget (outputProbeCleanupCountdownIdx_mem_internal n)).elim + · have hrewound : rewoundWork idx = queriedWork idx := by + apply outputProbeCaptureRewoundWork_ne_internal + intro heq + subst idx + exact hmiddle (by + simp [placeWorkInMiddle, outputProbeCleanupCaptureIdx]) + rw [hrewound] + dsimp only [queriedWork] + rw [placeWorkCfg_work_extra queryTM 0 2 extras queryDone idx hmiddle] + rw [show (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work idx = extras idx by + rw [outputProbePlacedFrameCfg] + exact placeWorkCfg_work_extra + ((outputProbeStartedTM tm).retargetOutput) 0 2 extras + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input (outputProbeCounterTape 0)) + output) idx hmiddle] + +theorem ComputesInSpace.outputProbePlacedTM_hoareTimeSpace_frame_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace : ℕ) + (hextra : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let querySpace := outputProbeConsumeQuerySpace + (max 1 (space input.length)) index frameSpace + ∃ probeSteps done, + (outputProbePlacedTM tm).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (fun inp work out => + inp = (placeWorkCfg queryTM 0 2 extras done).input ∧ + work = (placeWorkCfg queryTM 0 2 extras done).work ∧ + out = output) + probeSteps input.length querySpace ∧ + ((placeWorkCfg queryTM 0 2 extras done).work + (outputProbeCleanupCaptureIdx n)).HasOutput + [(f input)[index]'hindex] ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + done.output = output ∧ + (placeWorkCfg queryTM 0 2 extras done).input.cells = + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input.cells := by + dsimp only + let queryTM := (outputProbeStartedTM tm).retargetOutput + let querySpace := outputProbeConsumeQuerySpace + (max 1 (space input.length)) index frameSpace + obtain ⟨probeSteps, done, hreach, hhalt, hcaptured, _hcountdown, + hblank, houtputDone, hinputParked, hinputInvariant, hworkParked, + hworkInvariant, hprefix⟩ := + hcomp.placeOutputProbeStartedRetargetTM_getElem_withinAuxSpace_frame + 0 2 input index hindex output houtput extras hextra hframe + let placedDone := placeWorkCfg queryTM 0 2 extras done + have hreach' : (outputProbePlacedTM tm).reachesIn probeSteps + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras) placedDone := by + simpa [outputProbePlacedTM, outputProbePlacedFrameCfg, queryTM] using + hreach + have hhalt' : (outputProbePlacedTM tm).halted placedDone := by + simpa [placedDone, outputProbePlacedTM, queryTM] using hhalt + have hblankDone : ∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + intro i + simpa [placedDone] using hblank i + have hquery : (outputProbePlacedTM tm).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (fun inp work out => + inp = placedDone.input ∧ work = placedDone.work ∧ out = output) + probeSteps input.length querySpace := by + constructor + · rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨placedDone, probeSteps, le_rfl, hreach', hhalt', rfl, rfl, + by simpa [placedDone] using houtputDone⟩ + · rintro inp work out ⟨rfl, rfl, rfl⟩ current hcurrent + obtain ⟨elapsed, hcurrentRun⟩ := + (outputProbePlacedTM tm).reaches_to_reachesIn hcurrent + have helapsed : elapsed ≤ probeSteps := + (outputProbePlacedTM tm).reachesIn_le_halt hcurrentRun hreach' + hhalt' + simpa [outputProbePlacedTM, outputProbePlacedFrameCfg, queryTM, + querySpace, outputProbeConsumeQuerySpace] using + hprefix elapsed current helapsed hcurrentRun + refine ⟨probeSteps, done, ?_, ?_, hblankDone, hinputParked, + hinputInvariant, hworkParked, hworkInvariant, ?_, ?_⟩ + · simpa only [placedDone] using hquery + · have hphysical : outputProbeCleanupCaptureIdx n = + placeWorkIdx 0 2 (Fin.last (n + 1)) := by + apply Fin.ext + simp [outputProbeCleanupCaptureIdx] + rw [hphysical] + exact hcaptured + · simpa using houtputDone + · exact input_cells_eq_of_reachesIn hreach' + +theorem + ComputesInSpace.outputProbePlacedTM_index_halts_hoareTimeSpace_frame_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace : ℕ) + (hextra : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let querySpace := outputProbeConsumeQuerySpace + (max 1 (space input.length)) index frameSpace + ∃ probeSteps done bit, + (outputProbePlacedTM tm).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (fun inp work out => + inp = (placeWorkCfg queryTM 0 2 extras done).input ∧ + work = (placeWorkCfg queryTM 0 2 extras done).work ∧ + out = output) + probeSteps input.length querySpace ∧ + ((placeWorkCfg queryTM 0 2 extras done).work + (outputProbeCleanupCaptureIdx n)).HasOutput [bit] ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + done.output = output ∧ + (placeWorkCfg queryTM 0 2 extras done).input.cells = + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input.cells := by + dsimp only + let queryTM := (outputProbeStartedTM tm).retargetOutput + let querySpace := outputProbeConsumeQuerySpace + (max 1 (space input.length)) index frameSpace + obtain ⟨probeSteps, done, hreach, hhalt, hcaptured, hblank, + houtputDone, hinputParked, hinputInvariant, hworkParked, + hworkInvariant, hprefix⟩ := + hcomp.placeOutputProbeStartedRetargetTM_index_halts_withinAuxSpace_frame + 0 2 input index output houtput extras hextra hframe + obtain ⟨bit, hbit⟩ := hcaptured + let placedDone := placeWorkCfg queryTM 0 2 extras done + have hreach' : (outputProbePlacedTM tm).reachesIn probeSteps + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras) placedDone := by + simpa [outputProbePlacedTM, outputProbePlacedFrameCfg, queryTM] using + hreach + have hhalt' : (outputProbePlacedTM tm).halted placedDone := by + simpa [placedDone, outputProbePlacedTM, queryTM] using hhalt + have hblankDone : ∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + intro i + simpa [placedDone] using hblank i + have hquery : (outputProbePlacedTM tm).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (fun inp work out => + inp = placedDone.input ∧ work = placedDone.work ∧ out = output) + probeSteps input.length querySpace := by + constructor + · rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨placedDone, probeSteps, le_rfl, hreach', hhalt', rfl, rfl, + by simpa [placedDone] using houtputDone⟩ + · rintro inp work out ⟨rfl, rfl, rfl⟩ current hcurrent + obtain ⟨elapsed, hcurrentRun⟩ := + (outputProbePlacedTM tm).reaches_to_reachesIn hcurrent + have helapsed : elapsed ≤ probeSteps := + (outputProbePlacedTM tm).reachesIn_le_halt hcurrentRun hreach' + hhalt' + simpa [outputProbePlacedTM, outputProbePlacedFrameCfg, queryTM, + querySpace, outputProbeConsumeQuerySpace] using + hprefix elapsed current helapsed hcurrentRun + refine ⟨probeSteps, done, bit, ?_, ?_, hblankDone, hinputParked, + hinputInvariant, hworkParked, hworkInvariant, ?_, ?_⟩ + · simpa only [placedDone] using hquery + · have hphysical : outputProbeCleanupCaptureIdx n = + placeWorkIdx 0 2 (Fin.last (n + 1)) := by + apply Fin.ext + simp [outputProbeCleanupCaptureIdx] + rw [hphysical] + exact hbit + · simpa using houtputDone + · exact input_cells_eq_of_reachesIn hreach' + +theorem ComputesInSpace.outputProbeConsumeTM_hoareTimeSpace_bit_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (_hcomp : tm.ComputesInSpace f space) + (onZero onOne : TM (outputProbeControllerTapes n)) + (input : List Bool) (index : ℕ) (bit : Bool) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (_hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (hqueryResult : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let querySpace := outputProbeConsumeQuerySpace + (max 1 (space input.length)) index frameSpace + ∃ probeSteps done, + (outputProbePlacedTM tm).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (fun inp work out => + inp = (placeWorkCfg queryTM 0 2 extras done).input ∧ + work = (placeWorkCfg queryTM 0 2 extras done).work ∧ + out = output) + probeSteps input.length querySpace ∧ + ((placeWorkCfg queryTM 0 2 extras done).work + (outputProbeCleanupCaptureIdx n)).HasOutput [bit] ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + done.output = output ∧ + (placeWorkCfg queryTM 0 2 extras done).input.cells = + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input.cells) + {post : Bool → TapePred (outputProbeControllerTapes n)} + {zeroTime oneTime zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post false) zeroTime input.length zeroSpace) + (hone : onOne.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post true) oneTime input.length oneSpace) : + ∃ consumeTime, + (outputProbeConsumeTM tm onZero onOne).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (post bit) consumeTime input.length + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (if bit then oneSpace else zeroSpace)) := by + let sourceSpace := max 1 (space input.length) + let budget := outputProbeCaptureSpace sourceSpace (index + 1) + let querySpace := outputProbeConsumeQuerySpace sourceSpace index frameSpace + let rewindSpace := outputProbeConsumeRewindSpace sourceSpace index frameSpace + let cleanupSpace := outputProbeConsumeCleanupSpace n sourceSpace index + frameSpace limit + let continuationSpace := if bit then oneSpace else zeroSpace + let queryTM := (outputProbeStartedTM tm).retargetOutput + have hextraRead : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).read ≠ Γ.start := by + intro i hi + exact (hextras i hi).read_ne_start + dsimp only at hqueryResult + obtain ⟨probeSteps, done, hquery, hcaptured, hblank, + hinputParked, hinputInvariant, hworkParked, hworkInvariant, + hdoneOutput, hinputCells⟩ := + hqueryResult + let placedDone := placeWorkCfg queryTM 0 2 extras done + let readyWork := outputProbeCaptureRewoundWork placedDone.work + let cleanCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras + have hquerySpaceOne : 1 ≤ querySpace := by + dsimp only [querySpace, outputProbeConsumeQuerySpace, budget, + sourceSpace, outputProbeCaptureSpace, outputProbeReplaySpace, + outputProbePositiveSpace, binaryPredSpace] + omega + have hplacedInputParked : Parked placedDone.input := by + simpa only [placedDone, placeWorkCfg_input] using hinputParked + have hplacedInputInvariant : placedDone.input.StartInvariant := by + simpa only [placedDone, placeWorkCfg_input] using hinputInvariant + have hplacedOutput : placedDone.output = output := by + simpa [placedDone] using hdoneOutput + have hplacedWorkParked : ∀ i, Parked (placedDone.work i) := by + intro i + dsimp only [placedDone] + by_cases hi : placeWorkInMiddle 0 (n + 2) i + · rw [placeWorkCfg] + simp only [hi, dite_true] + exact hworkParked (placeWorkCoord 0 (n + 2) i hi) + · rw [placeWorkCfg_work_extra queryTM 0 2 extras done i hi] + exact hextras i hi + have hplacedDoneSpace : placedDone.WithinAuxSpace input.length + querySpace := by + obtain ⟨queryEnd, querySteps, _hquerySteps, hqueryRun, _hqueryHalt, + hqueryEnd⟩ := hquery.1 + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work + output ⟨rfl, rfl, rfl⟩ + have hqueryEndSpace := hquery.2 + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work + output ⟨rfl, rfl, rfl⟩ queryEnd (reaches_of_reachesIn hqueryRun) + obtain ⟨hqueryInput, hqueryWork, _hqueryOutput⟩ := hqueryEnd + constructor + · intro i + dsimp only [placedDone] + rw [← hqueryWork] + exact hqueryEndSpace.1 i + · dsimp only [placedDone] + rw [← hqueryInput] + exact hqueryEndSpace.2 + have hcapturePhysical : outputProbeCleanupCaptureIdx n = + placeWorkIdx 0 2 (Fin.last (n + 1)) := by + apply Fin.ext + simp [outputProbeCleanupCaptureIdx] + have hplacedCaptureInvariant : + (placedDone.work (outputProbeCleanupCaptureIdx n)).StartInvariant := by + rw [hcapturePhysical] + dsimp only [placedDone] + rw [placeWorkCfg_work_middle] + exact hworkInvariant (Fin.last (n + 1)) + have hrewindBase := rewindWorkTM_hoareTime_frame + (outputProbeCleanupCaptureIdx n) querySpace + (P := fun inp work out => + inp = placedDone.input ∧ + (work (outputProbeCleanupCaptureIdx n)).cells = + (placedDone.work (outputProbeCleanupCaptureIdx n)).cells ∧ + (∀ i, i ≠ outputProbeCleanupCaptureIdx n → + work i = placedDone.work i) ∧ + out = output) + (by + rintro inp work out inp' work' out' + ⟨hinputEq, htargetEq, hotherEq, houtputEq⟩ + htargetCells _htargetHead hother hinput' houtputCells houtputHead + refine ⟨hinput'.trans hinputEq, htargetCells.trans htargetEq, ?_, ?_⟩ + · intro i hi + exact (hother i hi).trans (hotherEq i hi) + · apply Tape.ext + · exact houtputHead.trans (congrArg Tape.head houtputEq) + · exact houtputCells.trans (congrArg Tape.cells houtputEq)) + have hrewindTime : + (rewindWorkTM (outputProbeCleanupCaptureIdx n)).HoareTime + (fun inp work out => + inp = placedDone.input ∧ work = placedDone.work ∧ out = output) + (fun inp work out => + inp = placedDone.input ∧ work = readyWork ∧ out = output) + (querySpace + 2) := by + apply hrewindBase.consequence + · rintro inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨hplacedCaptureInvariant.1, + hplacedCaptureInvariant.2, hplacedDoneSpace.1 _, + hplacedInputParked.read_ne_start, houtput.read_ne_start, houtput.1, + ?_, rfl, rfl, (fun _ _ => rfl), rfl⟩ + intro i hi + exact ⟨(hplacedWorkParked i).read_ne_start, + (hplacedWorkParked i).1⟩ + · rintro inp work out ⟨htargetHead, hinputEq, htargetCells, + hotherEq, houtputEq⟩ + refine ⟨hinputEq, ?_, houtputEq⟩ + funext i + by_cases hi : i = outputProbeCleanupCaptureIdx n + · subst i + dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_capture_internal] + apply Tape.ext + · exact htargetHead + · exact htargetCells + · dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_ne_internal placedDone.work i hi] + exact hotherEq i hi + · exact le_rfl + have hrewind : + (rewindWorkTM (outputProbeCleanupCaptureIdx n)).HoareTimeSpace + (fun inp work out => + inp = placedDone.input ∧ work = placedDone.work ∧ out = output) + (fun inp work out => + inp = placedDone.input ∧ work = readyWork ∧ out = output) + (querySpace + 2) input.length rewindSpace := by + have hrewind' := hrewindTime.toHoareTimeSpace (inputLength := input.length) + (initialSpace := querySpace) (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact hplacedDoneSpace) + simpa [rewindSpace, outputProbeConsumeRewindSpace] using hrewind' + have hqueryLeRewind : querySpace ≤ rewindSpace := by + dsimp only [rewindSpace, outputProbeConsumeRewindSpace] + omega + have hreadyWorkParked : ∀ i, Parked (readyWork i) := by + exact outputProbeCaptureRewoundWork_parked placedDone.work + hplacedWorkParked + have hplacedTargetInvariant : ∀ i, i ∈ outputProbeCleanupTargets n → + (placedDone.work i).StartInvariant := by + intro i hi + have hmiddle := outputProbeCleanupTarget_middle i hi + simp only [placedDone, placeWorkCfg, hmiddle, dite_true] + exact hworkInvariant (placeWorkCoord 0 (n + 2) i hmiddle) + have hplacedTargetBlank : ∀ i, i ∈ outputProbeCleanupTargets n → + (placedDone.work i).BlankAfter budget := by + intro i hi + have hmiddle := outputProbeCleanupTarget_middle i hi + simp only [placedDone, placeWorkCfg, hmiddle, dite_true] + simpa only [budget, sourceSpace] using + hblank (placeWorkCoord 0 (n + 2) i hmiddle) + have hreadyTargetInvariant : ∀ i, i ∈ outputProbeCleanupTargets n → + (readyWork i).StartInvariant := by + intro i hi + by_cases hicapture : i = outputProbeCleanupCaptureIdx n + · subst i + dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_capture_internal] + exact hplacedTargetInvariant _ hi + · dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_ne_internal placedDone.work i + hicapture] + exact hplacedTargetInvariant i hi + have hreadyTargetBlank : ∀ i, i ∈ outputProbeCleanupTargets n → + (readyWork i).BlankAfter limit := by + intro i hi cell hcell + have hblankBudget : (readyWork i).BlankAfter budget := by + by_cases hicapture : i = outputProbeCleanupCaptureIdx n + · subst i + dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_capture_internal] + exact hplacedTargetBlank _ hi + · dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_ne_internal placedDone.work i + hicapture] + exact hplacedTargetBlank i hi + exact hblankBudget cell (lt_of_le_of_lt (by + simpa only [budget, sourceSpace] using hlimit) hcell) + have hcounterExtra : ¬placeWorkInMiddle 0 (n + 2) + (outputProbeCleanupCounterIdx n) := by + simp [placeWorkInMiddle, outputProbeCleanupCounterIdx] + have hlimitExtra : ¬placeWorkInMiddle 0 (n + 2) + (outputProbeCleanupLimitIdx n) := by + simp [placeWorkInMiddle, outputProbeCleanupLimitIdx] + have hcounterCapture : outputProbeCleanupCounterIdx n ≠ + outputProbeCleanupCaptureIdx n := by + intro heq + apply congrArg Fin.val at heq + simp [outputProbeCleanupCounterIdx, outputProbeCleanupCaptureIdx] at heq + have hlimitCapture : outputProbeCleanupLimitIdx n ≠ + outputProbeCleanupCaptureIdx n := by + intro heq + apply congrArg Fin.val at heq + simp [outputProbeCleanupLimitIdx, outputProbeCleanupCaptureIdx] at heq + have hreadyCounter : + (readyWork (outputProbeCleanupCounterIdx n)).HasBinaryNat 0 := by + dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_ne_internal placedDone.work _ + hcounterCapture] + dsimp only [placedDone] + rw [placeWorkCfg_work_extra queryTM 0 2 extras done _ hcounterExtra] + exact hcleanupCounter + have hreadyLimit : + (readyWork (outputProbeCleanupLimitIdx n)).HasBinaryNat limit := by + dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_ne_internal placedDone.work _ + hlimitCapture] + dsimp only [placedDone] + rw [placeWorkCfg_work_extra queryTM 0 2 extras done _ hlimitExtra] + exact hcleanupLimit + have hreadyWorkSpace : ∀ i, (readyWork i).head ≤ rewindSpace := by + intro i + by_cases hicapture : i = outputProbeCleanupCaptureIdx n + · subst i + dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_capture_internal] + exact le_trans hquerySpaceOne hqueryLeRewind + · dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_ne_internal placedDone.work i + hicapture] + exact (hplacedDoneSpace.1 i).trans hqueryLeRewind + have hreadyTargetHead : ∀ i, i ∈ outputProbeCleanupTargets n → + (readyWork i).head ≤ querySpace := by + intro i _hi + by_cases hicapture : i = outputProbeCleanupCaptureIdx n + · subst i + dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_capture_internal] + exact hquerySpaceOne + · dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_ne_internal placedDone.work i + hicapture] + exact hplacedDoneSpace.1 i + have hcleanInput : outputProbeRewoundInput placedDone.input = + cleanCfg.input := by + apply Tape.ext + · simp [outputProbeRewoundInput, cleanCfg, outputProbePlacedFrameCfg, + outputProbeStartedCfg, Tape.move] + · simp only [outputProbeRewoundInput] + have hcells : placedDone.input.cells = + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input.cells := by + simpa [placedDone, queryTM] using hinputCells + simpa [cleanCfg, outputProbePlacedFrameCfg, outputProbeStartedCfg] using + hcells + have hcleanWork : rewindBlankWorkPrefixManyResult limit readyWork + (outputProbeCleanupTargets n) = cleanCfg.work := by + have hresult := outputProbeCleanupResult_eq_frame_internal tm input + output extras done hreadyTargetInvariant hreadyTargetBlank + simpa [readyWork, placedDone, queryTM, cleanCfg] using hresult + have hcleanupRaw := outputProbeCleanupTM_hoareTimeSpace_frame n + (input.length + querySpace + 1) limit input.length rewindSpace + (fun _ => querySpace) placedDone.input readyWork output + hplacedInputInvariant hplacedInputParked hplacedDoneSpace.2 + hreadyWorkParked hreadyTargetInvariant hreadyTargetHead hreadyCounter + hreadyLimit houtput hreadyWorkSpace + (hplacedDoneSpace.2.trans (by omega)) + have hcleanup : (outputProbeCleanupTM n).HoareTimeSpace + (fun inp work out => + inp = placedDone.input ∧ work = readyWork ∧ out = output) + (fun inp work out => + inp = cleanCfg.input ∧ work = cleanCfg.work ∧ out = output) + (outputProbeCleanupTime n (input.length + querySpace + 1) limit + (fun _ => querySpace)) input.length cleanupSpace := by + apply hcleanupRaw.consequence + · intro inp work out hpre + exact hpre + · rintro inp work out ⟨hinputEq, hworkEq, houtputEq⟩ + exact ⟨hinputEq.trans hcleanInput, hworkEq.trans hcleanWork, + houtputEq⟩ + · exact le_rfl + · exact le_rfl + · simp [cleanupSpace, rewindSpace, querySpace, + outputProbeConsumeCleanupSpace] + have hcleanInputParked : Parked cleanCfg.input := by + rw [← hcleanInput] + exact parked_rewoundInput placedDone.input hplacedInputInvariant + have hcleanWorkParked : ∀ i, Parked (cleanCfg.work i) := by + rw [← hcleanWork] + exact rewindBlankWorkPrefixManyResult_parked limit readyWork + (outputProbeCleanupTargets n) hreadyWorkParked + have hcleanupTransition : ∀ inp work out, + (inp = cleanCfg.input ∧ work = cleanCfg.work ∧ out = output) → + transitionInput inp = cleanCfg.input ∧ + (fun i => transitionTape (work i)) = cleanCfg.work ∧ + transitionTape out = output := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hcleanInputParked.transitionInput_eq_self, + funext fun i => (hcleanWorkParked i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + have hzeroClean : onZero.HoareTimeSpace + (fun inp work out => + inp = cleanCfg.input ∧ work = cleanCfg.work ∧ out = output) + (post false) zeroTime input.length zeroSpace := by + simpa only [cleanCfg] using hzero + have honeClean : onOne.HoareTimeSpace + (fun inp work out => + inp = cleanCfg.input ∧ work = cleanCfg.work ∧ out = output) + (post true) oneTime input.length oneSpace := by + simpa only [cleanCfg] using hone + have hcleanupZero := seqTM_hoareTimeSpace (outputProbeCleanupTM n) + onZero hcleanup hcleanupTransition hzeroClean + have hcleanupOne := seqTM_hoareTimeSpace (outputProbeCleanupTM n) + onOne hcleanup hcleanupTransition honeClean + have hreadyRead : + (readyWork (outputProbeCleanupCaptureIdx n)).read = Γ.ofBool bit := by + have hcell := hcaptured.1 0 (by simp) + dsimp only [readyWork] + rw [outputProbeCaptureRewoundWork_capture_internal] + simpa [Tape.read] using hcell + have hreadyTransition : ∀ inp work out, + (inp = placedDone.input ∧ work = readyWork ∧ out = output) → + transitionInput inp = placedDone.input ∧ + (fun i => transitionTape (work i)) = readyWork ∧ + transitionTape out = output := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hplacedInputParked.transitionInput_eq_self, + funext fun i => (hreadyWorkParked i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + have hqueryTransition : ∀ inp work out, + (inp = placedDone.input ∧ work = placedDone.work ∧ + out = output) → + transitionInput inp = placedDone.input ∧ + (fun i => transitionTape (work i)) = placedDone.work ∧ + transitionTape out = output := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hplacedInputParked.transitionInput_eq_self, + funext fun i => (hplacedWorkParked i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + cases hbit : bit with + | false => + have hdifferent : ∀ inp work out, + (inp = placedDone.input ∧ work = readyWork ∧ out = output) → + (work (outputProbeCleanupCaptureIdx n)).read ≠ Γ.one := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + rw [hbit] at hreadyRead + intro heq + rw [heq] at hreadyRead + simp [Γ.ofBool] at hreadyRead + have hbranch := branchWorkSymbolTM_hoareTimeSpace_different + (outputProbeCleanupCaptureIdx n) Γ.one + (seqTM (outputProbeCleanupTM n) onOne) + (seqTM (outputProbeCleanupTM n) onZero) + hdifferent + (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact hplacedInputParked.read_ne_start) + (by + rintro inp work out ⟨rfl, rfl, rfl⟩ i + exact (hreadyWorkParked i).read_ne_start) + (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact houtput.read_ne_start) + hcleanupZero + have htail := seqTM_hoareTimeSpace + (rewindWorkTM (outputProbeCleanupCaptureIdx n)) + (branchWorkSymbolTM (outputProbeCleanupCaptureIdx n) Γ.one + (seqTM (outputProbeCleanupTM n) onOne) + (seqTM (outputProbeCleanupTM n) onZero)) + hrewind hreadyTransition hbranch + have hall := seqTM_hoareTimeSpace (outputProbePlacedTM tm) + (seqTM (rewindWorkTM (outputProbeCleanupCaptureIdx n)) + (branchWorkSymbolTM (outputProbeCleanupCaptureIdx n) Γ.one + (seqTM (outputProbeCleanupTM n) onOne) + (seqTM (outputProbeCleanupTM n) onZero))) + hquery hqueryTransition htail + refine ⟨probeSteps + 1 + (querySpace + 2 + 1 + + (outputProbeCleanupTime n (input.length + querySpace + 1) limit + (fun _ => querySpace) + 1 + zeroTime + 1)), ?_⟩ + simpa [outputProbeConsumeTM, outputProbeConsumeSpace, hbit, + querySpace, rewindSpace, cleanupSpace, continuationSpace] using hall + | true => + have hequal : ∀ inp work out, + (inp = placedDone.input ∧ work = readyWork ∧ out = output) → + (work (outputProbeCleanupCaptureIdx n)).read = Γ.one := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + rw [hbit] at hreadyRead + simpa using hreadyRead + have hbranch := branchWorkSymbolTM_hoareTimeSpace_equal + (outputProbeCleanupCaptureIdx n) Γ.one + (seqTM (outputProbeCleanupTM n) onOne) + (seqTM (outputProbeCleanupTM n) onZero) + hequal + (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact hplacedInputParked.read_ne_start) + (by + rintro inp work out ⟨rfl, rfl, rfl⟩ i + exact (hreadyWorkParked i).read_ne_start) + (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact houtput.read_ne_start) + hcleanupOne + have htail := seqTM_hoareTimeSpace + (rewindWorkTM (outputProbeCleanupCaptureIdx n)) + (branchWorkSymbolTM (outputProbeCleanupCaptureIdx n) Γ.one + (seqTM (outputProbeCleanupTM n) onOne) + (seqTM (outputProbeCleanupTM n) onZero)) + hrewind hreadyTransition hbranch + have hall := seqTM_hoareTimeSpace (outputProbePlacedTM tm) + (seqTM (rewindWorkTM (outputProbeCleanupCaptureIdx n)) + (branchWorkSymbolTM (outputProbeCleanupCaptureIdx n) Γ.one + (seqTM (outputProbeCleanupTM n) onOne) + (seqTM (outputProbeCleanupTM n) onZero))) + hquery hqueryTransition htail + refine ⟨probeSteps + 1 + (querySpace + 2 + 1 + + (outputProbeCleanupTime n (input.length + querySpace + 1) limit + (fun _ => querySpace) + 1 + oneTime + 1)), ?_⟩ + simpa [outputProbeConsumeTM, outputProbeConsumeSpace, hbit, + querySpace, rewindSpace, cleanupSpace, continuationSpace] using hall + +theorem ComputesInSpace.outputProbeConsumeTM_hoareTimeSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (onZero onOne : TM (outputProbeControllerTapes n)) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + {post : Bool → TapePred (outputProbeControllerTapes n)} + {zeroTime oneTime zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post false) zeroTime input.length zeroSpace) + (hone : onOne.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post true) oneTime input.length oneSpace) : + ∃ consumeTime, + (outputProbeConsumeTM tm onZero onOne).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (post ((f input)[index]'hindex)) consumeTime input.length + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (if (f input)[index]'hindex then oneSpace else zeroSpace)) := by + have hextraRead : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).read ≠ Γ.start := by + intro i hi + exact (hextras i hi).read_ne_start + have hqueryResult := + hcomp.outputProbePlacedTM_hoareTimeSpace_frame_internal input index + hindex output houtput extras frameSpace hextraRead hframe + exact hcomp.outputProbeConsumeTM_hoareTimeSpace_bit_internal onZero onOne + input index ((f input)[index]'hindex) output houtput extras frameSpace + limit hextras hframe hcleanupCounter hcleanupLimit hlimit hqueryResult + hzero hone + +theorem + ComputesInSpace.outputProbeConsumeTM_index_halts_hoareTimeSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (onZero onOne : TM (outputProbeControllerTapes n)) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + {post : Bool → TapePred (outputProbeControllerTapes n)} + {zeroTime oneTime zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post false) zeroTime input.length zeroSpace) + (hone : onOne.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post true) oneTime input.length oneSpace) : + ∃ bit consumeTime, + (outputProbeConsumeTM tm onZero onOne).HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output) + (post bit) consumeTime input.length + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit (if bit then oneSpace else zeroSpace)) := by + have hextraRead : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).read ≠ Γ.start := by + intro i hi + exact (hextras i hi).read_ne_start + obtain ⟨probeSteps, done, bit, hquery⟩ := + hcomp.outputProbePlacedTM_index_halts_hoareTimeSpace_frame_internal + input index output houtput extras frameSpace hextraRead hframe + obtain ⟨consumeTime, hconsume⟩ := + hcomp.outputProbeConsumeTM_hoareTimeSpace_bit_internal onZero onOne + input index bit output houtput extras frameSpace limit hextras hframe + hcleanupCounter hcleanupLimit hlimit ⟨probeSteps, done, hquery⟩ hzero hone + exact ⟨bit, consumeTime, hconsume⟩ + +theorem + ComputesInSpace.outputProbeConsumeTM_index_halts_hoareTimeSpace_frame_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (onZero onOne : TM (outputProbeControllerTapes n)) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + {post : Bool → TapePred (outputProbeControllerTapes n)} + {zeroTime oneTime zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post false) zeroTime input.length zeroSpace) + (hone : onOne.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post true) oneTime input.length oneSpace) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) : + ∃ bit consumeTime, + (placeWorkTM 0 controllerTapes + (outputProbeConsumeTM tm onZero onOne)).HoareTimeSpace + (placeWorkPred (outputProbeConsumeTM tm onZero onOne) 0 + controllerTapes outerExtras + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output)) + (placeWorkPred (outputProbeConsumeTM tm onZero onOne) 0 + controllerTapes outerExtras (post bit)) + consumeTime input.length + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit (if bit then oneSpace else zeroSpace)) + outerFrameSpace) := by + obtain ⟨bit, consumeTime, hconsume⟩ := + hcomp.outputProbeConsumeTM_index_halts_hoareTimeSpace_internal + onZero onOne input index output houtput extras frameSpace limit hextras + hframe hcleanupCounter hcleanupLimit hlimit hzero hone + refine ⟨bit, consumeTime, ?_⟩ + exact placeWorkTM_hoareTimeSpace_frame_internal + (outputProbeConsumeTM tm onZero onOne) 0 controllerTapes outerExtras + hconsume houterRead houterFrame + +theorem ComputesInSpace.outputProbeConsumeTM_hoareTimeSpace_frame_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (onZero onOne : TM (outputProbeControllerTapes n)) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + {post : Bool → TapePred (outputProbeControllerTapes n)} + {zeroTime oneTime zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post false) zeroTime input.length zeroSpace) + (hone : onOne.HoareTimeSpace + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work ∧ + out = output) + (post true) oneTime input.length oneSpace) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) : + ∃ consumeTime, + (placeWorkTM 0 controllerTapes + (outputProbeConsumeTM tm onZero onOne)).HoareTimeSpace + (placeWorkPred (outputProbeConsumeTM tm onZero onOne) 0 + controllerTapes outerExtras + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output)) + (placeWorkPred (outputProbeConsumeTM tm onZero onOne) 0 + controllerTapes outerExtras (post ((f input)[index]'hindex))) + consumeTime input.length + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (if (f input)[index]'hindex then oneSpace else zeroSpace)) + outerFrameSpace) := by + obtain ⟨consumeTime, hconsume⟩ := + hcomp.outputProbeConsumeTM_hoareTimeSpace_internal onZero onOne input + index hindex output houtput extras frameSpace limit hextras hframe + hcleanupCounter hcleanupLimit hlimit hzero hone + refine ⟨consumeTime, ?_⟩ + exact placeWorkTM_hoareTimeSpace_frame_internal + (outputProbeConsumeTM tm onZero onOne) 0 controllerTapes outerExtras + hconsume houterRead houterFrame + +theorem outputProbePlacedTM_isTransducer_internal (tm : TM n) : + (outputProbePlacedTM tm).IsTransducer := by + exact ((outputProbeStartedTM tm).retargetOutput_isTransducer).placeWorkTM 0 2 + +theorem IsTransducer.outputProbeConsumeTM_internal + {tm : TM n} + {onZero onOne : TM (outputProbeControllerTapes n)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeConsumeTM tm onZero onOne).IsTransducer := by + unfold outputProbeConsumeTM + apply IsTransducer.seqTM + · exact outputProbePlacedTM_isTransducer_internal tm + apply IsTransducer.seqTM + · exact rewindWorkTM_isTransducer _ + apply IsTransducer.branchWorkSymbolTM + · exact (outputProbeCleanupTM_isTransducer _).seqTM hone + · exact (outputProbeCleanupTM_isTransducer _).seqTM hzero + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeCountOnes.lean b/Complexitylib/Models/TuringMachine/OutputProbeCountOnes.lean new file mode 100644 index 00000000..e244dba8 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeCountOnes.lean @@ -0,0 +1,567 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeCountOnes.Defs +import Complexitylib.Models.TuringMachine.OutputProbeCountOnes.Internal + +/-! +# Counting one bits through dynamically indexed output probes + +This module certifies the Boolean continuations used by an occupancy-counting +scan. Both branches start with the physical query latch reset to zero. The +zero branch preserves the complete controller frame; the one branch increments +one canonical binary count register and updates only that register. +-/ + +namespace Complexity + +namespace TM + +/-- Extending a valid prefix by one position adds exactly the queried bit to +the running one count. -/ +theorem outputProbePrefixOnes_succ (bits : List Bool) + (address : ℕ) (haddress : address < bits.length) : + outputProbePrefixOnes bits (address + 1) = + outputProbePrefixOnes bits address + + if bits[address]'haddress then 1 else 0 := + outputProbePrefixOnes_succ_internal bits address haddress + +/-- Taking the full prefix recovers the total number of true bits. -/ +theorem outputProbePrefixOnes_all (bits : List Bool) : + outputProbePrefixOnes bits bits.length = bits.count true := + outputProbePrefixOnes_all_internal bits + +/-- Controller registers other than the address and count retain their base +outer-frame tapes throughout the prefix-count invariant. -/ +theorem outputProbeCountOnesOuterExtrasAt_other + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx idx : Fin controllerTapes} + (haddress : idx ≠ addressIdx) (hcount : idx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) : + outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := + outputProbeCountOnesOuterExtrasAt_other_internal n haddress hcount + outerExtras bits address + +/-- Updating the canonical address and prefix-count registers preserves a +parked outer controller frame. -/ +theorem outputProbeCountOnesOuterExtrasAt_parked + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (bits : List Bool) (address : ℕ) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx + outerExtras bits address i) := + outputProbeCountOnesOuterExtrasAt_parked_internal n outerExtras houter bits + address + +/-- The canonical count-ones frame realizes its exact restored latch and +prefix-count tape predicate. -/ +theorem outputProbeCountOnesFrameCfg_post + (tm : TM n) (controllerTapes : ℕ) + (addressIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (address : ℕ) : + outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address) + input output extras false + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).output := + outputProbeCountOnesFrameCfg_post_internal tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address + +/-- The halted canonical scan frame exposes the exact one count of the +processed prefix in the designated count register. -/ +theorem outputProbeCountOnesDoneCfg_count + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (limitValue : ℕ) : + ((outputProbeCountOnesDoneCfg tm controllerTapes addressIdx scratchIdx + limitIdx countIdx outerExtras bits input output extras limitValue).work + (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + (outputProbePrefixOnes bits limitValue) := + outputProbeCountOnesDoneCfg_count_internal tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras + limitValue + +/-- The canonical scan frame stores the running prefix count in the designated +controller register. -/ +theorem outputProbeCountOnesOuterExtrasAt_count + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) : + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address + (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + (outputProbePrefixOnes bits address) := + outputProbeCountOnesOuterExtrasAt_count_internal n outerExtras bits address + +/-- The canonical scan frame stores the current address in the designated +controller register. -/ +theorem outputProbeCountOnesOuterExtrasAt_address + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (hne : addressIdx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) : + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address + (outputProbeIndexedControllerIdx n addressIdx)).HasBinaryNat address := + outputProbeCountOnesOuterExtrasAt_address_internal n hne outerExtras bits + address + +/-- Conditional count dispatch updates the outer frame to the next prefix +count while leaving the current address unchanged. -/ +theorem outputProbeCountOnesOuterExtrasAfter_eq + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) (haddress : address < bits.length) : + outputProbeCountOnesOuterExtrasAfter n countIdx + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras + bits address) + (outputProbePrefixOnes bits address) (bits[address]'haddress) = + Function.update + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras + bits address) + (outputProbeIndexedControllerIdx n countIdx) + (outputProbeCounterTape (outputProbePrefixOnes bits (address + 1))) := + outputProbeCountOnesOuterExtrasAfter_eq_internal n outerExtras bits address + haddress + +/-- After count dispatch and the loop's address successor, the complete outer +frame is exactly the canonical next-prefix frame. -/ +theorem outputProbeCountOnesOuterExtrasAt_succ + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (hne : addressIdx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) (haddress : address < bits.length) : + Function.update + (outputProbeCountOnesOuterExtrasAfter n countIdx + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras + bits address) + (outputProbePrefixOnes bits address) (bits[address]'haddress)) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeCounterTape (address + 1)) = + outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + (address + 1) := + outputProbeCountOnesOuterExtrasAt_succ_internal n hne outerExtras bits + address haddress + +/-- Package bounded composite-iteration witnesses into a count-ones scan +certificate whose configurations expose the exact prefix-count invariant. + +The comparison, loopback, and final equality phases are discharged here; +clients only provide the source-dependent query/count iterations. -/ +noncomputable def outputProbeCountOnesSegmentSpecOfIterationWitnesses + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (haddressLimit : addressIdx ≠ limitIdx) + (haddressCount : addressIdx ≠ countIdx) + (hcountLimit : countIdx ≠ limitIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (bodyTime : ℕ → ℕ) (startValue limitValue : ℕ) + (hlimit : + (outerExtras (outputProbeIndexedControllerIdx n limitIdx)).HasBinaryNat + limitValue) + (iterationWitness : ∀ value, startValue ≤ value → value < limitValue → + ∃ time, time ≤ binaryForIterationTime bodyTime value ∧ + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx + limitIdx countIdx).reachesIn time + (outputProbeCountOnesIterationStartCfg tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras + value) + (outputProbeCountOnesIterationDoneCfg tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras + value)) : + BinaryForSegmentSpec + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue := + outputProbeCountOnesSegmentSpecOfIterationWitnessesInternal tm + controllerTapes addressIdx scratchIdx limitIdx countIdx haddressLimit + haddressCount hcountLimit outerExtras bits input output extras hextras + houter houtput bodyTime startValue limitValue hlimit iterationWitness + +/-- Build the same exact prefix-count scan certificate from bounded Hoare +witnesses for the query/count body. + +This constructor closes the body-to-successor seam and leaves clients only +the source-specific task of supplying each valid-address body contract. -/ +noncomputable def outputProbeCountOnesSegmentSpecOfBodyWitnesses + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (haddressLimit : addressIdx ≠ limitIdx) + (haddressCount : addressIdx ≠ countIdx) + (hcountLimit : countIdx ≠ limitIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (bodyTime : ℕ → ℕ) (startValue limitValue : ℕ) + (hlimitBits : limitValue ≤ bits.length) + (hlimit : + (outerExtras (outputProbeIndexedControllerIdx n limitIdx)).HasBinaryNat + limitValue) + (bodyWitness : ∀ value, startValue ≤ value → value < limitValue → + (hvalueBits : value < bits.length) → + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + bodyBound ≤ bodyTime value ∧ + pre + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras value).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras value).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras value).output ∧ + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx + outerExtras bits value) + (outputProbePrefixOnes bits value) (bits[value]'hvalueBits)) + input output extras false) + bodyBound) : + BinaryForSegmentSpec + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue := + outputProbeCountOnesSegmentSpecOfBodyWitnessesInternal tm + controllerTapes addressIdx scratchIdx limitIdx countIdx haddressLimit + haddressCount hcountLimit outerExtras bits input output extras hextras + houter houtput bodyTime startValue limitValue hlimitBits hlimit bodyWitness + +/-- The zero continuation preserves the complete reset-latch controller frame. -/ +theorem outputProbeCountOnes_zero_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (countIdx : Fin controllerTapes) (count inputLength initialSpace : ℕ) + (hinitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).Q).WithinAuxSpace inputLength initialSpace) : + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + false) + input output extras false) + 1 inputLength (initialSpace + 1) := + outputProbeCountOnes_zero_hoareTimeSpace_internal tm controllerTapes + outerExtras input output extras hextras houter houtput countIdx count + inputLength initialSpace hinitial + +/-- The one continuation increments exactly the designated canonical binary +count and preserves every other tape in the reset-latch controller frame. -/ +theorem outputProbeCountOnes_one_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (countIdx : Fin controllerTapes) (count inputLength initialSpace : ℕ) + (hcount : + (outerExtras (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + count) + (hinitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).Q).WithinAuxSpace + inputLength initialSpace) : + (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count true) + input output extras false) + (binarySuccTime count) inputLength + (initialSpace + binarySuccTime count) := + outputProbeCountOnes_one_hoareTimeSpace_internal tm controllerTapes + outerExtras input output extras hextras houter houtput countIdx count + inputLength initialSpace hcount hinitial + +/-- A certified dynamic latch phase composes with reset-and-count dispatch. +The resulting body preserves the reset latch and updates only the count frame +when the queried bit is true. -/ +theorem outputProbeCountOnesBodyTM_of_latch_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (count : ℕ) + (hcount : + (outerExtras (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + count) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace inputLength clearInitialSpace zeroInitialSpace + oneInitialSpace : ℕ} + (hlatch : (outputProbeIndexedLatchTM tm controllerTapes addressIdx + scratchIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + latchTime inputLength latchSpace) + (hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength clearInitialSpace) + (hzeroInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).Q).WithinAuxSpace inputLength + zeroInitialSpace) + (honeInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).Q).WithinAuxSpace + inputLength oneInitialSpace) : + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false) + (latchTime + 1 + + outputProbeLatchDispatchTime bit 1 + (clearWorkTimeBound 1 + 1 + binarySuccTime count)) + inputLength + (max latchSpace + (if bit then + max (clearInitialSpace + clearWorkTimeBound 1) + (oneInitialSpace + binarySuccTime count) + else zeroInitialSpace + 1)) := + outputProbeCountOnesBodyTM_of_latch_hoareTimeSpace_internal tm + controllerTapes addressIdx scratchIdx countIdx outerExtras input output + extras bit hextras houter houtput count hcount hlatch hclearInitial + hzeroInitial honeInitial + +/-- Build one exact query/reset/count body contract directly from a +space-bounded source transducer and a canonical restored latch frame. + +All finite head maxima needed by the lower-level space contracts are chosen +internally. The caller supplies only the stable cleanup/controller invariants +and the cleanup limit needed for this query address. -/ +theorem ComputesInSpace.outputProbeCountOnesBodyTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (address : ℕ) (haddress : address < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (address + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (addressIdx scratchIdx countIdx : Fin controllerTapes) + (haddressScratch : addressIdx ≠ scratchIdx) + (hsource : + (outerExtras (outputProbeIndexedControllerIdx n addressIdx)) + |>.HasBinaryNat address) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (count : ℕ) + (hcount : + (outerExtras (outputProbeIndexedControllerIdx n countIdx)) + |>.HasBinaryNat count) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + ((f input)[address]'haddress)) + input output extras false) + bodyBound := + hcomp.outputProbeCountOnesBodyTM_hoareTime_internal input address haddress + output houtput extras hextras hcleanupCounter cleanupLimit hcleanupLimit + hlimit controllerTapes outerExtras houter addressIdx scratchIdx countIdx + haddressScratch hsource hscratch count hcount + +/-- Derive a complete exact-prefix count scan from the source transducer's +`ComputesInSpace` contract. + +Per-address runtimes are selected noncomputably from the deterministic source +runs. The returned segment certificate fixes every comparison, iteration, and +halted frame; no caller-supplied latch or body witnesses remain. -/ +noncomputable def ComputesInSpace.outputProbeCountOnesSegmentSpec + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (haddressLimit : addressIdx ≠ limitIdx) + (haddressCount : addressIdx ≠ countIdx) + (hcountLimit : countIdx ≠ limitIdx) + (haddressScratch : addressIdx ≠ scratchIdx) + (hscratchAddress : scratchIdx ≠ addressIdx) + (hscratchCount : scratchIdx ≠ countIdx) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (startValue limitValue : ℕ) + (hlimitBits : limitValue ≤ (f input).length) + (hlimitRegister : + (outerExtras (outputProbeIndexedControllerIdx n limitIdx)) + |>.HasBinaryNat limitValue) + (hqueryLimit : ∀ value, startValue ≤ value → value < limitValue → + outputProbeCaptureSpace (max 1 (space input.length)) (value + 1) ≤ + cleanupLimit) : + Σ bodyTime : ℕ → ℕ, + BinaryForSegmentSpec + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue := + hcomp.outputProbeCountOnesSegmentSpecInternal input output houtput extras + hextras hcleanupCounter cleanupLimit hcleanupLimit controllerTapes + outerExtras houter addressIdx scratchIdx limitIdx countIdx haddressLimit + haddressCount hcountLimit haddressScratch hscratchAddress hscratchCount + hscratch startValue limitValue hlimitBits hlimitRegister hqueryLimit + +/-- Counting queried one bits preserves one-way output safety. -/ +theorem outputProbeCountOnesTM_isTransducer + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) : + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx limitIdx + countIdx).IsTransducer := + IsTransducer.outputProbeCountOnesTM_internal + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeCountOnes/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeCountOnes/Defs.lean new file mode 100644 index 00000000..1ab7b1d7 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeCountOnes/Defs.lean @@ -0,0 +1,172 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeScan.Defs +import Complexitylib.Models.TuringMachine.Registers.RegisterOps +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs + +/-! +# Counting one bits through dynamically indexed output probes -- definitions + +The serializer's first pass scans an oracle-defined occupancy bit at every +fixed address and counts the true results. This module supplies the generic +machine layer: zero leaves a canonical binary count unchanged, while one +increments it before the enclosing probe scan advances its address. +-/ + +namespace Complexity + +namespace TM + +/-- Number of true bits in the first `count` source positions. -/ +def outputProbePrefixOnes (bits : List Bool) (count : ℕ) : ℕ := + (bits.take count).count true + +/-- Stable outer controller frame after processing one queried bit. -/ +def outputProbeCountOnesOuterExtrasAfter (n : ℕ) + {controllerTapes : ℕ} (countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (count : ℕ) (bit : Bool) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + if bit then + Function.update outerExtras + (outputProbeIndexedControllerIdx n countIdx) + (outputProbeCounterTape (count + 1)) + else + outerExtras + +/-- Canonical address/count controller frame after processing exactly +`address` source positions. -/ +def outputProbeCountOnesOuterExtrasAt (n : ℕ) + {controllerTapes : ℕ} (addressIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + Function.update + (Function.update outerExtras + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeCounterTape address)) + (outputProbeIndexedControllerIdx n countIdx) + (outputProbeCounterTape (outputProbePrefixOnes bits address)) + +/-- One occupancy-counting iteration before the enclosing loop increments its +address: query, reset the latch, and conditionally increment the count. -/ +def outputProbeCountOnesBodyTM (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx countIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeIndexedResetDispatchTM tm controllerTapes addressIdx scratchIdx + skipTM (binarySuccTM (outputProbeIndexedControllerIdx n countIdx)) + +/-- Scan consecutive source-output bits and count the ones in a canonical +binary controller register. -/ +def outputProbeCountOnesTM (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + binaryForTM + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + +/-- Canonical restored latch frame after exactly `address` source bits have +been counted. -/ +def outputProbeCountOnesFrameCfg (tm : TM n) (controllerTapes : ℕ) + (addressIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (address : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeLatchTM tm controllerTapes).Q := + outputProbeLatchFrameCfg tm controllerTapes + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address) + input output extras false + +/-- Canonical outer-loop comparison configuration after counting a prefix. -/ +def outputProbeCountOnesScanCfg (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (address : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx + limitIdx countIdx).Q := + let frame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address + { state := .inl (.scan true) + input := frame.input + work := frame.work + output := frame.output } + +/-- Canonical entry to the query/count body at one source address. -/ +def outputProbeCountOnesIterationStartCfg (tm : TM n) + (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (address : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx + limitIdx countIdx).Q := + let frame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address + { state := .inr + (binaryForIterationTM + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx)).qstart + input := frame.input + work := frame.work + output := frame.output } + +/-- Canonical iteration endpoint after the body and address successor have +established the next prefix-count invariant. -/ +def outputProbeCountOnesIterationDoneCfg (tm : TM n) + (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (address : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx + limitIdx countIdx).Q := + let frame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras (address + 1) + { state := .inr + (binaryForIterationTM + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx)).qhalt + input := frame.input + work := frame.work + output := frame.output } + +/-- Canonical halted scan configuration after the entire source prefix has +been counted. -/ +def outputProbeCountOnesDoneCfg (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (limit : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx + limitIdx countIdx).Q := + let frame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras limit + { state := .inl .done + input := frame.input + work := frame.work + output := frame.output } + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeCountOnes/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeCountOnes/Internal.lean new file mode 100644 index 00000000..c0adca6d --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeCountOnes/Internal.lean @@ -0,0 +1,1416 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Hoare.Space +import Complexitylib.Models.TuringMachine.OutputProbeCountOnes.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDispatch +import Complexitylib.Models.TuringMachine.OutputProbeIndexed +import Complexitylib.Models.TuringMachine.OutputProbeScan.Internal +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Counting one bits through dynamically indexed output probes -- internals +-/ + +namespace Complexity + +namespace TM + +private theorem skipTM_isTransducer_internal {n : ℕ} : + (skipTM (n := n)).IsTransducer := by + intro state _iHead _wHeads oHead + cases state <;> cases oHead <;> simp [skipTM, idleDir] + +private theorem outputProbeCountOnesHasBinaryNat_parked_internal + {t : Tape} {value : ℕ} (h : t.HasBinaryNat value) : Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem outputProbeCountOnesBinarySuccCanonical_reachesIn_internal + (idx : Fin n) (value : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hvalue : (work idx).HasBinaryNat value) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hout : Parked out) : + (binarySuccTM idx).reachesIn (binarySuccTime value) + { state := (binarySuccTM idx).qstart + input := inp + work := work + output := out } + { state := (binarySuccTM idx).qhalt + input := inp + work := Function.update work idx + (outputProbeCounterTape (value + 1)) + output := out } := by + obtain ⟨c', hreach, hhalt, hinput, hother, htarget, houtput⟩ := + binarySuccTM_reachesIn_frame idx value inp work out hvalue + hinp.read_ne_start (fun i _ => (hwork i).read_ne_start) + hout.read_ne_start + have hworkEq : c'.work = Function.update work idx + (outputProbeCounterTape (value + 1)) := by + funext i + by_cases hi : i = idx + · subst i + simp only [Function.update_self] + simpa [outputProbeCounterTape] using htarget.eq_init_move_right + · rw [Function.update_of_ne hi, hother i hi] + have hc' : c' = + { state := (binarySuccTM idx).qhalt + input := inp + work := Function.update work idx + (outputProbeCounterTape (value + 1)) + output := out } := + Cfg.ext hhalt hinput hworkEq houtput + simpa [hc'] using hreach + +theorem outputProbePrefixOnes_succ_internal (bits : List Bool) + (address : ℕ) (haddress : address < bits.length) : + outputProbePrefixOnes bits (address + 1) = + outputProbePrefixOnes bits address + + if bits[address]'haddress then 1 else 0 := by + rw [outputProbePrefixOnes, outputProbePrefixOnes, + List.take_succ_eq_append_getElem haddress, List.count_append] + by_cases hbit : bits[address]'haddress + · simp [hbit] + · simp [hbit] + +theorem outputProbePrefixOnes_all_internal (bits : List Bool) : + outputProbePrefixOnes bits bits.length = bits.count true := by + simp [outputProbePrefixOnes] + +theorem outputProbeCountOnesOuterExtrasAt_count_internal + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) : + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address + (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + (outputProbePrefixOnes bits address) := by + simp only [outputProbeCountOnesOuterExtrasAt, Function.update_self] + exact Tape.init_move_right_hasBinaryNat _ + +theorem outputProbeCountOnesOuterExtrasAt_address_internal + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (hne : addressIdx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) : + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address + (outputProbeIndexedControllerIdx n addressIdx)).HasBinaryNat + address := by + rw [outputProbeCountOnesOuterExtrasAt, Function.update_of_ne] + · rw [Function.update_self] + exact Tape.init_move_right_hasBinaryNat address + · exact outputProbeScan_address_ne_limit_internal n hne + +theorem outputProbeCountOnesOuterExtrasAt_other_internal + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx idx : Fin controllerTapes} + (haddress : idx ≠ addressIdx) (hcount : idx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) : + outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := by + rw [outputProbeCountOnesOuterExtrasAt, Function.update_of_ne, + Function.update_of_ne] + · exact fun heq => haddress + (outputProbeIndexedControllerIdx_injective_internal n heq) + · exact fun heq => hcount + (outputProbeIndexedControllerIdx_injective_internal n heq) + +theorem outputProbeCountOnesOuterExtrasAt_parked_internal + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (bits : List Bool) (address : ℕ) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx + outerExtras bits address i) := by + intro i hi + by_cases hcount : + i = outputProbeIndexedControllerIdx n countIdx + · subst i + simp only [outputProbeCountOnesOuterExtrasAt, Function.update_self] + exact outputProbeCountOnesHasBinaryNat_parked_internal + (Tape.init_move_right_hasBinaryNat _) + · rw [outputProbeCountOnesOuterExtrasAt, Function.update_of_ne hcount] + by_cases haddress : + i = outputProbeIndexedControllerIdx n addressIdx + · subst i + simp only [Function.update_self] + exact outputProbeCountOnesHasBinaryNat_parked_internal + (Tape.init_move_right_hasBinaryNat _) + · rw [Function.update_of_ne haddress] + exact houter i hi + +theorem outputProbeCountOnesOuterExtrasAfter_parked_internal + (n : ℕ) {controllerTapes : ℕ} + (countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (count : ℕ) (bit : Bool) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras + count bit i) := by + intro i hi + by_cases hbit : bit + · simp only [outputProbeCountOnesOuterExtrasAfter, hbit, if_true] + by_cases hcount : i = outputProbeIndexedControllerIdx n countIdx + · subst i + simp only [Function.update_self] + exact outputProbeCountOnesHasBinaryNat_parked_internal + (Tape.init_move_right_hasBinaryNat _) + · rw [Function.update_of_ne hcount] + exact houter i hi + · simpa [outputProbeCountOnesOuterExtrasAfter, hbit] using houter i hi + +theorem outputProbeCountOnesOuterExtrasAfter_address_internal + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (hne : addressIdx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) (bit : Bool) : + (outputProbeCountOnesOuterExtrasAfter n countIdx + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address) + (outputProbePrefixOnes bits address) bit + (outputProbeIndexedControllerIdx n addressIdx)).HasBinaryNat address := by + by_cases hbit : bit + · rw [outputProbeCountOnesOuterExtrasAfter, if_pos hbit, + Function.update_of_ne] + · exact outputProbeCountOnesOuterExtrasAt_address_internal n hne + outerExtras bits address + · exact outputProbeScan_address_ne_limit_internal n hne + · rw [outputProbeCountOnesOuterExtrasAfter, if_neg hbit] + exact outputProbeCountOnesOuterExtrasAt_address_internal n hne outerExtras + bits address + +theorem outputProbeCountOnesFrameCfg_post_internal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (address : ℕ) : + outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address) + input output extras false + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).output := by + exact outputProbeLatchFrameCfg_post tm controllerTapes + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address) + input output extras false + +theorem outputProbeCountOnesFrameCfg_address_internal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx countIdx : Fin controllerTapes) + (hne : addressIdx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (address : ℕ) : + ((outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work + (outputProbeIndexedControllerIdx n addressIdx)).HasBinaryNat address := by + rw [outputProbeLatchFramePost_controller tm controllerTapes + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address) + input output extras false + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).output + (outputProbeCountOnesFrameCfg_post_internal tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address) + addressIdx] + exact outputProbeCountOnesOuterExtrasAt_address_internal n hne outerExtras + bits address + +theorem outputProbeCountOnesFrameCfg_other_internal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx countIdx idx : Fin controllerTapes) + (haddress : idx ≠ addressIdx) (hcount : idx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (address : ℕ) : + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work + (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := by + rw [outputProbeLatchFramePost_controller tm controllerTapes + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address) + input output extras false + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).output + (outputProbeCountOnesFrameCfg_post_internal tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address) + idx] + exact outputProbeCountOnesOuterExtrasAt_other_internal n haddress hcount + outerExtras bits address + +theorem outputProbeCountOnesFrameCfg_parked_internal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houtput : Parked output) (address : ℕ) : + Parked (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address).input ∧ + (∀ i, Parked + ((outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work i)) ∧ + Parked (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address).output := by + exact outputProbeLatchFramePost_parked tm controllerTapes + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + address) + input output extras false hextras + (outputProbeCountOnesOuterExtrasAt_parked_internal n outerExtras houter bits + address) + houtput + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).output + (outputProbeCountOnesFrameCfg_post_internal tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address) + +theorem outputProbeCountOnesDoneCfg_count_internal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (limitValue : ℕ) : + ((outputProbeCountOnesDoneCfg tm controllerTapes addressIdx scratchIdx + limitIdx countIdx outerExtras bits input output extras limitValue).work + (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + (outputProbePrefixOnes bits limitValue) := by + let frame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras limitValue + have hpost := outputProbeCountOnesFrameCfg_post_internal tm controllerTapes + addressIdx countIdx outerExtras bits input output extras limitValue + change (frame.work + (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + (outputProbePrefixOnes bits limitValue) + rw [outputProbeLatchFramePost_controller tm controllerTapes + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + limitValue) + input output extras false frame.input frame.work frame.output hpost countIdx] + simpa [outputProbeCountOnesDoneCfg, frame] using + outputProbeCountOnesOuterExtrasAt_count_internal n outerExtras bits + limitValue + +theorem outputProbeCountOnesOuterExtrasAfter_eq_internal + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) (haddress : address < bits.length) : + outputProbeCountOnesOuterExtrasAfter n countIdx + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras + bits address) + (outputProbePrefixOnes bits address) (bits[address]'haddress) = + Function.update + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras + bits address) + (outputProbeIndexedControllerIdx n countIdx) + (outputProbeCounterTape (outputProbePrefixOnes bits (address + 1))) := by + by_cases hbit : bits[address]'haddress + · simp only [outputProbeCountOnesOuterExtrasAfter, hbit, if_true] + rw [outputProbePrefixOnes_succ_internal bits address haddress, if_pos hbit] + · simp only [outputProbeCountOnesOuterExtrasAfter] + rw [if_neg hbit] + rw [outputProbePrefixOnes_succ_internal bits address haddress, if_neg hbit, + Nat.add_zero] + funext i + by_cases hi : i = outputProbeIndexedControllerIdx n countIdx + · subst i + simp [outputProbeCountOnesOuterExtrasAt] + · rw [Function.update_of_ne hi] + +theorem outputProbeCountOnesOuterExtrasAt_succ_internal + (n : ℕ) {controllerTapes : ℕ} + {addressIdx countIdx : Fin controllerTapes} + (hne : addressIdx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits : List Bool) (address : ℕ) (haddress : address < bits.length) : + Function.update + (outputProbeCountOnesOuterExtrasAfter n countIdx + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras + bits address) + (outputProbePrefixOnes bits address) (bits[address]'haddress)) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeCounterTape (address + 1)) = + outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + (address + 1) := by + rw [outputProbeCountOnesOuterExtrasAfter_eq_internal n outerExtras bits + address haddress] + let addressPhysical := outputProbeIndexedControllerIdx n addressIdx + let countPhysical := outputProbeIndexedControllerIdx n countIdx + have hphysical : addressPhysical ≠ countPhysical := + outputProbeScan_address_ne_limit_internal n hne + funext i + by_cases hiAddress : i = addressPhysical + · subst i + simp [outputProbeCountOnesOuterExtrasAt, addressPhysical, countPhysical, + hphysical] + · by_cases hiCount : i = countPhysical + · subst i + rw [Function.update_of_ne hiAddress] + simp [outputProbeCountOnesOuterExtrasAt, countPhysical] + · simp [outputProbeCountOnesOuterExtrasAt, addressPhysical, + countPhysical, hiAddress, hiCount] + +theorem outputProbeCountOnesBodyTM_reachesIn_frame_internal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (count : ℕ) (bit : Bool) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {bodyBound : ℕ} + (hpre : pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output) + (hbody : (outputProbeCountOnesBodyTM tm controllerTapes addressIdx + scratchIdx countIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false) + bodyBound) : + ∃ time, time ≤ bodyBound ∧ + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx).reachesIn time + { state := (outputProbeCountOnesBodyTM tm controllerTapes addressIdx + scratchIdx countIdx).qstart + input := (outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras false).input + work := (outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras false).work + output := (outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras false).output } + { state := (outputProbeCountOnesBodyTM tm controllerTapes addressIdx + scratchIdx countIdx).qhalt + input := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false).input + work := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false).work + output := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false).output } := by + obtain ⟨done, time, htime, hreach, hhalt, hpost⟩ := hbody + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output hpre + obtain ⟨hinput, hwork, houtput⟩ := + outputProbeLatchFramePost_eq_frameCfg tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count bit) + input output extras false done.input done.work done.output hpost + have hdone : done = + { state := (outputProbeCountOnesBodyTM tm controllerTapes addressIdx + scratchIdx countIdx).qhalt + input := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false).input + work := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false).work + output := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false).output } := + Cfg.ext hhalt hinput hwork houtput + exact ⟨time, htime, hdone ▸ hreach⟩ + +theorem outputProbeCountOnesIteration_reachesIn_of_body_internal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (haddressCount : addressIdx ≠ countIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (address : ℕ) (haddress : address < bits.length) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {bodyBound : ℕ} + (hpre : pre + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras address).output) + (hbody : (outputProbeCountOnesBodyTM tm controllerTapes addressIdx + scratchIdx countIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx + outerExtras bits address) + (outputProbePrefixOnes bits address) (bits[address]'haddress)) + input output extras false) + bodyBound) : + ∃ time, time ≤ bodyBound + 1 + binarySuccTime address ∧ + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx + limitIdx countIdx).reachesIn time + (outputProbeCountOnesIterationStartCfg tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras + address) + (outputProbeCountOnesIterationDoneCfg tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras + address) := by + let currentOuter := outputProbeCountOnesOuterExtrasAt n addressIdx countIdx + outerExtras bits address + let afterOuter := outputProbeCountOnesOuterExtrasAfter n countIdx + currentOuter (outputProbePrefixOnes bits address) (bits[address]'haddress) + let body := outputProbeCountOnesBodyTM tm controllerTapes addressIdx + scratchIdx countIdx + let counter := outputProbeIndexedControllerIdx n addressIdx + let limit := outputProbeIndexedControllerIdx n limitIdx + let startFrame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras address + let afterFrame := outputProbeLatchFrameCfg tm controllerTapes afterOuter + input output extras false + let nextFrame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras (address + 1) + obtain ⟨bodySteps, hbodySteps, hbodyRun⟩ := + outputProbeCountOnesBodyTM_reachesIn_frame_internal tm controllerTapes + addressIdx scratchIdx countIdx currentOuter input output extras + (outputProbePrefixOnes bits address) (bits[address]'haddress) hpre hbody + have hcurrentOuterParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (currentOuter i) := + outputProbeCountOnesOuterExtrasAt_parked_internal n outerExtras houter bits + address + have hafterOuterParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (afterOuter i) := + outputProbeCountOnesOuterExtrasAfter_parked_internal n countIdx + currentOuter hcurrentOuterParked (outputProbePrefixOnes bits address) + (bits[address]'haddress) + have hafterPost := outputProbeLatchFrameCfg_post tm controllerTapes + afterOuter input output extras false + have hafterParked := outputProbeLatchFramePost_parked tm controllerTapes + afterOuter input output extras false hextras hafterOuterParked houtput + afterFrame.input afterFrame.work afterFrame.output hafterPost + have hafterAddress : (afterFrame.work counter).HasBinaryNat address := by + rw [outputProbeLatchFramePost_controller tm controllerTapes afterOuter + input output extras false afterFrame.input afterFrame.work + afterFrame.output hafterPost addressIdx] + exact outputProbeCountOnesOuterExtrasAfter_address_internal n + haddressCount outerExtras bits address (bits[address]'haddress) + have hsucc := outputProbeCountOnesBinarySuccCanonical_reachesIn_internal + counter address afterFrame.input afterFrame.work afterFrame.output + hafterAddress hafterParked.1 hafterParked.2.1 hafterParked.2.2 + let updatedOuter := Function.update afterOuter counter + (outputProbeCounterTape (address + 1)) + have hupdatedPost : outputProbeLatchFramePost tm controllerTapes + updatedOuter input output extras false afterFrame.input + (Function.update afterFrame.work counter + (outputProbeCounterTape (address + 1))) + afterFrame.output := by + exact outputProbeLatchFramePost_updateController tm controllerTapes + afterOuter input output extras false afterFrame.input afterFrame.work + afterFrame.output hafterPost addressIdx + (outputProbeCounterTape (address + 1)) + have hupdatedEq := outputProbeLatchFramePost_eq_frameCfg tm controllerTapes + updatedOuter input output extras false afterFrame.input + (Function.update afterFrame.work counter + (outputProbeCounterTape (address + 1))) + afterFrame.output hupdatedPost + have hupdatedOuter : updatedOuter = + outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras bits + (address + 1) := by + exact outputProbeCountOnesOuterExtrasAt_succ_internal n haddressCount + outerExtras bits address haddress + have hnextInput : afterFrame.input = nextFrame.input := by + simpa [updatedOuter, hupdatedOuter, nextFrame, + outputProbeCountOnesFrameCfg] using hupdatedEq.1 + have hnextWork : + Function.update afterFrame.work counter + (outputProbeCounterTape (address + 1)) = nextFrame.work := by + simpa [updatedOuter, hupdatedOuter, nextFrame, + outputProbeCountOnesFrameCfg] using hupdatedEq.2.1 + have hnextOutput : afterFrame.output = nextFrame.output := by + simpa [updatedOuter, hupdatedOuter, nextFrame, + outputProbeCountOnesFrameCfg] using hupdatedEq.2.2 + have hsuccNext : (binarySuccTM counter).reachesIn + (binarySuccTime address) + { state := (binarySuccTM counter).qstart + input := afterFrame.input + work := afterFrame.work + output := afterFrame.output } + { state := (binarySuccTM counter).qhalt + input := nextFrame.input + work := nextFrame.work + output := nextFrame.output } := by + have hend : + ({ state := (binarySuccTM counter).qhalt + input := afterFrame.input + work := Function.update afterFrame.work counter + (outputProbeCounterTape (address + 1)) + output := afterFrame.output } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binarySuccTM counter).Q) = + { state := (binarySuccTM counter).qhalt + input := nextFrame.input + work := nextFrame.work + output := nextFrame.output } := + Cfg.ext rfl hnextInput hnextWork hnextOutput + exact hend ▸ hsucc + have hinpTransition : transitionInput afterFrame.input = afterFrame.input := + hafterParked.1.transitionInput_eq_self + have hworkTransition : + (fun i => transitionTape (afterFrame.work i)) = afterFrame.work := by + funext i + exact (hafterParked.2.1 i).transitionTape_eq_self + have houtTransition : transitionTape afterFrame.output = afterFrame.output := + hafterParked.2.2.transitionTape_eq_self + have hsuccNext' : (binarySuccTM counter).reachesIn + (binarySuccTime address) + { state := (binarySuccTM counter).qstart + input := transitionInput afterFrame.input + work := fun i => transitionTape (afterFrame.work i) + output := transitionTape afterFrame.output } + { state := (binarySuccTM counter).qhalt + input := nextFrame.input + work := nextFrame.work + output := nextFrame.output } := by + rw [hinpTransition, hworkTransition, houtTransition] + exact hsuccNext + have hseq := seqTM_reachesIn_of_reachesIn body (binarySuccTM counter) + hbodyRun rfl hsuccNext' + have hlift := binaryForTM_iteration_reachesIn_internal body counter limit + hseq + refine ⟨bodySteps + 1 + binarySuccTime address, ?_, ?_⟩ + · omega + · simpa [body, counter, limit, startFrame, afterFrame, nextFrame, + outputProbeCountOnesTM, outputProbeCountOnesIterationStartCfg, + outputProbeCountOnesIterationDoneCfg, binaryForIterationWrap, + binaryForIterationTM, phase1Wrap, phase2Wrap] using hlift + +/-- Internal constructor for the explicit count-ones segment invariant. -/ +noncomputable def outputProbeCountOnesSegmentSpecOfIterationWitnessesInternal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (haddressLimit : addressIdx ≠ limitIdx) + (haddressCount : addressIdx ≠ countIdx) + (hcountLimit : countIdx ≠ limitIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (bodyTime : ℕ → ℕ) (startValue limitValue : ℕ) + (hlimit : + (outerExtras (outputProbeIndexedControllerIdx n limitIdx)).HasBinaryNat + limitValue) + (iterationWitness : ∀ value, startValue ≤ value → value < limitValue → + ∃ time, time ≤ binaryForIterationTime bodyTime value ∧ + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx + limitIdx countIdx).reachesIn time + (outputProbeCountOnesIterationStartCfg tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras + value) + (outputProbeCountOnesIterationDoneCfg tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras + value)) : + BinaryForSegmentSpec + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue := by + let body := outputProbeCountOnesBodyTM tm controllerTapes addressIdx + scratchIdx countIdx + let counter := outputProbeIndexedControllerIdx n addressIdx + let limit := outputProbeIndexedControllerIdx n limitIdx + let scanCfg := outputProbeCountOnesScanCfg tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras + let iterationStartCfg := outputProbeCountOnesIterationStartCfg tm + controllerTapes addressIdx scratchIdx limitIdx countIdx outerExtras bits + input output extras + let iterationDoneCfg := outputProbeCountOnesIterationDoneCfg tm + controllerTapes addressIdx scratchIdx limitIdx countIdx outerExtras bits + input output extras + let doneCfg := outputProbeCountOnesDoneCfg tm controllerTapes addressIdx + scratchIdx limitIdx countIdx outerExtras bits input output extras limitValue + apply BinaryForSegmentSpec.ofWitnessesInternal + (outputProbeScan_address_ne_limit_internal n haddressLimit) + scanCfg iterationStartCfg iterationDoneCfg doneCfg + · intro value _hstart hvalue + let frame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras value + have hparked := outputProbeCountOnesFrameCfg_parked_internal tm + controllerTapes addressIdx countIdx outerExtras houter bits input output + extras hextras houtput value + have hcounter := outputProbeCountOnesFrameCfg_address_internal tm + controllerTapes addressIdx countIdx haddressCount outerExtras bits input + output extras value + have hlimitFrame : (frame.work limit).HasBinaryNat limitValue := by + rw [outputProbeCountOnesFrameCfg_other_internal tm controllerTapes + addressIdx countIdx limitIdx (Ne.symm haddressLimit) + (Ne.symm hcountLimit) outerExtras bits input output extras value] + exact hlimit + have hrun := binaryForTM_compare_reachesIn_frame_of_lt_internal body + counter limit (outputProbeScan_address_ne_limit_internal n haddressLimit) + value limitValue hvalue frame.input frame.work frame.output hcounter + hlimitFrame hparked.1.read_ne_start + (fun i _ _ => (hparked.2.1 i).read_ne_start) + hparked.2.2.read_ne_start + simpa [body, counter, limit, scanCfg, iterationStartCfg, + outputProbeCountOnesTM, outputProbeCountOnesScanCfg, + outputProbeCountOnesIterationStartCfg, frame] using hrun + · intro value hstart hvalue + simpa [scanCfg, iterationStartCfg, iterationDoneCfg, + outputProbeCountOnesTM] using iterationWitness value hstart hvalue + · intro value _hstart _hvalue + let frame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras (value + 1) + let c : Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binaryForIterationTM body counter).Q := + { state := (binaryForIterationTM body counter).qhalt + input := frame.input + work := frame.work + output := frame.output } + have hparked := outputProbeCountOnesFrameCfg_parked_internal tm + controllerTapes addressIdx countIdx outerExtras houter bits input output + extras hextras houtput (value + 1) + have hstep := binaryForTM_step_iteration_halt_internal body counter limit c + rfl hparked.1.read_ne_start + (fun i => (hparked.2.1 i).read_ne_start) hparked.2.2.read_ne_start + simpa [body, counter, limit, iterationDoneCfg, scanCfg, + outputProbeCountOnesTM, outputProbeCountOnesIterationDoneCfg, + outputProbeCountOnesScanCfg, binaryForIterationWrap, c, frame] using hstep + · let frame := outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras bits input output extras limitValue + have hparked := outputProbeCountOnesFrameCfg_parked_internal tm + controllerTapes addressIdx countIdx outerExtras houter bits input output + extras hextras houtput limitValue + have hcounter := outputProbeCountOnesFrameCfg_address_internal tm + controllerTapes addressIdx countIdx haddressCount outerExtras bits input + output extras limitValue + have hlimitFrame : (frame.work limit).HasBinaryNat limitValue := by + rw [outputProbeCountOnesFrameCfg_other_internal tm controllerTapes + addressIdx countIdx limitIdx (Ne.symm haddressLimit) + (Ne.symm hcountLimit) outerExtras bits input output extras limitValue] + exact hlimit + have hrun := binaryForTM_compare_reachesIn_frame_of_eq_internal body + counter limit (outputProbeScan_address_ne_limit_internal n haddressLimit) + limitValue frame.input frame.work frame.output hcounter hlimitFrame + hparked.1.read_ne_start + (fun i _ _ => (hparked.2.1 i).read_ne_start) + hparked.2.2.read_ne_start + simpa [body, counter, limit, scanCfg, doneCfg, outputProbeCountOnesTM, + outputProbeCountOnesScanCfg, outputProbeCountOnesDoneCfg, frame] using + hrun + · simp [doneCfg, outputProbeCountOnesDoneCfg, outputProbeCountOnesTM, + binaryForTM] + +/-- Internal constructor lifting bounded body contracts into a segment. -/ +noncomputable def outputProbeCountOnesSegmentSpecOfBodyWitnessesInternal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (haddressLimit : addressIdx ≠ limitIdx) + (haddressCount : addressIdx ≠ countIdx) + (hcountLimit : countIdx ≠ limitIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (bodyTime : ℕ → ℕ) (startValue limitValue : ℕ) + (hlimitBits : limitValue ≤ bits.length) + (hlimit : + (outerExtras (outputProbeIndexedControllerIdx n limitIdx)).HasBinaryNat + limitValue) + (bodyWitness : ∀ value, startValue ≤ value → value < limitValue → + (hvalueBits : value < bits.length) → + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + bodyBound ≤ bodyTime value ∧ + pre + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras value).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras value).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx countIdx + outerExtras bits input output extras value).output ∧ + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx + (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx + outerExtras bits value) + (outputProbePrefixOnes bits value) + (bits[value]'hvalueBits)) + input output extras false) + bodyBound) : + BinaryForSegmentSpec + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue := by + apply outputProbeCountOnesSegmentSpecOfIterationWitnessesInternal tm + controllerTapes addressIdx scratchIdx limitIdx countIdx haddressLimit + haddressCount hcountLimit outerExtras bits input output extras hextras + houter houtput bodyTime startValue limitValue hlimit + intro value hstart hvalue + have hvalueBits : value < bits.length := by omega + obtain ⟨bodyBound, pre, hbound, hpre, hbody⟩ := + bodyWitness value hstart hvalue hvalueBits + obtain ⟨time, htime, hrun⟩ := + outputProbeCountOnesIteration_reachesIn_of_body_internal tm + controllerTapes addressIdx scratchIdx limitIdx countIdx haddressCount + outerExtras bits input output extras hextras houter houtput value + hvalueBits hpre hbody + refine ⟨time, ?_, hrun⟩ + simp only [binaryForIterationTime] + omega + +theorem outputProbeCountOnes_zero_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (countIdx : Fin controllerTapes) (count inputLength initialSpace : ℕ) + (hinitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).Q).WithinAuxSpace inputLength initialSpace) : + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + false) + input output extras false) + 1 inputLength (initialSpace + 1) := by + have htime : (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + false) + input output extras false) 1 := by + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + have hskip := skipTM_hoareTime_frame inp work out hinput hwork hout + obtain ⟨done, elapsed, helapsed, hreach, hhalt, hinputDone, + hworkDone, houtputDone⟩ := + hskip inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨done, elapsed, helapsed, hreach, hhalt, ?_⟩ + rw [hinputDone, hworkDone, houtputDone] + simpa [outputProbeCountOnesOuterExtrasAfter] using hpost + exact htime.toHoareTimeSpace hinitial + +theorem outputProbeCountOnes_one_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (countIdx : Fin controllerTapes) (count inputLength initialSpace : ℕ) + (hcount : + (outerExtras (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + count) + (hinitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).Q).WithinAuxSpace + inputLength initialSpace) : + (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count true) + input output extras false) + (binarySuccTime count) inputLength + (initialSpace + binarySuccTime count) := by + let physicalCount := outputProbeIndexedControllerIdx n countIdx + let nextTape := outputProbeCounterTape (count + 1) + have htime : (binarySuccTM physicalCount).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count true) + input output extras false) + (binarySuccTime count) := by + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + have hcountWork : (work physicalCount).HasBinaryNat count := by + rw [outputProbeLatchFramePost_controller tm controllerTapes + outerExtras input output extras false inp work out hpost countIdx] + exact hcount + obtain ⟨done, hreach, hhalt, hinputDone, hotherDone, hcountDone, + houtputDone⟩ := + binarySuccTM_reachesIn_frame physicalCount count inp work out + hcountWork hinput.read_ne_start + (fun i _ => (hwork i).read_ne_start) hout.read_ne_start + have hnext : done.work = Function.update work physicalCount nextTape := by + funext i + by_cases hi : i = physicalCount + · subst i + rw [Function.update_self] + exact hcountDone.eq_init_move_right + · rw [Function.update_of_ne hi] + exact hotherDone i hi + refine ⟨done, binarySuccTime count, le_rfl, hreach, hhalt, ?_⟩ + rw [hinputDone, hnext, houtputDone] + simpa [physicalCount, nextTape, outputProbeCountOnesOuterExtrasAfter] + using outputProbeLatchFramePost_updateController tm controllerTapes + outerExtras input output extras false inp work out hpost countIdx + nextTape + exact htime.toHoareTimeSpace hinitial + +theorem outputProbeCountOnesBodyTM_of_latch_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx countIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (count : ℕ) + (hcount : + (outerExtras (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + count) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace inputLength clearInitialSpace zeroInitialSpace + oneInitialSpace : ℕ} + (hlatch : (outputProbeIndexedLatchTM tm controllerTapes addressIdx + scratchIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + latchTime inputLength latchSpace) + (hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength clearInitialSpace) + (hzeroInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).Q).WithinAuxSpace inputLength + zeroInitialSpace) + (honeInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).Q).WithinAuxSpace + inputLength oneInitialSpace) : + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + bit) + input output extras false) + (latchTime + 1 + + outputProbeLatchDispatchTime bit 1 + (clearWorkTimeBound 1 + 1 + binarySuccTime count)) + inputLength + (max latchSpace + (if bit then + max (clearInitialSpace + clearWorkTimeBound 1) + (oneInitialSpace + binarySuccTime count) + else zeroInitialSpace + 1)) := by + have hzero := outputProbeCountOnes_zero_hoareTimeSpace_internal tm + controllerTapes outerExtras input output extras hextras houter houtput + countIdx count inputLength zeroInitialSpace hzeroInitial + have hone := outputProbeCountOnes_one_hoareTimeSpace_internal tm + controllerTapes outerExtras input output extras hextras houter houtput + countIdx count inputLength oneInitialSpace hcount honeInitial + simpa [outputProbeCountOnesBodyTM] using + outputProbeIndexedResetDispatchTM_of_latch_hoareTimeSpace tm + controllerTapes addressIdx scratchIdx outerExtras input output extras bit + hextras houter houtput skipTM + (binarySuccTM (outputProbeIndexedControllerIdx n countIdx)) + (post := fun branch => + outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + branch) + input output extras false) + hlatch + hclearInitial hzero hone + +theorem ComputesInSpace.outputProbeCountOnesBodyTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (address : ℕ) (haddress : address < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (address + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (addressIdx scratchIdx countIdx : Fin controllerTapes) + (haddressScratch : addressIdx ≠ scratchIdx) + (hsource : + (outerExtras (outputProbeIndexedControllerIdx n addressIdx)) + |>.HasBinaryNat address) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (count : ℕ) + (hcount : + (outerExtras (outputProbeIndexedControllerIdx n countIdx)) + |>.HasBinaryNat count) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx outerExtras count + ((f input)[address]'haddress)) + input output extras false) + bodyBound := by + let frame := outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false + let queryFrame := placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes + outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (address + 1)) output extras) + let frameSpace := Finset.univ.sup fun i => (extras i).head + let outerFrameSpace := Finset.univ.sup fun i => (outerExtras i).head + let initialSpace := Finset.univ.sup fun i => (frame.work i).head + let pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes) := + fun inp work out => + inp = queryFrame.input ∧ work = frame.work ∧ out = output + have hframePost := outputProbeLatchFrameCfg_post tm controllerTapes + outerExtras input output extras false + have hparked := outputProbeLatchFramePost_parked tm controllerTapes + outerExtras input output extras false hextras houter houtput frame.input + frame.work frame.output hframePost + have hframeBound : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace := by + intro i _hi + exact Finset.le_sup (f := fun j => (extras j).head) + (Finset.mem_univ i) + have houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start := by + intro i hi + exact (houter i hi).read_ne_start + have houterBound : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace := by + intro i _hi + exact Finset.le_sup (f := fun j => (outerExtras j).head) + (Finset.mem_univ i) + have hworkBound : ∀ i, (frame.work i).head ≤ initialSpace := by + intro i + exact Finset.le_sup (f := fun j => (frame.work j).head) + (Finset.mem_univ i) + have hqueryInput : queryFrame.input = frame.input := by + rfl + have hqueryOutput : frame.output = output := by + simp [frame, outputProbeLatchFrameCfg, outputProbeLatchInnerFrameCfg, + outputProbePlacedFrameCfg] + have hsourceWork : + (frame.work (outputProbeIndexedControllerIdx n addressIdx)) + |>.HasBinaryNat address := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false frame.input frame.work frame.output hframePost + addressIdx] + exact hsource + have hscratchWork : + (frame.work (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0 := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false frame.input frame.work frame.output hframePost + scratchIdx] + exact hscratch + have hframeWork : frame.work = Function.update queryFrame.work + (outputProbeIndexedCountdownIdx n controllerTapes) + (outputProbeCounterTape 0) := by + exact outputProbeLatchFrameCfg_work_eq_queryUpdate tm input output extras + hcleanupCounter controllerTapes address outerExtras + have hcountdown : + (frame.work (outputProbeIndexedCountdownIdx n controllerTapes)) + |>.HasBinaryNat 0 := by + rw [hframeWork, Function.update_self] + exact Tape.init_move_right_hasBinaryNat 0 + have hqueryWork : ∀ i, + i ≠ outputProbeIndexedCountdownIdx n controllerTapes → + frame.work i = queryFrame.work i := by + intro i hi + rw [hframeWork, Function.update_of_ne hi] + have hinputSpace : queryFrame.input.head ≤ + input.length + initialSpace + 1 := by + simp [queryFrame, outputProbePlacedFrameCfg, outputProbeStartedCfg, + Tape.move] + obtain ⟨latchTime, hlatch⟩ := + hcomp.outputProbeIndexedLatchTM_hoareTimeSpace input address haddress + output houtput extras frameSpace cleanupLimit hextras hframeBound + hcleanupCounter hcleanupLimit hlimit controllerTapes outerExtras + outerFrameSpace houterRead houterBound addressIdx scratchIdx + haddressScratch initialSpace frame.work hsourceWork hcountdown + hscratchWork (hqueryInput ▸ hparked.1) hparked.2.1 hworkBound hinputSpace + hqueryWork + let falseFrame := outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras false + let trueFrame := outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras true + let falseSpace := Finset.univ.sup fun i => (falseFrame.work i).head + let trueSpace := Finset.univ.sup fun i => (trueFrame.work i).head + have hframeInitial (bit : Bool) : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit inp work out → + ({ state := (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).Q).WithinAuxSpace input.length + (Finset.univ.sup fun i => + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras bit).work i).head) := by + intro inp work out hpost + obtain ⟨hinp, hwork, _hout⟩ := outputProbeLatchFramePost_eq_frameCfg tm + controllerTapes outerExtras input output extras bit inp work out hpost + subst inp + subst work + constructor + · intro i + exact Finset.le_sup + (f := fun j => + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras bit).work j).head) + (Finset.mem_univ i) + · simp [outputProbeLatchFrameCfg, outputProbeLatchInnerFrameCfg, + outputProbePlacedFrameCfg, outputProbeStartedCfg, Tape.move] + have hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM (outputProbeLatchIdx n controllerTapes)).Q + ).WithinAuxSpace input.length trueSpace := by + simpa [trueSpace, trueFrame] using hframeInitial true + have hzeroInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).Q).WithinAuxSpace input.length falseSpace := by + simpa [falseSpace, falseFrame] using hframeInitial false + have honeInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binarySuccTM + (outputProbeIndexedControllerIdx n countIdx)).Q + ).WithinAuxSpace input.length falseSpace := by + simpa [falseSpace, falseFrame] using hframeInitial false + let bodyBound := outputProbeIndexedPrepareTime address + 1 + latchTime + 1 + + outputProbeLatchDispatchTime ((f input)[address]'haddress) 1 + (clearWorkTimeBound 1 + 1 + binarySuccTime count) + have hbody := outputProbeCountOnesBodyTM_of_latch_hoareTimeSpace_internal tm + controllerTapes addressIdx scratchIdx countIdx outerExtras input output + extras ((f input)[address]'haddress) hextras houter houtput count hcount + hlatch hclearInitial hzeroInitial honeInitial + refine ⟨bodyBound, pre, ?_, ?_⟩ + · exact ⟨hqueryInput.symm, rfl, hqueryOutput⟩ + · simpa [bodyBound] using hbody.1 + +/-- Internal constructor selecting all source-dependent count-scan runtimes. -/ +noncomputable def + ComputesInSpace.outputProbeCountOnesSegmentSpecInternal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes) + (haddressLimit : addressIdx ≠ limitIdx) + (haddressCount : addressIdx ≠ countIdx) + (hcountLimit : countIdx ≠ limitIdx) + (haddressScratch : addressIdx ≠ scratchIdx) + (hscratchAddress : scratchIdx ≠ addressIdx) + (hscratchCount : scratchIdx ≠ countIdx) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (startValue limitValue : ℕ) + (hlimitBits : limitValue ≤ (f input).length) + (hlimitRegister : + (outerExtras (outputProbeIndexedControllerIdx n limitIdx)) + |>.HasBinaryNat limitValue) + (hqueryLimit : ∀ value, startValue ≤ value → value < limitValue → + outputProbeCaptureSpace (max 1 (space input.length)) (value + 1) ≤ + cleanupLimit) : + Σ bodyTime : ℕ → ℕ, + BinaryForSegmentSpec + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue := by + classical + let currentOuter (value : ℕ) := + outputProbeCountOnesOuterExtrasAt n addressIdx countIdx outerExtras + (f input) value + have bodyExists : ∀ value, ∃ bodyBound : ℕ, + ∀ (hstart : startValue ≤ value) (hvalue : value < limitValue) + (hvalueBits : value < (f input).length), + ∃ pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes), + pre + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras (f input) input output extras value).input + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras (f input) input output extras value).work + (outputProbeCountOnesFrameCfg tm controllerTapes addressIdx + countIdx outerExtras (f input) input output extras value).output ∧ + (outputProbeCountOnesBodyTM tm controllerTapes addressIdx scratchIdx + countIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeCountOnesOuterExtrasAfter n countIdx + (currentOuter value) + (outputProbePrefixOnes (f input) value) + ((f input)[value]'hvalueBits)) + input output extras false) + bodyBound := by + intro value + by_cases hrange : startValue ≤ value ∧ value < limitValue + · have hcurrentParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (currentOuter value i) := + outputProbeCountOnesOuterExtrasAt_parked_internal n outerExtras houter + (f input) value + have hsourceCurrent : + (currentOuter value + (outputProbeIndexedControllerIdx n addressIdx)).HasBinaryNat + value := by + exact outputProbeCountOnesOuterExtrasAt_address_internal n + haddressCount outerExtras (f input) value + have hscratchCurrent : + (currentOuter value + (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat + 0 := by + change (outputProbeCountOnesOuterExtrasAt n addressIdx countIdx + outerExtras (f input) value + (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat 0 + rw [outputProbeCountOnesOuterExtrasAt_other_internal n + hscratchAddress hscratchCount outerExtras (f input) value] + exact hscratch + have hcountCurrent : + (currentOuter value + (outputProbeIndexedControllerIdx n countIdx)).HasBinaryNat + (outputProbePrefixOnes (f input) value) := by + exact outputProbeCountOnesOuterExtrasAt_count_internal n outerExtras + (f input) value + obtain ⟨bodyBound, pre, hpre, hbody⟩ := + hcomp.outputProbeCountOnesBodyTM_hoareTime_internal input value + (by omega) output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit (hqueryLimit value hrange.1 hrange.2) + controllerTapes (currentOuter value) hcurrentParked addressIdx + scratchIdx countIdx haddressScratch hsourceCurrent hscratchCurrent + (outputProbePrefixOnes (f input) value) hcountCurrent + refine ⟨bodyBound, ?_⟩ + intro _hstart _hvalue hvalueBits + refine ⟨pre, ?_, hbody⟩ + simpa [currentOuter, outputProbeCountOnesFrameCfg] using hpre + · refine ⟨0, ?_⟩ + intro hstart hvalue _hvalueBits + exact (hrange ⟨hstart, hvalue⟩).elim + choose bodyTime hbody using bodyExists + refine ⟨bodyTime, + outputProbeCountOnesSegmentSpecOfBodyWitnessesInternal tm controllerTapes + addressIdx scratchIdx limitIdx countIdx haddressLimit haddressCount + hcountLimit outerExtras (f input) input output extras hextras houter + houtput bodyTime startValue limitValue hlimitBits hlimitRegister ?_⟩ + intro value hstart hvalue hvalueBits + obtain ⟨pre, hpre, hhoare⟩ := + hbody value hstart hvalue hvalueBits + exact ⟨bodyTime value, pre, le_rfl, hpre, hhoare⟩ + +theorem IsTransducer.outputProbeCountOnesTM_internal + {tm : TM n} {controllerTapes : ℕ} + {addressIdx scratchIdx limitIdx countIdx : Fin controllerTapes} : + (outputProbeCountOnesTM tm controllerTapes addressIdx scratchIdx limitIdx + countIdx).IsTransducer := by + unfold outputProbeCountOnesTM + exact (skipTM_isTransducer_internal.outputProbeIndexedResetDispatchTM + (binarySuccTM_isTransducer + (outputProbeIndexedControllerIdx n countIdx))).binaryForTM + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat.lean new file mode 100644 index 00000000..891b480f --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat.lean @@ -0,0 +1,790 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDecodeNat.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDecodeNat.Internal + +/-! +# Decoding terminated-unary fields through output probes + +This module exposes the first formula-code query controller used by the +uniform Barrington construction. It scans a terminated-unary field with a +bounded dynamic output probe, preserving a success/failure flag in a concrete +one-bit work register. +-/ + +namespace Complexity + +namespace TM + +/-- The bounded semantic controller agrees exactly with the existing +probe-oracle terminated-unary decoder, including unavailable positions and +fuel exhaustion. -/ +theorem outputProbeDecodeNatRun_result + (query : FormulaCode.BitOracle) (fuel cursor value : ℕ) : + (outputProbeDecodeNatRun query fuel + { cursor := cursor, value := value, active := true }).result? = + FormulaCode.BitOracle.decodeNatAt? query fuel cursor value := + outputProbeDecodeNatRun_result_internal query fuel cursor value + +/-- A successful oracle-level decode determines the entire final pure +controller state: accumulated value, advanced cursor, and cleared active flag. -/ +theorem outputProbeDecodeNatStateAt_eq_of_result + (bits : List Bool) (fuel cursor value result nextCursor : ℕ) + (hdecode : FormulaCode.BitOracle.decodeNatAt? + (FormulaCode.BitOracle.ofList bits) fuel cursor value = + some (result, nextCursor)) : + outputProbeDecodeNatStateAt bits + { cursor := cursor, value := value, active := true } fuel = + { cursor := nextCursor, value := result, active := false } := + outputProbeDecodeNatStateAt_eq_of_result_internal bits fuel cursor value + result nextCursor hdecode + +/-- One semantic decoder iteration over a finite output list consumes its +actual bit whenever the active cursor is valid, and otherwise preserves an +inactive state. -/ +theorem outputProbeDecodeNatStep_ofList + (bits : List Bool) (state : OutputProbeDecodeNatState) + (hcursor : state.active = true → state.cursor < bits.length) : + outputProbeDecodeNatStep (FormulaCode.BitOracle.ofList bits) state = + if state.active then + { cursor := state.cursor + 1 + value := state.value + + if outputProbeDecodeNatSourceBit bits state.cursor then 1 else 0 + active := outputProbeDecodeNatSourceBit bits state.cursor } + else + state := + outputProbeDecodeNatStep_ofList_internal bits state hcursor + +/-- Compact form of `outputProbeDecodeNatStep_ofList`: the finite source bit +drives the shared pure state transition. -/ +theorem outputProbeDecodeNatStep_ofList_eq_afterBit + (bits : List Bool) (state : OutputProbeDecodeNatState) + (hcursor : state.active = true → state.cursor < bits.length) : + outputProbeDecodeNatStep (FormulaCode.BitOracle.ofList bits) state = + outputProbeDecodeNatStateAfterBit state + (outputProbeDecodeNatSourceBit bits state.cursor) := + outputProbeDecodeNatStep_ofList_eq_afterBit_internal bits state hcursor + +/-- The concrete controller-frame updates for one decoder bit are literally +the canonical frame of the corresponding pure next state. -/ +theorem outputProbeDecodeNatOuterExtrasStep_state + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hvalueActive : valueIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (bit : Bool) : + outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state) + state bit = + outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras (outputProbeDecodeNatStateAfterBit state bit) := + outputProbeDecodeNatOuterExtrasStep_state_internal n cursorIdx valueIdx + activeIdx hcursorValue hcursorActive hvalueActive outerExtras state bit + +/-- Running one more pure decoder iteration is the same as stepping the state +obtained after the previous iterations. -/ +theorem outputProbeDecodeNatRun_succ + (query : FormulaCode.BitOracle) (fuel : ℕ) + (state : OutputProbeDecodeNatState) : + outputProbeDecodeNatRun query (fuel + 1) state = + outputProbeDecodeNatStep query + (outputProbeDecodeNatRun query fuel state) := + outputProbeDecodeNatRun_succ_internal query fuel state + +/-- The canonical decoder frame exposes its cursor register. -/ +theorem outputProbeDecodeNatStateOuterExtras_cursor + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) : + (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat state.cursor := + outputProbeDecodeNatStateOuterExtras_cursor_internal n cursorIdx valueIdx + activeIdx hcursorValue hcursorActive outerExtras state + +/-- The canonical decoder frame exposes its accumulated value register. -/ +theorem outputProbeDecodeNatStateOuterExtras_value + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (hvalueActive : valueIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) : + (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat state.value := + outputProbeDecodeNatStateOuterExtras_value_internal n cursorIdx valueIdx + activeIdx hvalueActive outerExtras state + +/-- The canonical decoder frame exposes its zero-or-one active register. -/ +theorem outputProbeDecodeNatStateOuterExtras_active + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) : + (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat (if state.active then 1 else 0) := + outputProbeDecodeNatStateOuterExtras_active_internal n cursorIdx valueIdx + activeIdx outerExtras state + +/-- The canonical loop frame exposes its exact binary iteration counter. -/ +theorem outputProbeDecodeNatLoopOuterExtras_loop + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (hloopCursor : loopIdx ≠ cursorIdx) + (hloopValue : loopIdx ≠ valueIdx) + (hloopActive : loopIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) : + (outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras state iteration + (outputProbeIndexedControllerIdx n loopIdx)).HasBinaryNat iteration := + outputProbeDecodeNatLoopOuterExtras_loop_internal n cursorIdx valueIdx + activeIdx loopIdx hloopCursor hloopValue hloopActive outerExtras state + iteration + +/-- If the cursor, value, active flag, and loop counter already contain their +canonical values, rebuilding that decoder frame changes no tape. -/ +theorem outputProbeDecodeNatLoopOuterExtras_eq_self + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat state.cursor) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat state.value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat (if state.active then 1 else 0)) + (hloop : + (outerExtras (outputProbeIndexedControllerIdx n loopIdx)) + |>.HasBinaryNat iteration) : + outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx loopIdx + outerExtras state iteration = outerExtras := + outputProbeDecodeNatLoopOuterExtras_eq_self_internal n cursorIdx valueIdx + activeIdx loopIdx outerExtras state iteration hcursor hvalue hactive hloop + +/-- Rebuilding a decoder loop frame preserves the parked outer-frame +invariant. -/ +theorem outputProbeDecodeNatLoopOuterExtras_parked + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (state : OutputProbeDecodeNatState) (iteration : ℕ) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx + activeIdx loopIdx outerExtras state iteration i) := + outputProbeDecodeNatLoopOuterExtras_parked_internal n cursorIdx valueIdx + activeIdx loopIdx outerExtras houter state iteration + +/-- A decoder loop frame leaves every unrelated controller register literally +unchanged. -/ +theorem outputProbeDecodeNatLoopOuterExtras_other + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx idx : Fin controllerTapes) + (hcursor : idx ≠ cursorIdx) (hvalue : idx ≠ valueIdx) + (hactive : idx ≠ activeIdx) (hloop : idx ≠ loopIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) : + outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras state iteration + (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := + outputProbeDecodeNatLoopOuterExtras_other_internal n cursorIdx valueIdx + activeIdx loopIdx idx hcursor hvalue hactive hloop outerExtras state + iteration + +/-- On a zero terminator, the concrete selected continuation clears the +active flag and advances the cursor exactly once. -/ +theorem outputProbeDecodeNatZeroTM_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx activeIdx : Fin controllerTapes) + (hdistinct : cursorIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (cursor : ℕ) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1) : + (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatZeroOuterExtras n cursorIdx activeIdx outerExtras + cursor) + input output extras false) + (clearWorkTimeBound 1 + 1 + binarySuccTime cursor) := + outputProbeDecodeNatZeroTM_hoareTime_internal tm controllerTapes cursorIdx + activeIdx hdistinct outerExtras input output extras hextras houter houtput + cursor hcursor hactive + +/-- On a unary one-bit, the concrete selected continuation increments both +the accumulator and cursor exactly once. -/ +theorem outputProbeDecodeNatOneTM_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx : Fin controllerTapes) + (hdistinct : cursorIdx ≠ valueIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (cursor value : ℕ) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat value) : + (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOneOuterExtras n cursorIdx valueIdx outerExtras + cursor value) + input output extras false) + (binarySuccTime value + 1 + binarySuccTime cursor) := + outputProbeDecodeNatOneTM_hoareTime_internal tm controllerTapes cursorIdx + valueIdx hdistinct outerExtras input output extras hextras houter houtput + cursor value hcursor hvalue + +/-- Compose a certified dynamic source probe with the exact terminated-unary +zero/one register updates. Both branches restore the physical probe latch to +canonical zero before exposing the updated controller frame. -/ +theorem outputProbeDecodeNatActiveTM_of_latch_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (cursor value : ℕ) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace inputLength clearInitialSpace zeroInitialSpace + oneInitialSpace : ℕ} + (hlatch : (outputProbeIndexedLatchTM tm controllerTapes cursorIdx + scratchIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + latchTime inputLength latchSpace) + (hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength clearInitialSpace) + (hzeroInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).Q).WithinAuxSpace inputLength zeroInitialSpace) + (honeInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).Q).WithinAuxSpace inputLength oneInitialSpace) : + (outputProbeDecodeNatActiveTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasAfter n cursorIdx valueIdx activeIdx + outerExtras cursor value bit) + input output extras false) + (latchTime + 1 + + outputProbeLatchDispatchTime bit + (clearWorkTimeBound 1 + 1 + binarySuccTime cursor) + (clearWorkTimeBound 1 + 1 + + (binarySuccTime value + 1 + binarySuccTime cursor))) + inputLength + (max latchSpace + (if bit then + max (clearInitialSpace + clearWorkTimeBound 1) + (oneInitialSpace + + (binarySuccTime value + 1 + binarySuccTime cursor)) + else + zeroInitialSpace + + (clearWorkTimeBound 1 + 1 + binarySuccTime cursor))) := + outputProbeDecodeNatActiveTM_of_latch_hoareTimeSpace_internal tm + controllerTapes cursorIdx scratchIdx valueIdx activeIdx hcursorValue + hcursorActive outerExtras input output extras bit hextras houter houtput + cursor value hcursor hvalue hactive hlatch hclearInitial hzeroInitial + honeInitial + +/-- Derive one exact active decoder step directly from a space-bounded source +transducer. Finite frame maxima and the private countdown-reset seam are chosen +internally; the caller supplies only the stable controller invariants. -/ +theorem ComputesInSpace.outputProbeDecodeNatActiveTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorScratch : cursorIdx ≠ scratchIdx) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (value : ℕ) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + (∀ inp work out, pre inp work out → + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).input ∧ + work = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).work ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).output) ∧ + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeNatActiveTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasAfter n cursorIdx valueIdx + activeIdx outerExtras cursor value + ((f input)[cursor]'hcursorBound)) + input output extras false) + bodyBound := + hcomp.outputProbeDecodeNatActiveTM_hoareTime_internal input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit controllerTapes outerExtras houter cursorIdx + scratchIdx valueIdx activeIdx hcursorScratch hcursorValue hcursorActive + hcursor hscratch value hvalue hactive + +/-- Lift a source-derived active query step through the concrete decoder's +outer active-flag dispatch. -/ +theorem ComputesInSpace.outputProbeDecodeNatBodyTM_active_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorScratch : cursorIdx ≠ scratchIdx) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (value : ℕ) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasAfter n cursorIdx valueIdx + activeIdx outerExtras cursor value + ((f input)[cursor]'hcursorBound)) + input output extras false) + bodyBound := + hcomp.outputProbeDecodeNatBodyTM_active_hoareTime_internal input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit controllerTapes outerExtras houter cursorIdx + scratchIdx valueIdx activeIdx hcursorScratch hcursorValue hcursorActive + hcursor hscratch value hvalue hactive + +/-- Once the terminator has cleared the active register, one decoder-body +iteration is exactly a no-op over the restored probe frame. -/ +theorem outputProbeDecodeNatBodyTM_inactive_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hinactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 0) : + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + 2 := + outputProbeDecodeNatBodyTM_inactive_hoareTime_internal tm controllerTapes + cursorIdx scratchIdx valueIdx activeIdx outerExtras input output extras + hextras houter houtput hinactive + +/-- Unified exact body contract matching one pure semantic decoder step. +Active states query the valid source cursor; inactive states preserve the +complete frame without imposing a source-position side condition. -/ +theorem ComputesInSpace.outputProbeDecodeNatBodyTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (state : OutputProbeDecodeNatState) + (hcursorBound : state.active = true → + state.cursor < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : state.active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + (state.cursor + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorScratch : cursorIdx ≠ scratchIdx) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat state.cursor) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat state.value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat (if state.active then 1 else 0)) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state + (outputProbeDecodeNatSourceBit (f input) state.cursor)) + input output extras false) + bodyBound := + hcomp.outputProbeDecodeNatBodyTM_hoareTime_internal input state hcursorBound + output houtput extras hextras hcleanupCounter cleanupLimit hcleanupLimit + hlimit controllerTapes outerExtras houter cursorIdx scratchIdx valueIdx + activeIdx hcursorScratch hcursorValue hcursorActive hcursor hscratch + hvalue hactive + +/-- Package exact decoder-iteration witnesses into a complete bounded-loop +certificate whose configurations expose the pure decoder state after every +iteration. -/ +noncomputable def outputProbeDecodeNatSegmentSpecOfIterationWitnesses + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) + (hloopFuel : loopIdx ≠ fuelIdx) + (hloopCursor : loopIdx ≠ cursorIdx) + (hloopValue : loopIdx ≠ valueIdx) + (hloopActive : loopIdx ≠ activeIdx) + (hfuelCursor : fuelIdx ≠ cursorIdx) + (hfuelValue : fuelIdx ≠ valueIdx) + (hfuelActive : fuelIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (initial : OutputProbeDecodeNatState) + (bodyTime : ℕ → ℕ) (startValue fuelValue : ℕ) + (hfuel : + (outerExtras (outputProbeIndexedControllerIdx n fuelIdx)).HasBinaryNat + fuelValue) + (iterationWitness : ∀ value, startValue ≤ value → value < fuelValue → + ∃ time, time ≤ binaryForIterationTime bodyTime value ∧ + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx loopIdx fuelIdx).reachesIn time + (outputProbeDecodeNatIterationStartCfg tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx outerExtras bits + input output extras initial value) + (outputProbeDecodeNatIterationDoneCfg tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx outerExtras bits + input output extras initial value)) : + BinaryForSegmentSpec + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx) + (outputProbeIndexedControllerIdx n loopIdx) + (outputProbeIndexedControllerIdx n fuelIdx) + bodyTime startValue fuelValue := + outputProbeDecodeNatSegmentSpecOfIterationWitnessesInternal tm + controllerTapes cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx + hloopFuel hloopCursor hloopValue hloopActive hfuelCursor hfuelValue + hfuelActive outerExtras bits input output extras hextras houter houtput + initial bodyTime startValue fuelValue hfuel iterationWitness + +/-- Derive the complete exact bounded decoder loop from a source transducer's +`ComputesInSpace` contract. + +The returned body-time function noncomputably selects the actual deterministic +runtime of each replayed source query. The register layout structurally keeps +all six controller roles distinct, and the segment's final frame stores +`outputProbeDecodeNatStateAt (f input) initial fuelValue`. -/ +noncomputable def ComputesInSpace.outputProbeDecodeNatSegmentSpec + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeNatLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (initial : OutputProbeDecodeNatState) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n layout.scratchIdx)) + |>.HasBinaryNat 0) + (startValue fuelValue : ℕ) + (hfuel : + (outerExtras (outputProbeIndexedControllerIdx n layout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, startValue ≤ value → value < fuelValue → + (outputProbeDecodeNatStateAt (f input) initial value).active = true → + (outputProbeDecodeNatStateAt (f input) initial value).cursor < + (f input).length) + (hqueryLimit : ∀ value, startValue ≤ value → value < fuelValue → + (outputProbeDecodeNatStateAt (f input) initial value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) initial value).cursor + 1) ≤ + cleanupLimit) : + Σ bodyTime : ℕ → ℕ, + BinaryForSegmentSpec + (outputProbeDecodeNatBodyTM tm controllerTapes layout.cursorIdx + layout.scratchIdx layout.valueIdx layout.activeIdx) + (outputProbeIndexedControllerIdx n layout.loopIdx) + (outputProbeIndexedControllerIdx n layout.fuelIdx) + bodyTime startValue fuelValue := + hcomp.outputProbeDecodeNatSegmentSpecInternal input output houtput extras + hextras hcleanupCounter cleanupLimit hcleanupLimit controllerTapes layout + outerExtras houter initial hscratch startValue fuelValue hfuel hqueryValid + hqueryLimit + +/-- A complete source-derived decoder run gives a bounded Hoare contract +between its canonical start and final latch frames. The existential body-time +function records the selected runtimes of the restartable source probes. -/ +theorem ComputesInSpace.outputProbeDecodeNatTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeNatLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (initial : OutputProbeDecodeNatState) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n layout.scratchIdx)) + |>.HasBinaryNat 0) + (startValue fuelValue : ℕ) (hstartFuel : startValue ≤ fuelValue) + (hfuel : + (outerExtras (outputProbeIndexedControllerIdx n layout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, startValue ≤ value → value < fuelValue → + (outputProbeDecodeNatStateAt (f input) initial value).active = true → + (outputProbeDecodeNatStateAt (f input) initial value).cursor < + (f input).length) + (hqueryLimit : ∀ value, startValue ≤ value → value < fuelValue → + (outputProbeDecodeNatStateAt (f input) initial value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) initial value).cursor + 1) ≤ + cleanupLimit) : + ∃ bodyTime : ℕ → ℕ, + (outputProbeDecodeNatTM tm controllerTapes layout.cursorIdx + layout.scratchIdx layout.valueIdx layout.activeIdx layout.loopIdx + layout.fuelIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatLoopOuterExtras n layout.cursorIdx + layout.valueIdx layout.activeIdx layout.loopIdx outerExtras + (outputProbeDecodeNatStateAt (f input) initial startValue) + startValue) + input output extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatLoopOuterExtras n layout.cursorIdx + layout.valueIdx layout.activeIdx layout.loopIdx outerExtras + (outputProbeDecodeNatStateAt (f input) initial fuelValue) + fuelValue) + input output extras false) + (binaryForLoopTime bodyTime fuelValue startValue + (fuelValue - startValue)) := + hcomp.outputProbeDecodeNatTM_hoareTime_internal input output houtput extras + hextras hcleanupCounter cleanupLimit hcleanupLimit controllerTapes layout + outerExtras houter initial hscratch startValue fuelValue hstartFuel hfuel + hqueryValid hqueryLimit + +/-- The complete bounded decoder preserves the append-only output discipline. -/ +theorem outputProbeDecodeNatTM_isTransducer + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) : + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx valueIdx + activeIdx loopIdx fuelIdx).IsTransducer := + outputProbeDecodeNatTM_isTransducer_internal tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat/Defs.lean new file mode 100644 index 00000000..5fbb6660 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat/Defs.lean @@ -0,0 +1,402 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDispatch.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs + +/-! +# Decoding terminated-unary fields through output probes -- definitions + +Formula headers and variable tokens encode natural numbers as a run of one +bits followed by a zero terminator. This module gives that scan a concrete +restartable-probe controller. A persistent `active` register records whether +the terminator is still owed; after it becomes zero, the remaining bounded +iterations are no-ops. +-/ + +namespace Complexity + +namespace TM + +/-- Pure controller state for a bounded terminated-unary probe scan. -/ +structure OutputProbeDecodeNatState where + /-- Current zero-based source-output position. -/ + cursor : ℕ + /-- Accumulated unary value. -/ + value : ℕ + /-- Whether the scan is still waiting for a zero terminator. -/ + active : Bool + deriving DecidableEq + +/-- Six distinct controller registers used by the concrete bounded decoder. + +The role order is cursor, query scratch, value, active flag, loop counter, and +fuel. Packaging the roles as an embedding makes every non-aliasing invariant +structural. -/ +structure OutputProbeDecodeNatLayout (controllerTapes : ℕ) where + /-- Injective assignment of the six logical roles to controller tapes. -/ + roles : Fin 6 ↪ Fin controllerTapes + +/-- Cursor register selected by a decoder layout. -/ +def OutputProbeDecodeNatLayout.cursorIdx + (layout : OutputProbeDecodeNatLayout controllerTapes) : + Fin controllerTapes := + layout.roles 0 + +/-- Query scratch register selected by a decoder layout. -/ +def OutputProbeDecodeNatLayout.scratchIdx + (layout : OutputProbeDecodeNatLayout controllerTapes) : + Fin controllerTapes := + layout.roles 1 + +/-- Unary value register selected by a decoder layout. -/ +def OutputProbeDecodeNatLayout.valueIdx + (layout : OutputProbeDecodeNatLayout controllerTapes) : + Fin controllerTapes := + layout.roles 2 + +/-- Active-flag register selected by a decoder layout. -/ +def OutputProbeDecodeNatLayout.activeIdx + (layout : OutputProbeDecodeNatLayout controllerTapes) : + Fin controllerTapes := + layout.roles 3 + +/-- Loop-counter register selected by a decoder layout. -/ +def OutputProbeDecodeNatLayout.loopIdx + (layout : OutputProbeDecodeNatLayout controllerTapes) : + Fin controllerTapes := + layout.roles 4 + +/-- Preserved fuel register selected by a decoder layout. -/ +def OutputProbeDecodeNatLayout.fuelIdx + (layout : OutputProbeDecodeNatLayout controllerTapes) : + Fin controllerTapes := + layout.roles 5 + +/-- One semantic decoder iteration against a position-indexed bit oracle. + +An unavailable position leaves the decoder active, hence makes the final +bounded result fail. A zero bit consumes the terminator and clears `active`; +a one bit advances both cursor and accumulator. -/ +def outputProbeDecodeNatStep (query : FormulaCode.BitOracle) + (state : OutputProbeDecodeNatState) : OutputProbeDecodeNatState := + if state.active then + match query state.cursor with + | none => state + | some bit => + { cursor := state.cursor + 1 + value := state.value + if bit then 1 else 0 + active := bit } + else + state + +/-- Run exactly `fuel` semantic decoder iterations. -/ +def outputProbeDecodeNatRun (query : FormulaCode.BitOracle) : + ℕ → OutputProbeDecodeNatState → OutputProbeDecodeNatState + | 0, state => state + | fuel + 1, state => + outputProbeDecodeNatRun query fuel + (outputProbeDecodeNatStep query state) + +/-- Read a successful value/cursor pair from a completed decoder state. -/ +def OutputProbeDecodeNatState.result? + (state : OutputProbeDecodeNatState) : Option (ℕ × ℕ) := + if state.active then none else some (state.value, state.cursor) + +/-- Total Boolean view of one finite source-output position. -/ +def outputProbeDecodeNatSourceBit (bits : List Bool) (cursor : ℕ) : Bool := + (bits[cursor]?).getD false + +/-- Pure decoder state after consuming one supplied bit. -/ +def outputProbeDecodeNatStateAfterBit (state : OutputProbeDecodeNatState) + (bit : Bool) : OutputProbeDecodeNatState := + if state.active then + { cursor := state.cursor + 1 + value := state.value + if bit then 1 else 0 + active := bit } + else + state + +/-- Physical controller tape holding the cursor. -/ +def outputProbeDecodeNatCursorIdx (n : ℕ) {controllerTapes : ℕ} + (cursorIdx : Fin controllerTapes) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeIndexedControllerIdx n cursorIdx + +/-- Physical controller tape holding the unary accumulator. -/ +def outputProbeDecodeNatValueIdx (n : ℕ) {controllerTapes : ℕ} + (valueIdx : Fin controllerTapes) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeIndexedControllerIdx n valueIdx + +/-- Physical one-bit register recording whether the terminator is still owed. -/ +def outputProbeDecodeNatActiveIdx (n : ℕ) {controllerTapes : ℕ} + (activeIdx : Fin controllerTapes) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeIndexedControllerIdx n activeIdx + +/-- Stable controller frame after consuming a zero terminator. -/ +def outputProbeDecodeNatZeroOuterExtras (n : ℕ) + {controllerTapes : ℕ} (cursorIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + Function.update + (Function.update outerExtras + (outputProbeDecodeNatActiveIdx n activeIdx) + (outputProbeCounterTape 0)) + (outputProbeDecodeNatCursorIdx n cursorIdx) + (outputProbeCounterTape (cursor + 1)) + +/-- Stable controller frame after consuming one unary one-bit. -/ +def outputProbeDecodeNatOneOuterExtras (n : ℕ) + {controllerTapes : ℕ} (cursorIdx valueIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor value : ℕ) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + Function.update + (Function.update outerExtras + (outputProbeDecodeNatValueIdx n valueIdx) + (outputProbeCounterTape (value + 1))) + (outputProbeDecodeNatCursorIdx n cursorIdx) + (outputProbeCounterTape (cursor + 1)) + +/-- Stable controller frame after consuming the selected decoder bit. -/ +def outputProbeDecodeNatOuterExtrasAfter (n : ℕ) + {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor value : ℕ) (bit : Bool) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + if bit then + outputProbeDecodeNatOneOuterExtras n cursorIdx valueIdx outerExtras + cursor value + else + outputProbeDecodeNatZeroOuterExtras n cursorIdx activeIdx outerExtras + cursor + +/-- Stable controller frame after one semantic decoder-body iteration. + +Inactive states preserve the complete frame. Active states consume the +supplied bit through the same zero/one register updates as the executable +branch continuations. -/ +def outputProbeDecodeNatOuterExtrasStep (n : ℕ) + {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (bit : Bool) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + if state.active then + outputProbeDecodeNatOuterExtrasAfter n cursorIdx valueIdx activeIdx + outerExtras state.cursor state.value bit + else + outerExtras + +/-- Canonical cursor/value/active registers for one semantic decoder state. -/ +def outputProbeDecodeNatStateOuterExtras (n : ℕ) + {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + Function.update + (Function.update + (Function.update outerExtras + (outputProbeDecodeNatCursorIdx n cursorIdx) + (outputProbeCounterTape state.cursor)) + (outputProbeDecodeNatValueIdx n valueIdx) + (outputProbeCounterTape state.value)) + (outputProbeDecodeNatActiveIdx n activeIdx) + (outputProbeCounterTape (if state.active then 1 else 0)) + +/-- Semantic decoder state after exactly `iteration` bounded body steps. -/ +def outputProbeDecodeNatStateAt (bits : List Bool) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + OutputProbeDecodeNatState := + outputProbeDecodeNatRun (FormulaCode.BitOracle.ofList bits) iteration initial + +/-- Canonical loop-counter plus decoder-register frame at one iteration. -/ +def outputProbeDecodeNatLoopOuterExtras (n : ℕ) + {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + (Function.update outerExtras + (outputProbeIndexedControllerIdx n loopIdx) + (outputProbeCounterTape iteration)) + state + +/-- Consume a zero terminator: clear `active`, then advance the cursor. -/ +def outputProbeDecodeNatZeroTM (n controllerTapes : ℕ) + (cursorIdx activeIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM + (clearWorkTM (outputProbeDecodeNatActiveIdx n activeIdx)) + (binarySuccTM (outputProbeDecodeNatCursorIdx n cursorIdx)) + +/-- Consume a unary one: increment the value, then advance the cursor. -/ +def outputProbeDecodeNatOneTM (n controllerTapes : ℕ) + (cursorIdx valueIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM + (binarySuccTM (outputProbeDecodeNatValueIdx n valueIdx)) + (binarySuccTM (outputProbeDecodeNatCursorIdx n cursorIdx)) + +/-- Query and consume one bit while the decoder is active. -/ +def outputProbeDecodeNatActiveTM (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeIndexedResetDispatchTM tm controllerTapes cursorIdx scratchIdx + (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx activeIdx) + (outputProbeDecodeNatOneTM n controllerTapes cursorIdx valueIdx) + +/-- One bounded decoder body iteration. + +The active branch consumes one probed source bit. The inactive branch is a +literal no-op, so a found terminator freezes the decoded value and cursor for +the rest of the public fuel loop. -/ +def outputProbeDecodeNatBodyTM (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + branchWorkSymbolTM (outputProbeDecodeNatActiveIdx n activeIdx) Γ.one + (outputProbeDecodeNatActiveTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx) + skipTM + +/-- Decode one terminated-unary field using at most the fuel stored in a +preserved limit register. + +The caller initializes `loopIdx` to zero, `fuelIdx` to the desired fuel, +`activeIdx` to one, and the cursor/value registers to their initial values. +On success `activeIdx` is zero; if fuel is exhausted first it remains one. -/ +def outputProbeDecodeNatTM (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + binaryForTM + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx) + (outputProbeIndexedControllerIdx n loopIdx) + (outputProbeIndexedControllerIdx n fuelIdx) + +/-- Canonical restored latch frame after exactly `iteration` decoder-body +steps. -/ +def outputProbeDecodeNatFrameCfg (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeLatchTM tm controllerTapes).Q := + outputProbeLatchFrameCfg tm controllerTapes + (outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras + (outputProbeDecodeNatStateAt bits initial iteration) iteration) + input output extras false + +/-- Canonical outer-loop comparison configuration at one decoder iteration. -/ +def outputProbeDecodeNatScanCfg (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx valueIdx + activeIdx loopIdx fuelIdx).Q := + let frame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration + { state := .inl (.scan true) + input := frame.input + work := frame.work + output := frame.output } + +/-- Canonical entry to the decoder body at one bounded iteration. -/ +def outputProbeDecodeNatIterationStartCfg (tm : TM n) + (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx valueIdx + activeIdx loopIdx fuelIdx).Q := + let frame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration + { state := .inr + (binaryForIterationTM + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx) + (outputProbeIndexedControllerIdx n loopIdx)).qstart + input := frame.input + work := frame.work + output := frame.output } + +/-- Canonical iteration endpoint after the body and loop successor have +established the next pure decoder state. -/ +def outputProbeDecodeNatIterationDoneCfg (tm : TM n) + (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx valueIdx + activeIdx loopIdx fuelIdx).Q := + let frame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + (iteration + 1) + { state := .inr + (binaryForIterationTM + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx) + (outputProbeIndexedControllerIdx n loopIdx)).qhalt + input := frame.input + work := frame.work + output := frame.output } + +/-- Canonical halted decoder configuration after exhausting the fuel loop. -/ +def outputProbeDecodeNatDoneCfg (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (fuel : ℕ) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx valueIdx + activeIdx loopIdx fuelIdx).Q := + let frame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial fuel + { state := .inl .done + input := frame.input + work := frame.work + output := frame.output } + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat/Internal.lean new file mode 100644 index 00000000..c4dc3de0 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeNat/Internal.lean @@ -0,0 +1,2354 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +import Complexitylib.Models.TuringMachine.OutputProbeDecodeNat.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDispatch +import Complexitylib.Models.TuringMachine.OutputProbeScan.Internal +import Complexitylib.Models.TuringMachine.Registers.RegisterOps +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork + +/-! +# Decoding terminated-unary fields through output probes -- internals +-/ + +namespace Complexity + +namespace TM + +private theorem OutputProbeDecodeNatLayout.roles_ne_internal + (layout : OutputProbeDecodeNatLayout controllerTapes) + {i j : Fin 6} (hne : i ≠ j) : layout.roles i ≠ layout.roles j := by + intro heq + exact hne (layout.roles.injective heq) + +private theorem outputProbeDecodeNatRun_inactive_internal + (query : FormulaCode.BitOracle) (fuel cursor value : ℕ) : + outputProbeDecodeNatRun query fuel + { cursor := cursor, value := value, active := false } = + { cursor := cursor, value := value, active := false } := by + induction fuel with + | zero => rfl + | succ fuel ih => + simpa [outputProbeDecodeNatRun, outputProbeDecodeNatStep] using ih + +theorem outputProbeDecodeNatRun_result_internal + (query : FormulaCode.BitOracle) (fuel cursor value : ℕ) : + (outputProbeDecodeNatRun query fuel + { cursor := cursor, value := value, active := true }).result? = + FormulaCode.BitOracle.decodeNatAt? query fuel cursor value := by + induction fuel generalizing cursor value with + | zero => rfl + | succ fuel ih => + rw [FormulaCode.BitOracle.decodeNatAt?] + simp only [outputProbeDecodeNatRun, outputProbeDecodeNatStep, if_true] + cases hbit : query cursor with + | none => + simp only + rw [ih] + cases fuel <;> + simp [FormulaCode.BitOracle.decodeNatAt?, hbit] + | some bit => + cases bit with + | false => + simp only [Bool.false_eq_true, ↓reduceIte, Nat.add_zero] + rw [outputProbeDecodeNatRun_inactive_internal] + rfl + | true => + simpa [hbit] using ih (cursor + 1) (value + 1) + +theorem outputProbeDecodeNatStateAt_eq_of_result_internal + (bits : List Bool) (fuel cursor value result nextCursor : ℕ) + (hdecode : FormulaCode.BitOracle.decodeNatAt? + (FormulaCode.BitOracle.ofList bits) fuel cursor value = + some (result, nextCursor)) : + outputProbeDecodeNatStateAt bits + { cursor := cursor, value := value, active := true } fuel = + { cursor := nextCursor, value := result, active := false } := by + let state := outputProbeDecodeNatStateAt bits + { cursor := cursor, value := value, active := true } fuel + have hresult : state.result? = some (result, nextCursor) := by + change (outputProbeDecodeNatRun (FormulaCode.BitOracle.ofList bits) fuel + { cursor := cursor, value := value, active := true }).result? = + some (result, nextCursor) + rw [outputProbeDecodeNatRun_result_internal] + exact hdecode + rcases hstate : state with ⟨stateCursor, stateValue, stateActive⟩ + change state = + { cursor := nextCursor, value := result, active := false } + cases stateActive + · rw [hstate] at hresult ⊢ + simp only [OutputProbeDecodeNatState.result?, Bool.false_eq_true, + if_false, Option.some.injEq, Prod.mk.injEq] at hresult + rcases hresult with ⟨rfl, rfl⟩ + rfl + · rw [hstate] at hresult + simp [OutputProbeDecodeNatState.result?] at hresult + +theorem outputProbeDecodeNatStep_ofList_internal + (bits : List Bool) (state : OutputProbeDecodeNatState) + (hcursor : state.active = true → state.cursor < bits.length) : + outputProbeDecodeNatStep (FormulaCode.BitOracle.ofList bits) state = + if state.active then + { cursor := state.cursor + 1 + value := state.value + + if outputProbeDecodeNatSourceBit bits state.cursor then 1 else 0 + active := outputProbeDecodeNatSourceBit bits state.cursor } + else + state := by + by_cases hactive : state.active + · have hbound := hcursor hactive + simp [outputProbeDecodeNatStep, hactive, FormulaCode.BitOracle.ofList, + outputProbeDecodeNatSourceBit, + List.getElem?_eq_getElem hbound] + · simp [outputProbeDecodeNatStep, hactive] + +theorem outputProbeDecodeNatStep_ofList_eq_afterBit_internal + (bits : List Bool) (state : OutputProbeDecodeNatState) + (hcursor : state.active = true → state.cursor < bits.length) : + outputProbeDecodeNatStep (FormulaCode.BitOracle.ofList bits) state = + outputProbeDecodeNatStateAfterBit state + (outputProbeDecodeNatSourceBit bits state.cursor) := by + rw [outputProbeDecodeNatStep_ofList_internal bits state hcursor] + rfl + +theorem outputProbeDecodeNatOuterExtrasStep_state_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hvalueActive : valueIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (bit : Bool) : + outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state) + state bit = + outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras (outputProbeDecodeNatStateAfterBit state bit) := by + have hcursorValuePhysical : + outputProbeDecodeNatCursorIdx n cursorIdx ≠ + outputProbeDecodeNatValueIdx n valueIdx := by + intro heq + exact hcursorValue (outputProbeIndexedControllerIdx_injective n heq) + have hcursorActivePhysical : + outputProbeDecodeNatCursorIdx n cursorIdx ≠ + outputProbeDecodeNatActiveIdx n activeIdx := by + intro heq + exact hcursorActive (outputProbeIndexedControllerIdx_injective n heq) + have hvalueActivePhysical : + outputProbeDecodeNatValueIdx n valueIdx ≠ + outputProbeDecodeNatActiveIdx n activeIdx := by + intro heq + exact hvalueActive (outputProbeIndexedControllerIdx_injective n heq) + by_cases hactiveState : state.active + · cases bit with + | false => + funext i + simp only [outputProbeDecodeNatOuterExtrasStep, hactiveState, if_true, + outputProbeDecodeNatOuterExtrasAfter, + outputProbeDecodeNatZeroOuterExtras, + outputProbeDecodeNatStateOuterExtras, + outputProbeDecodeNatStateAfterBit, Bool.false_eq_true, if_false] + by_cases hcursor : + i = outputProbeDecodeNatCursorIdx n cursorIdx + · subst i + simp [hcursorActivePhysical, hcursorValuePhysical] + · by_cases hvalue : + i = outputProbeDecodeNatValueIdx n valueIdx + · subst i + simp [hcursor, hvalueActivePhysical] + · by_cases hactive : + i = outputProbeDecodeNatActiveIdx n activeIdx + · subst i + simp [hcursor] + · simp [hcursor, hvalue, hactive] + | true => + funext i + simp only [outputProbeDecodeNatOuterExtrasStep, hactiveState, if_true, + outputProbeDecodeNatOuterExtrasAfter, + outputProbeDecodeNatOneOuterExtras, + outputProbeDecodeNatStateOuterExtras, + outputProbeDecodeNatStateAfterBit] + by_cases hcursor : + i = outputProbeDecodeNatCursorIdx n cursorIdx + · subst i + simp [hcursorActivePhysical, hcursorValuePhysical] + · by_cases hvalue : + i = outputProbeDecodeNatValueIdx n valueIdx + · subst i + simp [hcursor, hvalueActivePhysical] + · by_cases hactive : + i = outputProbeDecodeNatActiveIdx n activeIdx + · subst i + simp [hcursor, hvalue] + · simp [hcursor, hvalue, hactive] + · simp [outputProbeDecodeNatOuterExtrasStep, + outputProbeDecodeNatStateAfterBit, hactiveState] + +theorem outputProbeDecodeNatRun_succ_internal + (query : FormulaCode.BitOracle) (fuel : ℕ) + (state : OutputProbeDecodeNatState) : + outputProbeDecodeNatRun query (fuel + 1) state = + outputProbeDecodeNatStep query + (outputProbeDecodeNatRun query fuel state) := by + induction fuel generalizing state with + | zero => rfl + | succ fuel ih => + simpa [outputProbeDecodeNatRun] using + ih (outputProbeDecodeNatStep query state) + +private theorem outputProbeDecodeNatCounterTape_hasBinaryNat_internal + (value : ℕ) : (outputProbeCounterTape value).HasBinaryNat value := by + simpa [outputProbeCounterTape] using + Tape.init_move_right_hasBinaryNat value + +theorem outputProbeDecodeNatStateOuterExtras_cursor_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) : + (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat state.cursor := by + have hcursorValuePhysical : + outputProbeDecodeNatCursorIdx n cursorIdx ≠ + outputProbeDecodeNatValueIdx n valueIdx := by + intro heq + exact hcursorValue (outputProbeIndexedControllerIdx_injective n heq) + have hcursorActivePhysical : + outputProbeDecodeNatCursorIdx n cursorIdx ≠ + outputProbeDecodeNatActiveIdx n activeIdx := by + intro heq + exact hcursorActive (outputProbeIndexedControllerIdx_injective n heq) + simpa [outputProbeDecodeNatStateOuterExtras, hcursorValuePhysical, + hcursorActivePhysical] using + outputProbeDecodeNatCounterTape_hasBinaryNat_internal state.cursor + +theorem outputProbeDecodeNatStateOuterExtras_value_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (hvalueActive : valueIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) : + (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat state.value := by + have hvalueActivePhysical : + outputProbeDecodeNatValueIdx n valueIdx ≠ + outputProbeDecodeNatActiveIdx n activeIdx := by + intro heq + exact hvalueActive (outputProbeIndexedControllerIdx_injective n heq) + simpa [outputProbeDecodeNatStateOuterExtras, hvalueActivePhysical] using + outputProbeDecodeNatCounterTape_hasBinaryNat_internal state.value + +theorem outputProbeDecodeNatStateOuterExtras_active_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) : + (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat (if state.active then 1 else 0) := by + simpa [outputProbeDecodeNatStateOuterExtras] using + outputProbeDecodeNatCounterTape_hasBinaryNat_internal + (if state.active then 1 else 0) + +theorem outputProbeDecodeNatStateOuterExtras_other_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx idx : Fin controllerTapes) + (hcursor : idx ≠ cursorIdx) (hvalue : idx ≠ valueIdx) + (hactive : idx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) : + outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + outerExtras state (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := by + have hcursorPhysical : outputProbeIndexedControllerIdx n idx ≠ + outputProbeDecodeNatCursorIdx n cursorIdx := by + intro heq + exact hcursor (outputProbeIndexedControllerIdx_injective n heq) + have hvaluePhysical : outputProbeIndexedControllerIdx n idx ≠ + outputProbeDecodeNatValueIdx n valueIdx := by + intro heq + exact hvalue (outputProbeIndexedControllerIdx_injective n heq) + have hactivePhysical : outputProbeIndexedControllerIdx n idx ≠ + outputProbeDecodeNatActiveIdx n activeIdx := by + intro heq + exact hactive (outputProbeIndexedControllerIdx_injective n heq) + simp [outputProbeDecodeNatStateOuterExtras, hcursorPhysical, + hvaluePhysical, hactivePhysical] + +theorem outputProbeDecodeNatLoopOuterExtras_loop_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (hloopCursor : loopIdx ≠ cursorIdx) + (hloopValue : loopIdx ≠ valueIdx) + (hloopActive : loopIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) : + (outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras state iteration + (outputProbeIndexedControllerIdx n loopIdx)).HasBinaryNat iteration := by + rw [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatStateOuterExtras_other_internal n cursorIdx valueIdx + activeIdx loopIdx hloopCursor hloopValue hloopActive] + rw [Function.update_self] + exact Tape.init_move_right_hasBinaryNat iteration + +/-- Canonical decoder-register contents make the loop-frame normalization a +literal no-op. -/ +theorem outputProbeDecodeNatLoopOuterExtras_eq_self_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat state.cursor) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat state.value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat (if state.active then 1 else 0)) + (hloop : + (outerExtras (outputProbeIndexedControllerIdx n loopIdx)) + |>.HasBinaryNat iteration) : + outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx loopIdx + outerExtras state iteration = outerExtras := by + have hcursorEq : outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx) = + outputProbeCounterTape state.cursor := by + simpa [outputProbeCounterTape] using hcursor.eq_init_move_right + have hvalueEq : outerExtras (outputProbeDecodeNatValueIdx n valueIdx) = + outputProbeCounterTape state.value := by + simpa [outputProbeCounterTape] using hvalue.eq_init_move_right + have hactiveEq : outerExtras (outputProbeDecodeNatActiveIdx n activeIdx) = + outputProbeCounterTape (if state.active then 1 else 0) := by + simpa [outputProbeCounterTape] using hactive.eq_init_move_right + have hloopEq : outerExtras (outputProbeIndexedControllerIdx n loopIdx) = + outputProbeCounterTape iteration := by + simpa [outputProbeCounterTape] using hloop.eq_init_move_right + rw [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatStateOuterExtras] + rw [← hloopEq, Function.update_eq_self] + rw [← hcursorEq, Function.update_eq_self] + rw [← hvalueEq, Function.update_eq_self] + rw [← hactiveEq, Function.update_eq_self] + +private theorem outputProbeDecodeNatCounterTape_parked_internal + (value : ℕ) : Parked (outputProbeCounterTape value) := by + have h : (outputProbeCounterTape value).HasBinaryNat value := by + simpa [outputProbeCounterTape] using + Tape.init_move_right_hasBinaryNat value + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem outputProbeDecodeNatUpdateOuter_parked_internal + (n : ℕ) {controllerTapes : ℕ} + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (idx : Fin controllerTapes) (value : ℕ) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) + (outputProbeCounterTape value) i) := by + intro i hi + by_cases heq : i = outputProbeIndexedControllerIdx n idx + · subst i + rw [Function.update_self] + exact outputProbeDecodeNatCounterTape_parked_internal value + · rw [Function.update_of_ne heq] + exact houter i hi + +theorem outputProbeDecodeNatStateOuterExtras_parked_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (state : OutputProbeDecodeNatState) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx + activeIdx outerExtras state i) := by + have hcursor := outputProbeDecodeNatUpdateOuter_parked_internal n + outerExtras houter cursorIdx state.cursor + have hvalue := outputProbeDecodeNatUpdateOuter_parked_internal n + (Function.update outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx) + (outputProbeCounterTape state.cursor)) hcursor valueIdx state.value + have hactive := outputProbeDecodeNatUpdateOuter_parked_internal n + (Function.update + (Function.update outerExtras + (outputProbeDecodeNatCursorIdx n cursorIdx) + (outputProbeCounterTape state.cursor)) + (outputProbeDecodeNatValueIdx n valueIdx) + (outputProbeCounterTape state.value)) hvalue activeIdx + (if state.active then 1 else 0) + simpa [outputProbeDecodeNatStateOuterExtras, + outputProbeDecodeNatCursorIdx, outputProbeDecodeNatValueIdx, + outputProbeDecodeNatActiveIdx] using hactive + +theorem outputProbeDecodeNatLoopOuterExtras_parked_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (state : OutputProbeDecodeNatState) (iteration : ℕ) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx + activeIdx loopIdx outerExtras state iteration i) := by + have hloop := outputProbeDecodeNatUpdateOuter_parked_internal n + outerExtras houter loopIdx iteration + exact outputProbeDecodeNatStateOuterExtras_parked_internal n cursorIdx + valueIdx activeIdx + (Function.update outerExtras (outputProbeIndexedControllerIdx n loopIdx) + (outputProbeCounterTape iteration)) hloop state + +theorem outputProbeDecodeNatLoopOuterExtras_other_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx idx : Fin controllerTapes) + (hcursor : idx ≠ cursorIdx) (hvalue : idx ≠ valueIdx) + (hactive : idx ≠ activeIdx) (hloop : idx ≠ loopIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) : + outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras state iteration + (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := by + rw [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatStateOuterExtras_other_internal n cursorIdx valueIdx + activeIdx idx hcursor hvalue hactive] + rw [Function.update_of_ne] + intro heq + exact hloop (outputProbeIndexedControllerIdx_injective n heq) + +theorem outputProbeDecodeNatFrameCfg_post_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras + (outputProbeDecodeNatStateAt bits initial iteration) iteration) + input output extras false + (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).input + (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work + (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).output := by + exact outputProbeLatchFrameCfg_post tm controllerTapes _ input output extras + false + +theorem outputProbeDecodeNatFrameCfg_parked_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houtput : Parked output) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + Parked (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).input ∧ + (∀ i, Parked + ((outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work i)) ∧ + Parked (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).output := by + exact outputProbeLatchFramePost_parked tm controllerTapes _ input output + extras false hextras + (outputProbeDecodeNatLoopOuterExtras_parked_internal n cursorIdx valueIdx + activeIdx loopIdx outerExtras houter + (outputProbeDecodeNatStateAt bits initial iteration) iteration) + houtput _ _ _ + (outputProbeDecodeNatFrameCfg_post_internal tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration) + +theorem outputProbeDecodeNatFrameCfg_cursor_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + ((outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat + (outputProbeDecodeNatStateAt bits initial iteration).cursor := by + change ((outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work (outputProbeIndexedControllerIdx n cursorIdx)) + |>.HasBinaryNat + (outputProbeDecodeNatStateAt bits initial iteration).cursor + rw [outputProbeLatchFramePost_controller tm controllerTapes _ input output + extras false _ _ _ + (outputProbeDecodeNatFrameCfg_post_internal tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration) + cursorIdx] + exact outputProbeDecodeNatStateOuterExtras_cursor_internal n cursorIdx + valueIdx activeIdx hcursorValue hcursorActive _ _ + +theorem outputProbeDecodeNatFrameCfg_value_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (hvalueActive : valueIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + ((outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat + (outputProbeDecodeNatStateAt bits initial iteration).value := by + change ((outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work (outputProbeIndexedControllerIdx n valueIdx)) + |>.HasBinaryNat + (outputProbeDecodeNatStateAt bits initial iteration).value + rw [outputProbeLatchFramePost_controller tm controllerTapes _ input output + extras false _ _ _ + (outputProbeDecodeNatFrameCfg_post_internal tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration) + valueIdx] + exact outputProbeDecodeNatStateOuterExtras_value_internal n cursorIdx + valueIdx activeIdx hvalueActive _ _ + +theorem outputProbeDecodeNatFrameCfg_active_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + ((outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat + (if (outputProbeDecodeNatStateAt bits initial iteration).active then + 1 else 0) := by + change ((outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work (outputProbeIndexedControllerIdx n activeIdx)) + |>.HasBinaryNat + (if (outputProbeDecodeNatStateAt bits initial iteration).active then + 1 else 0) + rw [outputProbeLatchFramePost_controller tm controllerTapes _ input output + extras false _ _ _ + (outputProbeDecodeNatFrameCfg_post_internal tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration) + activeIdx] + exact outputProbeDecodeNatStateOuterExtras_active_internal n cursorIdx + valueIdx activeIdx _ _ + +theorem outputProbeDecodeNatFrameCfg_loop_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (hloopCursor : loopIdx ≠ cursorIdx) + (hloopValue : loopIdx ≠ valueIdx) + (hloopActive : loopIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + ((outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work (outputProbeIndexedControllerIdx n loopIdx)) + |>.HasBinaryNat iteration := by + rw [outputProbeLatchFramePost_controller tm controllerTapes _ input output + extras false _ _ _ + (outputProbeDecodeNatFrameCfg_post_internal tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration) + loopIdx] + exact outputProbeDecodeNatLoopOuterExtras_loop_internal n cursorIdx valueIdx + activeIdx loopIdx hloopCursor hloopValue hloopActive outerExtras _ iteration + +theorem outputProbeDecodeNatFrameCfg_other_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx activeIdx loopIdx idx : Fin controllerTapes) + (hcursor : idx ≠ cursorIdx) (hvalue : idx ≠ valueIdx) + (hactive : idx ≠ activeIdx) (hloop : idx ≠ loopIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) : + (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := by + rw [outputProbeLatchFramePost_controller tm controllerTapes _ input output + extras false _ _ _ + (outputProbeDecodeNatFrameCfg_post_internal tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration) + idx] + exact outputProbeDecodeNatLoopOuterExtras_other_internal n cursorIdx valueIdx + activeIdx loopIdx idx hcursor hvalue hactive hloop outerExtras _ iteration + +theorem outputProbeDecodeNatStateAt_succ_internal + (bits : List Bool) (initial : OutputProbeDecodeNatState) (iteration : ℕ) + (hcursor : (outputProbeDecodeNatStateAt bits initial iteration).active = + true → + (outputProbeDecodeNatStateAt bits initial iteration).cursor < + bits.length) : + outputProbeDecodeNatStateAt bits initial (iteration + 1) = + outputProbeDecodeNatStateAfterBit + (outputProbeDecodeNatStateAt bits initial iteration) + (outputProbeDecodeNatSourceBit bits + (outputProbeDecodeNatStateAt bits initial iteration).cursor) := by + rw [outputProbeDecodeNatStateAt, outputProbeDecodeNatRun_succ_internal] + exact outputProbeDecodeNatStep_ofList_eq_afterBit_internal bits _ hcursor + +theorem outputProbeDecodeNatLoopOuterExtras_step_internal + (n : ℕ) {controllerTapes : ℕ} + (cursorIdx valueIdx activeIdx loopIdx : Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hvalueActive : valueIdx ≠ activeIdx) + (hloopCursor : loopIdx ≠ cursorIdx) + (hloopValue : loopIdx ≠ valueIdx) + (hloopActive : loopIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (iteration : ℕ) (bit : Bool) : + Function.update + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + (outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras state iteration) + state bit) + (outputProbeIndexedControllerIdx n loopIdx) + (outputProbeCounterTape (iteration + 1)) = + outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras (outputProbeDecodeNatStateAfterBit state bit) + (iteration + 1) := by + rw [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatOuterExtrasStep_state_internal n cursorIdx valueIdx + activeIdx hcursorValue hcursorActive hvalueActive] + funext i + have hloopCursorPhysical : outputProbeIndexedControllerIdx n loopIdx ≠ + outputProbeDecodeNatCursorIdx n cursorIdx := by + intro heq + exact hloopCursor (outputProbeIndexedControllerIdx_injective n heq) + have hloopValuePhysical : outputProbeIndexedControllerIdx n loopIdx ≠ + outputProbeDecodeNatValueIdx n valueIdx := by + intro heq + exact hloopValue (outputProbeIndexedControllerIdx_injective n heq) + have hloopActivePhysical : outputProbeIndexedControllerIdx n loopIdx ≠ + outputProbeDecodeNatActiveIdx n activeIdx := by + intro heq + exact hloopActive (outputProbeIndexedControllerIdx_injective n heq) + have hcursorValuePhysical : outputProbeDecodeNatCursorIdx n cursorIdx ≠ + outputProbeDecodeNatValueIdx n valueIdx := by + intro heq + exact hcursorValue (outputProbeIndexedControllerIdx_injective n heq) + have hcursorActivePhysical : outputProbeDecodeNatCursorIdx n cursorIdx ≠ + outputProbeDecodeNatActiveIdx n activeIdx := by + intro heq + exact hcursorActive (outputProbeIndexedControllerIdx_injective n heq) + have hvalueActivePhysical : outputProbeDecodeNatValueIdx n valueIdx ≠ + outputProbeDecodeNatActiveIdx n activeIdx := by + intro heq + exact hvalueActive (outputProbeIndexedControllerIdx_injective n heq) + by_cases hloop : i = outputProbeIndexedControllerIdx n loopIdx + · subst i + simp [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatStateOuterExtras, hloopCursorPhysical, + hloopValuePhysical, hloopActivePhysical] + · by_cases hcursor : i = outputProbeDecodeNatCursorIdx n cursorIdx + · subst i + rw [Function.update_of_ne hloop] + simp [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatStateOuterExtras, + hcursorValuePhysical, hcursorActivePhysical] + · by_cases hvalue : i = outputProbeDecodeNatValueIdx n valueIdx + · subst i + rw [Function.update_of_ne hloop] + simp [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatStateOuterExtras, + hvalueActivePhysical] + · by_cases hactive : i = outputProbeDecodeNatActiveIdx n activeIdx + · subst i + rw [Function.update_of_ne hloop] + simp [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatStateOuterExtras] + · simp [outputProbeDecodeNatLoopOuterExtras, + outputProbeDecodeNatStateOuterExtras, hloop, hcursor, hvalue, + hactive] + +private theorem outputProbeDecodeNatSucc_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (idx : Fin controllerTapes) (value : ℕ) + (hvalue : + (outerExtras (outputProbeIndexedControllerIdx n idx)).HasBinaryNat + value) : + (binarySuccTM + (outputProbeIndexedControllerIdx n idx)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) + (outputProbeCounterTape (value + 1))) + input output extras false) + (binarySuccTime value) := by + let physical := outputProbeIndexedControllerIdx n idx + let nextTape := outputProbeCounterTape (value + 1) + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + have htarget : (work physical).HasBinaryNat value := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false inp work out hpost idx] + exact hvalue + obtain ⟨done, hreach, hhalt, hinputDone, hotherDone, htargetDone, + houtputDone⟩ := + binarySuccTM_reachesIn_frame physical value inp work out htarget + hinput.read_ne_start (fun i _ => (hwork i).read_ne_start) + hout.read_ne_start + have hworkDone : done.work = Function.update work physical nextTape := by + funext i + by_cases hi : i = physical + · subst i + rw [Function.update_self] + exact htargetDone.eq_init_move_right + · rw [Function.update_of_ne hi] + exact hotherDone i hi + refine ⟨done, binarySuccTime value, le_rfl, hreach, hhalt, ?_⟩ + rw [hinputDone, hworkDone, houtputDone] + simpa [physical, nextTape] using + outputProbeLatchFramePost_updateController tm controllerTapes outerExtras + input output extras false inp work out hpost idx nextTape + +private theorem outputProbeDecodeNatClear_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (idx : Fin controllerTapes) + (hone : + (outerExtras (outputProbeIndexedControllerIdx n idx)).HasBinaryNat 1) : + (clearWorkTM + (outputProbeIndexedControllerIdx n idx)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) + (outputProbeCounterTape 0)) + input output extras false) + (clearWorkTimeBound 1) := by + let physical := outputProbeIndexedControllerIdx n idx + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + have htargetNat : (work physical).HasBinaryNat 1 := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false inp work out hpost idx] + exact hone + have htarget : work physical = + (Tape.init ((1 : ℕ).bits.map Γ.ofBool)).move Dir3.right := + htargetNat.eq_init_move_right + have hclear := clearWorkTM_hoareTime_frame physical (1 : ℕ).bits inp work out + htarget hinput (fun i _ => hwork i) hout + obtain ⟨done, elapsed, helapsed, hreach, hhalt, hinputDone, hworkDone, + houtputDone⟩ := hclear inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨done, elapsed, ?_, hreach, hhalt, ?_⟩ + · simpa using helapsed + · rw [hinputDone, hworkDone, houtputDone] + simpa [physical, outputProbeCounterTape] using + outputProbeLatchFramePost_updateController tm controllerTapes + outerExtras input output extras false inp work out hpost idx + (outputProbeCounterTape 0) + +theorem outputProbeDecodeNatZeroTM_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx activeIdx : Fin controllerTapes) + (hdistinct : cursorIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (cursor : ℕ) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1) : + (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatZeroOuterExtras n cursorIdx activeIdx outerExtras + cursor) + input output extras false) + (clearWorkTimeBound 1 + 1 + binarySuccTime cursor) := by + let activePhysical := outputProbeDecodeNatActiveIdx n activeIdx + let cursorPhysical := outputProbeDecodeNatCursorIdx n cursorIdx + let clearedOuter := Function.update outerExtras activePhysical + (outputProbeCounterTape 0) + have hphysical : cursorPhysical ≠ activePhysical := by + intro heq + exact hdistinct + (outputProbeIndexedControllerIdx_injective n heq) + have hclear := outputProbeDecodeNatClear_hoareTime_internal tm + controllerTapes outerExtras input output extras hextras houter houtput + activeIdx hactive + have hclearedParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (clearedOuter i) := + outputProbeDecodeNatUpdateOuter_parked_internal n outerExtras houter + activeIdx 0 + have hclearedCursor : (clearedOuter cursorPhysical).HasBinaryNat cursor := by + dsimp only [clearedOuter] + rw [Function.update_of_ne hphysical] + exact hcursor + have hsucc := outputProbeDecodeNatSucc_hoareTime_internal tm + controllerTapes clearedOuter input output extras hextras hclearedParked + houtput cursorIdx cursor hclearedCursor + apply seqTM_hoareTime _ _ hclear + · intro inp work out hpost + obtain ⟨hinp, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes clearedOuter input output extras false hextras + hclearedParked houtput inp work out hpost + obtain ⟨hinpEq, hworkEq, houtEq⟩ := + phaseTransition_eq_self_of_reads_ne_start hinp.read_ne_start + (fun i => (hwork i).read_ne_start) hout.read_ne_start + simpa [hinpEq, hworkEq, houtEq] using hpost + · simpa [outputProbeDecodeNatZeroTM, + outputProbeDecodeNatZeroOuterExtras, clearedOuter, activePhysical, + cursorPhysical] using hsucc + +theorem outputProbeDecodeNatOneTM_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx valueIdx : Fin controllerTapes) + (hdistinct : cursorIdx ≠ valueIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (cursor value : ℕ) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat value) : + (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOneOuterExtras n cursorIdx valueIdx outerExtras + cursor value) + input output extras false) + (binarySuccTime value + 1 + binarySuccTime cursor) := by + let valuePhysical := outputProbeDecodeNatValueIdx n valueIdx + let cursorPhysical := outputProbeDecodeNatCursorIdx n cursorIdx + let incrementedOuter := Function.update outerExtras valuePhysical + (outputProbeCounterTape (value + 1)) + have hphysical : cursorPhysical ≠ valuePhysical := by + intro heq + exact hdistinct + (outputProbeIndexedControllerIdx_injective n heq) + have hvalueSucc := outputProbeDecodeNatSucc_hoareTime_internal tm + controllerTapes outerExtras input output extras hextras houter houtput + valueIdx value hvalue + have hincrementedParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (incrementedOuter i) := + outputProbeDecodeNatUpdateOuter_parked_internal n outerExtras houter + valueIdx (value + 1) + have hincrementedCursor : + (incrementedOuter cursorPhysical).HasBinaryNat cursor := by + dsimp only [incrementedOuter] + rw [Function.update_of_ne hphysical] + exact hcursor + have hcursorSucc := outputProbeDecodeNatSucc_hoareTime_internal tm + controllerTapes incrementedOuter input output extras hextras + hincrementedParked houtput cursorIdx cursor hincrementedCursor + apply seqTM_hoareTime _ _ hvalueSucc + · intro inp work out hpost + obtain ⟨hinp, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes incrementedOuter input output extras false hextras + hincrementedParked houtput inp work out hpost + obtain ⟨hinpEq, hworkEq, houtEq⟩ := + phaseTransition_eq_self_of_reads_ne_start hinp.read_ne_start + (fun i => (hwork i).read_ne_start) hout.read_ne_start + simpa [hinpEq, hworkEq, houtEq] using hpost + · simpa [outputProbeDecodeNatOneTM, + outputProbeDecodeNatOneOuterExtras, incrementedOuter, valuePhysical, + cursorPhysical] using hcursorSucc + +theorem outputProbeDecodeNatActiveTM_of_latch_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (cursor value : ℕ) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace inputLength clearInitialSpace zeroInitialSpace + oneInitialSpace : ℕ} + (hlatch : (outputProbeIndexedLatchTM tm controllerTapes cursorIdx + scratchIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + latchTime inputLength latchSpace) + (hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength clearInitialSpace) + (hzeroInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).Q).WithinAuxSpace inputLength zeroInitialSpace) + (honeInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).Q).WithinAuxSpace inputLength oneInitialSpace) : + (outputProbeDecodeNatActiveTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasAfter n cursorIdx valueIdx activeIdx + outerExtras cursor value bit) + input output extras false) + (latchTime + 1 + + outputProbeLatchDispatchTime bit + (clearWorkTimeBound 1 + 1 + binarySuccTime cursor) + (clearWorkTimeBound 1 + 1 + + (binarySuccTime value + 1 + binarySuccTime cursor))) + inputLength + (max latchSpace + (if bit then + max (clearInitialSpace + clearWorkTimeBound 1) + (oneInitialSpace + + (binarySuccTime value + 1 + binarySuccTime cursor)) + else + zeroInitialSpace + + (clearWorkTimeBound 1 + 1 + binarySuccTime cursor))) := by + have hzeroTime := outputProbeDecodeNatZeroTM_hoareTime_internal tm + controllerTapes cursorIdx activeIdx hcursorActive outerExtras input output + extras hextras houter houtput cursor hcursor hactive + have hzero := hzeroTime.toHoareTimeSpace hzeroInitial + have honeTime := outputProbeDecodeNatOneTM_hoareTime_internal tm + controllerTapes cursorIdx valueIdx hcursorValue outerExtras input output + extras hextras houter houtput cursor value hcursor hvalue + have hone := honeTime.toHoareTimeSpace honeInitial + simpa [outputProbeDecodeNatActiveTM, + outputProbeDecodeNatOuterExtrasAfter] using + outputProbeIndexedResetDispatchTM_of_latch_hoareTimeSpace tm + controllerTapes cursorIdx scratchIdx outerExtras input output extras bit + hextras houter houtput + (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx activeIdx) + (outputProbeDecodeNatOneTM n controllerTapes cursorIdx valueIdx) + (post := fun branch => + outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasAfter n cursorIdx valueIdx activeIdx + outerExtras cursor value branch) + input output extras false) + hlatch hclearInitial hzero hone + +theorem ComputesInSpace.outputProbeDecodeNatActiveTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorScratch : cursorIdx ≠ scratchIdx) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (value : ℕ) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + (∀ inp work out, pre inp work out → + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).input ∧ + work = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).work ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false).output) ∧ + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeNatActiveTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasAfter n cursorIdx valueIdx + activeIdx outerExtras cursor value + ((f input)[cursor]'hcursorBound)) + input output extras false) + bodyBound := by + let frame := outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false + let queryFrame := placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes + outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (cursor + 1)) output extras) + let frameSpace := Finset.univ.sup fun i => (extras i).head + let outerFrameSpace := Finset.univ.sup fun i => (outerExtras i).head + let initialSpace := Finset.univ.sup fun i => (frame.work i).head + let pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes) := + fun inp work out => + inp = queryFrame.input ∧ work = frame.work ∧ out = output + have hframePost := outputProbeLatchFrameCfg_post tm controllerTapes + outerExtras input output extras false + have hparked := outputProbeLatchFramePost_parked tm controllerTapes + outerExtras input output extras false hextras houter houtput frame.input + frame.work frame.output hframePost + have hframeBound : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace := by + intro i _hi + exact Finset.le_sup (f := fun j => (extras j).head) + (Finset.mem_univ i) + have houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start := by + intro i hi + exact (houter i hi).read_ne_start + have houterBound : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace := by + intro i _hi + exact Finset.le_sup (f := fun j => (outerExtras j).head) + (Finset.mem_univ i) + have hworkBound : ∀ i, (frame.work i).head ≤ initialSpace := by + intro i + exact Finset.le_sup (f := fun j => (frame.work j).head) + (Finset.mem_univ i) + have hqueryInput : queryFrame.input = frame.input := by + rfl + have hqueryOutput : frame.output = output := by + simp [frame, outputProbeLatchFrameCfg, outputProbeLatchInnerFrameCfg, + outputProbePlacedFrameCfg] + have hcursorWork : + (frame.work (outputProbeIndexedControllerIdx n cursorIdx)) + |>.HasBinaryNat cursor := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false frame.input frame.work frame.output hframePost + cursorIdx] + exact hcursor + have hscratchWork : + (frame.work (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0 := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false frame.input frame.work frame.output hframePost + scratchIdx] + exact hscratch + have hframeWork : frame.work = Function.update queryFrame.work + (outputProbeIndexedCountdownIdx n controllerTapes) + (outputProbeCounterTape 0) := by + exact outputProbeLatchFrameCfg_work_eq_queryUpdate tm input output extras + hcleanupCounter controllerTapes cursor outerExtras + have hcountdown : + (frame.work (outputProbeIndexedCountdownIdx n controllerTapes)) + |>.HasBinaryNat 0 := by + rw [hframeWork, Function.update_self] + exact Tape.init_move_right_hasBinaryNat 0 + have hqueryWork : ∀ i, + i ≠ outputProbeIndexedCountdownIdx n controllerTapes → + frame.work i = queryFrame.work i := by + intro i hi + rw [hframeWork, Function.update_of_ne hi] + have hinputSpace : queryFrame.input.head ≤ + input.length + initialSpace + 1 := by + simp [queryFrame, outputProbePlacedFrameCfg, outputProbeStartedCfg, + Tape.move] + obtain ⟨latchTime, hlatch⟩ := + hcomp.outputProbeIndexedLatchTM_hoareTimeSpace input cursor hcursorBound + output houtput extras frameSpace cleanupLimit hextras hframeBound + hcleanupCounter hcleanupLimit hlimit controllerTapes outerExtras + outerFrameSpace houterRead houterBound cursorIdx scratchIdx + hcursorScratch initialSpace frame.work hcursorWork hcountdown + hscratchWork (hqueryInput ▸ hparked.1) hparked.2.1 hworkBound hinputSpace + hqueryWork + let falseFrame := outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras false + let trueFrame := outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras true + let falseSpace := Finset.univ.sup fun i => (falseFrame.work i).head + let trueSpace := Finset.univ.sup fun i => (trueFrame.work i).head + have hframeInitial (bit : Bool) : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit inp work out → + ({ state := (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).Q).WithinAuxSpace input.length + (Finset.univ.sup fun i => + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras bit).work i).head) := by + intro inp work out hpost + obtain ⟨hinp, hwork, _hout⟩ := outputProbeLatchFramePost_eq_frameCfg tm + controllerTapes outerExtras input output extras bit inp work out hpost + subst inp + subst work + constructor + · intro i + exact Finset.le_sup + (f := fun j => + ((outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras bit).work j).head) + (Finset.mem_univ i) + · simp [outputProbeLatchFrameCfg, outputProbeLatchInnerFrameCfg, + outputProbePlacedFrameCfg, outputProbeStartedCfg, Tape.move] + have hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM (outputProbeLatchIdx n controllerTapes)).Q + ).WithinAuxSpace input.length trueSpace := by + simpa [trueSpace, trueFrame] using hframeInitial true + have hzeroInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).Q).WithinAuxSpace input.length falseSpace := by + simpa [falseSpace, falseFrame] using hframeInitial false + have honeInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + ({ state := (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).Q).WithinAuxSpace input.length falseSpace := by + simpa [falseSpace, falseFrame] using hframeInitial false + let bodyBound := outputProbeIndexedPrepareTime cursor + 1 + latchTime + 1 + + outputProbeLatchDispatchTime ((f input)[cursor]'hcursorBound) + (clearWorkTimeBound 1 + 1 + binarySuccTime cursor) + (clearWorkTimeBound 1 + 1 + + (binarySuccTime value + 1 + binarySuccTime cursor)) + have hbody := + outputProbeDecodeNatActiveTM_of_latch_hoareTimeSpace_internal tm + controllerTapes cursorIdx scratchIdx valueIdx activeIdx hcursorValue + hcursorActive outerExtras input output extras + ((f input)[cursor]'hcursorBound) hextras houter houtput cursor value + hcursor hvalue hactive hlatch hclearInitial hzeroInitial honeInitial + refine ⟨bodyBound, pre, ?_, ?_, ?_⟩ + · intro inp work out hpre + exact ⟨hpre.1.trans hqueryInput, hpre.2.1, + hpre.2.2.trans hqueryOutput.symm⟩ + · exact ⟨hqueryInput.symm, rfl, hqueryOutput⟩ + · simpa [bodyBound] using hbody.1 + +theorem ComputesInSpace.outputProbeDecodeNatBodyTM_active_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorScratch : cursorIdx ≠ scratchIdx) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat cursor) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (value : ℕ) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasAfter n cursorIdx valueIdx + activeIdx outerExtras cursor value + ((f input)[cursor]'hcursorBound)) + input output extras false) + bodyBound := by + obtain ⟨activeBound, pre, hpreExact, hpre, hactiveRun⟩ := + hcomp.outputProbeDecodeNatActiveTM_hoareTime_internal input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit controllerTapes outerExtras houter cursorIdx + scratchIdx valueIdx activeIdx hcursorScratch hcursorValue hcursorActive + hcursor hscratch value hvalue hactive + let frame := outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras false + have hframePost := outputProbeLatchFrameCfg_post tm controllerTapes + outerExtras input output extras false + have hparked := outputProbeLatchFramePost_parked tm controllerTapes + outerExtras input output extras false hextras houter houtput frame.input + frame.work frame.output hframePost + let activePhysical := outputProbeDecodeNatActiveIdx n activeIdx + have hactiveFrame : (frame.work activePhysical).HasBinaryNat 1 := by + dsimp only [activePhysical, outputProbeDecodeNatActiveIdx] + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false frame.input frame.work frame.output hframePost + activeIdx] + exact hactive + have hactiveRead : (frame.work activePhysical).read = Γ.one := by + rw [hactiveFrame.eq_init_move_right] + rfl + have hbody := branchWorkSymbolTM_hoareTime_equal activePhysical Γ.one + (outputProbeDecodeNatActiveTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx) + skipTM + (fun inp work out hp => by + rw [(hpreExact inp work out hp).2.1] + exact hactiveRead) + (fun inp work out hp => by + rw [(hpreExact inp work out hp).1] + exact hparked.1.read_ne_start) + (fun inp work out hp i => by + rw [(hpreExact inp work out hp).2.1] + exact (hparked.2.1 i).read_ne_start) + (fun inp work out hp => by + rw [(hpreExact inp work out hp).2.2] + exact hparked.2.2.read_ne_start) + hactiveRun + refine ⟨activeBound + 1, pre, hpre, ?_⟩ + simpa [outputProbeDecodeNatBodyTM, activePhysical] using hbody + +theorem outputProbeDecodeNatBodyTM_inactive_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hinactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 0) : + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + 2 := by + let activePhysical := outputProbeDecodeNatActiveIdx n activeIdx + have hinactiveController : + (outerExtras (outputProbeIndexedControllerIdx n activeIdx)) + |>.HasBinaryNat 0 := by + simpa [outputProbeDecodeNatActiveIdx] using hinactive + have hskip : (skipTM (n := 0 + outputProbeControllerTapes n + + controllerTapes)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + 1 := by + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + obtain ⟨done, elapsed, helapsed, hreach, hhalt, hinputDone, hworkDone, + houtputDone⟩ := + skipTM_hoareTime_frame inp work out hinput hwork hout inp work out + ⟨rfl, rfl, rfl⟩ + refine ⟨done, elapsed, helapsed, hreach, hhalt, ?_⟩ + simpa [hinputDone, hworkDone, houtputDone] using hpost + have hbody := branchWorkSymbolTM_hoareTime_different activePhysical Γ.one + (outputProbeDecodeNatActiveTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx) + skipTM + (fun inp work out hpost => by + have hcontroller := outputProbeLatchFramePost_controller tm + controllerTapes outerExtras input output extras false inp work out + hpost activeIdx + dsimp only [activePhysical, outputProbeDecodeNatActiveIdx] + rw [hcontroller, hinactiveController.eq_init_move_right] + decide) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras input + output extras false hextras houter houtput inp work out hpost).1 + |>.read_ne_start) + (fun inp work out hpost i => + ((outputProbeLatchFramePost_parked tm controllerTapes outerExtras input + output extras false hextras houter houtput inp work out hpost).2.1 i) + |>.read_ne_start) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras input + output extras false hextras houter houtput inp work out hpost).2.2 + |>.read_ne_start) + hskip + simpa [outputProbeDecodeNatBodyTM, activePhysical] using hbody + +theorem ComputesInSpace.outputProbeDecodeNatBodyTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (state : OutputProbeDecodeNatState) + (hcursorBound : state.active = true → + state.cursor < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : state.active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + (state.cursor + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (hcursorScratch : cursorIdx ≠ scratchIdx) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hcursor : + (outerExtras (outputProbeDecodeNatCursorIdx n cursorIdx)) + |>.HasBinaryNat state.cursor) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n scratchIdx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras (outputProbeDecodeNatValueIdx n valueIdx)) + |>.HasBinaryNat state.value) + (hactive : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat (if state.active then 1 else 0)) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state + (outputProbeDecodeNatSourceBit (f input) state.cursor)) + input output extras false) + bodyBound := by + by_cases hactiveState : state.active + · have hbound := hcursorBound hactiveState + have hlimitState := hlimit hactiveState + have hactiveOne : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 1 := by + simpa [hactiveState] using hactive + obtain ⟨bodyBound, pre, hpre, hbody⟩ := + hcomp.outputProbeDecodeNatBodyTM_active_hoareTime_internal input + state.cursor hbound output houtput extras hextras hcleanupCounter + cleanupLimit hcleanupLimit hlimitState controllerTapes outerExtras + houter cursorIdx scratchIdx valueIdx activeIdx hcursorScratch + hcursorValue hcursorActive hcursor hscratch state.value hvalue + hactiveOne + have hbit : outputProbeDecodeNatSourceBit (f input) state.cursor = + (f input)[state.cursor] := by + simp [outputProbeDecodeNatSourceBit, + List.getElem?_eq_getElem hbound] + refine ⟨bodyBound, pre, hpre, ?_⟩ + simpa [outputProbeDecodeNatOuterExtrasStep, hactiveState, hbit] using + hbody + · have hinactiveZero : + (outerExtras (outputProbeDecodeNatActiveIdx n activeIdx)) + |>.HasBinaryNat 0 := by + simpa [hactiveState] using hactive + let pre := outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras false + have hpre := outputProbeLatchFrameCfg_post tm controllerTapes outerExtras + input output extras false + have hbody := outputProbeDecodeNatBodyTM_inactive_hoareTime_internal tm + controllerTapes cursorIdx scratchIdx valueIdx activeIdx outerExtras + input output extras hextras houter houtput hinactiveZero + refine ⟨2, pre, ?_, ?_⟩ + · exact hpre + · simpa [pre, outputProbeDecodeNatOuterExtrasStep, hactiveState] using + hbody + +private theorem outputProbeDecodeNatBinarySuccCanonical_reachesIn_internal + (idx : Fin n) (value : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hvalue : (work idx).HasBinaryNat value) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hout : Parked out) : + (binarySuccTM idx).reachesIn (binarySuccTime value) + { state := (binarySuccTM idx).qstart + input := inp + work := work + output := out } + { state := (binarySuccTM idx).qhalt + input := inp + work := Function.update work idx + (outputProbeCounterTape (value + 1)) + output := out } := by + obtain ⟨done, hreach, hhalt, hinput, hother, htarget, houtput⟩ := + binarySuccTM_reachesIn_frame idx value inp work out hvalue + hinp.read_ne_start (fun i _ => (hwork i).read_ne_start) + hout.read_ne_start + have hworkEq : done.work = Function.update work idx + (outputProbeCounterTape (value + 1)) := by + funext i + by_cases hi : i = idx + · subst i + simp only [Function.update_self] + simpa [outputProbeCounterTape] using htarget.eq_init_move_right + · rw [Function.update_of_ne hi, hother i hi] + have hdone : done = + { state := (binarySuccTM idx).qhalt + input := inp + work := Function.update work idx + (outputProbeCounterTape (value + 1)) + output := out } := + Cfg.ext hhalt hinput hworkEq houtput + simpa [hdone] using hreach + +theorem outputProbeDecodeNatBodyTM_reachesIn_frame_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (state : OutputProbeDecodeNatState) (bit : Bool) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {bodyBound : ℕ} + (hpre : pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output) + (hbody : (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state bit) + input output extras false) + bodyBound) : + ∃ time, time ≤ bodyBound ∧ + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).reachesIn time + { state := (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx).qstart + input := (outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras false).input + work := (outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras false).work + output := (outputProbeLatchFrameCfg tm controllerTapes outerExtras + input output extras false).output } + { state := (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx).qhalt + input := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state bit) + input output extras false).input + work := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state bit) + input output extras false).work + output := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state bit) + input output extras false).output } := by + obtain ⟨done, time, htime, hreach, hhalt, hpost⟩ := hbody _ _ _ hpre + obtain ⟨hinput, hwork, houtput⟩ := + outputProbeLatchFramePost_eq_frameCfg tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state bit) + input output extras false done.input done.work done.output hpost + have hdone : done = + { state := (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx).qhalt + input := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state bit) + input output extras false).input + work := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state bit) + input output extras false).work + output := (outputProbeLatchFrameCfg tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + outerExtras state bit) + input output extras false).output } := + Cfg.ext hhalt hinput hwork houtput + exact ⟨time, htime, hdone ▸ hreach⟩ + +theorem outputProbeDecodeNatIteration_reachesIn_of_body_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) + (hcursorValue : cursorIdx ≠ valueIdx) + (hcursorActive : cursorIdx ≠ activeIdx) + (hvalueActive : valueIdx ≠ activeIdx) + (hloopCursor : loopIdx ≠ cursorIdx) + (hloopValue : loopIdx ≠ valueIdx) + (hloopActive : loopIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (initial : OutputProbeDecodeNatState) (iteration : ℕ) + (hcursorBound : + (outputProbeDecodeNatStateAt bits initial iteration).active = true → + (outputProbeDecodeNatStateAt bits initial iteration).cursor < + bits.length) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {bodyBound : ℕ} + (hpre : pre + (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).input + (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).work + (outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx valueIdx + activeIdx loopIdx outerExtras bits input output extras initial + iteration).output) + (hbody : (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx activeIdx + (outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras + (outputProbeDecodeNatStateAt bits initial iteration) iteration) + (outputProbeDecodeNatStateAt bits initial iteration) + (outputProbeDecodeNatSourceBit bits + (outputProbeDecodeNatStateAt bits initial iteration).cursor)) + input output extras false) + bodyBound) : + ∃ time, time ≤ bodyBound + 1 + binarySuccTime iteration ∧ + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx valueIdx + activeIdx loopIdx fuelIdx).reachesIn time + (outputProbeDecodeNatIterationStartCfg tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx outerExtras bits input + output extras initial iteration) + (outputProbeDecodeNatIterationDoneCfg tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx outerExtras bits input + output extras initial iteration) := by + let state := outputProbeDecodeNatStateAt bits initial iteration + let currentOuter := outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx + activeIdx loopIdx outerExtras state iteration + let bit := outputProbeDecodeNatSourceBit bits state.cursor + let afterOuter := outputProbeDecodeNatOuterExtrasStep n cursorIdx valueIdx + activeIdx currentOuter state bit + let body := outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx + let counter := outputProbeIndexedControllerIdx n loopIdx + let limit := outputProbeIndexedControllerIdx n fuelIdx + let currentFrame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + iteration + let afterFrame := outputProbeLatchFrameCfg tm controllerTapes afterOuter + input output extras false + let nextFrame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + (iteration + 1) + obtain ⟨bodySteps, hbodySteps, hbodyRun⟩ := + outputProbeDecodeNatBodyTM_reachesIn_frame_internal tm controllerTapes + cursorIdx scratchIdx valueIdx activeIdx currentOuter state bit input + output extras hpre hbody + have hcurrentOuterParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (currentOuter i) := + outputProbeDecodeNatLoopOuterExtras_parked_internal n cursorIdx valueIdx + activeIdx loopIdx outerExtras houter state iteration + have hafterOuterEq : afterOuter = + outputProbeDecodeNatStateOuterExtras n cursorIdx valueIdx activeIdx + (Function.update outerExtras counter + (outputProbeCounterTape iteration)) + (outputProbeDecodeNatStateAfterBit state bit) := by + exact outputProbeDecodeNatOuterExtrasStep_state_internal n cursorIdx + valueIdx activeIdx hcursorValue hcursorActive hvalueActive _ state bit + have hloopBaseParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked ((Function.update outerExtras counter + (outputProbeCounterTape iteration)) i) := + outputProbeDecodeNatUpdateOuter_parked_internal n outerExtras houter + loopIdx iteration + have hafterOuterParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (afterOuter i) := by + rw [hafterOuterEq] + exact outputProbeDecodeNatStateOuterExtras_parked_internal n cursorIdx + valueIdx activeIdx _ hloopBaseParked _ + have hafterPost := outputProbeLatchFrameCfg_post tm controllerTapes + afterOuter input output extras false + have hafterParked := outputProbeLatchFramePost_parked tm controllerTapes + afterOuter input output extras false hextras hafterOuterParked houtput + afterFrame.input afterFrame.work afterFrame.output hafterPost + have hafterLoop : (afterFrame.work counter).HasBinaryNat iteration := by + rw [outputProbeLatchFramePost_controller tm controllerTapes afterOuter + input output extras false afterFrame.input afterFrame.work + afterFrame.output hafterPost loopIdx, hafterOuterEq, + outputProbeDecodeNatStateOuterExtras_other_internal n cursorIdx valueIdx + activeIdx loopIdx hloopCursor hloopValue hloopActive, + Function.update_self] + exact Tape.init_move_right_hasBinaryNat iteration + have hsucc := outputProbeDecodeNatBinarySuccCanonical_reachesIn_internal + counter iteration afterFrame.input afterFrame.work afterFrame.output + hafterLoop hafterParked.1 hafterParked.2.1 hafterParked.2.2 + let updatedOuter := Function.update afterOuter counter + (outputProbeCounterTape (iteration + 1)) + have hupdatedPost : outputProbeLatchFramePost tm controllerTapes + updatedOuter input output extras false afterFrame.input + (Function.update afterFrame.work counter + (outputProbeCounterTape (iteration + 1))) + afterFrame.output := by + exact outputProbeLatchFramePost_updateController tm controllerTapes + afterOuter input output extras false afterFrame.input afterFrame.work + afterFrame.output hafterPost loopIdx + (outputProbeCounterTape (iteration + 1)) + have hupdatedEq := outputProbeLatchFramePost_eq_frameCfg tm controllerTapes + updatedOuter input output extras false afterFrame.input + (Function.update afterFrame.work counter + (outputProbeCounterTape (iteration + 1))) + afterFrame.output hupdatedPost + have hnextState : outputProbeDecodeNatStateAt bits initial (iteration + 1) = + outputProbeDecodeNatStateAfterBit state bit := by + exact outputProbeDecodeNatStateAt_succ_internal bits initial iteration + hcursorBound + have hupdatedOuter : updatedOuter = + outputProbeDecodeNatLoopOuterExtras n cursorIdx valueIdx activeIdx + loopIdx outerExtras + (outputProbeDecodeNatStateAt bits initial (iteration + 1)) + (iteration + 1) := by + rw [hnextState] + exact outputProbeDecodeNatLoopOuterExtras_step_internal n cursorIdx + valueIdx activeIdx loopIdx hcursorValue hcursorActive hvalueActive + hloopCursor hloopValue hloopActive outerExtras state iteration bit + have hnextInput : afterFrame.input = nextFrame.input := by + simpa [updatedOuter, hupdatedOuter, nextFrame, + outputProbeDecodeNatFrameCfg] using hupdatedEq.1 + have hnextWork : Function.update afterFrame.work counter + (outputProbeCounterTape (iteration + 1)) = nextFrame.work := by + simpa [updatedOuter, hupdatedOuter, nextFrame, + outputProbeDecodeNatFrameCfg] using hupdatedEq.2.1 + have hnextOutput : afterFrame.output = nextFrame.output := by + simpa [updatedOuter, hupdatedOuter, nextFrame, + outputProbeDecodeNatFrameCfg] using hupdatedEq.2.2 + have hsuccNext : (binarySuccTM counter).reachesIn + (binarySuccTime iteration) + { state := (binarySuccTM counter).qstart + input := afterFrame.input + work := afterFrame.work + output := afterFrame.output } + { state := (binarySuccTM counter).qhalt + input := nextFrame.input + work := nextFrame.work + output := nextFrame.output } := by + have hend : + ({ state := (binarySuccTM counter).qhalt + input := afterFrame.input + work := Function.update afterFrame.work counter + (outputProbeCounterTape (iteration + 1)) + output := afterFrame.output } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binarySuccTM counter).Q) = + { state := (binarySuccTM counter).qhalt + input := nextFrame.input + work := nextFrame.work + output := nextFrame.output } := + Cfg.ext rfl hnextInput hnextWork hnextOutput + exact hend ▸ hsucc + have hinpTransition : transitionInput afterFrame.input = afterFrame.input := + hafterParked.1.transitionInput_eq_self + have hworkTransition : + (fun i => transitionTape (afterFrame.work i)) = afterFrame.work := by + funext i + exact (hafterParked.2.1 i).transitionTape_eq_self + have houtTransition : transitionTape afterFrame.output = afterFrame.output := + hafterParked.2.2.transitionTape_eq_self + have hsuccNext' : (binarySuccTM counter).reachesIn + (binarySuccTime iteration) + { state := (binarySuccTM counter).qstart + input := transitionInput afterFrame.input + work := fun i => transitionTape (afterFrame.work i) + output := transitionTape afterFrame.output } + { state := (binarySuccTM counter).qhalt + input := nextFrame.input + work := nextFrame.work + output := nextFrame.output } := by + rw [hinpTransition, hworkTransition, houtTransition] + exact hsuccNext + have hseq := seqTM_reachesIn_of_reachesIn body (binarySuccTM counter) + hbodyRun rfl hsuccNext' + have hlift := binaryForTM_iteration_reachesIn_internal body counter limit + hseq + refine ⟨bodySteps + 1 + binarySuccTime iteration, ?_, ?_⟩ + · omega + · simpa [body, counter, limit, state, bit, currentOuter, afterOuter, + currentFrame, afterFrame, nextFrame, outputProbeDecodeNatTM, + outputProbeDecodeNatIterationStartCfg, + outputProbeDecodeNatIterationDoneCfg, binaryForIterationWrap, + binaryForIterationTM, phase1Wrap, phase2Wrap] using hlift + +/-- Internal constructor for the exact bounded decoder segment invariant. -/ +noncomputable def outputProbeDecodeNatSegmentSpecOfIterationWitnessesInternal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) + (hloopFuel : loopIdx ≠ fuelIdx) + (hloopCursor : loopIdx ≠ cursorIdx) + (hloopValue : loopIdx ≠ valueIdx) + (hloopActive : loopIdx ≠ activeIdx) + (hfuelCursor : fuelIdx ≠ cursorIdx) + (hfuelValue : fuelIdx ≠ valueIdx) + (hfuelActive : fuelIdx ≠ activeIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (bits input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (initial : OutputProbeDecodeNatState) + (bodyTime : ℕ → ℕ) (startValue fuelValue : ℕ) + (hfuel : + (outerExtras (outputProbeIndexedControllerIdx n fuelIdx)).HasBinaryNat + fuelValue) + (iterationWitness : ∀ value, startValue ≤ value → value < fuelValue → + ∃ time, time ≤ binaryForIterationTime bodyTime value ∧ + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx loopIdx fuelIdx).reachesIn time + (outputProbeDecodeNatIterationStartCfg tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx outerExtras bits + input output extras initial value) + (outputProbeDecodeNatIterationDoneCfg tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx outerExtras bits + input output extras initial value)) : + BinaryForSegmentSpec + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx) + (outputProbeIndexedControllerIdx n loopIdx) + (outputProbeIndexedControllerIdx n fuelIdx) + bodyTime startValue fuelValue := by + let body := outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx + let counter := outputProbeIndexedControllerIdx n loopIdx + let limit := outputProbeIndexedControllerIdx n fuelIdx + let scanCfg := outputProbeDecodeNatScanCfg tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx outerExtras bits input output + extras initial + let iterationStartCfg := outputProbeDecodeNatIterationStartCfg tm + controllerTapes cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx + outerExtras bits input output extras initial + let iterationDoneCfg := outputProbeDecodeNatIterationDoneCfg tm + controllerTapes cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx + outerExtras bits input output extras initial + let doneCfg := outputProbeDecodeNatDoneCfg tm controllerTapes cursorIdx + scratchIdx valueIdx activeIdx loopIdx fuelIdx outerExtras bits input output + extras initial fuelValue + apply BinaryForSegmentSpec.ofWitnessesInternal + (outputProbeScan_address_ne_limit_internal n hloopFuel) + scanCfg iterationStartCfg iterationDoneCfg doneCfg + · intro value _hstart hvalue + let frame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + value + have hparked := outputProbeDecodeNatFrameCfg_parked_internal tm + controllerTapes cursorIdx valueIdx activeIdx loopIdx outerExtras houter + bits input output extras hextras houtput initial value + have hcounter := outputProbeDecodeNatFrameCfg_loop_internal tm + controllerTapes cursorIdx valueIdx activeIdx loopIdx hloopCursor + hloopValue hloopActive outerExtras bits input output extras initial value + have hlimitFrame : (frame.work limit).HasBinaryNat fuelValue := by + rw [outputProbeDecodeNatFrameCfg_other_internal tm controllerTapes + cursorIdx valueIdx activeIdx loopIdx fuelIdx hfuelCursor hfuelValue + hfuelActive (Ne.symm hloopFuel) outerExtras bits input output extras + initial value] + exact hfuel + have hrun := binaryForTM_compare_reachesIn_frame_of_lt_internal body + counter limit (outputProbeScan_address_ne_limit_internal n hloopFuel) + value fuelValue hvalue frame.input frame.work frame.output hcounter + hlimitFrame hparked.1.read_ne_start + (fun i _ _ => (hparked.2.1 i).read_ne_start) + hparked.2.2.read_ne_start + simpa [body, counter, limit, scanCfg, iterationStartCfg, + outputProbeDecodeNatTM, outputProbeDecodeNatScanCfg, + outputProbeDecodeNatIterationStartCfg, frame] using hrun + · intro value hstart hvalue + simpa [scanCfg, iterationStartCfg, iterationDoneCfg, + outputProbeDecodeNatTM] using iterationWitness value hstart hvalue + · intro value _hstart _hvalue + let frame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + (value + 1) + let c : Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binaryForIterationTM body counter).Q := + { state := (binaryForIterationTM body counter).qhalt + input := frame.input + work := frame.work + output := frame.output } + have hparked := outputProbeDecodeNatFrameCfg_parked_internal tm + controllerTapes cursorIdx valueIdx activeIdx loopIdx outerExtras houter + bits input output extras hextras houtput initial (value + 1) + have hstep := binaryForTM_step_iteration_halt_internal body counter limit c + rfl hparked.1.read_ne_start + (fun i => (hparked.2.1 i).read_ne_start) hparked.2.2.read_ne_start + simpa [body, counter, limit, iterationDoneCfg, scanCfg, + outputProbeDecodeNatTM, outputProbeDecodeNatIterationDoneCfg, + outputProbeDecodeNatScanCfg, binaryForIterationWrap, c, frame] using hstep + · let frame := outputProbeDecodeNatFrameCfg tm controllerTapes cursorIdx + valueIdx activeIdx loopIdx outerExtras bits input output extras initial + fuelValue + have hparked := outputProbeDecodeNatFrameCfg_parked_internal tm + controllerTapes cursorIdx valueIdx activeIdx loopIdx outerExtras houter + bits input output extras hextras houtput initial fuelValue + have hcounter := outputProbeDecodeNatFrameCfg_loop_internal tm + controllerTapes cursorIdx valueIdx activeIdx loopIdx hloopCursor + hloopValue hloopActive outerExtras bits input output extras initial + fuelValue + have hlimitFrame : (frame.work limit).HasBinaryNat fuelValue := by + rw [outputProbeDecodeNatFrameCfg_other_internal tm controllerTapes + cursorIdx valueIdx activeIdx loopIdx fuelIdx hfuelCursor hfuelValue + hfuelActive (Ne.symm hloopFuel) outerExtras bits input output extras + initial fuelValue] + exact hfuel + have hrun := binaryForTM_compare_reachesIn_frame_of_eq_internal body + counter limit (outputProbeScan_address_ne_limit_internal n hloopFuel) + fuelValue frame.input frame.work frame.output hcounter hlimitFrame + hparked.1.read_ne_start + (fun i _ _ => (hparked.2.1 i).read_ne_start) + hparked.2.2.read_ne_start + simpa [body, counter, limit, scanCfg, doneCfg, outputProbeDecodeNatTM, + outputProbeDecodeNatScanCfg, outputProbeDecodeNatDoneCfg, frame] using + hrun + · simp [doneCfg, outputProbeDecodeNatDoneCfg, outputProbeDecodeNatTM, + binaryForTM] + +/-- Internal constructor selecting every source-dependent decoder-body +runtime and assembling the complete bounded loop certificate. -/ +noncomputable def + ComputesInSpace.outputProbeDecodeNatSegmentSpecInternal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeNatLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (initial : OutputProbeDecodeNatState) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n layout.scratchIdx)) + |>.HasBinaryNat 0) + (startValue fuelValue : ℕ) + (hfuel : + (outerExtras (outputProbeIndexedControllerIdx n layout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, startValue ≤ value → value < fuelValue → + (outputProbeDecodeNatStateAt (f input) initial value).active = true → + (outputProbeDecodeNatStateAt (f input) initial value).cursor < + (f input).length) + (hqueryLimit : ∀ value, startValue ≤ value → value < fuelValue → + (outputProbeDecodeNatStateAt (f input) initial value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) initial value).cursor + 1) ≤ + cleanupLimit) : + Σ bodyTime : ℕ → ℕ, + BinaryForSegmentSpec + (outputProbeDecodeNatBodyTM tm controllerTapes layout.cursorIdx + layout.scratchIdx layout.valueIdx layout.activeIdx) + (outputProbeIndexedControllerIdx n layout.loopIdx) + (outputProbeIndexedControllerIdx n layout.fuelIdx) + bodyTime startValue fuelValue := by + classical + have hcursorScratch : layout.cursorIdx ≠ layout.scratchIdx := + layout.roles_ne_internal (by decide) + have hcursorValue : layout.cursorIdx ≠ layout.valueIdx := + layout.roles_ne_internal (by decide) + have hcursorActive : layout.cursorIdx ≠ layout.activeIdx := + layout.roles_ne_internal (by decide) + have hvalueActive : layout.valueIdx ≠ layout.activeIdx := + layout.roles_ne_internal (by decide) + have hloopFuel : layout.loopIdx ≠ layout.fuelIdx := + layout.roles_ne_internal (by decide) + have hloopCursor : layout.loopIdx ≠ layout.cursorIdx := + layout.roles_ne_internal (by decide) + have hloopValue : layout.loopIdx ≠ layout.valueIdx := + layout.roles_ne_internal (by decide) + have hloopActive : layout.loopIdx ≠ layout.activeIdx := + layout.roles_ne_internal (by decide) + have hfuelCursor : layout.fuelIdx ≠ layout.cursorIdx := + layout.roles_ne_internal (by decide) + have hfuelValue : layout.fuelIdx ≠ layout.valueIdx := + layout.roles_ne_internal (by decide) + have hfuelActive : layout.fuelIdx ≠ layout.activeIdx := + layout.roles_ne_internal (by decide) + have hscratchValue : layout.scratchIdx ≠ layout.valueIdx := + layout.roles_ne_internal (by decide) + have hscratchActive : layout.scratchIdx ≠ layout.activeIdx := + layout.roles_ne_internal (by decide) + have hscratchLoop : layout.scratchIdx ≠ layout.loopIdx := + layout.roles_ne_internal (by decide) + let state (value : ℕ) := + outputProbeDecodeNatStateAt (f input) initial value + let currentOuter (value : ℕ) := + outputProbeDecodeNatLoopOuterExtras n layout.cursorIdx layout.valueIdx + layout.activeIdx layout.loopIdx outerExtras (state value) value + have bodyExists : ∀ value, ∃ bodyBound : ℕ, + ∀ (hstart : startValue ≤ value) (hvalue : value < fuelValue), + ∃ pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes), + pre + (outputProbeDecodeNatFrameCfg tm controllerTapes layout.cursorIdx + layout.valueIdx layout.activeIdx layout.loopIdx outerExtras + (f input) input output extras initial value).input + (outputProbeDecodeNatFrameCfg tm controllerTapes layout.cursorIdx + layout.valueIdx layout.activeIdx layout.loopIdx outerExtras + (f input) input output extras initial value).work + (outputProbeDecodeNatFrameCfg tm controllerTapes layout.cursorIdx + layout.valueIdx layout.activeIdx layout.loopIdx outerExtras + (f input) input output extras initial value).output ∧ + (outputProbeDecodeNatBodyTM tm controllerTapes layout.cursorIdx + layout.scratchIdx layout.valueIdx layout.activeIdx).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatOuterExtrasStep n layout.cursorIdx + layout.valueIdx layout.activeIdx (currentOuter value) + (state value) + (outputProbeDecodeNatSourceBit (f input) + (state value).cursor)) + input output extras false) + bodyBound := by + intro value + by_cases hrange : startValue ≤ value ∧ value < fuelValue + · have hcurrentParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (currentOuter value i) := + outputProbeDecodeNatLoopOuterExtras_parked_internal n + layout.cursorIdx layout.valueIdx layout.activeIdx layout.loopIdx + outerExtras houter (state value) value + have hcursorCurrent : + (currentOuter value + (outputProbeDecodeNatCursorIdx n layout.cursorIdx)) + |>.HasBinaryNat (state value).cursor := + outputProbeDecodeNatStateOuterExtras_cursor_internal n + layout.cursorIdx layout.valueIdx layout.activeIdx hcursorValue + hcursorActive _ _ + have hscratchCurrent : + (currentOuter value + (outputProbeIndexedControllerIdx n layout.scratchIdx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeNatLoopOuterExtras n layout.cursorIdx + layout.valueIdx layout.activeIdx layout.loopIdx outerExtras + (state value) value + (outputProbeIndexedControllerIdx n layout.scratchIdx)) + |>.HasBinaryNat 0 + rw [outputProbeDecodeNatLoopOuterExtras_other_internal n + layout.cursorIdx layout.valueIdx layout.activeIdx layout.loopIdx + layout.scratchIdx (Ne.symm hcursorScratch) hscratchValue + hscratchActive hscratchLoop outerExtras (state value) value] + exact hscratch + have hvalueCurrent : + (currentOuter value + (outputProbeDecodeNatValueIdx n layout.valueIdx)) + |>.HasBinaryNat (state value).value := + outputProbeDecodeNatStateOuterExtras_value_internal n + layout.cursorIdx layout.valueIdx layout.activeIdx hvalueActive _ _ + have hactiveCurrent : + (currentOuter value + (outputProbeDecodeNatActiveIdx n layout.activeIdx)) + |>.HasBinaryNat (if (state value).active then 1 else 0) := + outputProbeDecodeNatStateOuterExtras_active_internal n + layout.cursorIdx layout.valueIdx layout.activeIdx _ _ + obtain ⟨bodyBound, pre, hpre, hbody⟩ := + hcomp.outputProbeDecodeNatBodyTM_hoareTime_internal input + (state value) (hqueryValid value hrange.1 hrange.2) output houtput + extras hextras hcleanupCounter cleanupLimit hcleanupLimit + (hqueryLimit value hrange.1 hrange.2) controllerTapes + (currentOuter value) hcurrentParked layout.cursorIdx + layout.scratchIdx layout.valueIdx layout.activeIdx hcursorScratch + hcursorValue hcursorActive hcursorCurrent hscratchCurrent + hvalueCurrent hactiveCurrent + refine ⟨bodyBound, ?_⟩ + intro _hstart _hvalue + refine ⟨pre, ?_, hbody⟩ + simpa [currentOuter, state, outputProbeDecodeNatFrameCfg] using hpre + · refine ⟨0, ?_⟩ + intro hstart hvalue + exact (hrange ⟨hstart, hvalue⟩).elim + choose bodyTime hbody using bodyExists + refine ⟨bodyTime, + outputProbeDecodeNatSegmentSpecOfIterationWitnessesInternal tm + controllerTapes layout.cursorIdx layout.scratchIdx layout.valueIdx + layout.activeIdx layout.loopIdx layout.fuelIdx hloopFuel hloopCursor + hloopValue hloopActive hfuelCursor hfuelValue hfuelActive outerExtras + (f input) input output extras hextras houter houtput initial bodyTime + startValue fuelValue hfuel ?_⟩ + intro value hstart hvalue + obtain ⟨pre, hpre, hhoare⟩ := hbody value hstart hvalue + obtain ⟨time, htime, hrun⟩ := + outputProbeDecodeNatIteration_reachesIn_of_body_internal tm + controllerTapes layout.cursorIdx layout.scratchIdx layout.valueIdx + layout.activeIdx layout.loopIdx layout.fuelIdx hcursorValue + hcursorActive hvalueActive hloopCursor hloopValue hloopActive + outerExtras (f input) input output extras hextras houter houtput initial + value (hqueryValid value hstart hvalue) hpre hhoare + refine ⟨time, ?_, hrun⟩ + simp only [binaryForIterationTime] + omega + +/-- Internal initialized-frame Hoare adapter for the complete bounded decoder. +The selected body-time function is inherited from the source-dependent segment +certificate. -/ +theorem ComputesInSpace.outputProbeDecodeNatTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeNatLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (initial : OutputProbeDecodeNatState) + (hscratch : + (outerExtras (outputProbeIndexedControllerIdx n layout.scratchIdx)) + |>.HasBinaryNat 0) + (startValue fuelValue : ℕ) (hstartFuel : startValue ≤ fuelValue) + (hfuel : + (outerExtras (outputProbeIndexedControllerIdx n layout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, startValue ≤ value → value < fuelValue → + (outputProbeDecodeNatStateAt (f input) initial value).active = true → + (outputProbeDecodeNatStateAt (f input) initial value).cursor < + (f input).length) + (hqueryLimit : ∀ value, startValue ≤ value → value < fuelValue → + (outputProbeDecodeNatStateAt (f input) initial value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) initial value).cursor + 1) ≤ + cleanupLimit) : + ∃ bodyTime : ℕ → ℕ, + (outputProbeDecodeNatTM tm controllerTapes layout.cursorIdx + layout.scratchIdx layout.valueIdx layout.activeIdx layout.loopIdx + layout.fuelIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatLoopOuterExtras n layout.cursorIdx + layout.valueIdx layout.activeIdx layout.loopIdx outerExtras + (outputProbeDecodeNatStateAt (f input) initial startValue) + startValue) + input output extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatLoopOuterExtras n layout.cursorIdx + layout.valueIdx layout.activeIdx layout.loopIdx outerExtras + (outputProbeDecodeNatStateAt (f input) initial fuelValue) + fuelValue) + input output extras false) + (binaryForLoopTime bodyTime fuelValue startValue + (fuelValue - startValue)) := by + classical + let packed := hcomp.outputProbeDecodeNatSegmentSpecInternal input output + houtput extras hextras hcleanupCounter cleanupLimit hcleanupLimit + controllerTapes layout outerExtras houter initial hscratch startValue + fuelValue hfuel hqueryValid hqueryLimit + let bodyTime := packed.1 + let spec := packed.2 + refine ⟨bodyTime, ?_⟩ + have hscanState : + (spec.scanCfg startValue).state = + (outputProbeDecodeNatTM tm controllerTapes layout.cursorIdx + layout.scratchIdx layout.valueIdx layout.activeIdx layout.loopIdx + layout.fuelIdx).qstart := by + simp [spec, packed, + ComputesInSpace.outputProbeDecodeNatSegmentSpecInternal, + outputProbeDecodeNatSegmentSpecOfIterationWitnessesInternal, + BinaryForSegmentSpec.ofWitnessesInternal, outputProbeDecodeNatScanCfg, + outputProbeDecodeNatTM, binaryForTM] + have hsegment := spec.hoareTime_internal hstartFuel hscanState + apply hsegment.consequence + · intro inp work out hpre + have heq := outputProbeLatchFramePost_eq_frameCfg_internal tm + controllerTapes _ input output extras false inp work out hpre + simpa [spec, packed, + ComputesInSpace.outputProbeDecodeNatSegmentSpecInternal, + outputProbeDecodeNatSegmentSpecOfIterationWitnessesInternal, + BinaryForSegmentSpec.ofWitnessesInternal, outputProbeDecodeNatScanCfg, + outputProbeDecodeNatFrameCfg] using heq + · intro inp work out hpost + rcases hpost with ⟨hinp, hwork, hout⟩ + rw [hinp, hwork, hout] + simpa [spec, packed, + ComputesInSpace.outputProbeDecodeNatSegmentSpecInternal, + outputProbeDecodeNatSegmentSpecOfIterationWitnessesInternal, + BinaryForSegmentSpec.ofWitnessesInternal, outputProbeDecodeNatDoneCfg] + using outputProbeDecodeNatFrameCfg_post_internal tm controllerTapes + layout.cursorIdx layout.valueIdx layout.activeIdx layout.loopIdx + outerExtras (f input) input output extras initial fuelValue + · exact le_rfl + +private theorem skipTM_isTransducer_internal {n : ℕ} : + (skipTM (n := n)).IsTransducer := by + intro state _iHead _wHeads oHead + cases state <;> cases oHead <;> simp [skipTM, idleDir] + +theorem outputProbeDecodeNatZeroTM_isTransducer_internal + (n controllerTapes : ℕ) (cursorIdx activeIdx : Fin controllerTapes) : + (outputProbeDecodeNatZeroTM n controllerTapes cursorIdx + activeIdx).IsTransducer := by + apply IsTransducer.seqTM + · exact clearWorkTM_isTransducer _ + · exact binarySuccTM_isTransducer _ + +theorem outputProbeDecodeNatOneTM_isTransducer_internal + (n controllerTapes : ℕ) (cursorIdx valueIdx : Fin controllerTapes) : + (outputProbeDecodeNatOneTM n controllerTapes cursorIdx + valueIdx).IsTransducer := by + apply IsTransducer.seqTM + · exact binarySuccTM_isTransducer _ + · exact binarySuccTM_isTransducer _ + +theorem outputProbeDecodeNatActiveTM_isTransducer_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) : + (outputProbeDecodeNatActiveTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).IsTransducer := by + apply IsTransducer.outputProbeIndexedResetDispatchTM + · exact outputProbeDecodeNatZeroTM_isTransducer_internal n controllerTapes + cursorIdx activeIdx + · exact outputProbeDecodeNatOneTM_isTransducer_internal n controllerTapes + cursorIdx valueIdx + +theorem outputProbeDecodeNatBodyTM_isTransducer_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx : Fin controllerTapes) : + (outputProbeDecodeNatBodyTM tm controllerTapes cursorIdx scratchIdx + valueIdx activeIdx).IsTransducer := by + apply IsTransducer.branchWorkSymbolTM + · exact outputProbeDecodeNatActiveTM_isTransducer_internal tm + controllerTapes cursorIdx scratchIdx valueIdx activeIdx + · exact skipTM_isTransducer_internal + +theorem outputProbeDecodeNatTM_isTransducer_internal + (tm : TM n) (controllerTapes : ℕ) + (cursorIdx scratchIdx valueIdx activeIdx loopIdx fuelIdx : + Fin controllerTapes) : + (outputProbeDecodeNatTM tm controllerTapes cursorIdx scratchIdx valueIdx + activeIdx loopIdx fuelIdx).IsTransducer := by + apply IsTransducer.binaryForTM + exact outputProbeDecodeNatBodyTM_isTransducer_internal tm controllerTapes + cursorIdx scratchIdx valueIdx activeIdx + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag.lean new file mode 100644 index 00000000..c3b7976a --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag.lean @@ -0,0 +1,497 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDecodeTag.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDecodeTag.Internal + +/-! +# Decoding fixed formula-token tags through output probes + +This module exposes the pure three-bit tag classifier and the concrete +restartable-probe machine that retains each queried bit in a distinct +controller register. +-/ + +namespace Complexity + +namespace TM + +/-- Finite-list sources instantiate the tag decoder by three ordinary optional +index operations. -/ +theorem outputProbeDecodeTag?_ofList (bits : List Bool) (cursor : ℕ) : + outputProbeDecodeTag? (FormulaCode.BitOracle.ofList bits) cursor = (do + let tag₀ ← bits[cursor]? + let tag₁ ← bits[cursor + 1]? + let tag₂ ← bits[cursor + 2]? + let tag ← outputProbeTokenTag? tag₀ tag₁ tag₂ + some (tag, cursor + 3)) := + outputProbeDecodeTag?_ofList_internal bits cursor + +/-- Every decoded non-variable tag agrees immediately with the established +oracle token decoder. The variable case deliberately leaves its following +terminated-unary payload to `outputProbeDecodeNatTM`. -/ +theorem outputProbeDecodeTag?_fixed_token + (query : FormulaCode.BitOracle) (cursor bitFuel : ℕ) + (tag : OutputProbeTokenTag) (nextCursor : ℕ) + (hdecode : outputProbeDecodeTag? query cursor = + some (tag, nextCursor)) : + match tag with + | .var => True + | .tru => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.tru, nextCursor) + | .fls => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.fls, nextCursor) + | .neg => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.neg, nextCursor) + | .conj => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.conj, nextCursor) + | .disj => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.disj, nextCursor) := + outputProbeDecodeTag?_fixed_token_internal query cursor bitFuel tag + nextCursor hdecode + +/-- Derive one exact query/reset/retain/cursor step directly from a +space-bounded source transducer. The selected bit register starts at zero and +ends at the queried Boolean value. -/ +theorem ComputesInSpace.outputProbeDecodeTagBitTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx : Fin controllerTapes) + (hcursorScratch : layout.cursorIdx ≠ layout.scratchIdx) + (hcursorBit : layout.cursorIdx ≠ bitIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.scratchIdx)).HasBinaryNat + 0) + (hbit : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat 0) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTagBitTM tm controllerTapes layout bitIdx).HoareTime + pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagBitOuterExtrasAfter n layout bitIdx outerExtras + cursor ((f input)[cursor]'hcursorBound)) + input output extras false) + (bodyBound + 1 + binarySuccTime cursor) := + hcomp.outputProbeDecodeTagBitTM_hoareTime_internal input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit controllerTapes layout bitIdx hcursorScratch + hcursorBit outerExtras houter hcursor hscratch hbit + +/-- Compose the three exact query/reset/retain/cursor steps into the complete +fixed-width tag probe. The final frame contains the three source bits and the +cursor advanced by exactly three positions. -/ +theorem ComputesInSpace.outputProbeDecodeTagTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.scratchIdx)).HasBinaryNat + 0) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTagTM tm controllerTapes layout).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + ((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) := + hcomp.outputProbeDecodeTagTM_hoareTime_internal input cursor hcursorBound + output houtput extras hextras hcleanupCounter cleanupLimit hcleanupLimit + hlimit₀ hlimit₁ hlimit₂ controllerTapes layout outerExtras houter + hcursor hscratch htag₀ htag₁ htag₂ + +/-- Dispatch a literal retained tag frame to the corresponding legal-token +continuation, or to the invalid continuation for a reserved tag. -/ +theorem outputProbeDecodeTagDispatchTM_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Option OutputProbeTokenTag → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ} + (hvar : onVar.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .var)) varTime) + (htru : onTru.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .tru)) truTime) + (hfls : onFls.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .fls)) flsTime) + (hneg : onNeg.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .neg)) negTime) + (hconj : onConj.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .conj)) conjTime) + (hdisj : onDisj.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .disj)) disjTime) + (hinvalid : onInvalid.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post none) invalidTime) : + (outputProbeDecodeTagDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (outputProbeTokenTag? tag₀ tag₁ tag₂)) + (outputProbeDecodeTagDispatchTime tag₀ tag₁ tag₂ varTime + truTime flsTime negTime conjTime disjTime invalidTime) := + outputProbeDecodeTagDispatchTM_hoareTime_internal tm controllerTapes layout + outerExtras input output extras tag₀ tag₁ tag₂ hextras houter houtput + htag₀ htag₁ htag₂ onVar onTru onFls onNeg onConj onDisj onInvalid + hvar htru hfls hneg hconj hdisj hinvalid + +/-- Dispatch a retained tag using only the contract of the continuation that +the tag selects. This avoids imposing unreachable payload preconditions on +the other token cases. -/ +theorem outputProbeDecodeTagDispatchTM_selected_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : + (outputProbeTokenContinuation + (outputProbeTokenTag? tag₀ tag₁ tag₂) + onVar onTru onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + post selectedTime) : + (outputProbeDecodeTagDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + post (selectedTime + outputProbeDecodeTagDispatchDepth tag₀ tag₁) := + outputProbeDecodeTagDispatchTM_selected_hoareTime_internal tm + controllerTapes layout outerExtras input output extras tag₀ tag₁ tag₂ + hextras houter houtput htag₀ htag₁ htag₂ onVar onTru onFls onNeg + onConj onDisj onInvalid hselected + +/-- Probe all three fixed tag bits and immediately run the selected legal or +invalid continuation. The result combines the exact source-derived probe +runtimes, the sequential seam, and the exact two- or three-step dispatch +cost. -/ +theorem ComputesInSpace.outputProbeDecodeTagAndDispatchTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.scratchIdx)).HasBinaryNat + 0) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Option OutputProbeTokenTag → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ} + (hvar : onVar.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .var)) varTime) + (htru : onTru.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .tru)) truTime) + (hfls : onFls.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .fls)) flsTime) + (hneg : onNeg.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .neg)) negTime) + (hconj : onConj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .conj)) conjTime) + (hdisj : onDisj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .disj)) disjTime) + (hinvalid : onInvalid.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post none) invalidTime) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTagAndDispatchTM tm controllerTapes layout onVar + onTru onFls onNeg onConj onDisj onInvalid).HoareTime pre + (post (outputProbeTokenTag? ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]))) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTagDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) varTime + truTime flsTime negTime conjTime disjTime invalidTime) := + hcomp.outputProbeDecodeTagAndDispatchTM_hoareTime_internal input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes layout outerExtras + houter hcursor hscratch htag₀ htag₁ htag₂ onVar onTru onFls onNeg + onConj onDisj onInvalid hvar htru hfls hneg hconj hdisj hinvalid + +/-- The literal final tag frame is parked wherever the initial outer frame was +parked, and its three retained registers contain exactly the supplied bits. -/ +theorem outputProbeDecodeTagOuterExtrasAfter_invariant + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0) : + let after := outputProbeDecodeTagOuterExtrasAfter n layout outerExtras + cursor tag₀ tag₁ tag₂ + (∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (after i)) ∧ + (after (outputProbeDecodeTagBitIdx n layout.tag₀Idx)).HasBinaryNat + (if tag₀ then 1 else 0) ∧ + (after (outputProbeDecodeTagBitIdx n layout.tag₁Idx)).HasBinaryNat + (if tag₁ then 1 else 0) ∧ + (after (outputProbeDecodeTagBitIdx n layout.tag₂Idx)).HasBinaryNat + (if tag₂ then 1 else 0) := + outputProbeDecodeTagOuterExtrasAfter_invariant_internal n layout outerExtras + houter cursor tag₀ tag₁ tag₂ htag₀ htag₁ htag₂ + +/-- The complete fixed-width tag decoder preserves append-only output. -/ +theorem outputProbeDecodeTagTM_isTransducer + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) : + (outputProbeDecodeTagTM tm controllerTapes layout).IsTransducer := + outputProbeDecodeTagTM_isTransducer_internal tm controllerTapes layout + +/-- Retained tag dispatch preserves append-only output whenever every legal +and invalid continuation does. -/ +theorem IsTransducer.outputProbeDecodeTagDispatchTM + {onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hvar : onVar.IsTransducer) (htru : onTru.IsTransducer) + (hfls : onFls.IsTransducer) (hneg : onNeg.IsTransducer) + (hconj : onConj.IsTransducer) (hdisj : onDisj.IsTransducer) + (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTagLayout controllerTapes) : + (outputProbeDecodeTagDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).IsTransducer := + hvar.outputProbeDecodeTagDispatchTM_internal htru hfls hneg hconj hdisj + hinvalid layout + +/-- Complete tag probing and selected dispatch preserve append-only output +whenever every continuation does. -/ +theorem IsTransducer.outputProbeDecodeTagAndDispatchTM + {tm : TM n} + {onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hvar : onVar.IsTransducer) (htru : onTru.IsTransducer) + (hfls : onFls.IsTransducer) (hneg : onNeg.IsTransducer) + (hconj : onConj.IsTransducer) (hdisj : onDisj.IsTransducer) + (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTagLayout controllerTapes) : + (outputProbeDecodeTagAndDispatchTM tm controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).IsTransducer := + hvar.outputProbeDecodeTagAndDispatchTM_internal htru hfls hneg hconj + hdisj hinvalid layout + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag/Defs.lean new file mode 100644 index 00000000..8ac03f9d --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag/Defs.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Circuits.FormulaEncoding.ProbeNavigation.Defs +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +import Complexitylib.Models.TuringMachine.OutputProbeCountOnes.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs + +/-! +# Decoding fixed formula-token tags through output probes -- definitions + +Every formula token begins with one of six legal three-bit tags. This module +classifies those tags through three restartable source probes, advances a +persistent bit cursor, and retains the queried bits in three one-bit controller +registers. Variable payload decoding remains the responsibility of the bounded +terminated-unary controller. +-/ + +namespace Complexity + +namespace TM + +/-- The six legal fixed-width formula-token tags. -/ +inductive OutputProbeTokenTag where + | var + | tru + | fls + | neg + | conj + | disj + deriving DecidableEq, Repr + +/-- Classify one three-bit formula-token tag. Tags `110` and `111` are +reserved. -/ +def outputProbeTokenTag? (tag₀ tag₁ tag₂ : Bool) : + Option OutputProbeTokenTag := + match tag₀, tag₁, tag₂ with + | false, false, false => some .var + | false, false, true => some .tru + | false, true, false => some .fls + | false, true, true => some .neg + | true, false, false => some .conj + | true, false, true => some .disj + | true, true, _ => none + +/-- Decode the fixed tag at `cursor` and return the first payload position. -/ +def outputProbeDecodeTag? (query : FormulaCode.BitOracle) (cursor : ℕ) : + Option (OutputProbeTokenTag × ℕ) := do + let tag₀ ← query cursor + let tag₁ ← query (cursor + 1) + let tag₂ ← query (cursor + 2) + let tag ← outputProbeTokenTag? tag₀ tag₁ tag₂ + some (tag, cursor + 3) + +/-- Five distinct controller registers used by the fixed-width tag decoder. + +The role order is cursor, query scratch, and the three retained tag bits. -/ +structure OutputProbeDecodeTagLayout (controllerTapes : ℕ) where + /-- Injective assignment of logical roles to controller tapes. -/ + roles : Fin 5 ↪ Fin controllerTapes + +/-- Cursor register selected by a tag-decoder layout. -/ +def OutputProbeDecodeTagLayout.cursorIdx + (layout : OutputProbeDecodeTagLayout controllerTapes) : + Fin controllerTapes := + layout.roles 0 + +/-- Query scratch register selected by a tag-decoder layout. -/ +def OutputProbeDecodeTagLayout.scratchIdx + (layout : OutputProbeDecodeTagLayout controllerTapes) : + Fin controllerTapes := + layout.roles 1 + +/-- First retained tag-bit register. -/ +def OutputProbeDecodeTagLayout.tag₀Idx + (layout : OutputProbeDecodeTagLayout controllerTapes) : + Fin controllerTapes := + layout.roles 2 + +/-- Second retained tag-bit register. -/ +def OutputProbeDecodeTagLayout.tag₁Idx + (layout : OutputProbeDecodeTagLayout controllerTapes) : + Fin controllerTapes := + layout.roles 3 + +/-- Third retained tag-bit register. -/ +def OutputProbeDecodeTagLayout.tag₂Idx + (layout : OutputProbeDecodeTagLayout controllerTapes) : + Fin controllerTapes := + layout.roles 4 + +/-- Physical cursor tape in the complete output-probe controller frame. -/ +def outputProbeDecodeTagCursorIdx (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeIndexedControllerIdx n layout.cursorIdx + +/-- Physical retained tag-bit tape in the complete controller frame. -/ +def outputProbeDecodeTagBitIdx (n : ℕ) {controllerTapes : ℕ} + (idx : Fin controllerTapes) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeIndexedControllerIdx n idx + +/-- Canonical controller frame after retaining one queried tag bit and +advancing the source cursor. -/ +def outputProbeDecodeTagBitOuterExtrasAfter (n : ℕ) + {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (bit : Bool) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + Function.update + (outputProbeCountOnesOuterExtrasAfter n bitIdx outerExtras 0 bit) + (outputProbeDecodeTagCursorIdx n layout) + (outputProbeCounterTape (cursor + 1)) + +/-- Canonical controller frame after all three tag bits have been retained. -/ +def outputProbeDecodeTagOuterExtrasAfter (n : ℕ) + {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₂Idx + (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₁Idx + (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₀Idx + outerExtras cursor tag₀) + (cursor + 1) tag₁) + (cursor + 2) tag₂ + +/-- Query, reset the shared latch, retain one selected tag bit, and advance the +source cursor. The selected bit register must initially contain zero. -/ +def outputProbeDecodeTagBitTM (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM + (outputProbeCountOnesBodyTM tm controllerTapes layout.cursorIdx + layout.scratchIdx bitIdx) + (binarySuccTM (outputProbeDecodeTagCursorIdx n layout)) + +/-- Decode and retain all three fixed tag bits in source order. -/ +def outputProbeDecodeTagTM (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM + (outputProbeDecodeTagBitTM tm controllerTapes layout layout.tag₀Idx) + (seqTM + (outputProbeDecodeTagBitTM tm controllerTapes layout layout.tag₁Idx) + (outputProbeDecodeTagBitTM tm controllerTapes layout layout.tag₂Idx)) + +/-- Dispatch a retained three-bit tag to one of the six legal token +continuations, or to `onInvalid` for the two reserved prefixes. The retained +registers are inspected without changing the controller frame. -/ +def outputProbeDecodeTagDispatchTM (n controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₀Idx) Γ.one + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) Γ.one + onInvalid + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₂Idx) + Γ.one onDisj onConj)) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) Γ.one + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₂Idx) + Γ.one onNeg onFls) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₂Idx) + Γ.one onTru onVar)) + +/-- Exact selected runtime of retained three-bit tag dispatch. Legal tags pay +three branch steps, while either reserved `11_` prefix pays only two. -/ +def outputProbeDecodeTagDispatchTime (tag₀ tag₁ tag₂ : Bool) + (varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ) : + ℕ := + match tag₀, tag₁, tag₂ with + | false, false, false => varTime + 3 + | false, false, true => truTime + 3 + | false, true, false => flsTime + 3 + | false, true, true => negTime + 3 + | true, false, false => conjTime + 3 + | true, false, true => disjTime + 3 + | true, true, _ => invalidTime + 2 + +/-- Select the unique continuation named by a classified three-bit token tag. -/ +def outputProbeTokenContinuation + (tag : Option OutputProbeTokenTag) + (onVar onTru onFls onNeg onConj onDisj onInvalid : TM tapes) : + TM tapes := + match tag with + | some .var => onVar + | some .tru => onTru + | some .fls => onFls + | some .neg => onNeg + | some .conj => onConj + | some .disj => onDisj + | none => onInvalid + +/-- Number of finite-control branch steps needed to select one retained tag. +Reserved `11_` tags stop after two bits; every legal tag inspects all three. -/ +def outputProbeDecodeTagDispatchDepth (tag₀ tag₁ : Bool) : ℕ := + if tag₀ && tag₁ then 2 else 3 + +/-- Probe a complete fixed-width tag and immediately enter its selected legal +or invalid continuation. -/ +def outputProbeDecodeTagAndDispatchTM (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM (outputProbeDecodeTagTM tm controllerTapes layout) + (outputProbeDecodeTagDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag/Internal.lean new file mode 100644 index 00000000..449bcc50 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeTag/Internal.lean @@ -0,0 +1,1463 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDecodeTag.Defs +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +import Complexitylib.Models.TuringMachine.OutputProbeCountOnes +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Decoding fixed formula-token tags through output probes -- internals +-/ + +namespace Complexity + +namespace TM + +private theorem outputProbeDecodeTagSkipTM_isTransducer_internal {n : ℕ} : + (skipTM (n := n)).IsTransducer := by + intro state _iHead _wHeads oHead + cases state <;> cases oHead <;> simp [skipTM, idleDir] + +private theorem OutputProbeDecodeTagLayout.roles_ne_internal + (layout : OutputProbeDecodeTagLayout controllerTapes) + {i j : Fin 5} (hne : i ≠ j) : layout.roles i ≠ layout.roles j := by + intro heq + exact hne (layout.roles.injective heq) + +theorem outputProbeDecodeTag?_ofList_internal (bits : List Bool) + (cursor : ℕ) : + outputProbeDecodeTag? (FormulaCode.BitOracle.ofList bits) cursor = (do + let tag₀ ← bits[cursor]? + let tag₁ ← bits[cursor + 1]? + let tag₂ ← bits[cursor + 2]? + let tag ← outputProbeTokenTag? tag₀ tag₁ tag₂ + some (tag, cursor + 3)) := by + rfl + +theorem outputProbeDecodeTag?_fixed_token_internal + (query : FormulaCode.BitOracle) (cursor bitFuel : ℕ) + (tag : OutputProbeTokenTag) (nextCursor : ℕ) + (hdecode : outputProbeDecodeTag? query cursor = + some (tag, nextCursor)) : + match tag with + | .var => True + | .tru => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.tru, nextCursor) + | .fls => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.fls, nextCursor) + | .neg => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.neg, nextCursor) + | .conj => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.conj, nextCursor) + | .disj => FormulaCode.BitOracle.decodeTokenAt? query bitFuel cursor = + some (.disj, nextCursor) := by + cases tag <;> simp only + all_goals + unfold outputProbeDecodeTag? at hdecode + generalize htag₀ : query cursor = tag₀ at hdecode ⊢ + cases tag₀ with + | none => simp at hdecode + | some tag₀ => + generalize htag₁ : query (cursor + 1) = tag₁ at hdecode ⊢ + cases tag₁ with + | none => simp at hdecode + | some tag₁ => + generalize htag₂ : query (cursor + 2) = tag₂ at hdecode ⊢ + cases tag₂ with + | none => simp at hdecode + | some tag₂ => + cases tag₀ <;> cases tag₁ <;> cases tag₂ <;> + simp_all [outputProbeTokenTag?, + FormulaCode.BitOracle.decodeTokenAt?] + +private theorem outputProbeDecodeTagCounterTape_parked_internal + (value : ℕ) : Parked (outputProbeCounterTape value) := by + have h : (outputProbeCounterTape value).HasBinaryNat value := by + simpa [outputProbeCounterTape] using + Tape.init_move_right_hasBinaryNat value + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem outputProbeDecodeTagUpdateOuter_parked_internal + (n : ℕ) {controllerTapes : ℕ} + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (idx : Fin controllerTapes) (value : ℕ) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) + (outputProbeCounterTape value) i) := by + intro i hi + by_cases heq : i = outputProbeIndexedControllerIdx n idx + · subst i + rw [Function.update_self] + exact outputProbeDecodeTagCounterTape_parked_internal value + · rw [Function.update_of_ne heq] + exact houter i hi + +theorem outputProbeDecodeTagBitOuterExtrasAfter_parked_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (bit : Bool) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeDecodeTagBitOuterExtrasAfter n layout bitIdx + outerExtras cursor bit i) := by + have hbitOuter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeCountOnesOuterExtrasAfter n bitIdx outerExtras 0 + bit i) := by + by_cases hbit : bit + · simpa [outputProbeCountOnesOuterExtrasAfter, hbit] using + outputProbeDecodeTagUpdateOuter_parked_internal n outerExtras houter + bitIdx 1 + · simpa [outputProbeCountOnesOuterExtrasAfter, hbit] using houter + simpa [outputProbeDecodeTagBitOuterExtrasAfter, + outputProbeDecodeTagCursorIdx] using + outputProbeDecodeTagUpdateOuter_parked_internal n + (outputProbeCountOnesOuterExtrasAfter n bitIdx outerExtras 0 bit) + hbitOuter layout.cursorIdx (cursor + 1) + +theorem outputProbeDecodeTagBitOuterExtrasAfter_cursor_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (bit : Bool) : + (outputProbeDecodeTagBitOuterExtrasAfter n layout bitIdx outerExtras + cursor bit (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + (cursor + 1) := by + simp only [outputProbeDecodeTagBitOuterExtrasAfter, Function.update_self] + exact Tape.init_move_right_hasBinaryNat (cursor + 1) + +theorem outputProbeDecodeTagBitOuterExtrasAfter_bit_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx : Fin controllerTapes) + (hcursorBit : layout.cursorIdx ≠ bitIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (hzero : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat 0) + (cursor : ℕ) (bit : Bool) : + (outputProbeDecodeTagBitOuterExtrasAfter n layout bitIdx outerExtras + cursor bit (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat + (if bit then 1 else 0) := by + have hphysical : outputProbeDecodeTagBitIdx n bitIdx ≠ + outputProbeDecodeTagCursorIdx n layout := by + intro heq + exact hcursorBit (outputProbeIndexedControllerIdx_injective n heq.symm) + rw [outputProbeDecodeTagBitOuterExtrasAfter, + Function.update_of_ne hphysical] + by_cases hbit : bit + · simp [outputProbeCountOnesOuterExtrasAfter, hbit, + outputProbeDecodeTagBitIdx] + exact Tape.init_move_right_hasBinaryNat 1 + · simpa [outputProbeCountOnesOuterExtrasAfter, hbit] using hzero + +theorem outputProbeDecodeTagBitOuterExtrasAfter_other_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx idx : Fin controllerTapes) + (hcursor : idx ≠ layout.cursorIdx) (hbit : idx ≠ bitIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (bit : Bool) : + outputProbeDecodeTagBitOuterExtrasAfter n layout bitIdx outerExtras + cursor bit (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := by + have hcursorPhysical : outputProbeIndexedControllerIdx n idx ≠ + outputProbeDecodeTagCursorIdx n layout := by + intro heq + exact hcursor (outputProbeIndexedControllerIdx_injective n heq) + have hbitPhysical : outputProbeIndexedControllerIdx n idx ≠ + outputProbeIndexedControllerIdx n bitIdx := by + intro heq + exact hbit (outputProbeIndexedControllerIdx_injective n heq) + rw [outputProbeDecodeTagBitOuterExtrasAfter, + Function.update_of_ne hcursorPhysical] + by_cases hbitValue : bit + · simp [outputProbeCountOnesOuterExtrasAfter, hbitValue, hbitPhysical] + · simp [outputProbeCountOnesOuterExtrasAfter, hbitValue] + +theorem outputProbeDecodeTagOuterExtrasAfter_invariant_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0) : + let after := outputProbeDecodeTagOuterExtrasAfter n layout outerExtras + cursor tag₀ tag₁ tag₂ + (∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (after i)) ∧ + (after (outputProbeDecodeTagBitIdx n layout.tag₀Idx)).HasBinaryNat + (if tag₀ then 1 else 0) ∧ + (after (outputProbeDecodeTagBitIdx n layout.tag₁Idx)).HasBinaryNat + (if tag₁ then 1 else 0) ∧ + (after (outputProbeDecodeTagBitIdx n layout.tag₂Idx)).HasBinaryNat + (if tag₂ then 1 else 0) := by + have hcursorTag₀ : layout.cursorIdx ≠ layout.tag₀Idx := + layout.roles_ne_internal (by decide) + have hcursorTag₁ : layout.cursorIdx ≠ layout.tag₁Idx := + layout.roles_ne_internal (by decide) + have hcursorTag₂ : layout.cursorIdx ≠ layout.tag₂Idx := + layout.roles_ne_internal (by decide) + have htag₀Tag₁ : layout.tag₀Idx ≠ layout.tag₁Idx := + layout.roles_ne_internal (by decide) + have htag₀Tag₂ : layout.tag₀Idx ≠ layout.tag₂Idx := + layout.roles_ne_internal (by decide) + have htag₁Tag₀ : layout.tag₁Idx ≠ layout.tag₀Idx := + layout.roles_ne_internal (by decide) + have htag₁Tag₂ : layout.tag₁Idx ≠ layout.tag₂Idx := + layout.roles_ne_internal (by decide) + have htag₂Tag₀ : layout.tag₂Idx ≠ layout.tag₀Idx := + layout.roles_ne_internal (by decide) + have htag₂Tag₁ : layout.tag₂Idx ≠ layout.tag₁Idx := + layout.roles_ne_internal (by decide) + let outer₁ := outputProbeDecodeTagBitOuterExtrasAfter n layout + layout.tag₀Idx outerExtras cursor tag₀ + let outer₂ := outputProbeDecodeTagBitOuterExtrasAfter n layout + layout.tag₁Idx outer₁ (cursor + 1) tag₁ + let outer₃ := outputProbeDecodeTagBitOuterExtrasAfter n layout + layout.tag₂Idx outer₂ (cursor + 2) tag₂ + have houter₁ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₁ i) := + outputProbeDecodeTagBitOuterExtrasAfter_parked_internal n layout + layout.tag₀Idx outerExtras houter cursor tag₀ + have htag₀₁ := outputProbeDecodeTagBitOuterExtrasAfter_bit_internal n + layout layout.tag₀Idx hcursorTag₀ outerExtras htag₀ cursor tag₀ + have htag₁₁ : + (outer₁ (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₀Idx + outerExtras cursor tag₀ + (outputProbeIndexedControllerIdx n layout.tag₁Idx)).HasBinaryNat 0 + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₀Idx layout.tag₁Idx (Ne.symm hcursorTag₁) htag₁Tag₀ + outerExtras cursor tag₀] + exact htag₁ + have htag₂₁ : + (outer₁ (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₀Idx + outerExtras cursor tag₀ + (outputProbeIndexedControllerIdx n layout.tag₂Idx)).HasBinaryNat 0 + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₀Idx layout.tag₂Idx (Ne.symm hcursorTag₂) htag₂Tag₀ + outerExtras cursor tag₀] + exact htag₂ + have houter₂ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₂ i) := + outputProbeDecodeTagBitOuterExtrasAfter_parked_internal n layout + layout.tag₁Idx outer₁ houter₁ (cursor + 1) tag₁ + have htag₀₂ : + (outer₂ (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0) := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₁Idx + outer₁ (cursor + 1) tag₁ + (outputProbeIndexedControllerIdx n layout.tag₀Idx)).HasBinaryNat + (if tag₀ then 1 else 0) + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₁Idx layout.tag₀Idx (Ne.symm hcursorTag₀) htag₀Tag₁ + outer₁ (cursor + 1) tag₁] + exact htag₀₁ + have htag₁₂ := outputProbeDecodeTagBitOuterExtrasAfter_bit_internal n + layout layout.tag₁Idx hcursorTag₁ outer₁ htag₁₁ (cursor + 1) tag₁ + have htag₂₂ : + (outer₂ (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₁Idx + outer₁ (cursor + 1) tag₁ + (outputProbeIndexedControllerIdx n layout.tag₂Idx)).HasBinaryNat 0 + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₁Idx layout.tag₂Idx (Ne.symm hcursorTag₂) htag₂Tag₁ + outer₁ (cursor + 1) tag₁] + exact htag₂₁ + have houter₃ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₃ i) := + outputProbeDecodeTagBitOuterExtrasAfter_parked_internal n layout + layout.tag₂Idx outer₂ houter₂ (cursor + 2) tag₂ + have htag₀₃ : + (outer₃ (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0) := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₂Idx + outer₂ (cursor + 2) tag₂ + (outputProbeIndexedControllerIdx n layout.tag₀Idx)).HasBinaryNat + (if tag₀ then 1 else 0) + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₂Idx layout.tag₀Idx (Ne.symm hcursorTag₀) htag₀Tag₂ + outer₂ (cursor + 2) tag₂] + exact htag₀₂ + have htag₁₃ : + (outer₃ (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0) := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₂Idx + outer₂ (cursor + 2) tag₂ + (outputProbeIndexedControllerIdx n layout.tag₁Idx)).HasBinaryNat + (if tag₁ then 1 else 0) + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₂Idx layout.tag₁Idx (Ne.symm hcursorTag₁) htag₁Tag₂ + outer₂ (cursor + 2) tag₂] + exact htag₁₂ + have htag₂₃ := outputProbeDecodeTagBitOuterExtrasAfter_bit_internal n + layout layout.tag₂Idx hcursorTag₂ outer₂ htag₂₂ (cursor + 2) tag₂ + simpa [outputProbeDecodeTagOuterExtrasAfter, outer₁, outer₂, outer₃] + using And.intro houter₃ + (And.intro htag₀₃ (And.intro htag₁₃ htag₂₃)) + +private theorem outputProbeDecodeTagSucc_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (idx : Fin controllerTapes) (value : ℕ) + (hvalue : + (outerExtras (outputProbeIndexedControllerIdx n idx)).HasBinaryNat + value) : + (binarySuccTM + (outputProbeIndexedControllerIdx n idx)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) + (outputProbeCounterTape (value + 1))) + input output extras false) + (binarySuccTime value) := by + let physical := outputProbeIndexedControllerIdx n idx + let nextTape := outputProbeCounterTape (value + 1) + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + have htarget : (work physical).HasBinaryNat value := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false inp work out hpost idx] + exact hvalue + obtain ⟨done, hreach, hhalt, hinputDone, hotherDone, htargetDone, + houtputDone⟩ := + binarySuccTM_reachesIn_frame physical value inp work out htarget + hinput.read_ne_start (fun i _ => (hwork i).read_ne_start) + hout.read_ne_start + have hworkDone : done.work = Function.update work physical nextTape := by + funext i + by_cases hi : i = physical + · subst i + rw [Function.update_self] + exact htargetDone.eq_init_move_right + · rw [Function.update_of_ne hi] + exact hotherDone i hi + refine ⟨done, binarySuccTime value, le_rfl, hreach, hhalt, ?_⟩ + rw [hinputDone, hworkDone, houtputDone] + simpa [physical, nextTape] using + outputProbeLatchFramePost_updateController tm controllerTapes outerExtras + input output extras false inp work out hpost idx nextTape + +theorem ComputesInSpace.outputProbeDecodeTagBitTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx : Fin controllerTapes) + (hcursorScratch : layout.cursorIdx ≠ layout.scratchIdx) + (hcursorBit : layout.cursorIdx ≠ bitIdx) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.scratchIdx)).HasBinaryNat + 0) + (hbit : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat 0) : + ∃ (bodyBound : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTagBitTM tm controllerTapes layout bitIdx).HoareTime + pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagBitOuterExtrasAfter n layout bitIdx outerExtras + cursor ((f input)[cursor]'hcursorBound)) + input output extras false) + (bodyBound + 1 + binarySuccTime cursor) := by + let bit := (f input)[cursor]'hcursorBound + let afterBit := outputProbeCountOnesOuterExtrasAfter n bitIdx outerExtras 0 + bit + obtain ⟨bodyBound, pre, hpre, hbody⟩ := + hcomp.outputProbeCountOnesBodyTM_hoareTime input cursor hcursorBound output + houtput extras hextras hcleanupCounter cleanupLimit hcleanupLimit hlimit + controllerTapes outerExtras houter layout.cursorIdx layout.scratchIdx + bitIdx hcursorScratch hcursor hscratch 0 hbit + have hafterParked : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (afterBit i) := by + by_cases hbitValue : bit + · simpa [afterBit, outputProbeCountOnesOuterExtrasAfter, hbitValue] using + outputProbeDecodeTagUpdateOuter_parked_internal n outerExtras houter + bitIdx 1 + · simpa [afterBit, outputProbeCountOnesOuterExtrasAfter, hbitValue] using + houter + have hcursorAfter : + (afterBit (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + cursor := by + have hphysical : outputProbeDecodeTagCursorIdx n layout ≠ + outputProbeIndexedControllerIdx n bitIdx := by + intro heq + exact hcursorBit (outputProbeIndexedControllerIdx_injective n heq) + by_cases hbitValue : bit + · simpa [afterBit, outputProbeCountOnesOuterExtrasAfter, hbitValue, + hphysical] using hcursor + · simpa [afterBit, outputProbeCountOnesOuterExtrasAfter, hbitValue] using + hcursor + have hsucc := outputProbeDecodeTagSucc_hoareTime_internal tm + controllerTapes afterBit input output extras hextras hafterParked houtput + layout.cursorIdx cursor hcursorAfter + have htransition : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes afterBit input output + extras false inp work out → + outputProbeLatchFramePost tm controllerTapes afterBit input output + extras false (transitionInput inp) + (fun i => transitionTape (work i)) (transitionTape out) := by + intro inp work out hpost + obtain ⟨hinp, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes afterBit input output extras false hextras hafterParked + houtput inp work out hpost + rw [hinp.transitionInput_eq_self] + have hworkTransition : (fun i => transitionTape (work i)) = work := by + funext i + exact (hwork i).transitionTape_eq_self + rw [hworkTransition, hout.transitionTape_eq_self] + exact hpost + refine ⟨bodyBound, pre, hpre, ?_⟩ + simpa [outputProbeDecodeTagBitTM, + outputProbeDecodeTagBitOuterExtrasAfter, afterBit, bit, + outputProbeDecodeTagCursorIdx] using + seqTM_hoareTime + (outputProbeCountOnesBodyTM tm controllerTapes layout.cursorIdx + layout.scratchIdx bitIdx) + (binarySuccTM (outputProbeDecodeTagCursorIdx n layout)) + hbody htransition hsucc + +private theorem outputProbeDecodeTagFramePost_to_pre_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)) + (hpre : pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output) : + ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + pre (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpost + obtain ⟨hinputEq, hworkEq, houtputEq⟩ := + outputProbeLatchFramePost_eq_frameCfg tm controllerTapes outerExtras input + output extras false inp work out hpost + obtain ⟨hinputParked, hworkParked, houtputParked⟩ := + outputProbeLatchFramePost_parked tm controllerTapes outerExtras input + output extras false hextras houter houtput inp work out hpost + rw [hinputParked.transitionInput_eq_self] + have hworkTransition : (fun i => transitionTape (work i)) = work := by + funext i + exact (hworkParked i).transitionTape_eq_self + rw [hworkTransition, houtputParked.transitionTape_eq_self, hinputEq, + hworkEq, houtputEq] + exact hpre + +theorem ComputesInSpace.outputProbeDecodeTagTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.scratchIdx)).HasBinaryNat + 0) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTagTM tm controllerTapes layout).HoareTime pre + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + ((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) := by + have hbound₀ : cursor < (f input).length := by omega + have hbound₁ : cursor + 1 < (f input).length := by omega + have hbound₂ : cursor + 2 < (f input).length := hcursorBound + have hcursorScratch : layout.cursorIdx ≠ layout.scratchIdx := + layout.roles_ne_internal (by decide) + have hcursorTag₀ : layout.cursorIdx ≠ layout.tag₀Idx := + layout.roles_ne_internal (by decide) + have hcursorTag₁ : layout.cursorIdx ≠ layout.tag₁Idx := + layout.roles_ne_internal (by decide) + have hcursorTag₂ : layout.cursorIdx ≠ layout.tag₂Idx := + layout.roles_ne_internal (by decide) + have hscratchTag₀ : layout.scratchIdx ≠ layout.tag₀Idx := + layout.roles_ne_internal (by decide) + have hscratchTag₁ : layout.scratchIdx ≠ layout.tag₁Idx := + layout.roles_ne_internal (by decide) + have hscratchTag₂ : layout.scratchIdx ≠ layout.tag₂Idx := + layout.roles_ne_internal (by decide) + have htag₁Tag₀ : layout.tag₁Idx ≠ layout.tag₀Idx := + layout.roles_ne_internal (by decide) + have htag₂Tag₀ : layout.tag₂Idx ≠ layout.tag₀Idx := + layout.roles_ne_internal (by decide) + have htag₂Tag₁ : layout.tag₂Idx ≠ layout.tag₁Idx := + layout.roles_ne_internal (by decide) + let bit₀ := (f input)[cursor]'hbound₀ + let bit₁ := (f input)[cursor + 1]'hbound₁ + let bit₂ := (f input)[cursor + 2]'hbound₂ + let outer₁ := outputProbeDecodeTagBitOuterExtrasAfter n layout + layout.tag₀Idx outerExtras cursor bit₀ + let outer₂ := outputProbeDecodeTagBitOuterExtrasAfter n layout + layout.tag₁Idx outer₁ (cursor + 1) bit₁ + let outer₃ := outputProbeDecodeTagBitOuterExtrasAfter n layout + layout.tag₂Idx outer₂ (cursor + 2) bit₂ + have houter₁ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₁ i) := + outputProbeDecodeTagBitOuterExtrasAfter_parked_internal n layout + layout.tag₀Idx outerExtras houter cursor bit₀ + have hcursor₁ : + (outer₁ (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + (cursor + 1) := + outputProbeDecodeTagBitOuterExtrasAfter_cursor_internal n layout + layout.tag₀Idx outerExtras cursor bit₀ + have hscratch₁ : + (outer₁ (outputProbeIndexedControllerIdx n layout.scratchIdx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₀Idx + outerExtras cursor bit₀ + (outputProbeIndexedControllerIdx n layout.scratchIdx)).HasBinaryNat 0 + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₀Idx layout.scratchIdx (Ne.symm hcursorScratch) + hscratchTag₀ outerExtras cursor bit₀] + exact hscratch + have htag₁₁ : + (outer₁ (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₀Idx + outerExtras cursor bit₀ + (outputProbeIndexedControllerIdx n layout.tag₁Idx)).HasBinaryNat 0 + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₀Idx layout.tag₁Idx (Ne.symm hcursorTag₁) htag₁Tag₀ + outerExtras cursor bit₀] + exact htag₁ + have htag₂₁ : + (outer₁ (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₀Idx + outerExtras cursor bit₀ + (outputProbeIndexedControllerIdx n layout.tag₂Idx)).HasBinaryNat 0 + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₀Idx layout.tag₂Idx (Ne.symm hcursorTag₂) htag₂Tag₀ + outerExtras cursor bit₀] + exact htag₂ + have houter₂ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₂ i) := + outputProbeDecodeTagBitOuterExtrasAfter_parked_internal n layout + layout.tag₁Idx outer₁ houter₁ (cursor + 1) bit₁ + have hcursor₂ : + (outer₂ (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + (cursor + 2) := by + simpa [Nat.add_assoc] using + outputProbeDecodeTagBitOuterExtrasAfter_cursor_internal n layout + layout.tag₁Idx outer₁ (cursor + 1) bit₁ + have hscratch₂ : + (outer₂ (outputProbeIndexedControllerIdx n layout.scratchIdx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₁Idx + outer₁ (cursor + 1) bit₁ + (outputProbeIndexedControllerIdx n layout.scratchIdx)).HasBinaryNat 0 + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₁Idx layout.scratchIdx (Ne.symm hcursorScratch) + hscratchTag₁ outer₁ (cursor + 1) bit₁] + exact hscratch₁ + have htag₂₂ : + (outer₂ (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0 := by + change (outputProbeDecodeTagBitOuterExtrasAfter n layout layout.tag₁Idx + outer₁ (cursor + 1) bit₁ + (outputProbeIndexedControllerIdx n layout.tag₂Idx)).HasBinaryNat 0 + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n layout + layout.tag₁Idx layout.tag₂Idx (Ne.symm hcursorTag₂) htag₂Tag₁ outer₁ + (cursor + 1) bit₁] + exact htag₂₁ + have houter₃ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₃ i) := + outputProbeDecodeTagBitOuterExtrasAfter_parked_internal n layout + layout.tag₂Idx outer₂ houter₂ (cursor + 2) bit₂ + obtain ⟨bound₀, pre₀, hpre₀, hstep₀⟩ := + hcomp.outputProbeDecodeTagBitTM_hoareTime_internal input cursor hbound₀ + output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ controllerTapes layout layout.tag₀Idx + hcursorScratch hcursorTag₀ outerExtras houter hcursor hscratch htag₀ + obtain ⟨bound₁, pre₁, hpre₁, hstep₁⟩ := + hcomp.outputProbeDecodeTagBitTM_hoareTime_internal input (cursor + 1) + hbound₁ output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₁ controllerTapes layout layout.tag₁Idx + hcursorScratch hcursorTag₁ outer₁ houter₁ hcursor₁ hscratch₁ htag₁₁ + obtain ⟨bound₂, pre₂, hpre₂, hstep₂⟩ := + hcomp.outputProbeDecodeTagBitTM_hoareTime_internal input (cursor + 2) + hbound₂ output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₂ controllerTapes layout layout.tag₂Idx + hcursorScratch hcursorTag₂ outer₂ houter₂ hcursor₂ hscratch₂ htag₂₂ + have hstep₀' : + (outputProbeDecodeTagBitTM tm controllerTapes layout + layout.tag₀Idx).HoareTime pre₀ + (outputProbeLatchFramePost tm controllerTapes outer₁ input output + extras false) + (bound₀ + 1 + binarySuccTime cursor) := by + simpa [outer₁, bit₀] using hstep₀ + have hstep₁' : + (outputProbeDecodeTagBitTM tm controllerTapes layout + layout.tag₁Idx).HoareTime pre₁ + (outputProbeLatchFramePost tm controllerTapes outer₂ input output + extras false) + (bound₁ + 1 + binarySuccTime (cursor + 1)) := by + simpa [outer₂, bit₁] using hstep₁ + have hstep₂' : + (outputProbeDecodeTagBitTM tm controllerTapes layout + layout.tag₂Idx).HoareTime pre₂ + (outputProbeLatchFramePost tm controllerTapes outer₃ input output + extras false) + (bound₂ + 1 + binarySuccTime (cursor + 2)) := by + simpa [outer₃, bit₂] using hstep₂ + have hseam₁ := outputProbeDecodeTagFramePost_to_pre_internal tm + controllerTapes outer₁ input output extras hextras houter₁ houtput pre₁ + hpre₁ + have hseam₂ := outputProbeDecodeTagFramePost_to_pre_internal tm + controllerTapes outer₂ input output extras hextras houter₂ houtput pre₂ + hpre₂ + have hstep₁₂ := seqTM_hoareTime + (outputProbeDecodeTagBitTM tm controllerTapes layout layout.tag₁Idx) + (outputProbeDecodeTagBitTM tm controllerTapes layout layout.tag₂Idx) + hstep₁' hseam₂ hstep₂' + have hfull := seqTM_hoareTime + (outputProbeDecodeTagBitTM tm controllerTapes layout layout.tag₀Idx) + (seqTM + (outputProbeDecodeTagBitTM tm controllerTapes layout layout.tag₁Idx) + (outputProbeDecodeTagBitTM tm controllerTapes layout layout.tag₂Idx)) + hstep₀' hseam₁ hstep₁₂ + refine ⟨bound₀, bound₁, bound₂, pre₀, hpre₀, ?_⟩ + simpa [outputProbeDecodeTagTM, outputProbeDecodeTagOuterExtrasAfter, + outer₁, outer₂, outer₃, bit₀, bit₁, bit₂] using hfull + +private theorem outputProbeDecodeTagBitDispatchTM_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (bitIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hbit : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat + (if bit then 1 else 0)) + (onZero onOne : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {zeroTime oneTime : ℕ} + (hzero : onZero.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime) + (hone : onOne.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post true) oneTime) : + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n bitIdx) Γ.one onOne + onZero).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post bit) ((if bit then oneTime else zeroTime) + 1) := by + cases bit with + | false => + have hzeroBit : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat 0 := + by simpa using hbit + have hzeroController : + (outerExtras (outputProbeIndexedControllerIdx n bitIdx)) + |>.HasBinaryNat 0 := by + simpa [outputProbeDecodeTagBitIdx] using hzeroBit + have hbranch := branchWorkSymbolTM_hoareTime_different + (outputProbeDecodeTagBitIdx n bitIdx) Γ.one onOne onZero + (fun inp work out hpost => by + change (work (outputProbeIndexedControllerIdx n bitIdx)).read ≠ + Γ.one + have hcontroller := outputProbeLatchFramePost_controller tm + controllerTapes outerExtras input output extras false inp work out + hpost bitIdx + rw [hcontroller, hzeroController.eq_init_move_right] + decide) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).1.read_ne_start) + (fun inp work out hpost i => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).2.1 i |>.read_ne_start) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).2.2.read_ne_start) + hzero + simpa using hbranch + | true => + have honeBit : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat 1 := + by simpa using hbit + have honeController : + (outerExtras (outputProbeIndexedControllerIdx n bitIdx)) + |>.HasBinaryNat 1 := by + simpa [outputProbeDecodeTagBitIdx] using honeBit + have hbranch := branchWorkSymbolTM_hoareTime_equal + (outputProbeDecodeTagBitIdx n bitIdx) Γ.one onOne onZero + (fun inp work out hpost => by + change (work (outputProbeIndexedControllerIdx n bitIdx)).read = + Γ.one + have hcontroller := outputProbeLatchFramePost_controller tm + controllerTapes outerExtras input output extras false inp work out + hpost bitIdx + rw [hcontroller, honeController.eq_init_move_right] + rfl) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).1.read_ne_start) + (fun inp work out hpost i => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).2.1 i |>.read_ne_start) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).2.2.read_ne_start) + hone + simpa using hbranch + +private theorem outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (bitIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (hbit : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat + (if bit then 1 else 0)) + (onZero onOne : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : (if bit then onOne else onZero).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + post selectedTime) : + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n bitIdx) Γ.one onOne + onZero).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + post (selectedTime + 1) := by + cases bit with + | false => + have hzeroBit : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat 0 := + by simpa using hbit + have hzeroController : + (outerExtras (outputProbeIndexedControllerIdx n bitIdx)) + |>.HasBinaryNat 0 := by + simpa [outputProbeDecodeTagBitIdx] using hzeroBit + have hbranch := branchWorkSymbolTM_hoareTime_different + (outputProbeDecodeTagBitIdx n bitIdx) Γ.one onOne onZero + (fun inp work out hpost => by + change (work (outputProbeIndexedControllerIdx n bitIdx)).read ≠ + Γ.one + have hcontroller := outputProbeLatchFramePost_controller tm + controllerTapes outerExtras input output extras false inp work out + hpost bitIdx + rw [hcontroller, hzeroController.eq_init_move_right] + decide) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).1.read_ne_start) + (fun inp work out hpost i => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).2.1 i |>.read_ne_start) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).2.2.read_ne_start) + hselected + simpa using hbranch + | true => + have honeBit : + (outerExtras (outputProbeDecodeTagBitIdx n bitIdx)).HasBinaryNat 1 := + by simpa using hbit + have honeController : + (outerExtras (outputProbeIndexedControllerIdx n bitIdx)) + |>.HasBinaryNat 1 := by + simpa [outputProbeDecodeTagBitIdx] using honeBit + have hbranch := branchWorkSymbolTM_hoareTime_equal + (outputProbeDecodeTagBitIdx n bitIdx) Γ.one onOne onZero + (fun inp work out hpost => by + change (work (outputProbeIndexedControllerIdx n bitIdx)).read = + Γ.one + have hcontroller := outputProbeLatchFramePost_controller tm + controllerTapes outerExtras input output extras false inp work out + hpost bitIdx + rw [hcontroller, honeController.eq_init_move_right] + rfl) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).1.read_ne_start) + (fun inp work out hpost i => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).2.1 i |>.read_ne_start) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked tm controllerTapes outerExtras + input output extras false hextras houter houtput inp work out + hpost).2.2.read_ne_start) + hselected + simpa using hbranch + +theorem outputProbeDecodeTagDispatchTM_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Option OutputProbeTokenTag → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ} + (hvar : onVar.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .var)) varTime) + (htru : onTru.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .tru)) truTime) + (hfls : onFls.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .fls)) flsTime) + (hneg : onNeg.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .neg)) negTime) + (hconj : onConj.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .conj)) conjTime) + (hdisj : onDisj.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (some .disj)) disjTime) + (hinvalid : onInvalid.HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post none) invalidTime) : + (outputProbeDecodeTagDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (outputProbeTokenTag? tag₀ tag₁ tag₂)) + (outputProbeDecodeTagDispatchTime tag₀ tag₁ tag₂ varTime + truTime flsTime negTime conjTime disjTime invalidTime) := by + let tag₂Physical := outputProbeDecodeTagBitIdx n layout.tag₂Idx + let tag₀ZeroTM := branchWorkSymbolTM tag₂Physical Γ.one onTru onVar + let tag₀OneTM := branchWorkSymbolTM tag₂Physical Γ.one onNeg onFls + let tag₁ZeroTM := branchWorkSymbolTM tag₂Physical Γ.one onDisj onConj + have htag₀Zero := outputProbeDecodeTagBitDispatchTM_hoareTime_internal tm + controllerTapes layout.tag₂Idx outerExtras input output extras tag₂ hextras + houter houtput htag₂ onVar onTru + (post := fun bit => post (if bit then some .tru else some .var)) + hvar htru + have htag₀One := outputProbeDecodeTagBitDispatchTM_hoareTime_internal tm + controllerTapes layout.tag₂Idx outerExtras input output extras tag₂ hextras + houter houtput htag₂ onFls onNeg + (post := fun bit => post (if bit then some .neg else some .fls)) + hfls hneg + have htag₁Zero := outputProbeDecodeTagBitDispatchTM_hoareTime_internal tm + controllerTapes layout.tag₂Idx outerExtras input output extras tag₂ hextras + houter houtput htag₂ onConj onDisj + (post := fun bit => post (if bit then some .disj else some .conj)) + hconj hdisj + have htag₀Branch := + outputProbeDecodeTagBitDispatchTM_hoareTime_internal tm controllerTapes + layout.tag₁Idx outerExtras input output extras tag₁ hextras houter + houtput htag₁ tag₀ZeroTM tag₀OneTM + (post := fun bit => post (if bit then + if tag₂ then some .neg else some .fls + else if tag₂ then some .tru else some .var)) + htag₀Zero htag₀One + have htag₁Branch := + outputProbeDecodeTagBitDispatchTM_hoareTime_internal tm controllerTapes + layout.tag₁Idx outerExtras input output extras tag₁ hextras houter + houtput htag₁ tag₁ZeroTM onInvalid + (post := fun bit => post (if bit then none + else if tag₂ then some .disj else some .conj)) + htag₁Zero hinvalid + have hroot := outputProbeDecodeTagBitDispatchTM_hoareTime_internal tm + controllerTapes layout.tag₀Idx outerExtras input output extras tag₀ hextras + houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) Γ.one + tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) Γ.one + onInvalid tag₁ZeroTM) + (post := fun bit => post (if bit then + if tag₁ then none + else if tag₂ then some .disj else some .conj + else if tag₁ then + if tag₂ then some .neg else some .fls + else if tag₂ then some .tru else some .var)) + htag₀Branch htag₁Branch + cases tag₀ <;> cases tag₁ <;> cases tag₂ <;> + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchTime, outputProbeTokenTag?, tag₂Physical, + tag₀ZeroTM, tag₀OneTM, tag₁ZeroTM, Nat.add_assoc] using hroot + +theorem outputProbeDecodeTagDispatchTM_selected_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : + (outputProbeTokenContinuation + (outputProbeTokenTag? tag₀ tag₁ tag₂) + onVar onTru onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + post selectedTime) : + (outputProbeDecodeTagDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + post (selectedTime + outputProbeDecodeTagDispatchDepth tag₀ tag₁) := by + let tag₂Physical := outputProbeDecodeTagBitIdx n layout.tag₂Idx + let tag₀ZeroTM := branchWorkSymbolTM tag₂Physical Γ.one onTru onVar + let tag₀OneTM := branchWorkSymbolTM tag₂Physical Γ.one onNeg onFls + let tag₁ZeroTM := branchWorkSymbolTM tag₂Physical Γ.one onDisj onConj + cases tag₀ <;> cases tag₁ <;> cases tag₂ + · have h₂ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₂Idx outerExtras input output extras false + hextras houter houtput htag₂ onVar onTru hselected + have h₁ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₁Idx outerExtras input output extras false + hextras houter houtput htag₁ tag₀ZeroTM tag₀OneTM h₂ + have h₀ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₀Idx outerExtras input output extras false + hextras houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one onInvalid tag₁ZeroTM) + h₁ + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchDepth, tag₀ZeroTM, tag₀OneTM, + tag₁ZeroTM, Nat.add_assoc] using h₀ + · have h₂ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₂Idx outerExtras input output extras true + hextras houter houtput htag₂ onVar onTru hselected + have h₁ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₁Idx outerExtras input output extras false + hextras houter houtput htag₁ tag₀ZeroTM tag₀OneTM h₂ + have h₀ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₀Idx outerExtras input output extras false + hextras houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one onInvalid tag₁ZeroTM) + h₁ + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchDepth, tag₀ZeroTM, tag₀OneTM, + tag₁ZeroTM, Nat.add_assoc] using h₀ + · have h₂ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₂Idx outerExtras input output extras false + hextras houter houtput htag₂ onFls onNeg hselected + have h₁ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₁Idx outerExtras input output extras true + hextras houter houtput htag₁ tag₀ZeroTM tag₀OneTM h₂ + have h₀ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₀Idx outerExtras input output extras false + hextras houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one onInvalid tag₁ZeroTM) + h₁ + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchDepth, tag₀ZeroTM, tag₀OneTM, + tag₁ZeroTM, Nat.add_assoc] using h₀ + · have h₂ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₂Idx outerExtras input output extras true + hextras houter houtput htag₂ onFls onNeg hselected + have h₁ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₁Idx outerExtras input output extras true + hextras houter houtput htag₁ tag₀ZeroTM tag₀OneTM h₂ + have h₀ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₀Idx outerExtras input output extras false + hextras houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one onInvalid tag₁ZeroTM) + h₁ + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchDepth, tag₀ZeroTM, tag₀OneTM, + tag₁ZeroTM, Nat.add_assoc] using h₀ + · have h₂ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₂Idx outerExtras input output extras false + hextras houter houtput htag₂ onConj onDisj hselected + have h₁ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₁Idx outerExtras input output extras false + hextras houter houtput htag₁ tag₁ZeroTM onInvalid h₂ + have h₀ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₀Idx outerExtras input output extras true + hextras houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one onInvalid tag₁ZeroTM) + h₁ + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchDepth, tag₀ZeroTM, tag₀OneTM, + tag₁ZeroTM, Nat.add_assoc] using h₀ + · have h₂ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₂Idx outerExtras input output extras true + hextras houter houtput htag₂ onConj onDisj hselected + have h₁ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₁Idx outerExtras input output extras false + hextras houter houtput htag₁ tag₁ZeroTM onInvalid h₂ + have h₀ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₀Idx outerExtras input output extras true + hextras houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one onInvalid tag₁ZeroTM) + h₁ + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchDepth, tag₀ZeroTM, tag₀OneTM, + tag₁ZeroTM, Nat.add_assoc] using h₀ + · have h₁ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₁Idx outerExtras input output extras true + hextras houter houtput htag₁ tag₁ZeroTM onInvalid hselected + have h₀ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₀Idx outerExtras input output extras true + hextras houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one onInvalid tag₁ZeroTM) + h₁ + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchDepth, tag₀ZeroTM, tag₀OneTM, + tag₁ZeroTM, Nat.add_assoc] using h₀ + · have h₁ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₁Idx outerExtras input output extras true + hextras houter houtput htag₁ tag₁ZeroTM onInvalid hselected + have h₀ := outputProbeDecodeTagBitDispatchTM_selected_hoareTime_internal + tm controllerTapes layout.tag₀Idx outerExtras input output extras true + hextras houter houtput htag₀ + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one tag₀OneTM tag₀ZeroTM) + (branchWorkSymbolTM (outputProbeDecodeTagBitIdx n layout.tag₁Idx) + Γ.one onInvalid tag₁ZeroTM) + h₁ + simpa [outputProbeDecodeTagDispatchTM, + outputProbeDecodeTagDispatchDepth, tag₀ZeroTM, tag₀OneTM, + tag₁ZeroTM, Nat.add_assoc] using h₀ + +theorem ComputesInSpace.outputProbeDecodeTagAndDispatchTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras (outputProbeDecodeTagCursorIdx n layout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.scratchIdx)).HasBinaryNat + 0) + (htag₀ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras (outputProbeDecodeTagBitIdx n layout.tag₂Idx)) + |>.HasBinaryNat 0) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Option OutputProbeTokenTag → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ} + (hvar : onVar.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .var)) varTime) + (htru : onTru.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .tru)) truTime) + (hfls : onFls.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .fls)) flsTime) + (hneg : onNeg.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .neg)) negTime) + (hconj : onConj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .conj)) conjTime) + (hdisj : onDisj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .disj)) disjTime) + (hinvalid : onInvalid.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTagOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post none) invalidTime) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTagAndDispatchTM tm controllerTapes layout onVar + onTru onFls onNeg onConj onDisj onInvalid).HoareTime pre + (post (outputProbeTokenTag? ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]))) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTagDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) varTime + truTime flsTime negTime conjTime disjTime invalidTime) := by + have hbound₀ : cursor < (f input).length := by omega + have hbound₁ : cursor + 1 < (f input).length := by omega + have hbound₂ : cursor + 2 < (f input).length := hcursorBound + let bit₀ := (f input)[cursor]'hbound₀ + let bit₁ := (f input)[cursor + 1]'hbound₁ + let bit₂ := (f input)[cursor + 2]'hbound₂ + let after := outputProbeDecodeTagOuterExtrasAfter n layout outerExtras + cursor bit₀ bit₁ bit₂ + obtain ⟨hafter, hafterTag₀, hafterTag₁, hafterTag₂⟩ := + outputProbeDecodeTagOuterExtrasAfter_invariant_internal n layout + outerExtras houter cursor bit₀ bit₁ bit₂ htag₀ htag₁ htag₂ + obtain ⟨bound₀, bound₁, bound₂, pre, hpre, hdecode⟩ := + hcomp.outputProbeDecodeTagTM_hoareTime_internal input cursor hcursorBound + output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes layout outerExtras + houter hcursor hscratch htag₀ htag₁ htag₂ + have hdispatch := outputProbeDecodeTagDispatchTM_hoareTime_internal tm + controllerTapes layout after input output extras bit₀ bit₁ bit₂ hextras + hafter houtput hafterTag₀ hafterTag₁ hafterTag₂ onVar onTru onFls onNeg + onConj onDisj onInvalid (post := post) (by simpa [after, bit₀, bit₁, bit₂] + using hvar) (by simpa [after, bit₀, bit₁, bit₂] using htru) + (by simpa [after, bit₀, bit₁, bit₂] using hfls) + (by simpa [after, bit₀, bit₁, bit₂] using hneg) + (by simpa [after, bit₀, bit₁, bit₂] using hconj) + (by simpa [after, bit₀, bit₁, bit₂] using hdisj) + (by simpa [after, bit₀, bit₁, bit₂] using hinvalid) + have hframePre := outputProbeLatchFrameCfg_post tm controllerTapes after + input output extras false + have hseam := outputProbeDecodeTagFramePost_to_pre_internal tm + controllerTapes after input output extras hextras hafter houtput + (outputProbeLatchFramePost tm controllerTapes after input output extras + false) + hframePre + have hfull := seqTM_hoareTime + (outputProbeDecodeTagTM tm controllerTapes layout) + (outputProbeDecodeTagDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid) + (by simpa [after, bit₀, bit₁, bit₂] using hdecode) hseam hdispatch + refine ⟨bound₀, bound₁, bound₂, pre, hpre, ?_⟩ + simpa [outputProbeDecodeTagAndDispatchTM, after, bit₀, bit₁, bit₂] + using hfull + +theorem outputProbeDecodeTagBitTM_isTransducer_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) + (bitIdx : Fin controllerTapes) : + (outputProbeDecodeTagBitTM tm controllerTapes layout + bitIdx).IsTransducer := by + apply IsTransducer.seqTM + · apply IsTransducer.outputProbeIndexedResetDispatchTM + · exact outputProbeDecodeTagSkipTM_isTransducer_internal + · exact binarySuccTM_isTransducer _ + · exact binarySuccTM_isTransducer _ + +theorem outputProbeDecodeTagTM_isTransducer_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTagLayout controllerTapes) : + (outputProbeDecodeTagTM tm controllerTapes layout).IsTransducer := by + apply IsTransducer.seqTM + · exact outputProbeDecodeTagBitTM_isTransducer_internal tm controllerTapes + layout layout.tag₀Idx + · apply IsTransducer.seqTM + · exact outputProbeDecodeTagBitTM_isTransducer_internal tm controllerTapes + layout layout.tag₁Idx + · exact outputProbeDecodeTagBitTM_isTransducer_internal tm controllerTapes + layout layout.tag₂Idx + +theorem IsTransducer.outputProbeDecodeTagDispatchTM_internal + {onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hvar : onVar.IsTransducer) (htru : onTru.IsTransducer) + (hfls : onFls.IsTransducer) (hneg : onNeg.IsTransducer) + (hconj : onConj.IsTransducer) (hdisj : onDisj.IsTransducer) + (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTagLayout controllerTapes) : + (outputProbeDecodeTagDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).IsTransducer := by + apply IsTransducer.branchWorkSymbolTM + · apply IsTransducer.branchWorkSymbolTM + · exact hinvalid + · exact hdisj.branchWorkSymbolTM hconj + · apply IsTransducer.branchWorkSymbolTM + · exact hneg.branchWorkSymbolTM hfls + · exact htru.branchWorkSymbolTM hvar + +theorem IsTransducer.outputProbeDecodeTagAndDispatchTM_internal + {tm : TM n} + {onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hvar : onVar.IsTransducer) (htru : onTru.IsTransducer) + (hfls : onFls.IsTransducer) (hneg : onNeg.IsTransducer) + (hconj : onConj.IsTransducer) (hdisj : onDisj.IsTransducer) + (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTagLayout controllerTapes) : + (outputProbeDecodeTagAndDispatchTM tm controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).IsTransducer := by + apply IsTransducer.seqTM + · exact outputProbeDecodeTagTM_isTransducer_internal tm controllerTapes + layout + · exact hvar.outputProbeDecodeTagDispatchTM_internal htru hfls hneg hconj + hdisj hinvalid layout + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken.lean new file mode 100644 index 00000000..bc5b7590 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken.lean @@ -0,0 +1,731 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDecodeToken.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDecodeToken.Internal + +/-! +# Shared formula-token decoder layout + +This module exposes the structural bridge between fixed-width tag probing and +terminated-unary variable decoding. Both controllers use the same cursor and +query scratch, while every retained tag and unary-loop register stays distinct. +-/ + +namespace Complexity + +namespace TM + +/-- Fixed-tag and terminated-unary decoding share one source cursor. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.tagLayout_cursorIdx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.cursorIdx = layout.natLayout.cursorIdx := + layout.tagLayout_cursorIdx_internal + +/-- Fixed-tag and terminated-unary decoding share one query scratch register. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.tagLayout_scratchIdx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.scratchIdx = layout.natLayout.scratchIdx := + layout.tagLayout_scratchIdx_internal + +/-- The first retained tag bit occupies complete-layout role two. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.tagLayout_tag₀Idx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.tag₀Idx = layout.roles 2 := + layout.tagLayout_tag₀Idx_internal + +/-- The second retained tag bit occupies complete-layout role three. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.tagLayout_tag₁Idx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.tag₁Idx = layout.roles 3 := + layout.tagLayout_tag₁Idx_internal + +/-- The third retained tag bit occupies complete-layout role four. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.tagLayout_tag₂Idx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.tag₂Idx = layout.roles 4 := + layout.tagLayout_tag₂Idx_internal + +/-- The unary accumulator occupies complete-layout role five. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.natLayout_valueIdx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.natLayout.valueIdx = layout.roles 5 := + layout.natLayout_valueIdx_internal + +/-- The unary active flag occupies complete-layout role six. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.natLayout_activeIdx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.natLayout.activeIdx = layout.roles 6 := + layout.natLayout_activeIdx_internal + +/-- The unary loop counter occupies complete-layout role seven. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.natLayout_loopIdx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.natLayout.loopIdx = layout.roles 7 := + layout.natLayout_loopIdx_internal + +/-- The preserved unary fuel occupies complete-layout role eight. -/ +@[simp] +theorem OutputProbeDecodeTokenLayout.natLayout_fuelIdx + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.natLayout.fuelIdx = layout.roles 8 := + layout.natLayout_fuelIdx_internal + +/-- Complete tag probing and cleanup leave every unrelated controller register +literally unchanged. -/ +theorem outputProbeDecodeTokenOuterExtrasAfter_other + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) (idx : Fin controllerTapes) + (hcursor : idx ≠ layout.tagLayout.cursorIdx) + (htag₀ : idx ≠ layout.tagLayout.tag₀Idx) + (htag₁ : idx ≠ layout.tagLayout.tag₁Idx) + (htag₂ : idx ≠ layout.tagLayout.tag₂Idx) : + outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor tag₀ + tag₁ tag₂ (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := + outputProbeDecodeTokenOuterExtrasAfter_other_internal n layout outerExtras + cursor tag₀ tag₁ tag₂ idx hcursor htag₀ htag₁ htag₂ + +/-- Complete tag probing and cleanup advance the shared cursor by exactly +three positions. -/ +theorem outputProbeDecodeTokenOuterExtrasAfter_cursor + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) : + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor tag₀ + tag₁ tag₂ (outputProbeDecodeTagCursorIdx n layout.tagLayout)) + |>.HasBinaryNat (cursor + 3) := + outputProbeDecodeTokenOuterExtrasAfter_cursor_internal n layout outerExtras + cursor tag₀ tag₁ tag₂ + +/-- Complete tag probing and cleanup preserve the parked outer-frame +invariant. -/ +theorem outputProbeDecodeTokenOuterExtrasAfter_parked + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (htag₀Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor tag₀ tag₁ tag₂ i) := + outputProbeDecodeTokenOuterExtrasAfter_parked_internal n layout outerExtras + houter cursor tag₀ tag₁ tag₂ htag₀Zero htag₁Zero htag₂Zero + +/-- Clearing retained tags preserves every other physical controller tape. -/ +theorem outputProbeDecodeTokenClearedTagExtras_eq_of_ne + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (idx : Fin (0 + outputProbeControllerTapes n + controllerTapes)) + (htag₀ : idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx) + (htag₁ : idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx) + (htag₂ : idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx) : + outputProbeDecodeTokenClearedTagExtras n layout outerExtras idx = + outerExtras idx := + outputProbeDecodeTokenClearedTagExtras_eq_of_ne_internal n layout + outerExtras idx htag₀ htag₁ htag₂ + +/-- Clearing retained tags restores the first tag register to canonical zero. -/ +theorem outputProbeDecodeTokenClearedTagExtras_tag₀ + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)).HasBinaryNat + 0 := + outputProbeDecodeTokenClearedTagExtras_tag₀_internal n layout outerExtras + +/-- Clearing retained tags restores the second tag register to canonical zero. -/ +theorem outputProbeDecodeTokenClearedTagExtras_tag₁ + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)).HasBinaryNat + 0 := + outputProbeDecodeTokenClearedTagExtras_tag₁_internal n layout outerExtras + +/-- Clearing retained tags restores the third tag register to canonical zero. -/ +theorem outputProbeDecodeTokenClearedTagExtras_tag₂ + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)).HasBinaryNat + 0 := + outputProbeDecodeTokenClearedTagExtras_tag₂_internal n layout outerExtras + +/-- Clear all three retained tag registers from a literal restored probe +frame, preserving every other tape and exposing the exact cleanup time. -/ +theorem outputProbeDecodeTokenClearTagsTM_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) : + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (outputProbeDecodeTokenClearTagsTime tag₀ tag₁ tag₂) := + outputProbeDecodeTokenClearTagsTM_hoareTime_internal tm controllerTapes + layout outerExtras input output extras tag₀ tag₁ tag₂ hextras houter + houtput htag₀ htag₁ htag₂ + +/-- Dispatch a retained tag after restoring the same canonical zero-tag frame +for every legal and invalid continuation. -/ +theorem outputProbeDecodeTokenDispatchTM_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Option OutputProbeTokenTag → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ} + (hvar : onVar.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .var)) varTime) + (htru : onTru.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .tru)) truTime) + (hfls : onFls.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .fls)) flsTime) + (hneg : onNeg.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .neg)) negTime) + (hconj : onConj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .conj)) conjTime) + (hdisj : onDisj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .disj)) disjTime) + (hinvalid : onInvalid.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post none) invalidTime) : + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (outputProbeTokenTag? tag₀ tag₁ tag₂)) + (outputProbeDecodeTokenDispatchTime tag₀ tag₁ tag₂ varTime + truTime flsTime negTime conjTime disjTime invalidTime) := + outputProbeDecodeTokenDispatchTM_hoareTime_internal tm controllerTapes + layout outerExtras input output extras tag₀ tag₁ tag₂ hextras houter + houtput htag₀ htag₁ htag₂ onVar onTru onFls onNeg onConj onDisj + onInvalid hvar htru hfls hneg hconj hdisj hinvalid + +/-- Dispatch and normalize a retained tag while requiring a contract only for +the selected continuation. -/ +theorem outputProbeDecodeTokenDispatchTM_selected_hoareTime + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : + (outputProbeTokenContinuation + (outputProbeTokenTag? tag₀ tag₁ tag₂) + onVar onTru onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + post selectedTime) : + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + post (outputProbeDecodeTokenSelectedDispatchTime tag₀ tag₁ tag₂ + selectedTime) := + outputProbeDecodeTokenDispatchTM_selected_hoareTime_internal tm + controllerTapes layout outerExtras input output extras tag₀ tag₁ tag₂ + hextras houter houtput htag₀ htag₁ htag₂ onVar onTru onFls onNeg + onConj onDisj onInvalid hselected + +/-- Probe a complete source tag, restore the canonical zero-tag invariant, and +run the selected continuation in one exact source-derived machine contract. -/ +theorem ComputesInSpace.outputProbeDecodeTokenTM_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Option OutputProbeTokenTag → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ} + (hvar : onVar.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .var)) varTime) + (htru : onTru.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .tru)) truTime) + (hfls : onFls.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .fls)) flsTime) + (hneg : onNeg.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .neg)) negTime) + (hconj : onConj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .conj)) conjTime) + (hdisj : onDisj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post (some .disj)) disjTime) + (hinvalid : onInvalid.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + (post none) invalidTime) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTokenTM tm controllerTapes layout onVar onTru onFls + onNeg onConj onDisj onInvalid).HoareTime pre + (post (outputProbeTokenTag? ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]))) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) varTime + truTime flsTime negTime conjTime disjTime invalidTime) := + hcomp.outputProbeDecodeTokenTM_hoareTime_internal input cursor hcursorBound + output houtput extras hextras hcleanupCounter cleanupLimit hcleanupLimit + hlimit₀ hlimit₁ hlimit₂ controllerTapes layout outerExtras houter + hcursor hscratch htag₀ htag₁ htag₂ onVar onTru onFls onNeg onConj + onDisj onInvalid hvar htru hfls hneg hconj hdisj hinvalid + +/-- Probe, normalize, and dispatch a complete token using only the contract of +the continuation selected by the source tag. -/ +theorem ComputesInSpace.outputProbeDecodeTokenTM_selected_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : + (outputProbeTokenContinuation + (outputProbeTokenTag? ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + onVar onTru onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + post selectedTime) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTokenTM tm controllerTapes layout onVar onTru onFls + onNeg onConj onDisj onInvalid).HoareTime pre post + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) selectedTime) := + hcomp.outputProbeDecodeTokenTM_selected_hoareTime_internal input cursor + hcursorBound output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes layout outerExtras + houter hcursor hscratch htag₀ htag₁ htag₂ onVar onTru onFls onNeg + onConj onDisj onInvalid hselected + +/-- The concrete variable continuation starts from the normalized post-tag +frame, decodes the following terminated-unary field, and ends in the exact +fuel-bounded semantic decoder frame. -/ +theorem ComputesInSpace.outputProbeDecodeTokenVar_hoareTime + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx)) + |>.HasBinaryNat 0) + (hactive : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.activeIdx)) + |>.HasBinaryNat 1) + (hloop : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.loopIdx)) + |>.HasBinaryNat 0) + (fuelValue : ℕ) + (hfuel : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor < + (f input).length) + (hqueryLimit : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).active = true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) value).cursor + 1) ≤ + cleanupLimit) : + ∃ bodyTime : ℕ → ℕ, + (outputProbeDecodeNatTM tm controllerTapes layout.natLayout.cursorIdx + layout.natLayout.scratchIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + layout.natLayout.fuelIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂) + input output extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatLoopOuterExtras n layout.natLayout.cursorIdx + layout.natLayout.valueIdx layout.natLayout.activeIdx + layout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂) + (outputProbeDecodeNatStateAt (f input) + (outputProbeDecodeTokenVarInitial cursor) fuelValue) + fuelValue) + input output extras false) + (binaryForLoopTime bodyTime fuelValue 0 fuelValue) := by + simpa [outputProbeDecodeTokenVarInitial] using + hcomp.outputProbeDecodeTokenVar_hoareTime_internal input output houtput + extras hextras hcleanupCounter cleanupLimit hcleanupLimit + controllerTapes layout outerExtras houter cursor tag₀ tag₁ tag₂ + hscratch htag₀Zero htag₁Zero htag₂Zero hvalue hactive hloop + fuelValue hfuel + (by simpa [outputProbeDecodeTokenVarInitial] using hqueryValid) + (by simpa [outputProbeDecodeTokenVarInitial] using hqueryLimit) + +/-- Retained-tag cleanup preserves the append-only output discipline. -/ +theorem outputProbeDecodeTokenClearTagsTM_isTransducer + (n controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + (outputProbeDecodeTokenClearTagsTM n controllerTapes + layout).IsTransducer := + outputProbeDecodeTokenClearTagsTM_isTransducer_internal n controllerTapes + layout + +/-- Invariant-restoring token dispatch preserves append-only output whenever +all selected continuations do. -/ +theorem IsTransducer.outputProbeDecodeTokenDispatchTM + {onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hvar : onVar.IsTransducer) (htru : onTru.IsTransducer) + (hfls : onFls.IsTransducer) (hneg : onNeg.IsTransducer) + (hconj : onConj.IsTransducer) (hdisj : onDisj.IsTransducer) + (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).IsTransducer := + hvar.outputProbeDecodeTokenDispatchTM_internal htru hfls hneg hconj hdisj + hinvalid layout + +/-- Complete normalized token probing preserves append-only output whenever +every selected continuation does. -/ +theorem IsTransducer.outputProbeDecodeTokenTM + {tm : TM n} + {onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hvar : onVar.IsTransducer) (htru : onTru.IsTransducer) + (hfls : onFls.IsTransducer) (hneg : onNeg.IsTransducer) + (hconj : onConj.IsTransducer) (hdisj : onDisj.IsTransducer) + (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + (outputProbeDecodeTokenTM tm controllerTapes layout onVar onTru onFls + onNeg onConj onDisj onInvalid).IsTransducer := + hvar.outputProbeDecodeTokenTM_internal htru hfls hneg hconj hdisj hinvalid + layout + +/-- The token controller with concrete terminated-unary variable decoding is +append-only whenever all fixed-token and invalid continuations are. -/ +theorem IsTransducer.outputProbeDecodeTokenWithNatTM + {tm : TM n} + {onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (htru : onTru.IsTransducer) (hfls : onFls.IsTransducer) + (hneg : onNeg.IsTransducer) (hconj : onConj.IsTransducer) + (hdisj : onDisj.IsTransducer) (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + (outputProbeDecodeTokenWithNatTM tm controllerTapes layout onTru onFls + onNeg onConj onDisj onInvalid).IsTransducer := + htru.outputProbeDecodeTokenWithNatTM_internal hfls hneg hconj hdisj + hinvalid layout + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken/Defs.lean new file mode 100644 index 00000000..df259dec --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken/Defs.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDecodeNat.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDecodeTag.Defs +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs + +/-! +# Shared formula-token decoder layout -- definitions + +The complete token controller shares its source cursor and query scratch +between fixed-width tag probing and terminated-unary variable decoding. Nine +distinct logical roles make that sharing explicit while keeping all mutable +registers structurally non-aliasing. +-/ + +namespace Complexity + +namespace TM + +/-- Nine distinct controller registers used by complete token decoding. + +The role order is cursor, query scratch, three retained tag bits, unary value, +unary active flag, loop counter, and fuel. -/ +structure OutputProbeDecodeTokenLayout (controllerTapes : ℕ) where + /-- Injective assignment of logical roles to controller tapes. -/ + roles : Fin 9 ↪ Fin controllerTapes + +/-- Restrict a complete token layout to the five fixed-tag roles. -/ +def OutputProbeDecodeTokenLayout.tagLayout + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + OutputProbeDecodeTagLayout controllerTapes where + roles := + { toFun := fun i => layout.roles ⟨i.val, by omega⟩ + inj' := by + intro i j hij + have hroles := layout.roles.injective hij + apply Fin.ext + simpa using congrArg Fin.val hroles } + +/-- Restrict a complete token layout to the six terminated-unary roles. + +Roles zero and one share the tag cursor and scratch. Unary roles two through +five use complete-layout roles five through eight. -/ +def OutputProbeDecodeTokenLayout.natLayout + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + OutputProbeDecodeNatLayout controllerTapes where + roles := + { toFun := fun i => layout.roles + ⟨if i.val < 2 then i.val else i.val + 3, by + by_cases hi : i.val < 2 + · simp [hi] + omega + · simp [hi] + omega⟩ + inj' := by + intro i j hij + have hroles := congrArg Fin.val (layout.roles.injective hij) + apply Fin.ext + by_cases hi : i.val < 2 <;> by_cases hj : j.val < 2 <;> + simp [hi, hj] at hroles <;> omega } + +/-- Canonical controller frame after clearing all three retained tag bits. -/ +def outputProbeDecodeTokenClearedTagExtras (n : ℕ) + {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + Function.update + (Function.update + (Function.update outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx) + (outputProbeCounterTape 0)) + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx) + (outputProbeCounterTape 0)) + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx) + (outputProbeCounterTape 0) + +/-- Clear and rewind the three retained tag-bit registers in source order. -/ +def outputProbeDecodeTokenClearTagsTM (n controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM + (clearWorkTM + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + (seqTM + (clearWorkTM + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + (clearWorkTM + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx))) + +/-- Exact time to clear a canonical retained three-bit tag frame. -/ +def outputProbeDecodeTokenClearTagsTime (tag₀ tag₁ tag₂ : Bool) : ℕ := + clearWorkTimeBound (if tag₀ then 1 else 0).bits.length + 1 + + (clearWorkTimeBound (if tag₁ then 1 else 0).bits.length + 1 + + clearWorkTimeBound (if tag₂ then 1 else 0).bits.length) + +/-- Dispatch a retained tag after wrapping every selected continuation in the +same three-register cleanup phase. -/ +def outputProbeDecodeTokenDispatchTM (n controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + let clearTags := outputProbeDecodeTokenClearTagsTM n controllerTapes layout + outputProbeDecodeTagDispatchTM n controllerTapes layout.tagLayout + (seqTM clearTags onVar) (seqTM clearTags onTru) + (seqTM clearTags onFls) (seqTM clearTags onNeg) + (seqTM clearTags onConj) (seqTM clearTags onDisj) + (seqTM clearTags onInvalid) + +/-- Exact selected runtime of invariant-restoring token dispatch. -/ +def outputProbeDecodeTokenDispatchTime (tag₀ tag₁ tag₂ : Bool) + (varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ) : + ℕ := + let clearTime := outputProbeDecodeTokenClearTagsTime tag₀ tag₁ tag₂ + outputProbeDecodeTagDispatchTime tag₀ tag₁ tag₂ + (clearTime + 1 + varTime) (clearTime + 1 + truTime) + (clearTime + 1 + flsTime) (clearTime + 1 + negTime) + (clearTime + 1 + conjTime) (clearTime + 1 + disjTime) + (clearTime + 1 + invalidTime) + +/-- Exact cleanup and branch cost when only the selected continuation's +runtime is relevant. -/ +def outputProbeDecodeTokenSelectedDispatchTime (tag₀ tag₁ tag₂ : Bool) + (selectedTime : ℕ) : ℕ := + outputProbeDecodeTokenClearTagsTime tag₀ tag₁ tag₂ + 1 + selectedTime + + outputProbeDecodeTagDispatchDepth tag₀ tag₁ + +/-- Probe a complete fixed-width tag and dispatch from a normalized token +frame to its selected continuation. -/ +def outputProbeDecodeTokenTM (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM (outputProbeDecodeTagTM tm controllerTapes layout.tagLayout) + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid) + +/-- Canonical normalized controller frame after retaining and then clearing a +complete fixed-width tag. The cursor remains advanced by three. -/ +def outputProbeDecodeTokenOuterExtrasAfter (n : ℕ) + {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape := + outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor tag₀ tag₁ tag₂) + +/-- Pure terminated-unary decoder state selected after consuming a complete +three-bit variable tag. -/ +def outputProbeDecodeTokenVarInitial (cursor : ℕ) : + OutputProbeDecodeNatState := + { cursor := cursor + 3, value := 0, active := true } + +/-- Complete token controller with the variable branch instantiated by the +bounded terminated-unary decoder from the shared layout. -/ +def outputProbeDecodeTokenWithNatTM (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeDecodeTokenTM tm controllerTapes layout + (outputProbeDecodeNatTM tm controllerTapes layout.natLayout.cursorIdx + layout.natLayout.scratchIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + layout.natLayout.fuelIdx) + onTru onFls onNeg onConj onDisj onInvalid + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken/Internal.lean new file mode 100644 index 00000000..288f7a49 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDecodeToken/Internal.lean @@ -0,0 +1,1248 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDecodeNat +import Complexitylib.Models.TuringMachine.OutputProbeDecodeTag +import Complexitylib.Models.TuringMachine.OutputProbeDecodeToken.Defs +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork + +/-! +# Shared formula-token decoder layout -- internals +-/ + +namespace Complexity + +namespace TM + +theorem OutputProbeDecodeTokenLayout.tagLayout_cursorIdx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.cursorIdx = layout.natLayout.cursorIdx := by + rfl + +theorem OutputProbeDecodeTokenLayout.tagLayout_scratchIdx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.scratchIdx = layout.natLayout.scratchIdx := by + rfl + +theorem OutputProbeDecodeTokenLayout.tagLayout_tag₀Idx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.tag₀Idx = layout.roles 2 := by + rfl + +theorem OutputProbeDecodeTokenLayout.tagLayout_tag₁Idx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.tag₁Idx = layout.roles 3 := by + rfl + +theorem OutputProbeDecodeTokenLayout.tagLayout_tag₂Idx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.tagLayout.tag₂Idx = layout.roles 4 := by + rfl + +theorem OutputProbeDecodeTokenLayout.natLayout_valueIdx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.natLayout.valueIdx = layout.roles 5 := by + rfl + +theorem OutputProbeDecodeTokenLayout.natLayout_activeIdx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.natLayout.activeIdx = layout.roles 6 := by + rfl + +theorem OutputProbeDecodeTokenLayout.natLayout_loopIdx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.natLayout.loopIdx = layout.roles 7 := by + rfl + +theorem OutputProbeDecodeTokenLayout.natLayout_fuelIdx_internal + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + layout.natLayout.fuelIdx = layout.roles 8 := by + rfl + +theorem outputProbeDecodeTokenClearedTagExtras_eq_of_ne_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (idx : Fin (0 + outputProbeControllerTapes n + controllerTapes)) + (htag₀ : idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx) + (htag₁ : idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx) + (htag₂ : idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx) : + outputProbeDecodeTokenClearedTagExtras n layout outerExtras idx = + outerExtras idx := by + simp [outputProbeDecodeTokenClearedTagExtras, htag₀, htag₁, htag₂] + +/-- Every controller register other than the shared cursor and retained tag +bits is unchanged by complete tag probing and cleanup. -/ +theorem outputProbeDecodeTokenOuterExtrasAfter_other_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) (idx : Fin controllerTapes) + (hcursor : idx ≠ layout.tagLayout.cursorIdx) + (htag₀ : idx ≠ layout.tagLayout.tag₀Idx) + (htag₁ : idx ≠ layout.tagLayout.tag₁Idx) + (htag₂ : idx ≠ layout.tagLayout.tag₂Idx) : + outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor tag₀ + tag₁ tag₂ (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := by + rw [outputProbeDecodeTokenOuterExtrasAfter] + rw [outputProbeDecodeTokenClearedTagExtras_eq_of_ne_internal n layout _ _ + (fun heq => htag₀ (outputProbeIndexedControllerIdx_injective n heq)) + (fun heq => htag₁ (outputProbeIndexedControllerIdx_injective n heq)) + (fun heq => htag₂ (outputProbeIndexedControllerIdx_injective n heq))] + rw [outputProbeDecodeTagOuterExtrasAfter] + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n + layout.tagLayout layout.tagLayout.tag₂Idx idx hcursor htag₂] + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n + layout.tagLayout layout.tagLayout.tag₁Idx idx hcursor htag₁] + rw [outputProbeDecodeTagBitOuterExtrasAfter_other_internal n + layout.tagLayout layout.tagLayout.tag₀Idx idx hcursor htag₀] + +/-- Complete tag probing and cleanup leave the shared cursor canonically +advanced by three positions. -/ +theorem outputProbeDecodeTokenOuterExtrasAfter_cursor_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) : + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor tag₀ + tag₁ tag₂ (outputProbeDecodeTagCursorIdx n layout.tagLayout)) + |>.HasBinaryNat (cursor + 3) := by + have hcursorTag₀ : + layout.tagLayout.cursorIdx ≠ layout.tagLayout.tag₀Idx := + layout.tagLayout.roles.injective.ne (by decide) + have hcursorTag₁ : + layout.tagLayout.cursorIdx ≠ layout.tagLayout.tag₁Idx := + layout.tagLayout.roles.injective.ne (by decide) + have hcursorTag₂ : + layout.tagLayout.cursorIdx ≠ layout.tagLayout.tag₂Idx := + layout.tagLayout.roles.injective.ne (by decide) + rw [outputProbeDecodeTokenOuterExtrasAfter] + change (outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor tag₀ tag₁ tag₂) + (outputProbeIndexedControllerIdx n layout.tagLayout.cursorIdx)) + |>.HasBinaryNat (cursor + 3) + rw [outputProbeDecodeTokenClearedTagExtras_eq_of_ne_internal n layout _ _ + (fun heq => hcursorTag₀ + (outputProbeIndexedControllerIdx_injective n heq)) + (fun heq => hcursorTag₁ + (outputProbeIndexedControllerIdx_injective n heq)) + (fun heq => hcursorTag₂ + (outputProbeIndexedControllerIdx_injective n heq))] + simpa [outputProbeDecodeTagOuterExtrasAfter, Nat.add_assoc] using + outputProbeDecodeTagBitOuterExtrasAfter_cursor_internal n + layout.tagLayout layout.tagLayout.tag₂Idx + (outputProbeDecodeTagBitOuterExtrasAfter n layout.tagLayout + layout.tagLayout.tag₁Idx + (outputProbeDecodeTagBitOuterExtrasAfter n layout.tagLayout + layout.tagLayout.tag₀Idx outerExtras cursor tag₀) + (cursor + 1) tag₁) + (cursor + 2) tag₂ + +/-- Complete tag probing followed by canonical cleanup preserves the parked +outer-frame invariant. -/ +theorem outputProbeDecodeTokenOuterExtrasAfter_parked_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (htag₀Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) : + ∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor tag₀ tag₁ tag₂ i) := by + have hzeroParked : Parked (outputProbeCounterTape 0) := by + have hzero : (outputProbeCounterTape 0).HasBinaryNat 0 := by + simpa [outputProbeCounterTape] using + Tape.init_move_right_hasBinaryNat 0 + refine ⟨by rw [hzero.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hzero.2.2 + have updateParked : ∀ + (base : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape), + (∀ i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (base i)) → + ∀ idx i, ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (Function.update base idx (outputProbeCounterTape 0) i) := by + intro base hbase idx i hi + by_cases heq : i = idx + · subst i + rw [Function.update_self] + exact hzeroParked + · rw [Function.update_of_ne heq] + exact hbase i hi + let after := outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout + outerExtras cursor tag₀ tag₁ tag₂ + obtain ⟨hafter, _htag₀, _htag₁, _htag₂⟩ := + outputProbeDecodeTagOuterExtrasAfter_invariant_internal n + layout.tagLayout outerExtras houter cursor tag₀ tag₁ tag₂ + htag₀Zero htag₁Zero htag₂Zero + let idx₀ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx + let idx₁ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx + let idx₂ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx + have houter₀ := updateParked after hafter idx₀ + have houter₁ := updateParked + (Function.update after idx₀ (outputProbeCounterTape 0)) + houter₀ idx₁ + have houter₂ := updateParked + (Function.update + (Function.update after idx₀ (outputProbeCounterTape 0)) idx₁ + (outputProbeCounterTape 0)) + houter₁ idx₂ + simpa [outputProbeDecodeTokenOuterExtrasAfter, + outputProbeDecodeTokenClearedTagExtras, after, idx₀, idx₁, idx₂] + using houter₂ + +theorem outputProbeDecodeTokenClearedTagExtras_tag₀_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)).HasBinaryNat + 0 := by + have h₀₁ : layout.tagLayout.tag₀Idx ≠ layout.tagLayout.tag₁Idx := + layout.tagLayout.roles.injective.ne (by decide) + have h₀₂ : layout.tagLayout.tag₀Idx ≠ layout.tagLayout.tag₂Idx := + layout.tagLayout.roles.injective.ne (by decide) + have hphysical₀₁ : outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx := by + exact fun heq => h₀₁ (outputProbeIndexedControllerIdx_injective n heq) + have hphysical₀₂ : outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx := by + exact fun heq => h₀₂ (outputProbeIndexedControllerIdx_injective n heq) + simpa [outputProbeDecodeTokenClearedTagExtras, hphysical₀₁, + hphysical₀₂] using Tape.init_move_right_hasBinaryNat 0 + +theorem outputProbeDecodeTokenClearedTagExtras_tag₁_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)).HasBinaryNat + 0 := by + have h₁₂ : layout.tagLayout.tag₁Idx ≠ layout.tagLayout.tag₂Idx := + layout.tagLayout.roles.injective.ne (by decide) + have hphysical₁₂ : outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx ≠ + outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx := by + exact fun heq => h₁₂ (outputProbeIndexedControllerIdx_injective n heq) + simpa [outputProbeDecodeTokenClearedTagExtras, hphysical₁₂] using + Tape.init_move_right_hasBinaryNat 0 + +theorem outputProbeDecodeTokenClearedTagExtras_tag₂_internal + (n : ℕ) {controllerTapes : ℕ} + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)).HasBinaryNat + 0 := by + simpa [outputProbeDecodeTokenClearedTagExtras] using + Tape.init_move_right_hasBinaryNat 0 + +private theorem outputProbeDecodeToken_hasBinaryNat_parked_internal + {tape : Tape} {value : ℕ} (hvalue : tape.HasBinaryNat value) : + Parked tape := by + refine ⟨by rw [hvalue.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hvalue.2.2 + +private theorem outputProbeDecodeToken_update_parked_internal + (outerExtras : Fin controllerTapes → Tape) + (eligible : Fin controllerTapes → Prop) + (houter : ∀ i, eligible i → Parked (outerExtras i)) + (idx : Fin controllerTapes) : + ∀ i, eligible i → Parked (Function.update outerExtras idx + (outputProbeCounterTape 0) i) := by + intro i hiEligible + by_cases hi : i = idx + · subst i + rw [Function.update_self] + exact outputProbeDecodeToken_hasBinaryNat_parked_internal + (Tape.init_move_right_hasBinaryNat 0) + · rw [Function.update_of_ne hi] + exact houter i hiEligible + +private theorem outputProbeDecodeTokenClear_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) (idx : Fin controllerTapes) (value : ℕ) + (hvalue : + (outerExtras (outputProbeIndexedControllerIdx n idx)).HasBinaryNat + value) : + (clearWorkTM + (outputProbeIndexedControllerIdx n idx)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) + (outputProbeCounterTape 0)) + input output extras false) + (clearWorkTimeBound value.bits.length) := by + let physical := outputProbeIndexedControllerIdx n idx + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + have htargetNat : (work physical).HasBinaryNat value := by + rw [outputProbeLatchFramePost_controller tm controllerTapes outerExtras + input output extras false inp work out hpost idx] + exact hvalue + have htarget : work physical = + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right := + htargetNat.eq_init_move_right + have hclear := clearWorkTM_hoareTime_frame physical value.bits inp work out + htarget hinput (fun i _ => hwork i) hout + obtain ⟨done, elapsed, helapsed, hreach, hhalt, hinputDone, hworkDone, + houtputDone⟩ := hclear inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨done, elapsed, ?_, hreach, hhalt, ?_⟩ + · simpa using helapsed + · rw [hinputDone, hworkDone, houtputDone] + simpa [physical, outputProbeCounterTape] using + outputProbeLatchFramePost_updateController tm controllerTapes + outerExtras input output extras false inp work out hpost idx + (outputProbeCounterTape 0) + +private theorem outputProbeDecodeTokenFramePost_to_pre_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) : + ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false inp work out → + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false (transitionInput inp) + (fun i => transitionTape (work i)) (transitionTape out) := by + intro inp work out hpost + obtain ⟨hinput, hwork, hout⟩ := outputProbeLatchFramePost_parked tm + controllerTapes outerExtras input output extras false hextras houter + houtput inp work out hpost + rw [hinput.transitionInput_eq_self] + have hworkTransition : (fun i => transitionTape (work i)) = work := by + funext i + exact (hwork i).transitionTape_eq_self + rw [hworkTransition, hout.transitionTape_eq_self] + exact hpost + +theorem outputProbeDecodeTokenClearTagsTM_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) : + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (outputProbeDecodeTokenClearTagsTime tag₀ tag₁ tag₂) := by + let idx₀ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx + let idx₁ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx + let idx₂ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx + have hidx₀₁ : idx₀ ≠ idx₁ := by + intro heq + have hlogical := outputProbeIndexedControllerIdx_injective n heq + exact (layout.tagLayout.roles.injective.ne (by decide)) hlogical + have hidx₀₂ : idx₀ ≠ idx₂ := by + intro heq + have hlogical := outputProbeIndexedControllerIdx_injective n heq + exact (layout.tagLayout.roles.injective.ne (by decide)) hlogical + have hidx₁₂ : idx₁ ≠ idx₂ := by + intro heq + have hlogical := outputProbeIndexedControllerIdx_injective n heq + exact (layout.tagLayout.roles.injective.ne (by decide)) hlogical + let outer₁ := Function.update outerExtras idx₀ (outputProbeCounterTape 0) + let outer₂ := Function.update outer₁ idx₁ (outputProbeCounterTape 0) + have houter₁ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₁ i) := + outputProbeDecodeToken_update_parked_internal outerExtras + (fun i => ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i) + houter idx₀ + have houter₂ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₂ i) := + outputProbeDecodeToken_update_parked_internal outer₁ + (fun i => ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i) + houter₁ idx₁ + have htag₁₁ : (outer₁ idx₁).HasBinaryNat + (if tag₁ then 1 else 0) := by + simpa [outer₁, Function.update_of_ne (Ne.symm hidx₀₁)] using htag₁ + have htag₂₁ : (outer₁ idx₂).HasBinaryNat + (if tag₂ then 1 else 0) := by + simpa [outer₁, Function.update_of_ne (Ne.symm hidx₀₂)] using + htag₂ + have htag₂₂ : (outer₂ idx₂).HasBinaryNat + (if tag₂ then 1 else 0) := by + simpa [outer₂, Function.update_of_ne (Ne.symm hidx₁₂)] using + htag₂₁ + have hclear₀ := outputProbeDecodeTokenClear_hoareTime_internal tm + controllerTapes outerExtras input output extras hextras houter houtput + layout.tagLayout.tag₀Idx (if tag₀ then 1 else 0) htag₀ + have hclear₁ := outputProbeDecodeTokenClear_hoareTime_internal tm + controllerTapes outer₁ input output extras hextras houter₁ houtput + layout.tagLayout.tag₁Idx (if tag₁ then 1 else 0) htag₁₁ + have hclear₂ := outputProbeDecodeTokenClear_hoareTime_internal tm + controllerTapes outer₂ input output extras hextras houter₂ houtput + layout.tagLayout.tag₂Idx (if tag₂ then 1 else 0) htag₂₂ + have hseam₁ := outputProbeDecodeTokenFramePost_to_pre_internal tm + controllerTapes outer₁ input output extras hextras houter₁ houtput + have hseam₂ := outputProbeDecodeTokenFramePost_to_pre_internal tm + controllerTapes outer₂ input output extras hextras houter₂ houtput + have hclear₁₂ := seqTM_hoareTime + (clearWorkTM idx₁) (clearWorkTM idx₂) hclear₁ hseam₂ hclear₂ + have hfull := seqTM_hoareTime + (clearWorkTM idx₀) (seqTM (clearWorkTM idx₁) (clearWorkTM idx₂)) + hclear₀ hseam₁ hclear₁₂ + simpa [outputProbeDecodeTokenClearTagsTM, + outputProbeDecodeTokenClearedTagExtras, + outputProbeDecodeTokenClearTagsTime, outer₁, outer₂, idx₀, idx₁, + idx₂] using hfull + +theorem outputProbeDecodeTokenDispatchTM_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Option OutputProbeTokenTag → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ} + (hvar : onVar.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .var)) varTime) + (htru : onTru.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .tru)) truTime) + (hfls : onFls.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .fls)) flsTime) + (hneg : onNeg.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .neg)) negTime) + (hconj : onConj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .conj)) conjTime) + (hdisj : onDisj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post (some .disj)) disjTime) + (hinvalid : onInvalid.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + (post none) invalidTime) : + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post (outputProbeTokenTag? tag₀ tag₁ tag₂)) + (outputProbeDecodeTokenDispatchTime tag₀ tag₁ tag₂ varTime + truTime flsTime negTime conjTime disjTime invalidTime) := by + let cleared := outputProbeDecodeTokenClearedTagExtras n layout outerExtras + let idx₀ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx + let idx₁ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx + let idx₂ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx + let outer₁ := Function.update outerExtras idx₀ (outputProbeCounterTape 0) + let outer₂ := Function.update outer₁ idx₁ (outputProbeCounterTape 0) + have houter₁ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₁ i) := + outputProbeDecodeToken_update_parked_internal outerExtras + (fun i => ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i) + houter idx₀ + have houter₂ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₂ i) := + outputProbeDecodeToken_update_parked_internal outer₁ + (fun i => ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i) + houter₁ idx₁ + have hcleared : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (cleared i) := by + simpa [cleared, outputProbeDecodeTokenClearedTagExtras, outer₁, outer₂, + idx₀, idx₁, idx₂] using + outputProbeDecodeToken_update_parked_internal outer₂ + (fun i => ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i) + houter₂ idx₂ + have hclear := outputProbeDecodeTokenClearTagsTM_hoareTime_internal tm + controllerTapes layout outerExtras input output extras tag₀ tag₁ tag₂ + hextras houter houtput htag₀ htag₁ htag₂ + have hseam := outputProbeDecodeTokenFramePost_to_pre_internal tm + controllerTapes cleared input output extras hextras hcleared houtput + have hvar' := seqTM_hoareTime + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onVar hclear + hseam hvar + have htru' := seqTM_hoareTime + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onTru hclear + hseam htru + have hfls' := seqTM_hoareTime + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onFls hclear + hseam hfls + have hneg' := seqTM_hoareTime + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onNeg hclear + hseam hneg + have hconj' := seqTM_hoareTime + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onConj hclear + hseam hconj + have hdisj' := seqTM_hoareTime + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onDisj hclear + hseam hdisj + have hinvalid' := seqTM_hoareTime + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onInvalid + hclear hseam hinvalid + have hdispatch := outputProbeDecodeTagDispatchTM_hoareTime_internal tm + controllerTapes layout.tagLayout outerExtras input output extras tag₀ tag₁ + tag₂ hextras houter houtput htag₀ htag₁ htag₂ + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onVar) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onTru) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onFls) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onNeg) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onConj) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onDisj) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) + onInvalid) + (post := post) (by simpa [cleared] using hvar') + (by simpa [cleared] using htru') (by simpa [cleared] using hfls') + (by simpa [cleared] using hneg') (by simpa [cleared] using hconj') + (by simpa [cleared] using hdisj') (by simpa [cleared] using hinvalid') + simpa [outputProbeDecodeTokenDispatchTM, + outputProbeDecodeTokenDispatchTime] using hdispatch + +private theorem outputProbeTokenContinuation_seqTM_internal + (before : TM tapes) + (tag : Option OutputProbeTokenTag) + (onVar onTru onFls onNeg onConj onDisj onInvalid : TM tapes) : + outputProbeTokenContinuation tag + (seqTM before onVar) (seqTM before onTru) (seqTM before onFls) + (seqTM before onNeg) (seqTM before onConj) (seqTM before onDisj) + (seqTM before onInvalid) = + seqTM before (outputProbeTokenContinuation tag onVar onTru onFls + onNeg onConj onDisj onInvalid) := by + cases tag with + | none => rfl + | some tag => cases tag <;> rfl + +theorem outputProbeDecodeTokenDispatchTM_selected_hoareTime_internal + (tm : TM n) (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (tag₀ tag₁ tag₂ : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat (if tag₀ then 1 else 0)) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat (if tag₁ then 1 else 0)) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat (if tag₂ then 1 else 0)) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : + (outputProbeTokenContinuation + (outputProbeTokenTag? tag₀ tag₁ tag₂) + onVar onTru onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout outerExtras) + input output extras false) + post selectedTime) : + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + post (outputProbeDecodeTokenSelectedDispatchTime tag₀ tag₁ tag₂ + selectedTime) := by + let cleared := outputProbeDecodeTokenClearedTagExtras n layout outerExtras + let idx₀ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx + let idx₁ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx + let idx₂ := outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx + let outer₁ := Function.update outerExtras idx₀ (outputProbeCounterTape 0) + let outer₂ := Function.update outer₁ idx₁ (outputProbeCounterTape 0) + have houter₁ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₁ i) := + outputProbeDecodeToken_update_parked_internal outerExtras + (fun i => ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i) + houter idx₀ + have houter₂ : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outer₂ i) := + outputProbeDecodeToken_update_parked_internal outer₁ + (fun i => ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i) + houter₁ idx₁ + have hcleared : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (cleared i) := by + simpa [cleared, outputProbeDecodeTokenClearedTagExtras, outer₁, outer₂, + idx₀, idx₁, idx₂] using + outputProbeDecodeToken_update_parked_internal outer₂ + (fun i => ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i) + houter₂ idx₂ + have hclear := outputProbeDecodeTokenClearTagsTM_hoareTime_internal tm + controllerTapes layout outerExtras input output extras tag₀ tag₁ tag₂ + hextras houter houtput htag₀ htag₁ htag₂ + have hseam := outputProbeDecodeTokenFramePost_to_pre_internal tm + controllerTapes cleared input output extras hextras hcleared houtput + have hselected' := seqTM_hoareTime + (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) + (outputProbeTokenContinuation (outputProbeTokenTag? tag₀ tag₁ tag₂) + onVar onTru onFls onNeg onConj onDisj onInvalid) + hclear hseam (by simpa [cleared] using hselected) + have hdispatch := + outputProbeDecodeTagDispatchTM_selected_hoareTime_internal tm + controllerTapes layout.tagLayout outerExtras input output extras tag₀ + tag₁ tag₂ hextras houter houtput htag₀ htag₁ htag₂ + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onVar) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onTru) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onFls) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onNeg) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onConj) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) onDisj) + (seqTM (outputProbeDecodeTokenClearTagsTM n controllerTapes layout) + onInvalid) + (post := post) + (by + rw [outputProbeTokenContinuation_seqTM_internal] + exact hselected') + simpa [outputProbeDecodeTokenDispatchTM, + outputProbeDecodeTokenSelectedDispatchTime] using hdispatch + +theorem ComputesInSpace.outputProbeDecodeTokenTM_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Option OutputProbeTokenTag → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {varTime truTime flsTime negTime conjTime disjTime invalidTime : ℕ} + (hvar : onVar.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]))) + input output extras false) + (post (some .var)) varTime) + (htru : onTru.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]))) + input output extras false) + (post (some .tru)) truTime) + (hfls : onFls.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]))) + input output extras false) + (post (some .fls)) flsTime) + (hneg : onNeg.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]))) + input output extras false) + (post (some .neg)) negTime) + (hconj : onConj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]))) + input output extras false) + (post (some .conj)) conjTime) + (hdisj : onDisj.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]))) + input output extras false) + (post (some .disj)) disjTime) + (hinvalid : onInvalid.HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenClearedTagExtras n layout + (outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2]))) + input output extras false) + (post none) invalidTime) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTokenTM tm controllerTapes layout onVar onTru onFls + onNeg onConj onDisj onInvalid).HoareTime pre + (post (outputProbeTokenTag? ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]))) + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) varTime + truTime flsTime negTime conjTime disjTime invalidTime) := by + have hbound₀ : cursor < (f input).length := by omega + have hbound₁ : cursor + 1 < (f input).length := by omega + have hbound₂ : cursor + 2 < (f input).length := hcursorBound + let tag₀ := (f input)[cursor]'hbound₀ + let tag₁ := (f input)[cursor + 1]'hbound₁ + let tag₂ := (f input)[cursor + 2]'hbound₂ + let after := outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout + outerExtras cursor tag₀ tag₁ tag₂ + obtain ⟨hafter, hafterTag₀, hafterTag₁, hafterTag₂⟩ := + outputProbeDecodeTagOuterExtrasAfter_invariant_internal n layout.tagLayout + outerExtras houter cursor tag₀ tag₁ tag₂ htag₀ htag₁ htag₂ + obtain ⟨bound₀, bound₁, bound₂, pre, hpre, hdecode⟩ := + hcomp.outputProbeDecodeTagTM_hoareTime_internal input cursor hcursorBound + output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes layout.tagLayout + outerExtras houter hcursor hscratch htag₀ htag₁ htag₂ + have hdispatch := outputProbeDecodeTokenDispatchTM_hoareTime_internal tm + controllerTapes layout after input output extras tag₀ tag₁ tag₂ hextras + hafter houtput hafterTag₀ hafterTag₁ hafterTag₂ onVar onTru onFls onNeg + onConj onDisj onInvalid (post := post) + (by simpa [after, tag₀, tag₁, tag₂] using hvar) + (by simpa [after, tag₀, tag₁, tag₂] using htru) + (by simpa [after, tag₀, tag₁, tag₂] using hfls) + (by simpa [after, tag₀, tag₁, tag₂] using hneg) + (by simpa [after, tag₀, tag₁, tag₂] using hconj) + (by simpa [after, tag₀, tag₁, tag₂] using hdisj) + (by simpa [after, tag₀, tag₁, tag₂] using hinvalid) + have hseam := outputProbeDecodeTokenFramePost_to_pre_internal tm + controllerTapes after input output extras hextras hafter houtput + have hfull := seqTM_hoareTime + (outputProbeDecodeTagTM tm controllerTapes layout.tagLayout) + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid) + (by simpa [after, tag₀, tag₁, tag₂] using hdecode) hseam hdispatch + refine ⟨bound₀, bound₁, bound₂, pre, hpre, ?_⟩ + simpa [outputProbeDecodeTokenTM, after, tag₀, tag₁, tag₂] using hfull + +theorem ComputesInSpace.outputProbeDecodeTokenTM_selected_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (cursor : ℕ) + (hcursorBound : cursor + 2 < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (hlimit₀ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 1) ≤ cleanupLimit) + (hlimit₁ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 2) ≤ cleanupLimit) + (hlimit₂ : outputProbeCaptureSpace (max 1 (space input.length)) + (cursor + 3) ≤ cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (hcursor : + (outerExtras + (outputProbeDecodeTagCursorIdx n layout.tagLayout)).HasBinaryNat + cursor) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.tagLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂ : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {selectedTime : ℕ} + (hselected : + (outputProbeTokenContinuation + (outputProbeTokenTag? ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + onVar onTru onFls onNeg onConj onDisj onInvalid).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor ((f input)[cursor]) ((f input)[cursor + 1]) + ((f input)[cursor + 2])) + input output extras false) + post selectedTime) : + ∃ (bound₀ bound₁ bound₂ : ℕ) + (pre : TapePred + (0 + outputProbeControllerTapes n + controllerTapes)), + pre + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).output ∧ + (outputProbeDecodeTokenTM tm controllerTapes layout onVar onTru onFls + onNeg onConj onDisj onInvalid).HoareTime pre post + (((bound₀ + 1 + binarySuccTime cursor) + 1 + + ((bound₁ + 1 + binarySuccTime (cursor + 1)) + 1 + + (bound₂ + 1 + binarySuccTime (cursor + 2)))) + 1 + + outputProbeDecodeTokenSelectedDispatchTime ((f input)[cursor]) + ((f input)[cursor + 1]) ((f input)[cursor + 2]) selectedTime) := by + have hbound₀ : cursor < (f input).length := by omega + have hbound₁ : cursor + 1 < (f input).length := by omega + have hbound₂ : cursor + 2 < (f input).length := hcursorBound + let tag₀ := (f input)[cursor]'hbound₀ + let tag₁ := (f input)[cursor + 1]'hbound₁ + let tag₂ := (f input)[cursor + 2]'hbound₂ + let after := outputProbeDecodeTagOuterExtrasAfter n layout.tagLayout + outerExtras cursor tag₀ tag₁ tag₂ + obtain ⟨hafter, hafterTag₀, hafterTag₁, hafterTag₂⟩ := + outputProbeDecodeTagOuterExtrasAfter_invariant_internal n layout.tagLayout + outerExtras houter cursor tag₀ tag₁ tag₂ htag₀ htag₁ htag₂ + obtain ⟨bound₀, bound₁, bound₂, pre, hpre, hdecode⟩ := + hcomp.outputProbeDecodeTagTM_hoareTime_internal input cursor hcursorBound + output houtput extras hextras hcleanupCounter cleanupLimit + hcleanupLimit hlimit₀ hlimit₁ hlimit₂ controllerTapes layout.tagLayout + outerExtras houter hcursor hscratch htag₀ htag₁ htag₂ + have hdispatch := + outputProbeDecodeTokenDispatchTM_selected_hoareTime_internal tm + controllerTapes layout after input output extras tag₀ tag₁ tag₂ + hextras hafter houtput hafterTag₀ hafterTag₁ hafterTag₂ onVar onTru + onFls onNeg onConj onDisj onInvalid (post := post) + (by simpa [after, tag₀, tag₁, tag₂] using hselected) + have hseam := outputProbeDecodeTokenFramePost_to_pre_internal tm + controllerTapes after input output extras hextras hafter houtput + have hfull := seqTM_hoareTime + (outputProbeDecodeTagTM tm controllerTapes layout.tagLayout) + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid) + (by simpa [after, tag₀, tag₁, tag₂] using hdecode) hseam hdispatch + refine ⟨bound₀, bound₁, bound₂, pre, hpre, ?_⟩ + simpa [outputProbeDecodeTokenTM, after, tag₀, tag₁, tag₂] using hfull + +/-- Internal Hoare contract for the concrete variable continuation after a +complete tag probe and cleanup. -/ +theorem ComputesInSpace.outputProbeDecodeTokenVar_hoareTime_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (cleanupLimit : ℕ) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat cleanupLimit) + (controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (cursor : ℕ) (tag₀ tag₁ tag₂ : Bool) + (hscratch : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.scratchIdx)) + |>.HasBinaryNat 0) + (htag₀Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₀Idx)) + |>.HasBinaryNat 0) + (htag₁Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₁Idx)) + |>.HasBinaryNat 0) + (htag₂Zero : + (outerExtras + (outputProbeDecodeTagBitIdx n layout.tagLayout.tag₂Idx)) + |>.HasBinaryNat 0) + (hvalue : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.valueIdx)) + |>.HasBinaryNat 0) + (hactive : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.activeIdx)) + |>.HasBinaryNat 1) + (hloop : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.loopIdx)) + |>.HasBinaryNat 0) + (fuelValue : ℕ) + (hfuel : + (outerExtras + (outputProbeIndexedControllerIdx n layout.natLayout.fuelIdx)) + |>.HasBinaryNat fuelValue) + (hqueryValid : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + { cursor := cursor + 3, value := 0, active := true } value).active = + true → + (outputProbeDecodeNatStateAt (f input) + { cursor := cursor + 3, value := 0, active := true } value).cursor < + (f input).length) + (hqueryLimit : ∀ value, value < fuelValue → + (outputProbeDecodeNatStateAt (f input) + { cursor := cursor + 3, value := 0, active := true } value).active = + true → + outputProbeCaptureSpace (max 1 (space input.length)) + ((outputProbeDecodeNatStateAt (f input) + { cursor := cursor + 3, value := 0, active := true } value).cursor + + 1) ≤ cleanupLimit) : + ∃ bodyTime : ℕ → ℕ, + (outputProbeDecodeNatTM tm controllerTapes layout.natLayout.cursorIdx + layout.natLayout.scratchIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx + layout.natLayout.fuelIdx).HoareTime + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂) + input output extras false) + (outputProbeLatchFramePost tm controllerTapes + (outputProbeDecodeNatLoopOuterExtras n layout.natLayout.cursorIdx + layout.natLayout.valueIdx layout.natLayout.activeIdx + layout.natLayout.loopIdx + (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂) + (outputProbeDecodeNatStateAt (f input) + { cursor := cursor + 3, value := 0, active := true } fuelValue) + fuelValue) + input output extras false) + (binaryForLoopTime bodyTime fuelValue 0 fuelValue) := by + let after := outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras + cursor tag₀ tag₁ tag₂ + let initial : OutputProbeDecodeNatState := + { cursor := cursor + 3, value := 0, active := true } + have hafter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (after i) := by + simpa [after] using outputProbeDecodeTokenOuterExtrasAfter_parked_internal + n layout outerExtras houter cursor tag₀ tag₁ tag₂ htag₀Zero + htag₁Zero htag₂Zero + have hcursorAfter : + (after (outputProbeDecodeNatCursorIdx n + layout.natLayout.cursorIdx)).HasBinaryNat (cursor + 3) := by + simpa [after] using + outputProbeDecodeTokenOuterExtrasAfter_cursor_internal n layout + outerExtras cursor tag₀ tag₁ tag₂ + have hscratchAfter : + (after (outputProbeIndexedControllerIdx n + layout.natLayout.scratchIdx)).HasBinaryNat 0 := by + change (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂ (outputProbeIndexedControllerIdx n + layout.natLayout.scratchIdx)).HasBinaryNat 0 + rw [outputProbeDecodeTokenOuterExtrasAfter_other_internal n layout + outerExtras cursor tag₀ tag₁ tag₂ layout.natLayout.scratchIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide))] + exact hscratch + have hvalueAfter : + (after (outputProbeDecodeNatValueIdx n + layout.natLayout.valueIdx)).HasBinaryNat 0 := by + change (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂ (outputProbeIndexedControllerIdx n + layout.natLayout.valueIdx)).HasBinaryNat 0 + rw [outputProbeDecodeTokenOuterExtrasAfter_other_internal n layout + outerExtras cursor tag₀ tag₁ tag₂ layout.natLayout.valueIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide))] + exact hvalue + have hactiveAfter : + (after (outputProbeDecodeNatActiveIdx n + layout.natLayout.activeIdx)).HasBinaryNat 1 := by + change (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂ (outputProbeIndexedControllerIdx n + layout.natLayout.activeIdx)).HasBinaryNat 1 + rw [outputProbeDecodeTokenOuterExtrasAfter_other_internal n layout + outerExtras cursor tag₀ tag₁ tag₂ layout.natLayout.activeIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide))] + exact hactive + have hloopAfter : + (after (outputProbeIndexedControllerIdx n + layout.natLayout.loopIdx)).HasBinaryNat 0 := by + change (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂ (outputProbeIndexedControllerIdx n + layout.natLayout.loopIdx)).HasBinaryNat 0 + rw [outputProbeDecodeTokenOuterExtrasAfter_other_internal n layout + outerExtras cursor tag₀ tag₁ tag₂ layout.natLayout.loopIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide))] + exact hloop + have hfuelAfter : + (after (outputProbeIndexedControllerIdx n + layout.natLayout.fuelIdx)).HasBinaryNat fuelValue := by + change (outputProbeDecodeTokenOuterExtrasAfter n layout outerExtras cursor + tag₀ tag₁ tag₂ (outputProbeIndexedControllerIdx n + layout.natLayout.fuelIdx)).HasBinaryNat fuelValue + rw [outputProbeDecodeTokenOuterExtrasAfter_other_internal n layout + outerExtras cursor tag₀ tag₁ tag₂ layout.natLayout.fuelIdx + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide)) + (layout.roles.injective.ne (by decide))] + exact hfuel + have hinitial : outputProbeDecodeNatLoopOuterExtras n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx after initial 0 = + after := + outputProbeDecodeNatLoopOuterExtras_eq_self_internal n + layout.natLayout.cursorIdx layout.natLayout.valueIdx + layout.natLayout.activeIdx layout.natLayout.loopIdx after initial 0 + hcursorAfter hvalueAfter hactiveAfter hloopAfter + obtain ⟨bodyTime, hdecode⟩ := + hcomp.outputProbeDecodeNatTM_hoareTime_internal input output houtput + extras hextras hcleanupCounter cleanupLimit hcleanupLimit + controllerTapes layout.natLayout after hafter initial hscratchAfter 0 + fuelValue (Nat.zero_le fuelValue) hfuelAfter + (fun value _hzero hvalue => hqueryValid value hvalue) + (fun value _hzero hvalue => hqueryLimit value hvalue) + refine ⟨bodyTime, ?_⟩ + simpa [after, initial, outputProbeDecodeNatStateAt, + outputProbeDecodeNatRun, hinitial] using hdecode + +theorem outputProbeDecodeTokenClearTagsTM_isTransducer_internal + (n controllerTapes : ℕ) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + (outputProbeDecodeTokenClearTagsTM n controllerTapes + layout).IsTransducer := by + apply IsTransducer.seqTM + · exact clearWorkTM_isTransducer _ + · apply IsTransducer.seqTM <;> exact clearWorkTM_isTransducer _ + +theorem IsTransducer.outputProbeDecodeTokenDispatchTM_internal + {onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hvar : onVar.IsTransducer) (htru : onTru.IsTransducer) + (hfls : onFls.IsTransducer) (hneg : onNeg.IsTransducer) + (hconj : onConj.IsTransducer) (hdisj : onDisj.IsTransducer) + (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + (outputProbeDecodeTokenDispatchTM n controllerTapes layout onVar onTru + onFls onNeg onConj onDisj onInvalid).IsTransducer := by + let hclear := outputProbeDecodeTokenClearTagsTM_isTransducer_internal n + controllerTapes layout + apply IsTransducer.outputProbeDecodeTagDispatchTM_internal + · exact hclear.seqTM hvar + · exact hclear.seqTM htru + · exact hclear.seqTM hfls + · exact hclear.seqTM hneg + · exact hclear.seqTM hconj + · exact hclear.seqTM hdisj + · exact hclear.seqTM hinvalid + +theorem IsTransducer.outputProbeDecodeTokenTM_internal + {tm : TM n} + {onVar onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hvar : onVar.IsTransducer) (htru : onTru.IsTransducer) + (hfls : onFls.IsTransducer) (hneg : onNeg.IsTransducer) + (hconj : onConj.IsTransducer) (hdisj : onDisj.IsTransducer) + (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + (outputProbeDecodeTokenTM tm controllerTapes layout onVar onTru onFls + onNeg onConj onDisj onInvalid).IsTransducer := by + apply IsTransducer.seqTM + · exact outputProbeDecodeTagTM_isTransducer_internal tm controllerTapes + layout.tagLayout + · exact hvar.outputProbeDecodeTokenDispatchTM_internal htru hfls hneg + hconj hdisj hinvalid layout + +theorem IsTransducer.outputProbeDecodeTokenWithNatTM_internal + {tm : TM n} + {onTru onFls onNeg onConj onDisj onInvalid : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (htru : onTru.IsTransducer) (hfls : onFls.IsTransducer) + (hneg : onNeg.IsTransducer) (hconj : onConj.IsTransducer) + (hdisj : onDisj.IsTransducer) (hinvalid : onInvalid.IsTransducer) + (layout : OutputProbeDecodeTokenLayout controllerTapes) : + (outputProbeDecodeTokenWithNatTM tm controllerTapes layout onTru onFls + onNeg onConj onDisj onInvalid).IsTransducer := by + apply IsTransducer.outputProbeDecodeTokenTM_internal + · exact outputProbeDecodeNatTM_isTransducer_internal tm controllerTapes + layout.natLayout.cursorIdx layout.natLayout.scratchIdx + layout.natLayout.valueIdx layout.natLayout.activeIdx + layout.natLayout.loopIdx layout.natLayout.fuelIdx + · exact htru + · exact hfls + · exact hneg + · exact hconj + · exact hdisj + · exact hinvalid + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDispatch.lean b/Complexitylib/Models/TuringMachine/OutputProbeDispatch.lean new file mode 100644 index 00000000..f1ad97d6 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDispatch.lean @@ -0,0 +1,318 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDispatch.Defs +import Complexitylib.Models.TuringMachine.OutputProbeDispatch.Internal + +/-! +# Dynamically indexed output-probe dispatch + +This module exposes the outer-controller branch that consumes a persistent +output-probe latch. It is the reusable body boundary for bounded scans whose +Boolean branches update controller registers before the next query. +-/ + +namespace Complexity + +namespace TM + +/-- A restored latch frame is parked on its input, every work tape, and its +real output whenever both supplied frames are parked. -/ +theorem outputProbeLatchFramePost_parked + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) : + Parked inp ∧ (∀ i, Parked (work i)) ∧ Parked out := + outputProbeLatchFramePost_parked_internal tm controllerTapes outerExtras + input output extras bit hextras houter houtput inp work out hpost + +/-- Clearing a true latch restores exactly the false/zero latch frame. A caller +supplies the initial frame-space certificate; the standard head-growth bound +then covers every clearing prefix. -/ +theorem outputProbeLatch_clear_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (inputLength initialSpace : ℕ) + (hinitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength initialSpace) : + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true) + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (clearWorkTimeBound 1) inputLength + (initialSpace + clearWorkTimeBound 1) := + outputProbeLatch_clear_hoareTimeSpace_internal tm controllerTapes + outerExtras input output extras hextras houter houtput inputLength + initialSpace hinitial + +/-- Dispatching a parked latch selects the continuation indexed by its exact +Boolean value, with no space overhead beyond that continuation. -/ +theorem outputProbeLatchDispatchTM_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {zeroTime oneTime inputLength zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime inputLength zeroSpace) + (hone : onOne.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true) + (post true) oneTime inputLength oneSpace) : + (outputProbeLatchDispatchTM n controllerTapes onZero + onOne).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + (post bit) + (outputProbeLatchDispatchTime bit zeroTime oneTime) + inputLength (if bit then oneSpace else zeroSpace) := + outputProbeLatchDispatchTM_hoareTimeSpace_internal tm controllerTapes + outerExtras input output extras bit hextras houter houtput onZero onOne + hzero hone + +/-- Resetting dispatch presents both selected continuations with the exact +canonical zero-latch frame. The true branch pays for clearing its one-bit +latch; the false branch enters its continuation directly. -/ +theorem outputProbeLatchResetDispatchTM_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {zeroTime oneTime inputLength zeroSpace oneSpace clearInitialSpace : ℕ} + (hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength clearInitialSpace) + (hzero : onZero.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime inputLength zeroSpace) + (hone : onOne.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post true) oneTime inputLength oneSpace) : + (outputProbeLatchResetDispatchTM n controllerTapes onZero + onOne).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + (post bit) + (outputProbeLatchDispatchTime bit zeroTime + (clearWorkTimeBound 1 + 1 + oneTime)) + inputLength + (if bit then + max (clearInitialSpace + clearWorkTimeBound 1) oneSpace + else zeroSpace) := + outputProbeLatchResetDispatchTM_hoareTimeSpace_internal tm controllerTapes + outerExtras input output extras bit hextras houter houtput onZero onOne + hclearInitial hzero hone + +/-- Any certified dynamically indexed latch phase composes with the direct +Boolean dispatch. The only seam obligation is the parked restored frame, which +is discharged from the probe-frame hypotheses. -/ +theorem outputProbeIndexedDispatchTM_of_latch_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace zeroTime oneTime inputLength zeroSpace oneSpace : ℕ} + (hlatch : (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + latchTime inputLength latchSpace) + (hzero : onZero.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime inputLength zeroSpace) + (hone : onOne.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true) + (post true) oneTime inputLength oneSpace) : + (outputProbeIndexedDispatchTM tm controllerTapes sourceIdx scratchIdx + onZero onOne).HoareTimeSpace pre (post bit) + (latchTime + 1 + + outputProbeLatchDispatchTime bit zeroTime oneTime) + inputLength + (max latchSpace (if bit then oneSpace else zeroSpace)) := + outputProbeIndexedDispatchTM_of_latch_hoareTimeSpace_internal tm + controllerTapes sourceIdx scratchIdx outerExtras input output extras bit + hextras houter houtput onZero onOne hlatch hzero hone + +/-- A certified dynamic latch phase composes with invariant-restoring Boolean +dispatch: both selected continuations start from the exact zero-latch frame. -/ +theorem outputProbeIndexedResetDispatchTM_of_latch_hoareTimeSpace + (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace zeroTime oneTime inputLength zeroSpace oneSpace + clearInitialSpace : ℕ} + (hlatch : (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + latchTime inputLength latchSpace) + (hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength clearInitialSpace) + (hzero : onZero.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime inputLength zeroSpace) + (hone : onOne.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post true) oneTime inputLength oneSpace) : + (outputProbeIndexedResetDispatchTM tm controllerTapes sourceIdx scratchIdx + onZero onOne).HoareTimeSpace pre (post bit) + (latchTime + 1 + + outputProbeLatchDispatchTime bit zeroTime + (clearWorkTimeBound 1 + 1 + oneTime)) + inputLength + (max latchSpace + (if bit then + max (clearInitialSpace + clearWorkTimeBound 1) oneSpace + else zeroSpace)) := + outputProbeIndexedResetDispatchTM_of_latch_hoareTimeSpace_internal tm + controllerTapes sourceIdx scratchIdx outerExtras input output extras bit + hextras houter houtput onZero onOne hlatch hclearInitial hzero hone + +/-- Direct latch dispatch is one-way-output safe whenever both continuations +are one-way-output safe. -/ +theorem IsTransducer.outputProbeLatchDispatchTM + {onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeLatchDispatchTM n controllerTapes onZero onOne).IsTransducer := + hzero.outputProbeLatchDispatchTM_internal hone + +/-- Dynamic query-and-dispatch is one-way-output safe whenever both selected +continuations are one-way-output safe. -/ +theorem IsTransducer.outputProbeIndexedDispatchTM + {tm : TM n} {controllerTapes : ℕ} + {sourceIdx scratchIdx : Fin controllerTapes} + {onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeIndexedDispatchTM tm controllerTapes sourceIdx scratchIdx + onZero onOne).IsTransducer := + hzero.outputProbeIndexedDispatchTM_internal hone + +/-- Latch-resetting dispatch is one-way-output safe whenever both normalized +continuations are one-way-output safe. -/ +theorem IsTransducer.outputProbeLatchResetDispatchTM + {onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeLatchResetDispatchTM n controllerTapes onZero + onOne).IsTransducer := + hzero.outputProbeLatchResetDispatchTM_internal hone + +/-- Dynamic query, latch reset, and Boolean dispatch preserve one-way-output +safety whenever both selected continuations do. -/ +theorem IsTransducer.outputProbeIndexedResetDispatchTM + {tm : TM n} {controllerTapes : ℕ} + {sourceIdx scratchIdx : Fin controllerTapes} + {onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeIndexedResetDispatchTM tm controllerTapes sourceIdx scratchIdx + onZero onOne).IsTransducer := + hzero.outputProbeIndexedResetDispatchTM_internal hone + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDispatch/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeDispatch/Defs.lean new file mode 100644 index 00000000..9a6e1ac9 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDispatch/Defs.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +import Complexitylib.Models.TuringMachine.OutputProbeIndexed.Defs +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs + +/-! +# Dynamically indexed output-probe dispatch -- definitions + +This module turns the persistent Boolean output-probe latch into a concrete +outer-controller branch. The selected continuation sees the complete restored +query frame and every outer controller tape. It is responsible for any desired +register update, including resetting the latch before a subsequent query. +-/ + +namespace Complexity + +namespace TM + +/-- Branch on the physical output-probe latch, selecting `onOne` exactly when +the latch reads `1`. -/ +def outputProbeLatchDispatchTM (n controllerTapes : ℕ) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + branchWorkSymbolTM (outputProbeLatchIdx n controllerTapes) Γ.one + onOne onZero + +/-- Prepare a dynamic source-output query, latch its result, and dispatch to +the matching full-controller continuation. -/ +def outputProbeIndexedDispatchTM (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM (outputProbeIndexedLatchTM tm controllerTapes sourceIdx scratchIdx) + (outputProbeLatchDispatchTM n controllerTapes onZero onOne) + +/-- Dispatch on the physical latch after normalizing the selected branch to a +canonical zero latch. The false branch is already clean; the true branch first +clears its one-bit latch and then enters `onOne`. -/ +def outputProbeLatchResetDispatchTM (n controllerTapes : ℕ) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + outputProbeLatchDispatchTM n controllerTapes onZero + (seqTM (clearWorkTM (outputProbeLatchIdx n controllerTapes)) onOne) + +/-- Dynamically query one source-output position and enter the selected outer +continuation with the query latch reset to canonical zero. -/ +def outputProbeIndexedResetDispatchTM (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM (outputProbeIndexedLatchTM tm controllerTapes sourceIdx scratchIdx) + (outputProbeLatchResetDispatchTM n controllerTapes onZero onOne) + +/-- Exact runtime of the direct latch branch and its selected continuation. -/ +def outputProbeLatchDispatchTime (bit : Bool) + (zeroTime oneTime : ℕ) : ℕ := + (if bit then oneTime else zeroTime) + 1 + +/-- Exact runtime of a dynamically indexed latch followed by direct dispatch. -/ +def outputProbeIndexedDispatchTime (index latchTime : ℕ) (bit : Bool) + (zeroTime oneTime : ℕ) : ℕ := + outputProbeIndexedPrepareTime index + 1 + latchTime + 1 + + outputProbeLatchDispatchTime bit zeroTime oneTime + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeDispatch/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeDispatch/Internal.lean new file mode 100644 index 00000000..710a5761 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeDispatch/Internal.lean @@ -0,0 +1,513 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +import Complexitylib.Models.TuringMachine.OutputProbeDispatch.Defs +import Complexitylib.Models.TuringMachine.OutputProbeIndexed +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork + +/-! +# Dynamically indexed output-probe dispatch -- proof internals +-/ + +namespace Complexity + +namespace TM + +private theorem outputProbeDispatch_hasBinaryNat_parked {tape : Tape} + {value : ℕ} (hvalue : tape.HasBinaryNat value) : Parked tape := by + refine ⟨by rw [hvalue.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hvalue.2.2 + +private theorem outputProbeDispatch_cleanInput_parked + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) : + Parked (outputProbePlacedFrameCfg tm input (outputProbeCounterTape 0) + output extras).input := by + simp only [outputProbePlacedFrameCfg, placeWorkCfg_input, + retargetCfgFrame_input, outputProbeStartedCfg] + simpa [Tape.move] using parked_init_input input + +private theorem outputProbeDispatch_cleanWork_parked + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) : + ∀ i, Parked ((outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work i) := by + intro i + rw [outputProbePlacedFrameCfg] + by_cases hi : placeWorkInMiddle 0 (n + 2) i + · simp only [placeWorkCfg, hi, dite_true] + let coord := placeWorkCoord 0 (n + 2) i hi + by_cases hsource : coord.val < n + 1 + · rw [retargetCfgFrame_work_lt _ _ _ coord (by omega)] + by_cases hsourceWork : coord.val < n + · simp [outputProbeStartedCfg, hsourceWork] + simpa [Tape.move] using parked_init_input ([] : List Bool) + · simp [outputProbeStartedCfg, hsourceWork] + exact outputProbeDispatch_hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat 0) + · have hvirtualOutput : coord = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.last, coord] + have hcoord : coord.val < n + 2 := coord.isLt + omega + change Parked + ((tm.outputProbeStartedTM.retargetCfgFrame + (tm.outputProbeStartedCfg input (outputProbeCounterTape 0)) + output).work coord) + rw [hvirtualOutput, retargetCfgFrame_work_last] + simp [outputProbeStartedCfg] + simpa [Tape.move] using parked_init_input ([] : List Bool) + · rw [placeWorkCfg_work_extra] + exact hextras i hi + exact hi + +theorem outputProbeLatchFramePost_parked_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) : + Parked inp ∧ (∀ i, Parked (work i)) ∧ Parked out := by + rcases hpost with ⟨sourceWork, hsource, hworkEq⟩ + rcases hsource with ⟨hinputEq, hother, hlatch, houtputEq⟩ + have hsourceWorkParked : ∀ i, Parked (sourceWork i) := by + intro i + by_cases hi : i = outputProbeCleanupCounterIdx n + · subst i + exact outputProbeDispatch_hasBinaryNat_parked hlatch + · rw [hother i hi] + exact outputProbeDispatch_cleanWork_parked tm input output extras + hextras i + refine ⟨?_, ?_, ?_⟩ + · rw [hinputEq] + exact outputProbeDispatch_cleanInput_parked tm input output extras + · intro i + rw [hworkEq] + by_cases hi : placeWorkInMiddle 0 (outputProbeControllerTapes n) i + · simp only [placeWorkCfg, hi, dite_true] + exact hsourceWorkParked _ + · rw [placeWorkCfg_work_extra] + exact houter i hi + exact hi + · rw [houtputEq] + exact houtput + +theorem outputProbeLatch_clear_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (inputLength initialSpace : ℕ) + (hinitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength initialSpace) : + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true) + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (clearWorkTimeBound 1) inputLength + (initialSpace + clearWorkTimeBound 1) := by + have htime : + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).HoareTime + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true) + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (clearWorkTimeBound 1) := by + intro inp work out hpost + obtain ⟨hinpParked, hworkParked, houtParked⟩ := + outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras true hextras houter houtput inp work + out hpost + have hlatch := outputProbeLatchFramePost_latch tm controllerTapes + outerExtras input output extras true inp work out hpost + have htarget : work (outputProbeLatchIdx n controllerTapes) = + (Tape.init ([true].map Γ.ofBool)).move Dir3.right := by + simpa using hlatch.eq_init_move_right + have hbase := clearWorkTM_hoareTime_frame + (outputProbeLatchIdx n controllerTapes) [true] inp work out htarget + hinpParked (fun i _ => hworkParked i) houtParked + obtain ⟨done, elapsed, helapsed, hreach, hhalt, hdone⟩ := + hbase inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨done, elapsed, helapsed, hreach, hhalt, ?_⟩ + rcases hdone with ⟨hinputDone, hworkDone, houtputDone⟩ + rw [hinputDone, hworkDone, houtputDone] + rcases hpost with ⟨sourceWork, hsource, hplaced⟩ + rcases hsource with ⟨hinputSource, hotherSource, _hlatchSource, + houtputSource⟩ + let blank := (Tape.init []).move Dir3.right + refine ⟨Function.update sourceWork (outputProbeCleanupCounterIdx n) + blank, ?_, ?_⟩ + · refine ⟨hinputSource, ?_, ?_, houtputSource⟩ + · intro i hi + simp only [Function.update_of_ne hi] + exact hotherSource i hi + · simpa [blank] using Tape.init_move_right_hasBinaryNat 0 + · rw [hplaced] + simpa [outputProbeLatchIdx, blank] using + placeWorkCfg_work_update (outputProbeLatchInnerTM tm) 0 + controllerTapes outerExtras + { state := (outputProbeLatchInnerTM tm).qstart + input := inp + work := sourceWork + output := out } + (outputProbeCleanupCounterIdx n) blank + exact htime.toHoareTimeSpace hinitial + +theorem outputProbeLatchDispatchTM_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {zeroTime oneTime inputLength zeroSpace oneSpace : ℕ} + (hzero : onZero.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime inputLength zeroSpace) + (hone : onOne.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true) + (post true) oneTime inputLength oneSpace) : + (outputProbeLatchDispatchTM n controllerTapes onZero + onOne).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + (post bit) + (outputProbeLatchDispatchTime bit zeroTime oneTime) + inputLength (if bit then oneSpace else zeroSpace) := by + cases bit with + | false => + have hbranch := branchWorkSymbolTM_hoareTimeSpace_different + (outputProbeLatchIdx n controllerTapes) Γ.one onOne onZero + (fun inp work out hpost => by + have hlatch := outputProbeLatchFramePost_latch tm controllerTapes + outerExtras input output extras false inp work out hpost + rw [hlatch.eq_init_move_right] + simp [Tape.read, Tape.move, Tape.init]) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras false hextras houter houtput inp + work out hpost).1.read_ne_start) + (fun inp work out hpost i => + (outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras false hextras houter houtput inp + work out hpost).2.1 i |>.read_ne_start) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras false hextras houter houtput inp + work out hpost).2.2.read_ne_start) + hzero + simpa [outputProbeLatchDispatchTM, outputProbeLatchDispatchTime] using + hbranch + | true => + have hbranch := branchWorkSymbolTM_hoareTimeSpace_equal + (outputProbeLatchIdx n controllerTapes) Γ.one onOne onZero + (fun inp work out hpost => by + have hlatch := outputProbeLatchFramePost_latch tm controllerTapes + outerExtras input output extras true inp work out hpost + rw [hlatch.eq_init_move_right] + simp [Tape.read, Tape.move, Tape.init, Γ.ofBool]) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras true hextras houter houtput inp + work out hpost).1.read_ne_start) + (fun inp work out hpost i => + (outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras true hextras houter houtput inp + work out hpost).2.1 i |>.read_ne_start) + (fun inp work out hpost => + (outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras true hextras houter houtput inp + work out hpost).2.2.read_ne_start) + hone + simpa [outputProbeLatchDispatchTM, outputProbeLatchDispatchTime] using + hbranch + +theorem outputProbeLatchResetDispatchTM_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {zeroTime oneTime inputLength zeroSpace oneSpace clearInitialSpace : ℕ} + (hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength clearInitialSpace) + (hzero : onZero.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime inputLength zeroSpace) + (hone : onOne.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post true) oneTime inputLength oneSpace) : + (outputProbeLatchResetDispatchTM n controllerTapes onZero + onOne).HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + (post bit) + (outputProbeLatchDispatchTime bit zeroTime + (clearWorkTimeBound 1 + 1 + oneTime)) + inputLength + (if bit then + max (clearInitialSpace + clearWorkTimeBound 1) oneSpace + else zeroSpace) := by + have hclear := outputProbeLatch_clear_hoareTimeSpace_internal tm + controllerTapes outerExtras input output extras hextras houter houtput + inputLength clearInitialSpace hclearInitial + have htrue := seqTM_hoareTimeSpace + (clearWorkTM (outputProbeLatchIdx n controllerTapes)) onOne hclear (by + intro inp work out hpost + obtain ⟨hinp, hwork, hout⟩ := + outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras false hextras houter houtput inp work + out hpost + have htransitionWork : + (fun i => transitionTape (work i)) = work := by + funext i + exact (hwork i).transitionTape_eq_self + rw [hinp.transitionInput_eq_self, htransitionWork, + hout.transitionTape_eq_self] + exact hpost) hone + have hdispatch := outputProbeLatchDispatchTM_hoareTimeSpace_internal tm + controllerTapes outerExtras input output extras bit hextras houter houtput + onZero + (seqTM (clearWorkTM (outputProbeLatchIdx n controllerTapes)) onOne) + hzero htrue + simpa [outputProbeLatchResetDispatchTM] using hdispatch + +theorem outputProbeIndexedDispatchTM_of_latch_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace zeroTime oneTime inputLength zeroSpace oneSpace : ℕ} + (hlatch : (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + latchTime inputLength latchSpace) + (hzero : onZero.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime inputLength zeroSpace) + (hone : onOne.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true) + (post true) oneTime inputLength oneSpace) : + (outputProbeIndexedDispatchTM tm controllerTapes sourceIdx scratchIdx + onZero onOne).HoareTimeSpace pre (post bit) + (latchTime + 1 + + outputProbeLatchDispatchTime bit zeroTime oneTime) + inputLength + (max latchSpace (if bit then oneSpace else zeroSpace)) := by + have hdispatch := outputProbeLatchDispatchTM_hoareTimeSpace_internal tm + controllerTapes outerExtras input output extras bit hextras houter houtput + onZero onOne hzero hone + have hseq := seqTM_hoareTimeSpace + (outputProbeIndexedLatchTM tm controllerTapes sourceIdx scratchIdx) + (outputProbeLatchDispatchTM n controllerTapes onZero onOne) hlatch (by + intro inp work out hpost + obtain ⟨hinp, hwork, hout⟩ := + outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras bit hextras houter houtput inp work + out hpost + have htransitionWork : + (fun i => transitionTape (work i)) = work := by + funext i + exact (hwork i).transitionTape_eq_self + rw [hinp.transitionInput_eq_self, htransitionWork, + hout.transitionTape_eq_self] + exact hpost) hdispatch + simpa [outputProbeIndexedDispatchTM] using hseq + +theorem outputProbeIndexedResetDispatchTM_of_latch_hoareTimeSpace_internal + (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (houter : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + Parked (outerExtras i)) + (houtput : Parked output) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) + {pre : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {post : Bool → + TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace zeroTime oneTime inputLength zeroSpace oneSpace + clearInitialSpace : ℕ} + (hlatch : (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace pre + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit) + latchTime inputLength latchSpace) + (hclearInitial : ∀ inp work out, + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras true inp work out → + ({ state := + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).qstart + input := inp + work := work + output := out } : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (clearWorkTM + (outputProbeLatchIdx n controllerTapes)).Q).WithinAuxSpace + inputLength clearInitialSpace) + (hzero : onZero.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post false) zeroTime inputLength zeroSpace) + (hone : onOne.HoareTimeSpace + (outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras false) + (post true) oneTime inputLength oneSpace) : + (outputProbeIndexedResetDispatchTM tm controllerTapes sourceIdx scratchIdx + onZero onOne).HoareTimeSpace pre (post bit) + (latchTime + 1 + + outputProbeLatchDispatchTime bit zeroTime + (clearWorkTimeBound 1 + 1 + oneTime)) + inputLength + (max latchSpace + (if bit then + max (clearInitialSpace + clearWorkTimeBound 1) oneSpace + else zeroSpace)) := by + have hdispatch := outputProbeLatchResetDispatchTM_hoareTimeSpace_internal tm + controllerTapes outerExtras input output extras bit hextras houter houtput + onZero onOne hclearInitial hzero hone + have hseq := seqTM_hoareTimeSpace + (outputProbeIndexedLatchTM tm controllerTapes sourceIdx scratchIdx) + (outputProbeLatchResetDispatchTM n controllerTapes onZero onOne) hlatch (by + intro inp work out hpost + obtain ⟨hinp, hwork, hout⟩ := + outputProbeLatchFramePost_parked_internal tm controllerTapes + outerExtras input output extras bit hextras houter houtput inp work + out hpost + have htransitionWork : + (fun i => transitionTape (work i)) = work := by + funext i + exact (hwork i).transitionTape_eq_self + rw [hinp.transitionInput_eq_self, htransitionWork, + hout.transitionTape_eq_self] + exact hpost) hdispatch + simpa [outputProbeIndexedResetDispatchTM] using hseq + +theorem IsTransducer.outputProbeLatchDispatchTM_internal + {onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeLatchDispatchTM n controllerTapes onZero onOne).IsTransducer := by + unfold outputProbeLatchDispatchTM + exact hone.branchWorkSymbolTM hzero + +theorem IsTransducer.outputProbeIndexedDispatchTM_internal + {tm : TM n} {controllerTapes : ℕ} + {sourceIdx scratchIdx : Fin controllerTapes} + {onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeIndexedDispatchTM tm controllerTapes sourceIdx scratchIdx + onZero onOne).IsTransducer := by + unfold outputProbeIndexedDispatchTM + exact (outputProbeIndexedLatchTM_isTransducer tm controllerTapes sourceIdx + scratchIdx).seqTM + (hzero.outputProbeLatchDispatchTM_internal hone) + +theorem IsTransducer.outputProbeLatchResetDispatchTM_internal + {onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeLatchResetDispatchTM n controllerTapes onZero + onOne).IsTransducer := by + unfold outputProbeLatchResetDispatchTM + exact hzero.outputProbeLatchDispatchTM_internal + ((clearWorkTM_isTransducer + (outputProbeLatchIdx n controllerTapes)).seqTM hone) + +theorem IsTransducer.outputProbeIndexedResetDispatchTM_internal + {tm : TM n} {controllerTapes : ℕ} + {sourceIdx scratchIdx : Fin controllerTapes} + {onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeIndexedResetDispatchTM tm controllerTapes sourceIdx scratchIdx + onZero onOne).IsTransducer := by + unfold outputProbeIndexedResetDispatchTM + exact (outputProbeIndexedLatchTM_isTransducer tm controllerTapes sourceIdx + scratchIdx).seqTM + (hzero.outputProbeLatchResetDispatchTM_internal hone) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeFrame.lean b/Complexitylib/Models/TuringMachine/OutputProbeFrame.lean new file mode 100644 index 00000000..bc5c290f --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeFrame.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeFrame.Internal + +/-! +# Restartable output probes with a real-output frame + +These variants preserve an arbitrary parked real output, allowing repeated +source queries inside an append-only serializer. +-/ + +namespace Complexity + +namespace TM + +/-- Retarget a total restartable query while preserving an arbitrary parked +real output and the exact all-prefix query-space bound. -/ +theorem + ComputesInSpace.outputProbeStartedRetargetTM_index_halts_withinAuxSpace_frame + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (output : Tape) (houtput : Parked output) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (∃ bit, (done.work (Fin.last (n + 1))).HasOutput [bit]) ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + done.output = output ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + ((outputProbeStartedTM tm).retargetOutput).reachesIn elapsed + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := + hcomp.outputProbeStartedRetargetTM_index_halts_withinAuxSpace_frame_internal + input index output houtput + +/-- Place a total framed restartable query inside a stable controller frame. -/ +theorem + ComputesInSpace.placeOutputProbeStartedRetargetTM_index_halts_withinAuxSpace_frame + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (pre post : ℕ) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (pre + (n + 2) + post) → Tape) + {frameSpace : ℕ} + (hextra : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let start := (outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output + ∃ probeSteps done, + (placeWorkTM pre post queryTM).reachesIn probeSteps + (placeWorkCfg queryTM pre post extras start) + (placeWorkCfg queryTM pre post extras done) ∧ + (placeWorkTM pre post queryTM).halted + (placeWorkCfg queryTM pre post extras done) ∧ + (∃ bit, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post (Fin.last (n + 1)))).HasOutput [bit]) ∧ + (∀ i, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post i)).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + (placeWorkCfg queryTM pre post extras done).output = output ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (placeWorkTM pre post queryTM).reachesIn elapsed + (placeWorkCfg queryTM pre post extras start) cfg → + cfg.WithinAuxSpace input.length + (max + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) + frameSpace) := + hcomp.placeOutputProbeStartedRetargetTM_index_halts_withinAuxSpace_frame_internal + pre post input index output houtput extras hextra hframe + +/-- Retarget a restartable query while preserving an arbitrary parked real +output and the exact all-prefix query-space bound. -/ +theorem ComputesInSpace.outputProbeStartedRetargetTM_getElem_withinAuxSpace_frame + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (done.work (Fin.last (n + 1))).HasOutput + [(f input)[index]'hindex] ∧ + done.work ⟨n, by omega⟩ = outputProbeCounterTape 0 ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + done.output = output ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + ((outputProbeStartedTM tm).retargetOutput).reachesIn elapsed + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := + hcomp.outputProbeStartedRetargetTM_getElem_withinAuxSpace_frame_internal + input index hindex output houtput + +/-- Place a framed restartable query inside a stable controller work frame. -/ +theorem ComputesInSpace.placeOutputProbeStartedRetargetTM_getElem_withinAuxSpace_frame + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (pre post : ℕ) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (pre + (n + 2) + post) → Tape) + {frameSpace : ℕ} + (hextra : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let start := (outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output + ∃ probeSteps done, + (placeWorkTM pre post queryTM).reachesIn probeSteps + (placeWorkCfg queryTM pre post extras start) + (placeWorkCfg queryTM pre post extras done) ∧ + (placeWorkTM pre post queryTM).halted + (placeWorkCfg queryTM pre post extras done) ∧ + ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post (Fin.last (n + 1)))).HasOutput + [(f input)[index]'hindex] ∧ + (placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post ⟨n, by omega⟩) = + outputProbeCounterTape 0 ∧ + (∀ i, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post i)).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + (placeWorkCfg queryTM pre post extras done).output = output ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (placeWorkTM pre post queryTM).reachesIn elapsed + (placeWorkCfg queryTM pre post extras start) cfg → + cfg.WithinAuxSpace input.length + (max + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) + frameSpace) := + hcomp.placeOutputProbeStartedRetargetTM_getElem_withinAuxSpace_frame_internal + pre post input index hindex output houtput extras hextra hframe + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeFrame/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeFrame/Internal.lean new file mode 100644 index 00000000..935dfdd6 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeFrame/Internal.lean @@ -0,0 +1,696 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbe +import Complexitylib.Models.TuringMachine.Placement +import Complexitylib.Models.TuringMachine.RetargetOutputFrame + +/-! +# Restartable output probes with a real-output frame -- proof internals +-/ + +namespace Complexity + +namespace TM + +private theorem startInvariant_move_idle_parked (tape : Tape) + (hinvariant : tape.StartInvariant) : + Parked (tape.move (idleDir tape.read)) := by + constructor + · by_cases hhead : tape.head = 0 + · have hread : tape.read = Γ.start := by + simp [Tape.read, hhead, hinvariant.1] + simp [Tape.move, idleDir, hread, hhead] + · have hpositive : 1 ≤ tape.head := by omega + have hread := hinvariant.read_ne_start hpositive + simp [Tape.move, idleDir, hread] + exact hpositive + · intro index hindex + simpa only [Tape.move_cells] using hinvariant.2 index hindex + +private theorem startInvariant_writeAndMove_readBack_idle_parked (tape : Tape) + (hinvariant : tape.StartInvariant) : + Parked (tape.writeAndMove (readBackWrite tape.read) + (idleDir tape.read)) := by + by_cases hread : tape.read = Γ.start + · have hhead : tape.head = 0 := by + by_contra hne + exact hinvariant.read_ne_start (by omega) hread + have hwrite : tape.write (readBackWrite tape.read) = tape := by + simp [Tape.write, hhead] + rw [show tape.writeAndMove (readBackWrite tape.read) + (idleDir tape.read) = tape.move (idleDir tape.read) by + simp only [Tape.writeAndMove, hwrite]] + exact startInvariant_move_idle_parked tape hinvariant + · rw [Tape.writeAndMove_readBack_idle_of_ne_start tape hread] + exact ⟨by + by_contra hhead + exact hread (by simp [Tape.read, Nat.eq_zero_of_not_pos hhead, + hinvariant.1]), hinvariant.2⟩ + +private theorem outputProbeCaptureCursor_ne_done {n : ℕ} {State : Type} + (cursor : OutputCursor) : + outputProbeCaptureCursor (n := n) (State := State) cursor ≠ .done := by + cases cursor with + | start => simp [outputProbeCaptureCursor] + | cell symbol => cases symbol <;> simp [outputProbeCaptureCursor] + +private theorem outputProbeAfterSourceTransition_ne_done {n : ℕ} + {State : Type} (nextState : State) (cursor nextCursor : OutputCursor) + (outputWrite : Γw) (outputDir : Dir3) (counterHead : Γ) : + outputProbeAfterSourceTransition (n := n) nextState cursor nextCursor + outputWrite outputDir counterHead ≠ .done := by + cases cursor with + | start => + unfold outputProbeAfterSourceTransition + split <;> simp + | cell symbol => + unfold outputProbeAfterSourceTransition + split + · simp_all + by_cases hcounter : counterHead = Γ.blank + · rw [if_pos hcounter] + cases outputWrite <;> simp [outputProbeCaptureWrite] + · rw [if_neg hcounter] + simp + · simp + +private theorem outputProbeAfterPred_ne_done {n : ℕ} {State : Type} + (sourceState : State) (cursor : OutputCursor) + (mask : OutputProbeStartMask n) (phase : BinaryPredPhase) : + outputProbeAfterPred sourceState cursor mask phase ≠ .done := by + unfold outputProbeAfterPred + split <;> simp + +private theorem outputProbeNext_done_cases (tm : TM n) + (phase : (outputProbeTM tm).Q) (inputHead : Γ) + (workHeads : Fin (n + 1) → Γ) (outputHead : Γ) + (hdone : ((outputProbeTM tm).δ phase inputHead workHeads outputHead).1 = + (outputProbeTM tm).qhalt) : + phase = .missing ∨ + (∃ bit, phase = .capture bit ∧ outputHead ≠ Γ.start) ∨ + phase = .done := by + cases phase with + | source state cursor => + simp only [outputProbeTM] at hdone + split at hdone + · split at hdone + · exact (outputProbeCaptureCursor_ne_done cursor + (by simpa [allReadBack] using hdone)).elim + · simp [allReadBack] at hdone + · exact (outputProbeAfterSourceTransition_ne_done _ _ _ _ _ _ + (by simpa [outputProbeSourceAction] using hdone)).elim + | prepare state cursor => + simp [outputProbeTM, allReadBack] at hdone + | pred state cursor mask predPhase => + exact (outputProbeAfterPred_ne_done state cursor mask _ + (by simpa [outputProbeTM] using hdone)).elim + | restore state cursor mask => + simp [outputProbeTM] at hdone + | capture bit => + right; left + refine ⟨bit, rfl, ?_⟩ + intro hstart + simp [outputProbeTM, hstart, allReadBack] at hdone + | missing => exact Or.inl rfl + | done => exact Or.inr (Or.inr rfl) + +private theorem outputProbeTM_step_halted_parked_internal (tm : TM n) + {before after : Cfg (n + 1) (outputProbeTM tm).Q} + (hstep : (outputProbeTM tm).step before = some after) + (hhalt : (outputProbeTM tm).halted after) + (hinput : before.input.StartInvariant) + (hwork : ∀ i, (before.work i).StartInvariant) : + Parked after.input ∧ ∀ i, Parked (after.work i) := by + rcases before with ⟨phase, input, work, output⟩ + have hnotHalt : phase ≠ (outputProbeTM tm).qhalt := + state_ne_qhalt_of_step hstep + have hdone : + ((outputProbeTM tm).δ phase input.read (fun i => (work i).read) + output.read).1 = (outputProbeTM tm).qhalt := by + rw [TM.step, if_neg hnotHalt] at hstep + generalize htransition : + (outputProbeTM tm).δ phase input.read (fun i => (work i).read) + output.read = transition at hstep ⊢ + obtain ⟨nextState, workWrites, outputWrite, inputDir, workDirs, + outputDir⟩ := transition + simp only [Option.some.injEq] at hstep + exact (congrArg Cfg.state hstep).trans hhalt + rcases outputProbeNext_done_cases tm phase input.read + (fun i => (work i).read) output.read hdone with + hmissing | hcapture | hdonePhase + · subst phase + have houtput : output.read ≠ Γ.start := by + intro hstart + simp [outputProbeTM, hstart, allReadBack] at hdone + simp [TM.step, outputProbeTM, houtput] at hstep + subst after + exact ⟨startInvariant_move_idle_parked input hinput, + fun i => startInvariant_writeAndMove_readBack_idle_parked + (work i) (hwork i)⟩ + · obtain ⟨bit, hphase, houtput⟩ := hcapture + subst phase + simp [TM.step, outputProbeTM, houtput] at hstep + subst after + exact ⟨startInvariant_move_idle_parked input hinput, + fun i => startInvariant_writeAndMove_readBack_idle_parked + (work i) (hwork i)⟩ + · exact (hnotHalt hdonePhase).elim + +private theorem startInvariant_reachesIn_internal (tm : TM n) + {steps : ℕ} {start done : Cfg n tm.Q} + (hreach : tm.reachesIn steps start done) + (hinput : start.input.StartInvariant) + (hwork : ∀ i, (start.work i).StartInvariant) + (houtput : start.output.StartInvariant) : + done.input.StartInvariant ∧ + (∀ i, (done.work i).StartInvariant) ∧ + done.output.StartInvariant := by + induction hreach with + | zero => exact ⟨hinput, hwork, houtput⟩ + | step hstep _ ih => + obtain ⟨hnextInput, hnextWork, hnextOutput⟩ := + Tape.StartInvariant.step tm hstep hinput hwork houtput + exact ih hnextInput hnextWork hnextOutput + +private theorem outputProbeTM_halted_reachesIn_parked_internal (tm : TM n) + {steps : ℕ} + {start done : Cfg (n + 1) (outputProbeTM tm).Q} + (hreach : (outputProbeTM tm).reachesIn steps start done) + (hhalt : (outputProbeTM tm).halted done) + (hstartState : start.state ≠ (outputProbeTM tm).qhalt) + (hinput : start.input.StartInvariant) + (hwork : ∀ i, (start.work i).StartInvariant) + (houtput : start.output.StartInvariant) : + Parked done.input ∧ ∀ i, Parked (done.work i) := by + have hsteps : steps ≠ 0 := by + intro hzero + subst steps + cases hreach + exact hstartState hhalt + obtain ⟨priorSteps, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hsteps + have hreach' : (outputProbeTM tm).reachesIn (priorSteps + 1) + start done := by + simpa using hreach + obtain ⟨before, hprefix, hlast⟩ := reachesIn_split_internal hreach' + obtain ⟨hbeforeInput, hbeforeWork, _hbeforeOutput⟩ := + startInvariant_reachesIn_internal (outputProbeTM tm) hprefix + hinput hwork houtput + cases hlast with + | step hstep hzero => + cases hzero + exact outputProbeTM_step_halted_parked_internal tm hstep hhalt + hbeforeInput hbeforeWork + +theorem + ComputesInSpace.outputProbeStartedRetargetTM_index_halts_withinAuxSpace_frame_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (output : Tape) (houtput : Parked output) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (∃ bit, (done.work (Fin.last (n + 1))).HasOutput [bit]) ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + done.output = output ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + ((outputProbeStartedTM tm).retargetOutput).reachesIn elapsed + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + obtain ⟨probeSteps, sourceDone, hsourceRun, hhalt, hout, + hhead, hsourcePrefix⟩ := + hcomp.outputProbeStartedTM_index_halts_withinAuxSpace input index + let sourceTM := outputProbeStartedTM tm + let budget := outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) + have hsourceTrans : sourceTM.IsTransducer := + (outputProbeTM_isTransducer tm).startedTM + have hstartInput : + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))).input.StartInvariant := by + simpa [outputProbeStartedCfg] using + (Tape.StartInvariant.init_ofBool input).move Dir3.right + have hstartWork : ∀ i, + ((outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))).work i).StartInvariant := by + intro i + simp only [outputProbeStartedCfg] + split + · exact Tape.StartInvariant.init_nil.move Dir3.right + · simpa [outputProbeCounterTape] using + (Tape.StartInvariant.init_ofBool (index + 1).bits).move Dir3.right + have hstartOutput : + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))).output.StartInvariant := by + simpa [outputProbeStartedCfg] using + Tape.StartInvariant.init_nil.move Dir3.right + have hsourceRunRaw := + (outputProbeTM tm).source_reachesIn_of_startedTM hsourceRun + have hsourceStartState : + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))).state ≠ + (outputProbeTM tm).qhalt := by + have hprobeStart : + (outputProbeTM tm).qstart ≠ (outputProbeTM tm).qhalt := by + simp [outputProbeTM] + rw [outputProbeStartedCfg, + startedTM_qstart_eq_startedState (outputProbeTM tm) hprobeStart] + intro hdone + have hcases := outputProbeNext_done_cases tm + (outputProbeTM tm).qstart Γ.start (fun _ => Γ.start) Γ.start + (by simpa [startedState] using hdone) + rcases hcases with hmissing | ⟨bit, hcapture, _⟩ | hhalted <;> + simp [outputProbeTM] at * + have hsourceParked := + outputProbeTM_halted_reachesIn_parked_internal tm hsourceRunRaw + hhalt hsourceStartState hstartInput hstartWork hstartOutput + have hsourceInvariants := + startInvariant_reachesIn_internal (outputProbeTM tm) hsourceRunRaw + hstartInput hstartWork hstartOutput + have hsourceOutputParked : Parked sourceDone.output := by + refine ⟨?_, hsourceInvariants.2.2.2⟩ + rw [hhead] + omega + have hdoneOutput : sourceDone.output.head ≤ budget := by + rw [hhead] + dsimp only [budget, outputProbeCaptureSpace, outputProbeReplaySpace, + outputProbePositiveSpace, binaryPredSpace] + omega + obtain ⟨hretargetRun, hretargetPrefix⟩ := + hsourceTrans.retargetOutput_reachesIn_retargetCfgFrame_withinAuxSpace + output houtput hsourceRun hsourcePrefix hdoneOutput + have hblankParked : ((Tape.init []).move Dir3.right).BlankAfter budget := by + simpa only [Tape.BlankAfter, Tape.move_cells] using + Tape.BlankAfter.init_nil budget + have hstartBlank : ∀ i, + ((sourceTM.retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output).work i).BlankAfter + budget := by + intro i + by_cases hi : i.val < n + 1 + · rw [retargetCfgFrame_work_lt sourceTM _ output i hi] + by_cases hsource : i.val < n + · simpa [outputProbeStartedCfg, hsource] using hblankParked + · have hilast : (⟨i.val, hi⟩ : Fin (n + 1)) = Fin.last n := by + apply Fin.ext + simp only [Fin.val_last] + omega + rw [hilast] + have hcounterBlank : + (outputProbeCounterTape (index + 1)).BlankAfter budget := by + have hcounterNat : + (outputProbeCounterTape (index + 1)).HasBinaryNat + (index + 1) := by + simpa [outputProbeCounterTape] using + Tape.init_move_right_hasBinaryNat (index + 1) + have hcontent : (outputProbeCounterTape + (index + 1)).HasBinaryContent (index + 1).bits := + hcounterNat.2.2 + apply hcontent.blankAfter_of_length_le + rw [Nat.size_eq_bits_len] + have hsize := Nat.size_le_size + (show index + 1 ≤ index + 1 + 1 by omega) + dsimp only [budget, outputProbeCaptureSpace, + outputProbeReplaySpace, outputProbePositiveSpace, binaryPredSpace] + omega + simpa [outputProbeStartedCfg] using hcounterBlank + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfgFrame_work_last] + simpa [outputProbeStartedCfg] using hblankParked + let done := sourceTM.retargetCfgFrame sourceDone output + have hdoneInputParked : Parked done.input := by + simpa only [done, retargetCfgFrame_input] using hsourceParked.1 + have hdoneInputInvariant : done.input.StartInvariant := by + simpa only [done, retargetCfgFrame_input] using hsourceInvariants.1 + have hdoneWorkParked : ∀ i, Parked (done.work i) := by + intro i + dsimp only [done] + by_cases hi : i.val < n + 1 + · rw [retargetCfgFrame_work_lt sourceTM sourceDone output i hi] + exact hsourceParked.2 ⟨i.val, hi⟩ + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfgFrame_work_last] + exact hsourceOutputParked + have hdoneWorkInvariant : ∀ i, (done.work i).StartInvariant := by + intro i + dsimp only [done] + by_cases hi : i.val < n + 1 + · rw [retargetCfgFrame_work_lt sourceTM sourceDone output i hi] + exact hsourceInvariants.2.1 ⟨i.val, hi⟩ + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfgFrame_work_last] + exact hsourceInvariants.2.2 + refine ⟨probeSteps, done, hretargetRun, ?_, ?_, ?_, rfl, + hdoneInputParked, hdoneInputInvariant, hdoneWorkParked, hdoneWorkInvariant, + hretargetPrefix⟩ + · simpa only [done, retargetOutput_halted_retargetCfgFrame] using hhalt + · obtain ⟨bit, hbit⟩ := hout + refine ⟨bit, ?_⟩ + dsimp only [done] + rw [retargetCfgFrame_work_last] + exact hbit + · intro i + dsimp only [done] + exact work_blankAfter_reachesIn i (hstartBlank i) hretargetRun + hretargetPrefix + +theorem ComputesInSpace.outputProbeStartedRetargetTM_getElem_withinAuxSpace_frame_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (input : List Bool) + (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) : + ∃ probeSteps done, + ((outputProbeStartedTM tm).retargetOutput).reachesIn probeSteps + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output) done ∧ + ((outputProbeStartedTM tm).retargetOutput).halted done ∧ + (done.work (Fin.last (n + 1))).HasOutput + [(f input)[index]'hindex] ∧ + done.work ⟨n, by omega⟩ = outputProbeCounterTape 0 ∧ + (∀ i, (done.work i).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + done.output = output ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + ((outputProbeStartedTM tm).retargetOutput).reachesIn elapsed + ((outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output) cfg → + cfg.WithinAuxSpace input.length + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) := by + obtain ⟨probeSteps, sourceDone, hsourceRun, hhalt, hout, hcounter, + hhead, hsourcePrefix⟩ := + hcomp.outputProbeStartedTM_getElem_withinAuxSpace input index hindex + let sourceTM := outputProbeStartedTM tm + let budget := outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) + have hsourceTrans : sourceTM.IsTransducer := + (outputProbeTM_isTransducer tm).startedTM + have hstartInput : + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))).input.StartInvariant := by + simpa [outputProbeStartedCfg] using + (Tape.StartInvariant.init_ofBool input).move Dir3.right + have hstartWork : ∀ i, + ((outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))).work i).StartInvariant := by + intro i + simp only [outputProbeStartedCfg] + split + · exact Tape.StartInvariant.init_nil.move Dir3.right + · simpa [outputProbeCounterTape] using + (Tape.StartInvariant.init_ofBool (index + 1).bits).move Dir3.right + have hstartOutput : + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))).output.StartInvariant := by + simpa [outputProbeStartedCfg] using + Tape.StartInvariant.init_nil.move Dir3.right + have hsourceRunRaw := + (outputProbeTM tm).source_reachesIn_of_startedTM hsourceRun + have hsourceStartState : + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))).state ≠ + (outputProbeTM tm).qhalt := by + have hprobeStart : + (outputProbeTM tm).qstart ≠ (outputProbeTM tm).qhalt := by + simp [outputProbeTM] + rw [outputProbeStartedCfg, + startedTM_qstart_eq_startedState (outputProbeTM tm) hprobeStart] + intro hdone + have hcases := outputProbeNext_done_cases tm + (outputProbeTM tm).qstart Γ.start (fun _ => Γ.start) Γ.start + (by simpa [startedState] using hdone) + rcases hcases with hmissing | ⟨bit, hcapture, _⟩ | hhalted <;> + simp [outputProbeTM] at * + have hsourceParked := + outputProbeTM_halted_reachesIn_parked_internal tm hsourceRunRaw + hhalt hsourceStartState hstartInput hstartWork hstartOutput + have hsourceInvariants := + startInvariant_reachesIn_internal (outputProbeTM tm) hsourceRunRaw + hstartInput hstartWork hstartOutput + have hsourceOutputParked : Parked sourceDone.output := by + refine ⟨?_, hsourceInvariants.2.2.2⟩ + rw [hhead] + omega + have hdoneOutput : sourceDone.output.head ≤ budget := by + rw [hhead] + dsimp only [budget, outputProbeCaptureSpace, outputProbeReplaySpace, + outputProbePositiveSpace, binaryPredSpace] + omega + obtain ⟨hretargetRun, hretargetPrefix⟩ := + hsourceTrans.retargetOutput_reachesIn_retargetCfgFrame_withinAuxSpace + output houtput hsourceRun hsourcePrefix hdoneOutput + have hblankParked : ((Tape.init []).move Dir3.right).BlankAfter budget := by + simpa only [Tape.BlankAfter, Tape.move_cells] using + Tape.BlankAfter.init_nil budget + have hstartBlank : ∀ i, + ((sourceTM.retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output).work i).BlankAfter + budget := by + intro i + by_cases hi : i.val < n + 1 + · rw [retargetCfgFrame_work_lt sourceTM _ output i hi] + by_cases hsource : i.val < n + · simpa [outputProbeStartedCfg, hsource] using hblankParked + · have hilast : (⟨i.val, hi⟩ : Fin (n + 1)) = Fin.last n := by + apply Fin.ext + simp only [Fin.val_last] + omega + rw [hilast] + have hcounterBlank : + (outputProbeCounterTape (index + 1)).BlankAfter budget := by + have hcounterNat : + (outputProbeCounterTape (index + 1)).HasBinaryNat + (index + 1) := by + simpa [outputProbeCounterTape] using + Tape.init_move_right_hasBinaryNat (index + 1) + have hcontent : (outputProbeCounterTape + (index + 1)).HasBinaryContent (index + 1).bits := + hcounterNat.2.2 + apply hcontent.blankAfter_of_length_le + rw [Nat.size_eq_bits_len] + have hsize := Nat.size_le_size + (show index + 1 ≤ index + 1 + 1 by omega) + dsimp only [budget, outputProbeCaptureSpace, + outputProbeReplaySpace, outputProbePositiveSpace, binaryPredSpace] + omega + simpa [outputProbeStartedCfg] using hcounterBlank + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfgFrame_work_last] + simpa [outputProbeStartedCfg] using hblankParked + let done := sourceTM.retargetCfgFrame sourceDone output + have hdoneInputParked : Parked done.input := by + simpa only [done, retargetCfgFrame_input] using hsourceParked.1 + have hdoneInputInvariant : done.input.StartInvariant := by + simpa only [done, retargetCfgFrame_input] using hsourceInvariants.1 + have hdoneWorkParked : ∀ i, Parked (done.work i) := by + intro i + dsimp only [done] + by_cases hi : i.val < n + 1 + · rw [retargetCfgFrame_work_lt sourceTM sourceDone output i hi] + exact hsourceParked.2 ⟨i.val, hi⟩ + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfgFrame_work_last] + exact hsourceOutputParked + have hdoneWorkInvariant : ∀ i, (done.work i).StartInvariant := by + intro i + dsimp only [done] + by_cases hi : i.val < n + 1 + · rw [retargetCfgFrame_work_lt sourceTM sourceDone output i hi] + exact hsourceInvariants.2.1 ⟨i.val, hi⟩ + · have hilast : i = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.val_last] + omega + subst i + rw [retargetCfgFrame_work_last] + exact hsourceInvariants.2.2 + refine ⟨probeSteps, done, hretargetRun, ?_, ?_, ?_, ?_, rfl, + hdoneInputParked, hdoneInputInvariant, hdoneWorkParked, hdoneWorkInvariant, + hretargetPrefix⟩ + · simpa only [done, retargetOutput_halted_retargetCfgFrame] using hhalt + · dsimp only [done] + rw [retargetCfgFrame_work_last] + exact hout + · dsimp only [done] + rw [retargetCfgFrame_work_lt] + exact hcounter + · intro i + dsimp only [done] + exact work_blankAfter_reachesIn i (hstartBlank i) hretargetRun + hretargetPrefix + +theorem + ComputesInSpace.placeOutputProbeStartedRetargetTM_index_halts_withinAuxSpace_frame_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (pre post : ℕ) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (pre + (n + 2) + post) → Tape) + {frameSpace : ℕ} + (hextra : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let start := (outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output + ∃ probeSteps done, + (placeWorkTM pre post queryTM).reachesIn probeSteps + (placeWorkCfg queryTM pre post extras start) + (placeWorkCfg queryTM pre post extras done) ∧ + (placeWorkTM pre post queryTM).halted + (placeWorkCfg queryTM pre post extras done) ∧ + (∃ bit, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post (Fin.last (n + 1)))).HasOutput [bit]) ∧ + (∀ i, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post i)).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + (placeWorkCfg queryTM pre post extras done).output = output ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (placeWorkTM pre post queryTM).reachesIn elapsed + (placeWorkCfg queryTM pre post extras start) cfg → + cfg.WithinAuxSpace input.length + (max + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) + frameSpace) := by + dsimp only + obtain ⟨probeSteps, done, hreach, hhalt, hout, hblank, + houtputDone, hinputParked, hinputInvariant, hworkParked, + hworkInvariant, hprefix⟩ := + hcomp.outputProbeStartedRetargetTM_index_halts_withinAuxSpace_frame_internal + input index output houtput + obtain ⟨hplaced, hplacedPrefix⟩ := + placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace + ((outputProbeStartedTM tm).retargetOutput) pre post extras hreach + hextra hprefix hframe + refine ⟨probeSteps, done, hplaced, hhalt, ?_, ?_, ?_, hinputParked, + hinputInvariant, hworkParked, hworkInvariant, hplacedPrefix⟩ + · obtain ⟨bit, hbit⟩ := hout + refine ⟨bit, ?_⟩ + rw [placeWorkCfg_work_middle] + exact hbit + · intro i + rw [placeWorkCfg_work_middle] + exact hblank i + · simpa only [placeWorkCfg_output] using houtputDone + +theorem ComputesInSpace.placeOutputProbeStartedRetargetTM_getElem_withinAuxSpace_frame_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) (pre post : ℕ) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (pre + (n + 2) + post) → Tape) + {frameSpace : ℕ} + (hextra : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre (n + 2) i → + (extras i).head ≤ frameSpace) : + let queryTM := (outputProbeStartedTM tm).retargetOutput + let start := (outputProbeStartedTM tm).retargetCfgFrame + (outputProbeStartedCfg tm input + (outputProbeCounterTape (index + 1))) output + ∃ probeSteps done, + (placeWorkTM pre post queryTM).reachesIn probeSteps + (placeWorkCfg queryTM pre post extras start) + (placeWorkCfg queryTM pre post extras done) ∧ + (placeWorkTM pre post queryTM).halted + (placeWorkCfg queryTM pre post extras done) ∧ + ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post (Fin.last (n + 1)))).HasOutput + [(f input)[index]'hindex] ∧ + (placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post ⟨n, by omega⟩) = + outputProbeCounterTape 0 ∧ + (∀ i, ((placeWorkCfg queryTM pre post extras done).work + (placeWorkIdx pre post i)).BlankAfter + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1))) ∧ + (placeWorkCfg queryTM pre post extras done).output = output ∧ + Parked done.input ∧ + done.input.StartInvariant ∧ + (∀ i, Parked (done.work i)) ∧ + (∀ i, (done.work i).StartInvariant) ∧ + ∀ elapsed cfg, elapsed ≤ probeSteps → + (placeWorkTM pre post queryTM).reachesIn elapsed + (placeWorkCfg queryTM pre post extras start) cfg → + cfg.WithinAuxSpace input.length + (max + (outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1)) + frameSpace) := by + dsimp only + obtain ⟨probeSteps, done, hreach, hhalt, hout, hcounter, hblank, + houtputDone, hinputParked, hinputInvariant, hworkParked, + hworkInvariant, hprefix⟩ := + hcomp.outputProbeStartedRetargetTM_getElem_withinAuxSpace_frame_internal + input index hindex output houtput + obtain ⟨hplaced, hplacedPrefix⟩ := + placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace + ((outputProbeStartedTM tm).retargetOutput) pre post extras hreach + hextra hprefix hframe + refine ⟨probeSteps, done, hplaced, ?_, ?_, ?_, ?_, ?_, hinputParked, + hinputInvariant, hworkParked, hworkInvariant, hplacedPrefix⟩ + · exact hhalt + · rw [placeWorkCfg_work_middle] + exact hout + · rw [placeWorkCfg_work_middle] + exact hcounter + · intro i + rw [placeWorkCfg_work_middle] + exact hblank i + · simpa only [placeWorkCfg_output] using houtputDone + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeIndexed.lean b/Complexitylib/Models/TuringMachine/OutputProbeIndexed.lean new file mode 100644 index 00000000..8733c5b6 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeIndexed.lean @@ -0,0 +1,364 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeIndexed.Defs +import Complexitylib.Models.TuringMachine.OutputProbeIndexed.Internal + +/-! +# Dynamically indexed restartable output probes + +This module bridges ghost-indexed output-probe contracts to concrete machine +loops. A preserved controller register is copied into the probe countdown, +incremented to select that zero-based position, and queried through the total +framed bit latch. +-/ + +namespace Complexity + +namespace TM + +/-- The canonical zero-latch frame is exactly the dynamic-query entry frame +with only its private countdown overwritten by canonical zero. This reusable +identity is the tape-level seam between successive indexed probe clients. -/ +theorem outputProbeLatchFrameCfg_work_eq_queryUpdate + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (controllerTapes value : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work = + Function.update + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (value + 1)) output extras)).work + (outputProbeIndexedCountdownIdx n controllerTapes) + (outputProbeCounterTape 0) := + outputProbeLatchFrameCfg_work_eq_queryUpdate_internal tm input output + extras hcleanupCounter controllerTapes value outerExtras + +/-- Controller-local indices embed injectively after the complete probe frame. -/ +theorem outputProbeIndexedControllerIdx_injective + (n : ℕ) {controllerTapes : ℕ} : + Function.Injective + (@outputProbeIndexedControllerIdx n controllerTapes) := + outputProbeIndexedControllerIdx_injective_internal n + +/-- Every embedded controller-local index lies outside the probe frame. -/ +theorem outputProbeIndexedControllerIdx_not_middle + (n : ℕ) {controllerTapes : ℕ} (idx : Fin controllerTapes) : + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) + (outputProbeIndexedControllerIdx n idx) := + outputProbeIndexedControllerIdx_not_middle_internal n idx + +/-- The private countdown lies inside the placed probe frame. -/ +theorem outputProbeIndexedCountdownIdx_middle (n controllerTapes : ℕ) : + placeWorkInMiddle 0 (outputProbeControllerTapes n) + (outputProbeIndexedCountdownIdx n controllerTapes) := + outputProbeIndexedCountdownIdx_middle_internal n controllerTapes + +/-- No controller-local register aliases the private probe countdown. -/ +theorem outputProbeIndexedControllerIdx_ne_countdown + (n : ℕ) {controllerTapes : ℕ} (idx : Fin controllerTapes) : + outputProbeIndexedControllerIdx n idx ≠ + outputProbeIndexedCountdownIdx n controllerTapes := + outputProbeIndexedControllerIdx_ne_countdown_internal n idx + +/-- A controller-local tape remains exactly equal to its stable outer-frame +value after a latched query. -/ +theorem outputProbeLatchFramePost_controller + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) + (idx : Fin controllerTapes) : + work (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := + outputProbeLatchFramePost_controller_internal tm controllerTapes + outerExtras input output extras bit inp work out hpost idx + +/-- Updating one controller-local tape after a latched query is represented by +the same update to the stable outer frame; the complete query-owned frame is +unchanged. -/ +theorem outputProbeLatchFramePost_updateController + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) + (idx : Fin controllerTapes) (tape : Tape) : + outputProbeLatchFramePost tm controllerTapes + (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) tape) + input output extras bit inp + (Function.update work + (outputProbeIndexedControllerIdx n idx) tape) + out := + outputProbeLatchFramePost_updateController_internal tm controllerTapes + outerExtras input output extras bit inp work out hpost idx tape + +/-- The physical private countdown in a doubly framed query contains the +declared one-based query value. -/ +theorem outputProbeIndexedFrameCountdown + (tm : TM n) (controllerTapes value : ℕ) + (input : List Bool) (output : Tape) + (innerExtras : Fin (outputProbeControllerTapes n) → Tape) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + let innerCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape value) output innerExtras + let framedCfg := placeWorkCfg (outputProbePlacedTM tm) 0 + controllerTapes outerExtras innerCfg + (framedCfg.work + (outputProbeIndexedCountdownIdx n controllerTapes)).HasBinaryNat value := + outputProbeIndexedFrameCountdown_internal tm controllerTapes value input + output innerExtras outerExtras + +/-- Dynamic countdown preparation preserves every non-countdown tape, writes +the canonical one-based query position, and has an explicit all-prefix space +envelope. -/ +theorem outputProbeIndexedPrepareTM_hoareTimeSpace + (n controllerTapes : ℕ) (sourceIdx scratchIdx : Fin controllerTapes) + (hdistinct : sourceIdx ≠ scratchIdx) + (index inputLength initialSpace : ℕ) + (inp₀ : Tape) + (work₀ : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out₀ : Tape) + (hsource : + (work₀ (outputProbeIndexedControllerIdx n sourceIdx)).HasBinaryNat + index) + (hcountdown : + (work₀ (outputProbeIndexedCountdownIdx n controllerTapes)).HasBinaryNat 0) + (hscratch : + (work₀ (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + let countdown := outputProbeIndexedCountdownIdx n controllerTapes + (outputProbeIndexedPrepareTM n controllerTapes + sourceIdx scratchIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ countdown → work i = work₀ i) ∧ + (work countdown).HasBinaryNat (index + 1) ∧ + out = out₀) + (outputProbeIndexedPrepareTime index) inputLength + (outputProbeIndexedPrepareSpace initialSpace index) := + outputProbeIndexedPrepareTM_hoareTimeSpace_internal n controllerTapes + sourceIdx scratchIdx hdistinct index inputLength initialSpace inp₀ work₀ + out₀ hsource hcountdown hscratch hinput hwork houtput hworkSpace + hinputSpace + +/-- A valid zero-based controller index is copied into the private query +countdown and returns the corresponding source-output bit in the persistent +framed latch. -/ +theorem ComputesInSpace.outputProbeIndexedLatchTM_hoareTimeSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) + (sourceIdx scratchIdx : Fin controllerTapes) + (hdistinct : sourceIdx ≠ scratchIdx) + (initialSpace : ℕ) + (work₀ : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (hsource : + (work₀ (outputProbeIndexedControllerIdx n sourceIdx)).HasBinaryNat + index) + (hcountdown : + (work₀ (outputProbeIndexedCountdownIdx n + controllerTapes)).HasBinaryNat 0) + (hscratch : + (work₀ (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat 0) + (hinput : Parked + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input) + (hwork : ∀ i, Parked (work₀ i)) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input.head ≤ + input.length + initialSpace + 1) + (hqueryWork : ∀ i, + i ≠ outputProbeIndexedCountdownIdx n controllerTapes → + work₀ i = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).work i) : + ∃ latchTime, + (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace + (fun inp work out => + inp = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes + outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input ∧ + work = work₀ ∧ out = output) + (outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras ((f input)[index]'hindex)) + (outputProbeIndexedPrepareTime index + 1 + latchTime) + input.length + (max (outputProbeIndexedPrepareSpace initialSpace index) + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (outputProbeLatchContinuationSpace + ((f input)[index]'hindex) frameSpace)) + outerFrameSpace)) := + hcomp.outputProbeIndexedLatchTM_hoareTimeSpace_internal input index hindex + output houtput extras frameSpace limit hextras hframe hcleanupCounter + hcleanupLimit hlimit controllerTapes outerExtras outerFrameSpace + houterRead houterFrame sourceIdx scratchIdx hdistinct initialSpace work₀ + hsource hcountdown hscratch hinput hwork hworkSpace hinputSpace hqueryWork + +/-- A zero-based index stored in a controller register selects one arbitrary +source-output bit. Preparation preserves the register, writes the private +one-based countdown, and composes with the total framed latch while retaining +an explicit all-prefix space bound. -/ +theorem ComputesInSpace.outputProbeIndexedLatchTM_index_halts_hoareTimeSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) + (sourceIdx scratchIdx : Fin controllerTapes) + (hdistinct : sourceIdx ≠ scratchIdx) + (initialSpace : ℕ) + (work₀ : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (hsource : + (work₀ (outputProbeIndexedControllerIdx n sourceIdx)).HasBinaryNat + index) + (hcountdown : + (work₀ (outputProbeIndexedCountdownIdx n + controllerTapes)).HasBinaryNat 0) + (hscratch : + (work₀ (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat 0) + (hinput : Parked + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input) + (hwork : ∀ i, Parked (work₀ i)) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input.head ≤ + input.length + initialSpace + 1) + (hqueryWork : ∀ i, + i ≠ outputProbeIndexedCountdownIdx n controllerTapes → + work₀ i = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).work i) : + ∃ bit latchTime, + (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace + (fun inp work out => + inp = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes + outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input ∧ + work = work₀ ∧ out = output) + (outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit) + (outputProbeIndexedPrepareTime index + 1 + latchTime) + input.length + (max (outputProbeIndexedPrepareSpace initialSpace index) + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (outputProbeLatchContinuationSpace bit frameSpace)) + outerFrameSpace)) := + hcomp.outputProbeIndexedLatchTM_index_halts_hoareTimeSpace_internal input + index output houtput extras frameSpace limit hextras hframe + hcleanupCounter hcleanupLimit hlimit controllerTapes outerExtras + outerFrameSpace houterRead houterFrame sourceIdx scratchIdx hdistinct + initialSpace work₀ hsource hcountdown hscratch hinput hwork hworkSpace + hinputSpace hqueryWork + +/-- Dynamic countdown preparation is one-way-output safe. -/ +theorem outputProbeIndexedPrepareTM_isTransducer + (n controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) : + (outputProbeIndexedPrepareTM n controllerTapes + sourceIdx scratchIdx).IsTransducer := + outputProbeIndexedPrepareTM_isTransducer_internal n controllerTapes + sourceIdx scratchIdx + +/-- A dynamically indexed latched query is one-way-output safe. -/ +theorem outputProbeIndexedLatchTM_isTransducer + (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) : + (outputProbeIndexedLatchTM tm controllerTapes + sourceIdx scratchIdx).IsTransducer := + outputProbeIndexedLatchTM_isTransducer_internal tm controllerTapes + sourceIdx scratchIdx + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeIndexed/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeIndexed/Defs.lean new file mode 100644 index 00000000..0ff6d30e --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeIndexed/Defs.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeLatch.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs + +/-! +# Dynamically indexed restartable output probes -- definitions + +The basic output-probe contracts take a numeric query position as a ghost +parameter. A machine loop instead stores that position on a preserved +controller tape. This module copies such a controller index into the probe's +private countdown, increments it to the probe's one-based convention, and then +runs the total framed latch. +-/ + +namespace Complexity + +namespace TM + +/-- Embed one controller-local work index after the complete probe frame. -/ +def outputProbeIndexedControllerIdx (n : ℕ) {controllerTapes : ℕ} + (idx : Fin controllerTapes) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) := + ⟨outputProbeControllerTapes n + idx, by + dsimp only [outputProbeControllerTapes] + omega⟩ + +/-- Physical location of the probe's private query countdown. -/ +def outputProbeIndexedCountdownIdx (n controllerTapes : ℕ) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) := + placeWorkIdx 0 controllerTapes (outputProbeCleanupCountdownIdx n) + +/-- Prepare a dynamic query position. + +The source controller register is preserved. The distinct scratch register is +a reusable canonical zero, and the private countdown is overwritten by the +source value and incremented once. -/ +def outputProbeIndexedPrepareTM (n controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + let source := outputProbeIndexedControllerIdx n sourceIdx + let countdown := outputProbeIndexedCountdownIdx n controllerTapes + let scratch := outputProbeIndexedControllerIdx n scratchIdx + seqTM (binaryCopyIntoTM source countdown scratch) + (binarySuccTM countdown) + +/-- Exact compositional runtime of dynamic countdown preparation. -/ +def outputProbeIndexedPrepareTime (index : ℕ) : ℕ := + binaryCopyTime index 0 + 1 + binarySuccTime index + +/-- All-prefix space envelope of dynamic countdown preparation. -/ +def outputProbeIndexedPrepareSpace (initialSpace index : ℕ) : ℕ := + binaryCopySpace initialSpace index 0 + binarySuccTime index + +/-- Prepare the private countdown from a preserved controller index and run +one total query, leaving its Boolean result in the canonical probe latch. -/ +def outputProbeIndexedLatchTM (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + seqTM (outputProbeIndexedPrepareTM n controllerTapes sourceIdx scratchIdx) + (outputProbeLatchTM tm controllerTapes) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeIndexed/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeIndexed/Internal.lean new file mode 100644 index 00000000..b9eb5dc0 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeIndexed/Internal.lean @@ -0,0 +1,672 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeIndexed.Defs +import Complexitylib.Models.TuringMachine.OutputProbeLatch +import Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy + +/-! +# Dynamically indexed restartable output probes -- proof internals +-/ + +namespace Complexity + +namespace TM + +private theorem outputProbeIndexed_hasBinaryNat_parked {tape : Tape} + {value : ℕ} (hvalue : tape.HasBinaryNat value) : Parked tape := by + refine ⟨by rw [hvalue.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hvalue.2.2 + +theorem outputProbeLatchFrameCfg_work_eq_queryUpdate_internal + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (controllerTapes value : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras false).work = + Function.update + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (value + 1)) output extras)).work + (outputProbeIndexedCountdownIdx n controllerTapes) + (outputProbeCounterTape 0) := by + have hcleanupCounterEq : extras (outputProbeCleanupCounterIdx n) = + outputProbeCounterTape 0 := by + simpa [outputProbeCounterTape] using hcleanupCounter.eq_init_move_right + funext i + by_cases houterMiddle : + placeWorkInMiddle 0 (outputProbeControllerTapes n) i + · generalize hcoord : + placeWorkCoord 0 (outputProbeControllerTapes n) i houterMiddle = coord + have hphysical : placeWorkIdx 0 controllerTapes coord = i := by + rw [← hcoord] + exact placeWorkIdx_placeWorkCoord i houterMiddle + rw [← hphysical] + rw [outputProbeLatchFrameCfg, placeWorkCfg_work_middle, + outputProbeIndexedCountdownIdx] + change + (outputProbeLatchInnerFrameCfg tm input output extras false).work coord = + Function.update + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (value + 1)) output extras)).work + (placeWorkIdx 0 controllerTapes + (outputProbeCleanupCountdownIdx n)) + (outputProbeCounterTape 0) (placeWorkIdx 0 controllerTapes coord) + by_cases hcountdown : coord = outputProbeCleanupCountdownIdx n + · try rw [hcoord] + rw [hcountdown] + rw [Function.update_self] + simp only [outputProbeLatchInnerFrameCfg, Bool.false_eq_true, if_false] + rw [Function.update_of_ne] + · let countdownIdx : Fin (n + 2) := ⟨n, by omega⟩ + have hcountdownPhysical : outputProbeCleanupCountdownIdx n = + placeWorkIdx 0 2 countdownIdx := by + apply Fin.ext + simp [outputProbeCleanupCountdownIdx, countdownIdx] + rw [hcountdownPhysical, outputProbePlacedFrameCfg, + placeWorkCfg_work_middle] + rw [retargetCfgFrame_work_lt _ _ _ countdownIdx (by + dsimp only [countdownIdx] + omega)] + simp [outputProbeStartedCfg, countdownIdx, outputProbeCounterTape] + · intro heq + have hval := congrArg Fin.val heq + simp [outputProbeCleanupCountdownIdx, outputProbeCleanupCounterIdx] + at hval + · rw [Function.update_of_ne] + · rw [placeWorkCfg_work_middle] + simp only [outputProbeLatchInnerFrameCfg, Bool.false_eq_true, if_false] + by_cases hcounter : coord = outputProbeCleanupCounterIdx n + · try rw [hcoord] + rw [hcounter] + rw [Function.update_self] + rw [outputProbePlacedFrameCfg, placeWorkCfg_work_extra] + · exact hcleanupCounterEq.symm + · simp [placeWorkInMiddle, outputProbeCleanupCounterIdx] + · rw [Function.update_of_ne hcounter] + rw [outputProbePlacedFrameCfg, outputProbePlacedFrameCfg] + by_cases hinnerMiddle : placeWorkInMiddle 0 (n + 2) coord + · generalize hsourceCoord : + placeWorkCoord 0 (n + 2) coord hinnerMiddle = source + have hsourcePhysical : placeWorkIdx 0 2 source = coord := by + rw [← hsourceCoord] + exact placeWorkIdx_placeWorkCoord coord hinnerMiddle + rw [← hsourcePhysical, placeWorkCfg_work_middle, + placeWorkCfg_work_middle] + by_cases hsource : source.val < n + 1 + · rw [retargetCfgFrame_work_lt _ _ _ source hsource, + retargetCfgFrame_work_lt _ _ _ source hsource] + have hsourceWork : source.val < n := by + by_contra hnot + have hsourceEq : source.val = n := by omega + apply hcountdown + apply Fin.ext + rw [← hsourcePhysical] + simpa [outputProbeCleanupCountdownIdx, placeWorkIdx] using + hsourceEq + simp [outputProbeStartedCfg, hsourceWork] + · have hlast : source = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.last] + omega + rw [hlast, retargetCfgFrame_work_last, + retargetCfgFrame_work_last] + simp [outputProbeStartedCfg] + · rw [placeWorkCfg_work_extra _ _ _ extras _ coord hinnerMiddle, + placeWorkCfg_work_extra _ _ _ extras _ coord hinnerMiddle] + · intro heq + exact hcountdown (placeWorkIdx_injective 0 controllerTapes heq) + · rw [outputProbeLatchFrameCfg, + placeWorkCfg_work_extra _ _ _ outerExtras _ i houterMiddle] + rw [Function.update_of_ne] + · rw [placeWorkCfg_work_extra _ _ _ outerExtras _ i houterMiddle] + · intro heq + subst i + apply houterMiddle + simp [outputProbeIndexedCountdownIdx, placeWorkInMiddle, placeWorkIdx, + outputProbeCleanupCountdownIdx] + dsimp only [outputProbeControllerTapes] + omega + +theorem outputProbeIndexedControllerIdx_injective_internal + (n : ℕ) {controllerTapes : ℕ} : + Function.Injective + (@outputProbeIndexedControllerIdx n controllerTapes) := by + intro left right heq + apply Fin.ext + apply congrArg Fin.val at heq + simp only [outputProbeIndexedControllerIdx] at heq + omega + +theorem outputProbeIndexedControllerIdx_not_middle_internal + (n : ℕ) {controllerTapes : ℕ} (idx : Fin controllerTapes) : + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) + (outputProbeIndexedControllerIdx n idx) := by + simp [placeWorkInMiddle, outputProbeIndexedControllerIdx] + +theorem outputProbeIndexedCountdownIdx_middle_internal + (n controllerTapes : ℕ) : + placeWorkInMiddle 0 (outputProbeControllerTapes n) + (outputProbeIndexedCountdownIdx n controllerTapes) := by + simp [outputProbeIndexedCountdownIdx, placeWorkInMiddle, placeWorkIdx, + outputProbeCleanupCountdownIdx] + dsimp only [outputProbeControllerTapes] + omega + +theorem outputProbeIndexedControllerIdx_ne_countdown_internal + (n : ℕ) {controllerTapes : ℕ} (idx : Fin controllerTapes) : + outputProbeIndexedControllerIdx n idx ≠ + outputProbeIndexedCountdownIdx n controllerTapes := by + intro heq + have hmiddle := outputProbeIndexedCountdownIdx_middle_internal n + controllerTapes + rw [← heq] at hmiddle + exact outputProbeIndexedControllerIdx_not_middle_internal n idx hmiddle + +theorem outputProbeLatchFramePost_controller_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) + (idx : Fin controllerTapes) : + work (outputProbeIndexedControllerIdx n idx) = + outerExtras (outputProbeIndexedControllerIdx n idx) := by + obtain ⟨sourceWork, _hsource, hwork⟩ := hpost + rw [hwork, placeWorkCfg_work_extra] + exact outputProbeIndexedControllerIdx_not_middle_internal n idx + +theorem outputProbeLatchFramePost_updateController_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) + (idx : Fin controllerTapes) (tape : Tape) : + outputProbeLatchFramePost tm controllerTapes + (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) tape) + input output extras bit inp + (Function.update work + (outputProbeIndexedControllerIdx n idx) tape) + out := by + obtain ⟨sourceWork, hsource, hwork⟩ := hpost + refine ⟨sourceWork, hsource, ?_⟩ + rw [hwork] + funext i + by_cases hi : i = outputProbeIndexedControllerIdx n idx + · subst i + rw [Function.update_self, placeWorkCfg_work_extra] + · simp only [Function.update_self] + · exact outputProbeIndexedControllerIdx_not_middle_internal n idx + · rw [Function.update_of_ne hi] + by_cases hmiddle : placeWorkInMiddle 0 (outputProbeControllerTapes n) i + · simp only [placeWorkCfg, hmiddle, dite_true] + · rw [placeWorkCfg_work_extra _ _ _ outerExtras _ i hmiddle] + rw [placeWorkCfg_work_extra _ _ _ + (Function.update outerExtras + (outputProbeIndexedControllerIdx n idx) tape) _ i hmiddle] + rw [Function.update_of_ne hi] + +theorem outputProbeIndexedFrameCountdown_internal + (tm : TM n) (controllerTapes value : ℕ) + (input : List Bool) (output : Tape) + (innerExtras : Fin (outputProbeControllerTapes n) → Tape) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) : + let innerCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape value) output innerExtras + let framedCfg := placeWorkCfg (outputProbePlacedTM tm) 0 + controllerTapes outerExtras innerCfg + (framedCfg.work + (outputProbeIndexedCountdownIdx n controllerTapes)).HasBinaryNat value := by + dsimp only + rw [outputProbeIndexedCountdownIdx, placeWorkCfg_work_middle] + let countdownIdx : Fin (n + 2) := ⟨n, by omega⟩ + have hphysical : outputProbeCleanupCountdownIdx n = + placeWorkIdx 0 2 countdownIdx := by + apply Fin.ext + simp [outputProbeCleanupCountdownIdx, countdownIdx] + rw [outputProbePlacedFrameCfg, hphysical, placeWorkCfg_work_middle] + rw [retargetCfgFrame_work_lt _ _ _ countdownIdx (by + dsimp only [countdownIdx] + omega)] + simpa [outputProbeStartedCfg, countdownIdx, outputProbeCounterTape] using + Tape.init_move_right_hasBinaryNat value + +theorem outputProbeIndexedPrepareTM_hoareTimeSpace_internal + (n controllerTapes : ℕ) (sourceIdx scratchIdx : Fin controllerTapes) + (hdistinct : sourceIdx ≠ scratchIdx) + (index inputLength initialSpace : ℕ) + (inp₀ : Tape) + (work₀ : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out₀ : Tape) + (hsource : + (work₀ (outputProbeIndexedControllerIdx n sourceIdx)).HasBinaryNat + index) + (hcountdown : + (work₀ (outputProbeIndexedCountdownIdx n controllerTapes)).HasBinaryNat 0) + (hscratch : + (work₀ (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + let countdown := outputProbeIndexedCountdownIdx n controllerTapes + (outputProbeIndexedPrepareTM n controllerTapes + sourceIdx scratchIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ countdown → work i = work₀ i) ∧ + (work countdown).HasBinaryNat (index + 1) ∧ + out = out₀) + (outputProbeIndexedPrepareTime index) inputLength + (outputProbeIndexedPrepareSpace initialSpace index) := by + dsimp only + let source := outputProbeIndexedControllerIdx n sourceIdx + let countdown := outputProbeIndexedCountdownIdx n controllerTapes + let scratch := outputProbeIndexedControllerIdx n scratchIdx + have hsourceCountdown : source ≠ countdown := by + exact outputProbeIndexedControllerIdx_ne_countdown_internal n sourceIdx + have hscratchCountdown : scratch ≠ countdown := by + exact outputProbeIndexedControllerIdx_ne_countdown_internal n scratchIdx + have hsourceScratch : source ≠ scratch := by + exact (outputProbeIndexedControllerIdx_injective_internal n).ne hdistinct + let copiedWork := Function.update work₀ countdown + ((Tape.init (index.bits.map Γ.ofBool)).move Dir3.right) + have hcopy := binaryCopyIntoTM_hoareTimeSpace_frame + source countdown scratch hsourceCountdown hsourceScratch + hscratchCountdown.symm index 0 inputLength initialSpace inp₀ work₀ out₀ + hsource hcountdown hscratch hinput (fun i _ _ _ => hwork i) houtput + hworkSpace hinputSpace + have hcopiedCountdown : + (copiedWork countdown).HasBinaryNat index := by + simpa [copiedWork] using Tape.init_move_right_hasBinaryNat index + have hcopiedParked : ∀ i, Parked (copiedWork i) := by + intro i + by_cases hi : i = countdown + · subst i + exact outputProbeIndexed_hasBinaryNat_parked hcopiedCountdown + · dsimp only [copiedWork] + simpa [hi] using hwork i + have hinitialOne : 1 ≤ initialSpace := by + rw [← hcountdown.2.1] + exact hworkSpace countdown + have hcopiedWithin : + (⟨(binarySuccTM countdown).qstart, inp₀, copiedWork, out₀⟩ : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (binarySuccTM countdown).Q).WithinAuxSpace inputLength + (binaryCopySpace initialSpace index 0) := by + constructor + · intro i + by_cases hi : i = countdown + · subst i + rw [hcopiedCountdown.2.1] + simp [binaryCopySpace] + omega + · dsimp only [copiedWork] + simpa [hi] using (hworkSpace i).trans (by simp [binaryCopySpace]) + · exact hinputSpace.trans (by simp [binaryCopySpace]) + have hsucc := binarySuccTM_hoareTimeSpace_frame countdown index + inputLength (binaryCopySpace initialSpace index 0) inp₀ copiedWork out₀ + hcopiedCountdown hinput.read_ne_start + (fun i _ => (hcopiedParked i).read_ne_start) houtput.read_ne_start + hcopiedWithin + have hseq := seqTM_hoareTimeSpace + (binaryCopyIntoTM source countdown scratch) (binarySuccTM countdown) + hcopy (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hcopiedParked i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩) hsucc + have hseq' : + (seqTM (binaryCopyIntoTM source countdown scratch) + (binarySuccTM countdown)).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ countdown → work i = work₀ i) ∧ + (work countdown).HasBinaryNat (index + 1) ∧ + out = out₀) + (binaryCopyTime index 0 + 1 + binarySuccTime index) inputLength + (max (binaryCopySpace initialSpace index 0) + (binaryCopySpace initialSpace index 0 + binarySuccTime index)) := by + apply hseq.consequence (fun _ _ _ h => h) _ le_rfl le_rfl le_rfl + rintro inp work out ⟨hinputEq, hother, hvalue, houtputEq⟩ + refine ⟨hinputEq, ?_, hvalue, houtputEq⟩ + intro i hi + rw [hother i hi] + simp [copiedWork, hi] + simpa [outputProbeIndexedPrepareTM, outputProbeIndexedPrepareTime, + outputProbeIndexedPrepareSpace, source, countdown, scratch, copiedWork, + max_eq_right (Nat.le_add_right _ _)] using hseq' + +private theorem outputProbeIndexedLatchTM_compose_internal + (tm : TM n) (input : List Bool) (index : ℕ) + (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (sourceIdx scratchIdx : Fin controllerTapes) + (hdistinct : sourceIdx ≠ scratchIdx) + (initialSpace : ℕ) + (work₀ : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (hsource : + (work₀ (outputProbeIndexedControllerIdx n sourceIdx)).HasBinaryNat + index) + (hcountdown : + (work₀ (outputProbeIndexedCountdownIdx n + controllerTapes)).HasBinaryNat 0) + (hscratch : + (work₀ (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat 0) + (hinput : Parked + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input) + (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked output) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input.head ≤ + input.length + initialSpace + 1) + (hqueryWork : ∀ i, + i ≠ outputProbeIndexedCountdownIdx n controllerTapes → + work₀ i = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).work i) + {post : TapePred (0 + outputProbeControllerTapes n + controllerTapes)} + {latchTime latchSpace : ℕ} + (hlatch : (outputProbeLatchTM tm controllerTapes).HoareTimeSpace + (placeWorkPred (outputProbeLatchInnerTM tm) 0 controllerTapes + outerExtras + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output)) + post latchTime input.length latchSpace) : + (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace + (fun inp work out => + inp = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes + outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input ∧ + work = work₀ ∧ out = output) + post + (outputProbeIndexedPrepareTime index + 1 + latchTime) + input.length + (max (outputProbeIndexedPrepareSpace initialSpace index) + latchSpace) := by + let innerCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras + let queryCfg := placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes + outerExtras innerCfg + let countdown := outputProbeIndexedCountdownIdx n controllerTapes + have hqueryCountdown : + (queryCfg.work countdown).HasBinaryNat (index + 1) := by + simpa [queryCfg, innerCfg, countdown] using + outputProbeIndexedFrameCountdown_internal tm controllerTapes + (index + 1) input output extras outerExtras + have hprepare := + outputProbeIndexedPrepareTM_hoareTimeSpace_internal n controllerTapes + sourceIdx scratchIdx hdistinct index input.length initialSpace + queryCfg.input work₀ output hsource hcountdown hscratch (by + simpa [queryCfg, innerCfg] using hinput) hwork houtput hworkSpace (by + simpa [queryCfg, innerCfg] using hinputSpace) + have hseq := seqTM_hoareTimeSpace + (outputProbeIndexedPrepareTM n controllerTapes sourceIdx scratchIdx) + (outputProbeLatchTM tm controllerTapes) hprepare (by + rintro inp work out ⟨hinp, hother, hvalue, hout⟩ + have hworkEq : work = queryCfg.work := by + funext i + by_cases hi : i = countdown + · subst i + exact hvalue.eq_init_move_right.trans + hqueryCountdown.eq_init_move_right.symm + · exact (hother i hi).trans (hqueryWork i (by + simpa [countdown] using hi)) + have hworkParked : ∀ i, Parked (work i) := by + intro i + by_cases hi : i = countdown + · subst i + exact outputProbeIndexed_hasBinaryNat_parked hvalue + · rw [hother i hi] + exact hwork i + have htransitionWork : + (fun i => transitionTape (work i)) = work := by + funext i + exact (hworkParked i).transitionTape_eq_self + rw [(show Parked inp by rw [hinp]; simpa [queryCfg, innerCfg] using + hinput).transitionInput_eq_self, htransitionWork, + (show Parked out by rw [hout]; exact houtput).transitionTape_eq_self, + hinp, hworkEq, hout] + refine ⟨innerCfg.work, ?_, ?_⟩ + · exact ⟨by simp [queryCfg, innerCfg], rfl, rfl⟩ + · rfl) hlatch + simpa [outputProbeIndexedLatchTM, queryCfg, innerCfg, countdown] using hseq + +theorem ComputesInSpace.outputProbeIndexedLatchTM_hoareTimeSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) + (sourceIdx scratchIdx : Fin controllerTapes) + (hdistinct : sourceIdx ≠ scratchIdx) + (initialSpace : ℕ) + (work₀ : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (hsource : + (work₀ (outputProbeIndexedControllerIdx n sourceIdx)).HasBinaryNat + index) + (hcountdown : + (work₀ (outputProbeIndexedCountdownIdx n + controllerTapes)).HasBinaryNat 0) + (hscratch : + (work₀ (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat 0) + (hinput : Parked + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input) + (hwork : ∀ i, Parked (work₀ i)) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input.head ≤ + input.length + initialSpace + 1) + (hqueryWork : ∀ i, + i ≠ outputProbeIndexedCountdownIdx n controllerTapes → + work₀ i = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).work i) : + ∃ latchTime, + (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace + (fun inp work out => + inp = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes + outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input ∧ + work = work₀ ∧ out = output) + (outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras ((f input)[index]'hindex)) + (outputProbeIndexedPrepareTime index + 1 + latchTime) + input.length + (max (outputProbeIndexedPrepareSpace initialSpace index) + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (outputProbeLatchContinuationSpace + ((f input)[index]'hindex) frameSpace)) + outerFrameSpace)) := by + obtain ⟨latchTime, hlatch⟩ := + hcomp.outputProbeLatchTM_hoareTimeSpace input index hindex output houtput + extras frameSpace limit hextras hframe hcleanupCounter hcleanupLimit + hlimit controllerTapes outerExtras outerFrameSpace houterRead houterFrame + refine ⟨latchTime, ?_⟩ + exact outputProbeIndexedLatchTM_compose_internal tm input index output + extras controllerTapes outerExtras sourceIdx scratchIdx hdistinct + initialSpace work₀ hsource hcountdown hscratch hinput hwork houtput + hworkSpace hinputSpace hqueryWork hlatch + +theorem + ComputesInSpace.outputProbeIndexedLatchTM_index_halts_hoareTimeSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) + (sourceIdx scratchIdx : Fin controllerTapes) + (hdistinct : sourceIdx ≠ scratchIdx) + (initialSpace : ℕ) + (work₀ : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (hsource : + (work₀ (outputProbeIndexedControllerIdx n sourceIdx)).HasBinaryNat + index) + (hcountdown : + (work₀ (outputProbeIndexedCountdownIdx n + controllerTapes)).HasBinaryNat 0) + (hscratch : + (work₀ (outputProbeIndexedControllerIdx n scratchIdx)).HasBinaryNat 0) + (hinput : Parked + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input) + (hwork : ∀ i, Parked (work₀ i)) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input.head ≤ + input.length + initialSpace + 1) + (hqueryWork : ∀ i, + i ≠ outputProbeIndexedCountdownIdx n controllerTapes → + work₀ i = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).work i) : + ∃ bit latchTime, + (outputProbeIndexedLatchTM tm controllerTapes sourceIdx + scratchIdx).HoareTimeSpace + (fun inp work out => + inp = + (placeWorkCfg (outputProbePlacedTM tm) 0 controllerTapes + outerExtras + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras)).input ∧ + work = work₀ ∧ out = output) + (outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit) + (outputProbeIndexedPrepareTime index + 1 + latchTime) + input.length + (max (outputProbeIndexedPrepareSpace initialSpace index) + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (outputProbeLatchContinuationSpace bit frameSpace)) + outerFrameSpace)) := by + obtain ⟨bit, latchTime, hlatch⟩ := + hcomp.outputProbeLatchTM_index_halts_hoareTimeSpace input index output + houtput extras frameSpace limit hextras hframe hcleanupCounter + hcleanupLimit hlimit controllerTapes outerExtras outerFrameSpace + houterRead houterFrame + refine ⟨bit, latchTime, ?_⟩ + exact outputProbeIndexedLatchTM_compose_internal tm input index output + extras controllerTapes outerExtras sourceIdx scratchIdx hdistinct + initialSpace work₀ hsource hcountdown hscratch hinput hwork houtput + hworkSpace hinputSpace hqueryWork hlatch + +theorem outputProbeIndexedPrepareTM_isTransducer_internal + (n controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) : + (outputProbeIndexedPrepareTM n controllerTapes + sourceIdx scratchIdx).IsTransducer := by + unfold outputProbeIndexedPrepareTM + exact (binaryCopyIntoTM_isTransducer _ _ _).seqTM + (binarySuccTM_isTransducer _) + +theorem outputProbeIndexedLatchTM_isTransducer_internal + (tm : TM n) (controllerTapes : ℕ) + (sourceIdx scratchIdx : Fin controllerTapes) : + (outputProbeIndexedLatchTM tm controllerTapes + sourceIdx scratchIdx).IsTransducer := by + unfold outputProbeIndexedLatchTM + exact (outputProbeIndexedPrepareTM_isTransducer_internal n controllerTapes + sourceIdx scratchIdx).seqTM + (outputProbeLatchTM_isTransducer tm controllerTapes) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeLatch.lean b/Complexitylib/Models/TuringMachine/OutputProbeLatch.lean new file mode 100644 index 00000000..9496213d --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeLatch.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeLatch.Defs +import Complexitylib.Models.TuringMachine.OutputProbeLatch.Internal + +/-! +# Restartable output probes with a framed bit latch + +This module turns the finite-control result of a restartable output query into +a persistent canonical binary zero-or-one latch. The query and its cleanup +occupy a fixed prefix of the work vector; arbitrary serializer tapes after that +prefix remain a literal stable frame. +-/ + +namespace Complexity + +namespace TM + +/-- The canonical restored query frame satisfies the stable outer-frame +predicate with its explicit zero-or-one latch. -/ +theorem outputProbeLatchFrameCfg_post + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) : + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras bit).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras bit).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras bit).output := + outputProbeLatchFrameCfg_post_internal tm controllerTapes outerExtras input + output extras bit + +/-- The restored latch-frame predicate determines the canonical physical +input, work, and output tapes uniquely. -/ +theorem outputProbeLatchFramePost_eq_frameCfg + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) : + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras bit).input ∧ + work = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras bit).work ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras bit).output := + outputProbeLatchFramePost_eq_frameCfg_internal tm controllerTapes + outerExtras input output extras bit inp work out hpost + +/-- The physical latch selected by the placed frame predicate contains exactly +the queried Boolean as canonical binary zero or one. -/ +theorem outputProbeLatchFramePost_latch + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) : + (work (outputProbeLatchIdx n controllerTapes)).HasBinaryNat + (if bit then 1 else 0) := + outputProbeLatchFramePost_latch_internal tm controllerTapes outerExtras + input output extras bit inp work out hpost + +/-- A valid source-output query restores its complete query frame and stores +the selected Boolean as canonical binary zero or one in the reusable cleanup +counter. Every outer serializer tape is preserved exactly, and the theorem +carries the combined all-prefix auxiliary-space bound. -/ +theorem ComputesInSpace.outputProbeLatchTM_hoareTimeSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) : + ∃ latchTime, + (outputProbeLatchTM tm controllerTapes).HoareTimeSpace + (placeWorkPred (outputProbeLatchInnerTM tm) 0 controllerTapes + outerExtras + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output)) + (outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras ((f input)[index]'hindex)) + latchTime input.length + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (outputProbeLatchContinuationSpace + ((f input)[index]'hindex) frameSpace)) + outerFrameSpace) := + hcomp.outputProbeLatchTM_hoareTimeSpace_internal input index hindex output + houtput extras frameSpace limit hextras hframe hcleanupCounter + hcleanupLimit hlimit controllerTapes outerExtras outerFrameSpace + houterRead houterFrame + +/-- Every numeric output query restores its complete query frame and stores +the selected Boolean as canonical binary zero or one in the reusable cleanup +counter, while preserving every outer serializer tape. -/ +theorem ComputesInSpace.outputProbeLatchTM_index_halts_hoareTimeSpace + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) : + ∃ bit latchTime, + (outputProbeLatchTM tm controllerTapes).HoareTimeSpace + (placeWorkPred (outputProbeLatchInnerTM tm) 0 controllerTapes + outerExtras + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output)) + (outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit) + latchTime input.length + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (outputProbeLatchContinuationSpace bit frameSpace)) + outerFrameSpace) := + hcomp.outputProbeLatchTM_index_halts_hoareTimeSpace_internal input index + output houtput extras frameSpace limit hextras hframe hcleanupCounter + hcleanupLimit hlimit controllerTapes outerExtras outerFrameSpace + houterRead houterFrame + +/-- The latched query is one-way-output safe. -/ +theorem outputProbeLatchTM_isTransducer (tm : TM n) (controllerTapes : ℕ) : + (outputProbeLatchTM tm controllerTapes).IsTransducer := + outputProbeLatchTM_isTransducer_internal tm controllerTapes + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeLatch/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeLatch/Defs.lean new file mode 100644 index 00000000..3a9bf5b2 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeLatch/Defs.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeConsume.Defs +import Complexitylib.Models.TuringMachine.Placement.Defs +import Complexitylib.Models.TuringMachine.Registers.RegisterOps +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs + +/-! +# Restartable output probes with a framed bit latch -- definitions + +The consume/reset combinator branches while the captured bit is still in +finite control. This module records that bit in the cleanup counter after the +query-owned tapes have been restored, then places the complete query beside an +arbitrary serializer frame. The cleanup counter is zero before every query and +is therefore a reusable one-bit latch. +-/ + +namespace Complexity + +namespace TM + +/-- The zero continuation leaves the restored query frame unchanged. -/ +def outputProbeLatchZeroTM (n : ℕ) : TM (outputProbeControllerTapes n) := + skipTM + +/-- The one continuation raises the restored zero cleanup counter to one. -/ +def outputProbeLatchOneTM (n : ℕ) : TM (outputProbeControllerTapes n) := + binarySuccTM (outputProbeCleanupCounterIdx n) + +/-- Query one source-output bit, restore the query frame, and retain the bit in +the cleanup counter as canonical binary zero or one. -/ +def outputProbeLatchInnerTM (tm : TM n) : TM (outputProbeControllerTapes n) := + outputProbeConsumeTM tm (outputProbeLatchZeroTM n) + (outputProbeLatchOneTM n) + +/-- Place the latched query before `controllerTapes` arbitrary serializer work +tapes. -/ +def outputProbeLatchTM (tm : TM n) (controllerTapes : ℕ) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + placeWorkTM 0 controllerTapes (outputProbeLatchInnerTM tm) + +/-- Physical location of the reusable bit latch in the placed controller. -/ +def outputProbeLatchIdx (n controllerTapes : ℕ) : + Fin (0 + outputProbeControllerTapes n + controllerTapes) := + placeWorkIdx 0 controllerTapes (outputProbeCleanupCounterIdx n) + +/-- Exact restored inner frame with the queried Boolean stored in the cleanup +counter. -/ +def outputProbeLatchPost (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) : + TapePred (outputProbeControllerTapes n) := + let cleanCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras + fun inp work out => + inp = cleanCfg.input ∧ + (∀ i, i ≠ outputProbeCleanupCounterIdx n → + work i = cleanCfg.work i) ∧ + (work (outputProbeCleanupCounterIdx n)).HasBinaryNat + (if bit then 1 else 0) ∧ + out = output + +/-- Stable outer-frame form of `outputProbeLatchPost`. -/ +def outputProbeLatchFramePost (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) : + TapePred (0 + outputProbeControllerTapes n + controllerTapes) := + placeWorkPred (outputProbeLatchInnerTM tm) 0 controllerTapes outerExtras + (outputProbeLatchPost tm input output extras bit) + +/-- Canonical restored inner query frame with an explicit zero-or-one latch. -/ +def outputProbeLatchInnerFrameCfg (tm : TM n) (input : List Bool) + (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) : + Cfg (outputProbeControllerTapes n) (outputProbeLatchInnerTM tm).Q := + let cleanCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras + { state := (outputProbeLatchInnerTM tm).qstart + input := cleanCfg.input + work := Function.update cleanCfg.work (outputProbeCleanupCounterIdx n) + (outputProbeCounterTape (if bit then 1 else 0)) + output := output } + +/-- Canonical restored query frame placed before arbitrary controller tapes. -/ +def outputProbeLatchFrameCfg (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) : + Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeLatchTM tm controllerTapes).Q := + placeWorkCfg (outputProbeLatchInnerTM tm) 0 controllerTapes outerExtras + (outputProbeLatchInnerFrameCfg tm input output extras bit) + +/-- Auxiliary-space budget of the restored inner query frame. -/ +def outputProbeLatchCleanSpace (frameSpace : ℕ) : ℕ := + max 1 frameSpace + +/-- Continuation-space budget used by the zero and one latch branches. -/ +def outputProbeLatchContinuationSpace (bit : Bool) (frameSpace : ℕ) : ℕ := + if bit then + outputProbeLatchCleanSpace frameSpace + binarySuccTime 0 + else + outputProbeLatchCleanSpace frameSpace + 1 + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeLatch/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeLatch/Internal.lean new file mode 100644 index 00000000..11693f98 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeLatch/Internal.lean @@ -0,0 +1,446 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeConsume +import Complexitylib.Models.TuringMachine.OutputProbeLatch.Defs +import Complexitylib.Models.TuringMachine.Registers.RegisterOps +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Restartable output probes with a framed bit latch -- proof internals +-/ + +namespace Complexity + +namespace TM + +private theorem outputProbeLatch_hasBinaryNat_parked {tape : Tape} + {value : ℕ} (hvalue : tape.HasBinaryNat value) : Parked tape := by + refine ⟨by rw [hvalue.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hvalue.2.2 + +private theorem outputProbeLatchCounter_not_middle (n : ℕ) : + ¬placeWorkInMiddle 0 (n + 2) (outputProbeCleanupCounterIdx n) := by + simp [placeWorkInMiddle, outputProbeCleanupCounterIdx] + +private theorem outputProbeLatchCleanCounter + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (value : ℕ) + (hcounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat value) : + ((outputProbePlacedFrameCfg tm input (outputProbeCounterTape 0) + output extras).work + (outputProbeCleanupCounterIdx n)).HasBinaryNat value := by + rw [outputProbePlacedFrameCfg, placeWorkCfg_work_extra] + exact hcounter + exact outputProbeLatchCounter_not_middle n + +private theorem outputProbeLatchCleanInputParked + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) : + Parked (outputProbePlacedFrameCfg tm input (outputProbeCounterTape 0) + output extras).input := by + simp only [outputProbePlacedFrameCfg, placeWorkCfg_input, + retargetCfgFrame_input, outputProbeStartedCfg] + simpa [Tape.move] using parked_init_input input + +private theorem outputProbeLatchCleanWorkParked + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) : + ∀ i, Parked ((outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work i) := by + intro i + rw [outputProbePlacedFrameCfg] + by_cases hi : placeWorkInMiddle 0 (n + 2) i + · simp only [placeWorkCfg, hi, dite_true] + let coord := placeWorkCoord 0 (n + 2) i hi + by_cases hsource : coord.val < n + 1 + · rw [retargetCfgFrame_work_lt _ _ _ coord (by omega)] + by_cases hsourceWork : coord.val < n + · simp [outputProbeStartedCfg, hsourceWork] + simpa [Tape.move] using parked_init_input ([] : List Bool) + · simp [outputProbeStartedCfg, hsourceWork] + exact outputProbeLatch_hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat 0) + · have hvirtualOutput : coord = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.last, coord] + have hcoord : coord.val < n + 2 := coord.isLt + omega + change Parked + ((tm.outputProbeStartedTM.retargetCfgFrame + (tm.outputProbeStartedCfg input (outputProbeCounterTape 0)) + output).work coord) + rw [hvirtualOutput, retargetCfgFrame_work_last] + simp [outputProbeStartedCfg] + simpa [Tape.move] using parked_init_input ([] : List Bool) + · rw [placeWorkCfg_work_extra] + exact hextras i hi + exact hi + +private theorem outputProbeLatchCleanWithin + (tm : TM n) (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace : ℕ) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) : + Cfg.WithinAuxSpace + (⟨(outputProbeLatchZeroTM n).qstart, + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).input, + (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras).work, + output⟩ : + Cfg (outputProbeControllerTapes n) (outputProbeLatchZeroTM n).Q) + input.length (outputProbeLatchCleanSpace frameSpace) := by + constructor + · intro i + rw [outputProbePlacedFrameCfg] + by_cases hi : placeWorkInMiddle 0 (n + 2) i + · simp only [placeWorkCfg, hi, dite_true] + let coord := placeWorkCoord 0 (n + 2) i hi + have hhead : + ((tm.outputProbeStartedTM.retargetCfgFrame + (tm.outputProbeStartedCfg input (outputProbeCounterTape 0)) + output).work coord).head = 1 := by + by_cases hsource : coord.val < n + 1 + · rw [retargetCfgFrame_work_lt _ _ _ coord hsource] + by_cases hsourceWork : coord.val < n + · simp [outputProbeStartedCfg, hsourceWork, Tape.move] + · simp [outputProbeStartedCfg, + outputProbeCounterTape, Tape.move] + · have hvirtualOutput : coord = Fin.last (n + 1) := by + apply Fin.ext + simp only [Fin.last, coord] + have hcoord : coord.val < n + 2 := coord.isLt + omega + rw [hvirtualOutput, retargetCfgFrame_work_last] + simp [outputProbeStartedCfg, Tape.move] + change + ((tm.outputProbeStartedTM.retargetCfgFrame + (tm.outputProbeStartedCfg input (outputProbeCounterTape 0)) + output).work coord).head ≤ outputProbeLatchCleanSpace frameSpace + rw [hhead] + exact Nat.le_max_left 1 frameSpace + · rw [placeWorkCfg_work_extra] + exact le_trans (hframe i hi) (Nat.le_max_right 1 frameSpace) + exact hi + · have hhead : + (outputProbePlacedFrameCfg tm input (outputProbeCounterTape 0) + output extras).input.head = 1 := by + simp [outputProbePlacedFrameCfg, outputProbeStartedCfg, Tape.move] + rw [hhead] + omega + +theorem outputProbeLatchFramePost_latch_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) : + (work (outputProbeLatchIdx n controllerTapes)).HasBinaryNat + (if bit then 1 else 0) := by + obtain ⟨sourceWork, hsource, hwork⟩ := hpost + rw [hwork, outputProbeLatchIdx, placeWorkCfg_work_middle] + exact hsource.2.2.1 + +theorem outputProbeLatchFrameCfg_post_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) : + outputProbeLatchFramePost tm controllerTapes outerExtras input output + extras bit + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras bit).input + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras bit).work + (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras bit).output := by + refine ⟨(outputProbeLatchInnerFrameCfg tm input output extras bit).work, + ?_, rfl⟩ + refine ⟨rfl, ?_, ?_, rfl⟩ + · intro i hi + simp [outputProbeLatchInnerFrameCfg, Function.update_of_ne hi] + · simp only [outputProbeLatchInnerFrameCfg, Function.update_self] + exact Tape.init_move_right_hasBinaryNat _ + +theorem outputProbeLatchFramePost_eq_frameCfg_internal + (tm : TM n) (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (input : List Bool) (output : Tape) + (extras : Fin (outputProbeControllerTapes n) → Tape) (bit : Bool) + (inp : Tape) + (work : Fin (0 + outputProbeControllerTapes n + controllerTapes) → Tape) + (out : Tape) + (hpost : outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit inp work out) : + inp = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input output + extras bit).input ∧ + work = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras bit).work ∧ + out = (outputProbeLatchFrameCfg tm controllerTapes outerExtras input + output extras bit).output := by + obtain ⟨sourceWork, hsource, hwork⟩ := hpost + let cleanCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras + have hsourceWork : + sourceWork = + (outputProbeLatchInnerFrameCfg tm input output extras bit).work := by + funext i + by_cases hi : i = outputProbeCleanupCounterIdx n + · subst i + rw [hsource.2.2.1.eq_init_move_right] + simp [outputProbeLatchInnerFrameCfg, outputProbeCounterTape] + · simpa [outputProbeLatchInnerFrameCfg, cleanCfg, + Function.update_of_ne hi] using hsource.2.1 i hi + refine ⟨?_, ?_, ?_⟩ + · simpa [outputProbeLatchFrameCfg, outputProbeLatchInnerFrameCfg, cleanCfg] + using hsource.1 + · rw [hwork] + rw [hsourceWork] + funext i + by_cases hi : placeWorkInMiddle 0 (outputProbeControllerTapes n) i + · simp [outputProbeLatchFrameCfg, placeWorkCfg, hi] + · simp [outputProbeLatchFrameCfg, placeWorkCfg, hi] + · simpa [outputProbeLatchFrameCfg, outputProbeLatchInnerFrameCfg, cleanCfg] + using hsource.2.2.2 + +theorem ComputesInSpace.outputProbeLatchTM_hoareTimeSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) (hindex : index < (f input).length) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) : + ∃ latchTime, + (outputProbeLatchTM tm controllerTapes).HoareTimeSpace + (placeWorkPred (outputProbeLatchInnerTM tm) 0 controllerTapes + outerExtras + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output)) + (outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras ((f input)[index]'hindex)) + latchTime input.length + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (outputProbeLatchContinuationSpace + ((f input)[index]'hindex) frameSpace)) + outerFrameSpace) := by + let cleanCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras + let cleanSpace := outputProbeLatchCleanSpace frameSpace + have hinputParked : Parked cleanCfg.input := by + exact outputProbeLatchCleanInputParked tm input output extras + have hworkParked : ∀ i, Parked (cleanCfg.work i) := by + exact outputProbeLatchCleanWorkParked tm input output extras hextras + have hcounter : + (cleanCfg.work (outputProbeCleanupCounterIdx n)).HasBinaryNat 0 := by + exact outputProbeLatchCleanCounter tm input output extras 0 hcleanupCounter + have hwithin : + Cfg.WithinAuxSpace + (⟨(outputProbeLatchZeroTM n).qstart, cleanCfg.input, + cleanCfg.work, output⟩ : + Cfg (outputProbeControllerTapes n) (outputProbeLatchZeroTM n).Q) + input.length cleanSpace := by + exact outputProbeLatchCleanWithin tm input output extras frameSpace hframe + have hzeroTime := skipTM_hoareTime_frame cleanCfg.input cleanCfg.work output + hinputParked hworkParked houtput + have hzeroBase := hzeroTime.toHoareTimeSpace (inputLength := input.length) + (initialSpace := cleanSpace) (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact hwithin) + have hzero : (outputProbeLatchZeroTM n).HoareTimeSpace + (fun inp work out => + inp = cleanCfg.input ∧ work = cleanCfg.work ∧ out = output) + (outputProbeLatchPost tm input output extras false) + 1 input.length (cleanSpace + 1) := by + apply hzeroBase.consequence (fun _ _ _ h => h) _ le_rfl le_rfl le_rfl + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨rfl, fun _ _ => rfl, by simpa using hcounter, rfl⟩ + have hwithinOne : + Cfg.WithinAuxSpace + (⟨(outputProbeLatchOneTM n).qstart, cleanCfg.input, + cleanCfg.work, output⟩ : + Cfg (outputProbeControllerTapes n) (outputProbeLatchOneTM n).Q) + input.length cleanSpace := by + simpa [outputProbeLatchZeroTM, outputProbeLatchOneTM] using hwithin + have honeBase := binarySuccTM_hoareTimeSpace_frame + (outputProbeCleanupCounterIdx n) 0 input.length cleanSpace + cleanCfg.input cleanCfg.work output hcounter hinputParked.read_ne_start + (fun i _ => (hworkParked i).read_ne_start) houtput.read_ne_start + hwithinOne + have hone : (outputProbeLatchOneTM n).HoareTimeSpace + (fun inp work out => + inp = cleanCfg.input ∧ work = cleanCfg.work ∧ out = output) + (outputProbeLatchPost tm input output extras true) + (binarySuccTime 0) input.length (cleanSpace + binarySuccTime 0) := by + apply honeBase.consequence (fun _ _ _ h => h) _ le_rfl le_rfl le_rfl + rintro inp work out ⟨rfl, hother, hone, rfl⟩ + exact ⟨rfl, hother, by simpa using hone, rfl⟩ + obtain ⟨latchTime, hlatch⟩ := + hcomp.outputProbeConsumeTM_hoareTimeSpace_frame + (outputProbeLatchZeroTM n) (outputProbeLatchOneTM n) + input index hindex output houtput extras frameSpace limit hextras hframe + hcleanupCounter hcleanupLimit hlimit hzero hone controllerTapes + outerExtras outerFrameSpace houterRead houterFrame + refine ⟨latchTime, ?_⟩ + simpa [outputProbeLatchTM, outputProbeLatchInnerTM, + outputProbeLatchFramePost, outputProbeLatchContinuationSpace, + cleanSpace] using hlatch + +theorem + ComputesInSpace.outputProbeLatchTM_index_halts_hoareTimeSpace_internal + {tm : TM n} {f : List Bool → List Bool} {space : ℕ → ℕ} + (hcomp : tm.ComputesInSpace f space) + (input : List Bool) (index : ℕ) + (output : Tape) (houtput : Parked output) + (extras : Fin (outputProbeControllerTapes n) → Tape) + (frameSpace limit : ℕ) + (hextras : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → Parked (extras i)) + (hframe : ∀ i, ¬placeWorkInMiddle 0 (n + 2) i → + (extras i).head ≤ frameSpace) + (hcleanupCounter : + (extras (outputProbeCleanupCounterIdx n)).HasBinaryNat 0) + (hcleanupLimit : + (extras (outputProbeCleanupLimitIdx n)).HasBinaryNat limit) + (hlimit : outputProbeCaptureSpace (max 1 (space input.length)) + (index + 1) ≤ limit) + (controllerTapes : ℕ) + (outerExtras : Fin (0 + outputProbeControllerTapes n + + controllerTapes) → Tape) + (outerFrameSpace : ℕ) + (houterRead : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).read ≠ Γ.start) + (houterFrame : ∀ i, + ¬placeWorkInMiddle 0 (outputProbeControllerTapes n) i → + (outerExtras i).head ≤ outerFrameSpace) : + ∃ bit latchTime, + (outputProbeLatchTM tm controllerTapes).HoareTimeSpace + (placeWorkPred (outputProbeLatchInnerTM tm) 0 controllerTapes + outerExtras + (fun inp work out => + inp = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).input ∧ + work = (outputProbePlacedFrameCfg tm input + (outputProbeCounterTape (index + 1)) output extras).work ∧ + out = output)) + (outputProbeLatchFramePost tm controllerTapes outerExtras input + output extras bit) + latchTime input.length + (max + (outputProbeConsumeSpace n (max 1 (space input.length)) index + frameSpace limit + (outputProbeLatchContinuationSpace bit frameSpace)) + outerFrameSpace) := by + let cleanCfg := outputProbePlacedFrameCfg tm input + (outputProbeCounterTape 0) output extras + let cleanSpace := outputProbeLatchCleanSpace frameSpace + have hinputParked : Parked cleanCfg.input := by + exact outputProbeLatchCleanInputParked tm input output extras + have hworkParked : ∀ i, Parked (cleanCfg.work i) := by + exact outputProbeLatchCleanWorkParked tm input output extras hextras + have hcounter : + (cleanCfg.work (outputProbeCleanupCounterIdx n)).HasBinaryNat 0 := by + exact outputProbeLatchCleanCounter tm input output extras 0 hcleanupCounter + have hwithin : + Cfg.WithinAuxSpace + (⟨(outputProbeLatchZeroTM n).qstart, cleanCfg.input, + cleanCfg.work, output⟩ : + Cfg (outputProbeControllerTapes n) (outputProbeLatchZeroTM n).Q) + input.length cleanSpace := by + exact outputProbeLatchCleanWithin tm input output extras frameSpace hframe + have hzeroTime := skipTM_hoareTime_frame cleanCfg.input cleanCfg.work output + hinputParked hworkParked houtput + have hzeroBase := hzeroTime.toHoareTimeSpace (inputLength := input.length) + (initialSpace := cleanSpace) (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact hwithin) + have hzero : (outputProbeLatchZeroTM n).HoareTimeSpace + (fun inp work out => + inp = cleanCfg.input ∧ work = cleanCfg.work ∧ out = output) + (outputProbeLatchPost tm input output extras false) + 1 input.length (cleanSpace + 1) := by + apply hzeroBase.consequence (fun _ _ _ h => h) _ le_rfl le_rfl le_rfl + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨rfl, fun _ _ => rfl, by simpa using hcounter, rfl⟩ + have hwithinOne : + Cfg.WithinAuxSpace + (⟨(outputProbeLatchOneTM n).qstart, cleanCfg.input, + cleanCfg.work, output⟩ : + Cfg (outputProbeControllerTapes n) (outputProbeLatchOneTM n).Q) + input.length cleanSpace := by + simpa [outputProbeLatchZeroTM, outputProbeLatchOneTM] using hwithin + have honeBase := binarySuccTM_hoareTimeSpace_frame + (outputProbeCleanupCounterIdx n) 0 input.length cleanSpace + cleanCfg.input cleanCfg.work output hcounter hinputParked.read_ne_start + (fun i _ => (hworkParked i).read_ne_start) houtput.read_ne_start + hwithinOne + have hone : (outputProbeLatchOneTM n).HoareTimeSpace + (fun inp work out => + inp = cleanCfg.input ∧ work = cleanCfg.work ∧ out = output) + (outputProbeLatchPost tm input output extras true) + (binarySuccTime 0) input.length (cleanSpace + binarySuccTime 0) := by + apply honeBase.consequence (fun _ _ _ h => h) _ le_rfl le_rfl le_rfl + rintro inp work out ⟨rfl, hother, hone, rfl⟩ + exact ⟨rfl, hother, by simpa using hone, rfl⟩ + obtain ⟨bit, latchTime, hlatch⟩ := + hcomp.outputProbeConsumeTM_index_halts_hoareTimeSpace_frame_internal + (outputProbeLatchZeroTM n) (outputProbeLatchOneTM n) + input index output houtput extras frameSpace limit hextras hframe + hcleanupCounter hcleanupLimit hlimit hzero hone controllerTapes + outerExtras outerFrameSpace houterRead houterFrame + refine ⟨bit, latchTime, ?_⟩ + simpa [outputProbeLatchTM, outputProbeLatchInnerTM, + outputProbeLatchFramePost, outputProbeLatchContinuationSpace, + cleanSpace] using hlatch + +theorem outputProbeLatchTM_isTransducer_internal + (tm : TM n) (controllerTapes : ℕ) : + (outputProbeLatchTM tm controllerTapes).IsTransducer := by + have hzero : (outputProbeLatchZeroTM n).IsTransducer := by + intro state inputHead workHeads outputHead + cases state <;> cases outputHead <;> + simp [outputProbeLatchZeroTM, skipTM, idleDir] + have hone : (outputProbeLatchOneTM n).IsTransducer := by + exact binarySuccTM_isTransducer (outputProbeCleanupCounterIdx n) + exact (hzero.outputProbeConsumeTM hone).placeWorkTM 0 controllerTapes + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeScan.lean b/Complexitylib/Models/TuringMachine/OutputProbeScan.lean new file mode 100644 index 00000000..d28e467e --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeScan.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeScan.Defs +import Complexitylib.Models.TuringMachine.OutputProbeScan.Internal + +/-! +# Bounded scans through dynamically indexed output probes + +`outputProbeScanTM` is the concrete loop boundary used by output-oracle +controllers. It scans a binary address register up to a preserved binary +limit, queries the corresponding source-output bit on every iteration, resets +the query latch, and delegates the bit-specific update to two continuations. +-/ + +namespace Complexity + +namespace TM + +/-- Distinct controller-local address and limit registers remain distinct +after embedding behind the complete output-probe frame. -/ +theorem outputProbeScan_address_ne_limit + (n : ℕ) {controllerTapes : ℕ} + {addressIdx limitIdx : Fin controllerTapes} + (hne : addressIdx ≠ limitIdx) : + outputProbeIndexedControllerIdx n addressIdx ≠ + outputProbeIndexedControllerIdx n limitIdx := + outputProbeScan_address_ne_limit_internal n hne + +/-- A bounded segment certificate for the probe body executes the concrete +indexed scan through the standard recursive loop bound. -/ +theorem outputProbeScanTM_reachesIn + {tm : TM n} {controllerTapes : ℕ} + {addressIdx scratchIdx limitIdx : Fin controllerTapes} + {onZero onOne : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + {bodyTime : ℕ → ℕ} {startValue limitValue : ℕ} + (spec : BinaryForSegmentSpec + (outputProbeIndexedResetDispatchTM tm controllerTapes addressIdx + scratchIdx onZero onOne) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue) + (count value : ℕ) (hstart : startValue ≤ value) + (hlimit : value + count = limitValue) : + ∃ time, time ≤ binaryForLoopTime bodyTime limitValue value count ∧ + (outputProbeScanTM tm controllerTapes addressIdx scratchIdx limitIdx + onZero onOne).reachesIn time (spec.scanCfg value) spec.doneCfg := + outputProbeScanTM_reachesIn_internal spec count value hstart hlimit + +/-- Phase-local comparison and probe-body bounds cover every reachable prefix +of the concrete indexed scan. -/ +theorem outputProbeScanTM_prefix_withinAuxSpace + {tm : TM n} {controllerTapes : ℕ} + {addressIdx scratchIdx limitIdx : Fin controllerTapes} + {onZero onOne : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + {bodyTime : ℕ → ℕ} {startValue limitValue : ℕ} + {spec : BinaryForSegmentSpec + (outputProbeIndexedResetDispatchTM tm controllerTapes addressIdx + scratchIdx onZero onOne) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue} + {inputLength spaceBound : ℕ} + (spaceSpec : BinaryForSegmentSpaceSpec spec inputLength spaceBound) + (count value time : ℕ) + (cfg : Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeScanTM tm controllerTapes addressIdx scratchIdx limitIdx + onZero onOne).Q) + (hstart : startValue ≤ value) + (hlimit : value + count = limitValue) + (hreach : + (outputProbeScanTM tm controllerTapes addressIdx scratchIdx limitIdx + onZero onOne).reachesIn time (spec.scanCfg value) cfg) + (htime : time ≤ + binaryForLoopTime bodyTime limitValue value count) : + cfg.WithinAuxSpace inputLength spaceBound := + outputProbeScanTM_prefix_withinAuxSpace_internal spaceSpec count value time + cfg hstart hlimit hreach htime + +/-- The bounded indexed-probe scan preserves one-way output safety whenever +both selected controller updates do. -/ +theorem IsTransducer.outputProbeScanTM + {tm : TM n} {controllerTapes : ℕ} + {addressIdx scratchIdx limitIdx : Fin controllerTapes} + {onZero onOne : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeScanTM tm controllerTapes addressIdx scratchIdx limitIdx + onZero onOne).IsTransducer := + hzero.outputProbeScanTM_internal hone + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeScan/Defs.lean b/Complexitylib/Models/TuringMachine/OutputProbeScan/Defs.lean new file mode 100644 index 00000000..d69b046b --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeScan/Defs.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDispatch.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs + +/-! +# Bounded scans through dynamically indexed output probes -- definitions + +This module wires the restartable indexed-probe body into the canonical binary +count-up loop. At each address strictly below the preserved limit, the body +queries one source-output bit, resets the physical latch to canonical zero, +and runs the selected controller continuation. The loop then increments the +address register and repeats. + +Correctness clients require both continuations to preserve the address and +limit registers. They may update other controller registers or append output. +-/ + +namespace Complexity + +namespace TM + +/-- Scan consecutive source-output addresses stored in a controller register. + +The controller-local `addressIdx` and `limitIdx` are embedded after the full +probe frame. `scratchIdx` is the canonical zero register used to prepare each +dynamic query. -/ +def outputProbeScanTM (tm : TM n) (controllerTapes : ℕ) + (addressIdx scratchIdx limitIdx : Fin controllerTapes) + (onZero onOne : TM (0 + outputProbeControllerTapes n + controllerTapes)) : + TM (0 + outputProbeControllerTapes n + controllerTapes) := + binaryForTM + (outputProbeIndexedResetDispatchTM tm controllerTapes addressIdx + scratchIdx onZero onOne) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/OutputProbeScan/Internal.lean b/Complexitylib/Models/TuringMachine/OutputProbeScan/Internal.lean new file mode 100644 index 00000000..de1581e1 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/OutputProbeScan/Internal.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.OutputProbeDispatch.Internal +import Complexitylib.Models.TuringMachine.OutputProbeIndexed.Internal +import Complexitylib.Models.TuringMachine.OutputProbeScan.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal + +/-! +# Bounded scans through dynamically indexed output probes -- proof internals +-/ + +namespace Complexity + +namespace TM + +theorem outputProbeScan_address_ne_limit_internal + (n : ℕ) {controllerTapes : ℕ} + {addressIdx limitIdx : Fin controllerTapes} + (hne : addressIdx ≠ limitIdx) : + outputProbeIndexedControllerIdx n addressIdx ≠ + outputProbeIndexedControllerIdx n limitIdx := by + intro heq + exact hne (outputProbeIndexedControllerIdx_injective_internal n heq) + +theorem outputProbeScanTM_reachesIn_internal + {tm : TM n} {controllerTapes : ℕ} + {addressIdx scratchIdx limitIdx : Fin controllerTapes} + {onZero onOne : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + {bodyTime : ℕ → ℕ} {startValue limitValue : ℕ} + (spec : BinaryForSegmentSpec + (outputProbeIndexedResetDispatchTM tm controllerTapes addressIdx + scratchIdx onZero onOne) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue) + (count value : ℕ) (hstart : startValue ≤ value) + (hlimit : value + count = limitValue) : + ∃ time, time ≤ binaryForLoopTime bodyTime limitValue value count ∧ + (outputProbeScanTM tm controllerTapes addressIdx scratchIdx limitIdx + onZero onOne).reachesIn time (spec.scanCfg value) spec.doneCfg := by + simpa only [outputProbeScanTM] using + spec.reachesIn_internal count value hstart hlimit + +theorem outputProbeScanTM_prefix_withinAuxSpace_internal + {tm : TM n} {controllerTapes : ℕ} + {addressIdx scratchIdx limitIdx : Fin controllerTapes} + {onZero onOne : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + {bodyTime : ℕ → ℕ} {startValue limitValue : ℕ} + {spec : BinaryForSegmentSpec + (outputProbeIndexedResetDispatchTM tm controllerTapes addressIdx + scratchIdx onZero onOne) + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + bodyTime startValue limitValue} + {inputLength spaceBound : ℕ} + (spaceSpec : BinaryForSegmentSpaceSpec spec inputLength spaceBound) + (count value time : ℕ) + (cfg : Cfg (0 + outputProbeControllerTapes n + controllerTapes) + (outputProbeScanTM tm controllerTapes addressIdx scratchIdx limitIdx + onZero onOne).Q) + (hstart : startValue ≤ value) + (hlimit : value + count = limitValue) + (hreach : + (outputProbeScanTM tm controllerTapes addressIdx scratchIdx limitIdx + onZero onOne).reachesIn time (spec.scanCfg value) cfg) + (htime : time ≤ + binaryForLoopTime bodyTime limitValue value count) : + cfg.WithinAuxSpace inputLength spaceBound := by + exact spaceSpec.prefix_withinAuxSpace_internal count value time cfg hstart + hlimit hreach htime + +theorem IsTransducer.outputProbeScanTM_internal + {tm : TM n} {controllerTapes : ℕ} + {addressIdx scratchIdx limitIdx : Fin controllerTapes} + {onZero onOne : + TM (0 + outputProbeControllerTapes n + controllerTapes)} + (hzero : onZero.IsTransducer) (hone : onOne.IsTransducer) : + (outputProbeScanTM tm controllerTapes addressIdx scratchIdx limitIdx + onZero onOne).IsTransducer := by + unfold outputProbeScanTM + exact (hzero.outputProbeIndexedResetDispatchTM_internal hone) + |>.binaryForTM_internal + (outputProbeIndexedControllerIdx n addressIdx) + (outputProbeIndexedControllerIdx n limitIdx) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Placement.lean b/Complexitylib/Models/TuringMachine/Placement.lean index c7de471f..aa311697 100644 --- a/Complexitylib/Models/TuringMachine/Placement.lean +++ b/Complexitylib/Models/TuringMachine/Placement.lean @@ -18,6 +18,8 @@ are parked away from the left-end marker. - `TM.placeWorkTM_step_placeWorkCfg` — exact step with an evolving frame - `TM.placeWorkTM_reachesIn_placeWorkCfg_stable` — exact stable-frame simulation +- `TM.placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace` — stable-frame + simulation preserving all-prefix space bounds - `TM.placeWorkTM_reachesIn_placeWorkParkedCfg` — canonical parked simulation - `TM.placeWorkTM_computesInTime` — same-time preservation of computation -/ @@ -28,6 +30,17 @@ namespace TM variable {n : ℕ} +/-- Updating one physical tape in a placed machine's middle block is exactly +the placement of the corresponding source-work update. -/ +theorem placeWorkCfg_work_update (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) + (idx : Fin n) (tape : Tape) : + Function.update (placeWorkCfg tm pre post extras c).work + (placeWorkIdx pre post idx) tape = + (placeWorkCfg tm pre post extras + { c with work := Function.update c.work idx tape }).work := + placeWorkCfg_work_update_internal tm pre post extras c idx tape + /-- A placed step simulates one source step while applying the prescribed idle action to the arbitrary physical extra-tape frame. -/ theorem placeWorkTM_step_placeWorkCfg (tm : TM n) (pre post : ℕ) @@ -70,6 +83,48 @@ theorem placeWorkTM_reachesIn_placeWorkCfg_stable (tm : TM n) (placeWorkCfg tm pre post extras c') := placeWorkTM_reachesIn_placeWorkCfg_stable_internal tm pre post extras hreach hextra +/-- A stable placement preserves an all-prefix source-space certificate while +charging the surrounding controller frame only for its largest head. -/ +theorem placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace + (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) + {t inputLength sourceSpace frameSpace : ℕ} {c c' : Cfg n tm.Q} + (hreach : tm.reachesIn t c c') + (hextra : ∀ i, ¬placeWorkInMiddle pre n i → (extras i).read ≠ Γ.start) + (hsource : ∀ elapsed cfg, elapsed ≤ t → + tm.reachesIn elapsed c cfg → + cfg.WithinAuxSpace inputLength sourceSpace) + (hframe : ∀ i, ¬placeWorkInMiddle pre n i → + (extras i).head ≤ frameSpace) : + (placeWorkTM pre post tm).reachesIn t + (placeWorkCfg tm pre post extras c) + (placeWorkCfg tm pre post extras c') ∧ + ∀ elapsed cfg, elapsed ≤ t → + (placeWorkTM pre post tm).reachesIn elapsed + (placeWorkCfg tm pre post extras c) cfg → + cfg.WithinAuxSpace inputLength (max sourceSpace frameSpace) := + placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace_internal + tm pre post extras hreach hextra hsource hframe + +/-- A stable placed frame lifts a source time-and-space Hoare contract with +the same time bound and the maximum of the source and frame space bounds. -/ +theorem placeWorkTM_hoareTimeSpace_frame (tm : TM n) + (pre post : ℕ) (extras : Fin (pre + n + post) → Tape) + {sourcePre sourcePost : TapePred n} + {time inputLength sourceSpace frameSpace : ℕ} + (hsource : tm.HoareTimeSpace sourcePre sourcePost time inputLength + sourceSpace) + (hextras : ∀ i, ¬placeWorkInMiddle pre n i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre n i → + (extras i).head ≤ frameSpace) : + (placeWorkTM pre post tm).HoareTimeSpace + (placeWorkPred tm pre post extras sourcePre) + (placeWorkPred tm pre post extras sourcePost) + time inputLength (max sourceSpace frameSpace) := + placeWorkTM_hoareTimeSpace_frame_internal tm pre post extras hsource + hextras hframe + /-- Start-invariant positive-head extras remain an exact frame throughout a bounded source run. -/ theorem placeWorkTM_reachesIn_placeWorkCfg_of_startInvariant (tm : TM n) @@ -130,6 +185,12 @@ theorem placeWorkTM_computesInTime (tm : TM n) (pre post : ℕ) (placeWorkTM pre post tm).ComputesInTime f T := placeWorkTM_computesInTime_internal tm pre post hcomp +/-- Work-tape placement leaves the source output action unchanged. -/ +theorem IsTransducer.placeWorkTM {tm : TM n} (htrans : tm.IsTransducer) + (pre post : ℕ) : + (placeWorkTM pre post tm).IsTransducer := + htrans.placeWorkTM_internal pre post + end TM end Complexity diff --git a/Complexitylib/Models/TuringMachine/Placement/Defs.lean b/Complexitylib/Models/TuringMachine/Placement/Defs.lean index b1da0875..432c92db 100644 --- a/Complexitylib/Models/TuringMachine/Placement/Defs.lean +++ b/Complexitylib/Models/TuringMachine/Placement/Defs.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Samuel Schlesinger -/ import Complexitylib.Models.TuringMachine.Combinators +import Complexitylib.Models.TuringMachine.Hoare.Space.Defs /-! # Work-tape placement @@ -124,6 +125,20 @@ def placeWorkCfg (tm : TM n) (pre post : ℕ) else extras i output := c.output +/-- Lift a tape predicate into a stable placed-work frame. The source input and +output remain physical input and output tapes; only the source work vector is +embedded into the middle block. -/ +def placeWorkPred (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (predicate : TapePred n) : + TapePred (pre + n + post) := + fun inp work out => + ∃ sourceWork, predicate inp sourceWork out ∧ + work = (placeWorkCfg tm pre post extras + { state := tm.qstart, + input := inp, + work := sourceWork, + output := out }).work + /-- Apply the placement machine's idle work-tape action to an extra-tape frame. Only values outside the middle block are observable through `placeWorkCfg`. -/ def placeWorkFrameStep {pre n post : ℕ} diff --git a/Complexitylib/Models/TuringMachine/Placement/Internal.lean b/Complexitylib/Models/TuringMachine/Placement/Internal.lean index 989aad48..7e4bd4bb 100644 --- a/Complexitylib/Models/TuringMachine/Placement/Internal.lean +++ b/Complexitylib/Models/TuringMachine/Placement/Internal.lean @@ -5,6 +5,7 @@ Authors: Samuel Schlesinger -/ import Complexitylib.Models.TuringMachine.Placement.Defs import Complexitylib.Models.TuringMachine.Internal +import Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability /-! # Work-tape placement correctness internals @@ -19,6 +20,30 @@ namespace Complexity namespace TM +theorem placeWorkCfg_work_update_internal (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) + (idx : Fin n) (tape : Tape) : + Function.update (placeWorkCfg tm pre post extras c).work + (placeWorkIdx pre post idx) tape = + (placeWorkCfg tm pre post extras + { c with work := Function.update c.work idx tape }).work := by + funext i + by_cases hphysical : i = placeWorkIdx pre post idx + · subst i + simp + · rw [Function.update_of_ne hphysical] + by_cases hmiddle : placeWorkInMiddle pre n i + · dsimp only [placeWorkCfg] + simp only [hmiddle, dite_true] + rw [Function.update_of_ne] + intro hcoord + apply hphysical + rw [← hcoord] + exact (placeWorkIdx_placeWorkCoord i hmiddle).symm + · rw [placeWorkCfg_work_extra tm pre post extras c i hmiddle] + rw [placeWorkCfg_work_extra tm pre post extras + { c with work := Function.update c.work idx tape } i hmiddle] + variable {n pre post : ℕ} /-- The idle extra-tape action is the identity away from the left-end marker. -/ @@ -118,6 +143,55 @@ theorem placeWorkTM_reachesIn_placeWorkCfg_stable_internal (tm : TM n) hstep] rfl) ih +/-- An all-prefix source-space certificate lifts through a stable placement. +The placed source tapes use `sourceSpace`; the preserved surrounding frame +uses `frameSpace`, so the combined machine uses their maximum. -/ +theorem placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace_internal + (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) + {t inputLength sourceSpace frameSpace : ℕ} {c c' : Cfg n tm.Q} + (hreach : tm.reachesIn t c c') + (hextra : ∀ i, ¬placeWorkInMiddle pre n i → (extras i).read ≠ Γ.start) + (hsource : ∀ elapsed cfg, elapsed ≤ t → + tm.reachesIn elapsed c cfg → + cfg.WithinAuxSpace inputLength sourceSpace) + (hframe : ∀ i, ¬placeWorkInMiddle pre n i → + (extras i).head ≤ frameSpace) : + (placeWorkTM pre post tm).reachesIn t + (placeWorkCfg tm pre post extras c) + (placeWorkCfg tm pre post extras c') ∧ + ∀ elapsed cfg, elapsed ≤ t → + (placeWorkTM pre post tm).reachesIn elapsed + (placeWorkCfg tm pre post extras c) cfg → + cfg.WithinAuxSpace inputLength (max sourceSpace frameSpace) := by + refine ⟨placeWorkTM_reachesIn_placeWorkCfg_stable_internal + tm pre post extras hreach hextra, ?_⟩ + intro elapsed cfg helapsed hplaced + have hlength : elapsed + (t - elapsed) = t := + Nat.add_sub_of_le helapsed + rw [← hlength] at hreach + obtain ⟨sourceMid, hsourceMid, _hsourceRest⟩ := + reachesIn_split_internal hreach + have hplacedMid := placeWorkTM_reachesIn_placeWorkCfg_stable_internal + tm pre post extras hsourceMid hextra + have hcfg : cfg = placeWorkCfg tm pre post extras sourceMid := + (placeWorkTM pre post tm).reachesIn_right_unique hplaced hplacedMid + subst cfg + have hmidBound := hsource elapsed sourceMid helapsed hsourceMid + constructor + · intro i + by_cases hmid : placeWorkInMiddle pre n i + · let j := placeWorkCoord pre n i hmid + have hindex : placeWorkIdx pre post j = i := + placeWorkIdx_placeWorkCoord i hmid + rw [← hindex, placeWorkCfg_work_middle] + exact le_trans (hmidBound.1 j) (le_max_left _ _) + · rw [placeWorkCfg_work_extra tm pre post extras sourceMid i hmid] + exact le_trans (hframe i hmid) (le_max_right _ _) + · exact le_trans hmidBound.2 (by + have := le_max_left sourceSpace frameSpace + omega) + /-- The canonical parked frame is fixed by a placed source step. -/ theorem placeWorkTM_step_placeWorkParkedCfg_internal (tm : TM n) (pre post : ℕ) (c : Cfg n tm.Q) : @@ -202,6 +276,76 @@ theorem placeWorkTM_computesInTime_internal (tm : TM n) (pre post : ℕ) · rw [houtput] exact hout +/-- A stable placed frame lifts a source time-and-space Hoare contract without +time overhead and charges only the maximum source/frame space. -/ +theorem placeWorkTM_hoareTimeSpace_frame_internal (tm : TM n) + (pre post : ℕ) (extras : Fin (pre + n + post) → Tape) + {sourcePre sourcePost : TapePred n} + {time inputLength sourceSpace frameSpace : ℕ} + (hsource : tm.HoareTimeSpace sourcePre sourcePost time inputLength + sourceSpace) + (hextras : ∀ i, ¬placeWorkInMiddle pre n i → + (extras i).read ≠ Γ.start) + (hframe : ∀ i, ¬placeWorkInMiddle pre n i → + (extras i).head ≤ frameSpace) : + (placeWorkTM pre post tm).HoareTimeSpace + (placeWorkPred tm pre post extras sourcePre) + (placeWorkPred tm pre post extras sourcePost) + time inputLength (max sourceSpace frameSpace) := by + constructor + · rintro inp work out ⟨sourceWork, hpre, rfl⟩ + obtain ⟨done, elapsed, helapsed, hreach, hhalt, hpost⟩ := + hsource.1 inp sourceWork out hpre + let sourceStart : Cfg n tm.Q := + { state := tm.qstart, + input := inp, + work := sourceWork, + output := out } + let placedDone := placeWorkCfg tm pre post extras done + have hplaced : (placeWorkTM pre post tm).reachesIn elapsed + (placeWorkCfg tm pre post extras sourceStart) placedDone := by + exact placeWorkTM_reachesIn_placeWorkCfg_stable_internal tm pre post + extras hreach hextras + refine ⟨placedDone, elapsed, helapsed, ?_, ?_, ?_⟩ + · simpa only [sourceStart] using hplaced + · exact hhalt + · refine ⟨done.work, ?_, rfl⟩ + simpa only [placedDone, placeWorkCfg_input, placeWorkCfg_output] using + hpost + · rintro inp work out ⟨sourceWork, hpre, rfl⟩ current hcurrent + obtain ⟨done, elapsed, _helapsed, hreach, hhalt, _hpost⟩ := + hsource.1 inp sourceWork out hpre + let sourceStart : Cfg n tm.Q := + { state := tm.qstart, + input := inp, + work := sourceWork, + output := out } + have hsourcePrefix : ∀ steps cfg, steps ≤ elapsed → + tm.reachesIn steps sourceStart cfg → + cfg.WithinAuxSpace inputLength sourceSpace := by + intro steps cfg _hsteps hprefix + exact hsource.2 inp sourceWork out hpre cfg + (tm.reaches_of_reachesIn hprefix) + have hplaced := + placeWorkTM_reachesIn_placeWorkCfg_stable_withinAuxSpace_internal + tm pre post extras hreach hextras hsourcePrefix hframe + obtain ⟨currentTime, hcurrentRun⟩ := + (placeWorkTM pre post tm).reaches_to_reachesIn hcurrent + have hdoneHalted : (placeWorkTM pre post tm).halted + (placeWorkCfg tm pre post extras done) := + hhalt + have hcurrentTime : currentTime ≤ elapsed := + (placeWorkTM pre post tm).reachesIn_le_halt hcurrentRun hplaced.1 + hdoneHalted + exact hplaced.2 currentTime current hcurrentTime hcurrentRun + +theorem IsTransducer.placeWorkTM_internal {tm : TM n} + (htrans : tm.IsTransducer) (pre post : ℕ) : + (placeWorkTM pre post tm).IsTransducer := by + intro state inputHead workHeads outputHead + simpa only [placeWorkTM] using htrans state inputHead + (fun i => workHeads (placeWorkIdx pre post i)) outputHead + end TM end Complexity diff --git a/Complexitylib/Models/TuringMachine/RetargetOutputFrame.lean b/Complexitylib/Models/TuringMachine/RetargetOutputFrame.lean new file mode 100644 index 00000000..b4e7c2b5 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/RetargetOutputFrame.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.RetargetOutputFrame.Internal + +/-! +# Output-retargeting frames + +These lemmas let a retargeted machine carry an arbitrary parked real-output +accumulator while its virtual output evolves on the fresh final work tape. +-/ + +namespace Complexity + +namespace TM + +@[simp] theorem retargetCfgFrame_state (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + (tm.retargetCfgFrame cfg output).state = cfg.state := + retargetCfgFrame_state_internal tm cfg output + +@[simp] theorem retargetCfgFrame_input (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + (tm.retargetCfgFrame cfg output).input = cfg.input := + retargetCfgFrame_input_internal tm cfg output + +@[simp] theorem retargetCfgFrame_output (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + (tm.retargetCfgFrame cfg output).output = output := + retargetCfgFrame_output_internal tm cfg output + +theorem retargetCfgFrame_work_lt (tm : TM n) (cfg : Cfg n tm.Q) + (output : Tape) (i : Fin (n + 1)) (hi : i.val < n) : + (tm.retargetCfgFrame cfg output).work i = cfg.work ⟨i.val, hi⟩ := + retargetCfgFrame_work_lt_internal tm cfg output i hi + +theorem retargetCfgFrame_work_last (tm : TM n) (cfg : Cfg n tm.Q) + (output : Tape) : + (tm.retargetCfgFrame cfg output).work (Fin.last n) = cfg.output := + retargetCfgFrame_work_last_internal tm cfg output + +/-- A parked real output is a literal frame for one retargeted step. -/ +theorem retargetOutput_step_retargetCfgFrame (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) (houtput : Parked output) : + tm.retargetOutput.step (tm.retargetCfgFrame cfg output) = + (tm.step cfg).map fun next => tm.retargetCfgFrame next output := + retargetOutput_step_retargetCfgFrame_internal tm cfg output houtput + +/-- A parked real output remains literally fixed throughout a retargeted run. -/ +theorem retargetOutput_reachesIn_retargetCfgFrame (tm : TM n) + (output : Tape) (houtput : Parked output) {steps : ℕ} + {start done : Cfg n tm.Q} (hreach : tm.reachesIn steps start done) : + tm.retargetOutput.reachesIn steps + (tm.retargetCfgFrame start output) (tm.retargetCfgFrame done output) := + retargetOutput_reachesIn_retargetCfgFrame_internal tm output houtput hreach + +/-- Retargeting preserves a source all-prefix auxiliary-space certificate when +the source's final virtual-output head fits in that same budget. -/ +theorem IsTransducer.retargetOutput_reachesIn_retargetCfgFrame_withinAuxSpace + {tm : TM n} (htrans : tm.IsTransducer) + (output : Tape) (houtput : Parked output) + {steps inputLength space : ℕ} {start done : Cfg n tm.Q} + (hreach : tm.reachesIn steps start done) + (hprefix : ∀ elapsed cfg, elapsed ≤ steps → + tm.reachesIn elapsed start cfg → + cfg.WithinAuxSpace inputLength space) + (hdoneOutput : done.output.head ≤ space) : + tm.retargetOutput.reachesIn steps + (tm.retargetCfgFrame start output) + (tm.retargetCfgFrame done output) ∧ + ∀ elapsed cfg, elapsed ≤ steps → + tm.retargetOutput.reachesIn elapsed + (tm.retargetCfgFrame start output) cfg → + cfg.WithinAuxSpace inputLength space := + htrans.retargetOutput_reachesIn_retargetCfgFrame_withinAuxSpace_internal + output houtput hreach hprefix hdoneOutput + +@[simp] theorem retargetOutput_halted_retargetCfgFrame (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + tm.retargetOutput.halted (tm.retargetCfgFrame cfg output) ↔ + tm.halted cfg := + retargetOutput_halted_retargetCfgFrame_internal tm cfg output + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/RetargetOutputFrame/Defs.lean b/Complexitylib/Models/TuringMachine/RetargetOutputFrame/Defs.lean new file mode 100644 index 00000000..206c336f --- /dev/null +++ b/Complexitylib/Models/TuringMachine/RetargetOutputFrame/Defs.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Lift + +/-! +# Output-retargeting frames -- definitions + +`retargetOutput` redirects a machine's virtual output onto a fresh work tape. +The standard embedding uses a blank real output; this variant carries an +arbitrary real-output frame for composition inside an output accumulator. +-/ + +namespace Complexity + +namespace TM + +/-- Embed a source configuration into `retargetOutput` while carrying an +arbitrary real output tape. -/ +def retargetCfgFrame (tm : TM n) (cfg : Cfg n tm.Q) (output : Tape) : + Cfg (n + 1) tm.Q where + state := cfg.state + input := cfg.input + work := fun i => if h : i.val < n then cfg.work ⟨i.val, h⟩ else cfg.output + output := output + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/RetargetOutputFrame/Internal.lean b/Complexitylib/Models/TuringMachine/RetargetOutputFrame/Internal.lean new file mode 100644 index 00000000..c842672c --- /dev/null +++ b/Complexitylib/Models/TuringMachine/RetargetOutputFrame/Internal.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Registers +import Complexitylib.Models.TuringMachine.RetargetOutputFrame.Defs +import Complexitylib.Models.TuringMachine.OutputCursor +import Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability + +/-! +# Output-retargeting frames -- proof internals +-/ + +namespace Complexity + +namespace TM + +@[simp] theorem retargetCfgFrame_state_internal (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + (tm.retargetCfgFrame cfg output).state = cfg.state := rfl + +@[simp] theorem retargetCfgFrame_input_internal (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + (tm.retargetCfgFrame cfg output).input = cfg.input := rfl + +@[simp] theorem retargetCfgFrame_output_internal (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + (tm.retargetCfgFrame cfg output).output = output := rfl + +theorem retargetCfgFrame_work_lt_internal (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) (i : Fin (n + 1)) + (hi : i.val < n) : + (tm.retargetCfgFrame cfg output).work i = cfg.work ⟨i.val, hi⟩ := + dif_pos hi + +theorem retargetCfgFrame_work_last_internal (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + (tm.retargetCfgFrame cfg output).work (Fin.last n) = cfg.output := + dif_neg (Nat.lt_irrefl n) + +theorem retargetOutput_step_retargetCfgFrame_internal (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) (houtput : Parked output) : + tm.retargetOutput.step (tm.retargetCfgFrame cfg output) = + (tm.step cfg).map fun next => tm.retargetCfgFrame next output := by + let framed := tm.retargetCfgFrame cfg output + change tm.retargetOutput.step framed = + (tm.step cfg).map fun next => tm.retargetCfgFrame next output + have hstate : framed.state = cfg.state := rfl + have hinput : framed.input = cfg.input := rfl + have hwork : ∀ (i : Fin (n + 1)) (hi : i.val < n), + framed.work i = cfg.work ⟨i.val, hi⟩ := by + intro i hi + exact dif_pos hi + have hlast : framed.work (Fin.last n) = cfg.output := + dif_neg (Nat.lt_irrefl n) + by_cases hhalt : cfg.state = tm.qhalt + · have hframed : tm.retargetOutput.step framed = none := by + simp only [TM.step, hstate, hhalt, + show tm.retargetOutput.qhalt = tm.qhalt from rfl, ↓reduceIte] + have hsource : tm.step cfg = none := by + simp only [TM.step, hhalt, ↓reduceIte] + rw [hframed, hsource] + rfl + · cases hstep : tm.step cfg with + | none => exact absurd hstep (by simp [TM.step, hhalt]) + | some next => + simp only [TM.step, hhalt, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + have hworkReads : + (fun i : Fin n => (framed.work (Fin.castSucc i)).read) = + fun i => (cfg.work i).read := by + funext i + rw [hwork (Fin.castSucc i) i.isLt] + rfl + have hvirtualOutput : + (framed.work (Fin.last n)).read = cfg.output.read := by + rw [hlast] + simp only [TM.step, Option.map_some] + dsimp only [retargetOutput, retargetCfgFrame] + rw [hstate, hinput, hworkReads, hvirtualOutput, if_neg hhalt] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) + · funext i + by_cases hi : i.val < n + · rw [hwork i hi, dif_pos hi, dif_pos hi, dif_pos hi] + · have hilast : i = Fin.last n := by + apply Fin.ext + have := i.isLt + simp only [Fin.val_last] + omega + rw [dif_neg hi, dif_neg hi, dif_neg hi, hilast, hlast] + · exact houtput.writeAndMove_readBack_idle + +theorem retargetOutput_reachesIn_retargetCfgFrame_internal (tm : TM n) + (output : Tape) (houtput : Parked output) {steps : ℕ} + {start done : Cfg n tm.Q} (hreach : tm.reachesIn steps start done) : + tm.retargetOutput.reachesIn steps + (tm.retargetCfgFrame start output) (tm.retargetCfgFrame done output) := by + induction hreach with + | zero => exact .zero + | step hstep _ ih => + exact .step (by + rw [retargetOutput_step_retargetCfgFrame_internal tm _ output houtput, + hstep] + rfl) ih + +theorem IsTransducer.retargetOutput_reachesIn_retargetCfgFrame_withinAuxSpace_internal + {tm : TM n} (htrans : tm.IsTransducer) + (output : Tape) (houtput : Parked output) + {steps inputLength space : ℕ} {start done : Cfg n tm.Q} + (hreach : tm.reachesIn steps start done) + (hprefix : ∀ elapsed cfg, elapsed ≤ steps → + tm.reachesIn elapsed start cfg → + cfg.WithinAuxSpace inputLength space) + (hdoneOutput : done.output.head ≤ space) : + tm.retargetOutput.reachesIn steps + (tm.retargetCfgFrame start output) + (tm.retargetCfgFrame done output) ∧ + ∀ elapsed cfg, elapsed ≤ steps → + tm.retargetOutput.reachesIn elapsed + (tm.retargetCfgFrame start output) cfg → + cfg.WithinAuxSpace inputLength space := by + have hframed := retargetOutput_reachesIn_retargetCfgFrame_internal + tm output houtput hreach + refine ⟨hframed, ?_⟩ + intro elapsed cfg helapsed hretarget + let remaining := steps - elapsed + have htime : elapsed + remaining = steps := by + dsimp only [remaining] + omega + rw [← htime] at hreach + obtain ⟨sourceMid, hsourceMid, hsourceRest⟩ := + reachesIn_split_internal hreach + have hframedMid := retargetOutput_reachesIn_retargetCfgFrame_internal + tm output houtput hsourceMid + have hcfg : cfg = tm.retargetCfgFrame sourceMid output := + tm.retargetOutput.reachesIn_right_unique hretarget hframedMid + subst cfg + have hsourceSpace := hprefix elapsed sourceMid helapsed hsourceMid + have hmidOutput : sourceMid.output.head ≤ space := + le_trans (htrans.output_head_mono_reachesIn hsourceRest) hdoneOutput + constructor + · intro i + by_cases hi : i.val < n + · rw [retargetCfgFrame_work_lt_internal tm sourceMid output i hi] + exact hsourceSpace.1 ⟨i.val, hi⟩ + · have hilast : i = Fin.last n := by + apply Fin.ext + have := i.isLt + simp only [Fin.val_last] + omega + subst i + rw [retargetCfgFrame_work_last_internal] + exact hmidOutput + · simpa only [retargetCfgFrame_input_internal] using hsourceSpace.2 + +theorem retargetOutput_halted_retargetCfgFrame_internal (tm : TM n) + (cfg : Cfg n tm.Q) (output : Tape) : + tm.retargetOutput.halted (tm.retargetCfgFrame cfg output) ↔ + tm.halted cfg := by + rfl + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/SpaceTime/WorkSupport.lean b/Complexitylib/Models/TuringMachine/SpaceTime/WorkSupport.lean new file mode 100644 index 00000000..86810956 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/SpaceTime/WorkSupport.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Hoare.Space +import Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# Bounded support of work tapes + +A machine whose work head stays at or below `bound` cannot change cells +strictly above `bound`. This module packages that elementary fact for cleanup +arguments that must restore an initially blank work tape exactly. +-/ + +namespace Complexity + +namespace Tape + +/-- Every cell strictly above `bound` is blank. -/ +def BlankAfter (tape : Tape) (bound : ℕ) : Prop := + ∀ index, bound < index → tape.cells index = Γ.blank + +/-- A canonical blank tape has blank support above every bound. -/ +theorem BlankAfter.init_nil (bound : ℕ) : + (Tape.init []).BlankAfter bound := by + intro index hindex + simp [Tape.init] + omega + +/-- Canonical binary contents are blank above any bound covering their bit +length. -/ +theorem HasBinaryContent.blankAfter_of_length_le + {tape : Tape} {bits : List Bool} {bound : ℕ} + (hcontent : tape.HasBinaryContent bits) (hlength : bits.length ≤ bound) : + tape.BlankAfter bound := by + intro index hindex + let offset := index - 1 + have hindexEq : index = offset + 1 := by + dsimp only [offset] + omega + rw [hindexEq] + exact hcontent.2 offset (by omega) + +private theorem BlankAfter.writeAndMove_of_head_le + {tape : Tape} {bound : ℕ} (hblank : tape.BlankAfter bound) + (hhead : tape.head ≤ bound) (symbol : Γ) (direction : Dir3) : + (tape.writeAndMove symbol direction).BlankAfter bound := by + intro index hindex + have hne : index ≠ tape.head := by omega + rw [Tape.writeAndMove, Tape.move_cells, Tape.write] + split + · exact hblank index hindex + · change Function.update tape.cells tape.head symbol index = Γ.blank + rw [Function.update_of_ne hne] + exact hblank index hindex + +end Tape + +namespace TM + +/-- One machine step preserves blank support above any bound that covers the +current target-work head. -/ +private theorem work_blankAfter_step {tm : TM n} {before after : Cfg n tm.Q} + (idx : Fin n) (bound : ℕ) + (hblank : (before.work idx).BlankAfter bound) + (hhead : (before.work idx).head ≤ bound) + (hstep : tm.step before = some after) : + (after.work idx).BlankAfter bound := by + have hne := state_ne_qhalt_of_step hstep + generalize htransition : + tm.δ before.state before.input.read (fun i => (before.work i).read) + before.output.read = transition at hstep + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := + transition + simp only [TM.step, hne, ↓reduceIte, htransition, + Option.some.injEq] at hstep + subst after + exact hblank.writeAndMove_of_head_le hhead _ _ + +/-- A complete run preserves an initially blank suffix when every prefix +configuration keeps the selected work head inside the same bound. -/ +theorem work_blankAfter_reachesIn {tm : TM n} + {time inputLength bound : ℕ} {start done : Cfg n tm.Q} + (idx : Fin n) (hstart : (start.work idx).BlankAfter bound) + (hreach : tm.reachesIn time start done) + (hprefix : ∀ elapsed cfg, elapsed ≤ time → + tm.reachesIn elapsed start cfg → + cfg.WithinAuxSpace inputLength bound) : + (done.work idx).BlankAfter bound := by + induction hreach with + | zero => exact hstart + | @step before middle restTime final hstep hrest ih => + have hspaceStart := hprefix 0 before (by omega) .zero + have hmiddle := work_blankAfter_step idx bound hstart + (hspaceStart.1 idx) hstep + apply ih hmiddle + intro elapsed cfg helapsed hmiddleReach + apply hprefix (elapsed + 1) cfg (by omega) + exact TM.reachesIn.step hstep hmiddleReach + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean b/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean index 8b86414c..23a19b6b 100644 --- a/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean +++ b/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean @@ -53,12 +53,151 @@ theorem binaryEqTM_reachesIn_frame {n : ℕ} binaryEqTM_reachesIn_frame_internal lhsIdx rhsIdx resultIdx hdistinct lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother houtput +/-- Compositional time-bounded form of `binaryEqTM_reachesIn_frame`. -/ +theorem binaryEqTM_hoareTime_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (binaryEqTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work resultIdx).HasBinaryPrefix [decide (lhs = rhs)] ∧ + (work lhsIdx).HasBinaryContent lhs ∧ + 1 ≤ (work lhsIdx).head ∧ + (work rhsIdx).HasBinaryContent rhs ∧ + 1 ≤ (work rhsIdx).head ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (binaryEqTime lhs rhs) := + binaryEqTM_hoareTime_frame_internal lhsIdx rhsIdx resultIdx hdistinct lhs rhs + inp₀ work₀ out₀ hlhs hrhs hresult hinput hother houtput + +/-- Time-and-space form of canonical binary equality. -/ +theorem binaryEqTM_hoareTimeSpace_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (binaryEqTM lhsIdx rhsIdx resultIdx).qstart, + input := inp₀, + work := work₀, + output := out₀ } : + Cfg n (binaryEqTM lhsIdx rhsIdx resultIdx).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryEqTM lhsIdx rhsIdx resultIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work resultIdx).HasBinaryPrefix [decide (lhs = rhs)] ∧ + (work lhsIdx).HasBinaryContent lhs ∧ + 1 ≤ (work lhsIdx).head ∧ + (work rhsIdx).HasBinaryContent rhs ∧ + 1 ≤ (work rhsIdx).head ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (binaryEqTime lhs rhs) inputLength + (initialSpace + binaryEqTime lhs rhs) := + binaryEqTM_hoareTimeSpace_frame_internal lhsIdx rhsIdx resultIdx hdistinct + lhs rhs inputLength initialSpace inp₀ work₀ out₀ hlhs hrhs hresult hinput + hother houtput hinitial + +/-- Canonical binary equality with all three cursors rewound. The operands are +restored literally and the result tape becomes the canonical one-bit verdict. -/ +theorem binaryEqRewindTM_hoareTime_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hlhsStart : (work₀ lhsIdx).cells 0 = Γ.start) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hrhsStart : (work₀ rhsIdx).cells 0 = Γ.start) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryEqRewindTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ resultIdx + ((Tape.init ([decide (lhs = rhs)].map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (binaryEqRewindTime lhs rhs) := + binaryEqRewindTM_hoareTime_frame_internal lhsIdx rhsIdx resultIdx hdistinct + lhs rhs inp₀ work₀ out₀ hlhs hlhsStart hrhs hrhsStart hresult + hresultStart hinput hother houtput + +/-- Time-and-space form of normalized canonical binary equality. -/ +theorem binaryEqRewindTM_hoareTimeSpace_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hlhsStart : (work₀ lhsIdx).cells 0 = Γ.start) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hrhsStart : (work₀ rhsIdx).cells 0 = Γ.start) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) + (hinitial : + ({ state := (binaryEqRewindTM lhsIdx rhsIdx resultIdx).qstart, + input := inp₀, + work := work₀, + output := out₀ } : + Cfg n (binaryEqRewindTM lhsIdx rhsIdx resultIdx).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryEqRewindTM lhsIdx rhsIdx resultIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ resultIdx + ((Tape.init ([decide (lhs = rhs)].map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (binaryEqRewindTime lhs rhs) inputLength + (initialSpace + binaryEqRewindTime lhs rhs) := + binaryEqRewindTM_hoareTimeSpace_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inputLength initialSpace inp₀ work₀ out₀ hlhs + hlhsStart hrhs hrhsStart hresult hresultStart hinput hother houtput + hinitial + /-- Binary equality preserves one-way output safety. -/ theorem binaryEqTM_isTransducer {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) : (binaryEqTM lhsIdx rhsIdx resultIdx).IsTransducer := binaryEqTM_isTransducer_internal lhsIdx rhsIdx resultIdx +/-- Normalized binary equality preserves one-way output safety. -/ +theorem binaryEqRewindTM_isTransducer {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryEqRewindTM lhsIdx rhsIdx resultIdx).IsTransducer := + binaryEqRewindTM_isTransducer_internal lhsIdx rhsIdx resultIdx + end TM end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Defs.lean b/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Defs.lean index a9eefb2c..c745c801 100644 --- a/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Defs.lean +++ b/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Defs.lean @@ -99,6 +99,21 @@ def binaryEqTM {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) : TM n where def binaryEqTime (lhs rhs : List Bool) : ℕ := max lhs.length rhs.length + 1 +/-- Compare two canonical binary strings, then rewind both read cursors and +the one-bit result cursor. This is the compositional form used by iterative +controllers whose next phase must start from a completely parked frame. -/ +def binaryEqRewindTM {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) : TM n := + seqTM (binaryEqTM lhsIdx rhsIdx resultIdx) + (seqTM (rewindWorkTM lhsIdx) + (seqTM (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx))) + +/-- Runtime of equality followed by the three canonical rewinds. -/ +def binaryEqRewindTime (lhs rhs : List Bool) : ℕ := + let comparisonTime := binaryEqTime lhs rhs + comparisonTime + 1 + + ((comparisonTime + 1 + 2) + 1 + + ((comparisonTime + 1 + 2) + 1 + (2 + 2))) + end TM end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean b/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean index 2d2bc858..612efcfb 100644 --- a/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean +++ b/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean @@ -4,7 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Samuel Schlesinger -/ import Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs +import Complexitylib.Models.TuringMachine.Hoare.Space import Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +import Complexitylib.Models.TuringMachine.Registers +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Internal +import Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Internal /-! # Binary work-tape equality — proof internals @@ -14,6 +18,16 @@ namespace Complexity namespace TM +private theorem parked_of_hasBinaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : Parked t := + ⟨by rw [h.1]; omega, + Tape.HasBinaryContent.cells_ne_start + (show t.HasBinaryContent bits from h.2)⟩ + +private theorem parked_of_hasBinaryContent {t : Tape} {bits : List Bool} + (h : t.HasBinaryContent bits) (hhead : 1 ≤ t.head) : Parked t := + ⟨hhead, h.cells_ne_start⟩ + private def binaryEqResultWork {n : ℕ} (resultIdx : Fin n) (work : Fin n → Tape) (result : Bool) : Fin n → Tape := Function.update work resultIdx @@ -365,6 +379,429 @@ theorem binaryEqTM_reachesIn_frame_internal {n : ℕ} · simpa only [Tape.HasBinaryContent, hfinalLhs] using hlhs.hasBinaryContent · simpa only [Tape.HasBinaryContent, hfinalRhs] using hrhs.hasBinaryContent +theorem binaryEqTM_hoareTime_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (binaryEqTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work resultIdx).HasBinaryPrefix [decide (lhs = rhs)] ∧ + (work lhsIdx).HasBinaryContent lhs ∧ + 1 ≤ (work lhsIdx).head ∧ + (work rhsIdx).HasBinaryContent rhs ∧ + 1 ≤ (work rhsIdx).head ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (binaryEqTime lhs rhs) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + obtain ⟨c, time, htime, hreach, hhalt, hcInput, hcResult, hcLhs, + hcLhsHead, hcRhs, hcRhsHead, hcOther, hcOutput⟩ := + binaryEqTM_reachesIn_frame_internal lhsIdx rhsIdx resultIdx hdistinct + lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother houtput + exact ⟨c, time, htime, hreach, hhalt, hcInput, hcResult, hcLhs, hcLhsHead, + hcRhs, hcRhsHead, hcOther, hcOutput⟩ + +theorem binaryEqTM_hoareTimeSpace_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (binaryEqTM lhsIdx rhsIdx resultIdx).qstart, + input := inp₀, + work := work₀, + output := out₀ } : + Cfg n (binaryEqTM lhsIdx rhsIdx resultIdx).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryEqTM lhsIdx rhsIdx resultIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work resultIdx).HasBinaryPrefix [decide (lhs = rhs)] ∧ + (work lhsIdx).HasBinaryContent lhs ∧ + 1 ≤ (work lhsIdx).head ∧ + (work rhsIdx).HasBinaryContent rhs ∧ + 1 ≤ (work rhsIdx).head ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (binaryEqTime lhs rhs) inputLength + (initialSpace + binaryEqTime lhs rhs) := by + apply (binaryEqTM_hoareTime_frame_internal lhsIdx rhsIdx resultIdx hdistinct + lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother + houtput).toHoareTimeSpace + intro inp work out hpre + rcases hpre with ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + exact hinitial + +theorem binaryEqRewindTM_hoareTime_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hlhsStart : (work₀ lhsIdx).cells 0 = Γ.start) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hrhsStart : (work₀ rhsIdx).cells 0 = Γ.start) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryEqRewindTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ resultIdx + ((Tape.init ([decide (lhs = rhs)].map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (binaryEqRewindTime lhs rhs) := by + let comparisonTime := binaryEqTime lhs rhs + let resultBits := [decide (lhs = rhs)] + let compared : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work resultIdx).HasBinaryPrefix resultBits ∧ + (work resultIdx).cells 0 = Γ.start ∧ + (work lhsIdx).HasBinaryContent lhs ∧ + (work lhsIdx).cells 0 = Γ.start ∧ + 1 ≤ (work lhsIdx).head ∧ + (work lhsIdx).head ≤ comparisonTime + 1 ∧ + (work rhsIdx).HasBinaryContent rhs ∧ + (work rhsIdx).cells 0 = Γ.start ∧ + 1 ≤ (work rhsIdx).head ∧ + (work rhsIdx).head ≤ comparisonTime + 1 ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀ + have hcompare : (binaryEqTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + compared comparisonTime := by + intro inp work out hpre + rcases hpre with ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + obtain ⟨c, time, htime, hreach, hhalt, hcInput, hcResult, hcLhs, + hcLhsHead, hcRhs, hcRhsHead, hcOther, hcOutput⟩ := + binaryEqTM_reachesIn_frame_internal lhsIdx rhsIdx resultIdx hdistinct + lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput.read_ne_start + (fun i hil hir hires => (hother i hil hir hires).read_ne_start) + houtput.read_ne_start + have hheads := head_le_start_add_of_reachesIn + (binaryEqTM lhsIdx rhsIdx resultIdx) hreach + have hcResultStart := work_cells_zero_eq_start_of_reachesIn resultIdx + hreach hresultStart + have hcLhsStart := work_cells_zero_eq_start_of_reachesIn lhsIdx hreach + hlhsStart + have hcRhsStart := work_cells_zero_eq_start_of_reachesIn rhsIdx hreach + hrhsStart + refine ⟨c, time, ?_, hreach, hhalt, ?_⟩ + · simpa [comparisonTime] using htime + refine ⟨hcInput, ?_, hcResultStart, hcLhs, hcLhsStart, hcLhsHead, ?_, + hcRhs, hcRhsStart, hcRhsHead, ?_, hcOther, hcOutput⟩ + · simpa [resultBits] using hcResult + · have hbound := hheads.2.2 lhsIdx + rw [hlhs.1] at hbound + simp only [comparisonTime] + omega + · have hbound := hheads.2.2 rhsIdx + rw [hrhs.1] at hbound + simp only [comparisonTime] + omega + let rewoundLhs : TapePred n := fun inp work out => + inp = inp₀ ∧ + work lhsIdx = (Tape.init (lhs.map Γ.ofBool)).move Dir3.right ∧ + (work resultIdx).HasBinaryPrefix resultBits ∧ + (work resultIdx).cells 0 = Γ.start ∧ + (work rhsIdx).HasBinaryContent rhs ∧ + (work rhsIdx).cells 0 = Γ.start ∧ + 1 ≤ (work rhsIdx).head ∧ + (work rhsIdx).head ≤ comparisonTime + 1 ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀ + have hrewindLhs : (rewindWorkTM lhsIdx).HoareTime compared rewoundLhs + (comparisonTime + 1 + 2) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hres, hresStart, hlhsContent, hlhsStart', + hlhsHead, hlhsBound, hrhsContent, hrhsStart', hrhsHead, hrhsBound, + hother', hout⟩ + have hworkParked : ∀ i, i ≠ lhsIdx → Parked (work i) := by + intro i hil + by_cases hir : i = rhsIdx + · subst i + exact parked_of_hasBinaryContent hrhsContent hrhsHead + by_cases hires : i = resultIdx + · subst i + exact parked_of_hasBinaryPrefix hres + rw [hother' i hil hir hires] + exact hother i hil hir hires + have hrun := rewindBinaryWorkTM_hoareTime_frame_internal lhsIdx lhs + (comparisonTime + 1) inp work out hlhsContent hlhsStart' + ⟨hlhsHead, hlhsBound⟩ (hinp ▸ hinput) hworkParked (hout ▸ houtput) + obtain ⟨c, time, htime, hreach, hhalt, hcInput, hcLhs, hcOther, + hcOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c, time, htime, hreach, hhalt, ?_⟩ + refine ⟨hcInput.trans hinp, hcLhs, ?_, ?_, ?_, ?_, ?_, ?_, ?_, + hcOutput.trans hout⟩ + · rw [hcOther resultIdx hdistinct.lhs_result.symm] + exact hres + · rw [hcOther resultIdx hdistinct.lhs_result.symm] + exact hresStart + · rw [hcOther rhsIdx hdistinct.lhs_rhs.symm] + exact hrhsContent + · rw [hcOther rhsIdx hdistinct.lhs_rhs.symm] + exact hrhsStart' + · rw [hcOther rhsIdx hdistinct.lhs_rhs.symm] + exact hrhsHead + · rw [hcOther rhsIdx hdistinct.lhs_rhs.symm] + exact hrhsBound + · intro i hil hir hires + exact (hcOther i hil).trans (hother' i hil hir hires) + let rewoundRhs : TapePred n := fun inp work out => + inp = inp₀ ∧ + work lhsIdx = (Tape.init (lhs.map Γ.ofBool)).move Dir3.right ∧ + work rhsIdx = (Tape.init (rhs.map Γ.ofBool)).move Dir3.right ∧ + (work resultIdx).HasBinaryPrefix resultBits ∧ + (work resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀ + have hrewindRhs : (rewindWorkTM rhsIdx).HoareTime rewoundLhs rewoundRhs + (comparisonTime + 1 + 2) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhsEq, hres, hresStart, hrhsContent, + hrhsStart', hrhsHead, hrhsBound, hother', hout⟩ + have hworkParked : ∀ i, i ≠ rhsIdx → Parked (work i) := by + intro i hir + by_cases hil : i = lhsIdx + · subst i + rw [hlhsEq] + exact ⟨by simp [Tape.move], + Tape.init_ofBool_move_right_cells_ne_start lhs⟩ + by_cases hires : i = resultIdx + · subst i + exact parked_of_hasBinaryPrefix hres + rw [hother' i hil hir hires] + exact hother i hil hir hires + have hrun := rewindBinaryWorkTM_hoareTime_frame_internal rhsIdx rhs + (comparisonTime + 1) inp work out hrhsContent hrhsStart' + ⟨hrhsHead, hrhsBound⟩ (hinp ▸ hinput) hworkParked (hout ▸ houtput) + obtain ⟨c, time, htime, hreach, hhalt, hcInput, hcRhs, hcOther, + hcOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c, time, htime, hreach, hhalt, ?_⟩ + refine ⟨hcInput.trans hinp, ?_, hcRhs, ?_, ?_, ?_, + hcOutput.trans hout⟩ + · rw [hcOther lhsIdx hdistinct.lhs_rhs] + exact hlhsEq + · rw [hcOther resultIdx hdistinct.rhs_result.symm] + exact hres + · rw [hcOther resultIdx hdistinct.rhs_result.symm] + exact hresStart + · intro i hil hir hires + exact (hcOther i hir).trans (hother' i hil hir hires) + have hrewindResult : (rewindWorkTM resultIdx).HoareTime rewoundRhs + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ resultIdx + ((Tape.init (resultBits.map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (2 + 2) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhsEq, hrhsEq, hres, hresStart, hother', + hout⟩ + have hworkParked : ∀ i, i ≠ resultIdx → Parked (work i) := by + intro i hires + by_cases hil : i = lhsIdx + · subst i + rw [hlhsEq] + exact ⟨by simp [Tape.move], + Tape.init_ofBool_move_right_cells_ne_start lhs⟩ + by_cases hir : i = rhsIdx + · subst i + rw [hrhsEq] + exact ⟨by simp [Tape.move], + Tape.init_ofBool_move_right_cells_ne_start rhs⟩ + rw [hother' i hil hir hires] + exact hother i hil hir hires + have hrun := rewindBinaryWorkTM_hoareTime_frame_internal resultIdx + resultBits 2 inp work out (show (work resultIdx).HasBinaryContent + resultBits from hres.2) hresStart ⟨by rw [hres.1]; omega, + by rw [hres.1]; simp [resultBits]⟩ (hinp ▸ hinput) hworkParked + (hout ▸ houtput) + obtain ⟨c, time, htime, hreach, hhalt, hcInput, hcResult, hcOther, + hcOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c, time, htime, hreach, hhalt, hcInput.trans hinp, ?_, + hcOutput.trans hout⟩ + funext i + by_cases hires : i = resultIdx + · subst i + rw [Function.update_self] + exact hcResult + rw [Function.update_of_ne hires, hcOther i hires] + by_cases hil : i = lhsIdx + · subst i + exact hlhsEq.trans + (Tape.eq_init_move_right_of_hasBinaryString hlhs hlhsStart).symm + by_cases hir : i = rhsIdx + · subst i + exact hrhsEq.trans + (Tape.eq_init_move_right_of_hasBinaryString hrhs hrhsStart).symm + exact hother' i hil hir hires + have htransitionCompared : ∀ inp work out, compared inp work out → + compared (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hres, hresStart, hlhsContent, hlhsStart', + hlhsHead, hlhsBound, hrhsContent, hrhsStart', hrhsHead, hrhsBound, + hother', hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hil : i = lhsIdx + · subst i + exact (parked_of_hasBinaryContent hlhsContent hlhsHead).read_ne_start + by_cases hir : i = rhsIdx + · subst i + exact (parked_of_hasBinaryContent hrhsContent hrhsHead).read_ne_start + by_cases hires : i = resultIdx + · subst i + exact (parked_of_hasBinaryPrefix hres).read_ne_start + rw [hother' i hil hir hires] + exact (hother i hil hir hires).read_ne_start + obtain ⟨hi, hw, ho⟩ := phaseTransition_eq_self_of_reads_ne_start + (hinp ▸ hinput.read_ne_start) hreads (hout ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hres, hresStart, hlhsContent, hlhsStart', hlhsHead, + hlhsBound, hrhsContent, hrhsStart', hrhsHead, hrhsBound, hother', hout⟩ + have htransitionLhs : ∀ inp work out, rewoundLhs inp work out → + rewoundLhs (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhsEq, hres, hresStart, hrhsContent, + hrhsStart', hrhsHead, hrhsBound, hother', hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hil : i = lhsIdx + · subst i + rw [hlhsEq] + exact Tape.init_ofBool_move_right_read_ne_start lhs + by_cases hir : i = rhsIdx + · subst i + exact (parked_of_hasBinaryContent hrhsContent hrhsHead).read_ne_start + by_cases hires : i = resultIdx + · subst i + exact (parked_of_hasBinaryPrefix hres).read_ne_start + rw [hother' i hil hir hires] + exact (hother i hil hir hires).read_ne_start + obtain ⟨hi, hw, ho⟩ := phaseTransition_eq_self_of_reads_ne_start + (hinp ▸ hinput.read_ne_start) hreads (hout ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hlhsEq, hres, hresStart, hrhsContent, hrhsStart', + hrhsHead, hrhsBound, hother', hout⟩ + have htransitionRhs : ∀ inp work out, rewoundRhs inp work out → + rewoundRhs (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhsEq, hrhsEq, hres, hresStart, hother', + hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hil : i = lhsIdx + · subst i + rw [hlhsEq] + exact Tape.init_ofBool_move_right_read_ne_start lhs + by_cases hir : i = rhsIdx + · subst i + rw [hrhsEq] + exact Tape.init_ofBool_move_right_read_ne_start rhs + by_cases hires : i = resultIdx + · subst i + exact (parked_of_hasBinaryPrefix hres).read_ne_start + rw [hother' i hil hir hires] + exact (hother i hil hir hires).read_ne_start + obtain ⟨hi, hw, ho⟩ := phaseTransition_eq_self_of_reads_ne_start + (hinp ▸ hinput.read_ne_start) hreads (hout ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hlhsEq, hrhsEq, hres, hresStart, hother', hout⟩ + have hrewinds := seqTM_hoareTime (rewindWorkTM lhsIdx) + (seqTM (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx)) hrewindLhs + htransitionLhs + (seqTM_hoareTime (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx) + hrewindRhs htransitionRhs hrewindResult) + unfold binaryEqRewindTM binaryEqRewindTime + simpa [comparisonTime, resultBits] using + seqTM_hoareTime (binaryEqTM lhsIdx rhsIdx resultIdx) + (seqTM (rewindWorkTM lhsIdx) + (seqTM (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx))) + hcompare htransitionCompared hrewinds + +theorem binaryEqRewindTM_hoareTimeSpace_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hlhsStart : (work₀ lhsIdx).cells 0 = Γ.start) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hrhsStart : (work₀ rhsIdx).cells 0 = Γ.start) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) + (hinitial : + ({ state := (binaryEqRewindTM lhsIdx rhsIdx resultIdx).qstart, + input := inp₀, + work := work₀, + output := out₀ } : + Cfg n (binaryEqRewindTM lhsIdx rhsIdx resultIdx).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryEqRewindTM lhsIdx rhsIdx resultIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ resultIdx + ((Tape.init ([decide (lhs = rhs)].map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (binaryEqRewindTime lhs rhs) inputLength + (initialSpace + binaryEqRewindTime lhs rhs) := by + apply (binaryEqRewindTM_hoareTime_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inp₀ work₀ out₀ hlhs hlhsStart hrhs hrhsStart hresult + hresultStart hinput hother houtput).toHoareTimeSpace + intro inp work out hpre + rcases hpre with ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + exact hinitial + theorem binaryEqTM_isTransducer_internal {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) : (binaryEqTM lhsIdx rhsIdx resultIdx).IsTransducer := by @@ -387,6 +824,15 @@ theorem binaryEqTM_isTransducer_internal {n : ℕ} simp only [binaryEqTM, allIdle, idleDir] split <;> decide +theorem binaryEqRewindTM_isTransducer_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryEqRewindTM lhsIdx rhsIdx resultIdx).IsTransducer := by + unfold binaryEqRewindTM + exact (binaryEqTM_isTransducer_internal lhsIdx rhsIdx resultIdx).seqTM + ((rewindWorkTM_isTransducer_internal lhsIdx).seqTM + ((rewindWorkTM_isTransducer_internal rhsIdx).seqTM + (rewindWorkTM_isTransducer_internal resultIdx))) + end TM end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean b/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean index f6a91bcf..febacbab 100644 --- a/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean +++ b/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean @@ -27,6 +27,10 @@ limit, or tape frames. Clients record those endpoint facts in - `binaryForTM_compare_reachesIn_frame` gives the exact framed comparison. - `BinaryForLoopSpec.reachesIn` composes a certified loop exactly. - `BinaryForLoopSpaceSpec.prefix_withinAuxSpace` covers every run prefix. +- `BinaryForSegmentSpec.reachesIn` accepts bounded actual iteration times. +- `BinaryForSegmentSpec.hoareTime` exposes exact segment endpoints as a Hoare + contract. +- `BinaryForSegmentSpaceSpec.prefix_withinAuxSpace` covers segment prefixes. - `IsTransducer.binaryForTM` preserves one-way output safety. -/ @@ -163,6 +167,124 @@ theorem BinaryForLoopSpaceSpec.prefix_withinAuxSpace c.WithinAuxSpace inputLength spaceBound := spaceSpec.prefix_withinAuxSpace_internal count value t c hlimit hreach htime +/-- Package bounded reachable iteration witnesses into a segment certificate. + +The selected runtime is proof data only: execution remains the concrete +deterministic loop, while callers may supply each iteration through an +existential Hoare-time witness. -/ +noncomputable def BinaryForSegmentSpec.ofWitnesses + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue : ℕ} + (counter_ne_limit : counterIdx ≠ limitIdx) + (scanCfg iterationStartCfg iterationDoneCfg : + ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q) + (doneCfg : Cfg n (binaryForTM body counterIdx limitIdx).Q) + (testRun : ∀ value, startValue ≤ value → value < limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) (scanCfg value) + (iterationStartCfg value)) + (iterationWitness : ∀ value, startValue ≤ value → value < limitValue → + ∃ time, time ≤ binaryForIterationTime bodyTime value ∧ + (binaryForTM body counterIdx limitIdx).reachesIn time + (iterationStartCfg value) (iterationDoneCfg value)) + (loopbackStep : ∀ value, startValue ≤ value → value < limitValue → + (binaryForTM body counterIdx limitIdx).step (iterationDoneCfg value) = + some (scanCfg (value + 1))) + (doneRun : + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) (scanCfg limitValue) doneCfg) + (doneHalted : (binaryForTM body counterIdx limitIdx).halted doneCfg) : + BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue := + BinaryForSegmentSpec.ofWitnessesInternal counter_ne_limit scanCfg + iterationStartCfg iterationDoneCfg doneCfg testRun iterationWitness + loopbackStep doneRun doneHalted + +/-- A bounded reachable-segment certificate terminates within the standard +recursive binary-loop bound. Iteration witnesses may finish strictly before +their advertised body-time bounds. -/ +theorem BinaryForSegmentSpec.reachesIn {body : TM n} + {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue : ℕ} + (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue) + (count value : ℕ) (hstart : startValue ≤ value) + (hlimit : value + count = limitValue) : + ∃ time, time ≤ binaryForLoopTime bodyTime limitValue value count ∧ + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.scanCfg value) spec.doneCfg := + spec.reachesIn_internal count value hstart hlimit + +/-- A bounded reachable segment beginning in the driver's start state gives +a time-bounded Hoare triple from its exact initial tapes to its exact final +tapes. -/ +theorem BinaryForSegmentSpec.hoareTime {body : TM n} + {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue : ℕ} + (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue) + (hstartLimit : startValue ≤ limitValue) + (hscanState : + (spec.scanCfg startValue).state = + (binaryForTM body counterIdx limitIdx).qstart) : + (binaryForTM body counterIdx limitIdx).HoareTime + (fun inp work out => + inp = (spec.scanCfg startValue).input ∧ + work = (spec.scanCfg startValue).work ∧ + out = (spec.scanCfg startValue).output) + (fun inp work out => + inp = spec.doneCfg.input ∧ + work = spec.doneCfg.work ∧ + out = spec.doneCfg.output) + (binaryForLoopTime bodyTime limitValue startValue + (limitValue - startValue)) := + spec.hoareTime_internal hstartLimit hscanState + +/-- Derive phase-local segment space safety from bounds on each canonical +phase entry plus enough reserve for the corresponding concrete runtime. + +This is the standard adapter when the segment's configurations are explicit: +callers bound only scanner and iteration entries, while head-growth along +every reachable prefix is discharged generically. -/ +theorem BinaryForSegmentSpaceSpec.ofInitialBounds + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue inputLength spaceBound : ℕ} + (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue) + (testInitialSpace iterationInitialSpace : ℕ → ℕ) + (testInitial : ∀ value, startValue ≤ value → value ≤ limitValue → + (spec.scanCfg value).WithinAuxSpace inputLength + (testInitialSpace value)) + (iterationInitial : ∀ value, startValue ≤ value → value < limitValue → + (spec.iterationStartCfg value).WithinAuxSpace inputLength + (iterationInitialSpace value)) + (testBound : ∀ value, startValue ≤ value → value ≤ limitValue → + testInitialSpace value + binaryForCompareTime limitValue ≤ spaceBound) + (iterationBound : ∀ value, startValue ≤ value → value < limitValue → + iterationInitialSpace value + spec.iterationTime value ≤ spaceBound) : + BinaryForSegmentSpaceSpec spec inputLength spaceBound := + BinaryForSegmentSpaceSpec.ofInitialBounds_internal spec testInitialSpace + iterationInitialSpace testInitial iterationInitial testBound iterationBound + +/-- Phase-local segment bounds cover every reachable prefix of the whole +count-up loop, including iterations that halt before their advertised bound. -/ +theorem BinaryForSegmentSpaceSpec.prefix_withinAuxSpace + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue inputLength spaceBound : ℕ} + {spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue} + (spaceSpec : BinaryForSegmentSpaceSpec spec inputLength spaceBound) + (count value time : ℕ) + (cfg : Cfg n (binaryForTM body counterIdx limitIdx).Q) + (hstart : startValue ≤ value) + (hlimit : value + count = limitValue) + (hreach : (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.scanCfg value) cfg) + (htime : time ≤ binaryForLoopTime bodyTime limitValue value count) : + cfg.WithinAuxSpace inputLength spaceBound := + spaceSpec.prefix_withinAuxSpace_internal count value time cfg hstart + hlimit hreach htime + /-- A binary count-up loop preserves the body's one-way-output discipline. -/ theorem IsTransducer.binaryForTM {body : TM n} (hbody : body.IsTransducer) (counterIdx limitIdx : Fin n) : diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean b/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean index cb3657a4..f71d1daa 100644 --- a/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean +++ b/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean @@ -275,6 +275,71 @@ structure BinaryForLoopSpaceSpec {n : ℕ} {body : TM n} (spec.iterationStartCfg value) cfg → cfg.WithinAuxSpace inputLength spaceBound +/-- A bounded execution certificate for one reachable segment of a canonical +binary count-up loop. + +Unlike `BinaryForLoopSpec`, iterations may finish before their advertised +bound and obligations below `startValue` are not requested. This is the +appropriate interface for bodies whose actual runtime is selected from a +bounded Hoare witness. -/ +structure BinaryForSegmentSpec {n : ℕ} (body : TM n) + (counterIdx limitIdx : Fin n) (bodyTime : ℕ → ℕ) + (startValue limitValue : ℕ) where + /-- The counter and preserved-limit tapes are distinct. -/ + counter_ne_limit : counterIdx ≠ limitIdx + /-- Canonical scanner configuration at each reachable counter value. -/ + scanCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q + /-- Configuration at the composite body-plus-successor entry. -/ + iterationStartCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q + /-- Configuration after the composite body-plus-successor iteration. -/ + iterationDoneCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q + /-- Final halted driver configuration. -/ + doneCfg : Cfg n (binaryForTM body counterIdx limitIdx).Q + /-- A nonterminal comparison enters the composite iteration exactly. -/ + testRun : ∀ value, startValue ≤ value → value < limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) (scanCfg value) + (iterationStartCfg value) + /-- Selected actual runtime of each reachable composite iteration. -/ + iterationTime : ℕ → ℕ + /-- The selected runtime stays within the advertised iteration bound. -/ + iterationTime_le : ∀ value, startValue ≤ value → value < limitValue → + iterationTime value ≤ binaryForIterationTime bodyTime value + /-- The composite iteration runs for its selected actual runtime. -/ + iterationRun : ∀ value, startValue ≤ value → value < limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn (iterationTime value) + (iterationStartCfg value) (iterationDoneCfg value) + /-- The preserving loopback seam starts the next comparison. -/ + loopbackStep : ∀ value, startValue ≤ value → value < limitValue → + (binaryForTM body counterIdx limitIdx).step (iterationDoneCfg value) = + some (scanCfg (value + 1)) + /-- Equality at the limit completes the final comparison exactly. -/ + doneRun : + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) (scanCfg limitValue) doneCfg + /-- The supplied final driver configuration is genuinely halted. -/ + doneHalted : (binaryForTM body counterIdx limitIdx).halted doneCfg + +/-- All-prefix auxiliary-space obligations for a bounded reachable loop +segment. -/ +structure BinaryForSegmentSpaceSpec {n : ℕ} {body : TM n} + {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue : ℕ} + (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue) (inputLength spaceBound : ℕ) where + /-- Every reachable comparison prefix stays inside the shared budget. -/ + testPrefixWithin : ∀ value time cfg, startValue ≤ value → + value ≤ limitValue → time ≤ binaryForCompareTime limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.scanCfg value) cfg → + cfg.WithinAuxSpace inputLength spaceBound + /-- Every reachable composite-iteration prefix stays inside the budget. -/ + iterationPrefixWithin : ∀ value time cfg, startValue ≤ value → + value < limitValue → time ≤ spec.iterationTime value → + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.iterationStartCfg value) cfg → + cfg.WithinAuxSpace inputLength spaceBound + end TM end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean b/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean index b9e342bd..c58b7d3c 100644 --- a/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean +++ b/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean @@ -5,6 +5,7 @@ Authors: Samuel Schlesinger -/ import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Segment /-! # Canonical binary count-up loops — internal proofs diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Segment.lean b/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Segment.lean new file mode 100644 index 00000000..348f7636 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Segment.lean @@ -0,0 +1,325 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Internal +import Complexitylib.Models.TuringMachine.Hoare.Defs +import Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs + +/-! +# Bounded-runtime binary count-up loop segments -- proof internals +-/ + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Select one actual iteration runtime from each bounded reachable witness. -/ +noncomputable def BinaryForSegmentSpec.ofWitnessesInternal + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue : ℕ} + (counter_ne_limit : counterIdx ≠ limitIdx) + (scanCfg iterationStartCfg iterationDoneCfg : + ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q) + (doneCfg : Cfg n (binaryForTM body counterIdx limitIdx).Q) + (testRun : ∀ value, startValue ≤ value → value < limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) (scanCfg value) + (iterationStartCfg value)) + (iterationWitness : ∀ value, startValue ≤ value → value < limitValue → + ∃ time, time ≤ binaryForIterationTime bodyTime value ∧ + (binaryForTM body counterIdx limitIdx).reachesIn time + (iterationStartCfg value) (iterationDoneCfg value)) + (loopbackStep : ∀ value, startValue ≤ value → value < limitValue → + (binaryForTM body counterIdx limitIdx).step (iterationDoneCfg value) = + some (scanCfg (value + 1))) + (doneRun : + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) (scanCfg limitValue) doneCfg) + (doneHalted : (binaryForTM body counterIdx limitIdx).halted doneCfg) : + BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue := by + let actualTime (value : ℕ) : ℕ := + if h : startValue ≤ value ∧ value < limitValue then + Classical.choose (iterationWitness value h.1 h.2) + else + 0 + refine + { counter_ne_limit := counter_ne_limit + scanCfg := scanCfg + iterationStartCfg := iterationStartCfg + iterationDoneCfg := iterationDoneCfg + doneCfg := doneCfg + testRun := testRun + iterationTime := actualTime + iterationTime_le := ?_ + iterationRun := ?_ + loopbackStep := loopbackStep + doneRun := doneRun + doneHalted := doneHalted } + · intro value hstart hlimit + rw [show actualTime value = + Classical.choose (iterationWitness value hstart hlimit) by + simp only [actualTime, dif_pos, hstart, hlimit, and_self]] + exact (Classical.choose_spec + (iterationWitness value hstart hlimit)).1 + · intro value hstart hlimit + rw [show actualTime value = + Classical.choose (iterationWitness value hstart hlimit) by + simp only [actualTime, dif_pos, hstart, hlimit, and_self]] + exact (Classical.choose_spec + (iterationWitness value hstart hlimit)).2 + +theorem BinaryForSegmentSpec.reachesIn_internal {body : TM n} + {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue : ℕ} + (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue) : + ∀ count value, startValue ≤ value → value + count = limitValue → + ∃ time, time ≤ binaryForLoopTime bodyTime limitValue value count ∧ + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.scanCfg value) spec.doneCfg := by + intro count + induction count with + | zero => + intro value _hstart hlimit + have hvalue : value = limitValue := by omega + subst value + exact ⟨binaryForCompareTime limitValue, le_rfl, spec.doneRun⟩ + | succ count ih => + intro value hstart hlimit + have hvalue : value < limitValue := by omega + let iterationTime := spec.iterationTime value + have hiterationTime := spec.iterationTime_le value hstart hvalue + have hiteration := spec.iterationRun value hstart hvalue + obtain ⟨tailTime, htailTime, htail⟩ := + ih (value + 1) (by omega) (by omega) + have hloopback : (binaryForTM body counterIdx limitIdx).reachesIn 1 + (spec.iterationDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hstart hvalue) .zero + have hreach := reachesIn_trans (binaryForTM body counterIdx limitIdx) + (spec.testRun value hstart hvalue) + (reachesIn_trans (binaryForTM body counterIdx limitIdx) hiteration + (reachesIn_trans (binaryForTM body counterIdx limitIdx) + hloopback htail)) + refine ⟨binaryForCompareTime limitValue + + (iterationTime + (1 + tailTime)), ?_, hreach⟩ + rw [binaryForLoopTime] + omega + +/-- Convert a bounded segment certificate whose initial scanner state is the +driver start state into a time-bounded Hoare triple on its exact endpoint +tapes. -/ +theorem BinaryForSegmentSpec.hoareTime_internal {body : TM n} + {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue : ℕ} + (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue) + (hstartLimit : startValue ≤ limitValue) + (hscanState : + (spec.scanCfg startValue).state = + (binaryForTM body counterIdx limitIdx).qstart) : + (binaryForTM body counterIdx limitIdx).HoareTime + (fun inp work out => + inp = (spec.scanCfg startValue).input ∧ + work = (spec.scanCfg startValue).work ∧ + out = (spec.scanCfg startValue).output) + (fun inp work out => + inp = spec.doneCfg.input ∧ + work = spec.doneCfg.work ∧ + out = spec.doneCfg.output) + (binaryForLoopTime bodyTime limitValue startValue + (limitValue - startValue)) := by + intro inp work out hpre + have hsum : startValue + (limitValue - startValue) = limitValue := + Nat.add_sub_of_le hstartLimit + obtain ⟨time, htime, hrun⟩ := + spec.reachesIn_internal (limitValue - startValue) startValue le_rfl hsum + rcases hpre with ⟨rfl, rfl, rfl⟩ + refine ⟨spec.doneCfg, time, htime, ?_, spec.doneHalted, rfl, rfl, rfl⟩ + have hinitial : + { state := (binaryForTM body counterIdx limitIdx).qstart + input := (spec.scanCfg startValue).input + work := (spec.scanCfg startValue).work + output := (spec.scanCfg startValue).output } = + spec.scanCfg startValue := by + cases hcfg : spec.scanCfg startValue with + | mk state input work output => + simp only [hcfg] at hscanState ⊢ + subst state + rfl + rw [hinitial] + exact hrun + +theorem BinaryForSegmentSpaceSpec.ofInitialBounds_internal + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue inputLength spaceBound : ℕ} + (spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue) + (testInitialSpace iterationInitialSpace : ℕ → ℕ) + (testInitial : ∀ value, startValue ≤ value → value ≤ limitValue → + (spec.scanCfg value).WithinAuxSpace inputLength + (testInitialSpace value)) + (iterationInitial : ∀ value, startValue ≤ value → value < limitValue → + (spec.iterationStartCfg value).WithinAuxSpace inputLength + (iterationInitialSpace value)) + (testBound : ∀ value, startValue ≤ value → value ≤ limitValue → + testInitialSpace value + binaryForCompareTime limitValue ≤ spaceBound) + (iterationBound : ∀ value, startValue ≤ value → value < limitValue → + iterationInitialSpace value + spec.iterationTime value ≤ spaceBound) : + BinaryForSegmentSpaceSpec spec inputLength spaceBound where + testPrefixWithin value time cfg hstart hvalue htime hreach := by + have hinitial := testInitial value hstart hvalue + have hspace : cfg.WithinAuxSpace inputLength + (testInitialSpace value + time) := by + constructor + · intro i + exact le_trans ((binaryForTM body counterIdx limitIdx) + |>.work_head_reachesIn_bound hreach i) + (Nat.add_le_add_right (hinitial.1 i) time) + · calc + cfg.input.head ≤ (spec.scanCfg value).input.head + time := + (binaryForTM body counterIdx limitIdx).input_head_reachesIn_bound + hreach + _ ≤ inputLength + (testInitialSpace value + time) + 1 := by + have hinput := hinitial.2 + omega + have hbudget : testInitialSpace value + time ≤ spaceBound := + le_trans (Nat.add_le_add_left htime (testInitialSpace value)) + (testBound value hstart hvalue) + exact ⟨fun i => le_trans (hspace.1 i) hbudget, by + have hinput := hspace.2 + omega⟩ + iterationPrefixWithin value time cfg hstart hvalue htime hreach := by + have hinitial := iterationInitial value hstart hvalue + have hspace : cfg.WithinAuxSpace inputLength + (iterationInitialSpace value + time) := by + constructor + · intro i + exact le_trans ((binaryForTM body counterIdx limitIdx) + |>.work_head_reachesIn_bound hreach i) + (Nat.add_le_add_right (hinitial.1 i) time) + · calc + cfg.input.head ≤ (spec.iterationStartCfg value).input.head + time := + (binaryForTM body counterIdx limitIdx).input_head_reachesIn_bound + hreach + _ ≤ inputLength + (iterationInitialSpace value + time) + 1 := by + have hinput := hinitial.2 + omega + have hbudget : iterationInitialSpace value + time ≤ spaceBound := + le_trans (Nat.add_le_add_left htime (iterationInitialSpace value)) + (iterationBound value hstart hvalue) + exact ⟨fun i => le_trans (hspace.1 i) hbudget, by + have hinput := hspace.2 + omega⟩ + +theorem BinaryForSegmentSpaceSpec.prefix_withinAuxSpace_internal + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {startValue limitValue inputLength spaceBound : ℕ} + {spec : BinaryForSegmentSpec body counterIdx limitIdx bodyTime + startValue limitValue} + (spaceSpec : BinaryForSegmentSpaceSpec spec inputLength spaceBound) : + ∀ count value time (cfg : Cfg n (binaryForTM body counterIdx limitIdx).Q), + startValue ≤ value → value + count = limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.scanCfg value) cfg → + time ≤ binaryForLoopTime bodyTime limitValue value count → + cfg.WithinAuxSpace inputLength spaceBound := by + intro count + induction count with + | zero => + intro value time cfg hstart hlimit hreach _htime + have hvalue : value = limitValue := by omega + subst value + have hactual : time ≤ binaryForCompareTime limitValue := + (binaryForTM body counterIdx limitIdx).reachesIn_le_halt hreach + spec.doneRun spec.doneHalted + exact spaceSpec.testPrefixWithin limitValue time cfg hstart le_rfl + hactual hreach + | succ count ih => + intro value time cfg hstart hlimit hreach _htime + have hvalue : value < limitValue := by omega + let iterationTime := spec.iterationTime value + have hiterationRun := spec.iterationRun value hstart hvalue + obtain ⟨tailFullTime, htailBound, htailFull⟩ := + spec.reachesIn_internal count (value + 1) (by omega) (by omega) + have hloopback : (binaryForTM body counterIdx limitIdx).reachesIn 1 + (spec.iterationDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hstart hvalue) .zero + have hfull := reachesIn_trans (binaryForTM body counterIdx limitIdx) + (spec.testRun value hstart hvalue) + (reachesIn_trans (binaryForTM body counterIdx limitIdx) + hiterationRun + (reachesIn_trans (binaryForTM body counterIdx limitIdx) + hloopback htailFull)) + have hactual : + time ≤ binaryForCompareTime limitValue + + (iterationTime + (1 + tailFullTime)) := + (binaryForTM body counterIdx limitIdx).reachesIn_le_halt hreach + hfull spec.doneHalted + by_cases htest : time ≤ binaryForCompareTime limitValue + · exact spaceSpec.testPrefixWithin value time cfg hstart + (Nat.le_of_lt hvalue) htest hreach + · let afterTestTime := time - binaryForCompareTime limitValue + have htimeEq : binaryForCompareTime limitValue + afterTestTime = + time := by + dsimp only [afterTestTime] + exact Nat.add_sub_of_le (by omega) + by_cases hiteration : afterTestTime ≤ iterationTime + · obtain ⟨d, hprefix, _hsuffix⟩ := + reachesIn_prefix_internal hiterationRun hiteration + have hcanonical : + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.scanCfg value) d := by + have hrun := reachesIn_trans + (binaryForTM body counterIdx limitIdx) + (spec.testRun value hstart hvalue) hprefix + simpa [htimeEq] using hrun + have hcfg := + (binaryForTM body counterIdx limitIdx).reachesIn_right_unique + hreach hcanonical + rw [hcfg] + exact spaceSpec.iterationPrefixWithin value afterTestTime d + hstart hvalue hiteration hprefix + · let prefixTime := binaryForCompareTime limitValue + + iterationTime + 1 + have hprefixTime : prefixTime ≤ time := by + dsimp only [prefixTime, afterTestTime] at ⊢ hiteration + omega + let tailTime := time - prefixTime + have htailEq : prefixTime + tailTime = time := by + dsimp only [tailTime] + exact Nat.add_sub_of_le hprefixTime + have htailActual : tailTime ≤ tailFullTime := by + dsimp only [prefixTime, tailTime] at ⊢ hactual + omega + obtain ⟨d, htail, _hsuffix⟩ := + reachesIn_prefix_internal htailFull htailActual + have hcanonical : + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.scanCfg value) d := by + have hrun := reachesIn_trans + (binaryForTM body counterIdx limitIdx) + (spec.testRun value hstart hvalue) + (reachesIn_trans (binaryForTM body counterIdx limitIdx) + hiterationRun + (reachesIn_trans (binaryForTM body counterIdx limitIdx) + hloopback htail)) + convert hrun using 1 + all_goals + dsimp only [prefixTime] at htailEq ⊢ + omega + have hcfg := + (binaryForTM body counterIdx limitIdx).reachesIn_right_unique + hreach hcanonical + rw [hcfg] + exact ih (value + 1) tailTime d (by omega) (by omega) htail + (le_trans htailActual htailBound) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix.lean b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix.lean new file mode 100644 index 00000000..19aa5463 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefix.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefix.Internal + +/-! +# Binary-bounded work-prefix blanking + +This module exposes a reusable reset primitive for work tapes that may contain +sparse data. Given a preserved canonical binary limit and a canonical zero +scratch counter, the machine blanks every target cell from one through the +limit, rewinds the target to cell one, and restores the counter to zero. + +The all-prefix contract charges the target's linear scan in the numeric limit +and only binary-width overhead for the loop controller. In the intended probe +application the limit is itself a logarithmic auxiliary-space bound. +-/ + +namespace Complexity + +namespace TM + +@[simp] theorem blankPrefixCells_zero (cells : ℕ → Γ) : + blankPrefixCells cells 0 = cells := + blankPrefixCells_zero_internal cells + +theorem blankPrefixCells_succ (cells : ℕ → Γ) (count : ℕ) : + Function.update (blankPrefixCells cells count) (count + 1) Γ.blank = + blankPrefixCells cells (count + 1) := + blankPrefixCells_succ_internal cells count + +/-- Blanking through a complete support bound returns the literal canonical +parked blank tape. -/ +theorem blankPrefixResultTape_eq_parkedBlank (tape : Tape) + (limit : ℕ) (hinvariant : tape.StartInvariant) + (hblank : ∀ index, limit < index → tape.cells index = Γ.blank) : + blankPrefixResultTape tape limit = + (Tape.init []).move Dir3.right := + blankPrefixResultTape_eq_parkedBlank_internal tape limit hinvariant hblank + +/-- A binary-bounded prefix reset preserves the complete external frame, +changes only the selected target cells, and restores the scratch counter. -/ +theorem blankWorkPrefixTM_hoareTime_frame {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (limit : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetInvariant : (work₀ targetIdx).StartInvariant) + (htargetHead : (work₀ targetIdx).head = 1) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) : + (blankWorkPrefixTM targetIdx counterIdx limitIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit) ∧ + out = out₀) + (blankWorkPrefixTime limit) := + blankWorkPrefixTM_hoareTime_frame_internal targetIdx counterIdx limitIdx + hdistinct limit inp₀ work₀ out₀ htargetInvariant htargetHead hinp + hwork hcounter hlimit hout + +/-- The complete reset contract with an honest bound for every reachable +configuration. -/ +theorem blankWorkPrefixTM_hoareTimeSpace_frame {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (limit inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetInvariant : (work₀ targetIdx).StartInvariant) + (htargetHead : (work₀ targetIdx).head = 1) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (blankWorkPrefixTM targetIdx counterIdx limitIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit) ∧ + out = out₀) + (blankWorkPrefixTime limit) inputLength + (blankWorkPrefixSpace initialSpace limit) := + blankWorkPrefixTM_hoareTimeSpace_frame_internal targetIdx counterIdx limitIdx + hdistinct limit inputLength initialSpace inp₀ work₀ out₀ + htargetInvariant htargetHead hinp hwork hcounter hlimit hout hworkSpace + hinputSpace + +/-- Rewind an arbitrary source-space-bounded target head before applying the +same exact sparse-prefix reset. -/ +theorem rewindBlankWorkPrefixTM_hoareTimeSpace_frame {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (headBound limit inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetInvariant : (work₀ targetIdx).StartInvariant) + (htargetHead : (work₀ targetIdx).head ≤ headBound) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ targetIdx → Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (rewindBlankWorkPrefixTM targetIdx counterIdx limitIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit) ∧ + out = out₀) + (rewindBlankWorkPrefixTime headBound limit) inputLength + (rewindBlankWorkPrefixSpace initialSpace headBound limit) := + rewindBlankWorkPrefixTM_hoareTimeSpace_frame_internal targetIdx counterIdx + limitIdx hdistinct headBound limit inputLength initialSpace inp₀ work₀ + out₀ htargetInvariant htargetHead hinp hother hcounter hlimit hout + hworkSpace hinputSpace + +/-- Bounded-prefix blanking never moves the physical output head left. -/ +theorem blankWorkPrefixTM_isTransducer {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) : + (blankWorkPrefixTM targetIdx counterIdx limitIdx).IsTransducer := + blankWorkPrefixTM_isTransducer_internal targetIdx counterIdx limitIdx + +/-- Rewind-then-blank cleanup preserves one-way-output safety. -/ +theorem rewindBlankWorkPrefixTM_isTransducer {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) : + (rewindBlankWorkPrefixTM targetIdx counterIdx limitIdx).IsTransducer := + rewindBlankWorkPrefixTM_isTransducer_internal targetIdx counterIdx limitIdx + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix/Defs.lean b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix/Defs.lean new file mode 100644 index 00000000..613b65f9 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix/Defs.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs + +/-! +# Binary-bounded work-prefix blanking -- definitions + +A reusable output probe may leave sparse data anywhere inside its advertised +work-space envelope. Clearing only an initial packed bitstring is therefore +insufficient before replay. This module blanks every cell in a prefix whose +length is stored on a canonical binary limit tape, then rewinds the target and +restores a zero scratch counter. +-/ + +namespace Complexity + +namespace TM + +/-- The target, loop counter, and preserved limit occupy distinct work tapes. -/ +def BlankWorkPrefixDistinct {n : ℕ} (targetIdx counterIdx limitIdx : Fin n) : + Prop := + targetIdx ≠ counterIdx ∧ targetIdx ≠ limitIdx ∧ counterIdx ≠ limitIdx + +/-- Blank cells `1` through `count`, preserving every other cell. -/ +def blankPrefixCells (cells : ℕ → Γ) (count : ℕ) : ℕ → Γ := + fun index => + if 1 ≤ index ∧ index ≤ count then Γ.blank else cells index + +/-- Tape after blanking `count` cells from the left and advancing once past +that prefix. -/ +def blankPrefixTape (tape : Tape) (count : ℕ) : Tape where + head := count + 1 + cells := blankPrefixCells tape.cells count + +/-- Tape after blanking a bounded prefix and rewinding its head to cell one. -/ +def blankPrefixResultTape (tape : Tape) (count : ℕ) : Tape where + head := 1 + cells := blankPrefixCells tape.cells count + +/-- One transition blanks the target cell and moves its head right. -/ +def blankWorkCellTM {n : ℕ} (targetIdx : Fin n) : TM n where + Q := Bool + qstart := false + qhalt := true + δ := fun state inputHead workHeads outputHead => + if state then + allIdle true inputHead workHeads outputHead + else + (true, + fun i => if i = targetIdx then Γw.blank + else readBackWrite (workHeads i), + readBackWrite outputHead, + idleDir inputHead, + fun i => if i = targetIdx then Dir3.right + else idleDir (workHeads i), + idleDir outputHead) + δ_right_of_start := by + intro state inputHead workHeads outputHead + by_cases hstate : state + · simp [hstate, allIdle, idleDir] + · simp only [hstate] + refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + by_cases hitarget : i = targetIdx + · simp [hitarget] + · simp [hitarget, idleDir_right_of_start hi] + +/-- Count from zero to the preserved binary limit, blanking and advancing the +target once per iteration. -/ +def blankWorkPrefixLoopTM {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) : TM n := + binaryForTM (blankWorkCellTM targetIdx) counterIdx limitIdx + +/-- Blank the binary-bounded prefix, rewind the target, and clear the loop +counter back to canonical zero. -/ +def blankWorkPrefixTM {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) : TM n := + seqTM (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx) + (seqTM (rewindWorkTM targetIdx) (clearWorkTM counterIdx)) + +/-- Rewind an arbitrarily positioned target before blanking its bounded +prefix. This is the replay-cleanup form used after a source transducer halts. -/ +def rewindBlankWorkPrefixTM {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) : TM n := + seqTM (rewindWorkTM targetIdx) + (blankWorkPrefixTM targetIdx counterIdx limitIdx) + +/-- Exact loop time before target rewind and counter cleanup. -/ +def blankWorkPrefixLoopTime (limit : ℕ) : ℕ := + binaryForLoopTime (fun _ => 1) limit 0 limit + +/-- Advertised complete runtime of bounded-prefix blanking. -/ +def blankWorkPrefixTime (limit : ℕ) : ℕ := + blankWorkPrefixLoopTime limit + 1 + (limit + 3) + 1 + + clearWorkTimeBound limit.bits.length + +/-- All-prefix auxiliary-space envelope from an initial work-head bound. -/ +def blankWorkPrefixSpace (initialSpace limit : ℕ) : ℕ := + max (initialSpace + limit + 2 * limit.size + 4) + (max ((initialSpace + limit) + (limit + 3)) + (initialSpace + clearWorkTimeBound limit.bits.length)) + +/-- Exact advertised runtime for rewind followed by bounded-prefix blanking. -/ +def rewindBlankWorkPrefixTime (headBound limit : ℕ) : ℕ := + headBound + 2 + 1 + blankWorkPrefixTime limit + +/-- All-prefix envelope for rewind followed by bounded-prefix blanking. -/ +def rewindBlankWorkPrefixSpace + (initialSpace headBound limit : ℕ) : ℕ := + max (initialSpace + (headBound + 2)) + (blankWorkPrefixSpace initialSpace limit) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix/Internal.lean b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix/Internal.lean new file mode 100644 index 00000000..d36221df --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefix/Internal.lean @@ -0,0 +1,1222 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefix.Defs +import Complexitylib.Models.TuringMachine.Combinators.Internal.Seq +import Complexitylib.Models.TuringMachine.Hoare.Space +import Complexitylib.Models.TuringMachine.Subroutines.Internal +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor +import Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control +import Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import Complexitylib.Models.TuringMachine.Subroutines.ClearWork +import Complexitylib.Models.TuringMachine.Registers + +/-! +# Binary-bounded work-prefix blanking -- proof internals +-/ + +namespace Complexity + +namespace TM + +private theorem hasBinaryNat_parked {tape : Tape} {value : ℕ} + (hvalue : tape.HasBinaryNat value) : Parked tape := by + refine ⟨by rw [hvalue.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start hvalue.2.2 + +theorem blankPrefixCells_zero_internal (cells : ℕ → Γ) : + blankPrefixCells cells 0 = cells := by + funext index + simp [blankPrefixCells] + omega + +theorem blankPrefixCells_succ_internal (cells : ℕ → Γ) (count : ℕ) : + Function.update (blankPrefixCells cells count) (count + 1) Γ.blank = + blankPrefixCells cells (count + 1) := by + funext index + by_cases hindex : index = count + 1 + · subst index + simp [blankPrefixCells] + · rw [Function.update_of_ne hindex] + simp only [blankPrefixCells] + by_cases hold : 1 ≤ index ∧ index ≤ count + · rw [if_pos hold, if_pos] + omega + · rw [if_neg hold, if_neg] + omega + +theorem blankPrefixTape_zero_internal (tape : Tape) + (hhead : tape.head = 1) : + blankPrefixTape tape 0 = tape := by + apply Tape.ext + · simpa [blankPrefixTape] using hhead.symm + · exact blankPrefixCells_zero_internal tape.cells + +theorem blankPrefixTape_writeAndMove_internal (tape : Tape) + (count : ℕ) : + (blankPrefixTape tape count).writeAndMove Γw.blank Dir3.right = + blankPrefixTape tape (count + 1) := by + apply Tape.ext + · simp [blankPrefixTape, Tape.writeAndMove, Tape.move, Tape.write] + · simp [Tape.writeAndMove, Tape.move, Tape.write, blankPrefixTape, + blankPrefixCells_succ_internal] + +theorem blankPrefixTape_startInvariant_internal (tape : Tape) + (hinvariant : tape.StartInvariant) (count : ℕ) : + (blankPrefixTape tape count).StartInvariant := by + constructor + · simp [blankPrefixTape, blankPrefixCells, hinvariant.1] + · intro index hindex + simp only [blankPrefixTape, blankPrefixCells] + split + · decide + · exact hinvariant.2 index hindex + +theorem blankPrefixResultTape_eq_parkedBlank_internal (tape : Tape) + (limit : ℕ) (hinvariant : tape.StartInvariant) + (hblank : ∀ index, limit < index → tape.cells index = Γ.blank) : + blankPrefixResultTape tape limit = + (Tape.init []).move Dir3.right := by + apply Tape.ext + · simp [blankPrefixResultTape, Tape.init, Tape.move] + · funext index + change blankPrefixCells tape.cells limit index = + (if index = 0 then Γ.start else Γ.blank) + by_cases hzero : index = 0 + · subst index + simp [blankPrefixCells, hinvariant.1] + · have hpositive : 1 ≤ index := by omega + by_cases hprefix : index ≤ limit + · simp [blankPrefixCells, hpositive, hprefix, hzero] + · rw [show blankPrefixCells tape.cells limit index = tape.cells index by + simp [blankPrefixCells, hpositive, hprefix]] + rw [hblank index (by omega)] + simp [hzero] + +theorem blankWorkCellTM_isTransducer_internal {n : ℕ} + (targetIdx : Fin n) : + (blankWorkCellTM targetIdx).IsTransducer := by + intro state inputHead workHeads outputHead + cases state <;> cases outputHead <;> + simp [blankWorkCellTM, allIdle, idleDir] + +private def blankPrefixWorkAt {n : ℕ} (work : Fin n → Tape) + (targetIdx counterIdx : Fin n) (value : ℕ) : Fin n → Tape := + Function.update + (Function.update work targetIdx (blankPrefixTape (work targetIdx) value)) + counterIdx + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + +private theorem blankPrefixWorkAt_target {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) + (hne : targetIdx ≠ counterIdx) (value : ℕ) : + blankPrefixWorkAt work targetIdx counterIdx value targetIdx = + blankPrefixTape (work targetIdx) value := by + simp [blankPrefixWorkAt, hne] + +private theorem blankPrefixWorkAt_counter {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) (value : ℕ) : + (blankPrefixWorkAt work targetIdx counterIdx value counterIdx).HasBinaryNat + value := by + simp [blankPrefixWorkAt, Tape.init_move_right_hasBinaryNat] + +private theorem blankPrefixWorkAt_other {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx i : Fin n) + (hitarget : i ≠ targetIdx) (hicounter : i ≠ counterIdx) + (value : ℕ) : + blankPrefixWorkAt work targetIdx counterIdx value i = work i := by + simp [blankPrefixWorkAt, hitarget, hicounter] + +private def blankPrefixWorkAfterCell {n : ℕ} (work : Fin n → Tape) + (targetIdx counterIdx : Fin n) (value : ℕ) : Fin n → Tape := + Function.update + (Function.update work targetIdx + (blankPrefixTape (work targetIdx) (value + 1))) + counterIdx + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + +private theorem blankPrefixWorkAfterCell_target {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) + (hne : targetIdx ≠ counterIdx) (value : ℕ) : + blankPrefixWorkAfterCell work targetIdx counterIdx value targetIdx = + blankPrefixTape (work targetIdx) (value + 1) := by + simp [blankPrefixWorkAfterCell, hne] + +private theorem blankPrefixWorkAfterCell_counter {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) (value : ℕ) : + blankPrefixWorkAfterCell work targetIdx counterIdx value counterIdx = + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right := by + simp [blankPrefixWorkAfterCell] + +private theorem blankPrefixWorkAfterCell_other {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx i : Fin n) + (hitarget : i ≠ targetIdx) (hicounter : i ≠ counterIdx) + (value : ℕ) : + blankPrefixWorkAfterCell work targetIdx counterIdx value i = work i := by + simp [blankPrefixWorkAfterCell, hitarget, hicounter] + +private theorem blankWorkCellTM_step_at + {n : ℕ} (targetIdx counterIdx : Fin n) + (hne : targetIdx ≠ counterIdx) (value : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : Parked inp) + (hother : ∀ i, i ≠ targetIdx → Parked (work i)) + (hout : Parked out) : + (blankWorkCellTM targetIdx).step + { state := (blankWorkCellTM targetIdx).qstart + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx value + output := out } = + some + { state := (blankWorkCellTM targetIdx).qhalt + input := inp + work := blankPrefixWorkAfterCell work targetIdx counterIdx value + output := out } := by + simp only [TM.step, blankWorkCellTM, Bool.false_eq_true, ↓reduceIte] + congr 1 + apply Cfg.ext + · rfl + · exact hinp.move_idle + · funext i + by_cases hit : i = targetIdx + · subst i + simp only [if_pos] + rw [blankPrefixWorkAt_target work targetIdx counterIdx hne, + blankPrefixWorkAfterCell_target work targetIdx counterIdx hne] + exact blankPrefixTape_writeAndMove_internal (work targetIdx) value + · simp only [if_neg hit] + by_cases hic : i = counterIdx + · subst i + have hcounterEq := + (blankPrefixWorkAt_counter work targetIdx counterIdx value).eq_init_move_right + rw [hcounterEq, + blankPrefixWorkAfterCell_counter work targetIdx counterIdx] + exact + (hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat value)).writeAndMove_readBack_idle + · rw [blankPrefixWorkAt_other work targetIdx counterIdx i hit hic, + blankPrefixWorkAfterCell_other work targetIdx counterIdx i hit hic] + exact (hother i hit).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +private theorem blankPrefixTape_parked (tape : Tape) + (htape : Parked tape) (count : ℕ) : + Parked (blankPrefixTape tape count) := by + constructor + · simp [blankPrefixTape] + · intro index hindex + simp only [blankPrefixTape, blankPrefixCells] + split + · decide + · exact htape.2 index hindex + +private theorem blankPrefixResultTape_parked (tape : Tape) + (htape : Parked tape) (count : ℕ) : + Parked (blankPrefixResultTape tape count) := by + constructor + · simp [blankPrefixResultTape] + · intro index hindex + simp only [blankPrefixResultTape, blankPrefixCells] + split + · decide + · exact htape.2 index hindex + +private theorem blankPrefixWorkAt_zero_eq {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) + (hne : targetIdx ≠ counterIdx) + (htargetHead : (work targetIdx).head = 1) + (hcounter : (work counterIdx).HasBinaryNat 0) : + blankPrefixWorkAt work targetIdx counterIdx 0 = work := by + funext i + by_cases hit : i = targetIdx + · subst i + rw [blankPrefixWorkAt_target work targetIdx counterIdx hne] + exact blankPrefixTape_zero_internal (work targetIdx) htargetHead + · by_cases hic : i = counterIdx + · subst i + exact + (blankPrefixWorkAt_counter work targetIdx counterIdx 0).eq_init_move_right.trans + hcounter.eq_init_move_right.symm + · exact blankPrefixWorkAt_other work targetIdx counterIdx i hit hic 0 + +private theorem blankPrefixWorkAt_parked {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) + (hne : targetIdx ≠ counterIdx) (value : ℕ) + (hwork : ∀ i, Parked (work i)) : + ∀ i, Parked (blankPrefixWorkAt work targetIdx counterIdx value i) := by + intro i + by_cases hit : i = targetIdx + · subst i + rw [blankPrefixWorkAt_target work targetIdx counterIdx hne] + exact blankPrefixTape_parked (work targetIdx) (hwork targetIdx) value + · by_cases hic : i = counterIdx + · subst i + exact hasBinaryNat_parked + (blankPrefixWorkAt_counter work targetIdx counterIdx value) + · rw [blankPrefixWorkAt_other work targetIdx counterIdx i hit hic] + exact hwork i + +private theorem blankPrefixWorkAfterCell_parked {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) + (hne : targetIdx ≠ counterIdx) (value : ℕ) + (hwork : ∀ i, Parked (work i)) : + ∀ i, Parked (blankPrefixWorkAfterCell work targetIdx counterIdx value i) := by + intro i + by_cases hit : i = targetIdx + · subst i + rw [blankPrefixWorkAfterCell_target work targetIdx counterIdx hne] + exact blankPrefixTape_parked (work targetIdx) (hwork targetIdx) (value + 1) + · by_cases hic : i = counterIdx + · subst i + rw [blankPrefixWorkAfterCell_counter work targetIdx counterIdx] + exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat value) + · rw [blankPrefixWorkAfterCell_other work targetIdx counterIdx i hit hic] + exact hwork i + +private def blankPrefixScanCfg {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) (value : ℕ) : + Cfg n (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).Q := + { state := .inl (.scan true) + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx value + output := out } + +private def blankPrefixIterationStartCfg {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) (value : ℕ) : + Cfg n (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).Q := + { state := .inr + (binaryForIterationTM (blankWorkCellTM targetIdx) counterIdx).qstart + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx value + output := out } + +private def blankPrefixIterationDoneCfg {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) (value : ℕ) : + Cfg n (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).Q := + { state := .inr + (binaryForIterationTM (blankWorkCellTM targetIdx) counterIdx).qhalt + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx (value + 1) + output := out } + +private def blankPrefixDoneCfg {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) (limit : ℕ) : + Cfg n (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).Q := + { state := .inl .done + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx limit + output := out } + +private def blankPrefixRewoundWork {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) + (limit : ℕ) : Fin n → Tape := + Function.update (blankPrefixWorkAt work targetIdx counterIdx limit) + targetIdx (blankPrefixResultTape (work targetIdx) limit) + +private def blankPrefixFinalWork {n : ℕ} + (work : Fin n → Tape) (targetIdx : Fin n) + (limit : ℕ) : Fin n → Tape := + Function.update work targetIdx + (blankPrefixResultTape (work targetIdx) limit) + +private def rewindTargetWork {n : ℕ} + (work : Fin n → Tape) (targetIdx : Fin n) : Fin n → Tape := + Function.update work targetIdx + { head := 1, cells := (work targetIdx).cells } + +private theorem blankWorkCellTM_reachesIn_at {n : ℕ} + (targetIdx counterIdx : Fin n) (hne : targetIdx ≠ counterIdx) + (value : ℕ) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hout : Parked out) : + (blankWorkCellTM targetIdx).reachesIn 1 + { state := (blankWorkCellTM targetIdx).qstart + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx value + output := out } + { state := (blankWorkCellTM targetIdx).qhalt + input := inp + work := blankPrefixWorkAfterCell work targetIdx counterIdx value + output := out } := + .step (blankWorkCellTM_step_at targetIdx counterIdx hne value inp work out + hinp (fun i _ => hwork i) hout) .zero + +private theorem binarySuccAfterBlankCell_reachesIn {n : ℕ} + (targetIdx counterIdx : Fin n) (hne : targetIdx ≠ counterIdx) + (value : ℕ) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hout : Parked out) : + (binarySuccTM counterIdx).reachesIn (binarySuccTime value) + { state := (binarySuccTM counterIdx).qstart + input := inp + work := blankPrefixWorkAfterCell work targetIdx counterIdx value + output := out } + { state := (binarySuccTM counterIdx).qhalt + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx (value + 1) + output := out } := by + have hworkAfter := blankPrefixWorkAfterCell_parked work targetIdx counterIdx + hne value hwork + have hcounter : + Tape.HasBinaryNat + (blankPrefixWorkAfterCell work targetIdx counterIdx value counterIdx) + value := by + rw [blankPrefixWorkAfterCell_counter work targetIdx counterIdx] + exact Tape.init_move_right_hasBinaryNat value + obtain ⟨c', hreach, hhalt, hinput, hother, hcounter', houtput⟩ := + binarySuccTM_reachesIn_frame counterIdx value inp + (blankPrefixWorkAfterCell work targetIdx counterIdx value) out + hcounter hinp.read_ne_start + (fun i hi => (hworkAfter i).read_ne_start) hout.read_ne_start + have hworkEq : + c'.work = blankPrefixWorkAt work targetIdx counterIdx (value + 1) := by + funext i + by_cases hic : i = counterIdx + · subst i + exact hcounter'.eq_init_move_right.trans + (blankPrefixWorkAt_counter work targetIdx counterIdx + (value + 1)).eq_init_move_right.symm + · rw [hother i hic] + simp [blankPrefixWorkAfterCell, blankPrefixWorkAt, hic] + have hc' : c' = + { state := (binarySuccTM counterIdx).qhalt + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx (value + 1) + output := out } := + Cfg.ext hhalt hinput hworkEq houtput + simpa [hc'] using hreach + +private theorem blankPrefixIteration_reachesIn {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hne : targetIdx ≠ counterIdx) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hout : Parked out) (value : ℕ) : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reachesIn + (binaryForIterationTime (fun _ => 1) value) + (blankPrefixIterationStartCfg targetIdx counterIdx limitIdx + inp work out value) + (blankPrefixIterationDoneCfg targetIdx counterIdx limitIdx + inp work out value) := by + let body := blankWorkCellTM targetIdx + let succ := binarySuccTM counterIdx + have hbody := blankWorkCellTM_reachesIn_at targetIdx counterIdx hne + value inp work out hinp hwork hout + have hsucc := binarySuccAfterBlankCell_reachesIn targetIdx counterIdx hne + value inp work out hinp hwork hout + have hinpTransition : transitionInput inp = inp := + hinp.transitionInput_eq_self + have hworkTransition : + (fun i => transitionTape + (blankPrefixWorkAfterCell work targetIdx counterIdx value i)) = + blankPrefixWorkAfterCell work targetIdx counterIdx value := by + funext i + exact (blankPrefixWorkAfterCell_parked work targetIdx counterIdx hne + value hwork i).transitionTape_eq_self + have houtTransition : transitionTape out = out := + hout.transitionTape_eq_self + have hsucc' : succ.reachesIn (binarySuccTime value) + { state := succ.qstart + input := transitionInput inp + work := fun i => transitionTape + (blankPrefixWorkAfterCell work targetIdx counterIdx value i) + output := transitionTape out } + { state := succ.qhalt + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx (value + 1) + output := out } := by + rw [hinpTransition, hworkTransition, houtTransition] + exact hsucc + have hseq := seqTM_reachesIn_of_reachesIn body succ hbody rfl hsucc' + have hlift := binaryForTM_iteration_reachesIn_internal + (blankWorkCellTM targetIdx) counterIdx limitIdx hseq + simpa [body, succ, blankWorkPrefixLoopTM, blankPrefixIterationStartCfg, + blankPrefixIterationDoneCfg, binaryForIterationTime, + binaryForIterationTM, binaryForIterationWrap, phase1Wrap, + phase2Wrap] using hlift + +private theorem blankPrefixLoopback_step {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hne : targetIdx ≠ counterIdx) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hout : Parked out) (value : ℕ) : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).step + (blankPrefixIterationDoneCfg targetIdx counterIdx limitIdx + inp work out value) = + some (blankPrefixScanCfg targetIdx counterIdx limitIdx + inp work out (value + 1)) := by + let c : Cfg n + (binaryForIterationTM (blankWorkCellTM targetIdx) counterIdx).Q := + { state := + (binaryForIterationTM (blankWorkCellTM targetIdx) counterIdx).qhalt + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx (value + 1) + output := out } + have hworkAt := blankPrefixWorkAt_parked work targetIdx counterIdx hne + (value + 1) hwork + have hstep := binaryForTM_step_iteration_halt_internal + (blankWorkCellTM targetIdx) counterIdx limitIdx c rfl + hinp.read_ne_start (fun i => (hworkAt i).read_ne_start) + hout.read_ne_start + simpa [c, blankWorkPrefixLoopTM, blankPrefixIterationDoneCfg, + blankPrefixScanCfg, binaryForIterationWrap] using hstep + +private theorem blankPrefixTest_reachesIn {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (limit value : ℕ) (hlt : value < limit) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hlimit : (work limitIdx).HasBinaryNat limit) + (hout : Parked out) : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reachesIn + (binaryForCompareTime limit) + (blankPrefixScanCfg targetIdx counterIdx limitIdx inp work out value) + (blankPrefixIterationStartCfg targetIdx counterIdx limitIdx + inp work out value) := by + have hlimitAt : + Tape.HasBinaryNat + (blankPrefixWorkAt work targetIdx counterIdx value limitIdx) limit := by + rw [blankPrefixWorkAt_other work targetIdx counterIdx limitIdx + (Ne.symm hdistinct.2.1) (Ne.symm hdistinct.2.2)] + exact hlimit + have hworkAt := blankPrefixWorkAt_parked work targetIdx counterIdx + hdistinct.1 value hwork + have hrun := binaryForTM_compare_reachesIn_frame_of_lt + (blankWorkCellTM targetIdx) counterIdx limitIdx hdistinct.2.2 + value limit hlt inp + (blankPrefixWorkAt work targetIdx counterIdx value) out + (blankPrefixWorkAt_counter work targetIdx counterIdx value) hlimitAt + hinp.read_ne_start + (fun i _ _ => (hworkAt i).read_ne_start) hout.read_ne_start + simpa [blankWorkPrefixLoopTM, blankPrefixScanCfg, + blankPrefixIterationStartCfg] using hrun + +private theorem blankPrefixDone_reachesIn {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (limit : ℕ) (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hlimit : (work limitIdx).HasBinaryNat limit) + (hout : Parked out) : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reachesIn + (binaryForCompareTime limit) + (blankPrefixScanCfg targetIdx counterIdx limitIdx inp work out limit) + (blankPrefixDoneCfg targetIdx counterIdx limitIdx inp work out limit) := by + have hlimitAt : + Tape.HasBinaryNat + (blankPrefixWorkAt work targetIdx counterIdx limit limitIdx) limit := by + rw [blankPrefixWorkAt_other work targetIdx counterIdx limitIdx + (Ne.symm hdistinct.2.1) (Ne.symm hdistinct.2.2)] + exact hlimit + have hworkAt := blankPrefixWorkAt_parked work targetIdx counterIdx + hdistinct.1 limit hwork + have hrun := binaryForTM_compare_reachesIn_frame_of_eq + (blankWorkCellTM targetIdx) counterIdx limitIdx hdistinct.2.2 limit + inp (blankPrefixWorkAt work targetIdx counterIdx limit) out + (blankPrefixWorkAt_counter work targetIdx counterIdx limit) hlimitAt + hinp.read_ne_start + (fun i _ _ => (hworkAt i).read_ne_start) hout.read_ne_start + simpa [blankWorkPrefixLoopTM, blankPrefixScanCfg, + blankPrefixDoneCfg] using hrun + +private def blankPrefixLoopSpec {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (limit : ℕ) (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hlimit : (work limitIdx).HasBinaryNat limit) + (hout : Parked out) : + BinaryForLoopSpec (blankWorkCellTM targetIdx) counterIdx limitIdx + (fun _ => 1) limit where + counter_ne_limit := hdistinct.2.2 + scanCfg := blankPrefixScanCfg targetIdx counterIdx limitIdx inp work out + iterationStartCfg := + blankPrefixIterationStartCfg targetIdx counterIdx limitIdx inp work out + iterationDoneCfg := + blankPrefixIterationDoneCfg targetIdx counterIdx limitIdx inp work out + doneCfg := blankPrefixDoneCfg targetIdx counterIdx limitIdx + inp work out limit + testRun value hvalue := blankPrefixTest_reachesIn targetIdx counterIdx + limitIdx hdistinct inp work out limit value hvalue hinp hwork hlimit hout + iterationRun value _ := blankPrefixIteration_reachesIn targetIdx counterIdx + limitIdx hdistinct.1 inp work out hinp hwork hout value + loopbackStep value _ := blankPrefixLoopback_step targetIdx counterIdx + limitIdx hdistinct.1 inp work out hinp hwork hout value + doneRun := blankPrefixDone_reachesIn targetIdx counterIdx limitIdx + hdistinct inp work out limit hinp hwork hlimit hout + +/-- The binary loop blanks exactly the bounded target prefix and stops with its +scratch counter equal to the preserved limit. -/ +theorem blankWorkPrefixLoopTM_reachesIn_frame_internal {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (limit : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (htargetHead : (work₀ targetIdx).head = 1) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reachesIn + (blankWorkPrefixLoopTime limit) + { state := (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } + { state := (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).qhalt + input := inp₀ + work := blankPrefixWorkAt work₀ targetIdx counterIdx limit + output := out₀ } := by + let spec := blankPrefixLoopSpec targetIdx counterIdx limitIdx hdistinct + inp₀ work₀ out₀ limit hinp hwork hlimit hout + have hrun := spec.reachesIn limit 0 (by omega) + have hstart : spec.scanCfg 0 = + { state := (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } := by + dsimp only [spec, blankPrefixLoopSpec] + simp [blankPrefixScanCfg, + blankPrefixWorkAt_zero_eq work₀ targetIdx counterIdx + hdistinct.1 htargetHead hcounter, + blankWorkPrefixLoopTM, binaryForTM] + rw [hstart] at hrun + simpa [spec, blankPrefixLoopSpec, blankPrefixDoneCfg, + blankWorkPrefixLoopTime, blankWorkPrefixLoopTM, binaryForTM] using hrun + +private theorem rewindBlankPrefix_hoareTime {n : ℕ} + (targetIdx counterIdx : Fin n) (hne : targetIdx ≠ counterIdx) + (limit : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetInvariant : (work₀ targetIdx).StartInvariant) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hout : Parked out₀) : + (rewindWorkTM targetIdx).HoareTime + (fun inp work out => + inp = inp₀ ∧ + work = blankPrefixWorkAt work₀ targetIdx counterIdx limit ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = blankPrefixRewoundWork work₀ targetIdx counterIdx limit ∧ + out = out₀) + (limit + 3) := by + let loopWork := blankPrefixWorkAt work₀ targetIdx counterIdx limit + let RewindFrame : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work targetIdx).cells = (loopWork targetIdx).cells ∧ + (∀ i, i ≠ targetIdx → work i = loopWork i) ∧ + out = out₀ + have hrewind := rewindWorkTM_hoareTime_frame targetIdx (limit + 1) + (P := RewindFrame) (by + intro inp work out inp' work' out' hframe hcells _hhead + hwork' hinp' houtCells houtHead + rcases hframe with ⟨hframeInput, hframeCells, hframeOther, + hframeOutput⟩ + refine ⟨hinp'.trans hframeInput, hcells.trans hframeCells, + fun i hi => (hwork' i hi).trans (hframeOther i hi), ?_⟩ + exact (Tape.ext houtHead houtCells).trans hframeOutput) + apply hrewind.consequence (b' := limit + 3) + · rintro inp work out ⟨rfl, rfl, rfl⟩ + have hloopParked := blankPrefixWorkAt_parked work₀ targetIdx + counterIdx hne limit hwork + refine ⟨?_, ?_, ?_, hinp.read_ne_start, hout.read_ne_start, + hout.1, ?_, rfl, rfl, fun _ _ => rfl, rfl⟩ + · rw [blankPrefixWorkAt_target work₀ targetIdx counterIdx hne] + exact (blankPrefixTape_startInvariant_internal + (work₀ targetIdx) htargetInvariant limit).1 + · exact (hloopParked targetIdx).2 + · rw [blankPrefixWorkAt_target work₀ targetIdx counterIdx hne] + simp [blankPrefixTape] + · intro i hi + exact ⟨(hloopParked i).read_ne_start, (hloopParked i).1⟩ + · intro inp work out hpost + rcases hpost with ⟨htargetHead, hframeInput, hframeCells, + hframeOther, hframeOutput⟩ + refine ⟨hframeInput, ?_, hframeOutput⟩ + funext i + by_cases hit : i = targetIdx + · subst i + rw [blankPrefixRewoundWork, Function.update_self] + apply Tape.ext + · exact htargetHead + · rw [hframeCells] + simp [loopWork, blankPrefixResultTape, blankPrefixTape, + blankPrefixWorkAt_target work₀ targetIdx counterIdx hne] + · rw [blankPrefixRewoundWork, Function.update_of_ne hit] + simpa [loopWork] using hframeOther i hit + · omega + +private theorem blankPrefixRewoundWork_parked {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) + (hne : targetIdx ≠ counterIdx) (limit : ℕ) + (hwork : ∀ i, Parked (work i)) : + ∀ i, Parked (blankPrefixRewoundWork work targetIdx counterIdx limit i) := by + intro i + by_cases hit : i = targetIdx + · subst i + rw [blankPrefixRewoundWork, Function.update_self] + exact blankPrefixResultTape_parked (work targetIdx) (hwork targetIdx) limit + · rw [blankPrefixRewoundWork, Function.update_of_ne hit] + exact blankPrefixWorkAt_parked work targetIdx counterIdx hne limit hwork i + +private theorem blankPrefixClear_eq_final {n : ℕ} + (work : Fin n → Tape) (targetIdx counterIdx : Fin n) + (hne : targetIdx ≠ counterIdx) (limit : ℕ) + (hcounter : (work counterIdx).HasBinaryNat 0) : + Function.update (blankPrefixRewoundWork work targetIdx counterIdx limit) + counterIdx ((Tape.init []).move Dir3.right) = + blankPrefixFinalWork work targetIdx limit := by + funext i + by_cases hit : i = targetIdx + · subst i + simp [blankPrefixRewoundWork, blankPrefixFinalWork, hne] + · by_cases hic : i = counterIdx + · subst i + rw [Function.update_self, blankPrefixFinalWork, + Function.update_of_ne (Ne.symm hne)] + exact hcounter.eq_init_move_right.symm + · simp [blankPrefixRewoundWork, blankPrefixFinalWork, + blankPrefixWorkAt, hit, hic] + +private theorem clearBlankPrefixCounter_hoareTime {n : ℕ} + (targetIdx counterIdx : Fin n) (hne : targetIdx ≠ counterIdx) + (limit : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hout : Parked out₀) : + (clearWorkTM counterIdx).HoareTime + (fun inp work out => + inp = inp₀ ∧ + work = blankPrefixRewoundWork work₀ targetIdx counterIdx limit ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit) ∧ + out = out₀) + (clearWorkTimeBound limit.bits.length) := by + have htarget : + blankPrefixRewoundWork work₀ targetIdx counterIdx limit counterIdx = + (Tape.init (limit.bits.map Γ.ofBool)).move Dir3.right := by + rw [blankPrefixRewoundWork, Function.update_of_ne (Ne.symm hne)] + exact + (blankPrefixWorkAt_counter work₀ targetIdx counterIdx limit).eq_init_move_right + have hclear := clearWorkTM_hoareTime_frame counterIdx limit.bits inp₀ + (blankPrefixRewoundWork work₀ targetIdx counterIdx limit) out₀ + htarget hinp + (fun i _ => blankPrefixRewoundWork_parked work₀ targetIdx counterIdx + hne limit hwork i) hout + apply hclear.consequence (b' := clearWorkTimeBound limit.bits.length) + · exact fun _ _ _ hpre => hpre + · rintro inp work out ⟨hinput, hworkEq, houtput⟩ + exact ⟨hinput, hworkEq.trans + (blankPrefixClear_eq_final work₀ targetIdx counterIdx hne + limit hcounter), houtput⟩ + · exact le_rfl + +/-- Exact complete contract: blank the bounded target prefix, rewind the +target, and restore the scratch counter to its initial canonical zero tape. -/ +theorem blankWorkPrefixTM_hoareTime_frame_internal {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (limit : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetInvariant : (work₀ targetIdx).StartInvariant) + (htargetHead : (work₀ targetIdx).head = 1) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) : + (blankWorkPrefixTM targetIdx counterIdx limitIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = blankPrefixFinalWork work₀ targetIdx limit ∧ + out = out₀) + (blankWorkPrefixTime limit) := by + let loop := blankWorkPrefixLoopTM targetIdx counterIdx limitIdx + let rewind := rewindWorkTM targetIdx + let clear := clearWorkTM counterIdx + let loopWork := blankPrefixWorkAt work₀ targetIdx counterIdx limit + have hloop : loop.HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = loopWork ∧ out = out₀) + (blankWorkPrefixLoopTime limit) := by + intro inp work out hpre + rcases hpre with ⟨hinput, hworkEq, houtput⟩ + subst inp + subst work + subst out + let c' : Cfg n loop.Q := + { state := loop.qhalt + input := inp₀ + work := loopWork + output := out₀ } + refine ⟨c', blankWorkPrefixLoopTime limit, le_rfl, ?_, rfl, + rfl, rfl, rfl⟩ + simpa [loop, loopWork] using + blankWorkPrefixLoopTM_reachesIn_frame_internal targetIdx counterIdx + limitIdx hdistinct limit inp₀ work₀ out₀ hinp hwork + htargetHead hcounter hlimit hout + have hrewind := rewindBlankPrefix_hoareTime targetIdx counterIdx + hdistinct.1 limit inp₀ work₀ out₀ htargetInvariant hinp hwork hout + have hclear := clearBlankPrefixCounter_hoareTime targetIdx counterIdx + hdistinct.1 limit inp₀ work₀ out₀ hinp hwork hcounter hout + have hrewindClear := seqTM_hoareTime rewind clear hrewind (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + have hrewoundParked := blankPrefixRewoundWork_parked work₀ + targetIdx counterIdx hdistinct.1 limit hwork + exact ⟨hinp.transitionInput_eq_self, + funext fun i => (hrewoundParked i).transitionTape_eq_self, + hout.transitionTape_eq_self⟩) + hclear + have hall := seqTM_hoareTime loop (seqTM rewind clear) hloop (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + have hloopParked := blankPrefixWorkAt_parked work₀ targetIdx + counterIdx hdistinct.1 limit hwork + exact ⟨hinp.transitionInput_eq_self, + funext fun i => (hloopParked i).transitionTape_eq_self, + hout.transitionTape_eq_self⟩) + hrewindClear + simpa [loop, rewind, clear, blankWorkPrefixTM, + blankWorkPrefixTime, blankPrefixFinalWork, Nat.add_assoc] using hall + +private theorem blankPrefixWorkAt_cfg_withinAuxSpace {n : ℕ} {Q : Type} + (state : Q) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (targetIdx counterIdx : Fin n) (hne : targetIdx ≠ counterIdx) + (current limit inputLength initialSpace : ℕ) + (hcurrent : current ≤ limit) + (hworkSpace : ∀ i, (work i).head ≤ initialSpace) + (hinputSpace : inp.head ≤ inputLength + initialSpace + 1) + (hone : 1 ≤ initialSpace) : + ({ state := state + input := inp + work := blankPrefixWorkAt work targetIdx counterIdx current + output := out } : Cfg n Q).WithinAuxSpace inputLength + (initialSpace + limit) := by + constructor + · intro i + change (blankPrefixWorkAt work targetIdx counterIdx current i).head ≤ + initialSpace + limit + by_cases hit : i = targetIdx + · subst i + rw [blankPrefixWorkAt_target work targetIdx counterIdx hne] + simp [blankPrefixTape] + omega + · by_cases hic : i = counterIdx + · subst i + have hcounter := blankPrefixWorkAt_counter work targetIdx + counterIdx current + rw [hcounter.2.1] + omega + · rw [blankPrefixWorkAt_other work targetIdx counterIdx i hit hic] + exact le_trans (hworkSpace i) (Nat.le_add_right _ _) + · change inp.head ≤ inputLength + (initialSpace + limit) + 1 + omega + +private def blankPrefixLoopSpaceSpec {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (limit inputLength initialSpace : ℕ) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) + (hone : 1 ≤ initialSpace) : + BinaryForLoopSpaceSpec + (blankPrefixLoopSpec targetIdx counterIdx limitIdx hdistinct + inp₀ work₀ out₀ limit hinp hwork hlimit hout) + inputLength (initialSpace + limit + 2 * limit.size + 4) where + testPrefixWithin := by + intro current time cfg hcurrent htime hreach + have hstart : Cfg.WithinAuxSpace + (blankPrefixScanCfg targetIdx counterIdx limitIdx + inp₀ work₀ out₀ current) + inputLength (initialSpace + limit) := by + simpa [blankPrefixScanCfg] using + blankPrefixWorkAt_cfg_withinAuxSpace + (blankPrefixScanCfg targetIdx counterIdx limitIdx + inp₀ work₀ out₀ current).state + inp₀ work₀ out₀ targetIdx counterIdx hdistinct.1 + current limit inputLength initialSpace hcurrent + hworkSpace hinputSpace hone + have hreach' : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reachesIn time + (blankPrefixScanCfg targetIdx counterIdx limitIdx + inp₀ work₀ out₀ current) cfg := by + simpa [blankPrefixLoopSpec] using hreach + exact (hstart.reachesIn hreach').mono le_rfl (by + simp [binaryForCompareTime] at htime + omega) + iterationPrefixWithin := by + intro current time cfg hcurrent htime hreach + have hstart : Cfg.WithinAuxSpace + (blankPrefixIterationStartCfg targetIdx counterIdx limitIdx + inp₀ work₀ out₀ current) + inputLength (initialSpace + limit) := by + simpa [blankPrefixIterationStartCfg] using + blankPrefixWorkAt_cfg_withinAuxSpace + (blankPrefixIterationStartCfg targetIdx counterIdx limitIdx + inp₀ work₀ out₀ current).state + inp₀ work₀ out₀ targetIdx counterIdx hdistinct.1 + current limit inputLength initialSpace (Nat.le_of_lt hcurrent) + hworkSpace hinputSpace hone + have hreach' : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reachesIn time + (blankPrefixIterationStartCfg targetIdx counterIdx limitIdx + inp₀ work₀ out₀ current) cfg := by + simpa [blankPrefixLoopSpec] using hreach + have hsucc := binarySuccTime_le current + have hsize := Nat.size_le_size (Nat.le_of_lt hcurrent) + exact (hstart.reachesIn hreach').mono le_rfl (by + simp [binaryForIterationTime] at htime + omega) + +private theorem blankWorkPrefixLoopTM_hoareSpace {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (limit inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetHead : (work₀ targetIdx).head = 1) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).HoareSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + inputLength (initialSpace + limit + 2 * limit.size + 4) := by + intro inp work out hpre cfg hreach + rcases hpre with ⟨hinput, hworkEq, houtput⟩ + subst inp + subst work + subst out + obtain ⟨time, hreachIn⟩ := + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reaches_to_reachesIn + hreach + let spec := blankPrefixLoopSpec targetIdx counterIdx limitIdx hdistinct + inp₀ work₀ out₀ limit hinp hwork hlimit hout + have hstart : spec.scanCfg 0 = + { state := (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } := by + dsimp only [spec, blankPrefixLoopSpec] + simp [blankPrefixScanCfg, + blankPrefixWorkAt_zero_eq work₀ targetIdx counterIdx + hdistinct.1 htargetHead hcounter, + blankWorkPrefixLoopTM, binaryForTM] + have hfull := spec.reachesIn limit 0 (by omega) + rw [hstart] at hfull + have htime : time ≤ binaryForLoopTime (fun _ => 1) limit 0 limit := + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reachesIn_le_halt + hreachIn hfull (by + dsimp only [spec, blankPrefixLoopSpec, blankPrefixDoneCfg] + rfl) + have hreachSpec : + (blankWorkPrefixLoopTM targetIdx counterIdx limitIdx).reachesIn time + (spec.scanCfg 0) cfg := by + rw [hstart] + exact hreachIn + have hone : 1 ≤ initialSpace := by + rw [← htargetHead] + exact hworkSpace targetIdx + exact (blankPrefixLoopSpaceSpec targetIdx counterIdx limitIdx hdistinct + inp₀ work₀ out₀ limit inputLength initialSpace hinp hwork + hlimit hout hworkSpace hinputSpace hone).prefix_withinAuxSpace + limit 0 time cfg (by omega) (by simpa [spec] using hreachSpec) htime + +private theorem blankPrefixRewound_cfg_withinAuxSpace {n : ℕ} {Q : Type} + (state : Q) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (targetIdx counterIdx : Fin n) + (limit inputLength initialSpace : ℕ) + (hworkSpace : ∀ i, (work i).head ≤ initialSpace) + (hinputSpace : inp.head ≤ inputLength + initialSpace + 1) + (hone : 1 ≤ initialSpace) : + ({ state := state + input := inp + work := blankPrefixRewoundWork work targetIdx counterIdx limit + output := out } : Cfg n Q).WithinAuxSpace inputLength initialSpace := by + constructor + · intro i + change (blankPrefixRewoundWork work targetIdx counterIdx limit i).head ≤ + initialSpace + by_cases hit : i = targetIdx + · subst i + simp [blankPrefixRewoundWork, blankPrefixResultTape, hone] + · rw [blankPrefixRewoundWork, Function.update_of_ne hit] + by_cases hic : i = counterIdx + · subst i + have hcounter := blankPrefixWorkAt_counter work targetIdx counterIdx limit + rw [hcounter.2.1] + exact hone + · rw [blankPrefixWorkAt_other work targetIdx counterIdx i hit hic] + exact hworkSpace i + · exact hinputSpace + +/-- Complete time-and-all-prefix-space contract for binary-bounded arbitrary +work-tape blanking. -/ +theorem blankWorkPrefixTM_hoareTimeSpace_frame_internal {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (limit inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetInvariant : (work₀ targetIdx).StartInvariant) + (htargetHead : (work₀ targetIdx).head = 1) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (blankWorkPrefixTM targetIdx counterIdx limitIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit) ∧ + out = out₀) + (blankWorkPrefixTime limit) inputLength + (blankWorkPrefixSpace initialSpace limit) := by + let loop := blankWorkPrefixLoopTM targetIdx counterIdx limitIdx + let rewind := rewindWorkTM targetIdx + let clear := clearWorkTM counterIdx + let loopWork := blankPrefixWorkAt work₀ targetIdx counterIdx limit + have hone : 1 ≤ initialSpace := by + rw [← htargetHead] + exact hworkSpace targetIdx + have hloopTime : loop.HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = loopWork ∧ out = out₀) + (blankWorkPrefixLoopTime limit) := by + intro inp work out hpre + rcases hpre with ⟨hinput, hworkEq, houtput⟩ + subst inp + subst work + subst out + let c' : Cfg n loop.Q := + { state := loop.qhalt + input := inp₀ + work := loopWork + output := out₀ } + refine ⟨c', blankWorkPrefixLoopTime limit, le_rfl, ?_, rfl, + rfl, rfl, rfl⟩ + simpa [loop, loopWork] using + blankWorkPrefixLoopTM_reachesIn_frame_internal targetIdx counterIdx + limitIdx hdistinct limit inp₀ work₀ out₀ hinp hwork + htargetHead hcounter hlimit hout + have hloopTS := hloopTime.and_hoareSpace + (blankWorkPrefixLoopTM_hoareSpace targetIdx counterIdx limitIdx + hdistinct limit inputLength initialSpace inp₀ work₀ out₀ + htargetHead hinp hwork hcounter hlimit hout hworkSpace hinputSpace) + have hrewindTime := rewindBlankPrefix_hoareTime targetIdx counterIdx + hdistinct.1 limit inp₀ work₀ out₀ htargetInvariant hinp hwork hout + have hrewindTS := hrewindTime.toHoareTimeSpace (by + intro inp work out hpre + rcases hpre with ⟨hinput, hworkEq, houtput⟩ + subst inp + subst work + subst out + simpa using blankPrefixWorkAt_cfg_withinAuxSpace rewind.qstart + inp₀ work₀ out₀ targetIdx counterIdx hdistinct.1 + limit limit inputLength initialSpace le_rfl hworkSpace hinputSpace hone) + have hclearTime := clearBlankPrefixCounter_hoareTime targetIdx counterIdx + hdistinct.1 limit inp₀ work₀ out₀ hinp hwork hcounter hout + have hclearTS := hclearTime.toHoareTimeSpace (by + intro inp work out hpre + rcases hpre with ⟨hinput, hworkEq, houtput⟩ + subst inp + subst work + subst out + exact blankPrefixRewound_cfg_withinAuxSpace clear.qstart inp₀ work₀ + out₀ targetIdx counterIdx limit inputLength initialSpace + hworkSpace hinputSpace hone) + have hrewindClear := seqTM_hoareTimeSpace rewind clear hrewindTS (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + have hrewoundParked := blankPrefixRewoundWork_parked work₀ + targetIdx counterIdx hdistinct.1 limit hwork + exact ⟨hinp.transitionInput_eq_self, + funext fun i => (hrewoundParked i).transitionTape_eq_self, + hout.transitionTape_eq_self⟩) + hclearTS + have hall := seqTM_hoareTimeSpace loop (seqTM rewind clear) hloopTS (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + have hloopParked := blankPrefixWorkAt_parked work₀ targetIdx + counterIdx hdistinct.1 limit hwork + exact ⟨hinp.transitionInput_eq_self, + funext fun i => (hloopParked i).transitionTape_eq_self, + hout.transitionTape_eq_self⟩) + hrewindClear + simpa [loop, rewind, clear, blankWorkPrefixTM, blankWorkPrefixTime, + blankWorkPrefixSpace, blankPrefixFinalWork, Nat.add_assoc] using hall + +private theorem rewindTarget_hoareTime {n : ℕ} + (targetIdx : Fin n) (headBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetInvariant : (work₀ targetIdx).StartInvariant) + (htargetHead : (work₀ targetIdx).head ≤ headBound) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ targetIdx → Parked (work₀ i)) + (hout : Parked out₀) : + (rewindWorkTM targetIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = rewindTargetWork work₀ targetIdx ∧ out = out₀) + (headBound + 2) := by + let RewindFrame : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work targetIdx).cells = (work₀ targetIdx).cells ∧ + (∀ i, i ≠ targetIdx → work i = work₀ i) ∧ + out = out₀ + have hrewind := rewindWorkTM_hoareTime_frame targetIdx headBound + (P := RewindFrame) (by + intro inp work out inp' work' out' hframe hcells _hhead + hwork' hinp' houtCells houtHead + rcases hframe with ⟨hframeInput, hframeCells, hframeOther, + hframeOutput⟩ + refine ⟨hinp'.trans hframeInput, hcells.trans hframeCells, + fun i hi => (hwork' i hi).trans (hframeOther i hi), ?_⟩ + exact (Tape.ext houtHead houtCells).trans hframeOutput) + apply hrewind.consequence (b' := headBound + 2) + · rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨htargetInvariant.1, htargetInvariant.2, htargetHead, + hinp.read_ne_start, hout.read_ne_start, hout.1, + fun i hi => ⟨(hother i hi).read_ne_start, (hother i hi).1⟩, + rfl, rfl, fun _ _ => rfl, rfl⟩ + · intro inp work out hpost + rcases hpost with ⟨htargetHead', hframeInput, hframeCells, + hframeOther, hframeOutput⟩ + refine ⟨hframeInput, ?_, hframeOutput⟩ + funext i + by_cases hit : i = targetIdx + · subst i + rw [rewindTargetWork, Function.update_self] + exact Tape.ext htargetHead' hframeCells + · rw [rewindTargetWork, Function.update_of_ne hit] + exact hframeOther i hit + · exact le_rfl + +private theorem rewindTargetWork_parked {n : ℕ} + (work : Fin n → Tape) (targetIdx : Fin n) + (htargetInvariant : (work targetIdx).StartInvariant) + (hother : ∀ i, i ≠ targetIdx → Parked (work i)) : + ∀ i, Parked (rewindTargetWork work targetIdx i) := by + intro i + by_cases hit : i = targetIdx + · subst i + rw [rewindTargetWork, Function.update_self] + exact ⟨le_rfl, htargetInvariant.2⟩ + · rw [rewindTargetWork, Function.update_of_ne hit] + exact hother i hit + +private theorem rewindTargetWork_startInvariant {n : ℕ} + (work : Fin n → Tape) (targetIdx : Fin n) + (htargetInvariant : (work targetIdx).StartInvariant) : + (rewindTargetWork work targetIdx targetIdx).StartInvariant := by + rw [rewindTargetWork, Function.update_self] + exact htargetInvariant + +private theorem rewindTargetWork_other {n : ℕ} + (work : Fin n → Tape) (targetIdx i : Fin n) (hne : i ≠ targetIdx) : + rewindTargetWork work targetIdx i = work i := by + rw [rewindTargetWork, Function.update_of_ne hne] + +/-- Rewinding first removes any assumption about the post-source target head; +the source-space head bound becomes the rewind budget. -/ +theorem rewindBlankWorkPrefixTM_hoareTimeSpace_frame_internal {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) + (hdistinct : BlankWorkPrefixDistinct targetIdx counterIdx limitIdx) + (headBound limit inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htargetInvariant : (work₀ targetIdx).StartInvariant) + (htargetHead : (work₀ targetIdx).head ≤ headBound) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ targetIdx → Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (rewindBlankWorkPrefixTM targetIdx counterIdx limitIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit) ∧ + out = out₀) + (rewindBlankWorkPrefixTime headBound limit) inputLength + (rewindBlankWorkPrefixSpace initialSpace headBound limit) := by + let rewind := rewindWorkTM targetIdx + let rewoundWork := rewindTargetWork work₀ targetIdx + let blank := blankWorkPrefixTM targetIdx counterIdx limitIdx + have hrewindTime := rewindTarget_hoareTime targetIdx headBound + inp₀ work₀ out₀ htargetInvariant htargetHead hinp hother hout + have hrewindTS := hrewindTime.toHoareTimeSpace + (inputLength := inputLength) (initialSpace := initialSpace) (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hworkSpace, hinputSpace⟩) + have hrewoundParked := rewindTargetWork_parked work₀ targetIdx + htargetInvariant hother + have hcounter' : (rewoundWork counterIdx).HasBinaryNat 0 := by + dsimp only [rewoundWork] + rw [rewindTargetWork_other work₀ targetIdx counterIdx + (Ne.symm hdistinct.1)] + exact hcounter + have hlimit' : (rewoundWork limitIdx).HasBinaryNat limit := by + dsimp only [rewoundWork] + rw [rewindTargetWork_other work₀ targetIdx limitIdx + (Ne.symm hdistinct.2.1)] + exact hlimit + have hone : 1 ≤ initialSpace := by + rw [← hcounter.2.1] + exact hworkSpace counterIdx + have hrewoundSpace : ∀ i, (rewoundWork i).head ≤ initialSpace := by + intro i + by_cases hit : i = targetIdx + · subst i + simp [rewoundWork, rewindTargetWork, hone] + · dsimp only [rewoundWork] + rw [rewindTargetWork_other work₀ targetIdx i hit] + exact hworkSpace i + have hblankTS := + blankWorkPrefixTM_hoareTimeSpace_frame_internal targetIdx counterIdx + limitIdx hdistinct limit inputLength initialSpace inp₀ rewoundWork out₀ + (rewindTargetWork_startInvariant work₀ targetIdx htargetInvariant) + (by simp [rewoundWork, rewindTargetWork]) hinp hrewoundParked hcounter' + hlimit' hout hrewoundSpace hinputSpace + have hall := seqTM_hoareTimeSpace rewind blank hrewindTS (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hinp.transitionInput_eq_self, + funext fun i => (hrewoundParked i).transitionTape_eq_self, + hout.transitionTape_eq_self⟩) + hblankTS + simpa [rewind, rewoundWork, blank, rewindBlankWorkPrefixTM, + rewindBlankWorkPrefixTime, rewindBlankWorkPrefixSpace, + rewindTargetWork, blankPrefixResultTape, Nat.add_assoc] using hall + +theorem blankWorkPrefixTM_isTransducer_internal {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) : + (blankWorkPrefixTM targetIdx counterIdx limitIdx).IsTransducer := by + exact ((blankWorkCellTM_isTransducer_internal targetIdx).binaryForTM + counterIdx limitIdx).seqTM + ((rewindWorkTM_isTransducer targetIdx).seqTM + (clearWorkTM_isTransducer counterIdx)) + +theorem rewindBlankWorkPrefixTM_isTransducer_internal {n : ℕ} + (targetIdx counterIdx limitIdx : Fin n) : + (rewindBlankWorkPrefixTM targetIdx counterIdx limitIdx).IsTransducer := + (rewindWorkTM_isTransducer targetIdx).seqTM + (blankWorkPrefixTM_isTransducer_internal targetIdx counterIdx limitIdx) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany.lean b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany.lean new file mode 100644 index 00000000..3e3ffc25 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefixMany.Defs +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefixMany.Internal + +/-! +# Binary-bounded blanking of several sparse work prefixes + +This module exposes the fixed-list replay cleanup used by restartable output +probes. One preserved binary limit bounds every target prefix, and one +canonical zero counter is restored after each target. +-/ + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Resetting a target list preserves parkedness of the complete work frame. -/ +theorem rewindBlankWorkPrefixManyResult_parked + (limit : ℕ) (work₀ : Fin n → Tape) (targets : List (Fin n)) + (hwork : ∀ i, Parked (work₀ i)) : + ∀ i, Parked (rewindBlankWorkPrefixManyResult limit work₀ targets i) := + rewindBlankWorkPrefixManyResult_parked_internal limit work₀ targets hwork + +/-- Work tapes outside the target list are preserved literally. -/ +theorem rewindBlankWorkPrefixManyResult_eq_of_not_mem + (limit : ℕ) (work₀ : Fin n → Tape) (targets : List (Fin n)) + (idx : Fin n) (hidx : idx ∉ targets) : + rewindBlankWorkPrefixManyResult limit work₀ targets idx = work₀ idx := + rewindBlankWorkPrefixManyResult_eq_of_not_mem_internal limit work₀ targets + idx hidx + +/-- Every named target becomes the literal canonical parked blank when the +shared limit covers its complete support. -/ +theorem rewindBlankWorkPrefixManyResult_eq_parkedBlank_of_mem + (limit : ℕ) (work₀ : Fin n → Tape) (targets : List (Fin n)) + (hnodup : targets.Nodup) + (hinvariant : ∀ i, i ∈ targets → (work₀ i).StartInvariant) + (hblank : ∀ i, i ∈ targets → (work₀ i).BlankAfter limit) + (idx : Fin n) (hidx : idx ∈ targets) : + rewindBlankWorkPrefixManyResult limit work₀ targets idx = + (Tape.init []).move Dir3.right := + rewindBlankWorkPrefixManyResult_eq_parkedBlank_of_mem_internal limit work₀ + targets hnodup hinvariant hblank idx hidx + +/-- A uniform target-head bound gives a linear-in-the-list runtime bound. -/ +theorem rewindBlankWorkPrefixManyTime_le + (targets : List (Fin n)) (headBound : Fin n → ℕ) + (limit maxHead : ℕ) + (hhead : ∀ i, i ∈ targets → headBound i ≤ maxHead) : + rewindBlankWorkPrefixManyTime headBound limit targets ≤ + targets.length * (rewindBlankWorkPrefixTime maxHead limit + 1) + 1 := + rewindBlankWorkPrefixManyTime_le_internal targets headBound limit maxHead + hhead + +/-- Sequential sparse resets reuse space; the list length does not multiply +the peak-space envelope. -/ +theorem rewindBlankWorkPrefixManySpace_le + (targets : List (Fin n)) (initialSpace : ℕ) + (headBound : Fin n → ℕ) (limit maxHead : ℕ) + (hhead : ∀ i, i ∈ targets → headBound i ≤ maxHead) : + rewindBlankWorkPrefixManySpace initialSpace headBound limit targets ≤ + max (rewindBlankWorkPrefixSpace initialSpace maxHead limit) + (initialSpace + 1) := + rewindBlankWorkPrefixManySpace_le_internal targets initialSpace headBound + limit maxHead hhead + +/-- Sequentially rewind and blank a distinct list of sparse targets while +preserving the complete external frame, shared counter, and shared limit. -/ +theorem rewindBlankWorkPrefixManyTM_hoareTimeSpace_frame + (counterIdx limitIdx : Fin n) (targets : List (Fin n)) + (headBound : Fin n → ℕ) (limit inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hnodup : targets.Nodup) + (hdistinct : ∀ i, i ∈ targets → + BlankWorkPrefixDistinct i counterIdx limitIdx) + (htargetInvariant : ∀ i, i ∈ targets → (work₀ i).StartInvariant) + (htargetHead : ∀ i, i ∈ targets → + (work₀ i).head ≤ headBound i) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (houtput : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (rewindBlankWorkPrefixManyTM counterIdx limitIdx targets).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = rewindBlankWorkPrefixManyResult limit work₀ targets ∧ + out = out₀) + (rewindBlankWorkPrefixManyTime headBound limit targets) inputLength + (rewindBlankWorkPrefixManySpace initialSpace headBound limit targets) := + rewindBlankWorkPrefixManyTM_hoareTimeSpace_frame_internal counterIdx limitIdx + targets headBound limit inputLength initialSpace inp₀ work₀ out₀ + hnodup hdistinct htargetInvariant htargetHead hinput hwork hcounter hlimit + houtput hworkSpace hinputSpace + +/-- Fixed-list sparse cleanup never moves the physical output head left. -/ +theorem rewindBlankWorkPrefixManyTM_isTransducer + (counterIdx limitIdx : Fin n) (targets : List (Fin n)) : + (rewindBlankWorkPrefixManyTM counterIdx limitIdx targets).IsTransducer := + rewindBlankWorkPrefixManyTM_isTransducer_internal counterIdx limitIdx targets + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany/Defs.lean b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany/Defs.lean new file mode 100644 index 00000000..d78b093d --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany/Defs.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Registers.RegisterOps +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefix.Defs + +/-! +# Binary-bounded blanking of several sparse work prefixes -- definitions + +`rewindBlankWorkPrefixManyTM` applies the sparse-prefix reset to a fixed list +of target tapes. Every invocation reuses one canonical zero counter and one +preserved canonical binary limit. +-/ + +namespace Complexity + +namespace TM + +/-- Sequentially rewind and blank every target under one shared binary limit. -/ +def rewindBlankWorkPrefixManyTM {n : ℕ} + (counterIdx limitIdx : Fin n) : List (Fin n) → TM n + | [] => skipTM + | targetIdx :: rest => + seqTM (rewindBlankWorkPrefixTM targetIdx counterIdx limitIdx) + (rewindBlankWorkPrefixManyTM counterIdx limitIdx rest) + +/-- Exact work family obtained by applying the sparse resets in order. -/ +def rewindBlankWorkPrefixManyResult {n : ℕ} + (limit : ℕ) : (Fin n → Tape) → List (Fin n) → Fin n → Tape + | work, [] => work + | work, targetIdx :: rest => + rewindBlankWorkPrefixManyResult limit + (Function.update work targetIdx + (blankPrefixResultTape (work targetIdx) limit)) rest + +/-- Exact compositional runtime, including every sequencing seam and the final +one-step identity. -/ +def rewindBlankWorkPrefixManyTime {n : ℕ} + (headBound : Fin n → ℕ) (limit : ℕ) : List (Fin n) → ℕ + | [] => 1 + | targetIdx :: rest => + rewindBlankWorkPrefixTime (headBound targetIdx) limit + 1 + + rewindBlankWorkPrefixManyTime headBound limit rest + +/-- Compositional all-prefix space envelope for several sparse resets. -/ +def rewindBlankWorkPrefixManySpace {n : ℕ} + (initialSpace : ℕ) (headBound : Fin n → ℕ) + (limit : ℕ) : List (Fin n) → ℕ + | [] => initialSpace + 1 + | targetIdx :: rest => + max + (rewindBlankWorkPrefixSpace initialSpace + (headBound targetIdx) limit) + (rewindBlankWorkPrefixManySpace initialSpace headBound limit rest) + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany/Internal.lean b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany/Internal.lean new file mode 100644 index 00000000..23766000 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/BlankWorkPrefixMany/Internal.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefix +import Complexitylib.Models.TuringMachine.Subroutines.BlankWorkPrefixMany.Defs +import Complexitylib.Models.TuringMachine.SpaceTime.WorkSupport + +/-! +# Binary-bounded blanking of several sparse work prefixes -- proof internals +-/ + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +private theorem blankPrefixResultTape_parked_many + (tape : Tape) (hparked : Parked tape) (limit : ℕ) : + Parked (blankPrefixResultTape tape limit) := by + constructor + · simp [blankPrefixResultTape] + · intro index hindex + simp only [blankPrefixResultTape, blankPrefixCells] + split + · decide + · exact hparked.2 index hindex + +theorem rewindBlankWorkPrefixManyResult_parked_internal + (limit : ℕ) (work₀ : Fin n → Tape) (targets : List (Fin n)) + (hwork : ∀ i, Parked (work₀ i)) : + ∀ i, Parked (rewindBlankWorkPrefixManyResult limit work₀ targets i) := by + induction targets generalizing work₀ with + | nil => exact hwork + | cons targetIdx rest ih => + apply ih + intro i + by_cases hi : i = targetIdx + · subst i + rw [Function.update_self] + exact blankPrefixResultTape_parked_many _ (hwork targetIdx) limit + · simpa [Function.update_of_ne hi] using hwork i + +theorem rewindBlankWorkPrefixManyResult_eq_of_not_mem_internal + (limit : ℕ) (work₀ : Fin n → Tape) (targets : List (Fin n)) + (idx : Fin n) (hidx : idx ∉ targets) : + rewindBlankWorkPrefixManyResult limit work₀ targets idx = work₀ idx := by + induction targets generalizing work₀ with + | nil => rfl + | cons targetIdx rest ih => + have hne : idx ≠ targetIdx := by + intro heq + exact hidx (by simp [heq]) + have hrest : idx ∉ rest := by + intro hmem + exact hidx (by simp [hmem]) + simpa [rewindBlankWorkPrefixManyResult, Function.update_of_ne hne] using + ih (Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit)) hrest + +theorem rewindBlankWorkPrefixManyResult_eq_parkedBlank_of_mem_internal + (limit : ℕ) (work₀ : Fin n → Tape) (targets : List (Fin n)) + (hnodup : targets.Nodup) + (hinvariant : ∀ i, i ∈ targets → (work₀ i).StartInvariant) + (hblank : ∀ i, i ∈ targets → (work₀ i).BlankAfter limit) + (idx : Fin n) (hidx : idx ∈ targets) : + rewindBlankWorkPrefixManyResult limit work₀ targets idx = + (Tape.init []).move Dir3.right := by + induction targets generalizing work₀ with + | nil => simp at hidx + | cons targetIdx rest ih => + have htargetNotMem : targetIdx ∉ rest := (List.nodup_cons.mp hnodup).1 + have hrestNodup : rest.Nodup := (List.nodup_cons.mp hnodup).2 + let work₁ := Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit) + by_cases heq : idx = targetIdx + · subst idx + rw [rewindBlankWorkPrefixManyResult] + rw [rewindBlankWorkPrefixManyResult_eq_of_not_mem_internal + limit work₁ rest targetIdx htargetNotMem] + simp only [work₁, Function.update_self] + exact blankPrefixResultTape_eq_parkedBlank + (work₀ targetIdx) limit + (hinvariant targetIdx (by simp)) (hblank targetIdx (by simp)) + · have hidxRest : idx ∈ rest := by simpa [heq] using hidx + apply ih work₁ hrestNodup _ _ hidxRest + · intro i hi + have hne : i ≠ targetIdx := fun hieq => htargetNotMem (hieq ▸ hi) + simpa [work₁, Function.update_of_ne hne] using + hinvariant i (by simp [hi]) + · intro i hi + have hne : i ≠ targetIdx := fun hieq => htargetNotMem (hieq ▸ hi) + simpa [work₁, Function.update_of_ne hne] using + hblank i (by simp [hi]) + +theorem rewindBlankWorkPrefixManyTime_le_internal + (targets : List (Fin n)) (headBound : Fin n → ℕ) + (limit maxHead : ℕ) + (hhead : ∀ i, i ∈ targets → headBound i ≤ maxHead) : + rewindBlankWorkPrefixManyTime headBound limit targets ≤ + targets.length * (rewindBlankWorkPrefixTime maxHead limit + 1) + 1 := by + induction targets with + | nil => simp [rewindBlankWorkPrefixManyTime] + | cons targetIdx rest ih => + have htarget := hhead targetIdx (by simp) + have hrest := ih (fun i hi => hhead i (by simp [hi])) + simp only [rewindBlankWorkPrefixManyTime, List.length_cons] + have htime : rewindBlankWorkPrefixTime (headBound targetIdx) limit ≤ + rewindBlankWorkPrefixTime maxHead limit := by + simp only [rewindBlankWorkPrefixTime] + omega + rw [Nat.succ_mul] + omega + +theorem rewindBlankWorkPrefixManySpace_le_internal + (targets : List (Fin n)) (initialSpace : ℕ) + (headBound : Fin n → ℕ) (limit maxHead : ℕ) + (hhead : ∀ i, i ∈ targets → headBound i ≤ maxHead) : + rewindBlankWorkPrefixManySpace initialSpace headBound limit targets ≤ + max (rewindBlankWorkPrefixSpace initialSpace maxHead limit) + (initialSpace + 1) := by + induction targets with + | nil => simp [rewindBlankWorkPrefixManySpace] + | cons targetIdx rest ih => + have htarget := hhead targetIdx (by simp) + have hrest := ih (fun i hi => hhead i (by simp [hi])) + simp only [rewindBlankWorkPrefixManySpace] + apply max_le + · apply le_trans _ (le_max_left _ (initialSpace + 1)) + simp only [rewindBlankWorkPrefixSpace] + exact max_le_max + (Nat.add_le_add_left (Nat.add_le_add_right htarget 2) initialSpace) + (le_refl _) + · exact hrest + +theorem rewindBlankWorkPrefixManyTM_hoareTimeSpace_frame_internal + (counterIdx limitIdx : Fin n) (targets : List (Fin n)) + (headBound : Fin n → ℕ) (limit inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hnodup : targets.Nodup) + (hdistinct : ∀ i, i ∈ targets → + BlankWorkPrefixDistinct i counterIdx limitIdx) + (htargetInvariant : ∀ i, i ∈ targets → (work₀ i).StartInvariant) + (htargetHead : ∀ i, i ∈ targets → + (work₀ i).head ≤ headBound i) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hlimit : (work₀ limitIdx).HasBinaryNat limit) + (houtput : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (rewindBlankWorkPrefixManyTM counterIdx limitIdx targets).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = rewindBlankWorkPrefixManyResult limit work₀ targets ∧ + out = out₀) + (rewindBlankWorkPrefixManyTime headBound limit targets) inputLength + (rewindBlankWorkPrefixManySpace initialSpace headBound limit targets) := by + induction targets generalizing work₀ with + | nil => + have hskip := skipTM_hoareTime_frame inp₀ work₀ out₀ hinput hwork + houtput + have hskipSpace := hskip.toHoareTimeSpace (initialSpace := initialSpace) + (by + intro inp work out hpre + rcases hpre with ⟨rfl, rfl, rfl⟩ + exact ⟨hworkSpace, hinputSpace⟩) + simpa [rewindBlankWorkPrefixManyTM, + rewindBlankWorkPrefixManyResult, rewindBlankWorkPrefixManyTime, + rewindBlankWorkPrefixManySpace] using hskipSpace + | cons targetIdx rest ih => + have htargetNotMem : targetIdx ∉ rest := (List.nodup_cons.mp hnodup).1 + have hrestNodup : rest.Nodup := (List.nodup_cons.mp hnodup).2 + have htargetDistinct := hdistinct targetIdx (by simp) + let work₁ := Function.update work₀ targetIdx + (blankPrefixResultTape (work₀ targetIdx) limit) + have hreset := rewindBlankWorkPrefixTM_hoareTimeSpace_frame targetIdx + counterIdx limitIdx htargetDistinct (headBound targetIdx) limit + inputLength initialSpace inp₀ work₀ out₀ + (htargetInvariant targetIdx (by simp)) + (htargetHead targetIdx (by simp)) hinput + (fun i _ => hwork i) hcounter hlimit houtput hworkSpace hinputSpace + have hwork₁ : ∀ i, Parked (work₁ i) := by + intro i + by_cases hi : i = targetIdx + · subst i + rw [show work₁ targetIdx = + blankPrefixResultTape (work₀ targetIdx) limit by + simp [work₁]] + exact blankPrefixResultTape_parked_many _ (hwork targetIdx) limit + · simpa [work₁, Function.update_of_ne hi] using hwork i + have htargetInvariant₁ : ∀ i, i ∈ rest → + (work₁ i).StartInvariant := by + intro i hi + have hne : i ≠ targetIdx := fun heq => htargetNotMem (heq ▸ hi) + simpa [work₁, Function.update_of_ne hne] using + htargetInvariant i (by simp [hi]) + have htargetHead₁ : ∀ i, i ∈ rest → + (work₁ i).head ≤ headBound i := by + intro i hi + have hne : i ≠ targetIdx := fun heq => htargetNotMem (heq ▸ hi) + simpa [work₁, Function.update_of_ne hne] using + htargetHead i (by simp [hi]) + have hcounter₁ : (work₁ counterIdx).HasBinaryNat 0 := by + simpa [work₁, Function.update_of_ne htargetDistinct.1.symm] using + hcounter + have hlimit₁ : (work₁ limitIdx).HasBinaryNat limit := by + simpa [work₁, Function.update_of_ne htargetDistinct.2.1.symm] using + hlimit + have hone : 1 ≤ initialSpace := + le_trans (hwork targetIdx).1 (hworkSpace targetIdx) + have hworkSpace₁ : ∀ i, (work₁ i).head ≤ initialSpace := by + intro i + by_cases hi : i = targetIdx + · subst i + simpa [work₁, blankPrefixResultTape] using hone + · simpa [work₁, Function.update_of_ne hi] using hworkSpace i + have hrest := ih work₁ hrestNodup + (fun i hi => hdistinct i (by simp [hi])) htargetInvariant₁ + htargetHead₁ hwork₁ hcounter₁ hlimit₁ hworkSpace₁ + have hseq := seqTM_hoareTimeSpace + (rewindBlankWorkPrefixTM targetIdx counterIdx limitIdx) + (rewindBlankWorkPrefixManyTM counterIdx limitIdx rest) + hreset (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hwork₁ i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩) hrest + simpa [rewindBlankWorkPrefixManyTM, + rewindBlankWorkPrefixManyResult, rewindBlankWorkPrefixManyTime, + rewindBlankWorkPrefixManySpace, work₁] using hseq + +theorem rewindBlankWorkPrefixManyTM_isTransducer_internal + (counterIdx limitIdx : Fin n) (targets : List (Fin n)) : + (rewindBlankWorkPrefixManyTM counterIdx limitIdx targets).IsTransducer := by + induction targets with + | nil => + intro state inputHead workHeads outputHead + cases state <;> cases outputHead <;> + simp [rewindBlankWorkPrefixManyTM, skipTM, idleDir] + | cons targetIdx rest ih => + simpa [rewindBlankWorkPrefixManyTM] using + (rewindBlankWorkPrefixTM_isTransducer targetIdx counterIdx + limitIdx).seqTM ih + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/RewindInputSpace.lean b/Complexitylib/Models/TuringMachine/Subroutines/RewindInputSpace.lean new file mode 100644 index 00000000..6707a7fd --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/RewindInputSpace.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Subroutines.RewindInputSpace.Internal + +/-! +# Space-exact input rewind + +The input rewind only moves its input head toward cell one. This focused +contract records that its peak auxiliary space is the initial budget rather +than the machine's linear rewind time. +-/ + +namespace Complexity + +namespace TM + +/-- Rewind a parked invariant input while preserving the work/output frame and +without increasing auxiliary space. -/ +theorem rewindInputTM_hoareTimeSpace_frame {n : ℕ} + (inputHeadBound inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinputInvariant : inp₀.StartInvariant) (hinput : Parked inp₀) + (hinputHead : inp₀.head ≤ inputHeadBound) + (hwork : ∀ i, Parked (work₀ i)) (houtput : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (rewindInputTM (n := n)).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp.head = 1 ∧ inp.cells = inp₀.cells ∧ + work = work₀ ∧ out = out₀) + (inputHeadBound + 2) inputLength initialSpace := + rewindInputTM_hoareTimeSpace_frame_internal inputHeadBound inputLength + initialSpace inp₀ work₀ out₀ hinputInvariant hinput hinputHead + hwork houtput hworkSpace hinputSpace + +/-- Rewinding the input tape never moves the output head left. -/ +theorem rewindInputTM_isTransducer {n : ℕ} : + (rewindInputTM (n := n)).IsTransducer := + rewindInputTM_isTransducer_internal + +end TM + +end Complexity diff --git a/Complexitylib/Models/TuringMachine/Subroutines/RewindInputSpace/Internal.lean b/Complexitylib/Models/TuringMachine/Subroutines/RewindInputSpace/Internal.lean new file mode 100644 index 00000000..f5147af6 --- /dev/null +++ b/Complexitylib/Models/TuringMachine/Subroutines/RewindInputSpace/Internal.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexitylib.Models.TuringMachine.Hoare.Space +import Complexitylib.Models.TuringMachine.Registers +import Complexitylib.Models.TuringMachine.Subroutines.Internal + +/-! +# Space-exact input rewind -- proof internals +-/ + +namespace Complexity + +namespace TM + +private theorem input_head_eq_zero_of_read_start {tape : Tape} + (hinvariant : tape.StartInvariant) (hread : tape.read = Γ.start) : + tape.head = 0 := by + by_contra hne + have hpositive : 1 ≤ tape.head := by omega + exact hinvariant.2 tape.head hpositive (by simpa [Tape.read] using hread) + +private theorem rewindInputTM_step_frame {n : ℕ} + {before after : Cfg n (rewindInputTM (n := n)).Q} + (hinput : before.input.StartInvariant) + (hwork : ∀ i, Parked (before.work i)) + (houtput : Parked before.output) + (hstep : (rewindInputTM (n := n)).step before = some after) : + after.input.cells = before.input.cells ∧ + after.input.head ≤ max 1 before.input.head ∧ + after.work = before.work ∧ after.output = before.output := by + have hne := state_ne_qhalt_of_step hstep + cases hstate : before.state with + | moveLeft => + by_cases hread : before.input.read = Γ.start + · have hhead := input_head_eq_zero_of_read_start hinput hread + simp [TM.step, hstate, rewindInputTM, hread] at hstep + subst after + refine ⟨by simp only [Tape.move_cells], ?_, ?_, ?_⟩ + · simp [Tape.move, hhead] + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + · simp [TM.step, hstate, rewindInputTM, hread] at hstep + subst after + refine ⟨by simp only [Tape.move_cells], ?_, ?_, ?_⟩ + · simp [Tape.move, moveLeftDir, hread] + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + | moveRight => + simp [TM.step, hstate, rewindInputTM] at hstep + subst after + refine ⟨by simp only [Tape.move_cells], ?_, ?_, ?_⟩ + · by_cases hread : before.input.read = Γ.start + · have hhead := input_head_eq_zero_of_read_start hinput hread + simp [Tape.move, idleDir, hread, hhead] + · simp [Tape.move, idleDir, hread] + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + | done => + exact (hne (by simpa [rewindInputTM] using hstate)).elim + +private theorem rewindInputTM_reachesIn_frame {n : ℕ} + {time : ℕ} {start done : Cfg n (rewindInputTM (n := n)).Q} + (hinput : start.input.StartInvariant) + (hwork : ∀ i, Parked (start.work i)) + (houtput : Parked start.output) + (hreach : (rewindInputTM (n := n)).reachesIn time start done) : + done.input.cells = start.input.cells ∧ + done.input.head ≤ max 1 start.input.head ∧ + done.work = start.work ∧ done.output = start.output := by + induction hreach with + | zero => exact ⟨rfl, le_max_right 1 _, rfl, rfl⟩ + | @step before middle restTime final hstep hrest ih => + obtain ⟨hinputCells, hinputHead, hworkEq, houtputEq⟩ := + rewindInputTM_step_frame hinput hwork houtput hstep + have hmiddleInput : middle.input.StartInvariant := by + constructor + · rw [hinputCells] + exact hinput.1 + · intro index hindex + rw [hinputCells] + exact hinput.2 index hindex + have hmiddleWork : ∀ i, Parked (middle.work i) := by + intro i + rw [hworkEq] + exact hwork i + have hmiddleOutput : Parked middle.output := by + rw [houtputEq] + exact houtput + obtain ⟨hfinalCells, hfinalHead, hfinalWork, hfinalOutput⟩ := + ih hmiddleInput hmiddleWork hmiddleOutput + refine ⟨hfinalCells.trans hinputCells, ?_, hfinalWork.trans hworkEq, + hfinalOutput.trans houtputEq⟩ + exact le_trans hfinalHead (max_le (le_max_left 1 _) hinputHead) + +theorem rewindInputTM_hoareTimeSpace_frame_internal {n : ℕ} + (inputHeadBound inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinputInvariant : inp₀.StartInvariant) (hinput : Parked inp₀) + (hinputHead : inp₀.head ≤ inputHeadBound) + (hwork : ∀ i, Parked (work₀ i)) (houtput : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (rewindInputTM (n := n)).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp.head = 1 ∧ inp.cells = inp₀.cells ∧ + work = work₀ ∧ out = out₀) + (inputHeadBound + 2) inputLength initialSpace := by + have htime := rewindInputTM_hoareTime_frame inputHeadBound + (P := fun inp work out => + inp.cells = inp₀.cells ∧ work = work₀ ∧ out = out₀) (by + intro inp work out inp' work' out' hframe hcells _hhead + hworkEq houtputEq + exact ⟨hcells.trans hframe.1, hworkEq.trans hframe.2.1, + houtputEq.trans hframe.2.2⟩) + have htime' : (rewindInputTM (n := n)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp.head = 1 ∧ inp.cells = inp₀.cells ∧ + work = work₀ ∧ out = out₀) + (inputHeadBound + 2) := + htime.consequence + (by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨hinputInvariant.1, hinputInvariant.2, hinputHead, + houtput.read_ne_start, houtput.1, + fun i => ⟨(hwork i).read_ne_start, (hwork i).1⟩, rfl, rfl, rfl⟩) + (by + rintro inp work out ⟨hhead, hcells, hworkEq, houtputEq⟩ + exact ⟨hhead, hcells, hworkEq, houtputEq⟩) le_rfl + refine htime'.and_hoareSpace ?_ + intro inp work out hpre cfg hreach + rcases hpre with ⟨hinputEq, hwork₀Eq, houtputEq⟩ + subst inp + subst work + subst out + obtain ⟨time, hreachIn⟩ := + (rewindInputTM (n := n)).reaches_to_reachesIn hreach + obtain ⟨hcells, hhead, hworkEq, _houtputEq⟩ := + rewindInputTM_reachesIn_frame hinputInvariant hwork houtput hreachIn + constructor + · intro i + rw [hworkEq] + exact hworkSpace i + · have hone : 1 ≤ inp₀.head := hinput.1 + rw [max_eq_right hone] at hhead + exact le_trans hhead hinputSpace + +theorem rewindInputTM_isTransducer_internal {n : ℕ} : + (rewindInputTM (n := n)).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | moveLeft => + simp only [rewindInputTM] + split <;> simp [idleDir] <;> split <;> decide + | moveRight => + simp [rewindInputTM, idleDir] + split <;> decide + | done => + simp [rewindInputTM, allIdle, idleDir] + split <;> decide + +end TM + +end Complexity diff --git a/ROADMAP.md b/ROADMAP.md index 502a5f19..73051528 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -954,8 +954,12 @@ preserved by serialized encodings and uniform generators. `P_subset_UniformPPoly`, and combine it with `UniformPPoly_subset_P` for the logspace-uniform equality. - [x] Introduce `SIZE` and `PPoly` (`P/poly`) using the stable family conventions. -- [ ] Introduce `DEPTH`, `NC^i`, and `AC^i` after uniformity and zero-length +- [x] Introduce `DEPTH`, `NC^i`, and `AC^i` after uniformity and zero-length conventions have been propagated through the existing `AC0` definition. + (`Circuits/DepthClasses` uses total `CircuitFamily` semantics, polynomial + size, and the explicit envelope `c·(log₂ n + 1)^i`; `NC0`, `NC1`, and the + repaired `AC0` are specializations, and both hierarchies are monotone in + `i`. These names are explicitly nonuniform.) **Formalization hazards.** @@ -1096,13 +1100,19 @@ programs by log-depth circuits and a clearly stated uniformity convention. **Staged milestones.** -- [ ] Define Boolean formulas with literals, depth, evaluation, and compilation - from a selected circuit output by recursively unfolding its DAG. +- [x] Define Boolean formulas with literals, depth, evaluation, and compilation + from a selected circuit output by recursively unfolding its DAG. (`BoolFormula` + has variables/constants, literal helpers, evaluation, size, leaves, depth, and + variable locality. `Circuit.outputFormula` recursively unfolds one selected + fan-in-two output; `Circuit.eval_outputFormula` proves exact semantics, and + `Circuit.depth_outputFormula_le_outputDepth` bounds its formula depth by twice + the selected circuit-output depth. DAG sharing is intentionally duplicated, so + no formula-size bound is claimed.) - [x] Define width-`w` permutation branching programs: instructions selected by one input bit, ordered product semantics, length, and acceptance convention. (`Circuits/BranchingProgram.lean`: `BPInstr`, `BP`, `eval`, `eval_append`, `eval_cons`, `eval_rename`.) -- [~] Specialize to permutations of `Fin 5` and prove the explicit conjugation and +- [x] Specialize to permutations of `Fin 5` and prove the explicit conjugation and commutator identities used by Barrington's induction. (Abstract core done in `Circuits/Barrington.lean`: `BP.inverse`/`eval_inverse`, the representation predicate `BP.Computes`, and the closure lemmas `Computes_conj`, @@ -1114,8 +1124,8 @@ programs by log-depth circuits and a clearly stated uniformity convention. `every_fiveCycle_is_commutator` upgrades this to *every* `5`-cycle via the single-conjugacy-class fact (`isConj_iff_cycleType_eq`) plus conjugation distributing over `⁅·,·⁆`. So the full `S₅` target-cycle freedom Barrington's - induction consumes is proven. What remains is threading it through the - formula→BP induction with the `4^d` length bookkeeping.) + induction consumes is proven. `BPInstr.conjugate` and `BP.conjugate` now realize + conjugation pointwise, preserving program length exactly.) - [x] Compile literals and negation, then the AND/OR induction, tracking target cycles and a length bound. (The abstract move-set is functionally complete in `Circuits/Barrington.lean`: base cases `Computes_false`, `Computes_true`, @@ -1124,33 +1134,346 @@ programs by log-depth circuits and a clearly stated uniformity convention. `S₅` algebra: `BP.Computes_retarget` re-aims a program to any target `5`-cycle, and `BP.Computes_and5` gives the `AND` gate with full target-cycle freedom. The full formula recursion is done in `Circuits/BarringtonRepr.lean` - (`Computes_formula`). Length is now tracked in `Circuits/BarringtonLength.lean`: - `Computes_formula_len` + `barrington_representation_len` give a program of length - `≤ 13 ^ (size φ)`. The tighter textbook `4 ^ depth` constant is NOT yet - attained — it needs a construction avoiding the retargeting overhead.) -- [~] State and prove the finite Barrington theorem. (Representation form + (`Computes_formula`). `Circuits/BarringtonLength.lean` now adds pointwise + length-preserving retargeting, compact negation with length `max 1`, and the + exact four-copy commutator recurrence; `Computes_formula_depth_four` proves the + tight `≤ 4 ^ depth` induction.) +- [x] State and prove the finite Barrington theorem. (Representation form **proven**: `Circuits/BarringtonRepr.lean` `barrington_representation` — every Boolean formula is computed by a width-`5` permutation branching program (some nonidentity `σ ∈ S₅` with program-value `= σ ↔ φ` true). - `Circuits/BarringtonLength.lean` adds length bounds: `barrington_representation_len` - (`≤ 13 ^ size`), `barrington_representation_depth` (`≤ 17 ^ depth`), and - `barrington_poly_of_log_depth` — the **concrete `NC¹ ⟹` poly-size** statement: a - formula of depth `≤ log₂ n` compiles to a width-`5` program of length `≤ n⁵` (via - `17^{log₂ n} ≤ n⁵`). All 0 custom axioms. Remaining: the tight base `4 ^ depth` - (vs `17 ^ depth`); the nonuniform family equality is completed below, while a - uniform version remains a separate refinement.) + `Circuits/BarringtonLength.lean` adds the textbook finite theorem + `barrington_representation_depth_four` (`≤ 4 ^ depth`) and + `barrington_quadratic_of_log_depth` — a formula of depth `≤ log₂ n` compiles + to a width-`5` program of length `≤ n²`. The earlier `13 ^ size`, `17 ^ depth`, + and `n⁵` statements remain compatibility corollaries. All 0 custom axioms.) - [x] Lift it to nonuniform `NC^1`; then prove the converse by balanced composition of constant-size permutation transition matrices/functions. (Forward direction: `Circuits/BarringtonFamily.lean` `FormulaFamily.logDepth_polyLength_bp` — a logarithmic-depth (`NC¹`) formula family is computed formula-by-formula by a family of width-`5` branching programs of - polynomial length `C·(n+1)^p`. Converse and equality: + polynomial length `4^c·(n+1)^(2c)`. Converse and equality: `Circuits/BarringtonConverse.lean` — `BP.reachesFormula` composes two half-programs through the five possible intermediate states, `BP.depth_decisionFormula_le` bounds decision depth by `6·⌈log₂ length⌉ + 2`, and - `barrington_equivalence` proves `FormulaNC1 = Width5BP`. All 0 custom axioms.) -- [ ] Add a uniform version only after instruction-generation uniformity is - formalized. + `barrington_equivalence` proves `FormulaNC1 = Width5BP`. All 0 custom axioms. + The typed-family bridge is also complete: + `BoolFunFamily.onTotalAssignments_mem_Width5BP` unfolds any `NC1` circuit + family output with at most a factor-two depth increase and applies the + Barrington equivalence. No formula-size claim is used.) +- [~] Add a uniform version only after instruction-generation uniformity is + formalized. The extraction prerequisite is now complete: + `Circuits/BarringtonCompiler` replaces proof-level conjugator choices by a + computable enumeration of `S₅` and exposes an explicit recursive + `barringtonCompile` with exact semantics and length `≤ 4 ^ depth`. + `Circuits/BranchingProgramEncoding` now supplies the canonical machine-facing + codec: fixed seven-bit `S₅` ranks, self-delimiting instructions/programs, + exact decoding, injectivity, and explicit code-length bounds. + `Circuits/FormulaEncoding` supplies the corresponding iterative postfix input + format, and `Circuits/BarringtonCodeGenerator` fixes the total bitstring + transformer `barringtonCompileCode`, proving generated-code decoding, exact + formula semantics, the `4 ^ depth` instruction bound, and serialized length + at most `4^depth + 1 + 4^depth * (inputCodeLength + 15)`. The remaining steps + are a verified total log-space generator that agrees with this reference on + a promised logarithmic-depth family, plus the resulting uniform family-level + lift. The unbounded reference itself is not an `FL` candidate: arbitrary + linear-depth inputs can require exponentially long output. + `Classes/BarringtonUniform` now formalizes the correct promise-family boundary: + canonical `FL` generators define `FormulaFamily.Uniform` and + `BPFamily.Uniform`, the concrete `FormulaFamily.barringtonProgram` has fixed + decision point zero, exact semantics, and polynomial length. The machine + resource prerequisites now also expose that every `FL` output has a + pointwise polynomial length bound with logarithmic-width indices, and prove + that the *complete serialized code* of the concrete Barrington family + (including terminated-unary variable fields) is polynomially bounded with + logarithmic-width cursors. Thus the remaining construction may use + recomputation and binary output positions without hiding a space blowup. + `Models/TuringMachine/OutputCursor` now supplies the machine-level simulation + kernel for that construction: `OutputCursor` quotients an append-only output + prefix to finite control, exact step and run commutation are proved, and the + executable `suppressOutputTM` retains the source input/work behavior while + keeping its physical output empty. Its bounded-time computation theorem + includes the final normalization seam. Observed cursor runs now count output + advances exactly, including the theorem that the accumulated count from an + initial configuration equals the final physical output-head position. + `Models/TuringMachine/OutputProbe` adds the executable binary + position/capture controller: non-right source steps preserve its extra + countdown tape, right steps invoke the verified little-endian predecessor, + and a finite start-marker mask normalizes and exactly restores any source + heads parked on `▷` around that subroutine. Whole observed cursor runs now + consume exactly their counted output advances, and a halted source on the + selected Boolean frontier cell reaches the probe halt state with that + one-bit physical output. The companion theorem covers cells finalized by an + earlier right move, so the semantic capture cases are complete. Every prefix + of a complete replay now stays within the source invariant's space plus the + largest countdown's binary width, without accumulating predecessor costs. + Canonical blank-output specializations also discharge the probe's physical + head-and-cells premises after every positive-length replay. + Output-frontier monotonicity and exact crossing now combine those two capture + cases into one machine theorem for every valid index of a completed + space-bounded transducer output. A generic post-sentinel wrapper now turns + that result into a restartable query interface whose input, scratch, + countdown, and physical-output tapes all enter parked at cell one. The + output-retargeted form places the captured bit on a fresh work tape while + preserving a parked blank real output, so repeated queries can compose + without replaying the enclosing machine's sentinel transition. Successful + valid-index queries now carry the replay bound through the two capture + transitions, the restart wrapper, and output retargeting, including the + fresh work tape that stores the selected bit; the controller can therefore + cite one all-prefix space certificate for each complete query phase. + `Circuits/BarringtonStreaming` now replaces complete program construction by + a target-independent exact instruction-count recurrence and random-access + instruction stream, with every query proved equal to the reference compiler. + `Circuits/BarringtonSlots` schedules that same exact program inside `4^D` + optional fixed-address slots for any promised depth bound `D`: erasing empty + slots recovers the reference compiler byte-for-byte, and counting occupied + slots recovers its exact instruction count. This removes recursive child- + length arithmetic from the machine controller while keeping its output + unchanged. `Circuits/BarringtonSlotQuery` now gives target-independent + structural recurrences for the first and last occupied addresses and a + direct query that follows only the selected base-four block; every queried + slot is proved equal to the list-valued fixed schedule, including the + inverse-block and postmultiplication transformations used by negation, + conjunction, and disjunction. + `FormulaEncoding/Navigation` supplies its stack-free postfix tree primitive: + a backwards owed-subtree scan recovers exact child spans using one cursor and + one counter. `Circuits/BarringtonTokenQuery` now lifts the direct fixed-slot + recurrence from inductive formulas to canonical postfix token streams: + binary child spans are recovered by that backwards scan, and every token- + stream query is proved equal to the reference compiler's selected + instruction. `FormulaEncoding/BitNavigation` now implements exact random + access and subtree scans over the canonical framed bits themselves, including + child-span recovery inside arbitrary token context. `BarringtonBitQuery` + follows the selected base-four address directly over those bits and proves + every result equals the fixed-slot compiler. `BarringtonBitSerializer` fixes + the complete two-pass output algorithm: scan all `4^D` addresses to obtain + the exact instruction count, then erase empty addresses and emit the canonical + program code; under the promised depth bound its output is byte-for-byte the + executable Barrington compiler's code. `FormulaEncoding/ProbeNavigation` + replaces the in-memory code by a position-indexed bit oracle with total + finite-fuel decoders and exact token/subtree/child-span correctness. + `BarringtonProbeQuery` then proves that first/last occupancy and every direct + fixed-address instruction query through that oracle agree with the reference + compiler. Its machine-facing query has now also been factored through a + target-free Boolean occupancy kernel: bounded scans over exactly `4^D` + addresses recover the first and last occupied slots, and substituting those + scans into every postmultiplication site preserves each queried instruction + exactly. This removes nested recursive first/last evaluation from the + serializer controller. `BPInstrTransform` now packages every pending inverse + and postmultiplication of a selected instruction as an explicit finite type: + both permutation branches undergo one shared `left * p^(±1) * right` map, + while the unbounded variable index is preserved. Thus recursive descent need + not store a transformation stack on work tapes. + `Models/TuringMachine/Subroutines/BlankWorkPrefix` now supplies the + missing replay-reset primitive: it blanks an arbitrary sparse work prefix + bounded by a preserved binary limit, rewinds the target from an arbitrary + in-bound head position, restores its scratch counter, and proves exact time + plus an all-prefix space envelope. `BlankWorkPrefixMany` serially applies that + primitive to a fixed sparse tape list without multiplying the peak-space + bound. Successful output probes now also expose that their countdown ends as + the canonical zero tape, including after restart, output retargeting, and + placement in a larger controller frame, and give an exact blank-support bound + for every query-owned tape. `OutputProbeCleanup` combines an exact-space input + rewind with the fixed-list reset to restore the source, countdown, and + capture tapes while preserving the controller frame. `OutputProbeConsume` + now supplies the concrete restartable controller step: it reads the captured + bit before + cleanup, restores the exact canonical frame, dispatches to the matching + continuation, and carries an explicit all-prefix space maximum through the + whole query-consume-reset sequence. `OutputProbeLatch` now turns that + finite-control result into a reusable canonical binary zero-or-one latch + after cleanup while preserving an arbitrary outer serializer frame. + Output probes are now total at every positive numeric position: the complete + source run is split into crossed, final-frontier, and beyond-frontier cases, + blank or absent positions emit canonical zero, and every branch retains the + source-space-plus-binary-index all-prefix bound. Valid indices keep the + stronger theorem identifying the emitted bit with the source function. This + totality now passes through arbitrary real-output and controller frames, + consume/reset, and the persistent canonical bit latch, so bounded serializer + loops no longer need a valid-index side condition at each oracle query. + `OutputProbeIndexed` now bridges the remaining ghost-index boundary: it + copies a preserved zero-based controller register into the private probe + countdown, increments to the probe's one-based convention, and composes that + preparation with the total framed latch. The public contract preserves every + non-countdown tape exactly and carries the combined all-prefix space bound, + so `BinaryFor` clients can use a concrete machine register as their query + address. `OutputProbeDispatch` now turns that persistent latch into a direct + full-controller Boolean branch: valid indices select the exact source bit, + parked frame seams are discharged once, and arbitrary zero/one continuations + inherit a compositional time/space contract. Its resetting form now clears a + true one-bit latch before the selected continuation, while the false branch + reuses the already-canonical zero frame; both branches therefore reestablish + the identical restart invariant with explicit clearing cost. This is the + reusable iteration body boundary for the occupancy and serializer scans. + The bounded-runtime `BinaryForSegmentSpec` and its all-prefix companion have + now moved from the experimental routine adapter to the public `BinaryFor` + API, so source-dependent probe runtimes can be selected existentially per + address while remaining under one advertised loop bound. Its canonical + witness adapter now packages those existential Hoare runs without repeated + choice plumbing. The matching initial-bound adapter now turns canonical + comparison/iteration entry bounds plus runtime reserve into the full + all-prefix `BinaryForSegmentSpaceSpec`, without replaying phase semantics. + `OutputProbeScan` performs the concrete machine wiring: + it embeds address and limit registers behind the probe frame, queries and + resets the latch, runs the selected continuation, increments the address, + and preserves one-way output safety through the complete bounded scan. + `OutputProbeCountOnes` now supplies the serializer's first-pass branch body: + a zero probe preserves the complete reset-latch frame, while a one probe + increments exactly one canonical binary count register. The composed + query-reset-count step has an explicit time/space contract and the enclosing + count-up scan remains one-way-output safe. Its exact outer-loop invariant is + now formalized as well: after address `k`, the count register contains the + number of true bits in the first `k` source positions. Canonical restored + latch frames make Hoare endpoints literal loop configurations, and bounded + per-address body witnesses now package into a complete + `BinaryForSegmentSpec`; the halted frame exposes `List.count true` when the + scan limit is the full bit length. Those body witnesses are now derived + directly from the source transducer's `ComputesInSpace` contract and the + canonical restored frame: finite frame maxima discharge the concrete + indexed-latch and branch seams, and noncomputably selected per-address + runtimes assemble a complete exact-prefix segment certificate. The remaining + first-pass resource proof is specifically to attach an all-prefix segment- + space certificate with a bound suitable for the final logarithmic asymptotic + argument. `OutputProbeDecodeNat` now starts the Barrington-specific formula + query controller: it gives terminated-unary headers and variable fields a + concrete bounded probe loop with cursor, accumulator, fuel, and persistent + success registers. Its pure controller is proved exactly equal to the + established oracle decoder, including fuel exhaustion, and the complete + concrete machine is one-way-output safe. Its selected zero/one continuations + now have literal restored-frame contracts, and a valid source address plus + `ComputesInSpace` derives the complete active query/reset/update step without + caller-supplied replay witnesses. The outer active-flag branch is now + certified in both states and exposed through one source-derived body theorem + whose post-frame follows the same finite-list bit as the pure decoder + recurrence. The exact `BinaryFor` lift is now complete as well: an injective + six-role controller layout supplies canonical comparison, iteration, and + halted frames; source-derived per-query runtimes assemble a complete segment + whose final registers are the pure decoder state at the fuel bound. + `OutputProbeDecodeTag` now supplies the next controller layer's six-way pure + classifier, a concrete three-probe machine, one-way-output safety, and an + exact source-derived contract for each query/reset/retain/cursor step. Those + three contracts now compose into one exact run whose literal final frame + retains all three source bits and advances the cursor by exactly three. A + direct controller-symbol tree now dispatches that frame to all six legal + continuations or the reserved-tag failure branch, and the combined theorem + composes source-derived probing and exact two- or three-step dispatch in one + run. `OutputProbeDecodeToken` now gives the tag and terminated-unary layers + one injective nine-role controller layout with definitionally shared cursor + and scratch registers. Its exact cleanup phase resets all three retained tag + bits to a canonical zero frame without changing any other controller tape; + invariant-restoring dispatch now wraps every legal and invalid continuation + in that same cleanup contract. Selected-continuation variants of both the + retained-tag and normalized-token contracts require only the branch that can + actually execute, so constant tokens do not inherit an impossible variable- + payload precondition. The source-derived token theorem now composes all three + probes, tag retention, canonical cleanup, and selected dispatch in one exact + machine run. The variable branch is now instantiated concretely by the + bounded terminated-unary machine through the shared layout. The generic + `BinaryForSegmentSpec.hoareTime` adapter and the source-derived + `ComputesInSpace.outputProbeDecodeNatTM_hoareTime` theorem now expose that + complete loop between canonical initialized and final latch frames. + `ComputesInSpace.outputProbeDecodeTokenVar_hoareTime` now transports the + normalized post-tag frame into that canonical unary start frame and certifies + the concrete variable continuation. `BranchingProgramEncoding/Machine` now + supplies the serializer leaf itself: it emits a dynamic terminated-unary + variable field followed by two finite-control permutation ranks, restores the + complete input/work frame, and carries explicit time, all-prefix space, and + one-way-output contracts. Constant and variable Barrington instructions are + exposed as direct specializations. A restored-latch adapter now transports + those emitters through the complete restartable-query frame, and + `outputProbeDecodeVarInstrTM_hoareTime` certifies the whole normalized + `.var` continuation from bounded payload decoding through exact instruction + emission. The leaf dispatcher is concrete as well: `.tru` uses the constant + emitter, `.fls` uses the certified no-output frame adapter, and only the + recursive connective continuations remain parameters. A generic selected- + branch contract exposes that exact machine boundary without demanding proofs + for unreachable leaf or recursive branches. Its three source-level leaf + contracts are now certified end to end: `.var` alone assumes and decodes a + bounded terminated-unary payload before appending the exact dynamic + instruction, `.tru` appends the exact constant instruction without a payload + assumption, and `.fls` preserves the accumulator unchanged. The next local + seam is the recursive address/navigation controller for `.neg`, `.conj`, and + `.disj`. Its numeric state is now stack-free: `BarringtonSlotCursor` keeps the + original fixed address plus one reflection bit, splits each effective address + into its current base-four block and remaining local slot, and toggles only + that bit when descent enters an inverse block. Its branch equations identify + right-child and inverse-block selection with the two corresponding binary + address bits xor that reflection flag. The four-way machine dispatcher over + two captured canonical bit tapes is now concrete, costs exactly two framed + transitions beyond its selected continuation, preserves the continuation's + all-prefix space budget, and is one-way on output. Its raw-bit continuation + is proved equal to the cursor's semantic branch. A one-transition capture + primitive now canonicalizes the currently positioned source bit, optionally + moves the preserved address head left, carries an all-prefix space contract, + and is one-way on output. Its three-transition high/low composition captures + one adjacent base-four digit, leaves the source on the low bit, preserves all + unrelated tapes, carries its own all-prefix space contract, and remains one- + way on output. The runtime positioner is now concrete as a canonical binary + count-up loop whose certified two-transition body advances one base-four + digit, followed by a certified one-transition move onto the current high bit; + its exact loop invariant identifies iteration `v` with head offset `2 * v`. + The complete positioner lands on bit `2 * fuel + 1`, preserves the address + cells, advances its canonical counter exactly to `fuel`, and carries the + all-prefix bound `initialSpace + 2 * fuel + 2 * fuel.size + 6` rather than a + time-derived quadratic bound. Positioned canonical cells are also proved to + expose exactly `Nat.testBit`, including implicit blank high bits. Positioning + and the three-transition adjacent-bit capture now compose into one public + exact contract, and the resulting raw bits feed the four-way dispatcher and + any selected continuation. The end-to-end branch retains the tight + positioning-plus-three all-prefix budget, adds exactly the two dispatch + transitions, and remains one-way on output. The cursor-facing theorem hides + the raw-bit arithmetic behind the semantic left/right/inverse choice. After + this one-time positioning phase, recursive slot descent no longer rescans + from the address origin: one transition moves onto the next lower digit and + simultaneously resets both bit latches, then the existing three-transition + capture and two-transition dispatcher select the next semantic child. This + constant-cost recursive step has an explicit all-prefix bound and preserves + one-way output behavior. Postfix child navigation now also has a forward- + streaming invariant tailored to the existing token decoder: scanning a + binary root's child body maintains only the evaluation-stack height and the + most recent height-one boundary. That boundary is proved to be exactly the + end of the left child in both token count and encoded-bit offset, eliminating + repeated backward ordinal seeks. The machine-side numeric step is now + concrete as well: eight distinct binary registers hold the cursor, stack + height, token count, retained boundaries, constant one, verdict, and copy + scratch. One certified call applies the token arity, increments the token + count, performs normalized binary equality, conditionally copies both + boundaries, restores scratch, and preserves one-way output behavior. The + numeric step is now wrapped around the existing fixed-tag/terminated-unary + token decoder by an injective sixteen-role controller layout. The decoder and + scan share exactly the source cursor; every other register is structurally + disjoint. The concrete dispatcher maps variables, constants, negation, and + both binary connectives to arities zero, zero, one, and two respectively. A + completed variable decoder now has a certified normalization phase that + clears its value and loop counter, restores its active flag, preserves the + complete numeric scan frame literally, and remains one-way on output. + Source-derived one-token contracts now cover both sides of the dispatcher: + every legal fixed token maps through one tag-to-arity theorem, while a + variable composes bounded payload probing, the pure decoder's terminal + cursor/value state, normalization, and the arity-zero update. The numeric + scan invariant now transports automatically into restored latch frames, + through fixed-tag cleanup, and through the variable decoder's cursor update; + source theorems need only the original stable scan frame. Canonical variable + encodings also have an exact successful decoder result with arbitrary extra + fuel, exposing the post-token cursor and terminated active state. The bounded + scan now has its own injective eighteen-role layout and concrete count-up + wrapper: the first sixteen roles project to the complete token step, while a + fresh iteration counter and preserved token limit are certified distinct + from every token role. This avoids aliasing the loop counter with the + semantic token count already incremented by the body. The next seam is the + stream-indexed loop invariant for that wrapper, followed by the + finite-control cursor/transform updates. + `BarringtonProbeSerializer` fixes the complete oracle-level two-pass output + and proves that its counted header, filtered instruction stream, and final + code agree byte-for-byte with the executable compiler. The remaining + construction is to iterate these latched controller steps through the oracle + recurrences and the two serializer scans, together with the resulting + logarithmic-space proof. + Finally, + `uniformFormulaNC1_subset_uniformWidth5BP_of_compilation` reduces the forward + uniform theorem to the single named obligation + `UniformBarringtonCompilation`. Proving that obligation is the remaining + machine-level work. **Formalization hazards.** Permutation multiplication order differs between texts and libraries; fix it with executable examples before proving the induction.