From d35d0971dac22d1f4f44befef5b773858a1d634e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 4 Sep 2026 16:40:05 +0000 Subject: [PATCH 1/3] feat: import GapCVP hardness formalization --- LeanPool.lean | 69 + LeanPool/GapCVP.lean | 20 + LeanPool/GapCVP/Part01.lean | 9 + LeanPool/GapCVP/Part01A.lean | 7748 ++++++++++++++++++++++++++++++ LeanPool/GapCVP/Part01B.lean | 447 ++ LeanPool/GapCVP/Part02.lean | 8460 +++++++++++++++++++++++++++++++++ LeanPool/GapCVP/Part03.lean | 9 + LeanPool/GapCVP/Part03A.lean | 2181 +++++++++ LeanPool/GapCVP/Part03B.lean | 701 +++ LeanPool/GapCVP/Part03C.lean | 2312 +++++++++ LeanPool/GapCVP/Part03D.lean | 2316 +++++++++ LeanPool/GapCVP/Part03E.lean | 847 ++++ LeanPool/GapCVP/Part03F.lean | 1094 +++++ LeanPool/GapCVP/Part03G.lean | 451 ++ LeanPool/GapCVP/Part04.lean | 9 + LeanPool/GapCVP/Part04A.lean | 735 +++ LeanPool/GapCVP/Part04B.lean | 2079 ++++++++ LeanPool/GapCVP/Part04C.lean | 1144 +++++ LeanPool/GapCVP/Part04D.lean | 1255 +++++ LeanPool/GapCVP/Part04E.lean | 1094 +++++ LeanPool/GapCVP/Part04F.lean | 1801 +++++++ LeanPool/GapCVP/Part04G.lean | 408 ++ LeanPool/GapCVP/Part05.lean | 9 + LeanPool/GapCVP/Part05A.lean | 806 ++++ LeanPool/GapCVP/Part05B.lean | 1788 +++++++ LeanPool/GapCVP/Part05C.lean | 1821 +++++++ LeanPool/GapCVP/Part05D.lean | 1844 ++++++++ LeanPool/GapCVP/Part05E.lean | 1146 +++++ LeanPool/GapCVP/Part05F.lean | 943 ++++ LeanPool/GapCVP/Part06.lean | 9 + LeanPool/GapCVP/Part06A.lean | 2466 ++++++++++ LeanPool/GapCVP/Part06B.lean | 1307 +++++ LeanPool/GapCVP/Part06C.lean | 584 +++ LeanPool/GapCVP/Part06D.lean | 3800 +++++++++++++++ LeanPool/GapCVP/Part07.lean | 9 + LeanPool/GapCVP/Part07A.lean | 1976 ++++++++ LeanPool/GapCVP/Part07B.lean | 1088 +++++ LeanPool/GapCVP/Part07C.lean | 2055 ++++++++ LeanPool/GapCVP/Part07D.lean | 1550 ++++++ LeanPool/GapCVP/Part07E.lean | 838 ++++ LeanPool/GapCVP/Part07F.lean | 344 ++ LeanPool/GapCVP/Part07G.lean | 398 ++ LeanPool/GapCVP/Part08.lean | 9 + LeanPool/GapCVP/Part08A.lean | 1500 ++++++ LeanPool/GapCVP/Part08B.lean | 937 ++++ LeanPool/GapCVP/Part08C.lean | 1556 ++++++ LeanPool/GapCVP/Part08D.lean | 5839 +++++++++++++++++++++++ LeanPool/GapCVP/Part09.lean | 8644 ++++++++++++++++++++++++++++++++++ LeanPool/GapCVP/Part10.lean | 9 + LeanPool/GapCVP/Part10A.lean | 3524 ++++++++++++++ LeanPool/GapCVP/Part10B.lean | 4419 +++++++++++++++++ LeanPool/GapCVP/Part11.lean | 9 + LeanPool/GapCVP/Part11A.lean | 399 ++ LeanPool/GapCVP/Part11B.lean | 2003 ++++++++ LeanPool/GapCVP/Part11C.lean | 5669 ++++++++++++++++++++++ LeanPool/GapCVP/Part12.lean | 9 + LeanPool/GapCVP/Part12A.lean | 162 + LeanPool/GapCVP/Part12B.lean | 2302 +++++++++ LeanPool/GapCVP/Part12C.lean | 4068 ++++++++++++++++ LeanPool/GapCVP/Part12D.lean | 1561 ++++++ LeanPool/GapCVP/Part13.lean | 7782 ++++++++++++++++++++++++++++++ LeanPool/GapCVP/Part14.lean | 9 + LeanPool/GapCVP/Part14A.lean | 338 ++ LeanPool/GapCVP/Part14B.lean | 7595 +++++++++++++++++++++++++++++ LeanPool/GapCVP/Part15.lean | 7711 ++++++++++++++++++++++++++++++ LeanPool/GapCVP/Part16.lean | 9 + LeanPool/GapCVP/Part16A.lean | 6038 ++++++++++++++++++++++++ LeanPool/GapCVP/Part16B.lean | 1688 +++++++ LeanPool/GapCVP/Part17.lean | 2342 +++++++++ LeanPool/GapCVP/Part18.lean | 763 +++ LeanPool/projects.yml | 50 + 71 files changed, 136914 insertions(+) create mode 100644 LeanPool/GapCVP.lean create mode 100644 LeanPool/GapCVP/Part01.lean create mode 100644 LeanPool/GapCVP/Part01A.lean create mode 100644 LeanPool/GapCVP/Part01B.lean create mode 100644 LeanPool/GapCVP/Part02.lean create mode 100644 LeanPool/GapCVP/Part03.lean create mode 100644 LeanPool/GapCVP/Part03A.lean create mode 100644 LeanPool/GapCVP/Part03B.lean create mode 100644 LeanPool/GapCVP/Part03C.lean create mode 100644 LeanPool/GapCVP/Part03D.lean create mode 100644 LeanPool/GapCVP/Part03E.lean create mode 100644 LeanPool/GapCVP/Part03F.lean create mode 100644 LeanPool/GapCVP/Part03G.lean create mode 100644 LeanPool/GapCVP/Part04.lean create mode 100644 LeanPool/GapCVP/Part04A.lean create mode 100644 LeanPool/GapCVP/Part04B.lean create mode 100644 LeanPool/GapCVP/Part04C.lean create mode 100644 LeanPool/GapCVP/Part04D.lean create mode 100644 LeanPool/GapCVP/Part04E.lean create mode 100644 LeanPool/GapCVP/Part04F.lean create mode 100644 LeanPool/GapCVP/Part04G.lean create mode 100644 LeanPool/GapCVP/Part05.lean create mode 100644 LeanPool/GapCVP/Part05A.lean create mode 100644 LeanPool/GapCVP/Part05B.lean create mode 100644 LeanPool/GapCVP/Part05C.lean create mode 100644 LeanPool/GapCVP/Part05D.lean create mode 100644 LeanPool/GapCVP/Part05E.lean create mode 100644 LeanPool/GapCVP/Part05F.lean create mode 100644 LeanPool/GapCVP/Part06.lean create mode 100644 LeanPool/GapCVP/Part06A.lean create mode 100644 LeanPool/GapCVP/Part06B.lean create mode 100644 LeanPool/GapCVP/Part06C.lean create mode 100644 LeanPool/GapCVP/Part06D.lean create mode 100644 LeanPool/GapCVP/Part07.lean create mode 100644 LeanPool/GapCVP/Part07A.lean create mode 100644 LeanPool/GapCVP/Part07B.lean create mode 100644 LeanPool/GapCVP/Part07C.lean create mode 100644 LeanPool/GapCVP/Part07D.lean create mode 100644 LeanPool/GapCVP/Part07E.lean create mode 100644 LeanPool/GapCVP/Part07F.lean create mode 100644 LeanPool/GapCVP/Part07G.lean create mode 100644 LeanPool/GapCVP/Part08.lean create mode 100644 LeanPool/GapCVP/Part08A.lean create mode 100644 LeanPool/GapCVP/Part08B.lean create mode 100644 LeanPool/GapCVP/Part08C.lean create mode 100644 LeanPool/GapCVP/Part08D.lean create mode 100644 LeanPool/GapCVP/Part09.lean create mode 100644 LeanPool/GapCVP/Part10.lean create mode 100644 LeanPool/GapCVP/Part10A.lean create mode 100644 LeanPool/GapCVP/Part10B.lean create mode 100644 LeanPool/GapCVP/Part11.lean create mode 100644 LeanPool/GapCVP/Part11A.lean create mode 100644 LeanPool/GapCVP/Part11B.lean create mode 100644 LeanPool/GapCVP/Part11C.lean create mode 100644 LeanPool/GapCVP/Part12.lean create mode 100644 LeanPool/GapCVP/Part12A.lean create mode 100644 LeanPool/GapCVP/Part12B.lean create mode 100644 LeanPool/GapCVP/Part12C.lean create mode 100644 LeanPool/GapCVP/Part12D.lean create mode 100644 LeanPool/GapCVP/Part13.lean create mode 100644 LeanPool/GapCVP/Part14.lean create mode 100644 LeanPool/GapCVP/Part14A.lean create mode 100644 LeanPool/GapCVP/Part14B.lean create mode 100644 LeanPool/GapCVP/Part15.lean create mode 100644 LeanPool/GapCVP/Part16.lean create mode 100644 LeanPool/GapCVP/Part16A.lean create mode 100644 LeanPool/GapCVP/Part16B.lean create mode 100644 LeanPool/GapCVP/Part17.lean create mode 100644 LeanPool/GapCVP/Part18.lean diff --git a/LeanPool.lean b/LeanPool.lean index 604e4f27f..0d2595700 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -1664,6 +1664,75 @@ import LeanPool.GKPCarry.ModularPrefix import LeanPool.GKPCarry.PowerResidues import LeanPool.GKPCarry.Statement import LeanPool.GKPCarry.UnitCarryCounting +import LeanPool.GapCVP +import LeanPool.GapCVP.Part01 +import LeanPool.GapCVP.Part01A +import LeanPool.GapCVP.Part01B +import LeanPool.GapCVP.Part02 +import LeanPool.GapCVP.Part03 +import LeanPool.GapCVP.Part03A +import LeanPool.GapCVP.Part03B +import LeanPool.GapCVP.Part03C +import LeanPool.GapCVP.Part03D +import LeanPool.GapCVP.Part03E +import LeanPool.GapCVP.Part03F +import LeanPool.GapCVP.Part03G +import LeanPool.GapCVP.Part04 +import LeanPool.GapCVP.Part04A +import LeanPool.GapCVP.Part04B +import LeanPool.GapCVP.Part04C +import LeanPool.GapCVP.Part04D +import LeanPool.GapCVP.Part04E +import LeanPool.GapCVP.Part04F +import LeanPool.GapCVP.Part04G +import LeanPool.GapCVP.Part05 +import LeanPool.GapCVP.Part05A +import LeanPool.GapCVP.Part05B +import LeanPool.GapCVP.Part05C +import LeanPool.GapCVP.Part05D +import LeanPool.GapCVP.Part05E +import LeanPool.GapCVP.Part05F +import LeanPool.GapCVP.Part06 +import LeanPool.GapCVP.Part06A +import LeanPool.GapCVP.Part06B +import LeanPool.GapCVP.Part06C +import LeanPool.GapCVP.Part06D +import LeanPool.GapCVP.Part07 +import LeanPool.GapCVP.Part07A +import LeanPool.GapCVP.Part07B +import LeanPool.GapCVP.Part07C +import LeanPool.GapCVP.Part07D +import LeanPool.GapCVP.Part07E +import LeanPool.GapCVP.Part07F +import LeanPool.GapCVP.Part07G +import LeanPool.GapCVP.Part08 +import LeanPool.GapCVP.Part08A +import LeanPool.GapCVP.Part08B +import LeanPool.GapCVP.Part08C +import LeanPool.GapCVP.Part08D +import LeanPool.GapCVP.Part09 +import LeanPool.GapCVP.Part10 +import LeanPool.GapCVP.Part10A +import LeanPool.GapCVP.Part10B +import LeanPool.GapCVP.Part11 +import LeanPool.GapCVP.Part11A +import LeanPool.GapCVP.Part11B +import LeanPool.GapCVP.Part11C +import LeanPool.GapCVP.Part12 +import LeanPool.GapCVP.Part12A +import LeanPool.GapCVP.Part12B +import LeanPool.GapCVP.Part12C +import LeanPool.GapCVP.Part12D +import LeanPool.GapCVP.Part13 +import LeanPool.GapCVP.Part14 +import LeanPool.GapCVP.Part14A +import LeanPool.GapCVP.Part14B +import LeanPool.GapCVP.Part15 +import LeanPool.GapCVP.Part16 +import LeanPool.GapCVP.Part16A +import LeanPool.GapCVP.Part16B +import LeanPool.GapCVP.Part17 +import LeanPool.GapCVP.Part18 import LeanPool.GrothendieckVanishing import LeanPool.GrothendieckVanishing.ClosedImmersion import LeanPool.GrothendieckVanishing.ClosedImmersionCohomology diff --git a/LeanPool/GapCVP.lean b/LeanPool/GapCVP.lean new file mode 100644 index 000000000..7702a4a82 --- /dev/null +++ b/LeanPool/GapCVP.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part18 + +/-! +# Polynomial-factor hardness of the closest vector problem + +Source: url:https://github.com/openai/ten-proofs +Authors: OpenAI, Dean Cureton +Status: verified +Main declarations: `GapCVP.Comparator.gapCVP400IsNPHard` +Tags: computational-complexity, np-hardness, lattice-problems, coding-theory +MSC: 68Q17, 68Q25, 11H06, 94B35 +-/ + +/-! # Polynomial-factor hardness of the closest vector problem -/ diff --git a/LeanPool/GapCVP/Part01.lean b/LeanPool/GapCVP/Part01.lean new file mode 100644 index 000000000..a2a6aec1b --- /dev/null +++ b/LeanPool/GapCVP/Part01.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part01B + +/-! # GapCVP proof, part 01 -/ diff --git a/LeanPool/GapCVP/Part01A.lean b/LeanPool/GapCVP/Part01A.lean new file mode 100644 index 000000000..862c0d59e --- /dev/null +++ b/LeanPool/GapCVP/Part01A.lean @@ -0,0 +1,7748 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import Mathlib.Algebra.Group.Translate +import Mathlib.Algebra.Module.ZLattice.Basic +import Mathlib.Algebra.Order.Ring.Star +import Mathlib.Algebra.Order.Star.Real +import Mathlib.Computability.Language +import Mathlib.Computability.TuringMachine.Computable + +/-! # GapCVP proof, part 01 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +/-- Executes the `compactMachineStepTac` machine-step simplifier. -/ +macro "compactMachineStepTac" "[" definitions:term,* "]" : tactic => + `(tactic| + (first + | rfl + | (simp [$[$definitions:term],*, Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +namespace GapCVP + +namespace TraceGolf + +/-- GapCVP reduction support. -/ +def oneStep {α : Type*} {step : α → Option α} (source target : α) + (transition : step source = some target) : + EvalsToInTime step source (some target) 1 where + steps := 1 + evals_in_steps := transition + steps_le_m := Nat.le_refl 1 + +/-- GapCVP reduction support. -/ +def rebound {α : Type*} {step : α → Option α} + {source : α} {target : Option α} {oldBudget newBudget : ℕ} + (trace : EvalsToInTime step source target oldBudget) + (budget : oldBudget ≤ newBudget) : + EvalsToInTime step source target newBudget where + steps := trace.steps + evals_in_steps := trace.evals_in_steps + steps_le_m := trace.steps_le_m.trans budget + +end TraceGolf + +open GapCVP.TraceGolf (oneStep rebound) + +namespace Core + +section + +theorem odd_integer_distance_gt_half (z : ℤ) : + (1 / 2 : ℝ) < |(1 : ℝ) - 2 * z| := by + have hz : Odd (1 - 2 * z : ℤ) := by + exact ⟨-z, by ring⟩ + have hne : (1 - 2 * z : ℤ) ≠ 0 := by + intro h + rw [h] at hz + simp only [Int.not_odd_zero] at hz + have habs : (1 : ℤ) ≤ |(1 - 2 * z : ℤ)| := Int.one_le_abs hne + have hreal : (1 : ℝ) ≤ |(1 : ℝ) - 2 * z| := by + exact_mod_cast habs + linarith + +/-- GapCVP reduction support. -/ +structure GapCVPInstance where + /-- GapCVP reduction support. -/ + dimension : ℕ + dimension_pos : 0 < dimension + /-- GapCVP reduction support. -/ + basis : Matrix (Fin dimension) (Fin dimension) ℤ + basis_nonsingular : basis.det ≠ 0 + /-- GapCVP reduction support. -/ + target : Fin dimension → ℚ + /-- GapCVP reduction support. -/ + radius : ℚ + radius_pos : 0 < radius + +namespace GapCVPInstance + +/-- GapCVP reduction support. -/ +noncomputable def latticePoint (I : GapCVPInstance) + (z : Fin I.dimension → ℤ) : EuclideanSpace ℝ (Fin I.dimension) := + WithLp.toLp 2 fun i => (↑(∑ j, I.basis i j * z j) : ℝ) + +/-- GapCVP reduction support. -/ +noncomputable def targetPoint (I : GapCVPInstance) : + EuclideanSpace ℝ (Fin I.dimension) := + WithLp.toLp 2 fun i => (↑(I.target i) : ℝ) + +/-- GapCVP reduction support. -/ +noncomputable def latticeDistance (I : GapCVPInstance) : ℝ := + Metric.infDist I.targetPoint (Set.range I.latticePoint) + +/-- GapCVP reduction support. -/ +noncomputable def IsYes (I : GapCVPInstance) : Bool := + @decide ( + I.latticeDistance ≤ (I.radius : ℝ) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def IsNo (c : ℝ) (I : GapCVPInstance) : Bool := + @decide ( + ((I.dimension : ℝ) ^ c) * (I.radius : ℝ) < I.latticeDistance + ) (Classical.propDecidable _) +end GapCVPInstance + +end + +section + +open scoped BigOperators + +/-- GapCVP reduction support. -/ +def squaredDistance (I : GapCVPInstance) + (z : Fin I.dimension → ℤ) : ℝ := + ∑ i : Fin I.dimension, + (((I.target i : ℚ) : ℝ) - + ∑ j : Fin I.dimension, + (I.basis i j : ℝ) * (z j : ℝ)) ^ 2 + +/-- GapCVP reduction support. -/ +noncomputable def SquaredYes (I : GapCVPInstance) : Bool := + @decide ( + ∃ z : Fin I.dimension → ℤ, + squaredDistance I z ≤ (I.radius : ℝ) ^ 2 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def SquaredNoAt (c : ℝ) (I : GapCVPInstance) : Bool := + @decide ( + ∀ z : Fin I.dimension → ℤ, + (((I.dimension : ℝ) ^ c) * (I.radius : ℝ)) ^ 2 < + squaredDistance I z + ) (Classical.propDecidable _) +theorem squaredDistance_eq_dist_sq + (I : GapCVPInstance) (z : Fin I.dimension → ℤ) : + squaredDistance I z = + dist I.targetPoint (I.latticePoint z) ^ 2 := by + rw [EuclideanSpace.dist_sq_eq] + simp only [squaredDistance, GapCVPInstance.targetPoint, GapCVPInstance.latticePoint, + Int.cast_sum, + Int.cast_mul, Real.dist_eq, sq_abs] + +private theorem isClosed_of_subset_euclidean_integer_grid + {n : ℕ} + (s : Set (EuclideanSpace ℝ (Fin n))) + (hsub : s ⊆ + (Submodule.span ℤ + (Set.range (EuclideanSpace.basisFun (Fin n) ℝ).toBasis) : + Set (EuclideanSpace ℝ (Fin n)))) : + IsClosed s := by + let b : Module.Basis (Fin n) ℝ (EuclideanSpace ℝ (Fin n)) := + (EuclideanSpace.basisFun (Fin n) ℝ).toBasis + let G : Submodule ℤ (EuclideanSpace ℝ (Fin n)) := + Submodule.span ℤ (Set.range b) + have hclosed : IsClosed (G : Set (EuclideanSpace ℝ (Fin n))) := by + change IsClosed (G.toAddSubgroup : Set (EuclideanSpace ℝ (Fin n))) + exact AddSubgroup.isClosed_of_discrete + have hsub' : s ⊆ (G : Set (EuclideanSpace ℝ (Fin n))) := hsub + let inside : Set G := ((↑) : G → EuclideanSpace ℝ (Fin n)) ⁻¹' s + have hinside : IsClosed inside := isClosed_discrete inside + have himage : IsClosed + (((↑) : G → EuclideanSpace ℝ (Fin n)) '' inside) := + hclosed.isClosedMap_subtype_val inside hinside + have heq : + (((↑) : G → EuclideanSpace ℝ (Fin n)) '' inside) = s := by + ext x + constructor + · rintro ⟨y, hy, rfl⟩ + exact hy + · intro hx + exact ⟨⟨x, hsub' hx⟩, hx, rfl⟩ + rwa [heq] at himage + +private theorem instance_latticePoint_range_isClosed (I : GapCVPInstance) : + IsClosed (Set.range I.latticePoint) := by + apply isClosed_of_subset_euclidean_integer_grid + rintro x ⟨z, rfl⟩ + let b : Module.Basis (Fin I.dimension) ℝ + (EuclideanSpace ℝ (Fin I.dimension)) := + (EuclideanSpace.basisFun (Fin I.dimension) ℝ).toBasis + apply (b.mem_span_iff_repr_mem ℤ (I.latticePoint z)).mpr + intro i + refine ⟨∑ j : Fin I.dimension, I.basis i j * z j, ?_⟩ + simp only [algebraMap_int_eq, map_sum, eq_intCast, Int.cast_mul, GapCVPInstance.latticePoint, + Int.cast_sum, + OrthonormalBasis.coe_toBasis_repr_apply, EuclideanSpace.basisFun_repr, b] + +theorem exists_latticePoint_eq_latticeDistance + (I : GapCVPInstance) : + ∃ z : Fin I.dimension → ℤ, + I.latticeDistance = dist I.targetPoint (I.latticePoint z) := by + have hnonempty : + (Set.range I.latticePoint).Nonempty := + ⟨I.latticePoint 0, ⟨0, rfl⟩⟩ + obtain ⟨x, ⟨z, rfl⟩, hdistance⟩ := + (instance_latticePoint_range_isClosed I).exists_infDist_eq_dist + hnonempty I.targetPoint + exact ⟨z, hdistance⟩ + +theorem yes_of_squaredYes (I : GapCVPInstance) : + SquaredYes I → I.IsYes := by + simp only [GapCVP.Core.SquaredYes, GapCVP.Core.GapCVPInstance.IsYes, decide_eq_true_eq] at * + rintro ⟨z, hz⟩ + unfold GapCVPInstance.latticeDistance + calc + Metric.infDist I.targetPoint (Set.range I.latticePoint) ≤ + dist I.targetPoint (I.latticePoint z) := + Metric.infDist_le_dist_of_mem ⟨z, rfl⟩ + _ ≤ (I.radius : ℝ) := by + have hdist : + dist I.targetPoint (I.latticePoint z) ^ 2 ≤ + (I.radius : ℝ) ^ 2 := by + rwa [squaredDistance_eq_dist_sq] at hz + have hnonneg : 0 ≤ (I.radius : ℝ) := by + exact_mod_cast (le_of_lt I.radius_pos) + nlinarith [dist_nonneg (x := I.targetPoint) + (y := I.latticePoint z)] + +theorem no_of_squaredNoAt + (c : ℝ) (I : GapCVPInstance) : + SquaredNoAt c I → I.IsNo c := by + simp only [GapCVP.Core.SquaredNoAt, GapCVP.Core.GapCVPInstance.IsNo, decide_eq_true_eq] at * + intro hsquared + obtain ⟨z, hnearest⟩ := exists_latticePoint_eq_latticeDistance I + have hsq := hsquared z + rw [squaredDistance_eq_dist_sq] at hsq + have hfactor : 0 ≤ (I.dimension : ℝ) ^ c := + Real.rpow_nonneg (by positivity) _ + have hradius : 0 ≤ (I.radius : ℝ) := by + exact_mod_cast (le_of_lt I.radius_pos) + rw [hnearest] + nlinarith [dist_nonneg (x := I.targetPoint) + (y := I.latticePoint z), mul_nonneg hfactor hradius] + +theorem squaredNoAt_of_metricNo + (c : ℝ) (I : GapCVPInstance) (hno : I.IsNo c) : + SquaredNoAt c I := by + simp only [GapCVP.Core.SquaredNoAt, GapCVP.Core.GapCVPInstance.IsNo, decide_eq_true_eq] at * + intro z + have hpoint : + ((I.dimension : ℝ) ^ c) * (I.radius : ℝ) < + dist I.targetPoint (I.latticePoint z) := + lt_of_lt_of_le hno + (Metric.infDist_le_dist_of_mem ⟨z, rfl⟩) + have hfactor : 0 ≤ (I.dimension : ℝ) ^ c := + Real.rpow_nonneg (by positivity) _ + have hradius : 0 ≤ (I.radius : ℝ) := by + exact_mod_cast le_of_lt I.radius_pos + rw [squaredDistance_eq_dist_sq] + nlinarith [mul_nonneg hfactor hradius, + dist_nonneg (x := I.targetPoint) (y := I.latticePoint z)] + +theorem squaredNoAt_iff_metricNo + (c : ℝ) (I : GapCVPInstance) : + SquaredNoAt c I ↔ I.IsNo c := + ⟨no_of_squaredNoAt c I, squaredNoAt_of_metricNo c I⟩ + +end + +section + +/-- GapCVP reduction support. -/ +abbrev canonicalNoInstance : GapCVPInstance where + dimension := 1 + dimension_pos := by norm_num + basis := Matrix.of fun _ _ => 2 + basis_nonsingular := by + rw [Matrix.det_fin_one] + norm_num + target := fun _ => 1 + radius := 1 / 2 + radius_pos := by norm_num + +end + +end Core + +section + +/-- GapCVP reduction support. -/ +abbrev Literal := ℕ × Bool + +/-- GapCVP reduction support. -/ +abbrev ThreeClause := Fin 3 → Literal + +/-- GapCVP reduction support. -/ +abbrev ThreeCNF := List ThreeClause + +/-- GapCVP reduction support. -/ +noncomputable def clauseHasDistinctVariables (c : ThreeClause) : Bool := + @decide ( + Function.Injective (fun i : Fin 3 => (c i).1) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def literalSatisfied (assignment : ℕ → Bool) (l : Literal) : Bool := + @decide ( + assignment l.1 = l.2 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def clauseSatisfied (assignment : ℕ → Bool) (c : ThreeClause) : Bool := + @decide ( + ∃ i : Fin 3, literalSatisfied assignment (c i) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def threeCNFSatisfiable (φ : ThreeCNF) : Bool := + @decide ( + (∀ c ∈ φ, clauseHasDistinctVariables c) ∧ + ∃ assignment : ℕ → Bool, ∀ c ∈ φ, clauseSatisfied assignment c + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +structure GapCVPInstance where + /-- GapCVP reduction support. -/ + dimension : ℕ + /-- GapCVP reduction support. -/ + basis : Matrix (Fin dimension) (Fin dimension) ℤ + /-- GapCVP reduction support. -/ + target : Fin dimension → ℚ + /-- GapCVP reduction support. -/ + radius : ℚ + +/-- GapCVP reduction support. -/ +noncomputable def gapCVPWellFormed (I : GapCVPInstance) : Bool := + @decide ( + 0 < I.dimension ∧ I.basis.det ≠ 0 ∧ 0 < I.radius + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def distanceSquared (I : GapCVPInstance) + (z : Fin I.dimension → ℤ) : ℝ := + ∑ i : Fin I.dimension, + (((∑ j : Fin I.dimension, + (I.basis i j : ℝ) * (z j : ℝ)) - (I.target i : ℝ)) ^ 2) + +/-- GapCVP reduction support. -/ +class BinaryBitCodec (α : Type*) where + /-- GapCVP reduction support. -/ + encode : α → List Bool + /-- GapCVP reduction support. -/ + decode : List Bool → Option α + decode_encode : ∀ a : α, decode (encode a) = some a + +namespace BinaryEncoding + +/-- GapCVP reduction support. -/ +def lengthPrefixedWord (word : List Bool) : List Bool := + List.replicate word.length true ++ false :: word + +@[simp] theorem lengthPrefixedWord_length (word : List Bool) : + (lengthPrefixedWord word).length = 2 * word.length + 1 := by + simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] + omega + +/-- GapCVP reduction support. -/ +def readUnaryPrefix : List Bool → Option (ℕ × List Bool) + | [] => none + | false :: rest => some (0, rest) + | true :: rest => + match readUnaryPrefix rest with + | none => none + | some (n, tail) => some (n + 1, tail) + +@[simp] theorem readUnaryPrefix_replicate + (n : ℕ) (tail : List Bool) : + readUnaryPrefix (List.replicate n true ++ false :: tail) = + some (n, tail) := by + induction n with + | zero => simp only [List.replicate_zero, List.nil_append, readUnaryPrefix] + | succ n ih => + simp only [List.replicate_succ, List.cons_append, readUnaryPrefix, ih] + +/-- GapCVP reduction support. -/ +def readLengthPrefixedWord (bits : List Bool) : + Option (List Bool × List Bool) := + match readUnaryPrefix bits with + | none => none + | some (n, tail) => + if n ≤ tail.length then + some (tail.take n, tail.drop n) + else + none + +@[simp] theorem readLengthPrefixedWord_append + (word suffix : List Bool) : + readLengthPrefixedWord (lengthPrefixedWord word ++ suffix) = + some (word, suffix) := by + simp only [readLengthPrefixedWord, lengthPrefixedWord, List.append_assoc, List.cons_append, + readUnaryPrefix_replicate, List.length_append, le_add_iff_nonneg_right, zero_le, ↓reduceIte, + List.take_left', + List.drop_left'] + +/-- GapCVP reduction support. -/ +def encodeLiteral (literal : Literal) : List Bool := + lengthPrefixedWord (Computability.encodeNat literal.1) ++ [literal.2] + +/-- GapCVP reduction support. -/ +def readLiteral (bits : List Bool) : Option (Literal × List Bool) := + match readLengthPrefixedWord bits with + | some (word, sign :: rest) => + some ((Computability.decodeNat word, sign), rest) + | _ => none + +@[simp] theorem readLiteral_append + (literal : Literal) (suffix : List Bool) : + readLiteral (encodeLiteral literal ++ suffix) = + some (literal, suffix) := by + rcases literal with ⟨index, sign⟩ + simp only [readLiteral, encodeLiteral, List.append_assoc, List.cons_append, List.nil_append, + readLengthPrefixedWord_append, Computability.decode_encodeNat] + +/-- GapCVP reduction support. -/ +def encodeThreeClause (clause : ThreeClause) : List Bool := + encodeLiteral (clause 0) ++ + encodeLiteral (clause 1) ++ encodeLiteral (clause 2) + +private def readThreeClause (bits : List Bool) : + Option (ThreeClause × List Bool) := + match readLiteral bits with + | some (a, rest₁) => + match readLiteral rest₁ with + | some (b, rest₂) => + match readLiteral rest₂ with + | some (c, rest₃) => some (![a, b, c], rest₃) + | none => none + | none => none + | none => none + +@[simp] private theorem readThreeClause_append + (clause : ThreeClause) (suffix : List Bool) : + readThreeClause (encodeThreeClause clause ++ suffix) = + some (clause, suffix) := by + have hclause : ![clause 0, clause 1, clause 2] = clause := by + funext i + fin_cases i <;> rfl + simp only [readThreeClause, encodeThreeClause, Fin.isValue, List.append_assoc, + readLiteral_append, hclause] + +private def readThreeClauses : ℕ → List Bool → Option (ThreeCNF × List Bool) + | 0, bits => some ([], bits) + | n + 1, bits => + match readThreeClause bits with + | none => none + | some (clause, rest) => + match readThreeClauses n rest with + | none => none + | some (clauses, suffix) => some (clause :: clauses, suffix) + +@[simp] private theorem readThreeClauses_append + (clauses : ThreeCNF) (suffix : List Bool) : + readThreeClauses clauses.length + (clauses.flatMap encodeThreeClause ++ suffix) = + some (clauses, suffix) := by + induction clauses with + | nil => simp only [List.length_nil, List.flatMap_nil, List.nil_append, readThreeClauses] + | cons clause clauses ih => + simp only [List.length_cons, List.flatMap_cons, List.append_assoc, readThreeClauses, + readThreeClause_append, + ih] + +/-- GapCVP reduction support. -/ +def encodeThreeCNF (clauses : ThreeCNF) : List Bool := + lengthPrefixedWord (Computability.encodeNat clauses.length) ++ + clauses.flatMap encodeThreeClause + +/-- GapCVP reduction support. -/ +def decodeThreeCNF (bits : List Bool) : Option ThreeCNF := + match readLengthPrefixedWord bits with + | none => none + | some (word, rest) => + match readThreeClauses (Computability.decodeNat word) rest with + | some (clauses, []) => some clauses + | _ => none + +@[simp] theorem decodeThreeCNF_encode (clauses : ThreeCNF) : + decodeThreeCNF (encodeThreeCNF clauses) = some clauses := by + have hclauses : + readThreeClauses clauses.length + (clauses.flatMap encodeThreeClause) = some (clauses, []) := by + simpa only [List.append_nil] using readThreeClauses_append clauses [] + simp only [decodeThreeCNF, encodeThreeCNF, readLengthPrefixedWord_append, + Computability.decode_encodeNat, + hclauses] + +end BinaryEncoding + +noncomputable instance (priority := 2000) instBinaryBitCodecThreeCNF : + BinaryBitCodec ThreeCNF where + encode := BinaryEncoding.encodeThreeCNF + decode := BinaryEncoding.decodeThreeCNF + decode_encode := BinaryEncoding.decodeThreeCNF_encode + +end + +namespace BinaryEncoding + +/-- GapCVP reduction support. -/ +def encodeAtomic {α : Type*} [Encodable α] (a : α) : List Bool := + lengthPrefixedWord (Computability.encodeNat (Encodable.encode a)) + +/-- GapCVP reduction support. -/ +def readAtomic {α : Type*} [Encodable α] (bits : List Bool) : + Option (α × List Bool) := + match readLengthPrefixedWord bits with + | none => none + | some (word, suffix) => + match (Encodable.decode (Computability.decodeNat word) : Option α) with + | none => none + | some a => some (a, suffix) + +@[simp] theorem readAtomic_append + {α : Type*} [Encodable α] (a : α) (suffix : List Bool) : + readAtomic (encodeAtomic a ++ suffix) = some (a, suffix) := by + simp only [readAtomic, encodeAtomic, readLengthPrefixedWord_append, + Computability.decode_encodeNat, + Encodable.encodek] + +/-- GapCVP reduction support. -/ +def encodeFinValues {α : Type*} [Encodable α] : + (n : ℕ) → (Fin n → α) → List Bool + | 0, _ => [] + | n + 1, values => + encodeAtomic (values 0) ++ + encodeFinValues n (fun i => values i.succ) + +/-- GapCVP reduction support. -/ +def readFinValues {α : Type*} [Encodable α] : + (n : ℕ) → List Bool → Option ((Fin n → α) × List Bool) + | 0, bits => some (Fin.elim0, bits) + | n + 1, bits => + match (readAtomic bits : Option (α × List Bool)) with + | none => none + | some (head, rest) => + match readFinValues n rest with + | none => none + | some (tail, suffix) => some (Fin.cases head tail, suffix) + +@[simp] theorem readFinValues_append + {α : Type*} [Encodable α] + {n : ℕ} (values : Fin n → α) (suffix : List Bool) : + readFinValues n (encodeFinValues n values ++ suffix) = + some (values, suffix) := by + induction n with + | zero => + have hvalues : values = Fin.elim0 := by + funext i + exact Fin.elim0 i + simp only [readFinValues, encodeFinValues, List.nil_append, hvalues] + | succ n ih => + have hvalues : + Fin.cases (values 0) (fun i : Fin n => values i.succ) = + values := by + funext i + refine Fin.cases ?_ (fun j => ?_) i + · rfl + · rfl + simp only [readFinValues, encodeFinValues, List.append_assoc, readAtomic_append, ih, hvalues] + +/-- GapCVP reduction support. -/ +def encodeMatrixRows : + (m n : ℕ) → (Fin m → Fin n → ℤ) → List Bool + | 0, _, _ => [] + | m + 1, n, matrix => + encodeFinValues n (matrix 0) ++ + encodeMatrixRows m n (fun i => matrix i.succ) + +/-- GapCVP reduction support. -/ +def readMatrixRows : + (m n : ℕ) → List Bool → + Option ((Fin m → Fin n → ℤ) × List Bool) + | 0, _, bits => some (Fin.elim0, bits) + | m + 1, n, bits => + match (readFinValues n bits : + Option ((Fin n → ℤ) × List Bool)) with + | none => none + | some (row, rest) => + match readMatrixRows m n rest with + | none => none + | some (rows, suffix) => some (Fin.cases row rows, suffix) + +@[simp] theorem readMatrixRows_append + {m n : ℕ} (matrix : Fin m → Fin n → ℤ) + (suffix : List Bool) : + readMatrixRows m n (encodeMatrixRows m n matrix ++ suffix) = + some (matrix, suffix) := by + induction m with + | zero => + have hmatrix : matrix = Fin.elim0 := by + funext i + exact Fin.elim0 i + simp only [readMatrixRows, encodeMatrixRows, List.nil_append, hmatrix] + | succ m ih => + have hmatrix : + Fin.cases (matrix 0) (fun i : Fin m => matrix i.succ) = + matrix := by + funext i + refine Fin.cases ?_ (fun j => ?_) i + · rfl + · rfl + simp only [readMatrixRows, encodeMatrixRows, List.append_assoc, readFinValues_append, ih, + hmatrix] + +/-- GapCVP reduction support. -/ +def encodeGapCVPInstance (I : GapCVPInstance) : List Bool := + encodeAtomic I.dimension ++ + encodeAtomic I.radius ++ + encodeFinValues I.dimension I.target ++ + encodeMatrixRows I.dimension I.dimension (Matrix.of.symm I.basis) + +private def decodeGapCVPInstance (bits : List Bool) : Option GapCVPInstance := + match (readAtomic bits : Option (ℕ × List Bool)) with + | none => none + | some (n, afterDimension) => + match (readAtomic afterDimension : Option (ℚ × List Bool)) with + | none => none + | some (radius, afterRadius) => + match (readFinValues n afterRadius : + Option ((Fin n → ℚ) × List Bool)) with + | none => none + | some (target, afterTarget) => + match readMatrixRows n n afterTarget with + | some (basis, []) => + some { + dimension := n + basis := basis + target := target + radius := radius + } + | _ => none + +@[simp] private theorem decodeGapCVPInstance_encode + (I : GapCVPInstance) : + decodeGapCVPInstance (encodeGapCVPInstance I) = + some I := by + cases I with + | mk n basis target radius => + have hmatrix : + readMatrixRows n n + (encodeMatrixRows n n (Matrix.of.symm basis)) = + some (Matrix.of.symm basis, []) := by + simpa only [List.append_nil] using + (readMatrixRows_append (Matrix.of.symm basis) []) + simp only [decodeGapCVPInstance, encodeGapCVPInstance, List.append_assoc, readAtomic_append, + readFinValues_append, hmatrix] + rfl + +end BinaryEncoding + +section + +noncomputable instance (priority := 2000) instBinaryBitCodecGapCVPInstance : + BinaryBitCodec GapCVPInstance where + encode := BinaryEncoding.encodeGapCVPInstance + decode := BinaryEncoding.decodeGapCVPInstance + decode_encode := BinaryEncoding.decodeGapCVPInstance_encode + +open Computability + +/-- GapCVP reduction support. -/ +noncomputable def binaryFinEncoding (α : Type*) + [BinaryBitCodec α] : Encoding α Bool where + encode := BinaryBitCodec.encode + decode := BinaryBitCodec.decode + decode_encode := BinaryBitCodec.decode_encode + +/-- GapCVP reduction support. -/ +abbrev BitLanguage := List Bool → Bool + +/-- GapCVP reduction support. -/ +abbrev bitEncoding : List Bool → List Bool := id + +/-- GapCVP reduction support. -/ +def pairBitEncoding : (List Bool × List Bool) → + List (Bool ⊕ Bool) := + (Computability.encodingProd + (Computability.encodingList Bool) + (Computability.encodingList Bool)).encode + +/-- GapCVP reduction support. -/ +abbrev BitTM (f : List Bool → List Bool) := + Turing.TM2ComputableInPolyTime bitEncoding bitEncoding f + +/-- GapCVP reduction support. -/ +abbrev VerifierTM (verifier : List Bool × List Bool → Bool) := + Turing.TM2ComputableInPolyTime + pairBitEncoding Computability.encodeBool verifier + +/-- GapCVP reduction support. -/ +noncomputable def IsNP (L : BitLanguage) : Bool := + @decide ( + ∃ (bound : Polynomial ℕ) (verifier : List Bool × List Bool → Bool), + Nonempty (VerifierTM verifier) ∧ + ∀ x : List Bool, + L x ↔ ∃ certificate : List Bool, + certificate.length ≤ bound.eval x.length ∧ + verifier (x, certificate) = true + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +structure PolynomialReduction (A B : BitLanguage) where + /-- GapCVP reduction support. -/ + map : List Bool → List Bool + polynomial_time : Nonempty + (BitTM map) + correct : ∀ x, A x ↔ B (map x) + +private noncomputable def PolynomialTimeClosedUnderComposition : Bool := + @decide ( + ∀ (f g : List Bool → List Bool), + Nonempty (BitTM f) → + Nonempty (BitTM g) → + Nonempty (BitTM (g ∘ f)) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def NPHard (L : BitLanguage) : Bool := + @decide ( + ∀ A : BitLanguage, IsNP A → Nonempty (PolynomialReduction A L) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def threeSATLanguage : BitLanguage := fun bits => + @decide ( + ∃ φ : ThreeCNF, + (binaryFinEncoding ThreeCNF).encode φ = bits ∧ + threeCNFSatisfiable φ + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +structure PromiseProblem where + /-- GapCVP reduction support. -/ + yes : BitLanguage + /-- GapCVP reduction support. -/ + no : BitLanguage + disjoint : ∀ x, yes x → no x → False + +/-- GapCVP reduction support. -/ +structure PromiseReduction (A : BitLanguage) (P : PromiseProblem) where + /-- GapCVP reduction support. -/ + map : List Bool → List Bool + polynomial_time : Nonempty + (BitTM map) + completeness : ∀ x, A x → P.yes (map x) + soundness : ∀ x, ¬ A x → P.no (map x) + +/-- GapCVP reduction support. -/ +noncomputable def NPHardPromise (P : PromiseProblem) : Bool := + @decide ( + ∀ A : BitLanguage, IsNP A → Nonempty (PromiseReduction A P) + ) (Classical.propDecidable _) +end + +section + +/-- GapCVP reduction support. -/ +noncomputable def gapYES (I : GapCVPInstance) : Bool := + @decide ( + gapCVPWellFormed I ∧ + ∃ z : Fin I.dimension → ℤ, + distanceSquared I z ≤ (I.radius : ℝ) ^ 2 + ) (Classical.propDecidable _) + +namespace TMComposition + +open Turing + +private abbrev Stack (first second : FinTM2) := + first.K ⊕ { k : second.K // k ≠ second.k₀ } + +/-- GapCVP reduction support. -/ +abbrev alphabet (first second : FinTM2) : Stack first second → Type + | .inl k => first.Γ k + | .inr k => second.Γ k.val + +private abbrev Label (first second : FinTM2) := first.Λ ⊕ second.Λ + +private abbrev InternalState (first second : FinTM2) := first.σ × second.σ + +private def statementPushCount {K : Type} {Γ : K → Type} {Λ σ : Type} : + Turing.TM2.Stmt Γ Λ σ → ℕ + | .push _ _ q => statementPushCount q + 1 + | .peek _ _ q => statementPushCount q + | .pop _ _ q => statementPushCount q + | .load _ q => statementPushCount q + | .branch _ yes no => + max (statementPushCount yes) (statementPushCount no) + | .goto _ => 0 + | .halt => 0 + +private theorem stepAux_stack_length_le + {K : Type} {Γ : K → Type} {Λ σ : Type} [DecidableEq K] + (q : Turing.TM2.Stmt Γ Λ σ) (v : σ) + (sourceStacks : ∀ k, List (Γ k)) (target : K) : + ((Turing.TM2.stepAux q v sourceStacks).stk target).length ≤ + (sourceStacks target).length + statementPushCount q := by + induction q generalizing v sourceStacks with + | push k p q ih => + have h := ih v (Function.update sourceStacks k + (p v :: sourceStacks k)) + by_cases hk : target = k + · subst target + simp only [Function.update_self, List.length_cons, TM2.stepAux, statementPushCount, + ge_iff_le] at h ⊢ + omega + · simp only [Function.update, hk, ↓reduceDIte, TM2.stepAux, statementPushCount, ge_iff_le] + at h ⊢ + omega + | peek k p q ih => + simpa only [TM2.stepAux, statementPushCount] using ih (p v (sourceStacks k).head?) + sourceStacks + | pop k p q ih => + have h := ih (p v (sourceStacks k).head?) + (Function.update sourceStacks k (sourceStacks k).tail) + by_cases hk : target = k + · subst target + simp only [Function.update_self, List.length_tail, TM2.stepAux, statementPushCount, + ge_iff_le] at h ⊢ + omega + · simpa only [TM2.stepAux, statementPushCount, ge_iff_le, Function.update, hk, ↓reduceDIte] + using h + | load p q ih => + simpa only [TM2.stepAux, statementPushCount] using ih (p v) sourceStacks + | branch p yes no ihYes ihNo => + cases hp : p v with + | false => + have h := ihNo v sourceStacks + simp only [TM2.stepAux, hp, Bool.cond_false, statementPushCount, ge_iff_le] at h ⊢ + omega + | true => + have h := ihYes v sourceStacks + simp only [TM2.stepAux, hp, Bool.cond_true, statementPushCount, ge_iff_le] at h ⊢ + omega + | goto p => simp only [TM2.stepAux, statementPushCount, add_zero, Std.le_refl] + | halt => simp only [TM2.stepAux, statementPushCount, add_zero, Std.le_refl] + +/-- GapCVP reduction support. -/ +noncomputable def maxPushPerStep (tm : Turing.FinTM2) : ℕ := by + classical + letI : Fintype tm.Λ := tm.ΛFin + exact Finset.univ.sup fun label => statementPushCount (tm.m label) + +private theorem statementPushCount_le_max + (tm : Turing.FinTM2) (label : tm.Λ) : + statementPushCount (tm.m label) ≤ maxPushPerStep tm := by + classical + let : Fintype tm.Λ := tm.ΛFin + change statementPushCount (tm.m label) ≤ + (Finset.univ : Finset tm.Λ).sup + (fun q => statementPushCount (tm.m q)) + exact Finset.le_sup + (f := fun q : tm.Λ => statementPushCount (tm.m q)) + (Finset.mem_univ label) + +private theorem step_stack_length_le (tm : Turing.FinTM2) + (c c' : tm.Cfg) (h : tm.step c = some c') (target : tm.K) : + (c'.stk target).length ≤ + (c.stk target).length + maxPushPerStep tm := by + rcases c with ⟨l, v, sourceStacks⟩ + cases l with + | none => simp only [FinTM2.step, TM2.step, reduceCtorEq] at h + | some label => + simp only [FinTM2.step, TM2.step] at h + have hc := Option.some.inj h + subst c' + exact (stepAux_stack_length_le (tm.m label) v + sourceStacks target).trans + (Nat.add_le_add_left (statementPushCount_le_max tm label) _) + +private theorem iterate_stack_length_le (tm : Turing.FinTM2) + (steps : ℕ) (c c' : tm.Cfg) + (h : ((fun state : Option tm.Cfg => state.bind tm.step)^[steps]) + (some c) = some c') (target : tm.K) : + (c'.stk target).length ≤ + (c.stk target).length + steps * maxPushPerStep tm := by + induction steps generalizing c with + | zero => + have hc : c = c' := Option.some.inj (by simpa only [Option.some.injEq, FinTM2.step, + Function.iterate_zero, id_eq] using h) + subst c' + simp only [zero_mul, add_zero, Std.le_refl] + | succ steps ih => + have hnext : + ((fun state : Option tm.Cfg => state.bind tm.step)^[steps]) + (tm.step c) = some c' := by + simpa only [Function.iterate_succ_apply, Option.bind_some] using h + cases hs : tm.step c with + | none => + rw [hs] at hnext + have hfixed : + ((fun state : Option tm.Cfg => state.bind tm.step)^[steps]) + none = none := + Function.iterate_fixed (by rfl) steps + rw [hfixed] at hnext + cases hnext + | some middle => + have htail : + ((fun state : Option tm.Cfg => state.bind tm.step)^[steps]) + (some middle) = some c' := by + simpa only [hs] using hnext + have hfirst := step_stack_length_le tm c middle hs target + have hrest := ih middle htail + simpa only [Nat.succ_mul, Nat.add_comm, Nat.add_assoc, ge_iff_le, Nat.add_left_comm] + using + hrest.trans (Nat.add_le_add_right hfirst _) + +private theorem evals_stack_length_le (tm : Turing.FinTM2) + (c c' : tm.Cfg) + (h : StateTransition.EvalsTo tm.step c (some c')) + (target : tm.K) : + (c'.stk target).length ≤ + (c.stk target).length + h.steps * maxPushPerStep tm := by + apply iterate_stack_length_le tm h.steps c c' _ target + exact h.evals_in_steps + +private theorem iterate_map_of_some + {α β : Type} (stepA : α → Option α) (stepB : β → Option β) + (translate : α → β) + (hstep : ∀ a a', stepA a = some a' → + stepB (translate a) = some (translate a')) + (steps : ℕ) (a a' : α) + (h : ((fun state : Option α => state.bind stepA)^[steps]) + (some a) = some a') : + ((fun state : Option β => state.bind stepB)^[steps]) + (some (translate a)) = some (translate a') := by + induction steps generalizing a with + | zero => + have ha : a = a' := Option.some.inj (by simpa only [Option.some.injEq, Function.iterate_zero, + id_eq] using h) + subst a' + simp only [Function.iterate_zero, id_eq] + | succ steps ih => + have hnext : + ((fun state : Option α => state.bind stepA)^[steps]) + (stepA a) = some a' := by + simpa only [Function.iterate_succ_apply, Option.bind_some] using h + cases hs : stepA a with + | none => + rw [hs] at hnext + have hfixed : + ((fun state : Option α => state.bind stepA)^[steps]) + none = none := + Function.iterate_fixed (by rfl) steps + rw [hfixed] at hnext + cases hnext + | some middle => + have htail : + ((fun state : Option α => state.bind stepA)^[steps]) + (some middle) = some a' := by + simpa only [hs] using hnext + have htranslated := hstep a middle hs + simpa only [Function.iterate_succ_apply, + Option.bind_some, htranslated] using ih middle htail + +/-- GapCVP reduction support. -/ +def evalsToInTimeMapOfStep + {α β : Type} (stepA : α → Option α) (stepB : β → Option β) + (translate : α → β) + (hstep : ∀ a a', stepA a = some a' → + stepB (translate a) = some (translate a')) + {a a' : α} {budget : ℕ} + (h : EvalsToInTime stepA a (some a') budget) : + EvalsToInTime stepB (translate a) (some (translate a')) budget where + steps := h.steps + evals_in_steps := + iterate_map_of_some stepA stepB translate hstep + h.steps a a' h.evals_in_steps + steps_le_m := h.steps_le_m + +@[simp] private theorem cast_list_length {α β : Type} + (h : α = β) (xs : List α) : + (cast (congrArg List h) xs).length = xs.length := by + cases h + rfl + +private theorem outputsInTime_length_le (tm : Turing.FinTM2) + (input : List (tm.Γ tm.k₀)) (output : List (tm.Γ tm.k₁)) + (budget : ℕ) + (h : Turing.TM2OutputsInTime tm input (some output) budget) : + output.length ≤ input.length + budget * maxPushPerStep tm := by + have hrun := evals_stack_length_le tm + (Turing.initList tm input) (Turing.haltList tm output) + h.toEvalsTo tm.k₁ + have hsteps : h.steps * maxPushPerStep tm ≤ + budget * maxPushPerStep tm := + Nat.mul_le_mul_right _ h.steps_le_m + by_cases hk : tm.k₁ = tm.k₀ + · simp only [haltList, hk, eq_mpr_eq_cast, ↓reduceDIte, cast_eq, initList, cast_list_length, + FinTM2.step, + Option.map_some] at hrun + exact hrun.trans (Nat.add_le_add_left hsteps _) + · simp only [haltList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq, initList, hk, List.length_nil, + FinTM2.step, + Option.map_some, zero_add] at hrun + exact hrun.trans (by omega) + +theorem natPolynomial_eval_monotone (p : Polynomial ℕ) : + Monotone p.eval := by + induction p using Polynomial.induction_on' with + | add p q hp hq => + intro a b hab + simpa only [Polynomial.eval_add] using Nat.add_le_add (hp hab) (hq hab) + | monomial n a => + intro x y hxy + simp only [Polynomial.eval_monomial] + exact Nat.mul_le_mul_left a (Nat.pow_le_pow_left hxy n) + +private theorem polynomialComputer_output_length_le + {f : List Bool → List Bool} + (first : BitTM f) + (x : List Bool) : + (f x).length ≤ + x.length + first.time.eval x.length * maxPushPerStep first.tm := by + have h := outputsInTime_length_le first.tm + (List.map first.inputAlphabet.invFun (bitEncoding x)) + (List.map first.outputAlphabet.invFun (bitEncoding (f x))) + (first.time.eval (bitEncoding x).length) + (first.outputsFun x) + simpa only [bitEncoding, ge_iff_le, Equiv.invFun_as_coe, id_eq, List.length_map] using h + +/-- GapCVP reduction support. -/ +noncomputable def outputLengthPolynomial + {f : List Bool → List Bool} + (first : BitTM f) : + Polynomial ℕ := + Polynomial.X + Polynomial.C (maxPushPerStep first.tm) * first.time + +theorem outputLengthPolynomial_bounds + {f : List Bool → List Bool} + (first : BitTM f) + (x : List Bool) : + (f x).length ≤ (outputLengthPolynomial first).eval x.length := by + simpa only [outputLengthPolynomial, eq_natCast, Polynomial.eval_add, Polynomial.eval_X, + Polynomial.eval_mul, + Polynomial.eval_natCast, Nat.cast_id, Nat.mul_comm] using polynomialComputer_output_length_le + first x + +private noncomputable def compositeTimePolynomial + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) : + Polynomial ℕ := + first.time + second.time.comp (outputLengthPolynomial first) + +private theorem compositeTimePolynomial_bounds + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (x : List Bool) : + first.time.eval x.length + second.time.eval (f x).length ≤ + (compositeTimePolynomial first second).eval x.length := by + have hmiddle := outputLengthPolynomial_bounds first x + have hsecond := natPolynomial_eval_monotone second.time hmiddle + simpa only [compositeTimePolynomial, Polynomial.eval_add, Polynomial.eval_comp, + add_le_add_iff_left, + ge_iff_le] using Nat.add_le_add_left hsecond (first.time.eval x.length) + +private noncomputable def secondStack (first second : FinTM2) (k : second.K) : + Stack first second := + if h : k = second.k₀ then .inl first.k₁ else .inr ⟨k, h⟩ + +private noncomputable def secondAlphabetEquiv + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (k : second.tm.K) : + second.tm.Γ k ≃ + alphabet first.tm second.tm (secondStack first.tm second.tm k) := by + classical + unfold secondStack + split_ifs with h + · subst k + exact second.inputAlphabet.trans first.outputAlphabet.symm + · exact Equiv.refl (second.tm.Γ k) + +private def liftFirstStmt (first second : FinTM2) : + Turing.TM2.Stmt first.Γ first.Λ first.σ → + Turing.TM2.Stmt (alphabet first second) + (Label first second) (InternalState first second) + | .push k f q => + .push (.inl k) (fun s => f s.1) (liftFirstStmt first second q) + | .peek k f q => + .peek (.inl k) (fun s x => (f s.1 x, s.2)) + (liftFirstStmt first second q) + | .pop k f q => + .pop (.inl k) (fun s x => (f s.1 x, s.2)) + (liftFirstStmt first second q) + | .load f q => + .load (fun s => (f s.1, s.2)) (liftFirstStmt first second q) + | .branch f yes no => + .branch (fun s => f s.1) + (liftFirstStmt first second yes) (liftFirstStmt first second no) + | .goto f => .goto (fun s => .inl (f s.1)) + | .halt => .goto (fun _ => .inr second.main) + +private noncomputable def liftSecondStmt + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) : + Turing.TM2.Stmt second.tm.Γ second.tm.Λ second.tm.σ → + Turing.TM2.Stmt (alphabet first.tm second.tm) + (Label first.tm second.tm) (InternalState first.tm second.tm) + | .push k p q => by + classical + by_cases hk : k = second.tm.k₀ + · subst k + exact .push (.inl first.tm.k₁) + (fun s => (second.inputAlphabet.trans first.outputAlphabet.symm) + (p s.2)) + (liftSecondStmt first second q) + · exact .push (.inr ⟨k, hk⟩) (fun s => p s.2) + (liftSecondStmt first second q) + | .peek k p q => by + classical + by_cases hk : k = second.tm.k₀ + · subst k + exact .peek (.inl first.tm.k₁) + (fun s x => (s.1, p s.2 + (x.map (first.outputAlphabet.trans second.inputAlphabet.symm)))) + (liftSecondStmt first second q) + · exact .peek (.inr ⟨k, hk⟩) + (fun s x => (s.1, p s.2 x)) + (liftSecondStmt first second q) + | .pop k p q => by + classical + by_cases hk : k = second.tm.k₀ + · subst k + exact .pop (.inl first.tm.k₁) + (fun s x => (s.1, p s.2 + (x.map (first.outputAlphabet.trans second.inputAlphabet.symm)))) + (liftSecondStmt first second q) + · exact .pop (.inr ⟨k, hk⟩) + (fun s x => (s.1, p s.2 x)) + (liftSecondStmt first second q) + | .load p q => + .load (fun s => (s.1, p s.2)) (liftSecondStmt first second q) + | .branch p yes no => + .branch (fun s => p s.2) + (liftSecondStmt first second yes) (liftSecondStmt first second no) + | .goto p => .goto (fun s => .inr (p s.2)) + | .halt => .halt + +/-- GapCVP reduction support. -/ +noncomputable def machine + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) : + Turing.FinTM2 := by + classical + letI : Fintype first.tm.K := first.tm.kFin + letI : Fintype second.tm.K := second.tm.kFin + letI : Fintype first.tm.Λ := first.tm.ΛFin + letI : Fintype second.tm.Λ := second.tm.ΛFin + letI : Fintype first.tm.σ := first.tm.σFin + letI : Fintype second.tm.σ := second.tm.σFin + letI : Fintype (first.tm.Γ first.tm.k₀) := first.tm.Γk₀Fin + letI : Fintype + (alphabet first.tm second.tm (.inl first.tm.k₀)) := + first.tm.Γk₀Fin + exact { + K := Stack first.tm second.tm + k₀ := .inl first.tm.k₀ + k₁ := secondStack first.tm second.tm second.tm.k₁ + Γ := alphabet first.tm second.tm + Λ := Label first.tm second.tm + main := .inl first.tm.main + σ := InternalState first.tm second.tm + initialState := (first.tm.initialState, second.tm.initialState) + m := fun + | .inl label => liftFirstStmt first.tm second.tm (first.tm.m label) + | .inr label => liftSecondStmt first second (second.tm.m label) + } + +/-- GapCVP reduction support. -/ +noncomputable def auxiliary + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) : + Turing.TM2ComputableAux Bool Bool where + tm := machine first second + inputAlphabet := first.inputAlphabet + outputAlphabet := + (secondAlphabetEquiv first second second.tm.k₁).symm.trans + second.outputAlphabet + +private def firstStacks (first second : FinTM2) + (sourceStacks : ∀ k, List (first.Γ k)) : + (k : Stack first second) → List (alphabet first second k) + | .inl k => sourceStacks k + | .inr _ => [] + +private theorem firstStacks_update (first second : FinTM2) + (sourceStacks : ∀ k, List (first.Γ k)) + (k : first.K) (value : List (first.Γ k)) : + firstStacks first second (Function.update sourceStacks k value) = + Function.update (firstStacks first second sourceStacks) + (.inl k) value := by + classical + funext j + cases j with + | inl j => + by_cases h : j = k + · subst j + simp only [ne_eq, firstStacks, Function.update_self] + · simp only [ne_eq, firstStacks, Function.update, h, ↓reduceDIte, Sum.inl.injEq] + | inr j => + simp only [ne_eq, firstStacks, Function.update, reduceCtorEq, ↓reduceDIte] + +private noncomputable def firstConfiguration + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (c : first.tm.Cfg) : (machine first second).Cfg where + l := match c.l with + | some label => some (.inl label) + | none => some (.inr second.tm.main) + var := (c.var, second.tm.initialState) + stk := firstStacks first.tm second.tm c.stk + +private theorem liftFirstStmt_stepAux + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (q : Turing.TM2.Stmt first.tm.Γ first.tm.Λ first.tm.σ) + (v : first.tm.σ) + (sourceStacks : ∀ k, List (first.tm.Γ k)) : + Turing.TM2.stepAux (liftFirstStmt first.tm second.tm q) + (v, second.tm.initialState) + (firstStacks first.tm second.tm sourceStacks) = + firstConfiguration first second + (Turing.TM2.stepAux q v sourceStacks) := by + classical + induction q generalizing v sourceStacks with + | push k p q ih => + change + Turing.TM2.stepAux (liftFirstStmt first.tm second.tm q) + (v, second.tm.initialState) + (Function.update (firstStacks first.tm second.tm sourceStacks) + (.inl k) (p v :: sourceStacks k)) = + firstConfiguration first second + (Turing.TM2.stepAux q v + (Function.update sourceStacks k (p v :: sourceStacks k))) + rw [← firstStacks_update] + exact ih (v := v) + (sourceStacks := Function.update sourceStacks k + (p v :: sourceStacks k)) + | peek k p q ih => + exact ih (v := p v (sourceStacks k).head?) + (sourceStacks := sourceStacks) + | pop k p q ih => + change + Turing.TM2.stepAux (liftFirstStmt first.tm second.tm q) + (p v (sourceStacks k).head?, second.tm.initialState) + (Function.update (firstStacks first.tm second.tm sourceStacks) + (.inl k) (sourceStacks k).tail) = + firstConfiguration first second + (Turing.TM2.stepAux q (p v (sourceStacks k).head?) + (Function.update sourceStacks k (sourceStacks k).tail)) + rw [← firstStacks_update] + exact ih (v := p v (sourceStacks k).head?) + (sourceStacks := Function.update sourceStacks k + (sourceStacks k).tail) + | load p q ih => + exact ih (v := p v) (sourceStacks := sourceStacks) + | branch p yes no ihYes ihNo => + cases hp : p v with + | false => + simpa only [liftFirstStmt, TM2.stepAux, hp, Bool.cond_false] using ihNo (v := v) + (sourceStacks + := sourceStacks) + | true => + simpa only [liftFirstStmt, TM2.stepAux, hp, Bool.cond_true] using ihYes (v := v) + (sourceStacks + := sourceStacks) + | goto p => rfl + | halt => rfl + +private theorem firstConfiguration_step + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (c c' : first.tm.Cfg) + (h : first.tm.step c = some c') : + (machine first second).step (firstConfiguration first second c) = + some (firstConfiguration first second c') := by + rcases c with ⟨l, v, sourceStacks⟩ + cases l with + | none => + simp only [FinTM2.step, TM2.step, reduceCtorEq] at h + | some label => + change some (Turing.TM2.stepAux (first.tm.m label) + v sourceStacks) = some c' at h + have hc := Option.some.inj h + subst c' + change + some (Turing.TM2.stepAux + (liftFirstStmt first.tm second.tm (first.tm.m label)) + (v, second.tm.initialState) + (firstStacks first.tm second.tm sourceStacks)) = + some (firstConfiguration first second + (Turing.TM2.stepAux (first.tm.m label) v sourceStacks)) + rw [liftFirstStmt_stepAux] + rfl + +private noncomputable def firstConfiguration_evalsToInTime + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + {c c' : first.tm.Cfg} {budget : ℕ} + (h : EvalsToInTime + first.tm.step c (some c') budget) : + EvalsToInTime (machine first second).step + (firstConfiguration first second c) + (some (firstConfiguration first second c')) budget := + evalsToInTimeMapOfStep first.tm.step + (machine first second).step (firstConfiguration first second) + (firstConfiguration_step first second) h + +private theorem firstConfiguration_init + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (x : List Bool) : + firstConfiguration first second + (Turing.initList first.tm + (List.map first.inputAlphabet.invFun (bitEncoding x))) = + Turing.initList (machine first second) + (List.map (auxiliary first second).inputAlphabet.invFun + (bitEncoding x)) := by + classical + simp only [machine, ne_eq, firstConfiguration, initList, Equiv.invFun_as_coe, id_eq, + eq_mpr_eq_cast, + auxiliary] + congr 1 + funext k + cases k with + | inl k => + by_cases hk : k = first.tm.k₀ + · subst k + simp only [ne_eq, firstStacks, ↓reduceDIte, cast_eq] + rfl + · simp only [ne_eq, firstStacks, hk, ↓reduceDIte, Sum.inl.injEq] + | inr k => + simp only [ne_eq, firstStacks, reduceCtorEq, ↓reduceDIte] + +private noncomputable def secondStacks + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (sourceStacks : ∀ k, List (second.tm.Γ k)) : + (k : Stack first.tm second.tm) → + List (alphabet first.tm second.tm k) + | .inl k => + if h : k = first.tm.k₁ then + h.symm ▸ + List.map (second.inputAlphabet.trans first.outputAlphabet.symm) + (sourceStacks second.tm.k₀) + else [] + | .inr k => sourceStacks k.val + +@[simp] private theorem secondStacks_shared + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (sourceStacks : ∀ k, List (second.tm.Γ k)) : + secondStacks first second sourceStacks (.inl first.tm.k₁) = + List.map (second.inputAlphabet.trans first.outputAlphabet.symm) + (sourceStacks second.tm.k₀) := by + classical + simp only [ne_eq, secondStacks, ↓reduceDIte, Equiv.coe_trans] + +@[simp] private theorem secondStacks_private + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (sourceStacks : ∀ k, List (second.tm.Γ k)) + (k : {k : second.tm.K // k ≠ second.tm.k₀}) : + secondStacks first second sourceStacks (.inr k) = + sourceStacks k.val := rfl + +private theorem secondStacks_shared_update + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (sourceStacks : ∀ k, List (second.tm.Γ k)) + (value : List (second.tm.Γ second.tm.k₀)) : + secondStacks first second + (Function.update sourceStacks second.tm.k₀ value) = + Function.update (secondStacks first second sourceStacks) + (.inl first.tm.k₁) + (List.map (second.inputAlphabet.trans first.outputAlphabet.symm) + value) := by + classical + funext j + cases j with + | inl j => + by_cases hj : j = first.tm.k₁ + · subst j + simp only [ne_eq, secondStacks, ↓reduceDIte, Equiv.coe_trans, Function.update_self] + · simp only [ne_eq, secondStacks, hj, ↓reduceDIte, Function.update, Sum.inl.injEq] + | inr j => + simp only [ne_eq, secondStacks, Function.update, j.property, ↓reduceDIte, reduceCtorEq] + +private theorem secondStacks_private_update + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (sourceStacks : ∀ k, List (second.tm.Γ k)) + (k : second.tm.K) (hk : k ≠ second.tm.k₀) + (value : List (second.tm.Γ k)) : + secondStacks first second (Function.update sourceStacks k value) = + Function.update (secondStacks first second sourceStacks) + (.inr ⟨k, hk⟩) value := by + classical + funext j + cases j with + | inl j => + by_cases hj : j = first.tm.k₁ + · subst j + simp only [ne_eq, secondStacks, ↓reduceDIte, Equiv.coe_trans, Function.update, Ne.symm hk, + reduceCtorEq] + · simp only [ne_eq, secondStacks, hj, ↓reduceDIte, Function.update, reduceCtorEq] + | inr j => + rcases j with ⟨j, hj₀⟩ + by_cases hj : j = k + · subst j + simp only [ne_eq, secondStacks, Function.update_self] + · simp only [ne_eq, secondStacks, Function.update, hj, ↓reduceDIte, Sum.inr.injEq, + Subtype.mk.injEq] + +private noncomputable def secondConfiguration + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (c : second.tm.Cfg) : (machine first second).Cfg where + l := c.l.map Sum.inr + var := (first.tm.initialState, c.var) + stk := secondStacks first second c.stk + +private theorem liftSecondStmt_stepAux + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (q : Turing.TM2.Stmt second.tm.Γ second.tm.Λ second.tm.σ) + (v : second.tm.σ) + (sourceStacks : ∀ k, List (second.tm.Γ k)) : + Turing.TM2.stepAux (liftSecondStmt first second q) + (first.tm.initialState, v) + (secondStacks first second sourceStacks) = + secondConfiguration first second + (Turing.TM2.stepAux q v sourceStacks) := by + classical + induction q generalizing v sourceStacks with + | push k p q ih => + by_cases hk : k = second.tm.k₀ + · subst k + simp only [liftSecondStmt, Turing.TM2.stepAux] + change + Turing.TM2.stepAux (liftSecondStmt first second q) + (first.tm.initialState, v) + (Function.update (secondStacks first second sourceStacks) + (.inl first.tm.k₁) + ((second.inputAlphabet.trans first.outputAlphabet.symm) + (p v) :: + secondStacks first second sourceStacks + (.inl first.tm.k₁))) = + secondConfiguration first second + (Turing.TM2.stepAux q v + (Function.update sourceStacks second.tm.k₀ + (p v :: sourceStacks second.tm.k₀))) + have hupdate : + Function.update (secondStacks first second sourceStacks) + (.inl first.tm.k₁) + ((second.inputAlphabet.trans first.outputAlphabet.symm) + (p v) :: secondStacks first second sourceStacks + (.inl first.tm.k₁)) = + secondStacks first second + (Function.update sourceStacks second.tm.k₀ + (p v :: sourceStacks second.tm.k₀)) := by + simpa only [secondStacks_shared, List.map_cons] using + (secondStacks_shared_update first second + sourceStacks (p v :: sourceStacks second.tm.k₀)).symm + rw [hupdate] + exact ih (v := v) (sourceStacks := Function.update sourceStacks + second.tm.k₀ (p v :: sourceStacks second.tm.k₀)) + · simp only [liftSecondStmt, dite_eq_right hk, Turing.TM2.stepAux] + change + Turing.TM2.stepAux (liftSecondStmt first second q) + (first.tm.initialState, v) + (Function.update (secondStacks first second sourceStacks) + (.inr ⟨k, hk⟩) + (p v :: secondStacks first second sourceStacks + (.inr ⟨k, hk⟩))) = + secondConfiguration first second + (Turing.TM2.stepAux q v + (Function.update sourceStacks k (p v :: sourceStacks k))) + rw [secondStacks_private, + ← secondStacks_private_update first second sourceStacks k hk] + exact ih (v := v) (sourceStacks := Function.update sourceStacks + k (p v :: sourceStacks k)) + | peek k p q ih => + by_cases hk : k = second.tm.k₀ + · subst k + have hhead : + (secondStacks first second sourceStacks + (.inl first.tm.k₁)).head?.map + (first.outputAlphabet.trans second.inputAlphabet.symm) = + (sourceStacks second.tm.k₀).head? := by + rw [secondStacks_shared] + cases h : sourceStacks second.tm.k₀ with + | nil => + simp only [List.map_nil, List.head?_nil, Option.map_none] + | cons a as => + simp only [List.map_cons, List.head?_cons, + Option.map_some, Equiv.trans_apply, + Equiv.apply_symm_apply, Equiv.symm_apply_apply] + simp only [liftSecondStmt, Turing.TM2.stepAux] + change + Turing.TM2.stepAux (liftSecondStmt first second q) + (first.tm.initialState, + p v ((secondStacks first second sourceStacks + (.inl first.tm.k₁)).head?.map + (first.outputAlphabet.trans + second.inputAlphabet.symm))) + (secondStacks first second sourceStacks) = + secondConfiguration first second + (Turing.TM2.stepAux q + (p v (sourceStacks second.tm.k₀).head?) sourceStacks) + rw [hhead] + exact ih (v := p v (sourceStacks second.tm.k₀).head?) + (sourceStacks := sourceStacks) + · simp only [liftSecondStmt, dite_eq_right hk, Turing.TM2.stepAux] + change + Turing.TM2.stepAux (liftSecondStmt first second q) + (first.tm.initialState, + p v (secondStacks first second sourceStacks + (.inr ⟨k, hk⟩)).head?) + (secondStacks first second sourceStacks) = + secondConfiguration first second + (Turing.TM2.stepAux q (p v (sourceStacks k).head?) + sourceStacks) + rw [secondStacks_private] + exact ih (v := p v (sourceStacks k).head?) + (sourceStacks := sourceStacks) + | pop k p q ih => + by_cases hk : k = second.tm.k₀ + · subst k + have hhead : + (secondStacks first second sourceStacks + (.inl first.tm.k₁)).head?.map + (first.outputAlphabet.trans second.inputAlphabet.symm) = + (sourceStacks second.tm.k₀).head? := by + rw [secondStacks_shared] + cases h : sourceStacks second.tm.k₀ with + | nil => + simp only [List.map_nil, List.head?_nil, Option.map_none] + | cons a as => + simp only [List.map_cons, List.head?_cons, + Option.map_some, Equiv.trans_apply, + Equiv.apply_symm_apply, Equiv.symm_apply_apply] + simp only [liftSecondStmt, Turing.TM2.stepAux] + change + Turing.TM2.stepAux (liftSecondStmt first second q) + (first.tm.initialState, + p v ((secondStacks first second sourceStacks + (.inl first.tm.k₁)).head?.map + (first.outputAlphabet.trans + second.inputAlphabet.symm))) + (Function.update (secondStacks first second sourceStacks) + (.inl first.tm.k₁) + (secondStacks first second sourceStacks + (.inl first.tm.k₁)).tail) = + secondConfiguration first second + (Turing.TM2.stepAux q + (p v (sourceStacks second.tm.k₀).head?) + (Function.update sourceStacks second.tm.k₀ + (sourceStacks second.tm.k₀).tail)) + have htail : + (secondStacks first second sourceStacks + (.inl first.tm.k₁)).tail = + List.map (second.inputAlphabet.trans + first.outputAlphabet.symm) + (sourceStacks second.tm.k₀).tail := by + rw [secondStacks_shared] + exact List.map_tail.symm + rw [hhead, htail, ← secondStacks_shared_update] + exact ih (v := p v (sourceStacks second.tm.k₀).head?) + (sourceStacks := Function.update sourceStacks second.tm.k₀ + (sourceStacks second.tm.k₀).tail) + · simp only [liftSecondStmt, dite_eq_right hk, Turing.TM2.stepAux] + change + Turing.TM2.stepAux (liftSecondStmt first second q) + (first.tm.initialState, + p v (secondStacks first second sourceStacks + (.inr ⟨k, hk⟩)).head?) + (Function.update (secondStacks first second sourceStacks) + (.inr ⟨k, hk⟩) + (secondStacks first second sourceStacks + (.inr ⟨k, hk⟩)).tail) = + secondConfiguration first second + (Turing.TM2.stepAux q (p v (sourceStacks k).head?) + (Function.update sourceStacks k + (sourceStacks k).tail)) + rw [secondStacks_private, + ← secondStacks_private_update first second sourceStacks k hk] + exact ih (v := p v (sourceStacks k).head?) + (sourceStacks := Function.update sourceStacks k + (sourceStacks k).tail) + | load p q ih => + exact ih (v := p v) (sourceStacks := sourceStacks) + | branch p yes no ihYes ihNo => + cases hp : p v with + | false => + simpa only [liftSecondStmt, TM2.stepAux, hp, Bool.cond_false] using ihNo (v := v) + (sourceStacks := sourceStacks) + | true => + simpa only [liftSecondStmt, TM2.stepAux, hp, Bool.cond_true] using ihYes (v := v) + (sourceStacks := sourceStacks) + | goto p => rfl + | halt => rfl + +private theorem secondConfiguration_step + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (c c' : second.tm.Cfg) + (h : second.tm.step c = some c') : + (machine first second).step (secondConfiguration first second c) = + some (secondConfiguration first second c') := by + rcases c with ⟨l, v, sourceStacks⟩ + cases l with + | none => + simp only [FinTM2.step, TM2.step, reduceCtorEq] at h + | some label => + change some (Turing.TM2.stepAux (second.tm.m label) + v sourceStacks) = some c' at h + have hc := Option.some.inj h + subst c' + change + some (Turing.TM2.stepAux + (liftSecondStmt first second (second.tm.m label)) + (first.tm.initialState, v) + (secondStacks first second sourceStacks)) = + some (secondConfiguration first second + (Turing.TM2.stepAux (second.tm.m label) v sourceStacks)) + rw [liftSecondStmt_stepAux] + rfl + +private theorem phaseConfiguration + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (x : List Bool) : + firstConfiguration first second + (Turing.haltList first.tm + (List.map first.outputAlphabet.invFun (bitEncoding (f x)))) = + secondConfiguration first second + (Turing.initList second.tm + (List.map second.inputAlphabet.invFun (bitEncoding (f x)))) := by + classical + simp only [machine, ne_eq, firstConfiguration, haltList, Equiv.invFun_as_coe, id_eq, + eq_mpr_eq_cast, + secondConfiguration, initList, Option.map_some] + congr 1 + funext k + cases k with + | inl k => + by_cases hk : k = first.tm.k₁ + · subst k + simp only [bitEncoding, ne_eq, firstStacks, ↓reduceDIte, cast_eq, secondStacks, + Equiv.coe_trans, List.map_map, + List.map_inj_left, Function.comp_apply, Equiv.apply_symm_apply, implies_true] + · simp only [ne_eq, firstStacks, hk, ↓reduceDIte, secondStacks] + | inr k => + simp only [ne_eq, firstStacks, secondStacks, k.property, ↓reduceDIte] + +@[simp] theorem haltList_stk_self + (tm : Turing.FinTM2) (xs : List (tm.Γ tm.k₁)) : + (Turing.haltList tm xs).stk tm.k₁ = xs := by + classical + simp only [haltList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq] + +private theorem haltList_stk_of_ne + (tm : Turing.FinTM2) (xs : List (tm.Γ tm.k₁)) + (j : tm.K) (hj : j ≠ tm.k₁) : + (Turing.haltList tm xs).stk j = [] := by + classical + simp only [haltList, eq_mpr_eq_cast, hj, ↓reduceDIte] + +private theorem secondStacks_secondStack + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (sourceStacks : ∀ k, List (second.tm.Γ k)) + (k : second.tm.K) : + secondStacks first second sourceStacks + (secondStack first.tm second.tm k) = + List.map (secondAlphabetEquiv first second k) (sourceStacks k) := by + classical + cases hdec : second.tm.decidableEqK k second.tm.k₀ with + | isTrue hk => + subst k + unfold secondAlphabetEquiv secondStack + rw! (castMode := .all) [hdec] + simp only [↓dreduceDIte, ne_eq, secondStacks, ↓reduceDIte, Equiv.coe_trans, eq_mpr_eq_cast, + cast_eq, id_eq] + | isFalse hk => + unfold secondAlphabetEquiv secondStack + rw! (castMode := .all) [hdec] + simp only [hk, ↓dreduceDIte, ne_eq, secondStacks, ↓reduceDIte, eq_mpr_eq_cast, cast_eq, + id_eq] + induction sourceStacks k with + | nil => rfl + | cons a rest ih => + exact congrArg (List.cons a) ih + +private theorem secondConfiguration_halt + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + (y : List Bool) : + secondConfiguration first second + (Turing.haltList second.tm + (List.map second.outputAlphabet.invFun (bitEncoding y))) = + Turing.haltList (machine first second) + (List.map (auxiliary first second).outputAlphabet.invFun + (bitEncoding y)) := by + classical + change + (⟨none, (first.tm.initialState, second.tm.initialState), + secondStacks first second + (Turing.haltList second.tm + (List.map second.outputAlphabet.invFun (bitEncoding y))).stk⟩ : + (machine first second).Cfg) = + (⟨none, (first.tm.initialState, second.tm.initialState), + (Turing.haltList (machine first second) + (List.map (auxiliary first second).outputAlphabet.invFun + (bitEncoding y))).stk⟩ : (machine first second).Cfg) + congr 1 + funext j + by_cases hj : j = (machine first second).k₁ + · subst j + rw [haltList_stk_self] + change + secondStacks first second + (Turing.haltList second.tm + (List.map second.outputAlphabet.invFun (bitEncoding y))).stk + (secondStack first.tm second.tm second.tm.k₁) = + List.map + ((secondAlphabetEquiv first second second.tm.k₁).symm.trans + second.outputAlphabet).invFun (bitEncoding y) + rw [secondStacks_secondStack, haltList_stk_self] + simp only [Equiv.invFun_as_coe, id_eq, List.map_map, Equiv.symm_trans, Equiv.symm_symm, + Equiv.coe_trans] + · have hhalt : + (Turing.haltList (machine first second) + (List.map (auxiliary first second).outputAlphabet.invFun + (bitEncoding y))).stk j = [] := + haltList_stk_of_ne (machine first second) _ j hj + rw [hhalt] + cases j with + | inl j => + by_cases hshared : j = first.tm.k₁ + · subst j + rw [secondStacks_shared] + have hinput : second.tm.k₀ ≠ second.tm.k₁ := by + intro h + apply hj + change Sum.inl first.tm.k₁ = + secondStack first.tm second.tm second.tm.k₁ + simp only [ne_eq, secondStack, h.symm, ↓reduceDIte] + rw [haltList_stk_of_ne _ _ _ hinput, List.map_nil] + rfl + · simp only [ne_eq, secondStacks, hshared, ↓reduceDIte] + rfl + | inr j => + rw [secondStacks_private] + have hout : j.val ≠ second.tm.k₁ := by + intro h + have hprivate : second.tm.k₁ ≠ second.tm.k₀ := by + intro hinput + exact j.property (h.trans hinput) + apply hj + change Sum.inr j = secondStack first.tm second.tm second.tm.k₁ + simp only [ne_eq, secondStack, hprivate, ↓reduceDIte, Sum.inr.injEq, Subtype.ext_iff, h] + exact haltList_stk_of_ne _ _ _ hout + +private noncomputable def computableInPolyTimeOfSeam + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) + : + BitTM (g ∘ f) where + toTM2ComputableAux := auxiliary first second + time := compositeTimePolynomial first second + outputsFun := by + intro x + have hfirst := firstConfiguration_evalsToInTime + first second (first.outputsFun x) + rw [firstConfiguration_init first second x, + phaseConfiguration first second x] at hfirst + have hsecond := evalsToInTimeMapOfStep + second.tm.step (machine first second).step + (secondConfiguration first second) + (secondConfiguration_step first second) + (second.outputsFun (f x)) + rw [secondConfiguration_halt first second (g (f x))] at hsecond + have hboth := EvalsToInTime.trans (machine first second).step + (first.time.eval x.length) + (second.time.eval (f x).length) + _ _ _ hfirst hsecond + have hbudget : + second.time.eval (f x).length + first.time.eval x.length ≤ + (compositeTimePolynomial first second).eval x.length := by + simpa only [Nat.add_comm] using compositeTimePolynomial_bounds first second x + exact { + steps := hboth.steps + evals_in_steps := hboth.evals_in_steps + steps_le_m := hboth.steps_le_m.trans hbudget + } + +/-- GapCVP reduction support. -/ +noncomputable def computableInPolyTime + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) : + BitTM (g ∘ f) := + computableInPolyTimeOfSeam first second + +end TMComposition + +theorem polynomialTimeClosedUnderComposition : + PolynomialTimeClosedUnderComposition := by + simp only [GapCVP.PolynomialTimeClosedUnderComposition, decide_eq_true_eq] at * + intro first second firstMachine secondMachine + exact ⟨TMComposition.computableInPolyTime + firstMachine.some secondMachine.some⟩ + +namespace PromiseReduction + +private def compWithCertificate {A B : BitLanguage} {P : PromiseProblem} + (first : PolynomialReduction A B) + (second : PromiseReduction B P) + (certificate : Nonempty + (BitTM + (second.map ∘ first.map))) : PromiseReduction A P where + map := second.map ∘ first.map + polynomial_time := certificate + completeness x hx := + second.completeness (first.map x) ((first.correct x).mp hx) + soundness x hx := by + apply second.soundness (first.map x) + intro h + exact hx ((first.correct x).mpr h) + +/-- GapCVP reduction support. -/ +def comp {A B : BitLanguage} {P : PromiseProblem} + (first : PolynomialReduction A B) + (second : PromiseReduction B P) + (closed : PolynomialTimeClosedUnderComposition) : + PromiseReduction A P := by + have hclosed := closed + simp only [PolynomialTimeClosedUnderComposition, decide_eq_true_eq] at hclosed + exact compWithCertificate first second + (hclosed first.map second.map first.polynomial_time second.polynomial_time) + +end PromiseReduction + +theorem nphardPromise_of_nphard_of_promiseReduction + {A : BitLanguage} {P : PromiseProblem} (hard : NPHard A) + (reduction : PromiseReduction A P) + (closed : PolynomialTimeClosedUnderComposition) : NPHardPromise P := by + apply @decide_eq_true _ (Classical.propDecidable _) + intro L hL + obtain ⟨first⟩ := + (@of_decide_eq_true _ (Classical.propDecidable _) hard) L hL + exact ⟨PromiseReduction.comp first reduction closed⟩ + +end + +namespace CL + +/-- GapCVP reduction support. -/ +abbrev Time (T : ℕ) := Fin (T + 1) +/-- GapCVP reduction support. -/ +abbrev Position (T : ℕ) := Fin (T + 1) +/-- GapCVP reduction support. -/ +abbrev Symbol (S : ℕ) := Fin (S + 1) + +/-- GapCVP reduction support. -/ +abbrev Variable (T S : ℕ) := Time T × Position T × Symbol S +/-- GapCVP reduction support. -/ +abbrev SignedLiteral (T S : ℕ) := Variable T S × Bool +/-- GapCVP reduction support. -/ +abbrev Clause (T S : ℕ) := Finset (SignedLiteral T S) +/-- GapCVP reduction support. -/ +abbrev Formula (T S : ℕ) := Finset (Clause T S) + +/-- GapCVP reduction support. -/ +def positive {T S : ℕ} (v : Variable T S) : SignedLiteral T S := + (v, true) + +/-- GapCVP reduction support. -/ +def negative {T S : ℕ} (v : Variable T S) : SignedLiteral T S := + (v, false) + +private noncomputable def satisfiesClause {T S : ℕ} + (assignment : Variable T S → Bool) (clause : Clause T S) : Bool := + @decide ( + ∃ literal ∈ clause, assignment literal.1 = literal.2 + ) (Classical.propDecidable _) +private noncomputable def satisfiesFormula {T S : ℕ} + (assignment : Variable T S → Bool) (formula : Formula T S) : Bool := + @decide ( + ∀ clause ∈ formula, satisfiesClause assignment clause + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def atLeastOneClause {T S : ℕ} + (t : Time T) (i : Position T) : Clause T S := + Finset.univ.image (fun s : Symbol S => positive (t, i, s)) + +/-- GapCVP reduction support. -/ +def atMostOneClause {T S : ℕ} + (t : Time T) (i : Position T) (a b : Symbol S) : Clause T S := + {negative (t, i, a), negative (t, i, b)} + +/-- GapCVP reduction support. -/ +def initialClause {T S : ℕ} + (input : Position T → Symbol S) (i : Position T) : Clause T S := + {positive ((0 : Time T), i, input i)} + +/-- GapCVP reduction support. -/ +def acceptanceClause {T S : ℕ} (accept : Symbol S) : Clause T S := + Finset.univ.image + (fun i : Position T => positive ((Fin.last T), i, accept)) + +/-- GapCVP reduction support. -/ +abbrev Window (T : ℕ) := + { ti : Time T × Position T // ti.1.val + 1 < T + 1 } + +/-- GapCVP reduction support. -/ +def nextTime {T : ℕ} (w : Window T) : Time T := + ⟨w.1.1.val + 1, w.2⟩ + +/-- GapCVP reduction support. -/ +def leftPosition {T : ℕ} (w : Window T) : Position T := + ⟨w.1.2.val - 1, Nat.lt_of_le_of_lt (Nat.sub_le _ _) w.1.2.isLt⟩ + +/-- GapCVP reduction support. -/ +def rightPosition {T : ℕ} (w : Window T) : Position T := + ⟨min (w.1.2.val + 1) T, + Nat.lt_succ_of_le (Nat.min_le_right _ _)⟩ + +/-- GapCVP reduction support. -/ +def windowAt {T : ℕ} (t : Fin T) (i : Position T) : Window T := + ⟨(⟨t.val, Nat.lt_trans t.isLt (Nat.lt_succ_self T)⟩, i), + Nat.add_lt_add_right t.isLt 1⟩ + +/-- GapCVP reduction support. -/ +abbrev WindowSymbols (S : ℕ) := + Symbol S × Symbol S × Symbol S × Symbol S + +/-- GapCVP reduction support. -/ +def transitionClause {T S : ℕ} + (w : Window T) (symbols : WindowSymbols S) : Clause T S := + { negative (w.1.1, leftPosition w, symbols.1), + negative (w.1.1, w.1.2, symbols.2.1), + negative (w.1.1, rightPosition w, symbols.2.2.1), + negative (nextTime w, w.1.2, symbols.2.2.2) } + +/-- GapCVP reduction support. -/ +structure Specification (T S : ℕ) where + /-- GapCVP reduction support. -/ + input : Position T → Symbol S + /-- GapCVP reduction support. -/ + accept : Symbol S + /-- GapCVP reduction support. -/ + allowed : WindowSymbols S → Bool + +/-- GapCVP reduction support. -/ +def structuralClauses (T S : ℕ) : Formula T S := + (Finset.univ.image fun p : Time T × Position T => + atLeastOneClause p.1 p.2) ∪ + ((Finset.univ.filter fun p : + (Time T × Position T) × (Symbol S × Symbol S) => + p.2.1 < p.2.2).image fun p => + atMostOneClause p.1.1 p.1.2 p.2.1 p.2.2) + +/-- GapCVP reduction support. -/ +def initialClauses {T S : ℕ} (spec : Specification T S) : Formula T S := + Finset.univ.image fun i : Position T => initialClause spec.input i + +/-- GapCVP reduction support. -/ +def transitionClauses {T S : ℕ} + (spec : Specification T S) : Formula T S := + ((Finset.univ.filter fun p : Window T × WindowSymbols S => + spec.allowed p.2 = false).image fun p => transitionClause p.1 p.2) + +/-- GapCVP reduction support. -/ +def tableauFormula {T S : ℕ} (spec : Specification T S) : Formula T S := + structuralClauses T S ∪ initialClauses spec ∪ + {acceptanceClause spec.accept} ∪ transitionClauses spec + +/-- GapCVP reduction support. -/ +noncomputable def ValidTrace {T S : ℕ} (spec : Specification T S) + (trace : Time T → Position T → Symbol S) : Bool := + @decide ( + (∀ i, trace 0 i = spec.input i) ∧ + (∃ i, trace (Fin.last T) i = spec.accept) ∧ + ∀ w : Window T, + spec.allowed + (trace w.1.1 (leftPosition w), + trace w.1.1 w.1.2, + trace w.1.1 (rightPosition w), + trace (nextTime w) w.1.2) = true + ) (Classical.propDecidable _) +private def assignmentOfTrace {T S : ℕ} + (trace : Time T → Position T → Symbol S) : Variable T S → Bool := + fun v => decide (trace v.1 v.2.1 = v.2.2) + +private theorem atLeastOneClause_satisfied {T S : ℕ} + (trace : Time T → Position T → Symbol S) + (t : Time T) (i : Position T) : + satisfiesClause (assignmentOfTrace trace) (atLeastOneClause t i) := by + simp only [GapCVP.CL.satisfiesClause, decide_eq_true_eq] + refine ⟨positive (t, i, trace t i), ?_, ?_⟩ + · simp only [atLeastOneClause, Finset.mem_image, Finset.mem_univ, true_and, + exists_apply_eq_apply] + · simp only [assignmentOfTrace, positive, decide_true] + +private theorem atMostOneClause_satisfied {T S : ℕ} + (trace : Time T → Position T → Symbol S) + (t : Time T) (i : Position T) (a b : Symbol S) + (hab : a < b) : + satisfiesClause (assignmentOfTrace trace) (atMostOneClause t i a b) := by + simp only [GapCVP.CL.satisfiesClause, decide_eq_true_eq] + by_cases ha : trace t i = a + · refine ⟨negative (t, i, b), by simp only [atMostOneClause, Finset.mem_insert, + Finset.mem_singleton, or_true], ?_⟩ + simp only [assignmentOfTrace, negative, ha, ne_of_lt hab, decide_false] + · refine ⟨negative (t, i, a), by simp only [atMostOneClause, Finset.mem_insert, + Finset.mem_singleton, true_or], ?_⟩ + simp only [assignmentOfTrace, negative, ha, decide_false] + +private theorem initialClause_satisfied {T S : ℕ} + (spec : Specification T S) + (trace : Time T → Position T → Symbol S) + (hinit : ∀ i, trace 0 i = spec.input i) (i : Position T) : + satisfiesClause (assignmentOfTrace trace) (initialClause spec.input i) := by + simp only [GapCVP.CL.satisfiesClause, decide_eq_true_eq] + refine ⟨positive ((0 : Time T), i, spec.input i), by simp only [initialClause, + Finset.mem_singleton], ?_⟩ + simp only [assignmentOfTrace, positive, hinit i, decide_true] + +private theorem acceptanceClause_satisfied {T S : ℕ} + (spec : Specification T S) + (trace : Time T → Position T → Symbol S) + (haccept : ∃ i, trace (Fin.last T) i = spec.accept) : + satisfiesClause (assignmentOfTrace trace) + (acceptanceClause spec.accept) := by + simp only [GapCVP.CL.satisfiesClause, decide_eq_true_eq] + obtain ⟨i, hi⟩ := haccept + refine ⟨positive ((Fin.last T), i, spec.accept), ?_, ?_⟩ + · simp only [acceptanceClause, Finset.mem_image, Finset.mem_univ, true_and, + exists_apply_eq_apply] + · simp only [assignmentOfTrace, positive, hi, decide_true] + +private theorem transitionClause_satisfied {T S : ℕ} + (spec : Specification T S) + (trace : Time T → Position T → Symbol S) + (htransition : ∀ w : Window T, + spec.allowed + (trace w.1.1 (leftPosition w), + trace w.1.1 w.1.2, + trace w.1.1 (rightPosition w), + trace (nextTime w) w.1.2) = true) + (w : Window T) (symbols : WindowSymbols S) + (hforbidden : spec.allowed symbols = false) : + satisfiesClause (assignmentOfTrace trace) (transitionClause w symbols) := by + simp only [GapCVP.CL.satisfiesClause, decide_eq_true_eq] + by_cases h₁ : trace w.1.1 (leftPosition w) = symbols.1 + · by_cases h₂ : trace w.1.1 w.1.2 = symbols.2.1 + · by_cases h₃ : trace w.1.1 (rightPosition w) = symbols.2.2.1 + · have h₄ : trace (nextTime w) w.1.2 ≠ symbols.2.2.2 := by + intro h₄ + have hgood := htransition w + rw [h₁, h₂, h₃, h₄, hforbidden] at hgood + contradiction + refine ⟨negative (nextTime w, w.1.2, symbols.2.2.2), + by simp only [transitionClause, Finset.mem_insert, Finset.mem_singleton, or_true], ?_⟩ + simp only [assignmentOfTrace, negative, h₄, decide_false] + · refine ⟨negative (w.1.1, rightPosition w, symbols.2.2.1), + by simp only [transitionClause, Finset.mem_insert, Finset.mem_singleton, true_or, + or_true], ?_⟩ + simp only [assignmentOfTrace, negative, h₃, decide_false] + · refine ⟨negative (w.1.1, w.1.2, symbols.2.1), + by simp only [transitionClause, Finset.mem_insert, Finset.mem_singleton, true_or, or_true], + ?_⟩ + simp only [assignmentOfTrace, negative, h₂, decide_false] + · refine ⟨negative (w.1.1, leftPosition w, symbols.1), + by simp only [transitionClause, Finset.mem_insert, Finset.mem_singleton, true_or], ?_⟩ + simp only [assignmentOfTrace, negative, h₁, decide_false] + +private theorem tableau_completeness {T S : ℕ} + (spec : Specification T S) + (trace : Time T → Position T → Symbol S) + (htrace : ValidTrace spec trace) : + satisfiesFormula (assignmentOfTrace trace) (tableauFormula spec) := by + simp only [GapCVP.CL.satisfiesFormula, decide_eq_true_eq] + have htrace' := htrace + simp only [GapCVP.CL.ValidTrace, decide_eq_true_eq] at htrace' + intro clause hclause + simp only [tableauFormula, Finset.mem_union, Finset.mem_singleton] at hclause + rcases hclause with ((hstruct | hinit) | haccept) | htransition + · simp only [structuralClauses, Finset.mem_union, + Finset.mem_image, Finset.mem_filter, Finset.mem_univ, + true_and] at hstruct + rcases hstruct with ⟨p, rfl⟩ | ⟨p, hp, rfl⟩ + · exact atLeastOneClause_satisfied trace p.1 p.2 + · exact atMostOneClause_satisfied trace p.1.1 p.1.2 + p.2.1 p.2.2 hp + · simp only [initialClauses, Finset.mem_image, + Finset.mem_univ, true_and] at hinit + obtain ⟨i, rfl⟩ := hinit + exact initialClause_satisfied spec trace htrace'.1 i + · subst clause + exact acceptanceClause_satisfied spec trace htrace'.2.1 + · simp only [transitionClauses, Finset.mem_image, + Finset.mem_filter, Finset.mem_univ, true_and] at htransition + obtain ⟨p, hp, rfl⟩ := htransition + exact transitionClause_satisfied spec trace htrace'.2.2 p.1 p.2 hp + +theorem atLeastOneClause_mem_tableauFormula {T S : ℕ} + (spec : Specification T S) (t : Time T) (i : Position T) : + atLeastOneClause t i ∈ tableauFormula spec := by + have h : atLeastOneClause t i ∈ structuralClauses T S := by + apply Finset.mem_union_left + exact Finset.mem_image.mpr ⟨(t, i), Finset.mem_univ _, rfl⟩ + simp only [tableauFormula, Finset.mem_union] + exact Or.inl (Or.inl (Or.inl h)) + +theorem atMostOneClause_mem_tableauFormula {T S : ℕ} + (spec : Specification T S) (t : Time T) (i : Position T) + (a b : Symbol S) (hab : a < b) : + atMostOneClause t i a b ∈ tableauFormula spec := by + have h : atMostOneClause t i a b ∈ structuralClauses T S := by + apply Finset.mem_union_right + apply Finset.mem_image.mpr + refine ⟨((t, i), (a, b)), ?_, rfl⟩ + simp only [Finset.mem_filter, Finset.mem_univ, hab, and_self] + simp only [tableauFormula, Finset.mem_union] + exact Or.inl (Or.inl (Or.inl h)) + +theorem initialClause_mem_tableauFormula {T S : ℕ} + (spec : Specification T S) (i : Position T) : + initialClause spec.input i ∈ tableauFormula spec := by + have h : initialClause spec.input i ∈ initialClauses spec := + Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩ + simp only [tableauFormula, Finset.mem_union] + exact Or.inl (Or.inl (Or.inr h)) + +theorem acceptanceClause_mem_tableauFormula {T S : ℕ} + (spec : Specification T S) : + acceptanceClause spec.accept ∈ tableauFormula spec := by + simp only [tableauFormula, Finset.union_assoc, Finset.union_singleton, Finset.insert_union, + Finset.mem_insert, Finset.mem_union, true_or] + +theorem transitionClause_mem_tableauFormula {T S : ℕ} + (spec : Specification T S) (w : Window T) + (symbols : WindowSymbols S) + (hforbidden : spec.allowed symbols = false) : + transitionClause w symbols ∈ tableauFormula spec := by + have h : transitionClause w symbols ∈ transitionClauses spec := by + apply Finset.mem_image.mpr + refine ⟨(w, symbols), ?_, rfl⟩ + simp only [Finset.mem_filter, Finset.mem_univ, hforbidden, and_self] + exact Finset.mem_union_right _ h + +private theorem symbol_exists_of_satisfiesFormula {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) + (t : Time T) (i : Position T) : + ∃ s : Symbol S, assignment (t, i, s) = true := by + have hsat' := hsat + simp only [GapCVP.CL.satisfiesFormula, GapCVP.CL.satisfiesClause, decide_eq_true_eq] at hsat' + obtain ⟨literal, hliteral, hvalue⟩ := + hsat' (atLeastOneClause t i) + (atLeastOneClause_mem_tableauFormula spec t i) + simp only [atLeastOneClause, Finset.mem_image, + Finset.mem_univ, true_and] at hliteral + obtain ⟨s, rfl⟩ := hliteral + exact ⟨s, hvalue⟩ + +private theorem symbol_unique_of_satisfiesFormula {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) + (t : Time T) (i : Position T) + (a b : Symbol S) + (ha : assignment (t, i, a) = true) + (hb : assignment (t, i, b) = true) : a = b := by + have hsat' := hsat + simp only [GapCVP.CL.satisfiesFormula, GapCVP.CL.satisfiesClause, decide_eq_true_eq] at hsat' + have exclude (a b : Symbol S) (hab : a < b) + (ha : assignment (t, i, a) = true) + (hb : assignment (t, i, b) = true) : False := by + obtain ⟨literal, hliteral, hvalue⟩ := + hsat' (atMostOneClause t i a b) + (atMostOneClause_mem_tableauFormula spec t i a b hab) + simp only [atMostOneClause, Finset.mem_insert, + Finset.mem_singleton] at hliteral + rcases hliteral with hleft | hright + · subst literal + have hfalse : assignment (t, i, a) = false := by + simpa only [negative] using hvalue + simp only [ha, Bool.true_eq_false] at hfalse + · subst literal + have hfalse : assignment (t, i, b) = false := by + simpa only [negative] using hvalue + simp only [hb, Bool.true_eq_false] at hfalse + rcases lt_trichotomy a b with hab | hab | hab + · exact (exclude a b hab ha hb).elim + · exact hab + · exact (exclude b a hab hb ha).elim + +private noncomputable def traceOfAssignment {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) : + Time T → Position T → Symbol S := + fun t i => Classical.choose + (symbol_exists_of_satisfiesFormula spec assignment hsat t i) + +private theorem traceOfAssignment_selected {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) + (t : Time T) (i : Position T) : + assignment (t, i, traceOfAssignment spec assignment hsat t i) = true := + Classical.choose_spec + (symbol_exists_of_satisfiesFormula spec assignment hsat t i) + +private theorem traceOfAssignment_eq_of_selected {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) + (t : Time T) (i : Position T) (s : Symbol S) + (hs : assignment (t, i, s) = true) : + traceOfAssignment spec assignment hsat t i = s := + symbol_unique_of_satisfiesFormula spec assignment hsat t i + (traceOfAssignment spec assignment hsat t i) s + (traceOfAssignment_selected spec assignment hsat t i) hs + +private theorem traceOfAssignment_initial {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) + (i : Position T) : + traceOfAssignment spec assignment hsat 0 i = spec.input i := by + have hsat' := hsat + simp only [GapCVP.CL.satisfiesFormula, GapCVP.CL.satisfiesClause, decide_eq_true_eq] at hsat' + obtain ⟨literal, hliteral, hvalue⟩ := + hsat' (initialClause spec.input i) + (initialClause_mem_tableauFormula spec i) + simp only [initialClause, Finset.mem_singleton] at hliteral + subst literal + apply traceOfAssignment_eq_of_selected spec assignment hsat 0 i + simpa only [positive] using hvalue + +private theorem traceOfAssignment_accepting {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) : + ∃ i : Position T, + traceOfAssignment spec assignment hsat (Fin.last T) i = spec.accept := by + have hsat' := hsat + simp only [GapCVP.CL.satisfiesFormula, GapCVP.CL.satisfiesClause, decide_eq_true_eq] at hsat' + obtain ⟨literal, hliteral, hvalue⟩ := + hsat' (acceptanceClause spec.accept) + (acceptanceClause_mem_tableauFormula spec) + simp only [acceptanceClause, Finset.mem_image, + Finset.mem_univ, true_and] at hliteral + obtain ⟨i, rfl⟩ := hliteral + refine ⟨i, traceOfAssignment_eq_of_selected spec assignment hsat + (Fin.last T) i spec.accept ?_⟩ + simpa only [positive] using hvalue + +private theorem traceOfAssignment_transition {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) + (w : Window T) : + spec.allowed + (traceOfAssignment spec assignment hsat w.1.1 (leftPosition w), + traceOfAssignment spec assignment hsat w.1.1 w.1.2, + traceOfAssignment spec assignment hsat w.1.1 (rightPosition w), + traceOfAssignment spec assignment hsat (nextTime w) w.1.2) = true := by + have hsat' := hsat + simp only [GapCVP.CL.satisfiesFormula, GapCVP.CL.satisfiesClause, decide_eq_true_eq] at hsat' + let symbols : WindowSymbols S := + (traceOfAssignment spec assignment hsat w.1.1 (leftPosition w), + traceOfAssignment spec assignment hsat w.1.1 w.1.2, + traceOfAssignment spec assignment hsat w.1.1 (rightPosition w), + traceOfAssignment spec assignment hsat (nextTime w) w.1.2) + change spec.allowed symbols = true + cases hallowed : spec.allowed symbols with + | true => rfl + | false => + exfalso + obtain ⟨literal, hliteral, hvalue⟩ := + hsat' (transitionClause w symbols) + (transitionClause_mem_tableauFormula spec w symbols hallowed) + simp only [transitionClause, Finset.mem_insert, + Finset.mem_singleton] at hliteral + rcases hliteral with h₁ | h₂ | h₃ | h₄ + · subst literal + have hfalse : assignment + (w.1.1, leftPosition w, symbols.1) = false := by + simpa only [negative] using hvalue + have htrue := traceOfAssignment_selected spec assignment hsat + w.1.1 (leftPosition w) + change assignment + (w.1.1, leftPosition w, + traceOfAssignment spec assignment hsat w.1.1 (leftPosition w)) + = false at hfalse + simp only [htrue, Bool.true_eq_false] at hfalse + · subst literal + have hfalse : assignment (w.1.1, w.1.2, symbols.2.1) = false := by + simpa only [negative] using hvalue + have htrue := traceOfAssignment_selected spec assignment hsat + w.1.1 w.1.2 + change assignment + (w.1.1, w.1.2, + traceOfAssignment spec assignment hsat w.1.1 w.1.2) + = false at hfalse + simp only [htrue, Bool.true_eq_false] at hfalse + · subst literal + have hfalse : assignment + (w.1.1, rightPosition w, symbols.2.2.1) = false := by + simpa only [negative] using hvalue + have htrue := traceOfAssignment_selected spec assignment hsat + w.1.1 (rightPosition w) + change assignment + (w.1.1, rightPosition w, + traceOfAssignment spec assignment hsat w.1.1 (rightPosition w)) + = false at hfalse + simp only [htrue, Bool.true_eq_false] at hfalse + · subst literal + have hfalse : assignment + (nextTime w, w.1.2, symbols.2.2.2) = false := by + simpa only [negative] using hvalue + have htrue := traceOfAssignment_selected spec assignment hsat + (nextTime w) w.1.2 + change assignment + (nextTime w, w.1.2, + traceOfAssignment spec assignment hsat (nextTime w) w.1.2) + = false at hfalse + simp only [htrue, Bool.true_eq_false] at hfalse + +private theorem tableau_soundness {T S : ℕ} + (spec : Specification T S) + (assignment : Variable T S → Bool) + (hsat : satisfiesFormula assignment (tableauFormula spec)) : + ValidTrace spec (traceOfAssignment spec assignment hsat) := by + simp only [GapCVP.CL.ValidTrace, decide_eq_true_eq] + exact ⟨traceOfAssignment_initial spec assignment hsat, + traceOfAssignment_accepting spec assignment hsat, + traceOfAssignment_transition spec assignment hsat⟩ + +private theorem tableau_satisfiable_iff_validTrace {T S : ℕ} + (spec : Specification T S) : + (∃ assignment : Variable T S → Bool, + satisfiesFormula assignment (tableauFormula spec)) ↔ + ∃ trace : Time T → Position T → Symbol S, ValidTrace spec trace := by + constructor + · rintro ⟨assignment, hs⟩ + exact ⟨traceOfAssignment spec assignment hs, + tableau_soundness spec assignment hs⟩ + · rintro ⟨trace, ht⟩ + exact ⟨assignmentOfTrace trace, tableau_completeness spec trace ht⟩ + +end CL + +namespace ThreeCNFReduction + +open GapCVP.CL + +/-- GapCVP reduction support. -/ +def sortedElements {α : Type} [Encodable α] (s : Finset α) : List α := by + letI : IsTrans α + (fun a b : α => Encodable.encode a ≤ Encodable.encode b) := + ⟨fun _ _ _ hab hbc => Nat.le_trans hab hbc⟩ + letI : Std.Antisymm + (fun a b : α => Encodable.encode a ≤ Encodable.encode b) := + ⟨fun _ _ hab hba => + Encodable.encode_injective (Nat.le_antisymm hab hba)⟩ + letI : Std.Total + (fun a b : α => Encodable.encode a ≤ Encodable.encode b) := + ⟨fun _ _ => Nat.le_total _ _⟩ + exact s.sort (fun a b : α => Encodable.encode a ≤ Encodable.encode b) + +@[simp] theorem mem_sortedElements {α : Type} [Encodable α] + (s : Finset α) (a : α) : + a ∈ sortedElements s ↔ a ∈ s := by + simp only [sortedElements, Finset.mem_sort] + +@[simp] theorem sortedElements_length {α : Type} [Encodable α] + (s : Finset α) : + (sortedElements s).length = s.card := by + simp only [sortedElements, Finset.length_sort] + +private noncomputable def satisfies (assignment : ℕ → Bool) (formula : ThreeCNF) : Bool := + @decide ( + ∀ clause ∈ formula, clauseSatisfied assignment clause + ) (Classical.propDecidable _) +@[simp] private theorem satisfies_nil (assignment : ℕ → Bool) : + satisfies assignment [] := by + simp only [satisfies, List.not_mem_nil, IsEmpty.forall_iff, implies_true, decide_true] + +@[simp] private theorem satisfies_append (assignment : ℕ → Bool) + (left right : ThreeCNF) : + satisfies assignment (left ++ right) ↔ + satisfies assignment left ∧ satisfies assignment right := by + simp only [satisfies, List.mem_append, or_imp, forall_and, Bool.decide_and, Bool.and_eq_true, + decide_eq_true_eq] + +@[simp] private theorem satisfies_singleton (assignment : ℕ → Bool) + (clause : ThreeClause) : + satisfies assignment [clause] ↔ clauseSatisfied assignment clause := by + simp only [satisfies, List.mem_cons, List.not_mem_nil, or_false, forall_eq, Bool.decide_eq_true] + +/-- GapCVP reduction support. -/ +noncomputable def allDistinct (formula : ThreeCNF) : Bool := + @decide ( + ∀ clause ∈ formula, clauseHasDistinctVariables clause + ) (Classical.propDecidable _) +@[simp] private theorem allDistinct_nil : allDistinct [] := by + simp only [allDistinct, List.not_mem_nil, IsEmpty.forall_iff, implies_true, decide_true] + +@[simp] private theorem allDistinct_append (left right : ThreeCNF) : + allDistinct (left ++ right) ↔ + allDistinct left ∧ allDistinct right := by + simp only [allDistinct, List.mem_append, or_imp, forall_and, Bool.decide_and, Bool.and_eq_true, + decide_eq_true_eq] + +@[simp] private theorem allDistinct_singleton (clause : ThreeClause) : + allDistinct [clause] ↔ clauseHasDistinctVariables clause := by + simp only [allDistinct, List.mem_cons, List.not_mem_nil, or_false, forall_eq, + Bool.decide_eq_true] + +private theorem threeCNFSatisfiable_iff (formula : ThreeCNF) : + threeCNFSatisfiable formula ↔ + allDistinct formula ∧ + ∃ assignment : ℕ → Bool, satisfies assignment formula := by + simp only [GapCVP.threeCNFSatisfiable, GapCVP.ThreeCNFReduction.allDistinct, + GapCVP.ThreeCNFReduction.satisfies, decide_eq_true_eq] + +/-- GapCVP reduction support. -/ +def sourceVariable {T S : ℕ} (v : Variable T S) : ℕ := + 4 * Encodable.encode v + +/-- GapCVP reduction support. -/ +def accumulatorVariable (clauseIndex prefixIndex : ℕ) : ℕ := + 4 * Encodable.encode (clauseIndex, prefixIndex) + 1 + +private theorem accumulatorVariable_injective : + Function.Injective + (fun p : ℕ × ℕ => accumulatorVariable p.1 p.2) := by + intro a b h + apply Encodable.encode_injective + change 4 * Encodable.encode a + 1 = + 4 * Encodable.encode b + 1 at h + omega + +private theorem sourceVariable_ne_accumulatorVariable {T S : ℕ} + (v : Variable T S) (clauseIndex prefixIndex : ℕ) : + sourceVariable v ≠ accumulatorVariable clauseIndex prefixIndex := by + unfold sourceVariable accumulatorVariable + omega + +private theorem sourceVariable_ne_paddingVariable₀ {T S : ℕ} + (v : Variable T S) : + sourceVariable v ≠ 2 := by + unfold sourceVariable + omega + +private theorem accumulatorVariable_ne_paddingVariable₀ + (clauseIndex prefixIndex : ℕ) : + accumulatorVariable clauseIndex prefixIndex ≠ 2 := by + unfold accumulatorVariable + omega + +private theorem accumulatorVariable_ne_paddingVariable₁ + (clauseIndex prefixIndex : ℕ) : + accumulatorVariable clauseIndex prefixIndex ≠ 3 := by + unfold accumulatorVariable + omega + +private theorem consecutive_accumulatorVariables_ne + (clauseIndex prefixIndex : ℕ) : + accumulatorVariable clauseIndex prefixIndex ≠ + accumulatorVariable clauseIndex (prefixIndex + 1) := by + intro h + have hp := accumulatorVariable_injective + (show accumulatorVariable + (clauseIndex, prefixIndex).1 (clauseIndex, prefixIndex).2 = + accumulatorVariable + (clauseIndex, prefixIndex + 1).1 + (clauseIndex, prefixIndex + 1).2 from h) + have := congrArg Prod.snd hp + omega + +/-- GapCVP reduction support. -/ +def triple (a b c : Literal) : ThreeClause := ![a, b, c] + +@[simp] private theorem clauseSatisfied_triple (assignment : ℕ → Bool) + (a b c : Literal) : + clauseSatisfied assignment (triple a b c) ↔ + literalSatisfied assignment a ∨ + literalSatisfied assignment b ∨ + literalSatisfied assignment c := by + simp only [clauseSatisfied, triple, Fin.exists_fin_succ, Fin.isValue, Matrix.cons_val_zero, + Matrix.cons_val_succ, Matrix.cons_val_fin_one, exists_const, Bool.decide_or, + Bool.decide_eq_true, Bool.or_eq_true] + +private theorem triple_distinct (a b c : Literal) + (hab : a.1 ≠ b.1) (hac : a.1 ≠ c.1) (hbc : b.1 ≠ c.1) : + clauseHasDistinctVariables (triple a b c) := by + simp only [GapCVP.clauseHasDistinctVariables, decide_eq_true_eq] + intro i j h + fin_cases i <;> fin_cases j <;> + simp_all [triple] + +/-- GapCVP reduction support. -/ +def paddedBinary (a b : Literal) : ThreeCNF := + [triple a b (2, true), + triple a b (2, false)] + +@[simp] private theorem paddedBinary_satisfied (assignment : ℕ → Bool) + (a b : Literal) : + satisfies assignment (paddedBinary a b) ↔ + literalSatisfied assignment a ∨ literalSatisfied assignment b := by + cases h : assignment 2 <;> + simp [satisfies, paddedBinary, literalSatisfied, h] + +private theorem paddedBinary_allDistinct (a b : Literal) + (hab : a.1 ≠ b.1) + (ha : a.1 ≠ 2) + (hb : b.1 ≠ 2) : + allDistinct (paddedBinary a b) := by + simp only [GapCVP.ThreeCNFReduction.allDistinct, decide_eq_true_eq] + intro clause hclause + simp only [paddedBinary, List.mem_cons, List.not_mem_nil, or_false] at hclause + rcases hclause with h | h + · subst clause + exact triple_distinct _ _ _ hab ha hb + · subst clause + exact triple_distinct _ _ _ hab ha hb + +/-- GapCVP reduction support. -/ +def paddedUnary (a : Literal) : ThreeCNF := + [triple a (2, false) (3, false), + triple a (2, false) (3, true), + triple a (2, true) (3, false), + triple a (2, true) (3, true)] + +@[simp] private theorem paddedUnary_satisfied (assignment : ℕ → Bool) + (a : Literal) : + satisfies assignment (paddedUnary a) ↔ + literalSatisfied assignment a := by + cases h₀ : assignment 2 <;> + cases h₁ : assignment 3 <;> + simp [satisfies, paddedUnary, literalSatisfied, h₀, h₁] + +private theorem paddedUnary_allDistinct (a : Literal) + (ha₀ : a.1 ≠ 2) + (ha₁ : a.1 ≠ 3) : + allDistinct (paddedUnary a) := by + simp only [GapCVP.ThreeCNFReduction.allDistinct, decide_eq_true_eq] + intro clause hclause + simp only [paddedUnary, List.mem_cons, List.not_mem_nil, or_false] at hclause + rcases hclause with h | h | h | h + all_goals + subst clause + exact triple_distinct _ _ _ ha₀ ha₁ (by decide) + +/-- GapCVP reduction support. -/ +def negate (a : Literal) : Literal := (a.1, !a.2) + +@[simp] private theorem literalSatisfied_negate (assignment : ℕ → Bool) + (a : Literal) : + literalSatisfied assignment (negate a) ↔ + ¬ literalSatisfied assignment a := by + obtain ⟨n, b⟩ := a + cases b <;> cases assignment n <;> + simp [negate, literalSatisfied] + +/-- GapCVP reduction support. -/ +def orGate (a b output : Literal) : ThreeCNF := + paddedBinary (negate a) output ++ + paddedBinary (negate b) output ++ + [triple a b (negate output)] + +private theorem orGate_satisfied (assignment : ℕ → Bool) + (a b output : Literal) : + satisfies assignment (orGate a b output) ↔ + (literalSatisfied assignment output ↔ + literalSatisfied assignment a ∨ literalSatisfied assignment b) := by + simp only [orGate, satisfies_append, paddedBinary_satisfied, + satisfies_singleton, clauseSatisfied_triple, literalSatisfied_negate] + tauto + +private theorem orGate_allDistinct (a b output : Literal) + (hab : a.1 ≠ b.1) + (hao : a.1 ≠ output.1) + (hbo : b.1 ≠ output.1) + (ha : a.1 ≠ 2) + (hb : b.1 ≠ 2) + (ho : output.1 ≠ 2) : + allDistinct (orGate a b output) := by + rw [orGate, allDistinct_append, allDistinct_append, + allDistinct_singleton] + refine ⟨⟨paddedBinary_allDistinct _ _ ?_ ?_ ho, + paddedBinary_allDistinct _ _ ?_ ?_ ho⟩, + triple_distinct _ _ _ hab ?_ ?_⟩ + · exact hao + · exact ha + · exact hbo + · exact hb + · exact hao + · exact hbo + +@[simp] private theorem paddedBinary_length (a b : Literal) : + (paddedBinary a b).length = 2 := by + rfl + +@[simp] theorem paddedUnary_length (a : Literal) : + (paddedUnary a).length = 4 := by + rfl + +@[simp] theorem orGate_length (a b output : Literal) : + (orGate a b output).length = 5 := by + simp only [orGate, List.append_assoc, List.length_append, paddedBinary_length, List.length_cons, + List.length_nil, zero_add, Nat.reduceAdd] + +/-- GapCVP reduction support. -/ +def sourceLiteral {T S : ℕ} + (literal : SignedLiteral T S) : Literal := + (sourceVariable literal.1, literal.2) + +/-- GapCVP reduction support. -/ +def accumulatorLiteral + (clauseIndex prefixIndex : ℕ) (value : Bool) : Literal := + (accumulatorVariable clauseIndex prefixIndex, value) + +/-- GapCVP reduction support. -/ +def gateList {T S : ℕ} (clauseIndex : ℕ) : + ℕ → List (SignedLiteral T S) → ThreeCNF + | _, [] => [] + | prefixIndex, literal :: remaining => + orGate (sourceLiteral literal) + (accumulatorLiteral clauseIndex (prefixIndex + 1) true) + (accumulatorLiteral clauseIndex prefixIndex true) ++ + gateList clauseIndex (prefixIndex + 1) remaining + +private theorem gateList_allDistinct {T S : ℕ} + (clauseIndex prefixIndex : ℕ) + (literals : List (SignedLiteral T S)) : + allDistinct (gateList clauseIndex prefixIndex literals) := by + induction literals generalizing prefixIndex with + | nil => simp only [gateList, allDistinct_nil] + | cons literal remaining ih => + rw [gateList, allDistinct_append] + refine ⟨orGate_allDistinct _ _ _ ?_ ?_ ?_ ?_ ?_ ?_, + ih (prefixIndex + 1)⟩ + · exact sourceVariable_ne_accumulatorVariable + literal.1 clauseIndex (prefixIndex + 1) + · exact sourceVariable_ne_accumulatorVariable + literal.1 clauseIndex prefixIndex + · exact Ne.symm + (consecutive_accumulatorVariables_ne clauseIndex prefixIndex) + · exact sourceVariable_ne_paddingVariable₀ literal.1 + · exact accumulatorVariable_ne_paddingVariable₀ + clauseIndex (prefixIndex + 1) + · exact accumulatorVariable_ne_paddingVariable₀ + clauseIndex prefixIndex + +/-- GapCVP reduction support. -/ +def encodeClause {T S : ℕ} + (clauseIndex : ℕ) (clause : Clause T S) : ThreeCNF := + paddedUnary (accumulatorLiteral clauseIndex 0 true) ++ + gateList clauseIndex 0 (sortedElements clause) ++ + paddedUnary + (accumulatorLiteral clauseIndex (sortedElements clause).length false) + +private theorem encodeClause_allDistinct {T S : ℕ} + (clauseIndex : ℕ) (clause : Clause T S) : + allDistinct (encodeClause clauseIndex clause) := by + rw [encodeClause, allDistinct_append, allDistinct_append] + exact ⟨⟨paddedUnary_allDistinct _ + (accumulatorVariable_ne_paddingVariable₀ clauseIndex 0) + (accumulatorVariable_ne_paddingVariable₁ clauseIndex 0), + gateList_allDistinct clauseIndex 0 (sortedElements clause)⟩, + paddedUnary_allDistinct _ + (accumulatorVariable_ne_paddingVariable₀ + clauseIndex (sortedElements clause).length) + (accumulatorVariable_ne_paddingVariable₁ + clauseIndex (sortedElements clause).length)⟩ + +/-- GapCVP reduction support. -/ +def encodeFormulaFrom {T S : ℕ} : + ℕ → List (Clause T S) → ThreeCNF + | _, [] => [] + | clauseIndex, clause :: remaining => + encodeClause clauseIndex clause ++ + encodeFormulaFrom (clauseIndex + 1) remaining + +private theorem encodeFormulaFrom_allDistinct {T S : ℕ} + (clauseIndex : ℕ) (clauses : List (Clause T S)) : + allDistinct (encodeFormulaFrom clauseIndex clauses) := by + induction clauses generalizing clauseIndex with + | nil => simp only [encodeFormulaFrom, allDistinct_nil] + | cons clause remaining ih => + rw [encodeFormulaFrom, allDistinct_append] + exact ⟨encodeClause_allDistinct clauseIndex clause, + ih (clauseIndex + 1)⟩ + +private def encodeFormula {T S : ℕ} (formula : Formula T S) : ThreeCNF := + encodeFormulaFrom 0 (sortedElements formula) + +theorem encodeFormula_allDistinct {T S : ℕ} (formula : Formula T S) : + allDistinct (encodeFormula formula) := + encodeFormulaFrom_allDistinct 0 (sortedElements formula) + +theorem signedLiteral_card (T S : ℕ) : + Fintype.card (SignedLiteral T S) = + 2 * ((T + 1) ^ 2 * (S + 1)) := by + simp only [Fintype.card_prod, Fintype.card_fin, Fintype.card_bool] + ring + +private def liftAssignment {T S : ℕ} + (clauses : List (Clause T S)) + (assignment : Variable T S → Bool) (n : ℕ) : Bool := + if n % 4 = 0 then + match (Encodable.decode (n / 4) : Option (Variable T S)) with + | some v => assignment v + | none => false + else if n % 4 = 1 then + match (Encodable.decode (n / 4) : Option (ℕ × ℕ)) with + | some p => + match clauses[p.1]? with + | some clause => + ((sortedElements clause).drop p.2).any + (fun literal => assignment literal.1 == literal.2) + | none => false + | none => false + else + false + +/-- GapCVP reduction support. -/ +def restrictAssignment {T S : ℕ} + (assignment : ℕ → Bool) : Variable T S → Bool := + fun v => assignment (sourceVariable v) + +@[simp] private theorem liftAssignment_sourceVariable {T S : ℕ} + (clauses : List (Clause T S)) + (assignment : Variable T S → Bool) + (v : Variable T S) : + liftAssignment clauses assignment (sourceVariable v) = assignment v := by + simp only [liftAssignment, sourceVariable, Nat.mul_mod_right, ↓reduceIte, ne_eq, + OfNat.ofNat_ne_zero, + not_false_eq_true, mul_div_cancel_left₀, Encodable.encodek] + +@[simp] private theorem liftAssignment_accumulatorVariable {T S : ℕ} + (clauses : List (Clause T S)) + (assignment : Variable T S → Bool) + (clauseIndex prefixIndex : ℕ) + (clause : Clause T S) + (hclause : clauses[clauseIndex]? = some clause) : + liftAssignment clauses assignment + (accumulatorVariable clauseIndex prefixIndex) = + ((sortedElements clause).drop prefixIndex).any + (fun literal => assignment literal.1 == literal.2) := by + have hone : + (4 * Encodable.encode (clauseIndex, prefixIndex) + 1) % 4 = 1 := by + omega + have hdiv : + (4 * Encodable.encode (clauseIndex, prefixIndex) + 1) / 4 = + Encodable.encode (clauseIndex, prefixIndex) := by + omega + simp only [liftAssignment, accumulatorVariable, ↓reduceIte, + hone, hdiv, Encodable.encodek, hclause, Nat.one_ne_zero] + +private theorem gateList_sound {T S : ℕ} + (assignment : ℕ → Bool) + (clauseIndex prefixIndex : ℕ) + (literals : List (SignedLiteral T S)) + (hgates : satisfies assignment + (gateList clauseIndex prefixIndex literals)) + (hstart : assignment + (accumulatorVariable clauseIndex prefixIndex) = true) + (hfinish : assignment + (accumulatorVariable clauseIndex + (prefixIndex + literals.length)) = false) : + ∃ literal ∈ literals, + assignment (sourceVariable literal.1) = literal.2 := by + induction literals generalizing prefixIndex with + | nil => + simp only [List.length_nil, add_zero] at hfinish + simp only [hstart, Bool.true_eq_false] at hfinish + | cons literal remaining ih => + simp only [gateList, satisfies_append] at hgates + obtain ⟨hgate, hremaining⟩ := hgates + have hchoice := + (orGate_satisfied assignment + (sourceLiteral literal) + (accumulatorLiteral clauseIndex (prefixIndex + 1) true) + (accumulatorLiteral clauseIndex prefixIndex true)).mp hgate + have houtput : literalSatisfied assignment + (accumulatorLiteral clauseIndex prefixIndex true) := by + apply @decide_eq_true _ (Classical.propDecidable _) + exact hstart + rcases hchoice.mp houtput with hsatisfied | hnext + · refine ⟨literal, by simp only [List.mem_cons, true_or], ?_⟩ + simpa only [sourceLiteral] using + @of_decide_eq_true _ (Classical.propDecidable _) hsatisfied + · have hnext' : assignment + (accumulatorVariable clauseIndex (prefixIndex + 1)) = true := by + simpa only [accumulatorLiteral] using + @of_decide_eq_true _ (Classical.propDecidable _) hnext + have hindex : + prefixIndex + 1 + remaining.length = + prefixIndex + (literal :: remaining).length := by + simp only [List.length_cons] + omega + have hfinish' : assignment + (accumulatorVariable clauseIndex + (prefixIndex + 1 + remaining.length)) = false := by + rw [hindex] + exact hfinish + obtain ⟨witness, hwitness, hvalue⟩ := + ih (prefixIndex + 1) hremaining hnext' hfinish' + exact ⟨witness, by simp only [List.mem_cons, hwitness, or_true], hvalue⟩ + +private theorem encodeClause_sound {T S : ℕ} + (assignment : ℕ → Bool) + (clauseIndex : ℕ) (clause : Clause T S) + (hsatisfied : satisfies assignment + (encodeClause clauseIndex clause)) : + CL.satisfiesClause (restrictAssignment assignment) clause := by + simp only [GapCVP.CL.satisfiesClause, decide_eq_true_eq] + simp only [encodeClause, satisfies_append] at hsatisfied + obtain ⟨⟨hfirst, hgates⟩, hlast⟩ := hsatisfied + have hstart : assignment (accumulatorVariable clauseIndex 0) = true := by + exact @of_decide_eq_true _ (Classical.propDecidable _) + ((paddedUnary_satisfied assignment _).mp hfirst) + have hfinish : assignment + (accumulatorVariable clauseIndex + (0 + (sortedElements clause).length)) = false := by + simpa only [sortedElements_length, zero_add, literalSatisfied, accumulatorLiteral, + Bool.decide_eq_false, + Bool.not_eq_eq_eq_not, Bool.not_true] using (paddedUnary_satisfied assignment _).mp hlast + obtain ⟨literal, hmem, hvalue⟩ := + gateList_sound assignment clauseIndex 0 + (sortedElements clause) hgates hstart hfinish + exact ⟨literal, (mem_sortedElements clause literal).mp hmem, hvalue⟩ + +private theorem encodeFormulaFrom_sound {T S : ℕ} + (assignment : ℕ → Bool) + (clauseIndex : ℕ) (clauses : List (Clause T S)) + (hsatisfied : satisfies assignment + (encodeFormulaFrom clauseIndex clauses)) : + ∀ clause ∈ clauses, + CL.satisfiesClause (restrictAssignment assignment) clause := by + induction clauses generalizing clauseIndex with + | nil => simp only [List.not_mem_nil, IsEmpty.forall_iff, implies_true] + | cons clause remaining ih => + simp only [encodeFormulaFrom, satisfies_append] at hsatisfied + obtain ⟨hclause, hremaining⟩ := hsatisfied + intro candidate hcandidate + simp only [List.mem_cons] at hcandidate + rcases hcandidate with rfl | hcandidate + · exact encodeClause_sound assignment clauseIndex _ hclause + · exact ih (clauseIndex + 1) hremaining candidate hcandidate + +private theorem encodeFormula_sound {T S : ℕ} + (formula : Formula T S) + (assignment : ℕ → Bool) + (hsatisfied : satisfies assignment (encodeFormula formula)) : + satisfiesFormula (restrictAssignment assignment) formula := by + simp only [GapCVP.CL.satisfiesFormula, decide_eq_true_eq] + intro clause hclause + exact encodeFormulaFrom_sound assignment 0 (sortedElements formula) + hsatisfied clause ((mem_sortedElements formula clause).mpr hclause) + +private theorem drop_succ_of_drop_cons {α : Type} + (literals : List α) (prefixIndex : ℕ) + (literal : α) (remaining : List α) + (hdrop : literals.drop prefixIndex = literal :: remaining) : + literals.drop (prefixIndex + 1) = remaining := by + have h := congrArg (List.drop 1) hdrop + simpa only [List.drop_drop, List.drop_succ_cons, List.drop_zero] using h + +private theorem gateList_complete {T S : ℕ} + (clauses : List (Clause T S)) + (assignment : Variable T S → Bool) + (clauseIndex : ℕ) (clause : Clause T S) + (hclause : clauses[clauseIndex]? = some clause) + (prefixIndex : ℕ) + (literals : List (SignedLiteral T S)) + (hdrop : (sortedElements clause).drop prefixIndex = literals) : + satisfies (liftAssignment clauses assignment) + (gateList clauseIndex prefixIndex literals) := by + induction literals generalizing prefixIndex with + | nil => simp only [gateList, satisfies_nil] + | cons literal remaining ih => + have hnext := drop_succ_of_drop_cons + (sortedElements clause) prefixIndex literal remaining hdrop + rw [gateList, satisfies_append] + refine ⟨?_, ih (prefixIndex + 1) hnext⟩ + apply (orGate_satisfied (liftAssignment clauses assignment) + (sourceLiteral literal) + (accumulatorLiteral clauseIndex (prefixIndex + 1) true) + (accumulatorLiteral clauseIndex prefixIndex true)).mpr + simp only [GapCVP.literalSatisfied, decide_eq_true_eq] + change + liftAssignment clauses assignment + (accumulatorVariable clauseIndex prefixIndex) = true ↔ + liftAssignment clauses assignment + (sourceVariable literal.1) = literal.2 ∨ + liftAssignment clauses assignment + (accumulatorVariable clauseIndex (prefixIndex + 1)) = true + rw [liftAssignment_accumulatorVariable clauses assignment + clauseIndex prefixIndex clause hclause, + liftAssignment_sourceVariable clauses assignment literal.1, + liftAssignment_accumulatorVariable clauses assignment + clauseIndex (prefixIndex + 1) clause hclause, + hdrop, hnext] + simp only [List.any_cons, Bool.or_eq_true, beq_iff_eq, List.any_eq_true, Prod.exists, + exists_eq_right'] + +private theorem encodeClause_complete {T S : ℕ} + (clauses : List (Clause T S)) + (assignment : Variable T S → Bool) + (clauseIndex : ℕ) (clause : Clause T S) + (hclause : clauses[clauseIndex]? = some clause) + (hsatisfied : CL.satisfiesClause assignment clause) : + satisfies (liftAssignment clauses assignment) + (encodeClause clauseIndex clause) := by + simp only [GapCVP.CL.satisfiesClause, decide_eq_true_eq] at hsatisfied + obtain ⟨literal, hmem, hvalue⟩ := hsatisfied + have hany : + (sortedElements clause).any + (fun candidate => assignment candidate.1 == candidate.2) = true := by + apply List.any_eq_true.mpr + refine ⟨literal, (mem_sortedElements clause literal).mpr hmem, ?_⟩ + simpa only [beq_iff_eq] using hvalue + rw [encodeClause, satisfies_append, satisfies_append] + refine ⟨⟨?_, gateList_complete clauses assignment clauseIndex clause + hclause 0 (sortedElements clause) (by simp only [List.drop_zero])⟩, ?_⟩ + · apply (paddedUnary_satisfied (liftAssignment clauses assignment) _).mpr + simp only [GapCVP.literalSatisfied, decide_eq_true_eq] + change liftAssignment clauses assignment + (accumulatorVariable clauseIndex 0) = true + rw [liftAssignment_accumulatorVariable clauses assignment + clauseIndex 0 clause hclause] + simpa only [List.drop_zero, List.any_eq_true, mem_sortedElements, beq_iff_eq, Prod.exists, + exists_eq_right'] using hany + · apply (paddedUnary_satisfied (liftAssignment clauses assignment) _).mpr + simp only [GapCVP.literalSatisfied, decide_eq_true_eq] + change liftAssignment clauses assignment + (accumulatorVariable clauseIndex (sortedElements clause).length) = false + rw [liftAssignment_accumulatorVariable clauses assignment + clauseIndex (sortedElements clause).length clause hclause] + simp only [List.drop_length, List.any_nil] + +private theorem encodeFormulaFrom_complete {T S : ℕ} + (clauses : List (Clause T S)) + (assignment : Variable T S → Bool) + (clauseIndex : ℕ) (remaining : List (Clause T S)) + (hdrop : clauses.drop clauseIndex = remaining) + (hsatisfied : ∀ clause ∈ clauses, + CL.satisfiesClause assignment clause) : + satisfies (liftAssignment clauses assignment) + (encodeFormulaFrom clauseIndex remaining) := by + induction remaining generalizing clauseIndex with + | nil => simp only [encodeFormulaFrom, satisfies_nil] + | cons clause tail ih => + have hlookup : clauses[clauseIndex]? = some clause := by + have hhead := congrArg List.head? hdrop + simpa only [List.head?_drop, List.head?_cons] using hhead + have hmem : clause ∈ clauses := by + obtain ⟨hbound, hget⟩ := + List.getElem?_eq_some_iff.mp hlookup + exact hget ▸ List.getElem_mem hbound + have htail := drop_succ_of_drop_cons + clauses clauseIndex clause tail hdrop + rw [encodeFormulaFrom, satisfies_append] + exact ⟨encodeClause_complete clauses assignment clauseIndex clause + hlookup (hsatisfied clause hmem), + ih (clauseIndex + 1) htail⟩ + +private theorem encodeFormula_complete {T S : ℕ} + (formula : Formula T S) + (assignment : Variable T S → Bool) + (hsatisfied : satisfiesFormula assignment formula) : + satisfies (liftAssignment (sortedElements formula) assignment) + (encodeFormula formula) := by + have hsatisfaction := hsatisfied + simp only [GapCVP.CL.satisfiesFormula, decide_eq_true_eq] at hsatisfaction + apply encodeFormulaFrom_complete + (sortedElements formula) assignment 0 (sortedElements formula) (by simp only [List.drop_zero]) + intro clause hclause + exact hsatisfaction clause ((mem_sortedElements formula clause).mp hclause) + +private theorem encodeFormula_satisfiable_iff {T S : ℕ} + (formula : Formula T S) : + threeCNFSatisfiable (encodeFormula formula) ↔ + ∃ assignment : Variable T S → Bool, + satisfiesFormula assignment formula := by + rw [threeCNFSatisfiable_iff] + constructor + · rintro ⟨_, assignment, hsatisfied⟩ + exact ⟨restrictAssignment assignment, + encodeFormula_sound formula assignment hsatisfied⟩ + · rintro ⟨assignment, hsatisfied⟩ + exact ⟨encodeFormula_allDistinct formula, + liftAssignment (sortedElements formula) assignment, + encodeFormula_complete formula assignment hsatisfied⟩ + +/-- GapCVP reduction support. -/ +def encodeTableau {T S : ℕ} (spec : Specification T S) : ThreeCNF := + encodeFormula (tableauFormula spec) + +private theorem encodeTableau_satisfiable_iff_validTrace {T S : ℕ} + (spec : Specification T S) : + threeCNFSatisfiable (encodeTableau spec) ↔ + ∃ trace : Time T → Position T → Symbol S, + ValidTrace spec trace := by + exact (encodeFormula_satisfiable_iff (tableauFormula spec)).trans + (tableau_satisfiable_iff_validTrace spec) + +end ThreeCNFReduction + +namespace CLVerifier + +open Computability GapCVP.CL + +@[simp] theorem pairBitEncoding_apply + (x certificate : List Bool) : + pairBitEncoding (x, certificate) = + x.map Sum.inl ++ certificate.map Sum.inr := by + rfl + +theorem pairBitEncoding_length + (x certificate : List Bool) : + (pairBitEncoding (x, certificate)).length = + x.length + certificate.length := by + simp only [pairBitEncoding_apply, List.length_append, List.length_map] + +private theorem encodePosNum_length_eq_natSize (n : PosNum) : + (Computability.encodePosNum n).length = n.natSize := by + induction n with + | one => rfl + | bit0 n ih => + simp only [encodePosNum, List.length_cons, ih, PosNum.natSize, Nat.succ_eq_add_one] + | bit1 n ih => + simp only [encodePosNum, List.length_cons, ih, PosNum.natSize, Nat.succ_eq_add_one] + +theorem encodeNat_length_eq_size (n : ℕ) : + (Computability.encodeNat n).length = Nat.size n := by + change (Computability.encodeNum (n : Num)).length = Nat.size n + have hnum : ∀ m : Num, + (Computability.encodeNum m).length = m.natSize := by + intro m + cases m with + | zero => rfl + | pos m => exact encodePosNum_length_eq_natSize m + rw [hnum, Num.natSize_to_nat] + simp only [Num.of_natCast, Nat.cast_id] + +/-- GapCVP reduction support. -/ +def verifierInput + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) : List (machine.tm.Γ machine.tm.k₀) := + (pairBitEncoding (x, certificate)).map machine.inputAlphabet.invFun + +/-- GapCVP reduction support. -/ +def verifierOutput + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (value : Bool) : List (machine.tm.Γ machine.tm.k₁) := + (Computability.encodeBool value).map machine.outputAlphabet.invFun + +@[simp] theorem verifierInput_length + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) : + (verifierInput machine x certificate).length = + x.length + certificate.length := by + simp only [verifierInput, Equiv.invFun_as_coe, pairBitEncoding_apply, List.map_append, + List.map_map, + List.length_append, List.length_map] + +@[simp] theorem verifierOutput_length + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (value : Bool) : + (verifierOutput machine value).length = 1 := by + simp only [encodeBool, verifierOutput, Equiv.invFun_as_coe, List.pure_def, List.map_cons, + List.map_nil, + List.length_cons, List.length_nil, zero_add] + +theorem verifierOutput_injective + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + Function.Injective (verifierOutput machine) := by + intro a b h + have hs : machine.outputAlphabet.invFun a = + machine.outputAlphabet.invFun b := by + simpa only [encodeBool, Equiv.invFun_as_coe, EmbeddingLike.apply_eq_iff_eq, verifierOutput, + List.pure_def, + List.map_cons, List.map_nil, List.cons.injEq, and_true] using h + exact machine.outputAlphabet.symm.injective hs + +/-- GapCVP reduction support. -/ +noncomputable def witnessTimePolynomial + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : Polynomial ℕ := + machine.time.comp (Polynomial.X + bound) + +private theorem witnessTimePolynomial_bounds + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hcertificate : certificate.length ≤ bound.eval x.length) : + machine.time.eval (pairBitEncoding (x, certificate)).length ≤ + (witnessTimePolynomial bound machine).eval x.length := by + rw [pairBitEncoding_length] + calc + machine.time.eval (x.length + certificate.length) ≤ + machine.time.eval (x.length + bound.eval x.length) := + TMComposition.natPolynomial_eval_monotone machine.time + (Nat.add_le_add_left hcertificate x.length) + _ = (witnessTimePolynomial bound machine).eval x.length := by + simp only [witnessTimePolynomial, Polynomial.eval_comp, Polynomial.eval_add, + Polynomial.eval_X] + +/-- GapCVP reduction support. -/ +def boundedVerifierRun + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hcertificate : certificate.length ≤ bound.eval x.length) : + Turing.TM2OutputsInTime machine.tm + (verifierInput machine x certificate) + (some (verifierOutput machine (verifier (x, certificate)))) + ((witnessTimePolynomial bound machine).eval x.length) := by + have h := machine.outputsFun (x, certificate) + change EvalsToInTime machine.tm.step + (Turing.initList machine.tm (verifierInput machine x certificate)) + (some (Turing.haltList machine.tm + (verifierOutput machine (verifier (x, certificate))))) + (machine.time.eval (pairBitEncoding (x, certificate)).length) at h + exact { + toEvalsTo := h.toEvalsTo + steps_le_m := h.steps_le_m.trans + (witnessTimePolynomial_bounds bound machine x certificate hcertificate) + } + +/-- GapCVP reduction support. -/ +structure ConfigurationTrace + (tm : Turing.FinTM2) + (input : List (tm.Γ tm.k₀)) + (output : List (tm.Γ tm.k₁)) + (steps : ℕ) where + /-- GapCVP reduction support. -/ + configuration : Fin (steps + 1) → tm.Cfg + initial : configuration 0 = Turing.initList tm input + final : configuration (Fin.last steps) = Turing.haltList tm output + transition : ∀ i : Fin steps, + tm.step (configuration (Fin.castSucc i)) = + some (configuration i.succ) + +private theorem iterate_some_of_le + (tm : Turing.FinTM2) (initial final : tm.Cfg) + (steps : ℕ) + (h : ((flip bind tm.step)^[steps]) + (some initial) = some final) + {i : ℕ} (hi : i ≤ steps) : + ∃ configuration : tm.Cfg, + ((flip bind tm.step)^[i]) + (some initial) = some configuration := by + let advance : Option tm.Cfg → Option tm.Cfg := + flip bind tm.step + have hsplit : steps = (steps - i) + i := by omega + cases hp : (advance^[i]) (some initial) with + | some configuration => + exact ⟨configuration, rfl⟩ + | none => + have hfixed : (advance^[steps - i]) none = none := + Function.iterate_fixed (by rfl) (steps - i) + change (advance^[steps]) (some initial) = some final at h + rw [hsplit, Function.iterate_add_apply, hp, hfixed] at h + cases h + +private def configurationAt + (tm : Turing.FinTM2) (initial : tm.Cfg) (i : ℕ) : tm.Cfg := + (((flip bind tm.step)^[i]) + (some initial)).getD initial + +private def traceOfEvalsTo + (tm : Turing.FinTM2) + (input : List (tm.Γ tm.k₀)) + (output : List (tm.Γ tm.k₁)) + (h : StateTransition.EvalsTo tm.step + (Turing.initList tm input) (some (Turing.haltList tm output))) : + ConfigurationTrace tm input output h.steps := by + let initial := Turing.initList tm input + refine { + configuration := fun i => configurationAt tm initial i.val + initial := ?_ + final := ?_ + transition := ?_ + } + · simp only [configurationAt, Option.bind_eq_bind, Turing.FinTM2.step, Fin.coe_ofNat_eq_mod, + Nat.zero_mod, + Function.iterate_zero, id_eq, Option.getD_some, initial] + · simpa only [configurationAt, Option.bind_eq_bind, Turing.FinTM2.step, Fin.val_last, + Option.getD_some] using + congrArg (fun state : Option tm.Cfg => state.getD initial) h.evals_in_steps + · intro i + obtain ⟨current, hcurrent⟩ := iterate_some_of_le + tm initial (Turing.haltList tm output) h.steps h.evals_in_steps + (show i.val ≤ h.steps by omega) + obtain ⟨following, hfollowing⟩ := iterate_some_of_le + tm initial (Turing.haltList tm output) h.steps h.evals_in_steps + (show i.val + 1 ≤ h.steps by omega) + have hstep : tm.step current = some following := by + rw [Function.iterate_succ_apply', hcurrent] at hfollowing + change tm.step current = some following at hfollowing + exact hfollowing + change tm.step (configurationAt tm initial i.val) = + some (configurationAt tm initial (i.val + 1)) + unfold configurationAt + rw [hcurrent, hfollowing] + exact hstep + +theorem ConfigurationTrace.iterate_configuration + {tm : Turing.FinTM2} + {input : List (tm.Γ tm.k₀)} + {output : List (tm.Γ tm.k₁)} + {steps : ℕ} + (trace : ConfigurationTrace tm input output steps) + (i : Fin (steps + 1)) : + ((flip bind tm.step)^[i.val]) (some (Turing.initList tm input)) = + some (trace.configuration i) := by + let advance : Option tm.Cfg → Option tm.Cfg := + flip bind tm.step + have hprefix : ∀ (i : ℕ) (hi : i ≤ steps), + (advance^[i]) (some (Turing.initList tm input)) = + some (trace.configuration ⟨i, by omega⟩) := by + intro i hi + induction i with + | zero => + simp only [Function.iterate_zero, id_eq, Fin.zero_eta, trace.initial] + | succ i ih => + have hip : i ≤ steps := by omega + have hilt : i < steps := by omega + rw [Function.iterate_succ_apply', ih hip] + change tm.step (trace.configuration ⟨i, by omega⟩) = + some (trace.configuration ⟨i + 1, by omega⟩) + exact trace.transition ⟨i, hilt⟩ + have hi : i.val ≤ steps := by omega + simpa only [advance] using hprefix i.val hi + +/-- GapCVP reduction support. -/ +def ConfigurationTrace.evalsToAt + {tm : Turing.FinTM2} + {input : List (tm.Γ tm.k₀)} + {output : List (tm.Γ tm.k₁)} + {steps : ℕ} + (trace : ConfigurationTrace tm input output steps) + (i : Fin (steps + 1)) : + StateTransition.EvalsTo tm.step (Turing.initList tm input) + (some (trace.configuration i)) where + steps := i.val + evals_in_steps := trace.iterate_configuration i + +/-- GapCVP reduction support. -/ +def ConfigurationTrace.evalsTo + {tm : Turing.FinTM2} + {input : List (tm.Γ tm.k₀)} + {output : List (tm.Γ tm.k₁)} + {steps : ℕ} + (trace : ConfigurationTrace tm input output steps) : + StateTransition.EvalsTo tm.step (Turing.initList tm input) + (some (Turing.haltList tm output)) := by + exact { + steps := steps + evals_in_steps := by + exact (trace.iterate_configuration (Fin.last steps)).trans + (congrArg some trace.final) + } + +theorem ConfigurationTrace.stack_length_le + {tm : Turing.FinTM2} + {input : List (tm.Γ tm.k₀)} + {output : List (tm.Γ tm.k₁)} + {steps : ℕ} + (trace : ConfigurationTrace tm input output steps) + (i : Fin (steps + 1)) (stack : tm.K) : + ((trace.configuration i).stk stack).length ≤ + input.length + i.val * TMComposition.maxPushPerStep tm := by + calc + ((trace.configuration i).stk stack).length ≤ + (((Turing.initList tm input).stk stack).length + + i.val * TMComposition.maxPushPerStep tm) := + TMComposition.evals_stack_length_le tm + (Turing.initList tm input) (trace.configuration i) + (trace.evalsToAt i) stack + _ ≤ input.length + i.val * TMComposition.maxPushPerStep tm := by + apply Nat.add_le_add_right + by_cases hstack : stack = tm.k₀ + · simp only [Turing.initList, eq_mpr_eq_cast, hstack, ↓reduceDIte, + TMComposition.cast_list_length, Std.le_refl] + · simp only [Turing.initList, eq_mpr_eq_cast, hstack, ↓reduceDIte, List.length_nil, zero_le] + +theorem haltList_step + (tm : Turing.FinTM2) (output : List (tm.Γ tm.k₁)) : + tm.step (Turing.haltList tm output) = none := by + rfl + +private theorem haltList_injective (tm : Turing.FinTM2) : + Function.Injective (Turing.haltList tm) := by + intro a b h + have hs := congrArg (fun c : tm.Cfg => c.stk tm.k₁) h + simpa only [Turing.haltList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq] using hs + +theorem evalsTo_terminal_unique_of_steps_le + {α : Type} (step : α → Option α) (initial a b : α) + (ha : StateTransition.EvalsTo step initial (some a)) + (hb : StateTransition.EvalsTo step initial (some b)) + (hterminal : step a = none) + (hle : ha.steps ≤ hb.steps) : a = b := by + let advance : Option α → Option α := flip bind step + let extra : ℕ := hb.steps - ha.steps + have hsplit : hb.steps = extra + ha.steps := by + dsimp [extra] + omega + have ha_run : (advance^[ha.steps]) (some initial) = some a := by + simpa only [advance] using ha.evals_in_steps + have hb_run : (advance^[hb.steps]) (some initial) = some b := by + simpa only [advance] using hb.evals_in_steps + have hrun : (advance^[extra]) (some a) = some b := by + calc + (advance^[extra]) (some a) = + (advance^[extra]) + ((advance^[ha.steps]) (some initial)) := by + rw [ha_run] + _ = (advance^[extra + ha.steps]) (some initial) := + (Function.iterate_add_apply advance extra ha.steps + (some initial)).symm + _ = some b := by + rw [← hsplit] + exact hb_run + cases he : extra with + | zero => + rw [he] at hrun + exact Option.some.inj (by simpa only [Option.some.injEq, Function.iterate_zero, id_eq] + using hrun) + | succ n => + have hnone : (advance^[extra]) (some a) = none := by + rw [he, Function.iterate_succ_apply] + change (advance^[n]) ((some a).bind step) = none + rw [Option.bind_some, hterminal] + exact Function.iterate_fixed (by rfl) n + rw [hnone] at hrun + cases hrun + +private theorem evalsTo_haltList_unique + (tm : Turing.FinTM2) (initial : tm.Cfg) + (a b : List (tm.Γ tm.k₁)) + (ha : StateTransition.EvalsTo tm.step initial + (some (Turing.haltList tm a))) + (hb : StateTransition.EvalsTo tm.step initial + (some (Turing.haltList tm b))) : a = b := by + apply haltList_injective tm + rcases le_total ha.steps hb.steps with hle | hle + · exact evalsTo_terminal_unique_of_steps_le tm.step initial + (Turing.haltList tm a) (Turing.haltList tm b) + ha hb (haltList_step tm a) hle + · exact (evalsTo_terminal_unique_of_steps_le tm.step initial + (Turing.haltList tm b) (Turing.haltList tm a) + hb ha (haltList_step tm b) hle).symm + +/-- GapCVP reduction support. -/ +structure AcceptedExecution + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) where + /-- GapCVP reduction support. -/ + certificate : List Bool + certificate_le : certificate.length ≤ bound.eval x.length + /-- GapCVP reduction support. -/ + steps : ℕ + steps_le : steps ≤ (witnessTimePolynomial bound machine).eval x.length + /-- GapCVP reduction support. -/ + trace : ConfigurationTrace machine.tm + (verifierInput machine x certificate) + (verifierOutput machine true) steps + +private theorem acceptedExecution_iff + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + Nonempty (AcceptedExecution bound machine x) ↔ + ∃ certificate : List Bool, + certificate.length ≤ bound.eval x.length ∧ + verifier (x, certificate) = true := by + constructor + · rintro ⟨execution⟩ + refine ⟨execution.certificate, execution.certificate_le, ?_⟩ + have htrace := execution.trace.evalsTo + have hactual := (machine.outputsFun + (x, execution.certificate)).toEvalsTo + change StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x execution.certificate)) + (some (Turing.haltList machine.tm + (verifierOutput machine + (verifier (x, execution.certificate))))) at hactual + have hout := evalsTo_haltList_unique machine.tm + (Turing.initList machine.tm + (verifierInput machine x execution.certificate)) + (verifierOutput machine true) + (verifierOutput machine (verifier (x, execution.certificate))) + htrace hactual + exact (verifierOutput_injective machine hout).symm + · rintro ⟨certificate, hcertificate, haccept⟩ + have hrun := boundedVerifierRun bound machine x certificate hcertificate + change EvalsToInTime machine.tm.step + (Turing.initList machine.tm (verifierInput machine x certificate)) + (some (Turing.haltList machine.tm + (verifierOutput machine (verifier (x, certificate))))) + ((witnessTimePolynomial bound machine).eval x.length) at hrun + rw [haccept] at hrun + exact ⟨{ + certificate := certificate + certificate_le := hcertificate + steps := hrun.steps + steps_le := hrun.steps_le_m + trace := traceOfEvalsTo machine.tm + (verifierInput machine x certificate) + (verifierOutput machine true) hrun.toEvalsTo + }⟩ + +/-- GapCVP reduction support. -/ +structure TableauSimulation + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) where + /-- GapCVP reduction support. -/ + time : Polynomial ℕ + /-- GapCVP reduction support. -/ + symbols : ℕ + /-- GapCVP reduction support. -/ + specification : (x : List Bool) → + Specification (time.eval x.length) symbols + correct : ∀ x : List Bool, + (∃ trace : Time (time.eval x.length) → + Position (time.eval x.length) → Symbol symbols, + ValidTrace (specification x) trace) ↔ + Nonempty (AcceptedExecution bound machine x) + +/-- GapCVP reduction support. -/ +noncomputable def encodedTableau + {bound : Polynomial ℕ} + {verifier : List Bool × List Bool → Bool} + {machine : VerifierTM verifier} + (simulation : TableauSimulation bound machine) + (x : List Bool) : List Bool := + (binaryFinEncoding ThreeCNF).encode + (ThreeCNFReduction.encodeTableau (simulation.specification x)) + +theorem threeSATLanguage_encode_iff (formula : ThreeCNF) : + threeSATLanguage ((binaryFinEncoding ThreeCNF).encode formula) ↔ + threeCNFSatisfiable formula := by + simp only [GapCVP.threeSATLanguage, decide_eq_true_eq] + constructor + · rintro ⟨candidate, hencoding, hsatisfied⟩ + have heq : candidate = formula := + (binaryFinEncoding ThreeCNF).encode_injective hencoding + simpa only [heq] using hsatisfied + · intro hsatisfied + exact ⟨formula, rfl, hsatisfied⟩ + +private theorem encodedTableau_mem_threeSAT_iff + {bound : Polynomial ℕ} + {verifier : List Bool × List Bool → Bool} + {machine : VerifierTM verifier} + (simulation : TableauSimulation bound machine) + (x : List Bool) : + threeSATLanguage (encodedTableau simulation x) ↔ + Nonempty (AcceptedExecution bound machine x) := by + unfold encodedTableau + exact + (threeSATLanguage_encode_iff + (ThreeCNFReduction.encodeTableau (simulation.specification x))).trans + ((ThreeCNFReduction.encodeTableau_satisfiable_iff_validTrace + (simulation.specification x)).trans (simulation.correct x)) + +end CLVerifier + +namespace CLNondeterminism + +open Computability GapCVP.CLVerifier + +/-- GapCVP reduction support. -/ +inductive FiniteRun {α : Type} (transition : α → α → Type) : + α → α → ℕ → Type where + | refl (state : α) : FiniteRun transition state state 0 + | tail {first middle last : α} {steps : ℕ} : + FiniteRun transition first middle steps → + transition middle last → + FiniteRun transition first last (steps + 1) + +namespace FiniteRun + +/-- GapCVP reduction support. -/ +noncomputable def single {α : Type} {transition : α → α → Type} + {first last : α} (h : transition first last) : + FiniteRun transition first last 1 := + .tail (.refl first) h + +/-- GapCVP reduction support. -/ +noncomputable def trans {α : Type} {transition : α → α → Type} + {first middle last : α} {leftSteps rightSteps : ℕ} + (left : FiniteRun transition first middle leftSteps) + (right : FiniteRun transition middle last rightSteps) : + FiniteRun transition first last (leftSteps + rightSteps) := by + induction right with + | refl => simpa only [add_zero] using left + | tail prior hstep ih => + simpa only [Nat.add_assoc] using FiniteRun.tail ih hstep + +end FiniteRun + +/-- GapCVP reduction support. -/ +inductive GuessState (tm : Turing.FinTM2) where + | guessing (certificate : List Bool) + | verifying (certificate : List Bool) (configuration : tm.Cfg) + +/-- GapCVP reduction support. -/ +inductive GuessStep + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + GuessState machine.tm → GuessState machine.tm → Type where + | guess (certificate : List Bool) (bit : Bool) + (hbound : certificate.length < bound.eval x.length) : + GuessStep bound machine x + (.guessing certificate) + (.guessing (certificate ++ [bit])) + | begin (certificate : List Bool) + (hbound : certificate.length ≤ bound.eval x.length) : + GuessStep bound machine x + (.guessing certificate) + (.verifying certificate + (Turing.initList machine.tm + (verifierInput machine x certificate))) + | execute (certificate : List Bool) + (configuration next : machine.tm.Cfg) + (hstep : machine.tm.step configuration = some next) : + GuessStep bound machine x + (.verifying certificate configuration) + (.verifying certificate next) + +/-- GapCVP reduction support. -/ +def oneStepEvalsTo + (tm : Turing.FinTM2) + (configuration next : tm.Cfg) + (hstep : tm.step configuration = some next) : + StateTransition.EvalsTo tm.step configuration (some next) where + steps := 1 + evals_in_steps := by + change tm.step configuration = some next + exact hstep + +private noncomputable def GuessInvariant + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : GuessState machine.tm → Bool + | .guessing certificate => + @decide ( + certificate.length ≤ bound.eval x.length + ) (Classical.propDecidable _) + | .verifying certificate configuration => + @decide ( + certificate.length ≤ bound.eval x.length ∧ + Nonempty (StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (some configuration)) + ) (Classical.propDecidable _) +private theorem guessInvariant_step + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + {first next : GuessState machine.tm} + (hfirst : GuessInvariant bound machine x first) + (hstep : GuessStep bound machine x first next) : + GuessInvariant bound machine x next := by + cases hstep with + | guess certificate bit hbound => + simp only [GuessInvariant, decide_eq_true_eq] at hfirst ⊢ + simp only [List.length_append, List.length_singleton] + omega + | begin certificate hbound => + simp only [GuessInvariant, decide_eq_true_eq] at hfirst ⊢ + exact ⟨hbound, + ⟨StateTransition.EvalsTo.refl machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate))⟩⟩ + | execute certificate configuration next hstep => + simp only [GuessInvariant, decide_eq_true_eq] at hfirst ⊢ + rcases hfirst with ⟨hbound, ⟨hrun⟩⟩ + exact ⟨hbound, + ⟨StateTransition.EvalsTo.trans machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + configuration (some next) hrun + (oneStepEvalsTo machine.tm configuration next hstep)⟩⟩ + +private theorem guessInvariant_run + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + {first last : GuessState machine.tm} + {steps : ℕ} + (run : FiniteRun (GuessStep bound machine x) first last steps) + (hfirst : GuessInvariant bound machine x first) : + GuessInvariant bound machine x last := by + induction run with + | refl => exact hfirst + | tail prior hstep ih => + exact guessInvariant_step bound machine x ih hstep + +private noncomputable def TimedGuessInvariant + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) (elapsed : ℕ) : GuessState machine.tm → Bool + | .guessing certificate => + @decide ( + certificate.length ≤ bound.eval x.length ∧ + certificate.length ≤ elapsed + ) (Classical.propDecidable _) + | .verifying certificate configuration => + @decide ( + certificate.length ≤ bound.eval x.length ∧ + ∃ run : StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (some configuration), + run.steps + certificate.length + 1 ≤ elapsed + ) (Classical.propDecidable _) +private theorem timedGuessInvariant_step + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) {elapsed : ℕ} + {first next : GuessState machine.tm} + (hfirst : TimedGuessInvariant bound machine x elapsed first) + (hstep : GuessStep bound machine x first next) : + TimedGuessInvariant bound machine x (elapsed + 1) next := by + cases hstep with + | guess certificate bit hbound => + simp only [TimedGuessInvariant, decide_eq_true_eq] at hfirst ⊢ + rcases hfirst with ⟨_, helapsed⟩ + simp only [List.length_append, List.length_singleton] + constructor <;> omega + | begin certificate hbound => + simp only [TimedGuessInvariant, decide_eq_true_eq] at hfirst ⊢ + rcases hfirst with ⟨_, helapsed⟩ + refine ⟨hbound, StateTransition.EvalsTo.refl machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)), ?_⟩ + change 0 + certificate.length + 1 ≤ elapsed + 1 + omega + | execute certificate configuration next hstep => + simp only [TimedGuessInvariant, decide_eq_true_eq] at hfirst ⊢ + rcases hfirst with ⟨hbound, run, hruntime⟩ + let nextRun := StateTransition.EvalsTo.trans machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + configuration (some next) run + (oneStepEvalsTo machine.tm configuration next hstep) + refine ⟨hbound, nextRun, ?_⟩ + change 1 + run.steps + certificate.length + 1 ≤ elapsed + 1 + omega + +private theorem timedGuessInvariant_run + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + {state : GuessState machine.tm} {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) state elapsed) : + TimedGuessInvariant bound machine x elapsed state := by + have hinitial : TimedGuessInvariant bound machine x 0 + (.guessing []) := by + simp only [TimedGuessInvariant, decide_eq_true_eq] + exact ⟨Nat.zero_le _, le_refl 0⟩ + induction run with + | refl => exact hinitial + | tail prior hstep ih => + exact timedGuessInvariant_step bound machine x ih hstep + +private noncomputable def guessingRunFrom + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (start suffix : List Bool) + (hbound : (start ++ suffix).length ≤ bound.eval x.length) : + FiniteRun (GuessStep bound machine x) + (.guessing start) (.guessing (start ++ suffix)) suffix.length := by + induction suffix generalizing start with + | nil => + simpa only [List.append_nil, List.length_nil] using + FiniteRun.refl (GuessState.guessing (tm := machine.tm) start) + | cons bit rest ih => + have hfirst : start.length < bound.eval x.length := by + simp only [List.length_append, List.length_cons] at hbound + omega + have hrest : ((start ++ [bit]) ++ rest).length ≤ + bound.eval x.length := by + simpa only [List.append_assoc, List.cons_append, List.nil_append, List.length_append, + List.length_cons] using + hbound + have hguess : FiniteRun (GuessStep bound machine x) + (.guessing start) (.guessing (start ++ [bit])) 1 := + FiniteRun.single + (GuessStep.guess start bit hfirst) + have hremaining := ih (start ++ [bit]) hrest + simpa only [List.length_cons, List.append_assoc, List.cons_append, List.nil_append, + Nat.add_comm] using + hguess.trans hremaining + +private noncomputable def guessingRun + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hbound : certificate.length ≤ bound.eval x.length) : + FiniteRun (GuessStep bound machine x) + (.guessing []) (.guessing certificate) certificate.length := by + simpa only [List.nil_append] using guessingRunFrom bound machine x [] certificate hbound + +private noncomputable def configurationTraceRun + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + {output : List (machine.tm.Γ machine.tm.k₁)} + {steps : ℕ} + (trace : ConfigurationTrace machine.tm + (verifierInput machine x certificate) output steps) : + FiniteRun (GuessStep bound machine x) + (.verifying certificate + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (.verifying certificate + (Turing.haltList machine.tm output)) steps := by + have hprefix : ∀ (i : ℕ) (hi : i ≤ steps), + FiniteRun (GuessStep bound machine x) + (.verifying certificate + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (.verifying certificate + (trace.configuration ⟨i, by omega⟩)) i := by + intro i hi + induction i with + | zero => + simpa only [Fin.zero_eta, trace.initial] using + FiniteRun.refl (GuessState.verifying certificate (Turing.initList machine.tm + (verifierInput machine x certificate))) + | succ i ih => + have hip : i ≤ steps := by omega + have hilt : i < steps := by omega + have hrun := ih hip + have hstep := GuessStep.execute + (bound := bound) (machine := machine) (x := x) + certificate + (trace.configuration ⟨i, by omega⟩) + (trace.configuration ⟨i + 1, by omega⟩) + (trace.transition ⟨i, hilt⟩) + exact FiniteRun.tail hrun hstep + have hlast : trace.configuration ⟨steps, by omega⟩ = + Turing.haltList machine.tm output := trace.final + rw [← hlast] + exact hprefix steps (le_refl steps) + +/-- GapCVP reduction support. -/ +noncomputable def guessTimePolynomial + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : Polynomial ℕ := + bound + 1 + witnessTimePolynomial bound machine + +/-- GapCVP reduction support. -/ +noncomputable def nondeterministicTableauDimensionPolynomial + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : Polynomial ℕ := + Polynomial.X + bound + + guessTimePolynomial bound machine * + Polynomial.C (TMComposition.maxPushPerStep machine.tm) + + guessTimePolynomial bound machine + 1 + +theorem verifying_stack_length_le + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (configuration : machine.tm.Cfg) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) (.verifying certificate configuration) elapsed) + (hruntime : elapsed ≤ (guessTimePolynomial bound machine).eval x.length) + (stack : machine.tm.K) : + (configuration.stk stack).length ≤ + (nondeterministicTableauDimensionPolynomial bound machine).eval + x.length := by + have hinvariant := timedGuessInvariant_run bound machine x run + simp only [TimedGuessInvariant, decide_eq_true_eq] at hinvariant + obtain ⟨hcertificate, hmachine, hsteps⟩ := hinvariant + have hmachineSteps : hmachine.steps ≤ elapsed := by omega + have hinput : + (((Turing.initList machine.tm + (verifierInput machine x certificate)).stk stack).length) ≤ + x.length + bound.eval x.length := by + calc + (((Turing.initList machine.tm + (verifierInput machine x certificate)).stk stack).length) ≤ + (verifierInput machine x certificate).length := by + by_cases hstack : stack = machine.tm.k₀ + · simp only [Turing.initList, eq_mpr_eq_cast, hstack, ↓reduceDIte, + TMComposition.cast_list_length, + verifierInput_length, Std.le_refl] + · simp only [Turing.initList, eq_mpr_eq_cast, hstack, ↓reduceDIte, List.length_nil, + verifierInput_length, + zero_le] + _ = x.length + certificate.length := + verifierInput_length machine x certificate + _ ≤ x.length + bound.eval x.length := + Nat.add_le_add_left hcertificate x.length + have hstack := TMComposition.evals_stack_length_le machine.tm + (Turing.initList machine.tm (verifierInput machine x certificate)) + configuration hmachine stack + have htime : hmachine.steps ≤ + (guessTimePolynomial bound machine).eval x.length := + hmachineSteps.trans hruntime + calc + (configuration.stk stack).length ≤ + (((Turing.initList machine.tm + (verifierInput machine x certificate)).stk stack).length) + + hmachine.steps * TMComposition.maxPushPerStep machine.tm := + hstack + _ ≤ (x.length + bound.eval x.length) + + (guessTimePolynomial bound machine).eval x.length * + TMComposition.maxPushPerStep machine.tm := + Nat.add_le_add hinput + (Nat.mul_le_mul_right + (TMComposition.maxPushPerStep machine.tm) htime) + _ ≤ (nondeterministicTableauDimensionPolynomial bound machine).eval + x.length := by + simp only [nondeterministicTableauDimensionPolynomial, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_X, + Polynomial.eval_C, Polynomial.eval_one] + omega + +/-- GapCVP reduction support. -/ +structure GuessingExecution + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) where + /-- GapCVP reduction support. -/ + certificate : List Bool + /-- GapCVP reduction support. -/ + steps : ℕ + steps_le : steps ≤ (guessTimePolynomial bound machine).eval x.length + /-- GapCVP reduction support. -/ + run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (Turing.haltList machine.tm (verifierOutput machine true))) + steps + +private noncomputable def guessingExecutionOfAccepted + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) : + GuessingExecution bound machine x := by + have hguess := guessingRun bound machine x execution.certificate + execution.certificate_le + have hbegin : FiniteRun (GuessStep bound machine x) + (.guessing execution.certificate) + (.verifying execution.certificate + (Turing.initList machine.tm + (verifierInput machine x execution.certificate))) 1 := + FiniteRun.single + (GuessStep.begin execution.certificate execution.certificate_le) + have hverify := configurationTraceRun bound machine x + execution.certificate execution.trace + refine { + certificate := execution.certificate + steps := (execution.certificate.length + 1) + execution.steps + steps_le := ?_ + run := (hguess.trans hbegin).trans hverify + } + have hcertificate := execution.certificate_le + have hsteps := execution.steps_le + simp only [guessTimePolynomial, Polynomial.eval_add, + Polynomial.eval_one] + omega + +theorem guessingExecution_accepted + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : GuessingExecution bound machine x) : + Nonempty (AcceptedExecution bound machine x) := by + have hinitial : GuessInvariant bound machine x (.guessing []) := by + simp only [GuessInvariant, decide_eq_true_eq] + change 0 ≤ bound.eval x.length + exact Nat.zero_le _ + have hfinal := guessInvariant_run bound machine x + execution.run hinitial + simp only [GuessInvariant, decide_eq_true_eq] at hfinal + rcases hfinal with ⟨hcertificate, ⟨hrun⟩⟩ + have hactual := (machine.outputsFun + (x, execution.certificate)).toEvalsTo + change StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x execution.certificate)) + (some (Turing.haltList machine.tm + (verifierOutput machine + (verifier (x, execution.certificate))))) at hactual + have houtput := evalsTo_haltList_unique machine.tm + (Turing.initList machine.tm + (verifierInput machine x execution.certificate)) + (verifierOutput machine true) + (verifierOutput machine (verifier (x, execution.certificate))) + hrun hactual + apply (acceptedExecution_iff bound machine x).mpr + exact ⟨execution.certificate, hcertificate, + (verifierOutput_injective machine houtput).symm⟩ + +/-- GapCVP reduction support. -/ +structure LocalTableauCompiler + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) where + /-- GapCVP reduction support. -/ + symbols : ℕ + /-- GapCVP reduction support. -/ + specification : (x : List Bool) → + CL.Specification + ((nondeterministicTableauDimensionPolynomial bound machine).eval + x.length) symbols + encode : ∀ (x : List Bool), + GuessingExecution bound machine x → + ∃ trace : + CL.Time + ((nondeterministicTableauDimensionPolynomial bound machine).eval + x.length) → + CL.Position + ((nondeterministicTableauDimensionPolynomial bound machine).eval + x.length) → + CL.Symbol symbols, + CL.ValidTrace (specification x) trace + /-- GapCVP reduction support. -/ + decode : ∀ (x : List Bool) + (trace : + CL.Time + ((nondeterministicTableauDimensionPolynomial bound machine).eval + x.length) → + CL.Position + ((nondeterministicTableauDimensionPolynomial bound machine).eval + x.length) → + CL.Symbol symbols), + CL.ValidTrace (specification x) trace → + GuessingExecution bound machine x + +/-- GapCVP reduction support. -/ +noncomputable def tableauSimulationOfLocalCompiler + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (compiler : LocalTableauCompiler bound machine) : + CLVerifier.TableauSimulation bound machine where + time := nondeterministicTableauDimensionPolynomial bound machine + symbols := compiler.symbols + specification := compiler.specification + correct x := by + constructor + · rintro ⟨trace, htrace⟩ + exact guessingExecution_accepted bound machine + (compiler.decode x trace htrace) + · rintro ⟨execution⟩ + exact compiler.encode x + (guessingExecutionOfAccepted bound machine execution) + +theorem compiledTableau_iff_verifier + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (compiler : LocalTableauCompiler bound machine) + (x : List Bool) : + threeSATLanguage + (encodedTableau + (tableauSimulationOfLocalCompiler bound machine compiler) x) ↔ + ∃ certificate : List Bool, + certificate.length ≤ bound.eval x.length ∧ + verifier (x, certificate) = true := by + exact (encodedTableau_mem_threeSAT_iff + (tableauSimulationOfLocalCompiler bound machine compiler) x).trans + (acceptedExecution_iff bound machine x) + +end CLNondeterminism + +namespace CLBoundedStates + +open Computability GapCVP.CLVerifier GapCVP.CLNondeterminism + +private def statementPushSlots + {K : Type} {Γ : K → Type} {Λ σ : Type} : + Turing.TM2.Stmt Γ Λ σ → ℕ + | .push _ _ next => statementPushSlots next + 1 + | .peek _ _ next => statementPushSlots next + | .pop _ _ next => statementPushSlots next + | .load _ next => statementPushSlots next + | .branch _ yes no => + statementPushSlots yes + statementPushSlots no + | .goto _ => 0 + | .halt => 0 + +private abbrev PushSlot (tm : Turing.FinTM2) := + Σ label : tm.Λ, Fin (statementPushSlots (tm.m label)) + +noncomputable instance instFintypePushSlot + (tm : Turing.FinTM2) : Fintype (PushSlot tm) := by + letI : Fintype tm.Λ := tm.ΛFin + infer_instance + +/-- GapCVP reduction support. -/ +abbrev PushTag (tm : Turing.FinTM2) := PushSlot tm × tm.σ + +noncomputable instance instFintypePushTag + (tm : Turing.FinTM2) : Fintype (PushTag tm) := by + letI : Fintype tm.σ := tm.σFin + infer_instance + +/-- GapCVP reduction support. -/ +abbrev CellAtom (tm : Turing.FinTM2) := + Option ((Bool ⊕ Bool) ⊕ PushTag tm) + +noncomputable instance instFintypeCellAtom + (tm : Turing.FinTM2) : Fintype (CellAtom tm) := by + infer_instance + +/-- GapCVP reduction support. -/ +inductive PhaseTag where + | guessing + | verifying + | accepting + deriving DecidableEq + +noncomputable instance : Fintype PhaseTag where + elems := {.guessing, .verifying, .accepting} + complete tag := by cases tag <;> simp + +/-- GapCVP reduction support. -/ +abbrev LocalCellSymbol (tm : Turing.FinTM2) := + PhaseTag × Option (tm.Λ × tm.σ) × + (tm.K → CellAtom tm) × Bool + +noncomputable instance instFintypeLocalCellSymbol + (tm : Turing.FinTM2) : Fintype (LocalCellSymbol tm) := by + letI : Fintype tm.K := tm.kFin + letI : Fintype tm.Λ := tm.ΛFin + letI : Fintype tm.σ := tm.σFin + infer_instance + +end CLBoundedStates + +namespace CLPushAlphabet + +open Computability GapCVP.CLVerifier GapCVP.CLBoundedStates + +private abbrev PushSource (tm : Turing.FinTM2) := + Σ stack : tm.K, tm.σ → tm.Γ stack + +private def statementPushSources + {K : Type} {Γ : K → Type} {Λ σ : Type} : + Turing.TM2.Stmt Γ Λ σ → List (Σ stack : K, σ → Γ stack) + | .push stack value next => + ⟨stack, value⟩ :: statementPushSources next + | .peek _ _ next => statementPushSources next + | .pop _ _ next => statementPushSources next + | .load _ next => statementPushSources next + | .branch _ yes no => + statementPushSources yes ++ statementPushSources no + | .goto _ => [] + | .halt => [] + +@[simp] private theorem statementPushSources_length + {K : Type} {Γ : K → Type} {Λ σ : Type} + (statement : Turing.TM2.Stmt Γ Λ σ) : + (statementPushSources statement).length = + statementPushSlots statement := by + induction statement with + | push stack value next ih => + simp only [statementPushSources, List.length_cons, ih, statementPushSlots] + | peek stack value next ih => + simpa only [statementPushSources, statementPushSlots] using ih + | pop stack value next ih => + simpa only [statementPushSources, statementPushSlots] using ih + | load value next ih => + simpa only [statementPushSources, statementPushSlots] using ih + | branch test yes no ihyes ihno => + simp only [statementPushSources, List.length_append, ihyes, ihno, statementPushSlots] + | goto value => rfl + | halt => rfl + +private def pushSourceOfSlot (tm : Turing.FinTM2) + (slot : PushSlot tm) : PushSource tm := + (statementPushSources (tm.m slot.1)).get + ⟨slot.2.val, by + rw [statementPushSources_length] + exact slot.2.isLt⟩ + +/-- GapCVP reduction support. -/ +def cellAtomValue + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) : + CellAtom machine.tm → Option (machine.tm.Γ stack) + | none => none + | some (.inl bit) => + if h : stack = machine.tm.k₀ then + some (h.symm ▸ machine.inputAlphabet.invFun bit) + else none + | some (.inr (slot, state)) => + if h : (pushSourceOfSlot machine.tm slot).1 = stack then + some (h ▸ (pushSourceOfSlot machine.tm slot).2 state) + else none + +@[simp] theorem cellAtomValue_blank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) : + cellAtomValue machine stack none = none := rfl + +@[simp] theorem cellAtomValue_input + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (bit : Bool ⊕ Bool) : + cellAtomValue machine machine.tm.k₀ + (some (.inl bit)) = some (machine.inputAlphabet.invFun bit) := by + simp only [cellAtomValue, ↓reduceDIte, Equiv.invFun_as_coe] + +@[simp] private theorem cellAtomValue_pushed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (slot : PushSlot machine.tm) (state : machine.tm.σ) : + cellAtomValue machine + (pushSourceOfSlot machine.tm slot).1 + (some (.inr (slot, state))) = + some ((pushSourceOfSlot machine.tm slot).2 state) := by + simp only [cellAtomValue, ↓reduceDIte] + +/-- GapCVP reduction support. -/ +noncomputable def StackAtomSupported + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (configuration : machine.tm.Cfg) : Bool := + @decide ( + ∀ (stack : machine.tm.K) (value : machine.tm.Γ stack), + value ∈ configuration.stk stack → + ∃ atom : CellAtom machine.tm, + cellAtomValue machine stack atom = some value + ) (Classical.propDecidable _) +theorem initialConfiguration_stackAtomSupported + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) : + StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x certificate)) := by + simp only [GapCVP.CLPushAlphabet.StackAtomSupported, decide_eq_true_eq] at * + intro stack value hvalue + by_cases hstack : stack = machine.tm.k₀ + · subst stack + have hinput : value ∈ verifierInput machine x certificate := by + simpa only [Turing.initList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq] using hvalue + obtain ⟨bit, _, hbit⟩ := List.mem_map.mp hinput + subst value + exact ⟨some (.inl bit), cellAtomValue_input machine bit⟩ + · simp only [Turing.initList, eq_mpr_eq_cast, hstack, ↓reduceDIte, List.not_mem_nil] at hvalue + +end CLPushAlphabet + +namespace CLStackSupport + +open Computability GapCVP.CLBoundedStates GapCVP.CLPushAlphabet + +private theorem pushSourceOfSlot_exists + (tm : Turing.FinTM2) (label : tm.Λ) + (source : PushSource tm) + (hsource : source ∈ statementPushSources (tm.m label)) : + ∃ slot : PushSlot tm, + slot.1 = label ∧ pushSourceOfSlot tm slot = source := by + obtain ⟨index, hindex⟩ := List.get_of_mem hsource + have hindexBound : index.val < statementPushSlots (tm.m label) := by + simpa only [← statementPushSources_length] using index.isLt + let slot : PushSlot tm := ⟨label, ⟨index.val, hindexBound⟩⟩ + refine ⟨slot, rfl, ?_⟩ + exact hindex + +private theorem pushedValue_has_cellAtom + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (label : machine.tm.Λ) + (stack : machine.tm.K) + (value : machine.tm.σ → machine.tm.Γ stack) + (state : machine.tm.σ) + (hsource : (⟨stack, value⟩ : PushSource machine.tm) ∈ + statementPushSources (machine.tm.m label)) : + ∃ atom : CellAtom machine.tm, + cellAtomValue machine stack atom = some (value state) := by + obtain ⟨slot, _, hslot⟩ := + pushSourceOfSlot_exists machine.tm label ⟨stack, value⟩ hsource + have hsigma : + (⟨(pushSourceOfSlot machine.tm slot).1, + (pushSourceOfSlot machine.tm slot).2⟩ : PushSource machine.tm) = + ⟨stack, value⟩ := by + exact hslot + obtain ⟨hstack, hvalue⟩ := Sigma.mk.inj_iff.mp hsigma + subst stack + have hfunction : (pushSourceOfSlot machine.tm slot).2 = value := + eq_of_heq hvalue + refine ⟨some (.inr (slot, state)), ?_⟩ + simpa only [hfunction] using + cellAtomValue_pushed machine slot state + +private noncomputable def StacksAtomSupported + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (values : ∀ stack : machine.tm.K, List (machine.tm.Γ stack)) : Bool := + @decide ( + ∀ (stack : machine.tm.K) (value : machine.tm.Γ stack), + value ∈ values stack → + ∃ atom : CellAtom machine.tm, + cellAtomValue machine stack atom = some value + ) (Classical.propDecidable _) +private theorem stacksAtomSupported_push + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (values : ∀ stack : machine.tm.K, List (machine.tm.Γ stack)) + (hvalues : StacksAtomSupported machine values) + (stack : machine.tm.K) (value : machine.tm.Γ stack) + (hatom : ∃ atom : CellAtom machine.tm, + cellAtomValue machine stack atom = some value) : + StacksAtomSupported machine + (Function.update values stack (value :: values stack)) := by + simp only [GapCVP.CLStackSupport.StacksAtomSupported, decide_eq_true_eq] at * + intro target candidate hcandidate + by_cases htarget : target = stack + · subst target + have hmem : candidate = value ∨ candidate ∈ values stack := by + simpa only [Function.update_self, List.mem_cons] using hcandidate + rcases hmem with rfl | hold + · exact hatom + · exact hvalues stack candidate hold + · have hold : candidate ∈ values target := by + simpa only [Function.update, htarget, ↓reduceDIte] using hcandidate + exact hvalues target candidate hold + +private theorem stacksAtomSupported_pop + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (values : ∀ stack : machine.tm.K, List (machine.tm.Γ stack)) + (hvalues : StacksAtomSupported machine values) + (stack : machine.tm.K) : + StacksAtomSupported machine + (Function.update values stack (values stack).tail) := by + simp only [GapCVP.CLStackSupport.StacksAtomSupported, decide_eq_true_eq] at * + intro target candidate hcandidate + by_cases htarget : target = stack + · subst target + have htail : candidate ∈ (values stack).tail := by + simpa only [Function.update_self] using hcandidate + exact hvalues stack candidate (List.mem_of_mem_tail htail) + · have hold : candidate ∈ values target := by + simpa only [Function.update, htarget, ↓reduceDIte] using hcandidate + exact hvalues target candidate hold + +private theorem stacksAtomSupported_stepAux + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (label : machine.tm.Λ) + (statement : Turing.TM2.Stmt machine.tm.Γ + machine.tm.Λ machine.tm.σ) + (state : machine.tm.σ) + (values : ∀ stack : machine.tm.K, + List (machine.tm.Γ stack)) + (hincluded : ∀ source ∈ statementPushSources statement, + source ∈ statementPushSources (machine.tm.m label)) + (hvalues : StacksAtomSupported machine values) : + StacksAtomSupported machine + (Turing.TM2.stepAux statement state values).stk := by + induction statement generalizing state values with + | push stack value next ih => + have hpush : (⟨stack, value⟩ : PushSource machine.tm) ∈ + statementPushSources (machine.tm.m label) := by + apply hincluded + simp only [statementPushSources, List.mem_cons, true_or] + have hatom := pushedValue_has_cellAtom + machine label stack value state hpush + have hnext : ∀ source ∈ statementPushSources next, + source ∈ statementPushSources (machine.tm.m label) := by + intro source hsource + apply hincluded + simp only [statementPushSources, List.mem_cons, hsource, or_true] + have hupdated := stacksAtomSupported_push + machine values hvalues stack (value state) hatom + simpa only [Turing.TM2.stepAux] using + ih state (Function.update values stack (value state :: values stack)) hnext hupdated + | peek stack update next ih => + have hnext : ∀ source ∈ statementPushSources next, + source ∈ statementPushSources (machine.tm.m label) := by + intro source hsource + exact hincluded source hsource + simpa only [Turing.TM2.stepAux] using ih (update state (values stack).head?) values hnext + hvalues + | pop stack update next ih => + have hnext : ∀ source ∈ statementPushSources next, + source ∈ statementPushSources (machine.tm.m label) := by + intro source hsource + exact hincluded source hsource + have hupdated := stacksAtomSupported_pop + machine values hvalues stack + simpa only [Turing.TM2.stepAux] using + ih (update state (values stack).head?) (Function.update values stack (values stack).tail) + hnext hupdated + | load update next ih => + have hnext : ∀ source ∈ statementPushSources next, + source ∈ statementPushSources (machine.tm.m label) := by + intro source hsource + exact hincluded source hsource + simpa only [Turing.TM2.stepAux] using ih (update state) values hnext hvalues + | branch test yes no ihyes ihno => + cases htest : test state with + | false => + have hno : ∀ source ∈ statementPushSources no, + source ∈ statementPushSources (machine.tm.m label) := by + intro source hsource + apply hincluded + simp only [statementPushSources, List.mem_append, hsource, or_true] + simpa only [Turing.TM2.stepAux, htest, Bool.cond_false] using ihno state values hno + hvalues + | true => + have hyes : ∀ source ∈ statementPushSources yes, + source ∈ statementPushSources (machine.tm.m label) := by + intro source hsource + apply hincluded + simp only [statementPushSources, List.mem_append, hsource, true_or] + simpa only [Turing.TM2.stepAux, htest, Bool.cond_true] using ihyes state values hyes + hvalues + | goto update => + simpa only [Turing.TM2.stepAux] using hvalues + | halt => + simpa only [Turing.TM2.stepAux] using hvalues + +private theorem step_stackAtomSupported + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (configuration next : machine.tm.Cfg) + (hstep : machine.tm.step configuration = some next) + (hsupported : StackAtomSupported machine configuration) : + StackAtomSupported machine next := by + rcases configuration with ⟨label, state, values⟩ + cases label with + | none => + simp only [Turing.FinTM2.step, Turing.TM2.step, reduceCtorEq] at hstep + | some label => + have heq : + Turing.TM2.stepAux (machine.tm.m label) state values = + next := by + have hsome : + some (Turing.TM2.stepAux + (machine.tm.m label) state values) = some next := by + exact hstep + exact Option.some.inj hsome + subst next + change StacksAtomSupported machine + (Turing.TM2.stepAux (machine.tm.m label) state values).stk + apply stacksAtomSupported_stepAux machine label + (machine.tm.m label) state values + · intro source hsource + exact hsource + · exact hsupported + +end CLStackSupport + +namespace CLCellRows + +open Computability GapCVP.CLBoundedStates GapCVP.CLPushAlphabet + +/-- GapCVP reduction support. -/ +def paddedAtom {tm : Turing.FinTM2} + (atoms : List (CellAtom tm)) (index : ℕ) : CellAtom tm := + (atoms[index]?).getD none + +theorem paddedAtom_decode + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + {atoms : List (CellAtom machine.tm)} + {values : List (machine.tm.Γ stack)} + (h : List.Forall₂ + (fun atom value => + cellAtomValue machine stack atom = some value) + atoms values) + (index : ℕ) : + cellAtomValue machine stack (paddedAtom atoms index) = values[index]? := by + induction h generalizing index with + | nil => + simp only [cellAtomValue, paddedAtom, List.length_nil, not_lt_zero, not_false_eq_true, + getElem?_neg, + Option.getD_none] + | @cons atom value atoms values hatom htail ih => + cases index with + | zero => simpa only [paddedAtom, List.length_cons, lt_add_iff_pos_left, + Order.lt_add_one_iff, zero_le, getElem?_pos, + List.getElem_cons_zero, Option.getD_some] using hatom + | succ index => simpa only [paddedAtom, List.getElem?_cons_succ] using ih index + +/-- GapCVP reduction support. -/ +def certificatePhase (certificate : List Bool) (index : ℕ) : PhaseTag := + if h : index < certificate.length then + if certificate.get ⟨index, h⟩ then + .verifying + else + .guessing + else if index = certificate.length then + .accepting + else + .guessing + +@[simp] private theorem certificatePhase_end (certificate : List Bool) : + certificatePhase certificate certificate.length = .accepting := by + simp only [certificatePhase, lt_self_iff_false, ↓reduceDIte, ↓reduceIte] + +theorem certificatePhase_accepting_iff + (certificate : List Bool) (index : ℕ) : + certificatePhase certificate index = .accepting ↔ + index = certificate.length := by + by_cases hindex : index < certificate.length + · have hne : index ≠ certificate.length := Nat.ne_of_lt hindex + cases hbit : certificate[index] <;> + simp [certificatePhase, hindex, hbit, hne] + · simp only [certificatePhase, hindex, ↓reduceDIte, ite_eq_left_iff, reduceCtorEq, imp_false, + Decidable.not_not] + +private theorem certificatePhase_bit + (certificate : List Bool) (index : ℕ) + (hindex : index < certificate.length) : + certificatePhase certificate index = + if certificate.get ⟨index, hindex⟩ then + PhaseTag.verifying + else + PhaseTag.guessing := by + simp only [certificatePhase, hindex, ↓reduceDIte, List.get_eq_getElem] + +private abbrev CellRow (tm : Turing.FinTM2) (width : ℕ) := + Fin (width + 1) → LocalCellSymbol tm + +/-- GapCVP reduction support. -/ +def guessingRow (tm : Turing.FinTM2) (width : ℕ) + (certificate : List Bool) : CellRow tm width := + fun index => + (certificatePhase certificate index.val, + none, + fun _ => none, + false) + +/-- GapCVP reduction support. -/ +def configurationControl (tm : Turing.FinTM2) + (configuration : tm.Cfg) : tm.Λ × tm.σ := + (configuration.l.getD tm.main, configuration.var) + +end CLCellRows + +namespace CLCellRowBounds + +open Computability GapCVP.CLNondeterminism + +/-- GapCVP reduction support. -/ +abbrev rowWidth + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : ℕ := + (nondeterministicTableauDimensionPolynomial bound machine).eval x.length + +theorem certificateBound_le_rowWidth + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + bound.eval x.length ≤ rowWidth bound machine x := by + simp only [rowWidth, nondeterministicTableauDimensionPolynomial, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_X, + Polynomial.eval_C, Polynomial.eval_one] + omega + +end CLCellRowBounds + +namespace CLLocalWindows + +open Computability GapCVP.CLBoundedStates GapCVP.CLCellRows + +/-- GapCVP reduction support. -/ +def statementStackActions + {K : Type} {Γ : K → Type} {Λ σ : Type} : + Turing.TM2.Stmt Γ Λ σ → ℕ + | .push _ _ next => statementStackActions next + 1 + | .peek _ _ next => statementStackActions next + | .pop _ _ next => statementStackActions next + 1 + | .load _ next => statementStackActions next + | .branch _ yes no => + max (statementStackActions yes) (statementStackActions no) + | .goto _ => 0 + | .halt => 0 + +private def maxStackEditsPerStep (tm : Turing.FinTM2) : ℕ := by + classical + letI : Fintype tm.Λ := tm.ΛFin + exact Finset.univ.sup fun label => + statementStackActions (tm.m label) + +private theorem statementStackActions_le_max + (tm : Turing.FinTM2) (label : tm.Λ) : + statementStackActions (tm.m label) ≤ maxStackEditsPerStep tm := by + classical + let : Fintype tm.Λ := tm.ΛFin + change statementStackActions (tm.m label) ≤ + (Finset.univ : Finset tm.Λ).sup + (fun candidate => statementStackActions (tm.m candidate)) + exact Finset.le_sup + (f := fun candidate : tm.Λ => + statementStackActions (tm.m candidate)) + (Finset.mem_univ label) + +/-- GapCVP reduction support. -/ +def blockSize (tm : Turing.FinTM2) : ℕ := + maxStackEditsPerStep tm + 1 + +theorem blockSize_pos (tm : Turing.FinTM2) : 0 < blockSize tm := by + simp only [blockSize, lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le] + +private theorem statementStackActions_lt_blockSize + (tm : Turing.FinTM2) (label : tm.Λ) : + statementStackActions (tm.m label) < blockSize tm := by + have hbound := statementStackActions_le_max tm label + simp only [blockSize] + omega + +/-- GapCVP reduction support. -/ +abbrev BlockCell (tm : Turing.FinTM2) := + Fin (blockSize tm) → LocalCellSymbol tm + +instance instFintypeBlockCell (tm : Turing.FinTM2) : + Fintype (BlockCell tm) := by + infer_instance + +/-- GapCVP reduction support. -/ +def blankCell (tm : Turing.FinTM2) : LocalCellSymbol tm := + (.guessing, none, fun _ => none, false) + +private abbrev BlockRow (tm : Turing.FinTM2) (width : ℕ) := + Fin (width + 1) → BlockCell tm + +/-- GapCVP reduction support. -/ +def packRow (tm : Turing.FinTM2) (width : ℕ) + (row : CellRow tm width) : BlockRow tm width := + fun block offset => + if h : block.val * blockSize tm + offset.val < width + 1 then + row ⟨block.val * blockSize tm + offset.val, h⟩ + else + blankCell tm + +/-- GapCVP reduction support. -/ +def coordinateBlock (tm : Turing.FinTM2) (width : ℕ) + (index : Fin (width + 1)) : Fin (width + 1) := + ⟨index.val / blockSize tm, + Nat.lt_of_le_of_lt + (Nat.div_le_self index.val (blockSize tm)) index.isLt⟩ + +/-- GapCVP reduction support. -/ +def coordinateOffset (tm : Turing.FinTM2) (width : ℕ) + (index : Fin (width + 1)) : Fin (blockSize tm) := + ⟨index.val % blockSize tm, + Nat.mod_lt index.val (blockSize_pos tm)⟩ + +theorem packRow_cell + (tm : Turing.FinTM2) (width : ℕ) + (row : CellRow tm width) (index : Fin (width + 1)) : + packRow tm width row + (coordinateBlock tm width index) + (coordinateOffset tm width index) = row index := by + have hcoordinate : + index.val / blockSize tm * blockSize tm + + index.val % blockSize tm = index.val := + Nat.div_add_mod' index.val (blockSize tm) + have hbound : + index.val / blockSize tm * blockSize tm + + index.val % blockSize tm < width + 1 := by + omega + have hbound' : + (coordinateBlock tm width index).val * blockSize tm + + (coordinateOffset tm width index).val < width + 1 := by + simpa only [coordinateBlock, coordinateOffset] using hbound + simp only [packRow] + rw [dite_eq_left hbound'] + apply congrArg row + apply Fin.ext + simpa only [coordinateBlock, coordinateOffset] using hcoordinate + +/-- GapCVP reduction support. -/ +def leftBlock (width : ℕ) + (index : Fin (width + 1)) : Fin (width + 1) := + ⟨index.val - 1, + Nat.lt_of_le_of_lt (Nat.sub_le _ _) index.isLt⟩ + +/-- GapCVP reduction support. -/ +def rightBlock (width : ℕ) + (index : Fin (width + 1)) : Fin (width + 1) := + ⟨min (index.val + 1) width, + Nat.lt_succ_of_le (Nat.min_le_right _ _)⟩ + +@[simp] theorem leftBlock_zero (width : ℕ) : + leftBlock width (0 : Fin (width + 1)) = 0 := by + apply Fin.ext + rfl + +end CLLocalWindows + +namespace CLLocalRules + +open Computability GapCVP.CLLocalWindows + +/-- GapCVP reduction support. -/ +abbrev SummaryBlockCell (tm : Turing.FinTM2) := + BlockCell tm × BlockCell tm + +instance instFintypeSummaryBlockCell (tm : Turing.FinTM2) : + Fintype (SummaryBlockCell tm) := by + infer_instance + +end CLLocalRules + +namespace CLTableauStitching + +open Computability GapCVP.CLLocalWindows + +theorem leftBlock_succ (width : ℕ) (index : Fin width) : + leftBlock width index.succ = index.castSucc := by + apply Fin.ext + simp only [leftBlock, Fin.val_succ, add_tsub_cancel_right, Fin.val_castSucc] + +end CLTableauStitching + +namespace CLExactLocalRules + +open Computability GapCVP.CLBoundedStates GapCVP.CLCellRows GapCVP.CLLocalWindows + +/-- GapCVP reduction support. -/ +abbrev GuessPhaseWindow := PhaseTag × PhaseTag × PhaseTag × PhaseTag + +/-- GapCVP reduction support. -/ +noncomputable def GuessPhaseAllowed (window : GuessPhaseWindow) : Bool := + @decide ( + (window.2.1 = .accepting ∧ + window.2.2.1 = .guessing ∧ + (window.2.2.2 = .guessing ∨ + window.2.2.2 = .verifying)) ∨ + (window.2.1 ≠ .accepting ∧ + window.1 = .accepting ∧ + window.2.2.2 = .accepting) ∨ + (window.2.1 ≠ .accepting ∧ + window.1 ≠ .accepting ∧ + window.2.2.2 = window.2.1) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def guessPhaseWindowAt (width : ℕ) + (first next : List Bool) + (index : Fin (width + 1)) : GuessPhaseWindow := + (certificatePhase first (leftBlock width index).val, + certificatePhase first index.val, + certificatePhase first (rightBlock width index).val, + certificatePhase next index.val) + +theorem certificatePhase_append_before + (certificate : List Bool) (bit : Bool) (index : ℕ) + (hindex : index < certificate.length) : + certificatePhase (certificate ++ [bit]) index = + certificatePhase certificate index := by + have happend : index < (certificate ++ [bit]).length := by + simp only [List.length_append, List.length_singleton] + omega + rw [certificatePhase_bit (certificate ++ [bit]) index happend, + certificatePhase_bit certificate index hindex] + simp only [List.get_eq_getElem, List.getElem_append_left hindex] + +theorem certificatePhase_append_old_marker + (certificate : List Bool) (bit : Bool) : + certificatePhase (certificate ++ [bit]) certificate.length = + if bit then PhaseTag.verifying else PhaseTag.guessing := by + cases bit <;> + simp [certificatePhase] + +theorem certificatePhase_append_new_marker + (certificate : List Bool) (bit : Bool) : + certificatePhase (certificate ++ [bit]) + (certificate.length + 1) = .accepting := by + have hlength : (certificate ++ [bit]).length = + certificate.length + 1 := by simp only [List.length_append, List.length_cons, + List.length_nil, + zero_add] + rw [← hlength] + exact certificatePhase_end (certificate ++ [bit]) + +theorem certificatePhase_after + (certificate : List Bool) (index : ℕ) + (hindex : certificate.length < index) : + certificatePhase certificate index = .guessing := by + have hnot : ¬ index < certificate.length := by omega + have hne : index ≠ certificate.length := by omega + simp only [certificatePhase, hnot, ↓reduceDIte, hne, ↓reduceIte] + +theorem certificatePhase_append_after + (certificate : List Bool) (bit : Bool) (index : ℕ) + (hindex : certificate.length + 1 < index) : + certificatePhase (certificate ++ [bit]) index = + certificatePhase certificate index := by + have hfirst : certificate.length < index := by omega + have hnext : (certificate ++ [bit]).length < index := by + simp only [List.length_append, List.length_singleton] + omega + rw [certificatePhase_after (certificate ++ [bit]) index hnext, + certificatePhase_after certificate index hfirst] + +theorem guessPhaseWindow_of_append + (width : ℕ) (certificate : List Bool) (bit : Bool) + (hspace : certificate.length < width) + (index : Fin (width + 1)) : + GuessPhaseAllowed + (guessPhaseWindowAt width certificate + (certificate ++ [bit]) index) := by + simp only [GapCVP.CLExactLocalRules.GuessPhaseAllowed, decide_eq_true_eq] at * + by_cases hmarker : index.val = certificate.length + · have hright : + (rightBlock width index).val = certificate.length + 1 := by + change min (index.val + 1) width = certificate.length + 1 + rw [Nat.min_eq_left (by omega)] + omega + refine Or.inl ⟨?_, ?_, ?_⟩ + · change certificatePhase certificate index.val = .accepting + rw [hmarker] + exact certificatePhase_end certificate + · change + certificatePhase certificate + (rightBlock width index).val = .guessing + rw [hright] + exact certificatePhase_after certificate + (certificate.length + 1) (by omega) + · change + certificatePhase (certificate ++ [bit]) index.val = .guessing ∨ + certificatePhase (certificate ++ [bit]) index.val = .verifying + rw [hmarker, certificatePhase_append_old_marker] + cases bit <;> simp + · by_cases hsuccessor : index.val = certificate.length + 1 + · have hleft : + (leftBlock width index).val = certificate.length := by + change index.val - 1 = certificate.length + omega + refine Or.inr (Or.inl ⟨?_, ?_, ?_⟩) + · change certificatePhase certificate index.val ≠ .accepting + intro haccept + exact hmarker + ((certificatePhase_accepting_iff + certificate index.val).mp haccept) + · change + certificatePhase certificate + (leftBlock width index).val = .accepting + rw [hleft] + exact certificatePhase_end certificate + · change + certificatePhase (certificate ++ [bit]) index.val = .accepting + rw [hsuccessor] + exact certificatePhase_append_new_marker certificate bit + · have hleftNe : + (leftBlock width index).val ≠ certificate.length := by + change index.val - 1 ≠ certificate.length + intro heq + omega + refine Or.inr (Or.inr ⟨?_, ?_, ?_⟩) + · change certificatePhase certificate index.val ≠ .accepting + intro haccept + exact hmarker + ((certificatePhase_accepting_iff + certificate index.val).mp haccept) + · change + certificatePhase certificate + (leftBlock width index).val ≠ .accepting + intro haccept + exact hleftNe + ((certificatePhase_accepting_iff certificate + (leftBlock width index).val).mp haccept) + · change + certificatePhase (certificate ++ [bit]) index.val = + certificatePhase certificate index.val + by_cases hbefore : index.val < certificate.length + · exact certificatePhase_append_before + certificate bit index.val hbefore + · have hafter : certificate.length + 1 < index.val := by + omega + exact certificatePhase_append_after + certificate bit index.val hafter + +end CLExactLocalRules + +namespace CLExactStackRules + +open Computability GapCVP.CLBoundedStates GapCVP.CLPushAlphabet + +/-- GapCVP reduction support. -/ +noncomputable def SupportedStackValue + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (value : machine.tm.Γ stack) : Bool := + @decide ( + ∃ atom : CellAtom machine.tm, + cellAtomValue machine stack atom = some value + ) (Classical.propDecidable _) + +theorem stackAtomSupported_supportedValues + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (configuration : machine.tm.Cfg) + (supported : StackAtomSupported machine configuration) + (stack : machine.tm.K) : + ∀ value ∈ configuration.stk stack, + SupportedStackValue machine stack value := by + have raw := supported + simp only [StackAtomSupported, decide_eq_true_eq] at raw + intro value membership + simpa only [SupportedStackValue, decide_eq_true_eq] using + raw stack value membership + +/-- GapCVP reduction support. -/ +def canonicalCellAtom + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (value : machine.tm.Γ stack) + (hsupported : SupportedStackValue machine stack value) : + CellAtom machine.tm := + Classical.choose + (by simpa only [SupportedStackValue, decide_eq_true_eq] using hsupported) + +theorem canonicalCellAtom_decode + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (value : machine.tm.Γ stack) + (hsupported : SupportedStackValue machine stack value) : + cellAtomValue machine stack + (canonicalCellAtom machine stack value hsupported) = + some value := by + unfold canonicalCellAtom + exact Classical.choose_spec + (by simpa only [SupportedStackValue, decide_eq_true_eq] using hsupported) + +/-- GapCVP reduction support. -/ +def canonicalStackAtoms + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (values : List (machine.tm.Γ stack)) + (hsupported : ∀ value ∈ values, + SupportedStackValue machine stack value) : + List (CellAtom machine.tm) := + List.pmap (canonicalCellAtom machine stack) values hsupported + +theorem canonicalStackAtoms_length + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (values : List (machine.tm.Γ stack)) + (hsupported : ∀ value ∈ values, + SupportedStackValue machine stack value) : + (canonicalStackAtoms machine stack values hsupported).length = + values.length := by + simp only [canonicalStackAtoms, List.length_pmap] + +theorem canonicalStackAtoms_forall₂ + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (values : List (machine.tm.Γ stack)) + (hsupported : ∀ value ∈ values, + SupportedStackValue machine stack value) : + List.Forall₂ + (fun atom value => + cellAtomValue machine stack atom = some value) + (canonicalStackAtoms machine stack values hsupported) + values := by + induction values with + | nil => + exact .nil + | cons value values ih => + have hhead : SupportedStackValue machine stack value := + hsupported value (by simp only [List.mem_cons, true_or]) + have htail : ∀ candidate ∈ values, + SupportedStackValue machine stack candidate := by + intro candidate hcandidate + exact hsupported candidate (by simp only [List.mem_cons, hcandidate, or_true]) + change List.Forall₂ + (fun atom candidate => + cellAtomValue machine stack atom = some candidate) + (canonicalCellAtom machine stack value hhead :: + canonicalStackAtoms machine stack values htail) + (value :: values) + exact .cons + (canonicalCellAtom_decode machine stack value hhead) + (ih htail) + +private theorem supportedStackValue_of_mem_drop + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (values : List (machine.tm.Γ stack)) + (hsupported : ∀ value ∈ values, + SupportedStackValue machine stack value) + (count : ℕ) : + ∀ value ∈ values.drop count, + SupportedStackValue machine stack value := by + intro value hvalue + exact hsupported value (List.mem_of_mem_drop hvalue) + +private theorem canonicalStackAtoms_drop + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (values : List (machine.tm.Γ stack)) + (hsupported : ∀ value ∈ values, + SupportedStackValue machine stack value) + (count : ℕ) : + (canonicalStackAtoms machine stack values hsupported).drop count = + canonicalStackAtoms machine stack (values.drop count) + (supportedStackValue_of_mem_drop + machine stack values hsupported count) := by + induction count generalizing values with + | zero => + simp only [List.drop_zero] + | succ count ih => + cases values with + | nil => + simp only [canonicalStackAtoms, List.pmap_nil, List.drop_nil] + | cons value values => + have htail : ∀ candidate ∈ values, + SupportedStackValue machine stack candidate := by + intro candidate hcandidate + exact hsupported candidate (by simp only [List.mem_cons, hcandidate, or_true]) + simpa only [canonicalStackAtoms, List.pmap, List.drop_succ_cons] using ih values htail + +private theorem canonicalStackAtoms_congr + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (first next : List (machine.tm.Γ stack)) + (hfirst : ∀ value ∈ first, + SupportedStackValue machine stack value) + (hnext : ∀ value ∈ next, + SupportedStackValue machine stack value) + (heq : first = next) : + canonicalStackAtoms machine stack first hfirst = + canonicalStackAtoms machine stack next hnext := by + subst next + rfl + +private theorem canonicalStackAtoms_common_suffix + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (first next : List (machine.tm.Γ stack)) + (hfirst : ∀ value ∈ first, + SupportedStackValue machine stack value) + (hnext : ∀ value ∈ next, + SupportedStackValue machine stack value) + (firstDrop nextDrop : ℕ) + (hcommon : first.drop firstDrop = next.drop nextDrop) : + (canonicalStackAtoms machine stack first hfirst).drop firstDrop = + (canonicalStackAtoms machine stack next hnext).drop nextDrop := by + rw [canonicalStackAtoms_drop, canonicalStackAtoms_drop] + exact canonicalStackAtoms_congr machine stack + (first.drop firstDrop) (next.drop nextDrop) + (supportedStackValue_of_mem_drop + machine stack first hfirst firstDrop) + (supportedStackValue_of_mem_drop + machine stack next hnext nextDrop) + hcommon + +end CLExactStackRules + +namespace CLExactVerifierRules + +open Computability GapCVP.CLLocalWindows + +/-- GapCVP reduction support. -/ +noncomputable def StackPrefixAgreement + {K : Type} {Γ : K → Type} + (radius : ℕ) + (first next : ∀ stack : K, List (Γ stack)) : Bool := + @decide ( + ∀ stack : K, + (first stack).take radius = (next stack).take radius + ) (Classical.propDecidable _) +theorem stackPrefixAgreement_mono + {K : Type} {Γ : K → Type} + {small large : ℕ} + {first next : ∀ stack : K, List (Γ stack)} + (hbound : small ≤ large) + (hagreement : StackPrefixAgreement large first next) : + StackPrefixAgreement small first next := by + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] at * + intro stack + have h := congrArg (List.take small) (hagreement stack) + simpa only [List.take_take, Nat.min_eq_left hbound] using h + +private theorem stackPrefixAgreement_head + {K : Type} {Γ : K → Type} + {radius : ℕ} + {first next : ∀ stack : K, List (Γ stack)} + (hpositive : 0 < radius) + (hagreement : StackPrefixAgreement radius first next) + (stack : K) : + (first stack).head? = (next stack).head? := by + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] at * + have h := congrArg List.head? (hagreement stack) + have hnonzero : radius ≠ 0 := by omega + simpa only [List.head?_take, hnonzero, ↓reduceIte] using h + +private theorem stackPrefixAgreement_push + {K : Type} {Γ : K → Type} [DecidableEq K] + (radius : ℕ) + (first next : ∀ stack : K, List (Γ stack)) + (stack : K) (value : Γ stack) + (hagreement : StackPrefixAgreement radius first next) : + StackPrefixAgreement radius + (Function.update first stack (value :: first stack)) + (Function.update next stack (value :: next stack)) := by + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] + have hraw := hagreement + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] at hraw + intro target + by_cases htarget : target = stack + · subst target + cases radius with + | zero => simp only [Function.update_self, List.take_zero] + | succ radius => + have hsmaller : + StackPrefixAgreement radius first next := + stackPrefixAgreement_mono (by omega) hagreement + have hsmaller' := hsmaller + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] + at hsmaller' + simpa only [Function.update_self, List.take_succ_cons, List.cons.injEq, true_and] + using hsmaller' stack + · simpa only [Function.update, htarget, ↓reduceDIte] using hraw target + +private theorem stackPrefixAgreement_pop + {K : Type} {Γ : K → Type} [DecidableEq K] + (radius : ℕ) + (first next : ∀ stack : K, List (Γ stack)) + (stack : K) + (hagreement : StackPrefixAgreement (radius + 1) first next) : + StackPrefixAgreement radius + (Function.update first stack (first stack).tail) + (Function.update next stack (next stack).tail) := by + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] + have hraw := hagreement + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] at hraw + intro target + by_cases htarget : target = stack + · subst target + have h := congrArg List.tail (hraw stack) + simpa only [Function.update_self, List.tail_take_eq_take_tail, add_tsub_cancel_right] using h + · have hsmaller : StackPrefixAgreement radius first next := + stackPrefixAgreement_mono (by omega) hagreement + have hsmaller' := hsmaller + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] at hsmaller' + simpa only [Function.update, htarget, ↓reduceDIte] using hsmaller' target + +theorem statementLookahead_le_blockSize + (tm : Turing.FinTM2) (label : tm.Λ) : + statementStackActions (tm.m label) + 1 ≤ blockSize tm := by + have h := statementStackActions_le_max tm label + simp only [blockSize] + omega + +end CLExactVerifierRules + +namespace CLCompleteLocalCompiler + +open Computability GapCVP.CLBoundedStates GapCVP.CLCellRows GapCVP.CLLocalWindows + +private theorem paddedAtom_common_suffix + (tm : Turing.FinTM2) + (first next : List (CellAtom tm)) + (firstDrop nextDrop index : ℕ) + (hcommon : first.drop firstDrop = next.drop nextDrop) + (hindex : nextDrop ≤ index) : + paddedAtom next index = + paddedAtom first (index - nextDrop + firstDrop) := by + have h := congrArg + (fun values : List (CellAtom tm) => + values[index - nextDrop]?) hcommon + simp only [List.getElem?_drop] at h + have hleft : nextDrop + (index - nextDrop) = index := by + omega + have hright : + firstDrop + (index - nextDrop) = + index - nextDrop + firstDrop := by omega + rw [hright, hleft] at h + exact congrArg + (fun value : Option (CellAtom tm) => value.getD none) + h.symm + +/-- GapCVP reduction support. -/ +abbrev AtomBlock (tm : Turing.FinTM2) := + Fin (blockSize tm) → CellAtom tm + +instance instFintypeAtomBlock (tm : Turing.FinTM2) : + Fintype (AtomBlock tm) := by + infer_instance + +/-- GapCVP reduction support. -/ +abbrev SingleStackHint (tm : Turing.FinTM2) := + Fin (blockSize tm) × Fin (blockSize tm) × AtomBlock tm + +instance instFintypeSingleStackHint (tm : Turing.FinTM2) : + Fintype (SingleStackHint tm) := by + infer_instance + +/-- GapCVP reduction support. -/ +def atomBlockAt (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) (index : ℕ) : AtomBlock tm := + fun offset => + paddedAtom atoms (index * blockSize tm + offset.val) + +/-- GapCVP reduction support. -/ +abbrev StackShiftWindow (tm : Turing.FinTM2) := + AtomBlock tm × AtomBlock tm × AtomBlock tm × AtomBlock tm × Bool + +/-- GapCVP reduction support. -/ +def stackShiftWindowAt (tm : Turing.FinTM2) (width : ℕ) + (first next : List (CellAtom tm)) + (index : Fin (width + 1)) : StackShiftWindow tm := + (atomBlockAt tm first (leftBlock width index).val, + atomBlockAt tm first index.val, + atomBlockAt tm first (rightBlock width index).val, + atomBlockAt tm next index.val, + decide (index.val = 0)) + +/-- GapCVP reduction support. -/ +def shiftedWindowAtom (tm : Turing.FinTM2) + (hint : SingleStackHint tm) + (window : StackShiftWindow tm) + (offset : Fin (blockSize tm)) : CellAtom tm := + if window.2.2.2.2 = true ∧ offset.val < hint.2.1.val then + hint.2.2 offset + else if hleft : offset.val + hint.1.val < hint.2.1.val then + window.1 + ⟨blockSize tm + (offset.val + hint.1.val) - hint.2.1.val, + by + have hnext := hint.2.1.isLt + omega⟩ + else + let shifted := offset.val + hint.1.val - hint.2.1.val + if hcenter : shifted < blockSize tm then + window.2.1 ⟨shifted, hcenter⟩ + else + window.2.2.1 + ⟨shifted - blockSize tm, by + have hoffset := offset.isLt + have hdrop := hint.1.isLt + omega⟩ + +/-- GapCVP reduction support. -/ +noncomputable def StackShiftAllowed (tm : Turing.FinTM2) + (hint : SingleStackHint tm) + (window : StackShiftWindow tm) : Bool := + @decide ( + ∀ offset : Fin (blockSize tm), + window.2.2.2.1 offset = shiftedWindowAtom tm hint window offset + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def stackShiftAllowed (tm : Turing.FinTM2) + (hint : SingleStackHint tm) + (window : StackShiftWindow tm) : Bool := by + classical + exact decide (StackShiftAllowed tm hint window) + +theorem stackShiftAllowed_iff (tm : Turing.FinTM2) + (hint : SingleStackHint tm) + (window : StackShiftWindow tm) : + stackShiftAllowed tm hint window = true ↔ + StackShiftAllowed tm hint window := by + classical + simp only [stackShiftAllowed, Bool.decide_eq_true] + +end CLCompleteLocalCompiler + +namespace CLStackShiftSoundness2 + +open Computability GapCVP.CLBoundedStates GapCVP.CLPushAlphabet GapCVP.CLCellRows +open GapCVP.CLExactStackRules GapCVP.CLCompleteLocalCompiler + +/-- GapCVP reduction support. -/ +noncomputable def NoBlankAtoms (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) : Bool := + @decide ( + ∀ atom ∈ atoms, atom ≠ none + ) (Classical.propDecidable _) +private theorem canonicalCellAtom_ne_blank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (value : machine.tm.Γ stack) + (hsupported : SupportedStackValue machine stack value) : + canonicalCellAtom machine stack value hsupported ≠ none := by + intro hblank + have hdecode := + canonicalCellAtom_decode machine stack value hsupported + rw [hblank, cellAtomValue_blank] at hdecode + cases hdecode + +private theorem canonicalStackAtoms_no_blank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (values : List (machine.tm.Γ stack)) + (hsupported : ∀ value ∈ values, + SupportedStackValue machine stack value) : + NoBlankAtoms machine.tm + (canonicalStackAtoms machine stack values hsupported) := by + simp only [GapCVP.CLStackShiftSoundness2.NoBlankAtoms, decide_eq_true_eq] + intro atom hmem + change atom ∈ + List.pmap (canonicalCellAtom machine stack) + values hsupported at hmem + obtain ⟨value, hvalue, heq⟩ := List.mem_pmap.mp hmem + subst atom + exact canonicalCellAtom_ne_blank + machine stack value (hsupported value hvalue) + +private theorem paddedAtom_eq_iff_getElem + (tm : Turing.FinTM2) + (first next : List (CellAtom tm)) + (hfirst : NoBlankAtoms tm first) + (hnext : NoBlankAtoms tm next) + (firstIndex nextIndex : ℕ) : + paddedAtom first firstIndex = paddedAtom next nextIndex ↔ + first[firstIndex]? = next[nextIndex]? := by + simp only [GapCVP.CLStackShiftSoundness2.NoBlankAtoms, decide_eq_true_eq] at * + constructor + · intro heq + cases hfirstEntry : first[firstIndex]? with + | none => + cases hnextEntry : next[nextIndex]? with + | none => rfl + | some atom => + have hmem := List.mem_of_getElem? hnextEntry + have hnonblank := hnext atom hmem + have hblank : none = atom := by + simpa only [paddedAtom, hfirstEntry, Option.getD_none, hnextEntry, Option.getD_some] + using heq + exact False.elim (hnonblank hblank.symm) + | some atom => + cases hnextEntry : next[nextIndex]? with + | none => + have hmem := List.mem_of_getElem? hfirstEntry + have hnonblank := hfirst atom hmem + have hblank : atom = none := by + simpa only [paddedAtom, hfirstEntry, Option.getD_some, hnextEntry, Option.getD_none] + using heq + exact False.elim (hnonblank hblank) + | some candidate => + have hvalue : atom = candidate := by + simpa only [paddedAtom, hfirstEntry, Option.getD_some, hnextEntry] using heq + simp only [hvalue] + · intro heq + exact congrArg + (fun value : Option (CellAtom tm) => value.getD none) + heq + +theorem atomSuffix_iff_paddedShift + (tm : Turing.FinTM2) + (first next : List (CellAtom tm)) + (hfirst : NoBlankAtoms tm first) + (hnext : NoBlankAtoms tm next) + (firstDrop nextDrop : ℕ) : + first.drop firstDrop = next.drop nextDrop ↔ + ∀ index : ℕ, + paddedAtom first (firstDrop + index) = + paddedAtom next (nextDrop + index) := by + constructor + · intro hcommon index + have h := paddedAtom_common_suffix tm first next + firstDrop nextDrop (nextDrop + index) + hcommon (by omega) + have harith : + nextDrop + index - nextDrop + firstDrop = + firstDrop + index := by omega + simpa only [add_tsub_cancel_left, Nat.add_comm] using h.symm + · intro hshift + apply List.ext_getElem? + intro index + simp only [List.getElem?_drop] + exact (paddedAtom_eq_iff_getElem tm first next + hfirst hnext (firstDrop + index) + (nextDrop + index)).mp (hshift index) + +end CLStackShiftSoundness2 + +namespace CLFiniteShiftWindows + +open Computability GapCVP.CLBoundedStates GapCVP.CLCellRows +open GapCVP.CLLocalWindows GapCVP.CLCompleteLocalCompiler + +theorem paddedAtom_none_of_length_le + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) + (index : ℕ) + (hindex : atoms.length ≤ index) : + paddedAtom atoms index = none := by + simp only [paddedAtom, List.getElem?_eq_none hindex, Option.getD_none] + +/-- GapCVP reduction support. -/ +noncomputable def AllStackShiftWindows (tm : Turing.FinTM2) (width : ℕ) + (hint : SingleStackHint tm) + (first next : List (CellAtom tm)) : Bool := + @decide ( + ∀ index : Fin (width + 1), + stackShiftAllowed tm hint + (stackShiftWindowAt tm width first next index) = true + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def PrefixHintCorrect (tm : Turing.FinTM2) + (hint : SingleStackHint tm) + (next : List (CellAtom tm)) : Bool := + @decide ( + ∀ offset : Fin (blockSize tm), + offset.val < hint.2.1.val → + hint.2.2 offset = paddedAtom next offset.val + ) (Classical.propDecidable _) +theorem width_le_block_capacity + (tm : Turing.FinTM2) (width : ℕ) : + width ≤ width * blockSize tm := by + have h := Nat.mul_le_mul_left width (blockSize_pos tm) + simpa only [ge_iff_le, Nat.succ_eq_add_one, zero_add, mul_one] using h + +theorem shiftedWindowAtom_eq_old + (tm : Turing.FinTM2) (width : ℕ) + (first next : List (CellAtom tm)) + (hfirstLength : first.length ≤ width) + (hint : SingleStackHint tm) + (index : Fin (width + 1)) + (offset : Fin (blockSize tm)) + (hnotPrefix : ¬ + (index.val = 0 ∧ offset.val < hint.2.1.val)) : + shiftedWindowAtom tm hint + (stackShiftWindowAt tm width first next index) + offset = + paddedAtom first + (index.val * blockSize tm + offset.val - + hint.2.1.val + hint.1.val) := by + have hguard : ¬ + ((stackShiftWindowAt tm width first next index).2.2.2.2 = true ∧ + offset.val < hint.2.1.val) := by + simpa only [stackShiftWindowAt, Fin.val_eq_zero_iff, decide_eq_true_eq, Fin.val_fin_lt, + not_and, not_lt] using + hnotPrefix + have hglobal : + hint.2.1.val ≤ + index.val * blockSize tm + offset.val := by + by_cases hzero : index.val = 0 + · have hoffset : hint.2.1.val ≤ offset.val := by + by_contra hsmall + exact hnotPrefix ⟨hzero, by omega⟩ + simp only [hzero, zero_mul, zero_add, hoffset] + · have hpositive : 1 ≤ index.val := by omega + have hcapacity := + Nat.mul_le_mul_right (blockSize tm) hpositive + have hdrop := hint.2.1.isLt + simp only [Nat.one_mul] at hcapacity + omega + simp only [shiftedWindowAtom, hguard, ↓reduceIte] + by_cases hleft : offset.val + hint.1.val < hint.2.1.val + · simp only [dite_eq_left hleft, stackShiftWindowAt, atomBlockAt] + have hnonzero : index.val ≠ 0 := by + intro hzero + exact hnotPrefix ⟨hzero, by omega⟩ + have hindex : 0 < index.val := by omega + have hmul : + (index.val - 1) * blockSize tm + blockSize tm = + index.val * blockSize tm := by + have hsucc : index.val - 1 + 1 = index.val := by omega + have h := congrArg + (fun value : ℕ => value * blockSize tm) hsucc + simpa only [Nat.add_mul, one_mul] using h + congr 1 + change + (index.val - 1) * blockSize tm + + (blockSize tm + (offset.val + hint.1.val) - + hint.2.1.val) = + index.val * blockSize tm + offset.val - + hint.2.1.val + hint.1.val + omega + · simp only [dite_eq_right hleft] + let shifted := offset.val + hint.1.val - hint.2.1.val + have hglobalShift : + index.val * blockSize tm + offset.val - + hint.2.1.val + hint.1.val = + index.val * blockSize tm + shifted := by + dsimp [shifted] + omega + by_cases hcenter : shifted < blockSize tm + · have hcenter' : + offset.val + hint.1.val - hint.2.1.val < + blockSize tm := by + simpa only using hcenter + simp only [dite_eq_left hcenter', stackShiftWindowAt, + atomBlockAt] + congr 1 + exact hglobalShift.symm + · have hcenter' : + ¬ offset.val + hint.1.val - hint.2.1.val < + blockSize tm := by + simpa only [not_lt] using hcenter + simp only [dite_eq_right hcenter', stackShiftWindowAt, + atomBlockAt] + by_cases hlast : index.val = width + · have hcapacity := width_le_block_capacity tm width + have hleftBlank : + first.length ≤ + (rightBlock width index).val * blockSize tm + + (shifted - blockSize tm) := by + have hright : (rightBlock width index).val = width := by + change min (index.val + 1) width = width + simp only [hlast, le_add_iff_nonneg_right, zero_le, inf_of_le_right] + rw [hright] + omega + have hrightBlank : + first.length ≤ + index.val * blockSize tm + offset.val - + hint.2.1.val + hint.1.val := by + rw [hglobalShift] + rw [hlast] + omega + rw [paddedAtom_none_of_length_le tm first _ hleftBlank, + paddedAtom_none_of_length_le tm first _ hrightBlank] + · have hright : + (rightBlock width index).val = index.val + 1 := by + change min (index.val + 1) width = index.val + 1 + exact Nat.min_eq_left (by + have hbound := index.isLt + omega) + rw [hright] + congr 1 + have hmul : + (index.val + 1) * blockSize tm = + index.val * blockSize tm + blockSize tm := by + simp only [Nat.add_mul, one_mul] + rw [hglobalShift] + omega + +end CLFiniteShiftWindows + +namespace CLStackWindowEquivalence + +open Computability GapCVP.CLBoundedStates GapCVP.CLCellRows GapCVP.CLLocalWindows +open GapCVP.CLCompleteLocalCompiler GapCVP.CLStackShiftSoundness2 GapCVP.CLFiniteShiftWindows + +private theorem not_first_prefix_implies_drop_le + (tm : Turing.FinTM2) + (hint : SingleStackHint tm) + (index : ℕ) + (offset : Fin (blockSize tm)) + (hnot : ¬ (index = 0 ∧ offset.val < hint.2.1.val)) : + hint.2.1.val ≤ index * blockSize tm + offset.val := by + by_cases hzero : index = 0 + · have hoffset : hint.2.1.val ≤ offset.val := by + by_contra hsmall + exact hnot ⟨hzero, by omega⟩ + simp only [hzero, zero_mul, zero_add, hoffset] + · have hpositive : 1 ≤ index := by omega + have hcapacity := + Nat.mul_le_mul_right (blockSize tm) hpositive + have hdrop := hint.2.1.isLt + simp only [Nat.one_mul] at hcapacity + omega + +private theorem stackShiftWindow_of_common_suffix + (tm : Turing.FinTM2) + (width : ℕ) + (first next : List (CellAtom tm)) + (hfirstLength : first.length ≤ width) + (hint : SingleStackHint tm) + (hcommon : first.drop hint.1.val = next.drop hint.2.1.val) + (hprefix : PrefixHintCorrect tm hint next) + (index : Fin (width + 1)) : + StackShiftAllowed tm hint + (stackShiftWindowAt tm width first next index) := by + simp only [GapCVP.CLFiniteShiftWindows.PrefixHintCorrect, + GapCVP.CLCompleteLocalCompiler.StackShiftAllowed, decide_eq_true_eq] at * + intro offset + change + paddedAtom next (index.val * blockSize tm + offset.val) = + shiftedWindowAtom tm hint + (stackShiftWindowAt tm width first next index) offset + by_cases hprefixPosition : + index.val = 0 ∧ offset.val < hint.2.1.val + · have hguard : + (stackShiftWindowAt tm width first next index).2.2.2.2 = true ∧ + offset.val < hint.2.1.val := by + simpa only [stackShiftWindowAt, Fin.val_eq_zero_iff, decide_eq_true_eq, Fin.val_fin_lt] + using hprefixPosition + rw [shiftedWindowAtom, ite_eq_left hguard] + have hcorrect := hprefix offset hprefixPosition.2 + simpa only [hprefixPosition.1, zero_mul, zero_add] using hcorrect.symm + · rw [shiftedWindowAtom_eq_old tm width first next + hfirstLength hint index offset hprefixPosition] + exact paddedAtom_common_suffix tm first next + hint.1.val hint.2.1.val + (index.val * blockSize tm + offset.val) hcommon + (not_first_prefix_implies_drop_le tm hint index.val + offset hprefixPosition) + +private theorem allStackShiftWindows_of_common_suffix + (tm : Turing.FinTM2) + (width : ℕ) + (first next : List (CellAtom tm)) + (hfirstLength : first.length ≤ width) + (hint : SingleStackHint tm) + (hcommon : first.drop hint.1.val = next.drop hint.2.1.val) + (hprefix : PrefixHintCorrect tm hint next) : + AllStackShiftWindows tm width hint first next := by + simp only [GapCVP.CLFiniteShiftWindows.AllStackShiftWindows, decide_eq_true_eq] + intro index + exact (stackShiftAllowed_iff tm hint + (stackShiftWindowAt tm width first next index)).mpr + (stackShiftWindow_of_common_suffix tm width first next + hfirstLength hint hcommon hprefix index) + +private theorem paddedShift_of_allStackShiftWindows + (tm : Turing.FinTM2) + (width : ℕ) + (first next : List (CellAtom tm)) + (hfirstLength : first.length ≤ width) + (hnextLength : next.length ≤ width) + (hint : SingleStackHint tm) + (hwindows : AllStackShiftWindows tm width hint first next) : + ∀ position : ℕ, + paddedAtom first (hint.1.val + position) = + paddedAtom next (hint.2.1.val + position) := by + simp only [GapCVP.CLFiniteShiftWindows.AllStackShiftWindows, decide_eq_true_eq] at hwindows + intro position + let global := hint.2.1.val + position + by_cases hcovered : + global < (width + 1) * blockSize tm + · let index : Fin (width + 1) := + ⟨global / blockSize tm, + (Nat.div_lt_iff_lt_mul (blockSize_pos tm)).mpr hcovered⟩ + let offset : Fin (blockSize tm) := + ⟨global % blockSize tm, + Nat.mod_lt global (blockSize_pos tm)⟩ + have hcoordinate : + index.val * blockSize tm + offset.val = global := by + dsimp [index, offset] + simpa only [Nat.mul_comm, Nat.add_comm] using Nat.mod_add_div global (blockSize tm) + have hnotPrefix : + ¬ (index.val = 0 ∧ offset.val < hint.2.1.val) := by + rintro ⟨hzero, hsmall⟩ + have hactual : + index.val * blockSize tm + offset.val = + hint.2.1.val + position := by + simpa only using hcoordinate + rw [hzero, Nat.zero_mul, Nat.zero_add] at hactual + omega + have hallowed : + StackShiftAllowed tm hint + (stackShiftWindowAt tm width first next index) := + (stackShiftAllowed_iff tm hint + (stackShiftWindowAt tm width first next index)).mp + (hwindows index) + simp only [GapCVP.CLCompleteLocalCompiler.StackShiftAllowed, decide_eq_true_eq] at hallowed + have hlocal := hallowed offset + change + paddedAtom next + (index.val * blockSize tm + offset.val) = + shiftedWindowAtom tm hint + (stackShiftWindowAt tm width first next index) offset + at hlocal + rw [shiftedWindowAtom_eq_old tm width first next + hfirstLength hint index offset hnotPrefix] at hlocal + rw [hcoordinate] at hlocal + have holdCoordinate : + global - hint.2.1.val + hint.1.val = + hint.1.val + position := by + dsimp [global] + omega + rw [holdCoordinate] at hlocal + simpa only using hlocal.symm + · have hbeyond : + (width + 1) * blockSize tm ≤ global := by omega + have hcapacity := width_le_block_capacity tm width + have hdrop := hint.2.1.isLt + have hcapacityForm : + (width + 1) * blockSize tm = + width * blockSize tm + blockSize tm := by + simp only [Nat.add_mul, one_mul] + rw [hcapacityForm] at hbeyond + dsimp [global] at hbeyond + have hfirstEnd : first.length ≤ hint.1.val + position := by + omega + have hnextEnd : next.length ≤ hint.2.1.val + position := by + omega + rw [paddedAtom_none_of_length_le tm first _ hfirstEnd, + paddedAtom_none_of_length_le tm next _ hnextEnd] + +private theorem allStackShiftWindows_iff_common_suffix + (tm : Turing.FinTM2) + (width : ℕ) + (first next : List (CellAtom tm)) + (hfirstLength : first.length ≤ width) + (hnextLength : next.length ≤ width) + (hfirstNoBlank : NoBlankAtoms tm first) + (hnextNoBlank : NoBlankAtoms tm next) + (hint : SingleStackHint tm) + (hprefix : PrefixHintCorrect tm hint next) : + AllStackShiftWindows tm width hint first next ↔ + first.drop hint.1.val = next.drop hint.2.1.val := by + constructor + · intro hwindows + exact (atomSuffix_iff_paddedShift tm first next + hfirstNoBlank hnextNoBlank + hint.1.val hint.2.1.val).mpr + (paddedShift_of_allStackShiftWindows tm width first next + hfirstLength hnextLength hint hwindows) + · intro hcommon + exact allStackShiftWindows_of_common_suffix tm width first next + hfirstLength hint hcommon hprefix + +end CLStackWindowEquivalence + +namespace CLExactVerifierTransition + +open Computability GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLExactStackRules +open GapCVP.CLCompleteLocalCompiler GapCVP.CLFiniteShiftWindows + +/-- GapCVP reduction support. -/ +abbrev FiniteVerifierHint (tm : Turing.FinTM2) := + ∀ _ : tm.K, SingleStackHint tm + +instance instFintypeFiniteVerifierHint (tm : Turing.FinTM2) : + Fintype (FiniteVerifierHint tm) := by + letI : Fintype tm.K := tm.kFin + infer_instance + +/-- GapCVP reduction support. -/ +noncomputable def AllVerifierStackWindows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hint : FiniteVerifierHint machine.tm) : Bool := + @decide ( + ∀ stack : machine.tm.K, + AllStackShiftWindows machine.tm width (hint stack) + (canonicalStackAtoms machine stack (first.stk stack) + (stackAtomSupported_supportedValues machine first hfirst stack)) + (canonicalStackAtoms machine stack (next.stk stack) + (stackAtomSupported_supportedValues machine next hnext stack)) + ) (Classical.propDecidable _) +private theorem canonicalStackAtoms_injective + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (first next : List (machine.tm.Γ stack)) + (hfirst : ∀ value ∈ first, + SupportedStackValue machine stack value) + (hnext : ∀ value ∈ next, + SupportedStackValue machine stack value) + (hatoms : canonicalStackAtoms machine stack first hfirst = + canonicalStackAtoms machine stack next hnext) : + first = next := by + apply List.ext_getElem? + intro index + have hfirstDecode := paddedAtom_decode machine stack + (canonicalStackAtoms_forall₂ machine stack first hfirst) index + have hnextDecode := paddedAtom_decode machine stack + (canonicalStackAtoms_forall₂ machine stack next hnext) index + rw [hatoms] at hfirstDecode + exact hfirstDecode.symm.trans hnextDecode + +end CLExactVerifierTransition + +namespace CLEmittedCNFTM + +open Computability Turing + +private abbrev LookupMemory (limit : ℕ) := + Fin (limit + 1) × (Fin limit → Bool) × Bool + +private def initialLookupMemory (limit : ℕ) : LookupMemory limit := + (0, fun _ => false, false) + +private def advanceLookupMemory (limit : ℕ) + (memory : LookupMemory limit) (bit : Bool) : + LookupMemory limit := + if h : memory.1.val < limit then + (⟨memory.1.val + 1, by omega⟩, + Function.update memory.2.1 ⟨memory.1.val, h⟩ bit, + memory.2.2) + else + (memory.1, memory.2.1, true) + +private def lookupMemoryBits (limit : ℕ) + (memory : LookupMemory limit) : List Bool := + (List.ofFn memory.2.1).take memory.1.val + +private def lookupMemoryOutput (limit : ℕ) + (table : List Bool → Bool) + (memory : LookupMemory limit) : Bool := + if memory.2.2 then false else table (lookupMemoryBits limit memory) + +private abbrev boundedLookupMachine (limit : ℕ) + (table : List Bool → Bool) : Turing.FinTM2 where + K := Bool + k₀ := false + k₁ := true + Γ _ := Bool + Λ := Unit + main := () + σ := LookupMemory limit × Option Bool + initialState := (initialLookupMemory limit, none) + m _ := + .peek false (fun state symbol => (state.1, symbol)) + (.branch (fun state => state.2.isSome) + (.pop false + (fun state _ => + (advanceLookupMemory limit state.1 + (state.2.getD false), none)) + (.goto (fun _ => ()))) + (.push true + (fun state => lookupMemoryOutput limit table state.1) + (.load (fun _ => (initialLookupMemory limit, none)) + .halt))) + +private def lookupConfiguration (limit : ℕ) + (table : List Bool → Bool) + (remaining : List Bool) + (memory : LookupMemory limit) : + (boundedLookupMachine limit table).Cfg where + l := some () + var := (memory, none) + stk + | false => remaining + | true => [] + +private theorem boundedLookupMachine_step_cons + (limit : ℕ) + (table : List Bool → Bool) + (bit : Bool) + (remaining : List Bool) + (memory : LookupMemory limit) : + (boundedLookupMachine limit table).step + (lookupConfiguration limit table (bit :: remaining) memory) = + some (lookupConfiguration limit table remaining + (advanceLookupMemory limit memory bit)) := by + cases bit <;> + simp only [boundedLookupMachine, lookupConfiguration, + Turing.FinTM2.step, Turing.TM2.step, + Turing.TM2.stepAux, List.head?_cons, Option.isSome_some, + Option.getD_some, List.tail_cons, Bool.cond_true] <;> + congr 2 <;> + funext stack <;> + cases stack <;> + simp [Function.update] + +private theorem boundedLookupMachine_step_nil + (limit : ℕ) + (table : List Bool → Bool) + (memory : LookupMemory limit) : + (boundedLookupMachine limit table).step + (lookupConfiguration limit table [] memory) = + some (Turing.haltList (boundedLookupMachine limit table) + [lookupMemoryOutput limit table memory]) := by + simp only [boundedLookupMachine, FinTM2.step, TM2.step, lookupConfiguration, TM2.stepAux, + List.head?_nil, + Option.isSome_none, Option.getD_none, List.tail_nil, Function.update_eq_self, + Bool.cond_false, + haltList, eq_mpr_eq_cast, + cast_eq, dite_eq_ite] + congr 2 + funext stack + cases stack <;> simp [Function.update] + +/-- GapCVP reduction support. -/ +def boundedLookupOutput (limit : ℕ) + (table : List Bool → Bool) + (input : List Bool) : Bool := + lookupMemoryOutput limit table + (input.foldl (advanceLookupMemory limit) + (initialLookupMemory limit)) + +private theorem boundedLookupMachine_iterate + (limit : ℕ) + (table : List Bool → Bool) + (input : List Bool) + (memory : LookupMemory limit) : + ((flip Option.bind (boundedLookupMachine limit table).step)^[ + input.length + 1]) + (some (lookupConfiguration limit table input memory)) = + some (Turing.haltList (boundedLookupMachine limit table) + [lookupMemoryOutput limit table + (input.foldl (advanceLookupMemory limit) memory)]) := by + induction input generalizing memory with + | nil => + change + (boundedLookupMachine limit table).step + (lookupConfiguration limit table [] memory) = _ + exact boundedLookupMachine_step_nil limit table memory + | cons bit remaining ih => + change + ((flip Option.bind (boundedLookupMachine limit table).step)^[ + remaining.length + 1 + 1]) + (some (lookupConfiguration limit table + (bit :: remaining) memory)) = _ + rw [Function.iterate_succ_apply] + change + ((flip Option.bind (boundedLookupMachine limit table).step)^[ + remaining.length + 1]) + ((boundedLookupMachine limit table).step + (lookupConfiguration limit table + (bit :: remaining) memory)) = _ + rw [boundedLookupMachine_step_cons] + exact ih (advanceLookupMemory limit memory bit) + +private theorem boundedLookupMachine_init + (limit : ℕ) + (table : List Bool → Bool) + (input : List Bool) : + Turing.initList (boundedLookupMachine limit table) input = + lookupConfiguration limit table input + (initialLookupMemory limit) := by + simp only [boundedLookupMachine, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + lookupConfiguration] + congr 1 + funext stack + cases stack <;> simp + +/-- GapCVP reduction support. -/ +noncomputable def boundedLookupComputable + (limit : ℕ) + (table : List Bool → Bool) : + BitTM + (fun input : List Bool => + [boundedLookupOutput limit table input]) where + tm := boundedLookupMachine limit table + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := Polynomial.X + 1 + outputsFun input := { + steps := input.length + 1 + evals_in_steps := by + have hinput : + List.map (Equiv.refl Bool).invFun (bitEncoding input) = + input := by + change List.map (fun bit : Bool => bit) input = input + simp only [List.map_id_fun', id_eq] + have houtput : + List.map (Equiv.refl Bool).invFun + (bitEncoding [boundedLookupOutput limit table input]) = + [boundedLookupOutput limit table input] := by + change + List.map (fun bit : Bool => bit) + [boundedLookupOutput limit table input] = + [boundedLookupOutput limit table input] + simp only [List.map_cons, List.map_nil] + rw [hinput, houtput, boundedLookupMachine_init] + exact boundedLookupMachine_iterate limit table input + (initialLookupMemory limit) + steps_le_m := by + simp only [bitEncoding, id_eq, Polynomial.eval_add, Polynomial.eval_X, Polynomial.eval_one, + Std.le_refl] + } + +end CLEmittedCNFTM + +namespace CLWindowTruthTable + +open Computability Turing GapCVP.CLEmittedCNFTM + +private theorem lookupMemoryBits_advance + (limit : ℕ) + (memory : LookupMemory limit) + (bit : Bool) + (hcapacity : memory.1.val < limit) : + lookupMemoryBits limit + (advanceLookupMemory limit memory bit) = + lookupMemoryBits limit memory ++ [bit] := by + have hcountLe : memory.1.val ≤ limit := by omega + apply List.ext_getElem? + intro index + by_cases hbefore : index < memory.1.val + · have hlimit : index < limit := Nat.lt_trans hbefore hcapacity + have hne : + (⟨index, hlimit⟩ : Fin limit) ≠ + ⟨memory.1.val, hcapacity⟩ := by + intro heq + have hval := congrArg Fin.val heq + change index = memory.1.val at hval + omega + have hle : index ≤ memory.1.val := by omega + simp only [lookupMemoryBits, advanceLookupMemory, hcapacity, ↓reduceDIte, List.length_take, + List.length_ofFn, + Order.add_one_le_iff, inf_of_le_left, Order.lt_add_one_iff, hle, getElem?_pos, + List.getElem_take, List.getElem_ofFn, + Function.update, hne, List.length_append, Nat.min_eq_left hcountLe, List.length_cons, + List.length_nil, zero_add, + hbefore, List.getElem_append_left] + · by_cases hat : index = memory.1.val + · subst index + simp only [lookupMemoryBits, advanceLookupMemory, hcapacity, ↓reduceDIte, List.length_take, + List.length_ofFn, + Order.add_one_le_iff, inf_of_le_left, lt_add_iff_pos_right, Order.lt_one_iff, + getElem?_pos, List.getElem_take, + List.getElem_ofFn, Function.update, List.length_append, Nat.min_eq_left hcountLe, + List.length_cons, List.length_nil, + zero_add, Std.le_refl, List.getElem_append_right, tsub_self, List.getElem_cons_zero] + · have hafter : memory.1.val + 1 ≤ index := by omega + have hnotNew : ¬ index < memory.1.val + 1 := by omega + simp only [lookupMemoryBits, advanceLookupMemory, hcapacity, ↓reduceDIte, List.length_take, + List.length_ofFn, + Order.add_one_le_iff, inf_of_le_left, hnotNew, not_false_eq_true, getElem?_neg, + List.length_append, + Nat.min_eq_left hcountLe, List.length_cons, List.length_nil, zero_add] + +private theorem lookupMemory_fold_exact + (limit : ℕ) + (memory : LookupMemory limit) + (input : List Bool) + (hcapacity : memory.1.val + input.length ≤ limit) + (hoverflow : memory.2.2 = false) : + lookupMemoryBits limit + (input.foldl (advanceLookupMemory limit) memory) = + lookupMemoryBits limit memory ++ input ∧ + (input.foldl (advanceLookupMemory limit) memory).2.2 = false := by + induction input generalizing memory with + | nil => + simp only [List.foldl_nil, List.append_nil, hoverflow, and_self] + | cons bit remaining ih => + have hhead : memory.1.val < limit := by + simp only [List.length_cons] at hcapacity + omega + let nextMemory := advanceLookupMemory limit memory bit + have hnextCount : nextMemory.1.val = memory.1.val + 1 := by + simp only [advanceLookupMemory, hhead, ↓reduceDIte, nextMemory] + have hnextOverflow : nextMemory.2.2 = false := by + simp only [advanceLookupMemory, hhead, ↓reduceDIte, hoverflow, nextMemory] + have hnextCapacity : + nextMemory.1.val + remaining.length ≤ limit := by + simp only [List.length_cons] at hcapacity + rw [hnextCount] + omega + have htail := ih nextMemory hnextCapacity hnextOverflow + simp only [List.foldl_cons] + constructor + · calc + lookupMemoryBits limit + (remaining.foldl (advanceLookupMemory limit) nextMemory) = + lookupMemoryBits limit nextMemory ++ remaining := htail.1 + _ = (lookupMemoryBits limit memory ++ [bit]) ++ + remaining := by + rw [show + lookupMemoryBits limit nextMemory = + lookupMemoryBits limit memory ++ [bit] from + lookupMemoryBits_advance limit memory bit hhead] + _ = lookupMemoryBits limit memory ++ (bit :: remaining) := by + simp only [List.append_assoc, List.cons_append, List.nil_append] + · exact htail.2 + +theorem boundedLookupOutput_of_length_le + (limit : ℕ) + (table : List Bool → Bool) + (input : List Bool) + (hinput : input.length ≤ limit) : + boundedLookupOutput limit table input = table input := by + have hcapacity : + (initialLookupMemory limit).1.val + input.length ≤ limit := by + simpa only [initialLookupMemory, Fin.coe_ofNat_eq_mod, Nat.zero_mod, zero_add] using hinput + have hoverflow : + (initialLookupMemory limit).2.2 = false := rfl + obtain ⟨hbits, hnotOverflow⟩ := + lookupMemory_fold_exact limit (initialLookupMemory limit) + input hcapacity hoverflow + have hbits' : + lookupMemoryBits limit + (input.foldl (advanceLookupMemory limit) + (initialLookupMemory limit)) = input := by + simpa only [lookupMemoryBits, initialLookupMemory, Fin.coe_ofNat_eq_mod, Nat.zero_mod, + List.ofFn_const, + List.take_replicate, zero_le, inf_of_le_left, List.replicate_zero, List.nil_append] + using hbits + simp only [boundedLookupOutput, lookupMemoryOutput, hnotOverflow, Bool.false_eq_true, ↓reduceIte, + hbits'] + +end CLWindowTruthTable + +namespace CLLocalTableauCompiler + +open Computability Turing GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLLocalWindows +open GapCVP.CLExactStackRules GapCVP.CLExactVerifierRules GapCVP.CLCompleteLocalCompiler + +theorem filterMap_ofFn_getElem + {α : Type} + (values : List α) + (width : ℕ) : + (List.ofFn (fun index : Fin width => + values[index.val]?)).filterMap id = + values.take width := by + induction width generalizing values with + | zero => simp only [id_eq, List.ofFn_zero, List.filterMap_nil, List.take_zero] + | succ width ih => + cases values with + | nil => + simp only [id_eq, List.length_nil, not_lt_zero, not_false_eq_true, getElem?_neg, + List.ofFn_succ, + List.ofFn_const, List.filterMap_cons_none, List.filterMap_replicate_of_none, + List.take_nil] + | cons value rest => + simpa only [id_eq, List.ofFn_succ, Fin.coe_ofNat_eq_mod, Nat.zero_mod, List.length_cons, + lt_add_iff_pos_left, + Order.lt_add_one_iff, zero_le, getElem?_pos, List.getElem_cons_zero, Fin.val_succ, + List.getElem?_cons_succ, + Option.some.injEq, List.filterMap_cons_some, List.take_succ_cons, List.cons.injEq, + true_and] using ih rest + +/-- GapCVP reduction support. -/ +def decodedAtomBlock + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (block : AtomBlock machine.tm) : + List (machine.tm.Γ stack) := + (List.ofFn (fun index : Fin (blockSize machine.tm) => + cellAtomValue machine stack (block index))).filterMap id + +theorem decodedAtomBlock_canonical + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (values : List (machine.tm.Γ stack)) + (hsupported : ∀ value ∈ values, + SupportedStackValue machine stack value) : + decodedAtomBlock machine stack + (atomBlockAt machine.tm + (canonicalStackAtoms machine stack values hsupported) 0) = + values.take (blockSize machine.tm) := by + have hpointwise : + (fun index : Fin (blockSize machine.tm) => + cellAtomValue machine stack + ((atomBlockAt machine.tm + (canonicalStackAtoms machine stack values hsupported) 0) + index)) = + (fun index : Fin (blockSize machine.tm) => + values[index.val]?) := by + funext index + simpa only [atomBlockAt, zero_mul, zero_add] using + paddedAtom_decode machine stack (canonicalStackAtoms_forall₂ machine stack values + hsupported) index.val + unfold decodedAtomBlock + rw [hpointwise] + exact filterMap_ofFn_getElem values (blockSize machine.tm) + +/-- GapCVP reduction support. -/ +abbrev FiniteVerifierHeadQuery (tm : Turing.FinTM2) := + (Option tm.Λ × tm.σ) × + (tm.K → AtomBlock tm) × + (Option tm.Λ × tm.σ) + +/-- GapCVP reduction support. -/ +def finiteHeadConfiguration + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (control : Option machine.tm.Λ × machine.tm.σ) + (heads : machine.tm.K → AtomBlock machine.tm) : + machine.tm.Cfg where + l := control.1 + var := control.2 + stk stack := decodedAtomBlock machine stack (heads stack) + +private def finiteHeadQueryOf + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) : + FiniteVerifierHeadQuery machine.tm := + ((first.l, first.var), + (fun stack => atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)) 0), + (next.l, next.var)) + +private theorem finiteHeadConfiguration_prefix + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (configuration : machine.tm.Cfg) + (hsupported : StackAtomSupported machine configuration) : + StackPrefixAgreement (blockSize machine.tm) + configuration.stk + (finiteHeadConfiguration machine + (configuration.l, configuration.var) + (fun stack => atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (configuration.stk stack) (stackAtomSupported_supportedValues machine configuration + hsupported stack)) 0)).stk := by + simp only [GapCVP.CLExactVerifierRules.StackPrefixAgreement, decide_eq_true_eq] + intro stack + change + (configuration.stk stack).take (blockSize machine.tm) = + (decodedAtomBlock machine stack + (atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (configuration.stk stack) (stackAtomSupported_supportedValues machine configuration + hsupported stack)) 0)).take + (blockSize machine.tm) + rw [decodedAtomBlock_canonical] + simp only [List.take_self_eq_iff, List.length_take, inf_le_left] + +end CLLocalTableauCompiler + +namespace CLVerifierTableauEmission + +open Computability Turing GapCVP.CLBoundedStates GapCVP.CLCellRows GapCVP.CLLocalWindows +open GapCVP.CLCompleteLocalCompiler GapCVP.CLFiniteShiftWindows + +theorem prefixHintCorrect_of_allStackShiftWindows + (tm : Turing.FinTM2) + (width : ℕ) + (first next : List (CellAtom tm)) + (hint : SingleStackHint tm) + (hwindows : AllStackShiftWindows tm width hint first next) : + PrefixHintCorrect tm hint next := by + simp only [GapCVP.CLFiniteShiftWindows.PrefixHintCorrect, decide_eq_true_eq] + simp only [GapCVP.CLFiniteShiftWindows.AllStackShiftWindows, decide_eq_true_eq] at hwindows + intro offset hoffset + let firstIndex : Fin (width + 1) := 0 + have hallowed : + StackShiftAllowed tm hint + (stackShiftWindowAt tm width first next firstIndex) := + (stackShiftAllowed_iff tm hint + (stackShiftWindowAt tm width first next firstIndex)).mp + (hwindows firstIndex) + simp only [GapCVP.CLCompleteLocalCompiler.StackShiftAllowed, decide_eq_true_eq] at hallowed + have hcell := hallowed offset + change + paddedAtom next + (firstIndex.val * blockSize tm + offset.val) = + shiftedWindowAtom tm hint + (stackShiftWindowAt tm width first next firstIndex) + offset at hcell + have hguard : + (stackShiftWindowAt tm width first next firstIndex).2.2.2.2 = + true ∧ + offset.val < hint.2.1.val := by + simp [stackShiftWindowAt, firstIndex, hoffset] + rw [shiftedWindowAtom, ite_eq_left hguard] at hcell + simpa [firstIndex] using hcell.symm + +end CLVerifierTableauEmission + +namespace CLUnconditionalTableau + +open Computability Turing GapCVP.CLLocalWindows GapCVP.CLExactVerifierRules + +/-- GapCVP reduction support. -/ +structure PrefixScript {K : Type} (Γ : K → Type) where + /-- GapCVP reduction support. -/ + dropped : K → ℕ + /-- GapCVP reduction support. -/ + pushed : ∀ stack : K, List (Γ stack) + +/-- GapCVP reduction support. -/ +def scriptStacks {K : Type} {Γ : K → Type} + (original : ∀ stack : K, List (Γ stack)) + (script : PrefixScript Γ) : + ∀ stack : K, List (Γ stack) := + fun stack => + script.pushed stack ++ + (original stack).drop (script.dropped stack) + +/-- GapCVP reduction support. -/ +def emptyPrefixScript {K : Type} (Γ : K → Type) : + PrefixScript Γ where + dropped _ := 0 + pushed _ := [] + +@[simp] theorem scriptStacks_empty + {K : Type} {Γ : K → Type} + (original : ∀ stack : K, List (Γ stack)) : + scriptStacks original (emptyPrefixScript Γ) = original := by + funext stack + simp only [scriptStacks, emptyPrefixScript, List.drop_zero, List.nil_append] + +private def pushPrefixScript + {K : Type} {Γ : K → Type} [DecidableEq K] + (script : PrefixScript Γ) + (stack : K) (value : Γ stack) : PrefixScript Γ where + dropped := script.dropped + pushed := Function.update script.pushed stack + (value :: script.pushed stack) + +private theorem scriptStacks_push + {K : Type} {Γ : K → Type} [DecidableEq K] + (original : ∀ stack : K, List (Γ stack)) + (script : PrefixScript Γ) + (stack : K) (value : Γ stack) : + scriptStacks original (pushPrefixScript script stack value) = + Function.update (scriptStacks original script) + stack (value :: scriptStacks original script stack) := by + funext target + by_cases htarget : target = stack + · subst target + simp only [scriptStacks, pushPrefixScript, Function.update_self, List.cons_append] + · simp only [scriptStacks, pushPrefixScript, Function.update, htarget, ↓reduceDIte] + +private def popPrefixScript + {K : Type} {Γ : K → Type} [DecidableEq K] + (script : PrefixScript Γ) + (stack : K) : PrefixScript Γ := + match script.pushed stack with + | [] => + { dropped := Function.update script.dropped stack + (script.dropped stack + 1) + pushed := script.pushed } + | _ :: tail => + { dropped := script.dropped + pushed := Function.update script.pushed stack tail } + +private theorem scriptStacks_pop + {K : Type} {Γ : K → Type} [DecidableEq K] + (original : ∀ stack : K, List (Γ stack)) + (script : PrefixScript Γ) + (stack : K) : + scriptStacks original (popPrefixScript script stack) = + Function.update (scriptStacks original script) + stack (scriptStacks original script stack).tail := by + funext target + by_cases htarget : target = stack + · subst target + cases hhead : script.pushed stack with + | nil => + simp only [scriptStacks, popPrefixScript, hhead, Function.update_self, List.nil_append, + List.tail_drop] + | cons head tail => + simp only [scriptStacks, popPrefixScript, hhead, Function.update_self, List.cons_append, + List.tail_cons] + · cases hhead : script.pushed stack with + | nil => + simp only [scriptStacks, popPrefixScript, hhead, Function.update, htarget, ↓reduceDIte] + | cons head tail => + simp only [scriptStacks, popPrefixScript, hhead, Function.update, htarget, ↓reduceDIte] + +/-- GapCVP reduction support. -/ +def executePrefixScript + {K : Type} {Γ : K → Type} {Λ σ : Type} + [DecidableEq K] : + Turing.TM2.Stmt Γ Λ σ → σ → + (∀ stack : K, List (Γ stack)) → + PrefixScript Γ → + Option Λ × σ × PrefixScript Γ + | .push stack value continuation, state, original, script => + executePrefixScript continuation state original + (pushPrefixScript script stack (value state)) + | .peek stack update continuation, state, original, script => + executePrefixScript continuation + (update state (scriptStacks original script stack).head?) + original script + | .pop stack update continuation, state, original, script => + executePrefixScript continuation + (update state (scriptStacks original script stack).head?) + original (popPrefixScript script stack) + | .load update continuation, state, original, script => + executePrefixScript continuation (update state) original script + | .branch test yes no, state, original, script => + if test state then + executePrefixScript yes state original script + else + executePrefixScript no state original script + | .goto update, state, _, script => + (some (update state), state, script) + | .halt, state, _, script => + (none, state, script) + +theorem executePrefixScript_correct + {K : Type} {Γ : K → Type} {Λ σ : Type} + [DecidableEq K] + (statement : Turing.TM2.Stmt Γ Λ σ) + (state : σ) + (original : ∀ stack : K, List (Γ stack)) + (script : PrefixScript Γ) : + Turing.TM2.stepAux statement state + (scriptStacks original script) = + { l := (executePrefixScript statement state original script).1 + var := + (executePrefixScript statement state original script).2.1 + stk := scriptStacks original + (executePrefixScript statement state original script).2.2 } := by + induction statement generalizing state script with + | push stack value continuation ih => + simpa only [TM2.stepAux, executePrefixScript, scriptStacks_push] using + ih state (pushPrefixScript script stack (value state)) + | peek stack update continuation ih => + simpa only [TM2.stepAux, executePrefixScript] using + ih (update state (scriptStacks original script stack).head?) script + | pop stack update continuation ih => + simpa only [TM2.stepAux, executePrefixScript, scriptStacks_pop] using + ih (update state (scriptStacks original script stack).head?) (popPrefixScript script + stack) + | load update continuation ih => + simpa only [TM2.stepAux, executePrefixScript] using ih (update state) script + | branch test yes no ihyes ihno => + cases htest : test state with + | false => + simpa only [TM2.stepAux, htest, Bool.cond_false, executePrefixScript, Bool.false_eq_true, + ↓reduceIte] using + ihno state script + | true => + simpa only [TM2.stepAux, htest, Bool.cond_true, executePrefixScript, ↓reduceIte] + using ihyes + state script + | goto update => + rfl + | halt => + rfl + +theorem executePrefixScript_of_prefix + {K : Type} {Γ : K → Type} {Λ σ : Type} + [DecidableEq K] + (statement : Turing.TM2.Stmt Γ Λ σ) + (state : σ) + (first second : ∀ stack : K, List (Γ stack)) + (script : PrefixScript Γ) + (hagreement : StackPrefixAgreement + (statementStackActions statement + 1) + (scriptStacks first script) + (scriptStacks second script)) : + executePrefixScript statement state first script = + executePrefixScript statement state second script := by + induction statement generalizing state first second script with + | push stack value continuation ih => + change StackPrefixAgreement + (statementStackActions continuation + 1 + 1) + (scriptStacks first script) + (scriptStacks second script) at hagreement + have hsmaller : StackPrefixAgreement + (statementStackActions continuation + 1) + (scriptStacks first script) + (scriptStacks second script) := + stackPrefixAgreement_mono (by omega) hagreement + have hupdated := stackPrefixAgreement_push + (statementStackActions continuation + 1) + (scriptStacks first script) + (scriptStacks second script) + stack (value state) hsmaller + rw [← scriptStacks_push first script stack (value state), + ← scriptStacks_push second script stack (value state)] + at hupdated + simpa only [executePrefixScript] using + ih state first second (pushPrefixScript script stack (value state)) hupdated + | peek stack update continuation ih => + have hhead : + (scriptStacks first script stack).head? = + (scriptStacks second script stack).head? := + stackPrefixAgreement_head (by omega) hagreement stack + have hnext := ih + (update state (scriptStacks first script stack).head?) + first second script hagreement + simpa only [executePrefixScript, hhead] using hnext + | pop stack update continuation ih => + change StackPrefixAgreement + (statementStackActions continuation + 1 + 1) + (scriptStacks first script) + (scriptStacks second script) at hagreement + have hhead : + (scriptStacks first script stack).head? = + (scriptStacks second script stack).head? := + stackPrefixAgreement_head (by omega) hagreement stack + have hupdated := stackPrefixAgreement_pop + (statementStackActions continuation + 1) + (scriptStacks first script) + (scriptStacks second script) + stack hagreement + rw [← scriptStacks_pop first script stack, + ← scriptStacks_pop second script stack] at hupdated + have hnext := ih + (update state (scriptStacks first script stack).head?) + first second (popPrefixScript script stack) hupdated + simpa only [executePrefixScript, hhead] using hnext + | load update continuation ih => + simpa only [executePrefixScript] using ih (update state) first second script hagreement + | branch test yes no ihyes ihno => + change StackPrefixAgreement + (max (statementStackActions yes) + (statementStackActions no) + 1) + (scriptStacks first script) + (scriptStacks second script) at hagreement + cases htest : test state with + | false => + have hsmaller : StackPrefixAgreement + (statementStackActions no + 1) + (scriptStacks first script) + (scriptStacks second script) := + stackPrefixAgreement_mono + (Nat.add_le_add_right + (Nat.le_max_right + (statementStackActions yes) + (statementStackActions no)) 1) + hagreement + simpa only [executePrefixScript, htest, Bool.false_eq_true, ↓reduceIte] using + ihno state first second script hsmaller + | true => + have hsmaller : StackPrefixAgreement + (statementStackActions yes + 1) + (scriptStacks first script) + (scriptStacks second script) := + stackPrefixAgreement_mono + (Nat.add_le_add_right + (Nat.le_max_left + (statementStackActions yes) + (statementStackActions no)) 1) + hagreement + simpa only [executePrefixScript, htest, ↓reduceIte] using ihyes state first second script + hsmaller + | goto update => + rfl + | halt => + rfl + +end CLUnconditionalTableau + +namespace CLGlobalTableauSimulation + +open Computability Turing GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLLocalWindows +open GapCVP.CLExactStackRules GapCVP.CLExactVerifierRules GapCVP.CLCompleteLocalCompiler +open GapCVP.CLStackShiftSoundness2 GapCVP.CLFiniteShiftWindows GapCVP.CLStackWindowEquivalence +open GapCVP.CLExactVerifierTransition GapCVP.CLLocalTableauCompiler +open GapCVP.CLVerifierTableauEmission GapCVP.CLUnconditionalTableau + +private theorem executePrefixScript_bounds + {K : Type} {Γ : K → Type} {Λ σ : Type} + [DecidableEq K] + (statement : Turing.TM2.Stmt Γ Λ σ) + (state : σ) + (original : ∀ stack : K, List (Γ stack)) + (script : PrefixScript Γ) + (target : K) : + (executePrefixScript statement state original script).2.2.dropped + target ≤ + script.dropped target + statementStackActions statement ∧ + ((executePrefixScript statement state original script).2.2.pushed + target).length ≤ + (script.pushed target).length + + statementStackActions statement := by + induction statement generalizing state script with + | push stack value continuation ih => + have hnext := ih state + (pushPrefixScript script stack (value state)) + by_cases htarget : target = stack + · subst target + simp only [pushPrefixScript, Function.update_self, List.length_cons, executePrefixScript, + statementStackActions] at hnext ⊢ + omega + · simp [executePrefixScript, pushPrefixScript, + statementStackActions, Function.update, htarget] + at hnext ⊢ + omega + | peek stack update continuation ih => + simpa only [executePrefixScript, statementStackActions] using + ih (update state (scriptStacks original script stack).head?) script + | pop stack update continuation ih => + have hnext := ih + (update state (scriptStacks original script stack).head?) + (popPrefixScript script stack) + by_cases htarget : target = stack + · subst target + cases hhead : script.pushed stack with + | nil => + simp only [popPrefixScript, hhead, Function.update_self, List.length_nil, zero_add, + executePrefixScript, + statementStackActions] at hnext ⊢ + omega + | cons head tail => + simp only [popPrefixScript, hhead, Function.update_self, executePrefixScript, + statementStackActions, + List.length_cons] at hnext ⊢ + omega + · cases hhead : script.pushed stack with + | nil => + simp only [popPrefixScript, hhead, Function.update, htarget, ↓reduceDIte, + executePrefixScript, + statementStackActions] at hnext ⊢ + omega + | cons head tail => + simp only [popPrefixScript, hhead, Function.update, htarget, ↓reduceDIte, + executePrefixScript, + statementStackActions] at hnext ⊢ + omega + | load update continuation ih => + simpa only [executePrefixScript, statementStackActions] using ih (update state) script + | branch test yes no ihyes ihno => + cases htest : test state with + | false => + have hnext := ihno state script + simp only [executePrefixScript, htest, Bool.false_eq_true, ↓reduceIte, + statementStackActions] at hnext ⊢ + omega + | true => + have hnext := ihyes state script + simp only [executePrefixScript, htest, ↓reduceIte, statementStackActions] at hnext ⊢ + omega + | goto update => + simp only [executePrefixScript, statementStackActions, add_zero, Std.le_refl, and_self] + | halt => + simp only [executePrefixScript, statementStackActions, add_zero, Std.le_refl, and_self] + +private theorem emptyPrefixScript_bounds + (tm : Turing.FinTM2) + (label : tm.Λ) + (state : tm.σ) + (original : ∀ stack : tm.K, List (tm.Γ stack)) + (target : tm.K) : + (executePrefixScript (tm.m label) state original + (emptyPrefixScript tm.Γ)).2.2.dropped target < + blockSize tm ∧ + ((executePrefixScript (tm.m label) state original + (emptyPrefixScript tm.Γ)).2.2.pushed target).length < + blockSize tm := by + have hbound := executePrefixScript_bounds + (tm.m label) state original + (emptyPrefixScript tm.Γ) target + have hstatement := statementStackActions_lt_blockSize tm label + have hdrop : + (executePrefixScript (tm.m label) state original + (emptyPrefixScript tm.Γ)).2.2.dropped target ≤ + statementStackActions (tm.m label) := by + simpa only [emptyPrefixScript, zero_add] using hbound.1 + have hpush : + ((executePrefixScript (tm.m label) state original + (emptyPrefixScript tm.Γ)).2.2.pushed target).length ≤ + statementStackActions (tm.m label) := by + simpa only [emptyPrefixScript, List.length_nil, zero_add] using hbound.2 + exact ⟨hdrop.trans_lt hstatement, hpush.trans_lt hstatement⟩ + +/-- GapCVP reduction support. -/ +def finiteHeadScriptRun + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (label : machine.tm.Λ) + (state : machine.tm.σ) + (heads : machine.tm.K → AtomBlock machine.tm) : + Option machine.tm.Λ × machine.tm.σ × + PrefixScript machine.tm.Γ := + executePrefixScript (machine.tm.m label) state + (finiteHeadConfiguration machine (some label, state) heads).stk + (emptyPrefixScript machine.tm.Γ) + +/-- GapCVP reduction support. -/ +abbrev ScriptVerifierQuery (tm : Turing.FinTM2) := + FiniteVerifierHeadQuery tm × + (tm.K → AtomBlock tm) × + FiniteVerifierHint tm + +/-- GapCVP reduction support. -/ +def scriptVerifierAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (query : ScriptVerifierQuery machine.tm) : Bool := by + classical + exact match query.1.1.1 with + | none => false + | some label => + let run := finiteHeadScriptRun machine label + query.1.1.2 query.1.2.1 + decide + (run.1 = query.1.2.2.1 ∧ + run.2.1 = query.1.2.2.2 ∧ + ∀ stack : machine.tm.K, + (query.2.2 stack).1.val = run.2.2.dropped stack ∧ + (query.2.2 stack).2.1.val = + (run.2.2.pushed stack).length ∧ + (decodedAtomBlock machine stack + (query.2.1 stack)).take + (run.2.2.pushed stack).length = + run.2.2.pushed stack) + +theorem scriptVerifierAllowed_iff + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (query : ScriptVerifierQuery machine.tm) : + scriptVerifierAllowed machine query = true ↔ + ∃ label : machine.tm.Λ, + query.1.1.1 = some label ∧ + let run := finiteHeadScriptRun machine label + query.1.1.2 query.1.2.1 + run.1 = query.1.2.2.1 ∧ + run.2.1 = query.1.2.2.2 ∧ + ∀ stack : machine.tm.K, + (query.2.2 stack).1.val = run.2.2.dropped stack ∧ + (query.2.2 stack).2.1.val = + (run.2.2.pushed stack).length ∧ + (decodedAtomBlock machine stack + (query.2.1 stack)).take + (run.2.2.pushed stack).length = + run.2.2.pushed stack := by + classical + cases hlabel : query.1.1.1 with + | none => simp only [scriptVerifierAllowed, hlabel, Bool.false_eq_true, reduceCtorEq, false_and, + exists_false] + | some label => simp only [scriptVerifierAllowed, hlabel, Bool.decide_and, Bool.and_eq_true, + decide_eq_true_eq, + Option.some.injEq, exists_eq_left'] + +private theorem actualStep_eq_stepAux + (tm : Turing.FinTM2) + (first next : tm.Cfg) + (label : tm.Λ) + (hlabel : first.l = some label) + (hstep : tm.step first = some next) : + Turing.TM2.stepAux (tm.m label) first.var first.stk = next := by + rcases first with ⟨sourceLabel, sourceState, sourceStacks⟩ + cases sourceLabel with + | none => + simp only [reduceCtorEq] at hlabel + | some sourceLabel => + have heq : sourceLabel = label := Option.some.inj hlabel + subst sourceLabel + exact Option.some.inj hstep + +private theorem finiteHeadScriptRun_eq_actual + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (first : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (label : machine.tm.Λ) + (hlabel : first.l = some label) : + finiteHeadScriptRun machine label first.var + (fun stack => atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)) 0) = + executePrefixScript (machine.tm.m label) first.var first.stk + (emptyPrefixScript machine.tm.Γ) := by + let heads : machine.tm.K → AtomBlock machine.tm := + fun stack => atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)) 0 + let finite := + finiteHeadConfiguration machine (some label, first.var) heads + have hblock : StackPrefixAgreement (blockSize machine.tm) + first.stk finite.stk := by + have h := finiteHeadConfiguration_prefix machine first hfirst + simpa only [hlabel] using h + have hlookahead : StackPrefixAgreement + (statementStackActions (machine.tm.m label) + 1) + first.stk finite.stk := + stackPrefixAgreement_mono + (statementLookahead_le_blockSize machine.tm label) hblock + have hscript := executePrefixScript_of_prefix + (machine.tm.m label) first.var first.stk finite.stk + (emptyPrefixScript machine.tm.Γ) (by + simpa only [scriptStacks_empty] using hlookahead) + change + executePrefixScript (machine.tm.m label) first.var finite.stk + (emptyPrefixScript machine.tm.Γ) = _ + exact hscript.symm + +/-- GapCVP reduction support. -/ +def scriptVerifierQueryOf + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hint : FiniteVerifierHint machine.tm) : + ScriptVerifierQuery machine.tm := + (finiteHeadQueryOf machine first next hfirst, + (fun stack => atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) 0), + hint) + +theorem configuration_eq_of_components + (tm : Turing.FinTM2) + (first next : tm.Cfg) + (hlabel : first.l = next.l) + (hstate : first.var = next.var) + (hstacks : first.stk = next.stk) : + first = next := by + rcases first with ⟨firstLabel, firstState, firstStacks⟩ + rcases next with ⟨nextLabel, nextState, nextStacks⟩ + change firstLabel = nextLabel at hlabel + change firstState = nextState at hstate + change firstStacks = nextStacks at hstacks + cases hlabel + cases hstate + cases hstacks + rfl + +private theorem realStackSuffix_of_allVerifierWindows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstLength : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ width) + (hnextLength : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ width) + (hint : FiniteVerifierHint machine.tm) + (hwindows : AllVerifierStackWindows machine width + first next hfirst hnext hint) + (stack : machine.tm.K) : + (first.stk stack).drop (hint stack).1.val = + (next.stk stack).drop (hint stack).2.1.val := by + have windows := hwindows + simp only [GapCVP.CLExactVerifierTransition.AllVerifierStackWindows, decide_eq_true_eq] + at windows + let firstAtoms := canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack) + let nextAtoms := canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack) + have hfirstBound : firstAtoms.length ≤ width := by + simpa [firstAtoms, canonicalStackAtoms_length] using + hfirstLength stack + have hnextBound : nextAtoms.length ≤ width := by + simpa [nextAtoms, canonicalStackAtoms_length] using + hnextLength stack + have hprefix : + PrefixHintCorrect machine.tm (hint stack) nextAtoms := + prefixHintCorrect_of_allStackShiftWindows machine.tm + width firstAtoms nextAtoms (hint stack) + (windows stack) + have hfirstNoBlank : NoBlankAtoms machine.tm firstAtoms := by + simpa [firstAtoms] using + canonicalStackAtoms_no_blank machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack) + have hnextNoBlank : NoBlankAtoms machine.tm nextAtoms := by + simpa [nextAtoms] using + canonicalStackAtoms_no_blank machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack) + have hatoms := + (allStackShiftWindows_iff_common_suffix machine.tm width + firstAtoms nextAtoms hfirstBound hnextBound + hfirstNoBlank hnextNoBlank + (hint stack) hprefix).mp (windows stack) + change + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)).drop + (hint stack).1.val = + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)).drop + (hint stack).2.1.val at hatoms + rw [canonicalStackAtoms_drop, canonicalStackAtoms_drop] at hatoms + exact canonicalStackAtoms_injective machine stack + ((first.stk stack).drop (hint stack).1.val) + ((next.stk stack).drop (hint stack).2.1.val) + (supportedStackValue_of_mem_drop machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack) (hint + stack).1.val) + (supportedStackValue_of_mem_drop machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack) (hint + stack).2.1.val) + hatoms + +theorem actualStep_of_stepAux + (tm : Turing.FinTM2) + (first next : tm.Cfg) + (label : tm.Λ) + (hlabel : first.l = some label) + (haux : Turing.TM2.stepAux (tm.m label) + first.var first.stk = next) : + tm.step first = some next := by + rcases first with ⟨sourceLabel, sourceState, sourceStacks⟩ + cases sourceLabel with + | none => + simp only [reduceCtorEq] at hlabel + | some sourceLabel => + have heq : sourceLabel = label := Option.some.inj hlabel + subst sourceLabel + exact congrArg some haux + +private theorem actualStep_of_finite_script_and_windows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstLength : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ width) + (hnextLength : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ width) + (hint : FiniteVerifierHint machine.tm) + (hscript : scriptVerifierAllowed machine + (scriptVerifierQueryOf machine first next + hfirst hnext hint) = true) + (hwindows : AllVerifierStackWindows machine width + first next hfirst hnext hint) : + machine.tm.step first = some next := by + obtain ⟨label, hlabel, hcontrol, hstate, hchecks⟩ := + (scriptVerifierAllowed_iff machine + (scriptVerifierQueryOf machine first next + hfirst hnext hint)).mp hscript + change first.l = some label at hlabel + let heads : machine.tm.K → AtomBlock machine.tm := + fun stack => atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)) 0 + let run := finiteHeadScriptRun machine label first.var heads + change run.1 = next.l at hcontrol + change run.2.1 = next.var at hstate + have hstacks : + scriptStacks first.stk run.2.2 = next.stk := by + funext stack + have hcheck := hchecks stack + change + (hint stack).1.val = run.2.2.dropped stack ∧ + (hint stack).2.1.val = + (run.2.2.pushed stack).length ∧ + (decodedAtomBlock machine stack + (atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) + 0)).take + (run.2.2.pushed stack).length = + run.2.2.pushed stack at hcheck + have hprefix := hcheck.2.2 + rw [decodedAtomBlock_canonical] at hprefix + have hprefixBound : + (run.2.2.pushed stack).length ≤ blockSize machine.tm := by + have hfin := (hint stack).2.1.isLt + omega + simp only [List.take_take, Nat.min_eq_left hprefixBound] + at hprefix + have hsuffix := realStackSuffix_of_allVerifierWindows + machine width first next hfirst hnext + hfirstLength hnextLength hint hwindows stack + rw [hcheck.1, hcheck.2.1] at hsuffix + have hnextStack : + next.stk stack = scriptStacks first.stk run.2.2 stack := by + calc + next.stk stack = + (next.stk stack).take + (run.2.2.pushed stack).length ++ + (next.stk stack).drop + (run.2.2.pushed stack).length := + (List.take_append_drop + (run.2.2.pushed stack).length (next.stk stack)).symm + _ = run.2.2.pushed stack ++ + (first.stk stack).drop + (run.2.2.dropped stack) := by + rw [hprefix, ← hsuffix] + _ = scriptStacks first.stk run.2.2 stack := rfl + exact hnextStack.symm + have hrun := finiteHeadScriptRun_eq_actual + machine first hfirst label hlabel + change + run = executePrefixScript (machine.tm.m label) + first.var first.stk (emptyPrefixScript machine.tm.Γ) + at hrun + have hexecution := executePrefixScript_correct + (machine.tm.m label) first.var first.stk + (emptyPrefixScript machine.tm.Γ) + simp only [scriptStacks_empty] at hexecution + rw [← hrun] at hexecution + have hconfiguration : + ({ l := run.1 + var := run.2.1 + stk := scriptStacks first.stk run.2.2 } : machine.tm.Cfg) = + next := + configuration_eq_of_components machine.tm _ next + hcontrol hstate hstacks + exact actualStep_of_stepAux machine.tm first next label hlabel + (hexecution.trans hconfiguration) + +private theorem actualStep_has_finite_script_and_windows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstLength : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ width) + (hstep : machine.tm.step first = some next) : + ∃ hint : FiniteVerifierHint machine.tm, + scriptVerifierAllowed machine + (scriptVerifierQueryOf machine first next + hfirst hnext hint) = true ∧ + AllVerifierStackWindows machine width + first next hfirst hnext hint := by + cases hlabel : first.l with + | none => + have hnone : machine.tm.step first = none := by + rcases first with ⟨sourceLabel, sourceState, sourceStacks⟩ + cases sourceLabel with + | none => rfl + | some sourceLabel => simp only [reduceCtorEq] at hlabel + rw [hnone] at hstep + cases hstep + | some label => + let heads : machine.tm.K → AtomBlock machine.tm := + fun stack => atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)) 0 + let run := finiteHeadScriptRun machine label first.var heads + have hbounds (stack : machine.tm.K) : + run.2.2.dropped stack < blockSize machine.tm ∧ + (run.2.2.pushed stack).length < + blockSize machine.tm := by + exact emptyPrefixScript_bounds machine.tm label first.var + (finiteHeadConfiguration machine + (some label, first.var) heads).stk stack + let hint : FiniteVerifierHint machine.tm := fun stack => + (⟨run.2.2.dropped stack, (hbounds stack).1⟩, + ⟨(run.2.2.pushed stack).length, (hbounds stack).2⟩, + fun offset => paddedAtom + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) + offset.val) + have hrun := finiteHeadScriptRun_eq_actual + machine first hfirst label hlabel + change + run = executePrefixScript (machine.tm.m label) + first.var first.stk (emptyPrefixScript machine.tm.Γ) + at hrun + have hexecution := executePrefixScript_correct + (machine.tm.m label) first.var first.stk + (emptyPrefixScript machine.tm.Γ) + simp only [scriptStacks_empty] at hexecution + rw [← hrun] at hexecution + have hactual := actualStep_eq_stepAux + machine.tm first next label hlabel hstep + have hconfiguration : + next = + ({ l := run.1 + var := run.2.1 + stk := scriptStacks first.stk run.2.2 } + : machine.tm.Cfg) := + hactual.symm.trans hexecution + have hrunLabel : run.1 = next.l := by + have h := congrArg + (fun configuration : machine.tm.Cfg => configuration.l) + hconfiguration + exact h.symm + have hrunState : run.2.1 = next.var := by + have h := congrArg + (fun configuration : machine.tm.Cfg => configuration.var) + hconfiguration + exact h.symm + have hrunStacks (stack : machine.tm.K) : + next.stk stack = + scriptStacks first.stk run.2.2 stack := by + have h := congrArg + (fun configuration : machine.tm.Cfg => + configuration.stk stack) hconfiguration + exact h + have hscriptAllowed : + scriptVerifierAllowed machine + (scriptVerifierQueryOf machine first next + hfirst hnext hint) = true := by + apply (scriptVerifierAllowed_iff machine + (scriptVerifierQueryOf machine first next + hfirst hnext hint)).mpr + refine ⟨label, hlabel, hrunLabel, hrunState, ?_⟩ + intro stack + refine ⟨rfl, rfl, ?_⟩ + change + (decodedAtomBlock machine stack + (atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) + 0)).take + (run.2.2.pushed stack).length = + run.2.2.pushed stack + rw [decodedAtomBlock_canonical] + have hle : + (run.2.2.pushed stack).length ≤ + blockSize machine.tm := + Nat.le_of_lt (hbounds stack).2 + simp only [List.take_take, Nat.min_eq_left hle] + rw [hrunStacks stack] + simp only [scriptStacks, List.take_left'] + have hallWindows : + AllVerifierStackWindows machine width + first next hfirst hnext hint := by + simp only [GapCVP.CLExactVerifierTransition.AllVerifierStackWindows, decide_eq_true_eq] + intro stack + have hfirstBound : + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst + stack)).length ≤ width := by + simpa only [canonicalStackAtoms_length] using hfirstLength stack + have hrealSuffix : + (first.stk stack).drop (run.2.2.dropped stack) = + (next.stk stack).drop + (run.2.2.pushed stack).length := by + rw [hrunStacks stack] + simp only [scriptStacks, List.drop_left'] + have hcanonicalSuffix := canonicalStackAtoms_common_suffix + machine stack (first.stk stack) (next.stk stack) + (stackAtomSupported_supportedValues machine first hfirst stack) + (stackAtomSupported_supportedValues machine next hnext stack) + (run.2.2.dropped stack) + (run.2.2.pushed stack).length hrealSuffix + have hprefix : + PrefixHintCorrect machine.tm (hint stack) + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) + := by + simp only [GapCVP.CLFiniteShiftWindows.PrefixHintCorrect, decide_eq_true_eq] + intro offset hoffset + rfl + exact allStackShiftWindows_of_common_suffix + machine.tm width + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)) + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) + hfirstBound (hint stack) + (by simpa only [hint] using hcanonicalSuffix) + hprefix + exact ⟨hint, hscriptAllowed, hallWindows⟩ + +theorem actualStep_iff_finite_script_and_windows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstLength : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ width) + (hnextLength : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ width) : + machine.tm.step first = some next ↔ + ∃ hint : FiniteVerifierHint machine.tm, + scriptVerifierAllowed machine + (scriptVerifierQueryOf machine first next + hfirst hnext hint) = true ∧ + AllVerifierStackWindows machine width + first next hfirst hnext hint := by + constructor + · exact actualStep_has_finite_script_and_windows + machine width first next hfirst hnext hfirstLength + · rintro ⟨hint, hscript, hwindows⟩ + exact actualStep_of_finite_script_and_windows + machine width first next hfirst hnext + hfirstLength hnextLength hint hscript hwindows + +end CLGlobalTableauSimulation + +namespace CLTableauSimulationCert + +open Computability Turing GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLLocalWindows +open GapCVP.CLLocalRules GapCVP.CLExactStackRules GapCVP.CLCompleteLocalCompiler +open GapCVP.CLFiniteShiftWindows GapCVP.CLExactVerifierTransition GapCVP.CLLocalTableauCompiler +open GapCVP.CLGlobalTableauSimulation + +/-- GapCVP reduction support. -/ +def stackAtomsOfBlock (tm : Turing.FinTM2) + (block : BlockCell tm) + (stack : tm.K) : AtomBlock tm := + fun offset => (block offset).2.2.1 stack + +/-- GapCVP reduction support. -/ +def machineControlOfBlock (tm : Turing.FinTM2) + (block : BlockCell tm) : Option (Option tm.Λ × tm.σ) := + match (block ⟨0, blockSize_pos tm⟩).2.1 with + | none => none + | some (label, state) => + some + ((if (block ⟨0, blockSize_pos tm⟩).2.2.2 then + some label + else + none), state) + +/-- GapCVP reduction support. -/ +abbrev ScriptBlockCell (tm : Turing.FinTM2) := + SummaryBlockCell tm × FiniteVerifierHint tm × Bool + +instance instFintypeScriptBlockCell + (tm : Turing.FinTM2) : Fintype (ScriptBlockCell tm) := by + infer_instance + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev ScriptBlockRow (tm : Turing.FinTM2) (width : ℕ) := + Fin (width + 1) → ScriptBlockCell tm + +/-- GapCVP reduction support. -/ +abbrev ScriptBlockWindow (tm : Turing.FinTM2) := + ScriptBlockCell tm × ScriptBlockCell tm × + ScriptBlockCell tm × ScriptBlockCell tm + +/-- GapCVP reduction support. -/ +def scriptBlockWindowAt (tm : Turing.FinTM2) + (width : ℕ) + (first next : ScriptBlockRow tm width) + (index : Fin (width + 1)) : ScriptBlockWindow tm := + (first (leftBlock width index), + first index, + first (rightBlock width index), + next index) + +/-- GapCVP reduction support. -/ +def canonicalVerifyingRow + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (configuration : machine.tm.Cfg) + (hsupported : StackAtomSupported machine configuration) : + CellRow machine.tm width := + fun index => + (certificatePhase certificate index.val, + some (configurationControl machine.tm configuration), + fun stack => paddedAtom + (canonicalStackAtoms machine stack + (configuration.stk stack) (stackAtomSupported_supportedValues machine configuration + hsupported stack)) index.val, + configuration.l.isSome) + +theorem stackAtomsOfBlock_pack_canonical + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (configuration : machine.tm.Cfg) + (hsupported : StackAtomSupported machine configuration) + (hstackLength : ∀ stack : machine.tm.K, + (configuration.stk stack).length ≤ width) + (index : Fin (width + 1)) + (stack : machine.tm.K) : + stackAtomsOfBlock machine.tm + (packRow machine.tm width + (canonicalVerifyingRow machine width + certificate configuration hsupported) index) stack = + atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (configuration.stk stack) (stackAtomSupported_supportedValues machine configuration + hsupported stack)) index.val := by + funext offset + by_cases hposition : + index.val * blockSize machine.tm + offset.val < width + 1 + · simp only [stackAtomsOfBlock, packRow, hposition, ↓reduceDIte, canonicalVerifyingRow, + atomBlockAt] + · have hbound : + (canonicalStackAtoms machine stack + (configuration.stk stack) (stackAtomSupported_supportedValues machine configuration + hsupported stack)).length ≤ + index.val * blockSize machine.tm + offset.val := by + have hlength := hstackLength stack + rw [canonicalStackAtoms_length] + omega + simp only [stackAtomsOfBlock, packRow, hposition, ↓reduceDIte, blankCell, atomBlockAt, + paddedAtom_none_of_length_le machine.tm + (canonicalStackAtoms machine stack (configuration.stk stack) + (stackAtomSupported_supportedValues machine configuration hsupported stack)) + (index.val * blockSize machine.tm + offset.val) hbound] + +/-- GapCVP reduction support. -/ +def canonicalScriptBlockRow + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (configuration : machine.tm.Cfg) + (hsupported : StackAtomSupported machine configuration) + (hint : FiniteVerifierHint machine.tm) : + ScriptBlockRow machine.tm width := + fun index => + ((packRow machine.tm width + (canonicalVerifyingRow machine width certificate + configuration hsupported) index, + packRow machine.tm width + (canonicalVerifyingRow machine width certificate + configuration hsupported) 0), + hint, decide (index.val = 0)) + +theorem machineControlOfBlock_pack_canonical + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (configuration : machine.tm.Cfg) + (hsupported : StackAtomSupported machine configuration) : + machineControlOfBlock machine.tm + (packRow machine.tm width + (canonicalVerifyingRow machine width + certificate configuration hsupported) 0) = + some (configuration.l, configuration.var) := by + cases hlabel : configuration.l with + | none => + simp only [machineControlOfBlock, packRow, Fin.coe_ofNat_eq_mod, Nat.zero_mod, zero_mul, + add_zero, + Order.lt_add_one_iff, zero_le, ↓reduceDIte, canonicalVerifyingRow, configurationControl, + hlabel, Option.getD_none, + Option.isSome_none, Bool.false_eq_true, ↓reduceIte] + | some label => + simp only [machineControlOfBlock, packRow, Fin.coe_ofNat_eq_mod, Nat.zero_mod, zero_mul, + add_zero, + Order.lt_add_one_iff, zero_le, ↓reduceDIte, canonicalVerifyingRow, configurationControl, + hlabel, Option.getD_some, + Option.isSome_some, ↓reduceIte] + +/-- GapCVP reduction support. -/ +def scriptQueryOfBlockWindow + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : ScriptBlockWindow machine.tm) : + Option (ScriptVerifierQuery machine.tm) := + match + machineControlOfBlock machine.tm window.2.1.1.2, + machineControlOfBlock machine.tm window.2.2.2.1.2 + with + | some firstControl, some nextControl => + some + ((firstControl, + (fun stack => stackAtomsOfBlock machine.tm + window.2.1.1.2 stack), nextControl), + (fun stack => stackAtomsOfBlock machine.tm + window.2.2.2.1.2 stack), + window.2.1.2.1) + | _, _ => none + +/-- GapCVP reduction support. -/ +def stackWindowOfScriptBlock + (tm : Turing.FinTM2) + (window : ScriptBlockWindow tm) + (stack : tm.K) : StackShiftWindow tm := + (stackAtomsOfBlock tm window.1.1.1 stack, + stackAtomsOfBlock tm window.2.1.1.1 stack, + stackAtomsOfBlock tm window.2.2.1.1.1 stack, + stackAtomsOfBlock tm window.2.2.2.1.1 stack, + window.2.1.2.2) + +/-- GapCVP reduction support. -/ +noncomputable def ScriptBlockCoherent (tm : Turing.FinTM2) + (window : ScriptBlockWindow tm) : Bool := + @decide ( + window.1.1.2 = window.2.1.1.2 ∧ + window.2.2.1.1.2 = window.2.1.1.2 ∧ + window.1.2.1 = window.2.1.2.1 ∧ + window.2.2.1.2.1 = window.2.1.2.1 ∧ + window.2.1.2.2 = window.2.2.2.2.2 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def scriptBlockAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : ScriptBlockWindow machine.tm) : Bool := by + classical + exact match scriptQueryOfBlockWindow machine window with + | none => false + | some query => + decide + (ScriptBlockCoherent machine.tm window ∧ + scriptVerifierAllowed machine query = true ∧ + ∀ stack : machine.tm.K, + stackShiftAllowed machine.tm + (window.2.1.2.1 stack) + (stackWindowOfScriptBlock machine.tm + window stack) = true) + +theorem scriptBlockAllowed_iff + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : ScriptBlockWindow machine.tm) : + scriptBlockAllowed machine window = true ↔ + ScriptBlockCoherent machine.tm window ∧ + ∃ query : ScriptVerifierQuery machine.tm, + scriptQueryOfBlockWindow machine window = some query ∧ + scriptVerifierAllowed machine query = true ∧ + ∀ stack : machine.tm.K, + stackShiftAllowed machine.tm + (window.2.1.2.1 stack) + (stackWindowOfScriptBlock machine.tm + window stack) = true := by + classical + cases hquery : scriptQueryOfBlockWindow machine window with + | none => simp only [scriptBlockAllowed, hquery, Bool.false_eq_true, reduceCtorEq, false_and, + exists_false, and_false] + | some query => simp only [scriptBlockAllowed, hquery, Bool.decide_and, Bool.decide_eq_true, + Bool.and_eq_true, + decide_eq_true_eq, Option.some.injEq, exists_eq_left'] + +private theorem canonicalScriptBlockWindow_coherent + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (firstHint nextHint : FiniteVerifierHint machine.tm) + (index : Fin (width + 1)) : + ScriptBlockCoherent machine.tm + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) + index) := by + simp only [ScriptBlockCoherent, scriptBlockWindowAt, canonicalScriptBlockRow, + Fin.val_eq_zero_iff, and_self, + decide_true] + +private theorem scriptQueryOfBlockWindow_canonical + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstLength : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ width) + (hnextLength : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ width) + (firstHint nextHint : FiniteVerifierHint machine.tm) + (index : Fin (width + 1)) : + scriptQueryOfBlockWindow machine + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) + index) = + some (scriptVerifierQueryOf machine first next + hfirst hnext firstHint) := by + simp only [scriptQueryOfBlockWindow, scriptBlockWindowAt, canonicalScriptBlockRow, + Fin.val_eq_zero_iff, + machineControlOfBlock_pack_canonical, scriptVerifierQueryOf, finiteHeadQueryOf, + Option.some.injEq, Prod.mk.injEq, + and_true, true_and] + constructor + · funext stack + exact stackAtomsOfBlock_pack_canonical machine width certificate + first hfirst hfirstLength 0 stack + · funext stack + exact stackAtomsOfBlock_pack_canonical machine width certificate + next hnext hnextLength 0 stack + +private theorem stackWindowOfScriptBlock_canonical + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstLength : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ width) + (hnextLength : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ width) + (firstHint nextHint : FiniteVerifierHint machine.tm) + (index : Fin (width + 1)) + (stack : machine.tm.K) : + stackWindowOfScriptBlock machine.tm + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) + index) stack = + stackShiftWindowAt machine.tm width + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)) + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) index + := by + simp only [stackWindowOfScriptBlock, scriptBlockWindowAt, + canonicalScriptBlockRow, stackShiftWindowAt] + rw [stackAtomsOfBlock_pack_canonical machine width certificate + first hfirst hfirstLength (leftBlock width index) stack] + rw [stackAtomsOfBlock_pack_canonical machine width certificate + first hfirst hfirstLength index stack] + rw [stackAtomsOfBlock_pack_canonical machine width certificate + first hfirst hfirstLength (rightBlock width index) stack] + rw [stackAtomsOfBlock_pack_canonical machine width certificate + next hnext hnextLength index stack] + +theorem canonicalScriptBlockWindows_iff + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstLength : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ width) + (hnextLength : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ width) + (firstHint nextHint : FiniteVerifierHint machine.tm) : + (∀ index : Fin (width + 1), + scriptBlockAllowed machine + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) + index) = true) ↔ + scriptVerifierAllowed machine + (scriptVerifierQueryOf machine first next + hfirst hnext firstHint) = true ∧ + AllVerifierStackWindows machine width + first next hfirst hnext firstHint := by + constructor + · intro hallowed + have hzero := + (scriptBlockAllowed_iff machine + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) 0)).mp (hallowed 0) + obtain ⟨_, query, hquery, hscript, _⟩ := hzero + rw [scriptQueryOfBlockWindow_canonical machine width + certificate first next hfirst hnext + hfirstLength hnextLength firstHint nextHint 0] at hquery + have hqueryEq : + scriptVerifierQueryOf machine first next + hfirst hnext firstHint = query := + Option.some.inj hquery + subst query + refine ⟨hscript, ?_⟩ + apply @decide_eq_true _ (Classical.propDecidable _) + intro stack + apply @decide_eq_true _ (Classical.propDecidable _) + intro index + have hlocal := + (scriptBlockAllowed_iff machine + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) index)).mp (hallowed index) + obtain ⟨_, _, _, _, hstack⟩ := hlocal + have hchecked := hstack stack + change + stackShiftAllowed machine.tm (firstHint stack) + (stackWindowOfScriptBlock machine.tm + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) index) stack) = true + at hchecked + rw [stackWindowOfScriptBlock_canonical machine width + certificate first next hfirst hnext + hfirstLength hnextLength firstHint nextHint + index stack] at hchecked + exact hchecked + · rintro ⟨hscript, hwindows⟩ index + have hwindows' := + @of_decide_eq_true _ (Classical.propDecidable _) hwindows + apply (scriptBlockAllowed_iff machine + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) index)).mpr + refine ⟨canonicalScriptBlockWindow_coherent + machine width certificate first next hfirst hnext + firstHint nextHint index, + scriptVerifierQueryOf machine first next + hfirst hnext firstHint, + scriptQueryOfBlockWindow_canonical + machine width certificate first next hfirst hnext + hfirstLength hnextLength firstHint nextHint index, + hscript, ?_⟩ + intro stack + change + stackShiftAllowed machine.tm (firstHint stack) + (stackWindowOfScriptBlock machine.tm + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) index) stack) = true + rw [stackWindowOfScriptBlock_canonical machine width + certificate first next hfirst hnext + hfirstLength hnextLength firstHint nextHint index stack] + exact (@of_decide_eq_true _ (Classical.propDecidable _) + (hwindows' stack)) index + +theorem actualStep_iff_canonical_block_windows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstLength : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ width) + (hnextLength : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ width) : + machine.tm.step first = some next ↔ + ∃ (firstHint nextHint : FiniteVerifierHint machine.tm), + ∀ index : Fin (width + 1), + scriptBlockAllowed machine + (scriptBlockWindowAt machine.tm width + (canonicalScriptBlockRow machine width certificate + first hfirst firstHint) + (canonicalScriptBlockRow machine width certificate + next hnext nextHint) index) = true := by + constructor + · intro hstep + obtain ⟨hint, hscript, hwindows⟩ := + (actualStep_iff_finite_script_and_windows machine width + first next hfirst hnext hfirstLength hnextLength).mp hstep + refine ⟨hint, hint, ?_⟩ + exact (canonicalScriptBlockWindows_iff machine width + certificate first next hfirst hnext + hfirstLength hnextLength hint hint).mpr + ⟨hscript, hwindows⟩ + · rintro ⟨firstHint, nextHint, hwindows⟩ + obtain ⟨hscript, hstacks⟩ := + (canonicalScriptBlockWindows_iff machine width + certificate first next hfirst hnext + hfirstLength hnextLength firstHint nextHint).mp hwindows + exact (actualStep_iff_finite_script_and_windows machine width + first next hfirst hnext hfirstLength hnextLength).mpr + ⟨firstHint, hscript, hstacks⟩ + +end CLTableauSimulationCert + +namespace CLFullTableauEmitter + +open Computability Turing GapCVP.CLLocalWindows GapCVP.CLCompleteLocalCompiler +open GapCVP.CLExactVerifierTransition GapCVP.CLTableauSimulationCert + +private def defaultSingleStackHint (tm : Turing.FinTM2) : + SingleStackHint tm := + (⟨0, blockSize_pos tm⟩, + ⟨0, blockSize_pos tm⟩, + fun _ => none) + +/-- GapCVP reduction support. -/ +def defaultVerifierHint (tm : Turing.FinTM2) : + FiniteVerifierHint tm := + fun _ => defaultSingleStackHint tm + +/-- Internal support shared across GapCVP continuation modules. -/ +def defaultScriptBlockCell (tm : Turing.FinTM2) : + ScriptBlockCell tm := + (((fun _ => blankCell tm), + (fun _ => blankCell tm)), + defaultVerifierHint tm, false) + +end CLFullTableauEmitter + +namespace CLVerifierPhaseCert + +open Computability Turing GapCVP.CLVerifier GapCVP.CLNondeterminism +open GapCVP.CLPushAlphabet GapCVP.CLStackSupport GapCVP.CLCellRowBounds + +theorem configurationTrace_stackAtomSupported + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + {output : List (machine.tm.Γ machine.tm.k₁)} + {steps : ℕ} + (trace : ConfigurationTrace machine.tm + (verifierInput machine x certificate) output steps) : + ∀ time : Fin (steps + 1), + StackAtomSupported machine (trace.configuration time) := by + have hprefix : ∀ (time : ℕ) (htime : time ≤ steps), + StackAtomSupported machine + (trace.configuration ⟨time, by omega⟩) := by + intro time htime + induction time with + | zero => + have hzero : + trace.configuration (⟨0, by omega⟩ : Fin (steps + 1)) = + Turing.initList machine.tm + (verifierInput machine x certificate) := by + simpa only [Fin.zero_eta] using trace.initial + rw [hzero] + exact initialConfiguration_stackAtomSupported + machine x certificate + | succ time ih => + have hprior : time ≤ steps := by omega + have hlt : time < steps := by omega + exact step_stackAtomSupported machine + (trace.configuration ⟨time, by omega⟩) + (trace.configuration ⟨time + 1, by omega⟩) + (trace.transition ⟨time, hlt⟩) + (ih hprior) + intro time + simpa only [Fin.eta] using hprefix time.val (by omega) + +theorem acceptedExecution_stack_length_le_rowWidth + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (time : Fin (execution.steps + 1)) + (stack : machine.tm.K) : + ((execution.trace.configuration time).stk stack).length ≤ + rowWidth bound machine x := by + have htime : time.val ≤ + (guessTimePolynomial bound machine).eval x.length := by + have hstep : time.val ≤ execution.steps := by omega + have hwitness := execution.steps_le + simp only [guessTimePolynomial, Polynomial.eval_add, + Polynomial.eval_one] + omega + calc + ((execution.trace.configuration time).stk stack).length ≤ + (verifierInput machine x execution.certificate).length + + time.val * TMComposition.maxPushPerStep machine.tm := + execution.trace.stack_length_le time stack + _ ≤ (x.length + bound.eval x.length) + + (guessTimePolynomial bound machine).eval x.length * + TMComposition.maxPushPerStep machine.tm := by + rw [verifierInput_length] + exact Nat.add_le_add + (Nat.add_le_add_left execution.certificate_le x.length) + (Nat.mul_le_mul_right + (TMComposition.maxPushPerStep machine.tm) htime) + _ ≤ rowWidth bound machine x := by + simp only [rowWidth, nondeterministicTableauDimensionPolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_X, Polynomial.eval_C, Polynomial.eval_one] + omega + +end CLVerifierPhaseCert + +namespace CLCompleteVerifierSimulation + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLBoundedStates +open GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLCellRowBounds GapCVP.CLLocalWindows +open GapCVP.CLExactLocalRules GapCVP.CLExactStackRules GapCVP.CLExactVerifierTransition +open GapCVP.CLTableauSimulationCert GapCVP.CLFullTableauEmitter + +/-- GapCVP reduction support. -/ +inductive PairedInputTag where + | bit (value : Bool ⊕ Bool) + | marker + | blank + deriving DecidableEq, Fintype + +/-- GapCVP reduction support. -/ +def pairedInputTagAt (x certificate : List Bool) + (index : ℕ) : PairedInputTag := + match (pairBitEncoding (x, certificate))[index]? with + | some value => .bit value + | none => + if index = (pairBitEncoding (x, certificate)).length then + .marker + else + .blank + +@[simp] theorem pairedInputTagAt_marker + (x certificate : List Bool) : + pairedInputTagAt x certificate (x.length + certificate.length) = + .marker := by + simp only [pairedInputTagAt, pairBitEncoding_apply, List.length_append, List.length_map, + lt_self_iff_false, + not_false_eq_true, getElem?_neg, ↓reduceIte] + +theorem pairBitEncoding_append_guess + (x certificate : List Bool) (bit : Bool) : + pairBitEncoding (x, certificate ++ [bit]) = + pairBitEncoding (x, certificate) ++ [Sum.inr bit] := by + simp only [pairBitEncoding_apply, List.map_append, List.map_cons, List.map_nil, + List.append_assoc] + +end CLCompleteVerifierSimulation + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part01B.lean b/LeanPool/GapCVP/Part01B.lean new file mode 100644 index 000000000..a890d52cb --- /dev/null +++ b/LeanPool/GapCVP/Part01B.lean @@ -0,0 +1,447 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part01A + +/-! # GapCVP proof, part 01, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CLCompleteVerifierSimulation + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLBoundedStates + +open GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLCellRowBounds GapCVP.CLLocalWindows + +open GapCVP.CLExactLocalRules GapCVP.CLExactStackRules GapCVP.CLExactVerifierTransition + +open GapCVP.CLTableauSimulationCert GapCVP.CLFullTableauEmitter + +/-- GapCVP reduction support. -/ +abbrev PairedInputBlock (tm : Turing.FinTM2) := + Fin (blockSize tm) → PairedInputTag + +instance instFintypePairedInputBlock + (tm : Turing.FinTM2) : Fintype (PairedInputBlock tm) := by + infer_instance + +/-- GapCVP reduction support. -/ +abbrev PhaseMaskBlock (tm : Turing.FinTM2) := + Fin (blockSize tm) → Bool + +instance instFintypePhaseMaskBlock + (tm : Turing.FinTM2) : Fintype (PhaseMaskBlock tm) := by + infer_instance + +/-- GapCVP reduction support. -/ +def pairedInputBlockAt (tm : Turing.FinTM2) + (width : ℕ) (x certificate : List Bool) + (position : Fin (width + 1)) : PairedInputBlock tm := + fun offset => + if position.val * blockSize tm + offset.val < width + 1 then + pairedInputTagAt x certificate + (position.val * blockSize tm + offset.val) + else + .blank + +/-- GapCVP reduction support. -/ +def phaseRangeBlockAt (tm : Turing.FinTM2) + (width : ℕ) + (position : Fin (width + 1)) : PhaseMaskBlock tm := + fun offset => + decide (position.val * blockSize tm + offset.val < width + 1) + +/-- GapCVP reduction support. -/ +def phaseBudgetBlockAt + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (position : Fin (rowWidth bound machine x + 1)) : + PhaseMaskBlock machine.tm := + fun offset => + decide + (position.val * blockSize machine.tm + offset.val < + x.length + bound.eval x.length) + +/-- GapCVP reduction support. -/ +def initialPairedAtom + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (tag : PairedInputTag) : CellAtom machine.tm := by + classical + exact match tag with + | .bit bit => + if stack = machine.tm.k₀ then + canonicalCellAtom machine machine.tm.k₀ + (machine.inputAlphabet.invFun bit) + (by + simp only [SupportedStackValue, decide_eq_true_eq] + exact ⟨some (.inl bit), + cellAtomValue_input machine bit⟩) + else + none + | .marker => none + | .blank => none + +/-- GapCVP reduction support. -/ +def initializedPhaseBlock + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (old : BlockCell machine.tm) + (payload : PairedInputBlock machine.tm) + (range : PhaseMaskBlock machine.tm) : BlockCell machine.tm := + fun offset => + if range offset then + ((old offset).1, + some + (configurationControl machine.tm + (Turing.initList machine.tm [])), + fun stack => initialPairedAtom machine stack (payload offset), + (Turing.initList machine.tm []).l.isSome) + else + blankCell machine.tm + +/-- GapCVP reduction support. -/ +structure CompletePhaseCell (tm : Turing.FinTM2) where + /-- GapCVP reduction support. -/ + mode : PhaseTag + /-- GapCVP reduction support. -/ + script : ScriptBlockCell tm + /-- GapCVP reduction support. -/ + payload : PairedInputBlock tm + /-- GapCVP reduction support. -/ + payloadHead : PairedInputBlock tm + /-- GapCVP reduction support. -/ + range : PhaseMaskBlock tm + /-- GapCVP reduction support. -/ + rangeHead : PhaseMaskBlock tm + /-- GapCVP reduction support. -/ + budget : PhaseMaskBlock tm + /-- GapCVP reduction support. -/ + guessBit : Bool + +noncomputable instance instFintypeCompletePhaseCell + (tm : Turing.FinTM2) : Fintype (CompletePhaseCell tm) := by + letI : Fintype tm.K := tm.kFin + letI : Fintype tm.Λ := tm.ΛFin + letI : Fintype tm.σ := tm.σFin + exact Fintype.ofEquiv + (PhaseTag × ScriptBlockCell tm × + PairedInputBlock tm × PairedInputBlock tm × + PhaseMaskBlock tm × PhaseMaskBlock tm × + PhaseMaskBlock tm × Bool) + { toFun := fun value => + ⟨value.1, value.2.1, value.2.2.1, + value.2.2.2.1, value.2.2.2.2.1, + value.2.2.2.2.2.1, value.2.2.2.2.2.2.1, + value.2.2.2.2.2.2.2⟩ + invFun := fun value => + (value.mode, value.script, value.payload, + value.payloadHead, value.range, value.rangeHead, + value.budget, value.guessBit) + left_inv := by + rintro ⟨mode, script, payload, payloadHead, + range, rangeHead, budget, guessBit⟩ + rfl + right_inv := by + rintro ⟨mode, script, payload, payloadHead, + range, rangeHead, budget, guessBit⟩ + rfl } + +/-- GapCVP reduction support. -/ +abbrev CompletePhaseWindow (tm : Turing.FinTM2) := + CompletePhaseCell tm × CompletePhaseCell tm × + CompletePhaseCell tm × CompletePhaseCell tm + +/-- GapCVP reduction support. -/ +def completeMachineBlock (tm : Turing.FinTM2) + (cell : CompletePhaseCell tm) : BlockCell tm := + cell.script.1.1 + +/-- GapCVP reduction support. -/ +def completeMachineHead (tm : Turing.FinTM2) + (cell : CompletePhaseCell tm) : BlockCell tm := + cell.script.1.2 + +/-- GapCVP reduction support. -/ +def completeIsFirstBlock (tm : Turing.FinTM2) + (cell : CompletePhaseCell tm) : Bool := + cell.script.2.2 + +/-- GapCVP reduction support. -/ +def lastPhaseOffset (tm : Turing.FinTM2) : Fin (blockSize tm) := + ⟨blockSize tm - 1, by + have hpositive := blockSize_pos tm + omega⟩ + +/-- GapCVP reduction support. -/ +def phaseLeftOffset {α : Type} + (tm : Turing.FinTM2) + (first : Bool) + (left center : Fin (blockSize tm) → α) + (offset : Fin (blockSize tm)) : α := + if hzero : offset.val = 0 then + if first then center offset else left (lastPhaseOffset tm) + else + center ⟨offset.val - 1, by + have hlt := offset.isLt + omega⟩ + +/-- GapCVP reduction support. -/ +def phaseRightOffset {α : Type} + (tm : Turing.FinTM2) + (center right : Fin (blockSize tm) → α) + (offset : Fin (blockSize tm)) : α := + if hnext : offset.val + 1 < blockSize tm then + center ⟨offset.val + 1, hnext⟩ + else + right ⟨0, blockSize_pos tm⟩ + +/-- GapCVP reduction support. -/ +def completeWitnessWindow + (tm : Turing.FinTM2) + (window : CompletePhaseWindow tm) + (offset : Fin (blockSize tm)) : GuessPhaseWindow := + (phaseLeftOffset tm + (completeIsFirstBlock tm window.2.1) + (fun position => + (completeMachineBlock tm window.1 position).1) + (fun position => + (completeMachineBlock tm window.2.1 position).1) + offset, + (completeMachineBlock tm window.2.1 offset).1, + phaseRightOffset tm + (fun position => + (completeMachineBlock tm window.2.1 position).1) + (fun position => + (completeMachineBlock tm window.2.2.1 position).1) + offset, + (completeMachineBlock tm window.2.2.2 offset).1) + +/-- GapCVP reduction support. -/ +def completePayloadWindow + (tm : Turing.FinTM2) + (window : CompletePhaseWindow tm) + (offset : Fin (blockSize tm)) : + PairedInputTag × PairedInputTag × PairedInputTag × PairedInputTag := + (phaseLeftOffset tm + (completeIsFirstBlock tm window.2.1) + window.1.payload window.2.1.payload offset, + window.2.1.payload offset, + phaseRightOffset tm + window.2.1.payload window.2.2.1.payload offset, + window.2.2.2.payload offset) + +/-- GapCVP reduction support. -/ +noncomputable def PairedInputGuessAllowed + (bit : Bool) + (window : + PairedInputTag × PairedInputTag × + PairedInputTag × PairedInputTag) : Bool := + @decide ( + (window.2.1 = .marker ∧ + window.2.2.1 = .blank ∧ + window.2.2.2 = .bit (.inr bit)) ∨ + (window.2.1 ≠ .marker ∧ + window.1 = .marker ∧ + window.2.2.2 = .marker) ∨ + (window.2.1 ≠ .marker ∧ + window.1 ≠ .marker ∧ + window.2.2.2 = window.2.1) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def BroadcastWitnessGuessAllowed + (bit : Bool) + (window : GuessPhaseWindow) : Bool := + @decide ( + GuessPhaseAllowed window ∧ + (window.2.1 = .accepting → + window.2.2.2 = + if bit then PhaseTag.verifying else PhaseTag.guessing) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def CompletePhaseCoherent + (tm : Turing.FinTM2) + (window : CompletePhaseWindow tm) : Bool := + @decide ( + window.1.mode = window.2.1.mode ∧ + window.2.2.1.mode = window.2.1.mode ∧ + window.1.guessBit = window.2.1.guessBit ∧ + window.2.2.1.guessBit = window.2.1.guessBit ∧ + window.1.payloadHead = window.2.1.payloadHead ∧ + window.2.2.1.payloadHead = window.2.1.payloadHead ∧ + window.1.rangeHead = window.2.1.rangeHead ∧ + window.2.2.1.rangeHead = window.2.1.rangeHead + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def completeScriptWindow + (tm : Turing.FinTM2) + (window : CompletePhaseWindow tm) : ScriptBlockWindow tm := + (window.1.script, window.2.1.script, + window.2.2.1.script, window.2.2.2.script) + +/-- GapCVP reduction support. -/ +noncomputable def CompleteStaticTracksPreserved + (tm : Turing.FinTM2) + (window : CompletePhaseWindow tm) : Bool := + @decide ( + window.2.2.2.payload = window.2.1.payload ∧ + window.2.2.2.payloadHead = window.2.1.payloadHead ∧ + window.2.2.2.range = window.2.1.range ∧ + window.2.2.2.rangeHead = window.2.1.rangeHead ∧ + window.2.2.2.budget = window.2.1.budget ∧ + completeIsFirstBlock tm window.2.2.2 = + completeIsFirstBlock tm window.2.1 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def canonicalGuessingScriptRow + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (certificate : List Bool) + (hint : FiniteVerifierHint machine.tm) : + ScriptBlockRow machine.tm width := + fun position => + ((packRow machine.tm width + (guessingRow machine.tm width certificate) position, + packRow machine.tm width + (guessingRow machine.tm width certificate) 0), + hint, decide (position.val = 0)) + +/-- GapCVP reduction support. -/ +def initialPhaseCell + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (position : Fin (rowWidth bound machine x + 1)) : + CompletePhaseCell machine.tm where + mode := .guessing + script := canonicalGuessingScriptRow machine + (rowWidth bound machine x) [] + (defaultVerifierHint machine.tm) position + payload := pairedInputBlockAt machine.tm + (rowWidth bound machine x) x [] position + payloadHead := pairedInputBlockAt machine.tm + (rowWidth bound machine x) x [] 0 + range := phaseRangeBlockAt machine.tm + (rowWidth bound machine x) position + rangeHead := phaseRangeBlockAt machine.tm + (rowWidth bound machine x) 0 + budget := phaseBudgetBlockAt bound machine x position + guessBit := false + +/-- GapCVP reduction support. -/ +def acceptingPhaseCell + (tm : Turing.FinTM2) : CompletePhaseCell tm where + mode := .accepting + script := defaultScriptBlockCell tm + payload := fun _ => .blank + payloadHead := fun _ => .blank + range := fun _ => false + rangeHead := fun _ => false + budget := fun _ => false + guessBit := false + +/-- GapCVP reduction support. -/ +noncomputable def AcceptingPhaseBlock + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (cell : CompletePhaseCell machine.tm) : Bool := + @decide ( + machineControlOfBlock machine.tm + (completeMachineHead machine.tm cell) = + some + ((Turing.haltList machine.tm + (verifierOutput machine true)).l, + (Turing.haltList machine.tm + (verifierOutput machine true)).var) ∧ + ∀ (offset : Fin (blockSize machine.tm)) + (stack : machine.tm.K), + cellAtomValue machine stack + ((completeMachineBlock machine.tm cell offset).2.2.1 stack) = + if completeIsFirstBlock machine.tm cell ∧ offset.val = 0 then + ((Turing.haltList machine.tm + (verifierOutput machine true)).stk stack)[0]? + else + none + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def CompleteInitializationAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + window.2.2.2.mode = .verifying ∧ + CompleteStaticTracksPreserved machine.tm window ∧ + completeMachineBlock machine.tm window.2.2.2 = + initializedPhaseBlock machine + (completeMachineBlock machine.tm window.2.1) + window.2.1.payload window.2.1.range ∧ + completeMachineHead machine.tm window.2.2.2 = + initializedPhaseBlock machine + (completeMachineHead machine.tm window.2.1) + window.2.1.payloadHead window.2.1.rangeHead + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def CompleteVerificationAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + window.2.2.2.mode = .verifying ∧ + CompleteStaticTracksPreserved machine.tm window ∧ + scriptBlockAllowed machine + (completeScriptWindow machine.tm window) = true + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def CompleteAcceptanceAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + window.2.2.2 = acceptingPhaseCell machine.tm ∧ + AcceptingPhaseBlock machine window.2.1 + ) (Classical.propDecidable _) +private def defaultCompletePhaseCell + (tm : Turing.FinTM2) : CompletePhaseCell tm := + acceptingPhaseCell tm + +/-- GapCVP reduction support. -/ +def completePhaseSymbolCount (tm : Turing.FinTM2) : ℕ := + Fintype.card (CompletePhaseCell tm) - 1 + +private theorem completePhaseSymbolCount_card + (tm : Turing.FinTM2) : + completePhaseSymbolCount tm + 1 = + Fintype.card (CompletePhaseCell tm) := by + have hpositive : 0 < Fintype.card (CompletePhaseCell tm) := + Fintype.card_pos_iff.mpr ⟨defaultCompletePhaseCell tm⟩ + unfold completePhaseSymbolCount + omega + +/-- GapCVP reduction support. -/ +def completePhaseSymbolEquiv + (tm : Turing.FinTM2) : + CompletePhaseCell tm ≃ Symbol (completePhaseSymbolCount tm) := + (Fintype.equivFin (CompletePhaseCell tm)).trans + (Equiv.cast (congrArg Fin + (completePhaseSymbolCount_card tm).symm)) + +end CLCompleteVerifierSimulation + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part02.lean b/LeanPool/GapCVP/Part02.lean new file mode 100644 index 000000000..487283288 --- /dev/null +++ b/LeanPool/GapCVP/Part02.lean @@ -0,0 +1,8460 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part01 + +/-! # GapCVP proof, part 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +private theorem ofClassicalDecide {proposition : Prop} + (proof : @decide proposition (Classical.propDecidable proposition) = true) : + proposition := + @of_decide_eq_true proposition (Classical.propDecidable proposition) proof + +namespace CLPhaseSoundness + +open Computability Turing GapCVP.CLLocalWindows + +private def firstPhaseOffset (tm : Turing.FinTM2) : Fin (blockSize tm) := + ⟨0, blockSize_pos tm⟩ + +end CLPhaseSoundness + +namespace CLPhaseSpecification + +open Computability Turing GapCVP.CLBoundedStates GapCVP.CLLocalWindows +open GapCVP.CLCompleteVerifierSimulation + +private noncomputable def CorrectedGuessingAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + window.2.2.2.mode = .guessing ∧ + window.2.2.2.range = window.2.1.range ∧ + window.2.2.2.rangeHead = window.2.1.rangeHead ∧ + window.2.2.2.budget = window.2.1.budget ∧ + (∀ offset : Fin (blockSize machine.tm), + window.2.1.range offset = true → + BroadcastWitnessGuessAllowed window.2.2.2.guessBit + (completeWitnessWindow machine.tm window offset) ∧ + PairedInputGuessAllowed window.2.2.2.guessBit + (completePayloadWindow machine.tm window offset) ∧ + (window.2.1.payload offset = .marker → + window.2.1.budget offset = true)) + ) (Classical.propDecidable _) + +end CLPhaseSpecification + +namespace CLPhaseCompleteness + +open Computability Turing GapCVP.CL GapCVP.CLCompleteVerifierSimulation + +/-- GapCVP reduction support. -/ +def decodeCorrectedPhaseRow + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {width : ℕ} + (row : Position width → + Symbol (completePhaseSymbolCount machine.tm)) : + Position width → CompletePhaseCell machine.tm := + fun position => (completePhaseSymbolEquiv machine.tm).symm + (row position) + +end CLPhaseCompleteness + +namespace CLPhaseTableauSimulation + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLBoundedStates +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseSpecification GapCVP.CLPhaseCompleteness + +/-- GapCVP reduction support. -/ +noncomputable def FirstBlockAnchored (tm : Turing.FinTM2) + (cell : CompletePhaseCell tm) : Bool := + @decide ( + completeIsFirstBlock tm cell = true → + completeMachineBlock tm cell = + completeMachineHead tm cell ∧ + cell.payload = cell.payloadHead ∧ + cell.range = cell.rangeHead + ) (Classical.propDecidable _) +private noncomputable def PhaseBoundaryPreserved + (tm : Turing.FinTM2) + (window : CompletePhaseWindow tm) : Bool := + @decide ( + completeIsFirstBlock tm window.2.2.2 = + completeIsFirstBlock tm window.2.1 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def AnchoredGuessingAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + CorrectedGuessingAllowed machine window ∧ + PhaseBoundaryPreserved machine.tm window ∧ + FirstBlockAnchored machine.tm window.2.1 ∧ + FirstBlockAnchored machine.tm window.2.2.2 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def AnchoredInitializationAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + CompleteInitializationAllowed machine window ∧ + FirstBlockAnchored machine.tm window.2.1 ∧ + FirstBlockAnchored machine.tm window.2.2.2 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def AnchoredVerificationAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + CompleteVerificationAllowed machine window ∧ + FirstBlockAnchored machine.tm window.2.1 ∧ + FirstBlockAnchored machine.tm window.2.2.2 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def AnchoredAcceptanceAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + CompleteAcceptanceAllowed machine window ∧ + FirstBlockAnchored machine.tm window.2.1 + ) (Classical.propDecidable _) +private noncomputable def AnchoredPhaseAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + CompletePhaseCoherent machine.tm window ∧ + match window.2.1.mode with + | .guessing => + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window + | .verifying => + AnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window + | .accepting => + window.2.2.2 = acceptingPhaseCell machine.tm + ) (Classical.propDecidable _) +private def anchoredPhaseAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := by + classical + exact decide (AnchoredPhaseAllowed machine window) + +private theorem anchoredPhaseAllowed_iff + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : + anchoredPhaseAllowed machine window = true ↔ + AnchoredPhaseAllowed machine window := by + classical + simp only [anchoredPhaseAllowed, Bool.decide_eq_true] + +private def anchoredPhaseSymbolAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : WindowSymbols (completePhaseSymbolCount machine.tm)) : + Bool := + anchoredPhaseAllowed machine + ((completePhaseSymbolEquiv machine.tm).symm window.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.2) + +private def anchoredPhaseSpecification + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + Specification + ((nondeterministicTableauDimensionPolynomial bound machine).eval + x.length) + (completePhaseSymbolCount machine.tm) where + input position := + completePhaseSymbolEquiv machine.tm + (initialPhaseCell bound machine x position) + accept := + completePhaseSymbolEquiv machine.tm + (acceptingPhaseCell machine.tm) + allowed := anchoredPhaseSymbolAllowed machine + +private theorem anchoredTrace_window + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : + Time ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Position ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Symbol (completePhaseSymbolCount machine.tm)) + (htrace : ValidTrace + (anchoredPhaseSpecification bound machine x) trace) + (window : Window + ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length)) : + AnchoredPhaseAllowed machine + (decodeCorrectedPhaseRow machine (trace window.1.1) + (leftPosition window), + decodeCorrectedPhaseRow machine (trace window.1.1) + window.1.2, + decodeCorrectedPhaseRow machine (trace window.1.1) + (rightPosition window), + decodeCorrectedPhaseRow machine + (trace (nextTime window)) window.1.2) := by + have htrace' := htrace + simp only [ValidTrace, decide_eq_true_eq] at htrace' + apply (anchoredPhaseAllowed_iff machine _).mp + exact htrace'.2.2 window + +private theorem anchoredTrace_initial + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : + Time ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Position ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Symbol (completePhaseSymbolCount machine.tm)) + (htrace : ValidTrace + (anchoredPhaseSpecification bound machine x) trace) + (position : Position + ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length)) : + decodeCorrectedPhaseRow machine (trace 0) position = + initialPhaseCell bound machine x position := by + have htrace' := htrace + simp only [ValidTrace, decide_eq_true_eq] at htrace' + simp only [decodeCorrectedPhaseRow, htrace'.1 position, anchoredPhaseSpecification, + Equiv.symm_apply_apply] + +end CLPhaseTableauSimulation + +namespace CLPhaseTraceInduction + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates +open GapCVP.CLPushAlphabet GapCVP.CLCellRowBounds GapCVP.CLLocalWindows +open GapCVP.CLExactVerifierTransition GapCVP.CLTableauSimulationCert +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseTableauSimulation + +private def unpackPhaseMachineCell + (tm : Turing.FinTM2) + (width : ℕ) + (row : Position width → CompletePhaseCell tm) + (index : Position width) : LocalCellSymbol tm := + completeMachineBlock tm + (row (coordinateBlock tm width index)) + (coordinateOffset tm width index) + +private def unpackPhaseWitness + (tm : Turing.FinTM2) + (width : ℕ) + (row : Position width → CompletePhaseCell tm) + (index : Position width) : PhaseTag := + (unpackPhaseMachineCell tm width row index).1 + +private def unpackPhasePayload + (tm : Turing.FinTM2) + (width : ℕ) + (row : Position width → CompletePhaseCell tm) + (index : Position width) : PairedInputTag := + (row (coordinateBlock tm width index)).payload + (coordinateOffset tm width index) + +/-- GapCVP reduction support. -/ +def canonicalAnchoredVerifyingRow + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (configuration : machine.tm.Cfg) + (hsupported : StackAtomSupported machine configuration) + (hint : FiniteVerifierHint machine.tm) + (annotation : Bool) : + Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm := + fun position => { + mode := .verifying + script := canonicalScriptBlockRow machine + (rowWidth bound machine x) certificate + configuration hsupported hint position + payload := pairedInputBlockAt machine.tm + (rowWidth bound machine x) x certificate position + payloadHead := pairedInputBlockAt machine.tm + (rowWidth bound machine x) x certificate 0 + range := phaseRangeBlockAt machine.tm + (rowWidth bound machine x) position + rangeHead := phaseRangeBlockAt machine.tm + (rowWidth bound machine x) 0 + budget := phaseBudgetBlockAt bound machine x position + guessBit := annotation + } + +private theorem canonicalAnchoredVerifyingRow_firstBlockAnchored + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (configuration : machine.tm.Cfg) + (hsupported : StackAtomSupported machine configuration) + (hint : FiniteVerifierHint machine.tm) + (annotation : Bool) + (position : Position (rowWidth bound machine x)) : + FirstBlockAnchored machine.tm + (canonicalAnchoredVerifyingRow bound machine x certificate + configuration hsupported hint annotation position) := by + simp only [FirstBlockAnchored, decide_eq_true_eq] + intro hfirst + have hposition : position.val = 0 := by + simpa only [Fin.val_eq_zero_iff, completeIsFirstBlock, canonicalAnchoredVerifyingRow, + canonicalScriptBlockRow, + decide_eq_true_eq] using hfirst + have hzero : position = 0 := by + apply Fin.ext + exact hposition + subst position + exact ⟨rfl, rfl, rfl⟩ + +end CLPhaseTraceInduction + +namespace CLPhaseGlobalSimulation + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLPushAlphabet +open GapCVP.CLCellRowBounds GapCVP.CLLocalWindows GapCVP.CLExactVerifierTransition +open GapCVP.CLTableauSimulationCert GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseTraceInduction + +/-- GapCVP reduction support. -/ +def anchoredVerifierWindowAt + (tm : Turing.FinTM2) (width : ℕ) + (first next : Position width → CompletePhaseCell tm) + (position : Position width) : CompletePhaseWindow tm := + (first (leftBlock width position), + first position, + first (rightBlock width position), + next position) + +private theorem canonicalAnchoredVerifierWindow_coherent + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (firstHint nextHint : FiniteVerifierHint machine.tm) + (annotation : Bool) + (position : Position (rowWidth bound machine x)) : + CompletePhaseCoherent machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + first hfirst firstHint annotation) + (canonicalAnchoredVerifyingRow bound machine x certificate + next hnext nextHint annotation) position) := by + simp only [CompletePhaseCoherent, anchoredVerifierWindowAt, canonicalAnchoredVerifyingRow, + and_self, + decide_true] + +private theorem canonicalAnchoredVerifierWindow_static + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (firstHint nextHint : FiniteVerifierHint machine.tm) + (firstAnnotation nextAnnotation : Bool) + (position : Position (rowWidth bound machine x)) : + CompleteStaticTracksPreserved machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + first hfirst firstHint firstAnnotation) + (canonicalAnchoredVerifyingRow bound machine x certificate + next hnext nextHint nextAnnotation) position) := by + simp only [CompleteStaticTracksPreserved, anchoredVerifierWindowAt, + canonicalAnchoredVerifyingRow, + canonicalScriptBlockRow, Fin.val_eq_zero_iff, completeIsFirstBlock, and_self, decide_true] + +private theorem canonicalAnchoredVerifierWindow_allowed_iff + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (firstHint nextHint : FiniteVerifierHint machine.tm) + (annotation : Bool) + (position : Position (rowWidth bound machine x)) : + AnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + first hfirst firstHint annotation) + (canonicalAnchoredVerifyingRow bound machine x certificate + next hnext nextHint annotation) position) ↔ + scriptBlockAllowed machine + (scriptBlockWindowAt machine.tm + (rowWidth bound machine x) + (canonicalScriptBlockRow machine + (rowWidth bound machine x) + certificate first hfirst firstHint) + (canonicalScriptBlockRow machine + (rowWidth bound machine x) + certificate next hnext nextHint) position) = true := by + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + first hfirst firstHint annotation) + (canonicalAnchoredVerifyingRow bound machine x certificate + next hnext nextHint annotation) position + have hfirstAnchor : FirstBlockAnchored machine.tm window.2.1 := + canonicalAnchoredVerifyingRow_firstBlockAnchored + bound machine x certificate first hfirst + firstHint annotation position + have hnextAnchor : FirstBlockAnchored machine.tm window.2.2.2 := + canonicalAnchoredVerifyingRow_firstBlockAnchored + bound machine x certificate next hnext + nextHint annotation position + have hmode : window.2.1.mode = .verifying := rfl + have hnextMode : window.2.2.2.mode = .verifying := rfl + have hscript : completeScriptWindow machine.tm window = + scriptBlockWindowAt machine.tm (rowWidth bound machine x) + (canonicalScriptBlockRow machine + (rowWidth bound machine x) + certificate first hfirst firstHint) + (canonicalScriptBlockRow machine + (rowWidth bound machine x) + certificate next hnext nextHint) position := rfl + constructor + · intro hallowed + change AnchoredPhaseAllowed machine window at hallowed + have hallowed' := hallowed + simp only [AnchoredPhaseAllowed, decide_eq_true_eq] at hallowed' + have hbranch : + AnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window := by + simpa only [hmode] using hallowed'.2 + rcases hbranch with hverification | hacceptance + · have hverification' := hverification + simp only [AnchoredVerificationAllowed, CompleteVerificationAllowed, + decide_eq_true_eq] at hverification' + rw [← hscript] + exact hverification'.1.2.2 + · have hacceptance' := hacceptance + simp only [AnchoredAcceptanceAllowed, CompleteAcceptanceAllowed, + decide_eq_true_eq] at hacceptance' + have hacceptanceOuter := ofClassicalDecide hacceptance' + have hacceptanceCore := ofClassicalDecide hacceptanceOuter.1 + have hfixed := hacceptanceCore.1 + have himpossible := congrArg CompletePhaseCell.mode hfixed + simp only [hnextMode, acceptingPhaseCell, reduceCtorEq] at himpossible + · intro hallowed + change AnchoredPhaseAllowed machine window + simp only [AnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨canonicalAnchoredVerifierWindow_coherent + bound machine x certificate first next hfirst hnext + firstHint nextHint annotation position, ?_⟩ + change AnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window + left + simp only [AnchoredVerificationAllowed, CompleteVerificationAllowed, + decide_eq_true_eq] + refine ⟨⟨hnextMode, + canonicalAnchoredVerifierWindow_static + bound machine x certificate first next hfirst hnext + firstHint nextHint annotation annotation position, + ?_⟩, hfirstAnchor, hnextAnchor⟩ + rw [hscript] + exact hallowed + +private theorem actualStep_iff_anchoredCanonicalVerifierWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstSpace : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ rowWidth bound machine x) + (hnextSpace : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ rowWidth bound machine x) : + machine.tm.step first = some next ↔ + ∃ (firstHint nextHint : FiniteVerifierHint machine.tm), + ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow + bound machine x certificate + first hfirst firstHint false) + (canonicalAnchoredVerifyingRow + bound machine x certificate + next hnext nextHint false) position) := by + constructor + · intro hstep + obtain ⟨firstHint, nextHint, hwindows⟩ := + (actualStep_iff_canonical_block_windows + machine (rowWidth bound machine x) certificate + first next hfirst hnext hfirstSpace hnextSpace).mp hstep + refine ⟨firstHint, nextHint, ?_⟩ + intro position + exact (canonicalAnchoredVerifierWindow_allowed_iff + bound machine x certificate first next hfirst hnext + firstHint nextHint false position).mpr + (hwindows position) + · rintro ⟨firstHint, nextHint, hwindows⟩ + apply (actualStep_iff_canonical_block_windows + machine (rowWidth bound machine x) certificate + first next hfirst hnext hfirstSpace hnextSpace).mpr + refine ⟨firstHint, nextHint, ?_⟩ + intro position + exact (canonicalAnchoredVerifierWindow_allowed_iff + bound machine x certificate first next hfirst hnext + firstHint nextHint false position).mp + (hwindows position) + +end CLPhaseGlobalSimulation + +namespace CLPhaseVerifierSimulation + +open Computability Turing GapCVP.CL GapCVP.CLPushAlphabet GapCVP.CLCellRowBounds +open GapCVP.CLExactVerifierTransition GapCVP.CLGlobalTableauSimulation +open GapCVP.CLTableauSimulationCert GapCVP.CLFullTableauEmitter GapCVP.CLPhaseTableauSimulation +open GapCVP.CLPhaseTraceInduction GapCVP.CLPhaseGlobalSimulation + +private noncomputable def AllCanonicalAnchoredVerifierTraceWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + {steps : ℕ} + (configuration : Fin (steps + 1) → machine.tm.Cfg) + (hsupported : ∀ time : Fin (steps + 1), + StackAtomSupported machine (configuration time)) + (hint : Fin (steps + 1) → FiniteVerifierHint machine.tm) : Bool := + @decide ( + ∀ (time : Fin steps) + (position : Position (rowWidth bound machine x)), + AnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + (configuration (Fin.castSucc time)) + (hsupported (Fin.castSucc time)) + (hint (Fin.castSucc time)) false) + (canonicalAnchoredVerifyingRow bound machine x certificate + (configuration time.succ) + (hsupported time.succ) + (hint time.succ) false) position) + ) (Classical.propDecidable _) +private theorem canonicalAnchoredVerifierTraceWindows_iff_actualRun + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + {steps : ℕ} + (configuration : Fin (steps + 1) → machine.tm.Cfg) + (hsupported : ∀ time : Fin (steps + 1), + StackAtomSupported machine (configuration time)) + (hspace : ∀ (time : Fin (steps + 1)) (stack : machine.tm.K), + ((configuration time).stk stack).length ≤ + rowWidth bound machine x) : + (∃ hint : Fin (steps + 1) → FiniteVerifierHint machine.tm, + AllCanonicalAnchoredVerifierTraceWindows bound machine x + certificate configuration hsupported hint) ↔ + ∀ time : Fin steps, + machine.tm.step (configuration (Fin.castSucc time)) = + some (configuration time.succ) := by + constructor + · rintro ⟨hint, hwindows⟩ time + have hwindows' := hwindows + simp only [AllCanonicalAnchoredVerifierTraceWindows, + decide_eq_true_eq] at hwindows' + apply (actualStep_iff_anchoredCanonicalVerifierWindows + bound machine x certificate + (configuration (Fin.castSucc time)) + (configuration time.succ) + (hsupported (Fin.castSucc time)) + (hsupported time.succ) + (hspace (Fin.castSucc time)) + (hspace time.succ)).mpr + exact ⟨hint (Fin.castSucc time), + hint time.succ, hwindows' time⟩ + · intro hrun + have hlocal : ∀ time : Fin steps, + ∃ firstHint : FiniteVerifierHint machine.tm, + scriptVerifierAllowed machine + (scriptVerifierQueryOf machine + (configuration (Fin.castSucc time)) + (configuration time.succ) + (hsupported (Fin.castSucc time)) + (hsupported time.succ) firstHint) = true ∧ + AllVerifierStackWindows machine + (rowWidth bound machine x) + (configuration (Fin.castSucc time)) + (configuration time.succ) + (hsupported (Fin.castSucc time)) + (hsupported time.succ) firstHint := by + intro time + exact (actualStep_iff_finite_script_and_windows + machine (rowWidth bound machine x) + (configuration (Fin.castSucc time)) + (configuration time.succ) + (hsupported (Fin.castSucc time)) + (hsupported time.succ) + (hspace (Fin.castSucc time)) + (hspace time.succ)).mp (hrun time) + choose selected hselectedScript hselectedWindows using hlocal + let hint : Fin (steps + 1) → FiniteVerifierHint machine.tm := + fun time => + if htime : time.val < steps then + selected ⟨time.val, htime⟩ + else + defaultVerifierHint machine.tm + refine ⟨hint, ?_⟩ + simp only [AllCanonicalAnchoredVerifierTraceWindows, decide_eq_true_eq] + intro time position + have hcurrent : hint (Fin.castSucc time) = selected time := by + simp only [Fin.val_castSucc, time.isLt, ↓reduceDIte, Fin.eta, hint] + rw [hcurrent] + apply (canonicalAnchoredVerifierWindow_allowed_iff + bound machine x certificate + (configuration (Fin.castSucc time)) + (configuration time.succ) + (hsupported (Fin.castSucc time)) + (hsupported time.succ) + (selected time) (hint time.succ) false position).mpr + exact (canonicalScriptBlockWindows_iff + machine (rowWidth bound machine x) certificate + (configuration (Fin.castSucc time)) + (configuration time.succ) + (hsupported (Fin.castSucc time)) + (hsupported time.succ) + (hspace (Fin.castSucc time)) + (hspace time.succ) + (selected time) (hint time.succ)).mpr + ⟨hselectedScript time, + hselectedWindows time⟩ position + +end CLPhaseVerifierSimulation + +namespace CLValidTraceSoundness + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLCellRowBounds +open GapCVP.CLLocalWindows GapCVP.CLTableauStitching GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLPhaseCompleteness GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseGlobalSimulation + +private noncomputable def AllAnchoredPhaseWindows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) : Bool := + @decide ( + ∀ position : Position width, + AnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position) + ) (Classical.propDecidable _) +private theorem allAnchoredWindows_mode_constant + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hwindows : AllAnchoredPhaseWindows machine width first next) : + ∀ position : Position width, + (first position).mode = (first 0).mode := by + intro position + induction position using Fin.induction with + | zero => rfl + | succ position ih => + have hlocal := hwindows + simp only [AllAnchoredPhaseWindows, decide_eq_true_eq] at hlocal + have hcoherent := hlocal position.succ + simp only [AnchoredPhaseAllowed, CompletePhaseCoherent, + decide_eq_true_eq] at hcoherent + have hcoherentOuter := ofClassicalDecide hcoherent + have hcoherentCore := ofClassicalDecide hcoherentOuter.1 + have hleft := hcoherentCore.1 + change (first (leftBlock width position.succ)).mode = + (first position.succ).mode at hleft + rw [leftBlock_succ] at hleft + exact hleft.symm.trans ih + +private theorem allAnchoredWindows_guessBit_constant + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hwindows : AllAnchoredPhaseWindows machine width first next) : + ∀ position : Position width, + (first position).guessBit = (first 0).guessBit := by + intro position + induction position using Fin.induction with + | zero => rfl + | succ position ih => + have hlocal := hwindows + simp only [AllAnchoredPhaseWindows, decide_eq_true_eq] at hlocal + have hcoherent := hlocal position.succ + simp only [AnchoredPhaseAllowed, CompletePhaseCoherent, + decide_eq_true_eq] at hcoherent + have hcoherentOuter := ofClassicalDecide hcoherent + have hcoherentCore := ofClassicalDecide hcoherentOuter.1 + have hleft := hcoherentCore.2.2.1 + change (first (leftBlock width position.succ)).guessBit = + (first position.succ).guessBit at hleft + rw [leftBlock_succ] at hleft + exact hleft.symm.trans ih + +private theorem anchoredGuessing_boundary + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hwindow : AnchoredGuessingAllowed machine window) : + completeIsFirstBlock machine.tm window.2.2.2 = + completeIsFirstBlock machine.tm window.2.1 := by + have hwindow' := hwindow + simp only [AnchoredGuessingAllowed, PhaseBoundaryPreserved, + decide_eq_true_eq] at hwindow' + exact hwindow'.2.1 + +private theorem anchoredVerification_boundary + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hwindow : AnchoredVerificationAllowed machine window) : + completeIsFirstBlock machine.tm window.2.2.2 = + completeIsFirstBlock machine.tm window.2.1 := by + have hwindow' := hwindow + simp only [AnchoredVerificationAllowed, CompleteVerificationAllowed, + CompleteStaticTracksPreserved, decide_eq_true_eq] at hwindow' + exact hwindow'.1.2.1.2.2.2.2.2 + +private theorem anchoredValidTrace_allWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : + Time ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Position ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Symbol (completePhaseSymbolCount machine.tm)) + (htrace : ValidTrace + (anchoredPhaseSpecification bound machine x) trace) + (time : Fin ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length)) : + AllAnchoredPhaseWindows machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) := by + simp only [AllAnchoredPhaseWindows, decide_eq_true_eq] + intro position + exact anchoredTrace_window bound machine x trace htrace + (windowAt time position) + +private theorem anchoredValidTrace_mode_constant + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : + Time ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Position ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Symbol (completePhaseSymbolCount machine.tm)) + (htrace : ValidTrace + (anchoredPhaseSpecification bound machine x) trace) + (time : Fin ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length)) + (position : Position (rowWidth bound machine x)) : + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) 0).mode := + allAnchoredWindows_mode_constant machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + (anchoredValidTrace_allWindows bound machine x + trace htrace time) position + +private theorem anchoredValidTrace_guessBit_constant + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : + Time ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Position ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length) → + Symbol (completePhaseSymbolCount machine.tm)) + (htrace : ValidTrace + (anchoredPhaseSpecification bound machine x) trace) + (time : Fin ((nondeterministicTableauDimensionPolynomial + bound machine).eval x.length)) + (position : Position (rowWidth bound machine x)) : + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).guessBit = + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) 0).guessBit := + allAnchoredWindows_guessBit_constant machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + (anchoredValidTrace_allWindows bound machine x + trace htrace time) position + +end CLValidTraceSoundness + +namespace CLWholeTraceSoundness + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLCellRowBounds +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseSpecification GapCVP.CLPhaseCompleteness +open GapCVP.CLPhaseTableauSimulation GapCVP.CLValidTraceSoundness + +/-- GapCVP reduction support. -/ +abbrev AnchoredPhaseTrace + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) := + Time (rowWidth bound machine x) → + Position (rowWidth bound machine x) → + Symbol (completePhaseSymbolCount machine.tm) + +/-- GapCVP reduction support. -/ +noncomputable def AnchoredPhaseMasks + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (position : Position (rowWidth bound machine x)) + (cell : CompletePhaseCell machine.tm) : Bool := + @decide ( + cell.range = + phaseRangeBlockAt machine.tm (rowWidth bound machine x) position ∧ + cell.rangeHead = + phaseRangeBlockAt machine.tm (rowWidth bound machine x) 0 ∧ + cell.budget = phaseBudgetBlockAt bound machine x position ∧ + completeIsFirstBlock machine.tm cell = decide (position.val = 0) + ) (Classical.propDecidable _) +private theorem anchoredPhase_old_not_accepting_of_next_not_accepting + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hallowed : AnchoredPhaseAllowed machine window) + (hnext : window.2.2.2.mode ≠ .accepting) : + window.2.1.mode ≠ .accepting := by + have hallowed' := hallowed + simp only [AnchoredPhaseAllowed, decide_eq_true_eq] at hallowed' + intro hmode + have hcleared : window.2.2.2 = acceptingPhaseCell machine.tm := by + simpa only [hmode] using hallowed'.2 + apply hnext + rw [hcleared] + rfl + +private theorem anchoredPhase_staticMasks_of_next_not_accepting + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hallowed : AnchoredPhaseAllowed machine window) + (hnext : window.2.2.2.mode ≠ .accepting) : + window.2.2.2.range = window.2.1.range ∧ + window.2.2.2.rangeHead = window.2.1.rangeHead ∧ + window.2.2.2.budget = window.2.1.budget ∧ + completeIsFirstBlock machine.tm window.2.2.2 = + completeIsFirstBlock machine.tm window.2.1 := by + have hallowed' := hallowed + simp only [AnchoredPhaseAllowed, decide_eq_true_eq] at hallowed' + cases hmode : window.2.1.mode with + | guessing => + have hcases : + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window := by + simpa only [hmode] using hallowed'.2 + rcases hcases with hguess | hinit + · have hguess' := hguess + simp only [AnchoredGuessingAllowed, CorrectedGuessingAllowed, + decide_eq_true_eq] at hguess' + exact ⟨hguess'.1.2.1, + hguess'.1.2.2.1, + hguess'.1.2.2.2.1, + anchoredGuessing_boundary machine window hguess⟩ + · have hinit' := hinit + simp only [AnchoredInitializationAllowed, CompleteInitializationAllowed, + decide_eq_true_eq] at hinit' + have hinitOuter := ofClassicalDecide hinit' + have hinitCore := ofClassicalDecide hinitOuter.1 + have hstatic := hinitCore.2.1 + simp only [CompleteStaticTracksPreserved, decide_eq_true_eq] at hstatic + exact ⟨hstatic.2.2.1, + hstatic.2.2.2.1, + hstatic.2.2.2.2.1, + hstatic.2.2.2.2.2⟩ + | verifying => + have hcases : + AnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window := by + simpa only [hmode] using hallowed'.2 + rcases hcases with hverify | haccept + · have hverify' := hverify + simp only [AnchoredVerificationAllowed, CompleteVerificationAllowed, + decide_eq_true_eq] at hverify' + have hstatic := hverify'.1.2.1 + simp only [CompleteStaticTracksPreserved, decide_eq_true_eq] at hstatic + exact ⟨hstatic.2.2.1, + hstatic.2.2.2.1, + hstatic.2.2.2.2.1, + hstatic.2.2.2.2.2⟩ + · have haccept' := haccept + simp only [AnchoredAcceptanceAllowed, CompleteAcceptanceAllowed, + decide_eq_true_eq] at haccept' + have hacceptOuter := ofClassicalDecide haccept' + have hacceptCore := ofClassicalDecide hacceptOuter.1 + exact (hnext (by rw [hacceptCore.1]; rfl)).elim + | accepting => + exact ((anchoredPhase_old_not_accepting_of_next_not_accepting + machine window hallowed hnext) hmode).elim + +private theorem anchoredValidTrace_masks_of_not_accepting + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace (anchoredPhaseSpecification bound machine x) trace) + (time : Time (rowWidth bound machine x)) + (position : Position (rowWidth bound machine x)) : + (decodeCorrectedPhaseRow machine (trace time) position).mode ≠ + .accepting → + AnchoredPhaseMasks bound machine x position + (decodeCorrectedPhaseRow machine (trace time) position) := by + simp only [AnchoredPhaseMasks, decide_eq_true_eq] + induction time using Fin.induction with + | zero => + intro _ + have hinitial : + decodeCorrectedPhaseRow machine (trace 0) position = + initialPhaseCell bound machine x position := by + exact anchoredTrace_initial bound machine x trace htrace position + rw [hinitial] + exact ⟨rfl, rfl, rfl, rfl⟩ + | succ time ih => + intro hnext + have hall := + anchoredValidTrace_allWindows bound machine x trace htrace time + simp only [AllAnchoredPhaseWindows, decide_eq_true_eq] at hall + have hwindow := hall position + have hold := anchoredPhase_old_not_accepting_of_next_not_accepting + machine _ hwindow hnext + have hstatic := anchoredPhase_staticMasks_of_next_not_accepting + machine _ hwindow hnext + obtain ⟨hrange, hrangeHead, hbudget, hboundary⟩ := ih hold + exact ⟨hstatic.1.trans hrange, + hstatic.2.1.trans hrangeHead, + hstatic.2.2.1.trans hbudget, + hstatic.2.2.2.trans hboundary⟩ + +private theorem anchoredValidTrace_has_acceptingCell + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace (anchoredPhaseSpecification bound machine x) trace) : + ∃ position : Position (rowWidth bound machine x), + decodeCorrectedPhaseRow machine + (trace (Fin.last (rowWidth bound machine x))) position = + acceptingPhaseCell machine.tm := by + have htrace' := htrace + simp only [ValidTrace, decide_eq_true_eq] at htrace' + obtain ⟨position, haccept⟩ := htrace'.2.1 + refine ⟨position, ?_⟩ + change + trace (Fin.last (rowWidth bound machine x)) position = + completePhaseSymbolEquiv machine.tm + (acceptingPhaseCell machine.tm) at haccept + change + (completePhaseSymbolEquiv machine.tm).symm + (trace (Fin.last (rowWidth bound machine x)) position) = + acceptingPhaseCell machine.tm + rw [haccept] + exact (completePhaseSymbolEquiv machine.tm).symm_apply_apply _ + +end CLWholeTraceSoundness + +namespace CLFirstAcceptance + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLCellRowBounds +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseSpecification GapCVP.CLPhaseCompleteness +open GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseGlobalSimulation GapCVP.CLValidTraceSoundness +open GapCVP.CLWholeTraceSoundness + +private noncomputable def HasAcceptingModeAt + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (index : ℕ) : Bool := + @decide ( + ∃ (time : Time (rowWidth bound machine x)) + (position : Position (rowWidth bound machine x)), + time.val = index ∧ + (decodeCorrectedPhaseRow machine (trace time) position).mode = + .accepting + ) (Classical.propDecidable _) +private theorem anchoredValidTrace_hasAcceptingTime + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace (anchoredPhaseSpecification bound machine x) trace) : + ∃ index : ℕ, HasAcceptingModeAt bound machine x trace index := by + simp only [HasAcceptingModeAt, decide_eq_true_eq] + obtain ⟨position, haccept⟩ := + anchoredValidTrace_has_acceptingCell bound machine x trace htrace + refine ⟨rowWidth bound machine x, + Fin.last (rowWidth bound machine x), position, rfl, ?_⟩ + rw [haccept] + rfl + +private noncomputable def firstAcceptanceIndex + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace (anchoredPhaseSpecification bound machine x) trace) : + ℕ := by + classical + exact Nat.find (anchoredValidTrace_hasAcceptingTime + bound machine x trace htrace) + +private theorem firstAcceptanceIndex_spec + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace (anchoredPhaseSpecification bound machine x) trace) : + HasAcceptingModeAt bound machine x trace + (firstAcceptanceIndex bound machine x trace htrace) := by + classical + exact Nat.find_spec (anchoredValidTrace_hasAcceptingTime + bound machine x trace htrace) + +private theorem firstAcceptanceIndex_min + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace (anchoredPhaseSpecification bound machine x) trace) + (index : ℕ) + (hindex : index < firstAcceptanceIndex + bound machine x trace htrace) : + ¬ HasAcceptingModeAt bound machine x trace index := by + classical + exact Nat.find_min (anchoredValidTrace_hasAcceptingTime + bound machine x trace htrace) hindex + +private theorem anchoredPhase_first_acceptance_is_verifying + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hallowed : AnchoredPhaseAllowed machine window) + (hnext : window.2.2.2.mode = .accepting) + (hold : window.2.1.mode ≠ .accepting) : + window.2.1.mode = .verifying ∧ + AnchoredAcceptanceAllowed machine window := by + have hallowed' := hallowed + simp only [AnchoredPhaseAllowed, decide_eq_true_eq] at hallowed' + cases hmode : window.2.1.mode with + | guessing => + have hcases : + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window := by + simpa only [hmode] using hallowed'.2 + rcases hcases with hguess | hinit + · have hguess' := hguess + simp only [AnchoredGuessingAllowed, CorrectedGuessingAllowed, + decide_eq_true_eq] at hguess' + have hguessMode := hguess'.1.1 + rw [hnext] at hguessMode + cases hguessMode + · have hinit' := hinit + simp only [AnchoredInitializationAllowed, CompleteInitializationAllowed, + decide_eq_true_eq] at hinit' + have hinitOuter := ofClassicalDecide hinit' + have hinitCore := ofClassicalDecide hinitOuter.1 + have hinitMode := hinitCore.1 + rw [hnext] at hinitMode + cases hinitMode + | verifying => + have hcases : + AnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window := by + simpa only [hmode] using hallowed'.2 + rcases hcases with hverify | haccept + · have hverify' := hverify + simp only [AnchoredVerificationAllowed, CompleteVerificationAllowed, + decide_eq_true_eq] at hverify' + have hverifyMode := hverify'.1.1 + rw [hnext] at hverifyMode + cases hverifyMode + · exact ⟨rfl, haccept⟩ + | accepting => + exact (hold hmode).elim + +private theorem anchoredValidTrace_has_first_checked_acceptance + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace (anchoredPhaseSpecification bound machine x) trace) : + ∃ (time : Fin (rowWidth bound machine x)) + (position : Position (rowWidth bound machine x)), + AnchoredAcceptanceAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + position) ∧ + (∀ other : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) other).mode = .verifying) ∧ + (∀ other : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x other + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) other)) ∧ + (∀ (earlier : Time (rowWidth bound machine x)), + earlier.val ≤ time.val → + ∀ other : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace earlier) other).mode ≠ .accepting) := by + have hfirst := firstAcceptanceIndex_spec bound machine x trace htrace + simp only [HasAcceptingModeAt, decide_eq_true_eq] at hfirst + obtain ⟨acceptTime, position, hindex, hmode⟩ := hfirst + have hnonzero : acceptTime.val ≠ 0 := by + intro hzero + have htime : acceptTime = 0 := by + apply Fin.ext + exact hzero + subst acceptTime + have hinitial : + decodeCorrectedPhaseRow machine (trace 0) position = + initialPhaseCell bound machine x position := by + exact anchoredTrace_initial bound machine x trace htrace position + rw [hinitial] at hmode + cases hmode + have hpositive : 0 < acceptTime.val := Nat.pos_of_ne_zero hnonzero + let previous : Fin (rowWidth bound machine x) := + ⟨acceptTime.val - 1, by + have hbound := acceptTime.isLt + omega⟩ + have hnext : previous.succ = acceptTime := by + apply Fin.ext + dsimp [previous] + omega + have hprefix : + ∀ (earlier : Time (rowWidth bound machine x)), + earlier.val < acceptTime.val → + ∀ other : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace earlier) other).mode ≠ .accepting := by + intro earlier hearlier other hearlyMode + have hfirst : + earlier.val < firstAcceptanceIndex + bound machine x trace htrace := by + omega + have hearly : HasAcceptingModeAt bound machine x trace earlier.val := by + simp only [HasAcceptingModeAt, decide_eq_true_eq] + exact ⟨earlier, other, rfl, hearlyMode⟩ + exact (firstAcceptanceIndex_min bound machine x trace htrace + earlier.val hfirst) hearly + have hall := + anchoredValidTrace_allWindows bound machine x trace htrace previous + simp only [AllAnchoredPhaseWindows, decide_eq_true_eq] at hall + have hwindow := hall position + have hnextMode : + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc previous))) + (decodeCorrectedPhaseRow machine (trace previous.succ)) + position).2.2.2.mode = .accepting := by + change + (decodeCorrectedPhaseRow machine + (trace previous.succ) position).mode = .accepting + rw [hnext] + exact hmode + have hprevious : + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc previous)) position).mode ≠ .accepting := by + apply hprefix (Fin.castSucc previous) + dsimp [previous] + omega + obtain ⟨hverifying, haccept⟩ := + anchoredPhase_first_acceptance_is_verifying machine _ + hwindow hnextMode hprevious + refine ⟨previous, position, haccept, ?_, ?_, ?_⟩ + · intro other + have hother := anchoredValidTrace_mode_constant + bound machine x trace htrace previous other + have hselected := anchoredValidTrace_mode_constant + bound machine x trace htrace previous position + exact hother.trans (hselected.symm.trans hverifying) + · intro other + apply anchoredValidTrace_masks_of_not_accepting + bound machine x trace htrace (Fin.castSucc previous) other + apply hprefix (Fin.castSucc previous) + dsimp [previous] + omega + · intro earlier hearlier other + apply hprefix earlier + have hprev : previous.val = acceptTime.val - 1 := rfl + omega + +end CLFirstAcceptance + +namespace CLArbitraryVerifierSoundness + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLLocalWindows +open GapCVP.CLTableauStitching GapCVP.CLTableauSimulationCert +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseTableauSimulation +open GapCVP.CLPhaseGlobalSimulation + +private noncomputable def AllAnchoredVerificationWindows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) : Bool := + @decide ( + ∀ position : Position width, + AnchoredVerificationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position) + ) (Classical.propDecidable _) +private theorem anchoredPhase_verification_of_verifying_modes + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hallowed : AnchoredPhaseAllowed machine window) + (hfirst : window.2.1.mode = .verifying) + (hnext : window.2.2.2.mode = .verifying) : + AnchoredVerificationAllowed machine window := by + have allowed := hallowed + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredPhaseAllowed, decide_eq_true_eq] at allowed + have hcases : + AnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window := by + simpa only [hfirst] using allowed.2 + rcases hcases with hverify | haccept + · exact hverify + · have acceptance := haccept + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredAcceptanceAllowed, + GapCVP.CLCompleteVerifierSimulation.CompleteAcceptanceAllowed, + decide_eq_true_eq] at acceptance + have acceptanceOuter := ofClassicalDecide acceptance + have acceptanceCore := ofClassicalDecide acceptanceOuter.1 + rw [acceptanceCore.1] at hnext + cases hnext + +private theorem allAnchoredVerificationWindows_script + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hwindows : AllAnchoredVerificationWindows + machine width first next) + (position : Position width) : + scriptBlockAllowed machine + (completeScriptWindow machine.tm + (anchoredVerifierWindowAt machine.tm width + first next position)) = true := by + have windows := hwindows + simp only [AllAnchoredVerificationWindows, decide_eq_true_eq] at windows + have verification := windows position + simp only [AnchoredVerificationAllowed, CompleteVerificationAllowed, + decide_eq_true_eq] at verification + exact verification.1.2.2 + +private theorem allAnchoredVerificationWindows_scriptCoherent + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hwindows : AllAnchoredVerificationWindows + machine width first next) + (position : Position width) : + ScriptBlockCoherent machine.tm + (completeScriptWindow machine.tm + (anchoredVerifierWindowAt machine.tm width + first next position)) := + ((scriptBlockAllowed_iff machine + (completeScriptWindow machine.tm + (anchoredVerifierWindowAt machine.tm width + first next position))).mp + (allAnchoredVerificationWindows_script machine width + first next hwindows position)).1 + +private theorem allAnchoredVerificationWindows_hint_constant + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hwindows : AllAnchoredVerificationWindows + machine width first next) : + ∀ position : Position width, + (first position).script.2.1 = (first 0).script.2.1 := by + intro position + induction position using Fin.induction with + | zero => rfl + | succ position ih => + have coherent := + allAnchoredVerificationWindows_scriptCoherent + machine width first next hwindows position.succ + simp only [GapCVP.CLTableauSimulationCert.ScriptBlockCoherent, decide_eq_true_eq] at coherent + have hleft := coherent.2.2.1 + change + (first (leftBlock width position.succ)).script.2.1 = + (first position.succ).script.2.1 at hleft + rw [leftBlock_succ] at hleft + exact hleft.symm.trans ih + +end CLArbitraryVerifierSoundness + +namespace CLStackShiftSoundness + +open Computability Turing GapCVP.CLBoundedStates GapCVP.CLPushAlphabet GapCVP.CLLocalWindows +open GapCVP.CLCompleteLocalCompiler GapCVP.CLExactVerifierTransition + +private noncomputable def OccupiedAtomTrack + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (atoms : List (CellAtom machine.tm)) : Bool := + @decide ( + ∀ atom ∈ atoms, + ∃ value : machine.tm.Γ stack, + cellAtomValue machine stack atom = some value + ) (Classical.propDecidable _) +private theorem occupiedAtomTrack_filterMap_drop + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (atoms : List (CellAtom machine.tm)) + (hoccupied : OccupiedAtomTrack machine stack atoms) + (count : ℕ) : + (atoms.filterMap (cellAtomValue machine stack)).drop count = + (atoms.drop count).filterMap (cellAtomValue machine stack) := by + induction count generalizing atoms with + | zero => simp only [List.drop_zero] + | succ count induction => + cases atoms with + | nil => simp only [List.filterMap_nil, List.drop_nil] + | cons atom rest => + have hoccupied' := hoccupied + simp only [OccupiedAtomTrack, decide_eq_true_eq] at hoccupied' + obtain ⟨value, equation⟩ := hoccupied' atom (by simp only [List.mem_cons, true_or]) + have restOccupied : OccupiedAtomTrack machine stack rest := by + simp only [OccupiedAtomTrack, decide_eq_true_eq] + intro candidate membership + exact hoccupied' candidate (by simp only [List.mem_cons, membership, or_true]) + simpa only [equation, Option.some.injEq, List.filterMap_cons_some, List.drop_succ_cons] using + induction rest restOccupied + +private theorem decodedCommonSuffix_of_occupied_atom_suffix + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (first next : List (CellAtom machine.tm)) + (hfirst : OccupiedAtomTrack machine stack first) + (hnext : OccupiedAtomTrack machine stack next) + (firstDrop nextDrop : ℕ) + (hcommon : first.drop firstDrop = next.drop nextDrop) : + (first.filterMap (cellAtomValue machine stack)).drop firstDrop = + (next.filterMap (cellAtomValue machine stack)).drop nextDrop := by + calc + (first.filterMap (cellAtomValue machine stack)).drop firstDrop = + (first.drop firstDrop).filterMap + (cellAtomValue machine stack) := + occupiedAtomTrack_filterMap_drop + machine stack first hfirst firstDrop + _ = (next.drop nextDrop).filterMap + (cellAtomValue machine stack) := by rw [hcommon] + _ = (next.filterMap + (cellAtomValue machine stack)).drop nextDrop := + (occupiedAtomTrack_filterMap_drop + machine stack next hnext nextDrop).symm + +private noncomputable def OccupiedStackShiftAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (hint : SingleStackHint machine.tm) + (window : StackShiftWindow machine.tm) : Bool := + @decide ( + StackShiftAllowed machine.tm hint window ∧ + ∀ offset : Fin (blockSize machine.tm), + offset.val < hint.2.1.val → + (cellAtomValue machine stack (hint.2.2 offset)).isSome = true + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def OccupiedVerifierPrefix + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (hint : FiniteVerifierHint machine.tm) : Bool := + @decide ( + ∀ (stack : machine.tm.K) + (offset : Fin (blockSize machine.tm)), + offset.val < (hint stack).2.1.val → + (cellAtomValue machine stack + ((hint stack).2.2 offset)).isSome = true + ) (Classical.propDecidable _) + +end CLStackShiftSoundness + +namespace CLStackVerifierSimulation + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism +open GapCVP.CLBoundedStates GapCVP.CLPushAlphabet GapCVP.CLCellRows +open GapCVP.CLExactStackRules GapCVP.CLCompleteLocalCompiler +open GapCVP.CLExactVerifierTransition GapCVP.CLLocalTableauCompiler +open GapCVP.CLVerifierTableauEmission GapCVP.CLUnconditionalTableau +open GapCVP.CLGlobalTableauSimulation GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLPhaseTableauSimulation GapCVP.CLStackShiftSoundness + +private theorem canonicalVerifierScriptHints_occupied + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hint : FiniteVerifierHint machine.tm) + (hscript : scriptVerifierAllowed machine + (scriptVerifierQueryOf machine first next + hfirst hnext hint) = true) + (hwindows : AllVerifierStackWindows machine width + first next hfirst hnext hint) : + OccupiedVerifierPrefix machine hint := by + simp only [GapCVP.CLStackShiftSoundness.OccupiedVerifierPrefix, decide_eq_true_eq] + have windows := hwindows + simp only [GapCVP.CLExactVerifierTransition.AllVerifierStackWindows, decide_eq_true_eq] + at windows + obtain ⟨label, hlabel, hcontrol, hstate, hchecks⟩ := + (scriptVerifierAllowed_iff machine + (scriptVerifierQueryOf machine first next + hfirst hnext hint)).mp hscript + intro stack offset hoffset + let run := finiteHeadScriptRun machine label first.var + (fun target => atomBlockAt machine.tm + (canonicalStackAtoms machine target + (first.stk target) (stackAtomSupported_supportedValues machine first hfirst target)) 0) + have hcheck := hchecks stack + change + (hint stack).1.val = run.2.2.dropped stack ∧ + (hint stack).2.1.val = + (run.2.2.pushed stack).length ∧ + (decodedAtomBlock machine stack + (atomBlockAt machine.tm + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) + 0)).take + (run.2.2.pushed stack).length = + run.2.2.pushed stack at hcheck + have hdecodedPrefix := hcheck.2.2 + rw [decodedAtomBlock_canonical] at hdecodedPrefix + have hlength := congrArg List.length hdecodedPrefix + simp only [List.length_take] at hlength + have hvalueBound : offset.val < (next.stk stack).length := by + have hcount := hcheck.2.1 + omega + have hatom := + prefixHintCorrect_of_allStackShiftWindows machine.tm width + (canonicalStackAtoms machine stack + (first.stk stack) (stackAtomSupported_supportedValues machine first hfirst stack)) + (canonicalStackAtoms machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack)) + (hint stack) (windows stack) + simp only [GapCVP.CLFiniteShiftWindows.PrefixHintCorrect, + decide_eq_true_eq] at hatom + have hatom := hatom offset hoffset + rw [hatom, + paddedAtom_decode machine stack + (canonicalStackAtoms_forall₂ machine stack + (next.stk stack) (stackAtomSupported_supportedValues machine next hnext stack))] + simp only [hvalueBound, getElem?_pos, Option.isSome_some] + +/-- GapCVP reduction support. -/ +noncomputable def StackSoundAnchoredVerificationAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + AnchoredVerificationAllowed machine window ∧ + OccupiedVerifierPrefix machine window.2.1.script.2.1 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def StackSoundAnchoredPhaseAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + CompletePhaseCoherent machine.tm window ∧ + match window.2.1.mode with + | .guessing => + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window + | .verifying => + StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window + | .accepting => + window.2.2.2 = acceptingPhaseCell machine.tm + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def stackSoundAnchoredPhaseAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := by + classical + exact decide (StackSoundAnchoredPhaseAllowed machine window) + +theorem stackSoundAnchoredPhaseAllowed_iff + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : + stackSoundAnchoredPhaseAllowed machine window = true ↔ + StackSoundAnchoredPhaseAllowed machine window := by + classical + simp only [stackSoundAnchoredPhaseAllowed, Bool.decide_eq_true] + +private theorem stackSoundAnchoredPhaseAllowed_implies_anchored + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hallowed : StackSoundAnchoredPhaseAllowed machine window) : + AnchoredPhaseAllowed machine window := by + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredPhaseAllowed, decide_eq_true_eq] + have hallowed' := hallowed + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] at hallowed' + refine ⟨hallowed'.1, ?_⟩ + cases mode : window.2.1.mode with + | guessing => + simpa only [mode] using hallowed'.2 + | verifying => + have cases : + StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window := by + simpa only [mode] using hallowed'.2 + rcases cases with verification | acceptance + · have verification' := verification + simp only [StackSoundAnchoredVerificationAllowed, decide_eq_true_eq] at verification' + simpa only using Or.inl verification'.1 + · simpa only using Or.inr acceptance + | accepting => + simpa only [mode] using hallowed'.2 + +/-- GapCVP reduction support. -/ +def stackSoundAnchoredPhaseSymbolAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : WindowSymbols (completePhaseSymbolCount machine.tm)) : Bool := + stackSoundAnchoredPhaseAllowed machine + ((completePhaseSymbolEquiv machine.tm).symm window.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.2) + +/-- GapCVP reduction support. -/ +def stackSoundAnchoredPhaseSpecification + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + Specification + ((nondeterministicTableauDimensionPolynomial bound machine).eval + x.length) + (completePhaseSymbolCount machine.tm) where + input position := + completePhaseSymbolEquiv machine.tm + (initialPhaseCell bound machine x position) + accept := + completePhaseSymbolEquiv machine.tm + (acceptingPhaseCell machine.tm) + allowed := stackSoundAnchoredPhaseSymbolAllowed machine + +end CLStackVerifierSimulation + +namespace CLAnchoredTraceSimulation + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLPushAlphabet +open GapCVP.CLCellRowBounds GapCVP.CLExactVerifierTransition GapCVP.CLTableauSimulationCert +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseCompleteness +open GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseTraceInduction GapCVP.CLPhaseGlobalSimulation +open GapCVP.CLWholeTraceSoundness GapCVP.CLFirstAcceptance GapCVP.CLArbitraryVerifierSoundness +open GapCVP.CLStackVerifierSimulation + +private theorem stackSoundSymbolAllowed_implies_anchored + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : WindowSymbols (completePhaseSymbolCount machine.tm)) + (hallowed : + stackSoundAnchoredPhaseSymbolAllowed machine window = true) : + anchoredPhaseSymbolAllowed machine window = true := by + let decoded : CompletePhaseWindow machine.tm := + ((completePhaseSymbolEquiv machine.tm).symm window.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.2) + have hcorrected : StackSoundAnchoredPhaseAllowed machine decoded := by + apply (stackSoundAnchoredPhaseAllowed_iff machine decoded).mp + exact hallowed + apply (anchoredPhaseAllowed_iff machine decoded).mpr + exact stackSoundAnchoredPhaseAllowed_implies_anchored + machine decoded hcorrected + +private theorem stackSoundValidTrace_to_anchored + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) : + ValidTrace (anchoredPhaseSpecification bound machine x) trace := by + simp only [GapCVP.CL.ValidTrace, decide_eq_true_eq] + have trace := htrace + simp only [GapCVP.CL.ValidTrace, decide_eq_true_eq] at trace + refine ⟨trace.1, trace.2.1, ?_⟩ + intro window + exact stackSoundSymbolAllowed_implies_anchored machine _ + (trace.2.2 window) + +theorem stackSoundValidTrace_window + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (window : Window (rowWidth bound machine x)) : + StackSoundAnchoredPhaseAllowed machine + (decodeCorrectedPhaseRow machine (trace window.1.1) + (leftPosition window), + decodeCorrectedPhaseRow machine (trace window.1.1) + window.1.2, + decodeCorrectedPhaseRow machine (trace window.1.1) + (rightPosition window), + decodeCorrectedPhaseRow machine + (trace (nextTime window)) window.1.2) := by + have trace := htrace + simp only [GapCVP.CL.ValidTrace, decide_eq_true_eq] at trace + apply (stackSoundAnchoredPhaseAllowed_iff machine _).mp + exact trace.2.2 window + +private theorem stackSoundValidTrace_masks_of_not_accepting + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Time (rowWidth bound machine x)) + (position : Position (rowWidth bound machine x)) + (hmode : (decodeCorrectedPhaseRow machine + (trace time) position).mode ≠ .accepting) : + AnchoredPhaseMasks bound machine x position + (decodeCorrectedPhaseRow machine (trace time) position) := + anchoredValidTrace_masks_of_not_accepting + bound machine x trace + (stackSoundValidTrace_to_anchored + bound machine x trace htrace) + time position hmode + +private theorem stackSoundValidTrace_has_first_checked_acceptance + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) : + ∃ (time : Fin (rowWidth bound machine x)) + (position : Position (rowWidth bound machine x)), + AnchoredAcceptanceAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + position) ∧ + (∀ other : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) other).mode = .verifying) ∧ + (∀ other : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x other + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) other)) ∧ + (∀ (earlier : Time (rowWidth bound machine x)), + earlier.val ≤ time.val → + ∀ other : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace earlier) other).mode ≠ .accepting) := + anchoredValidTrace_has_first_checked_acceptance + bound machine x trace + (stackSoundValidTrace_to_anchored + bound machine x trace htrace) + +private theorem stackSoundPhase_verification_of_verifying_modes + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hallowed : StackSoundAnchoredPhaseAllowed machine window) + (hfirst : window.2.1.mode = .verifying) + (hnext : window.2.2.2.mode = .verifying) : + StackSoundAnchoredVerificationAllowed machine window := by + have allowed := hallowed + simp only [GapCVP.CLStackVerifierSimulation.StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + at allowed + have hcases : + StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window := by + simpa only [hfirst] using allowed.2 + rcases hcases with hverify | haccept + · exact hverify + · have acceptance := haccept + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredAcceptanceAllowed, + GapCVP.CLCompleteVerifierSimulation.CompleteAcceptanceAllowed, + decide_eq_true_eq] at acceptance + have acceptanceOuter := ofClassicalDecide acceptance + have acceptanceCore := ofClassicalDecide acceptanceOuter.1 + rw [acceptanceCore.1] at hnext + cases hnext + +private theorem stackSoundValidTrace_occupied_verification_windows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .verifying) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) : + ∀ position : Position (rowWidth bound machine x), + StackSoundAnchoredVerificationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + position) := by + intro position + apply stackSoundPhase_verification_of_verifying_modes machine _ + · exact stackSoundValidTrace_window + bound machine x trace htrace (windowAt time position) + · exact hfirst position + · exact hnext position + +private theorem actualStep_iff_stackSoundCanonicalVerifierWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstSpace : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ rowWidth bound machine x) + (hnextSpace : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ rowWidth bound machine x) : + machine.tm.step first = some next ↔ + ∃ (firstHint nextHint : FiniteVerifierHint machine.tm), + ∀ position : Position (rowWidth bound machine x), + StackSoundAnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow + bound machine x certificate + first hfirst firstHint false) + (canonicalAnchoredVerifyingRow + bound machine x certificate + next hnext nextHint false) position) := by + constructor + · intro hstep + obtain ⟨firstHint, nextHint, hanchored⟩ := + (actualStep_iff_anchoredCanonicalVerifierWindows + bound machine x certificate first next + hfirst hnext hfirstSpace hnextSpace).mp hstep + have hscriptWindows : + ∀ position : Position (rowWidth bound machine x), + scriptBlockAllowed machine + (scriptBlockWindowAt machine.tm + (rowWidth bound machine x) + (canonicalScriptBlockRow machine + (rowWidth bound machine x) + certificate first hfirst firstHint) + (canonicalScriptBlockRow machine + (rowWidth bound machine x) + certificate next hnext nextHint) + position) = true := by + intro position + exact (canonicalAnchoredVerifierWindow_allowed_iff + bound machine x certificate first next hfirst hnext + firstHint nextHint false position).mp + (hanchored position) + obtain ⟨hscript, hstackWindows⟩ := + (canonicalScriptBlockWindows_iff + machine (rowWidth bound machine x) + certificate first next hfirst hnext + hfirstSpace hnextSpace firstHint nextHint).mp + hscriptWindows + have hoccupied := canonicalVerifierScriptHints_occupied + machine (rowWidth bound machine x) + first next hfirst hnext firstHint hscript hstackWindows + refine ⟨firstHint, nextHint, ?_⟩ + intro position + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + first hfirst firstHint false) + (canonicalAnchoredVerifyingRow bound machine x certificate + next hnext nextHint false) position + have hold : AnchoredPhaseAllowed machine window := + hanchored position + have hfirstMode : window.2.1.mode = .verifying := rfl + have hnextMode : window.2.2.2.mode = .verifying := rfl + have hverify := anchoredPhase_verification_of_verifying_modes + machine window hold hfirstMode hnextMode + change StackSoundAnchoredPhaseAllowed machine window + simp only [GapCVP.CLStackVerifierSimulation.StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + have hold' := hold + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredPhaseAllowed, decide_eq_true_eq] at hold' + refine ⟨hold'.1, ?_⟩ + change StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window + left + simp only [GapCVP.CLStackVerifierSimulation.StackSoundAnchoredVerificationAllowed, + decide_eq_true_eq] + exact ⟨hverify, hoccupied⟩ + · rintro ⟨firstHint, nextHint, hwindows⟩ + apply (actualStep_iff_anchoredCanonicalVerifierWindows + bound machine x certificate first next + hfirst hnext hfirstSpace hnextSpace).mpr + refine ⟨firstHint, nextHint, ?_⟩ + intro position + exact stackSoundAnchoredPhaseAllowed_implies_anchored machine _ + (hwindows position) + +end CLAnchoredTraceSimulation + +namespace CLArbitraryRowOccupancy + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLPushAlphabet +open GapCVP.CLLocalWindows GapCVP.CLExactStackRules GapCVP.CLCompleteLocalCompiler +open GapCVP.CLTableauSimulationCert GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLPhaseGlobalSimulation GapCVP.CLStackVerifierSimulation + +private noncomputable def DecodableOrBlank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (atom : CellAtom machine.tm) : Bool := + @decide ( + atom = none ∨ + ∃ value : machine.tm.Γ stack, + cellAtomValue machine stack atom = some value + ) (Classical.propDecidable _) +private theorem decodableOrBlank_of_isSome + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (atom : CellAtom machine.tm) + (hoccupied : (cellAtomValue machine stack atom).isSome = true) : + DecodableOrBlank machine stack atom := by + simp only [DecodableOrBlank, decide_eq_true_eq] + cases decoded : cellAtomValue machine stack atom with + | none => simp only [decoded, Option.isSome_none, Bool.false_eq_true] at hoccupied + | some value => exact Or.inr ⟨value, rfl⟩ + +private theorem initialPairedAtom_decodableOrBlank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (tag : PairedInputTag) : + DecodableOrBlank machine stack + (initialPairedAtom machine stack tag) := by + simp only [DecodableOrBlank, decide_eq_true_eq] + cases tag with + | marker => exact Or.inl rfl + | blank => exact Or.inl rfl + | bit bit => + by_cases hstack : stack = machine.tm.k₀ + · subst stack + right + refine ⟨machine.inputAlphabet.invFun bit, ?_⟩ + simp only [initialPairedAtom, ↓reduceIte, Equiv.invFun_as_coe, canonicalCellAtom_decode] + · left + simp only [initialPairedAtom, hstack, ↓reduceIte] + +private theorem initializedPhaseBlock_decodableOrBlank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (old : BlockCell machine.tm) + (payload : PairedInputBlock machine.tm) + (range : PhaseMaskBlock machine.tm) + (stack : machine.tm.K) + (offset : Fin (blockSize machine.tm)) : + DecodableOrBlank machine stack + ((initializedPhaseBlock machine old payload range + offset).2.2.1 stack) := by + by_cases hrange : range offset = true + · have hrangeBool : range offset := by simpa only using hrange + simp only [initializedPhaseBlock, hrangeBool, ↓reduceIte] + exact initialPairedAtom_decodableOrBlank machine stack (payload offset) + · have hfalse := Bool.eq_false_of_not_eq_true hrange + simp only [DecodableOrBlank, initializedPhaseBlock, hfalse, Bool.false_eq_true, ↓reduceIte, + blankCell, + cellAtomValue_blank, reduceCtorEq, exists_false, or_false, decide_true] + +/-- GapCVP reduction support. -/ +noncomputable def PhaseRowAtomsWellTyped + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) : Bool := + @decide ( + ∀ (position : Position width) + (stack : machine.tm.K) + (offset : Fin (blockSize machine.tm)), + DecodableOrBlank machine stack + ((completeMachineBlock machine.tm (row position) + offset).2.2.1 stack) + ) (Classical.propDecidable _) +private theorem occupiedShift_preserves_decodableOrBlank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (hint : SingleStackHint machine.tm) + (window : StackShiftWindow machine.tm) + (hshift : StackShiftAllowed machine.tm hint window) + (hprefix : ∀ offset : Fin (blockSize machine.tm), + offset.val < hint.2.1.val → + (cellAtomValue machine stack + (hint.2.2 offset)).isSome = true) + (hleft : ∀ offset : Fin (blockSize machine.tm), + DecodableOrBlank machine stack (window.1 offset)) + (hcenter : ∀ offset : Fin (blockSize machine.tm), + DecodableOrBlank machine stack (window.2.1 offset)) + (hright : ∀ offset : Fin (blockSize machine.tm), + DecodableOrBlank machine stack (window.2.2.1 offset)) : + ∀ offset : Fin (blockSize machine.tm), + DecodableOrBlank machine stack + (window.2.2.2.1 offset) := by + have hshift' := hshift + simp only [StackShiftAllowed, decide_eq_true_eq] at hshift' + intro offset + rw [hshift' offset] + unfold shiftedWindowAtom + split + next guard => + exact decodableOrBlank_of_isSome machine stack (hint.2.2 offset) + (hprefix offset guard.2) + next _ => + split + next _ => exact hleft _ + next _ => + dsimp only + split + next _ => exact hcenter _ + next _ => exact hright _ + +private theorem allCorrectedVerifierWindows_preserve_wellTyped_rows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hfirst : PhaseRowAtomsWellTyped machine width first) + (hwindows : ∀ position : Position width, + StackSoundAnchoredVerificationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position)) : + PhaseRowAtomsWellTyped machine width next := by + simp only [GapCVP.CLArbitraryRowOccupancy.PhaseRowAtomsWellTyped, decide_eq_true_eq] + have firstTyped := hfirst + simp only [GapCVP.CLArbitraryRowOccupancy.PhaseRowAtomsWellTyped, decide_eq_true_eq] + at firstTyped + intro position stack offset + let window := anchoredVerifierWindowAt machine.tm + width first next position + have hverification := hwindows position + simp only [GapCVP.CLStackVerifierSimulation.StackSoundAnchoredVerificationAllowed, + decide_eq_true_eq] at hverification + have anchored := hverification.1 + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredVerificationAllowed, decide_eq_true_eq] + at anchored + have complete := anchored.1 + simp only [GapCVP.CLCompleteVerifierSimulation.CompleteVerificationAllowed, decide_eq_true_eq] + at complete + have occupied := hverification.2 + simp only [GapCVP.CLStackShiftSoundness.OccupiedVerifierPrefix, decide_eq_true_eq] at occupied + have hscript : scriptBlockAllowed machine + (completeScriptWindow machine.tm window) = true := + complete.2.2 + obtain ⟨_, _, _, _, hstacks⟩ := + (scriptBlockAllowed_iff machine + (completeScriptWindow machine.tm window)).mp hscript + let stackWindow := stackWindowOfScriptBlock machine.tm + (completeScriptWindow machine.tm window) stack + have hshift : StackShiftAllowed machine.tm + ((first position).script.2.1 stack) stackWindow := + (stackShiftAllowed_iff machine.tm + ((first position).script.2.1 stack) stackWindow).mp + (hstacks stack) + have hprefix : ∀ innerOffset : Fin (blockSize machine.tm), + innerOffset.val < ((first position).script.2.1 stack).2.1.val → + (cellAtomValue machine stack + (((first position).script.2.1 stack).2.2 innerOffset)).isSome = + true := + occupied stack + have hleft : ∀ innerOffset : Fin (blockSize machine.tm), + DecodableOrBlank machine stack (stackWindow.1 innerOffset) := by + intro innerOffset + change DecodableOrBlank machine stack + ((completeMachineBlock machine.tm + (first (leftBlock width position)) innerOffset).2.2.1 stack) + exact firstTyped (leftBlock width position) stack innerOffset + have hcenter : ∀ innerOffset : Fin (blockSize machine.tm), + DecodableOrBlank machine stack + (stackWindow.2.1 innerOffset) := by + intro innerOffset + change DecodableOrBlank machine stack + ((completeMachineBlock machine.tm + (first position) innerOffset).2.2.1 stack) + exact firstTyped position stack innerOffset + have hright : ∀ innerOffset : Fin (blockSize machine.tm), + DecodableOrBlank machine stack + (stackWindow.2.2.1 innerOffset) := by + intro innerOffset + change DecodableOrBlank machine stack + ((completeMachineBlock machine.tm + (first (rightBlock width position)) innerOffset).2.2.1 stack) + exact firstTyped (rightBlock width position) stack innerOffset + exact occupiedShift_preserves_decodableOrBlank + machine stack ((first position).script.2.1 stack) + stackWindow hshift hprefix hleft hcenter hright offset + +end CLArbitraryRowOccupancy + +namespace CLWholeTimeOccupancy + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLCellRowBounds +open GapCVP.CLLocalWindows GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseCompleteness +open GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseGlobalSimulation GapCVP.CLValidTraceSoundness +open GapCVP.CLWholeTraceSoundness GapCVP.CLStackVerifierSimulation +open GapCVP.CLAnchoredTraceSimulation GapCVP.CLArbitraryRowOccupancy + +private theorem stackSoundPhase_initialization_of_modes + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hallowed : StackSoundAnchoredPhaseAllowed machine window) + (hfirst : window.2.1.mode = .guessing) + (hnext : window.2.2.2.mode = .verifying) : + AnchoredInitializationAllowed machine window := by + have allowed := hallowed + simp only [GapCVP.CLStackVerifierSimulation.StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + at allowed + have hcases : + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window := by + simpa only [hfirst] using allowed.2 + rcases hcases with hguess | hinit + · have guess := hguess + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredGuessingAllowed, + GapCVP.CLPhaseSpecification.CorrectedGuessingAllowed, + decide_eq_true_eq] at guess + have hguessMode := guess.1.1 + rw [hnext] at hguessMode + cases hguessMode + · exact hinit + +private theorem initializationWindow_next_wellTyped + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hinit : AnchoredInitializationAllowed machine window) + (stack : machine.tm.K) + (offset : Fin (blockSize machine.tm)) : + DecodableOrBlank machine stack + ((completeMachineBlock machine.tm + window.2.2.2 offset).2.2.1 stack) := by + have initial := hinit + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredInitializationAllowed, + GapCVP.CLCompleteVerifierSimulation.CompleteInitializationAllowed, + decide_eq_true_eq] at initial + have initialOuter := ofClassicalDecide initial + have initialCore := ofClassicalDecide initialOuter.1 + have hblock := initialCore.2.2.1 + rw [hblock] + exact initializedPhaseBlock_decodableOrBlank machine + (completeMachineBlock machine.tm window.2.1) + window.2.1.payload window.2.1.range stack offset + +theorem stackSoundValidTrace_all_verifier_rows_wellTyped + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Time (rowWidth bound machine x)) : + (∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time) position).mode = .verifying) → + PhaseRowAtomsWellTyped machine (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time)) := by + have hanchored := stackSoundValidTrace_to_anchored + bound machine x trace htrace + induction time using Fin.induction with + | zero => + intro hmode + have hzero := hmode 0 + have hinitial : + decodeCorrectedPhaseRow machine (trace 0) 0 = + initialPhaseCell bound machine x 0 := by + exact anchoredTrace_initial + bound machine x trace hanchored 0 + rw [hinitial] at hzero + cases hzero + | succ time ih => + intro hnextModes + cases hsource : + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) 0).mode with + | guessing => + simp only [GapCVP.CLArbitraryRowOccupancy.PhaseRowAtomsWellTyped, decide_eq_true_eq] + intro position stack offset + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + position + have hallowed : + StackSoundAnchoredPhaseAllowed machine window := + stackSoundValidTrace_window + bound machine x trace htrace (windowAt time position) + have hfirstMode : window.2.1.mode = .guessing := by + have hcoherent := anchoredValidTrace_mode_constant + bound machine x trace hanchored time position + exact hcoherent.trans hsource + have hnextMode : window.2.2.2.mode = .verifying := + hnextModes position + have hinit := stackSoundPhase_initialization_of_modes + machine window hallowed hfirstMode hnextMode + exact initializationWindow_next_wellTyped + machine window hinit stack offset + | verifying => + have hsourceModes : + ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = + .verifying := by + intro position + exact (anchoredValidTrace_mode_constant + bound machine x trace hanchored time position).trans + hsource + have hsourceWellTyped := ih hsourceModes + exact allCorrectedVerifierWindows_preserve_wellTyped_rows + machine (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + hsourceWellTyped + (stackSoundValidTrace_occupied_verification_windows + bound machine x trace htrace time + hsourceModes hnextModes) + | accepting => + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) 0 + have hallowed : + StackSoundAnchoredPhaseAllowed machine window := + stackSoundValidTrace_window + bound machine x trace htrace (windowAt time 0) + have hsourceMode : window.2.1.mode = .accepting := by + change + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) 0).mode = .accepting + exact hsource + have allowed := hallowed + simp only [GapCVP.CLStackVerifierSimulation.StackSoundAnchoredPhaseAllowed, + decide_eq_true_eq] at allowed + have hclear : + window.2.2.2 = acceptingPhaseCell machine.tm := by + simpa only [hsourceMode] using allowed.2 + have hnext := hnextModes 0 + change window.2.2.2.mode = .verifying at hnext + rw [hclear] at hnext + cases hnext + +end CLWholeTimeOccupancy + +namespace CLRawTrackSimulation + +open Computability Turing GapCVP.CLBoundedStates GapCVP.CLPushAlphabet +open GapCVP.CLStackShiftSoundness + +private theorem filterMap_ofFn_comp + {α β : Type} + (size : ℕ) + (atoms : Fin size → α) + (decode : α → Option β) : + (List.ofFn (fun index : Fin size => + decode (atoms index))).filterMap id = + (List.ofFn atoms).filterMap decode := by + induction size with + | zero => simp only [id_eq, List.ofFn_zero, List.filterMap_nil] + | succ size ih => + cases hhead : decode (atoms 0) with + | none => + simpa only [id_eq, List.ofFn_succ, hhead, List.filterMap_cons_none] using + ih (fun index : Fin size => atoms index.succ) + | some value => + simpa only [id_eq, List.ofFn_succ, hhead, Option.some.injEq, List.filterMap_cons_some, + List.cons.injEq, + true_and] using ih (fun index : Fin size => atoms index.succ) + +private theorem filterMap_filter_isSome + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (atoms : List (CellAtom machine.tm)) : + (atoms.filter Option.isSome).filterMap + (cellAtomValue machine stack) = + atoms.filterMap (cellAtomValue machine stack) := by + induction atoms with + | nil => simp only [List.filter_nil, List.filterMap_nil] + | cons atom rest ih => + cases atom with + | none => + rw [List.filter_cons_of_neg (by simp only [Option.isSome_none, + Bool.false_eq_true, not_false_eq_true]), ih] + exact (List.filterMap_cons_none + (cellAtomValue_blank machine stack)).symm + | some value => + cases hdecode : cellAtomValue machine stack (some value) with + | none => simp only [Option.isSome_some, List.filter_cons_of_pos, hdecode, + List.filterMap_cons_none, ih] + | some decoded => simp only [Option.isSome_some, List.filter_cons_of_pos, hdecode, + Option.some.injEq, List.filterMap_cons_some, + ih] + +private theorem occupiedAtomTrack_filterMap_length + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (atoms : List (CellAtom machine.tm)) + (hoccupied : OccupiedAtomTrack machine stack atoms) : + (atoms.filterMap (cellAtomValue machine stack)).length = + atoms.length := by + induction atoms with + | nil => simp only [List.filterMap_nil, List.length_nil] + | cons atom rest ih => + have occupied := hoccupied + simp only [GapCVP.CLStackShiftSoundness.OccupiedAtomTrack, decide_eq_true_eq] at occupied + obtain ⟨value, hvalue⟩ := occupied atom (by simp only [List.mem_cons, true_or]) + have hrest : OccupiedAtomTrack machine stack rest := by + simp only [GapCVP.CLStackShiftSoundness.OccupiedAtomTrack, decide_eq_true_eq] + intro candidate hcandidate + exact occupied candidate (by simp only [List.mem_cons, hcandidate, or_true]) + simp only [hvalue, Option.some.injEq, List.filterMap_cons_some, List.length_cons, ih hrest] + +end CLRawTrackSimulation + +namespace CLCompactWindowSoundness + +open Computability Turing GapCVP.CLBoundedStates GapCVP.CLCellRows GapCVP.CLLocalWindows +open GapCVP.CLCompleteLocalCompiler GapCVP.CLStackShiftSoundness2 + +/-- GapCVP reduction support. -/ +noncomputable def NoInteriorPaddingHoles + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) : Bool := + @decide ( + ∃ (occupied : List (CellAtom tm)) (padding : ℕ), + NoBlankAtoms tm occupied ∧ + atoms = occupied ++ List.replicate padding none + ) (Classical.propDecidable _) +private theorem filter_isSome_eq_self_of_noBlank + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) + (hnoblank : NoBlankAtoms tm atoms) : + atoms.filter Option.isSome = atoms := by + induction atoms with + | nil => simp only [List.filter_nil] + | cons atom rest induction => + have hnoblank' := hnoblank + simp only [NoBlankAtoms, decide_eq_true_eq] at hnoblank' + have restNoBlank : NoBlankAtoms tm rest := by + simp only [NoBlankAtoms, decide_eq_true_eq] + intro candidate membership + exact hnoblank' candidate (by simp only [List.mem_cons, membership, or_true]) + cases atom with + | none => exact (hnoblank' none (by simp only [List.mem_cons, true_or]) rfl).elim + | some value => simp only [Option.isSome_some, List.filter_cons_of_pos, induction restNoBlank] + +private theorem paddedAtom_append_blank_padding + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) + (padding index : ℕ) : + paddedAtom (atoms ++ List.replicate padding none) index = + paddedAtom atoms index := by + by_cases hindex : index < atoms.length + · simp only [paddedAtom, List.getElem?_append, hindex, ↓reduceIte, getElem?_pos, + Option.getD_some] + · simp only [paddedAtom, List.getElem?_append, hindex, ↓reduceIte, + List.getElem?_getD_replicate_default_eq, + not_false_eq_true, getElem?_neg, Option.getD_none] + +private theorem noHoles_padded_compact + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) + (hholes : NoInteriorPaddingHoles tm atoms) + (index : ℕ) : + paddedAtom atoms index = + paddedAtom (atoms.filter Option.isSome) index := by + have hholes' := hholes + simp only [NoInteriorPaddingHoles, decide_eq_true_eq] at hholes' + obtain ⟨occupied, padding, noBlank, equality⟩ := hholes' + subst atoms + have filtered : + (occupied ++ List.replicate padding none).filter Option.isSome = occupied := by + simp only [List.filter_append, filter_isSome_eq_self_of_noBlank tm occupied noBlank, + Option.isSome_none, + Bool.false_eq_true, not_false_eq_true, List.filter_replicate_of_neg, List.append_nil] + rw [filtered] + exact paddedAtom_append_blank_padding tm occupied padding index + +private theorem noHoles_atomBlockAt_compact + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) + (hholes : NoInteriorPaddingHoles tm atoms) + (position : ℕ) : + atomBlockAt tm atoms position = + atomBlockAt tm (atoms.filter Option.isSome) position := by + funext offset + exact noHoles_padded_compact tm atoms hholes + (position * blockSize tm + offset.val) + +end CLCompactWindowSoundness + +namespace CLNoHoleTimeInduction + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLPushAlphabet +open GapCVP.CLCellRows GapCVP.CLLocalWindows GapCVP.CLCompleteLocalCompiler +open GapCVP.CLStackShiftSoundness2 GapCVP.CLFiniteShiftWindows +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseTableauSimulation +open GapCVP.CLPhaseGlobalSimulation GapCVP.CLStackShiftSoundness GapCVP.CLCompactWindowSoundness + +private noncomputable def BlankPaddingMonotone + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) : Bool := + @decide ( + ∀ first next : ℕ, + first ≤ next → + paddedAtom atoms first = none → + paddedAtom atoms next = none + ) (Classical.propDecidable _) +private theorem paddedAtom_none_iff_length_le_of_noBlank + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) + (hoccupied : NoBlankAtoms tm atoms) + (index : ℕ) : + paddedAtom atoms index = none ↔ atoms.length ≤ index := by + have hoccupied' := hoccupied + simp only [NoBlankAtoms, decide_eq_true_eq] at hoccupied' + constructor + · intro blank + by_contra bound + have indexBound : index < atoms.length := by omega + have equation : atoms[index] = none := by + simpa only [paddedAtom, indexBound, getElem?_pos, Option.getD_some] using blank + exact hoccupied' atoms[index] (List.getElem_mem indexBound) equation + · exact paddedAtom_none_of_length_le tm atoms index + +private theorem blankPaddingMonotone_of_noInteriorPaddingHoles + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) + (hholes : NoInteriorPaddingHoles tm atoms) : + BlankPaddingMonotone tm atoms := by + simp only [BlankPaddingMonotone, decide_eq_true_eq] + have hholes' := hholes + simp only [NoInteriorPaddingHoles, decide_eq_true_eq] at hholes' + obtain ⟨occupied, padding, occupiedNoBlank, equality⟩ := hholes' + subst atoms + intro first next order firstBlank + rw [paddedAtom_append_blank_padding tm occupied padding first] at firstBlank + rw [paddedAtom_append_blank_padding tm occupied padding next] + exact (paddedAtom_none_iff_length_le_of_noBlank tm occupied occupiedNoBlank next).mpr + (le_trans + ((paddedAtom_none_iff_length_le_of_noBlank tm occupied occupiedNoBlank first).mp + firstBlank) order) + +private theorem noInteriorPaddingHoles_of_blankPaddingMonotone + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) + (hmonotone : BlankPaddingMonotone tm atoms) : + NoInteriorPaddingHoles tm atoms := by + simp only [NoInteriorPaddingHoles, decide_eq_true_eq] + have hmonotone' := hmonotone + simp only [BlankPaddingMonotone, decide_eq_true_eq] at hmonotone' + induction atoms with + | nil => + refine ⟨[], 0, ?_, ?_⟩ + · simp only [NoBlankAtoms, List.not_mem_nil, ne_eq, IsEmpty.forall_iff, implies_true, + decide_true] + · simp only [List.replicate_zero, List.append_nil] + | cons atom rest induction => + cases atom with + | none => + have restBlank : ∀ candidate ∈ rest, candidate = none := by + intro candidate membership + obtain ⟨index, bound, value⟩ := List.getElem_of_mem membership + have blank := hmonotone' 0 (index + 1) (Nat.zero_le _) + (by simp only [paddedAtom, List.length_cons, lt_add_iff_pos_left, Order.lt_add_one_iff, + zero_le, getElem?_pos, + List.getElem_cons_zero, Option.getD_some]) + have entry : rest[index] = none := by + simpa only [paddedAtom, List.length_cons, Order.lt_add_one_iff, Order.add_one_le_iff, + bound, getElem?_pos, + List.getElem_cons_succ, Option.getD_some] using blank + exact value.symm.trans entry + have replicated : rest = List.replicate rest.length none := + List.eq_replicate_of_mem restBlank + refine ⟨[], rest.length + 1, ?_, ?_⟩ + · simp only [NoBlankAtoms, List.not_mem_nil, ne_eq, IsEmpty.forall_iff, implies_true, + decide_true] + · simpa only [List.nil_append, List.replicate_succ] using + congrArg (List.cons none) replicated + | some value => + have restMonotone : BlankPaddingMonotone tm rest := by + simp only [BlankPaddingMonotone, decide_eq_true_eq] + intro first next order blank + have shifted := hmonotone' (first + 1) (next + 1) (by omega) + apply shifted + simpa only [paddedAtom, List.getElem?_cons_succ] using blank + have restMonotone' := restMonotone + simp only [BlankPaddingMonotone, decide_eq_true_eq] at restMonotone' + obtain ⟨occupied, padding, noBlank, decomposition⟩ := + induction restMonotone restMonotone' + refine ⟨some value :: occupied, padding, ?_, ?_⟩ + · simp only [NoBlankAtoms, decide_eq_true_eq] at noBlank ⊢ + intro candidate membership + simp only [List.mem_cons] at membership + rcases membership with rfl | membership + · simp only [ne_eq, reduceCtorEq, not_false_eq_true] + · exact noBlank candidate membership + · simp only [decomposition, List.cons_append] + +private theorem noHoles_stackShiftWindow_source_compact + (tm : Turing.FinTM2) + (width : ℕ) + (first next : List (CellAtom tm)) + (hfirst : NoInteriorPaddingHoles tm first) + (position : Fin (width + 1)) : + stackShiftWindowAt tm width first next position = + stackShiftWindowAt tm width + (first.filter Option.isSome) next position := by + simp only [stackShiftWindowAt] + rw [noHoles_atomBlockAt_compact tm first hfirst + (leftBlock width position).val] + rw [noHoles_atomBlockAt_compact tm first hfirst position.val] + rw [noHoles_atomBlockAt_compact tm first hfirst + (rightBlock width position).val] + +private theorem occupiedRawWindows_prefix_nonblank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (stack : machine.tm.K) + (first next : List (CellAtom machine.tm)) + (hint : SingleStackHint machine.tm) + (hwindows : ∀ position : Fin (width + 1), + OccupiedStackShiftAllowed machine stack hint + (stackShiftWindowAt machine.tm width + first next position)) + (index : ℕ) + (hindex : index < hint.2.1.val) : + paddedAtom next index ≠ none := by + let position : Fin (width + 1) := 0 + let offset : Fin (blockSize machine.tm) := + ⟨index, Nat.lt_trans hindex hint.2.1.isLt⟩ + have allowed := hwindows position + simp only [OccupiedStackShiftAllowed, decide_eq_true_eq] at allowed + have shifted := allowed.1 + simp only [StackShiftAllowed, decide_eq_true_eq] at shifted + have cell := shifted offset + change paddedAtom next (position.val * blockSize machine.tm + offset.val) = + shiftedWindowAtom machine.tm hint + (stackShiftWindowAt machine.tm width first next position) offset at cell + have guard : + (stackShiftWindowAt machine.tm width first next position).2.2.2.2 = true ∧ + offset.val < hint.2.1.val := by + simp [stackShiftWindowAt, position, offset, hindex] + rw [shiftedWindowAtom, ite_eq_left guard] at cell + have equation : paddedAtom next index = hint.2.2 offset := by + simpa [position, offset] using cell + intro blank + have occupied := allowed.2 offset (by simpa [offset] using hindex) + rw [← equation, blank] at occupied + simp [cellAtomValue_blank] at occupied + +private theorem occupiedRawWindows_suffix_paddedAtom + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (stack : machine.tm.K) + (first next : List (CellAtom machine.tm)) + (hfirst : NoInteriorPaddingHoles machine.tm first) + (hfirstLength : (first.filter Option.isSome).length ≤ width) + (hint : SingleStackHint machine.tm) + (hwindows : ∀ position : Fin (width + 1), + OccupiedStackShiftAllowed machine stack hint + (stackShiftWindowAt machine.tm width + first next position)) + (index : ℕ) + (hprefix : hint.2.1.val ≤ index) + (hcovered : index < (width + 1) * blockSize machine.tm) : + paddedAtom next index = + paddedAtom (first.filter Option.isSome) + (index - hint.2.1.val + hint.1.val) := by + let position : Fin (width + 1) := + ⟨index / blockSize machine.tm, + (Nat.div_lt_iff_lt_mul (blockSize_pos machine.tm)).mpr hcovered⟩ + let offset : Fin (blockSize machine.tm) := + ⟨index % blockSize machine.tm, + Nat.mod_lt index (blockSize_pos machine.tm)⟩ + have coordinate : position.val * blockSize machine.tm + offset.val = index := by + dsimp [position, offset] + exact Nat.div_add_mod' index (blockSize machine.tm) + have notPrefix : ¬ (position.val = 0 ∧ offset.val < hint.2.1.val) := by + rintro ⟨zero, small⟩ + have coordinate' := coordinate + rw [zero, Nat.zero_mul, Nat.zero_add] at coordinate' + omega + have shift : StackShiftAllowed machine.tm hint + (stackShiftWindowAt machine.tm width + (first.filter Option.isSome) next position) := by + have allowed := hwindows position + simp only [OccupiedStackShiftAllowed, decide_eq_true_eq] at allowed + have raw := allowed.1 + rw [noHoles_stackShiftWindow_source_compact + machine.tm width first next hfirst position] at raw + exact raw + have shift' := shift + simp only [StackShiftAllowed, decide_eq_true_eq] at shift' + have cell := shift' offset + change paddedAtom next (position.val * blockSize machine.tm + offset.val) = + shiftedWindowAtom machine.tm hint + (stackShiftWindowAt machine.tm width + (first.filter Option.isSome) next position) offset at cell + rw [shiftedWindowAtom_eq_old machine.tm width + (first.filter Option.isSome) next hfirstLength + hint position offset notPrefix] at cell + simpa only [coordinate] using cell + +private theorem filter_isSome_noBlank + (tm : Turing.FinTM2) + (atoms : List (CellAtom tm)) : + NoBlankAtoms tm (atoms.filter Option.isSome) := by + simp only [NoBlankAtoms, decide_eq_true_eq] + intro atom membership blank + have some := (List.mem_filter.mp membership).2 + simp only [blank, Option.isSome_none, Bool.false_eq_true] at some + +private theorem occupiedRawWindows_preserve_noInteriorPaddingHoles + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (stack : machine.tm.K) + (first next : List (CellAtom machine.tm)) + (hfirst : NoInteriorPaddingHoles machine.tm first) + (hfirstLength : (first.filter Option.isSome).length ≤ width) + (hnextCapacity : + next.length ≤ (width + 1) * blockSize machine.tm) + (hint : SingleStackHint machine.tm) + (hwindows : ∀ position : Fin (width + 1), + OccupiedStackShiftAllowed machine stack hint + (stackShiftWindowAt machine.tm width + first next position)) : + NoInteriorPaddingHoles machine.tm next := by + apply noInteriorPaddingHoles_of_blankPaddingMonotone + simp only [BlankPaddingMonotone, decide_eq_true_eq] + intro firstIndex nextIndex order blank + by_cases nextBound : nextIndex < next.length + · have nextCovered : nextIndex < (width + 1) * blockSize machine.tm := + Nat.lt_of_lt_of_le nextBound hnextCapacity + have firstCovered : firstIndex < (width + 1) * blockSize machine.tm := by + omega + by_cases firstPrefix : firstIndex < hint.2.1.val + · exact False.elim ((occupiedRawWindows_prefix_nonblank + machine width stack first next hint hwindows firstIndex firstPrefix) blank) + · have firstSuffix : hint.2.1.val ≤ firstIndex := by omega + have nextSuffix : hint.2.1.val ≤ nextIndex := by omega + have sourceBlank : + paddedAtom (first.filter Option.isSome) + (firstIndex - hint.2.1.val + hint.1.val) = none := by + rw [← occupiedRawWindows_suffix_paddedAtom + machine width stack first next hfirst hfirstLength + hint hwindows firstIndex firstSuffix firstCovered] + exact blank + have sourceMonotone : BlankPaddingMonotone machine.tm + (first.filter Option.isSome) := by + apply blankPaddingMonotone_of_noInteriorPaddingHoles + simp only [NoInteriorPaddingHoles, decide_eq_true_eq] + exact ⟨first.filter Option.isSome, 0, + filter_isSome_noBlank machine.tm first, by simp only [List.replicate_zero, + List.append_nil]⟩ + have sourceMonotone' := sourceMonotone + simp only [BlankPaddingMonotone, decide_eq_true_eq] at sourceMonotone' + rw [occupiedRawWindows_suffix_paddedAtom + machine width stack first next hfirst hfirstLength + hint hwindows nextIndex nextSuffix nextCovered] + apply sourceMonotone' + (firstIndex - hint.2.1.val + hint.1.val) + (nextIndex - hint.2.1.val + hint.1.val) + · omega + · exact sourceBlank + · apply paddedAtom_none_of_length_le + omega + +private noncomputable def PhaseRowStackRangeFaithful + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) : Bool := + @decide ( + ∀ (position : Position width) + (stack : machine.tm.K) + (offset : Fin (blockSize machine.tm)), + width + 1 ≤ position.val * blockSize machine.tm + offset.val → + ((completeMachineBlock machine.tm (row position) + offset).2.2.1 stack) = none + ) (Classical.propDecidable _) +private theorem allInitializationWindows_next_stackRangeFaithful + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hrange : ∀ position : Position width, + (first position).range = phaseRangeBlockAt machine.tm width position) + (hwindows : ∀ position : Position width, + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position)) : + PhaseRowStackRangeFaithful machine width next := by + simp only [GapCVP.CLNoHoleTimeInduction.PhaseRowStackRangeFaithful, decide_eq_true_eq] + intro position stack offset hout + have initial := hwindows position + simp only [GapCVP.CLPhaseTableauSimulation.AnchoredInitializationAllowed, + GapCVP.CLCompleteVerifierSimulation.CompleteInitializationAllowed, + decide_eq_true_eq] at initial + have initialOuter := ofClassicalDecide initial + have initialCore := ofClassicalDecide initialOuter.1 + have hblock := initialCore.2.2.1 + change + completeMachineBlock machine.tm (next position) = + initializedPhaseBlock machine + (completeMachineBlock machine.tm (first position)) + (first position).payload (first position).range at hblock + have hfalse : (first position).range offset = false := by + rw [hrange position] + simp only [phaseRangeBlockAt, Nat.not_lt.mpr hout, decide_false] + rw [hblock] + simp only [initializedPhaseBlock, hfalse, Bool.false_eq_true, ↓reduceIte, blankCell] + +end CLNoHoleTimeInduction + +namespace CLBoundedRowInduction + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLPushAlphabet +open GapCVP.CLCellRows GapCVP.CLCellRowBounds GapCVP.CLLocalWindows +open GapCVP.CLCompleteLocalCompiler GapCVP.CLFiniteShiftWindows GapCVP.CLTableauSimulationCert +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseCompleteness +open GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseGlobalSimulation GapCVP.CLWholeTraceSoundness +open GapCVP.CLArbitraryVerifierSoundness GapCVP.CLStackShiftSoundness +open GapCVP.CLStackVerifierSimulation GapCVP.CLAnchoredTraceSimulation +open GapCVP.CLArbitraryRowOccupancy GapCVP.CLRawTrackSimulation GapCVP.CLCompactWindowSoundness +open GapCVP.CLNoHoleTimeInduction + +private def packedPhaseCapacity (tm : Turing.FinTM2) (width : ℕ) : ℕ := + (width + 1) * blockSize tm + +/-- GapCVP reduction support. -/ +def fullPackedPhaseStackAtoms + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (stack : machine.tm.K) : List (CellAtom machine.tm) := + List.ofFn fun index : Fin (packedPhaseCapacity machine.tm width) => + ((completeMachineBlock machine.tm + (row ⟨index.val / blockSize machine.tm, + (Nat.div_lt_iff_lt_mul + (blockSize_pos machine.tm)).mpr index.isLt⟩) + ⟨index.val % blockSize machine.tm, + Nat.mod_lt index.val (blockSize_pos machine.tm)⟩).2.2.1 stack) + +@[simp] private theorem fullPackedPhaseStackAtoms_length + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (stack : machine.tm.K) : + (fullPackedPhaseStackAtoms machine width row stack).length = + packedPhaseCapacity machine.tm width := by + simp only [fullPackedPhaseStackAtoms, List.length_ofFn] + +private theorem packedBlockOffset_lt_capacity + (tm : Turing.FinTM2) + (width : ℕ) + (position : Position width) + (offset : Fin (blockSize tm)) : + position.val * blockSize tm + offset.val < + packedPhaseCapacity tm width := by + have hblock : + (position.val + 1) * blockSize tm ≤ + (width + 1) * blockSize tm := + Nat.mul_le_mul_right (blockSize tm) (by + have hpos := position.isLt + omega) + change position.val * blockSize tm + offset.val < + (width + 1) * blockSize tm + apply Nat.lt_of_lt_of_le _ hblock + simpa only [Nat.add_mul, Nat.one_mul] + using Nat.add_lt_add_left offset.isLt + (position.val * blockSize tm) + +private theorem atomBlockAt_fullPackedPhaseStackAtoms + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (stack : machine.tm.K) + (position : Position width) : + atomBlockAt machine.tm + (fullPackedPhaseStackAtoms machine width row stack) + position.val = + stackAtomsOfBlock machine.tm + (completeMachineBlock machine.tm (row position)) stack := by + funext offset + let global := position.val * blockSize machine.tm + offset.val + have hglobal : global < packedPhaseCapacity machine.tm width := by + exact packedBlockOffset_lt_capacity machine.tm width position offset + have hblock : + global / blockSize machine.tm = position.val := by + dsimp [global] + have hdivision := Nat.mul_add_div + (blockSize_pos machine.tm) position.val offset.val + simpa only [Nat.mul_comm, Nat.div_eq_of_lt offset.isLt, add_zero] using hdivision + have hoffset : global % blockSize machine.tm = offset.val := by + dsimp [global] + exact Nat.mul_add_mod_of_lt offset.isLt + change + paddedAtom (fullPackedPhaseStackAtoms machine width row stack) + global = + ((completeMachineBlock machine.tm (row position) + offset).2.2.1 stack) + change + ((List.ofFn fun index : + Fin (packedPhaseCapacity machine.tm width) => + ((completeMachineBlock machine.tm + (row ⟨index.val / blockSize machine.tm, + (Nat.div_lt_iff_lt_mul + (blockSize_pos machine.tm)).mpr index.isLt⟩) + ⟨index.val % blockSize machine.tm, + Nat.mod_lt index.val + (blockSize_pos machine.tm)⟩).2.2.1 stack))[ + global]?).getD none = + ((completeMachineBlock machine.tm (row position) + offset).2.2.1 stack) + rw [List.getElem?_ofFn] + simp only [dite_eq_left hglobal, Option.getD_some] + have hposition : + (⟨global / blockSize machine.tm, + (Nat.div_lt_iff_lt_mul + (blockSize_pos machine.tm)).mpr hglobal⟩ : Position width) = + position := by + apply Fin.ext + exact hblock + have hlocal : + (⟨global % blockSize machine.tm, + Nat.mod_lt global (blockSize_pos machine.tm)⟩ : + Fin (blockSize machine.tm)) = offset := by + apply Fin.ext + exact hoffset + rw [hposition, hlocal] + +private theorem phaseStackWindow_eq_fullPackedPhaseStackWindow + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hboundary : ∀ position : Position width, + completeIsFirstBlock machine.tm (first position) = + decide (position.val = 0)) + (stack : machine.tm.K) + (position : Position width) : + stackWindowOfScriptBlock machine.tm + (completeScriptWindow machine.tm + (anchoredVerifierWindowAt machine.tm width + first next position)) stack = + stackShiftWindowAt machine.tm width + (fullPackedPhaseStackAtoms machine width first stack) + (fullPackedPhaseStackAtoms machine width next stack) + position := by + simp only [stackWindowOfScriptBlock, completeScriptWindow, + anchoredVerifierWindowAt, stackShiftWindowAt] + rw [atomBlockAt_fullPackedPhaseStackAtoms machine width + first stack (leftBlock width position)] + rw [atomBlockAt_fullPackedPhaseStackAtoms machine width + first stack position] + rw [atomBlockAt_fullPackedPhaseStackAtoms machine width + first stack (rightBlock width position)] + rw [atomBlockAt_fullPackedPhaseStackAtoms machine width + next stack position] + change + (_, _, _, _, completeIsFirstBlock machine.tm (first position)) = + (_, _, _, _, decide (position.val = 0)) + rw [hboundary position] + simp only [completeMachineBlock] + +private theorem allCorrectedVerifierWindows_occupied_fullPackedWindows + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hboundary : ∀ position : Position width, + completeIsFirstBlock machine.tm (first position) = + decide (position.val = 0)) + (hwindows : ∀ position : Position width, + StackSoundAnchoredVerificationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position)) : + ∀ (stack : machine.tm.K) (position : Position width), + OccupiedStackShiftAllowed machine stack + ((first 0).script.2.1 stack) + (stackShiftWindowAt machine.tm width + (fullPackedPhaseStackAtoms machine width first stack) + (fullPackedPhaseStackAtoms machine width next stack) + position) := by + have hanchored : AllAnchoredVerificationWindows + machine width first next := by + simp only [AllAnchoredVerificationWindows, decide_eq_true_eq] + intro position + have verification := hwindows position + simp only [StackSoundAnchoredVerificationAllowed, decide_eq_true_eq] at verification + exact verification.1 + intro stack position + let window := anchoredVerifierWindowAt machine.tm + width first next position + have hverification := hwindows position + simp only [StackSoundAnchoredVerificationAllowed, AnchoredVerificationAllowed, + CompleteVerificationAllowed, decide_eq_true_eq] at hverification + have hscript : scriptBlockAllowed machine + (completeScriptWindow machine.tm window) = true := + hverification.1.1.2.2 + obtain ⟨_, _, _, _, hstacks⟩ := + (scriptBlockAllowed_iff machine + (completeScriptWindow machine.tm window)).mp hscript + have hshift : + StackShiftAllowed machine.tm + ((first position).script.2.1 stack) + (stackWindowOfScriptBlock machine.tm + (completeScriptWindow machine.tm window) stack) := + (stackShiftAllowed_iff machine.tm + ((first position).script.2.1 stack) + (stackWindowOfScriptBlock machine.tm + (completeScriptWindow machine.tm window) stack)).mp + (hstacks stack) + have hhint := allAnchoredVerificationWindows_hint_constant + machine width first next hanchored position + have prefixEvidence := hverification.2 + simp only [OccupiedVerifierPrefix, decide_eq_true_eq] at prefixEvidence + have hprefix := prefixEvidence stack + simp only [OccupiedStackShiftAllowed, decide_eq_true_eq] + change + StackShiftAllowed machine.tm + ((first 0).script.2.1 stack) + (stackShiftWindowAt machine.tm width + (fullPackedPhaseStackAtoms machine width first stack) + (fullPackedPhaseStackAtoms machine width next stack) position) ∧ + ∀ offset : Fin (blockSize machine.tm), + offset.val < ((first 0).script.2.1 stack).2.1.val → + (cellAtomValue machine stack + (((first 0).script.2.1 stack).2.2 offset)).isSome = true + constructor + · rw [← phaseStackWindow_eq_fullPackedPhaseStackWindow + machine width first next hboundary stack position] + change + StackShiftAllowed machine.tm + ((first 0).script.2.1 stack) + (stackWindowOfScriptBlock machine.tm + (completeScriptWindow machine.tm window) stack) + rw [← hhint] + exact hshift + · rw [← hhint] + exact hprefix + +private theorem allCorrectedVerifierWindows_preserve_fullPacked_noHoles + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hboundary : ∀ position : Position width, + completeIsFirstBlock machine.tm (first position) = + decide (position.val = 0)) + (hfirstHoles : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine width first stack)) + (hfirstLength : ∀ stack : machine.tm.K, + ((fullPackedPhaseStackAtoms machine width first stack).filter + Option.isSome).length ≤ width) + (hwindows : ∀ position : Position width, + StackSoundAnchoredVerificationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position)) : + ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine width next stack) := by + intro stack + apply occupiedRawWindows_preserve_noInteriorPaddingHoles + machine width stack + (fullPackedPhaseStackAtoms machine width first stack) + (fullPackedPhaseStackAtoms machine width next stack) + (hfirstHoles stack) + · exact hfirstLength stack + · rw [fullPackedPhaseStackAtoms_length] + exact le_rfl + · exact allCorrectedVerifierWindows_occupied_fullPackedWindows + machine width first next hboundary hwindows stack + +private theorem fullPackedPhaseStackAtoms_occupied + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (hrow : PhaseRowAtomsWellTyped machine width row) + (stack : machine.tm.K) : + OccupiedAtomTrack machine stack + ((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome) := by + simp only [OccupiedAtomTrack, decide_eq_true_eq] + have typedRow := hrow + simp only [PhaseRowAtomsWellTyped, decide_eq_true_eq] at typedRow + intro atom hmem + have hfiltered := List.mem_filter.mp hmem + obtain ⟨index, hindex⟩ := List.mem_ofFn.mp hfiltered.1 + let position : Position width := + ⟨index.val / blockSize machine.tm, + (Nat.div_lt_iff_lt_mul + (blockSize_pos machine.tm)).mpr index.isLt⟩ + let offset : Fin (blockSize machine.tm) := + ⟨index.val % blockSize machine.tm, + Nat.mod_lt index.val (blockSize_pos machine.tm)⟩ + have htyped := typedRow position stack offset + simp only [DecodableOrBlank, decide_eq_true_eq] at htyped + change + ((completeMachineBlock machine.tm (row position) + offset).2.2.1 stack) = atom at hindex + rw [hindex] at htyped + rcases htyped with hblank | hoccupied + · simp only [hblank, Option.isSome_none, Bool.false_eq_true, and_false] at hfiltered + · exact hoccupied + +private def decodedFullPackedPhaseStack + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (stack : machine.tm.K) : List (machine.tm.Γ stack) := + (fullPackedPhaseStackAtoms machine width row stack).filterMap + (cellAtomValue machine stack) + +private theorem fullPackedPhaseStackAtoms_filter_decode + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (stack : machine.tm.K) : + ((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome).filterMap (cellAtomValue machine stack) = + decodedFullPackedPhaseStack machine width row stack := by + exact filterMap_filter_isSome machine stack + (fullPackedPhaseStackAtoms machine width row stack) + +private theorem fullPackedPhaseStackAtoms_compact_length + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (hrow : PhaseRowAtomsWellTyped machine width row) + (stack : machine.tm.K) : + ((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome).length = + (decodedFullPackedPhaseStack machine width row stack).length := by + calc + ((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome).length = + (((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome).filterMap + (cellAtomValue machine stack)).length := + (occupiedAtomTrack_filterMap_length machine stack + ((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome) + (fullPackedPhaseStackAtoms_occupied + machine width row hrow stack)).symm + _ = (decodedFullPackedPhaseStack + machine width row stack).length := by + rw [fullPackedPhaseStackAtoms_filter_decode] + +private theorem stackSoundValidTrace_occupied_fullPackedWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .verifying) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) : + ∀ (stack : machine.tm.K) + (position : Position (rowWidth bound machine x)), + OccupiedStackShiftAllowed machine stack + (((decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) 0).script.2.1) stack) + (stackShiftWindowAt machine.tm (rowWidth bound machine x) + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) stack) + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack) + position) := by + apply allCorrectedVerifierWindows_occupied_fullPackedWindows + machine (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + · intro position + have hmask := stackSoundValidTrace_masks_of_not_accepting + bound machine x trace htrace (Fin.castSucc time) + position (by + rw [hfirst position] + exact PhaseTag.noConfusion) + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at hmask + exact hmask.2.2.2 + · exact stackSoundValidTrace_occupied_verification_windows + bound machine x trace htrace time hfirst hnext + +private theorem stackSoundValidTrace_preserves_fullPacked_noHoles + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .verifying) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) + (hfirstHoles : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) stack)) + (hfirstLength : ∀ stack : machine.tm.K, + ((fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) stack).filter + Option.isSome).length ≤ rowWidth bound machine x) : + ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack) := by + intro stack + apply occupiedRawWindows_preserve_noInteriorPaddingHoles + machine (rowWidth bound machine x) stack + (fullPackedPhaseStackAtoms machine (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) stack) + (fullPackedPhaseStackAtoms machine (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)) stack) + (hfirstHoles stack) + · exact hfirstLength stack + · rw [fullPackedPhaseStackAtoms_length] + exact le_rfl + · exact stackSoundValidTrace_occupied_fullPackedWindows + bound machine x trace htrace time hfirst hnext stack + +private theorem fullPacked_noHoles_and_bound_implies_stackRangeFaithful + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (hholes : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine width row stack)) + (hbound : ∀ stack : machine.tm.K, + ((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome).length ≤ width) : + PhaseRowStackRangeFaithful machine width row := by + simp only [PhaseRowStackRangeFaithful, decide_eq_true_eq] + intro position stack offset hout + let global := position.val * blockSize machine.tm + offset.val + have hpadded : + paddedAtom (fullPackedPhaseStackAtoms + machine width row stack) global = none := by + rw [noHoles_padded_compact machine.tm + (fullPackedPhaseStackAtoms machine width row stack) + (hholes stack) global] + apply paddedAtom_none_of_length_le machine.tm + ((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome) global + have hlength := hbound stack + dsimp [global] + omega + have hblock := congrFun + (atomBlockAt_fullPackedPhaseStackAtoms + machine width row stack position) offset + change + paddedAtom (fullPackedPhaseStackAtoms machine width row stack) + global = + ((completeMachineBlock machine.tm (row position) + offset).2.2.1 stack) at hblock + exact hblock.symm.trans hpadded + +end CLBoundedRowInduction + +namespace CLFullStackStepSoundness + +open Computability Turing GapCVP.CL GapCVP.CLBoundedStates GapCVP.CLPushAlphabet +open GapCVP.CLCellRows GapCVP.CLLocalWindows GapCVP.CLExactVerifierRules +open GapCVP.CLCompleteLocalCompiler GapCVP.CLStackShiftSoundness2 GapCVP.CLFiniteShiftWindows +open GapCVP.CLLocalTableauCompiler GapCVP.CLUnconditionalTableau +open GapCVP.CLGlobalTableauSimulation GapCVP.CLTableauSimulationCert +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseTableauSimulation +open GapCVP.CLPhaseGlobalSimulation GapCVP.CLValidTraceSoundness GapCVP.CLStackShiftSoundness +open GapCVP.CLStackVerifierSimulation GapCVP.CLArbitraryRowOccupancy GapCVP.CLRawTrackSimulation +open GapCVP.CLCompactWindowSoundness GapCVP.CLNoHoleTimeInduction GapCVP.CLBoundedRowInduction + +private theorem occupiedAtomTrack_forall₂_filterMap + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (atoms : List (CellAtom machine.tm)) + (hoccupied : OccupiedAtomTrack machine stack atoms) : + List.Forall₂ + (fun atom value => + cellAtomValue machine stack atom = some value) + atoms (atoms.filterMap (cellAtomValue machine stack)) := by + induction atoms with + | nil => exact .nil + | cons atom rest ih => + have occupied := hoccupied + simp only [OccupiedAtomTrack, decide_eq_true_eq] at occupied + obtain ⟨value, hvalue⟩ := occupied atom (by simp only [List.mem_cons, true_or]) + have hrest : OccupiedAtomTrack machine stack rest := by + simp only [OccupiedAtomTrack, decide_eq_true_eq] + intro candidate hcandidate + exact occupied candidate (by simp only [List.mem_cons, hcandidate, or_true]) + rw [List.filterMap_cons_some hvalue] + exact List.Forall₂.cons hvalue (ih hrest) + +private theorem decodedAtomBlock_of_occupiedAtomTrack + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (atoms : List (CellAtom machine.tm)) + (hoccupied : OccupiedAtomTrack machine stack atoms) : + decodedAtomBlock machine stack + (atomBlockAt machine.tm atoms 0) = + (atoms.filterMap (cellAtomValue machine stack)).take + (blockSize machine.tm) := by + have hforall := occupiedAtomTrack_forall₂_filterMap + machine stack atoms hoccupied + have hpointwise : + (fun index : Fin (blockSize machine.tm) => + cellAtomValue machine stack + ((atomBlockAt machine.tm atoms 0) index)) = + (fun index : Fin (blockSize machine.tm) => + (atoms.filterMap + (cellAtomValue machine stack))[index.val]?) := by + funext index + simpa only [atomBlockAt, zero_mul, zero_add] using paddedAtom_decode machine stack hforall + index.val + unfold decodedAtomBlock + rw [hpointwise] + exact filterMap_ofFn_getElem + (atoms.filterMap (cellAtomValue machine stack)) + (blockSize machine.tm) + +private theorem fullPackedPhaseStack_firstBlock_decode + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (hrow : PhaseRowAtomsWellTyped machine width row) + (stack : machine.tm.K) + (hholes : NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine width row stack)) : + decodedAtomBlock machine stack + (stackAtomsOfBlock machine.tm + (completeMachineBlock machine.tm (row 0)) stack) = + (decodedFullPackedPhaseStack machine width row stack).take + (blockSize machine.tm) := by + rw [← atomBlockAt_fullPackedPhaseStackAtoms + machine width row stack 0] + change + decodedAtomBlock machine stack + (atomBlockAt machine.tm + (fullPackedPhaseStackAtoms machine width row stack) 0) = + (decodedFullPackedPhaseStack machine width row stack).take + (blockSize machine.tm) + rw [noHoles_atomBlockAt_compact machine.tm + (fullPackedPhaseStackAtoms machine width row stack) hholes 0] + rw [decodedAtomBlock_of_occupiedAtomTrack machine stack + ((fullPackedPhaseStackAtoms machine width row stack).filter + Option.isSome) + (fullPackedPhaseStackAtoms_occupied + machine width row hrow stack)] + rw [fullPackedPhaseStackAtoms_filter_decode] + +private theorem occupiedPackedWindows_compact_common_suffix + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (stack : machine.tm.K) + (first next : List (CellAtom machine.tm)) + (hfirstHoles : NoInteriorPaddingHoles machine.tm first) + (hnextHoles : NoInteriorPaddingHoles machine.tm next) + (hfirstLength : (first.filter Option.isSome).length ≤ width) + (hnextCapacity : + next.length ≤ (width + 1) * blockSize machine.tm) + (hint : SingleStackHint machine.tm) + (hwindows : ∀ position : Fin (width + 1), + OccupiedStackShiftAllowed machine stack hint + (stackShiftWindowAt machine.tm width + first next position)) : + (first.filter Option.isSome).drop hint.1.val = + (next.filter Option.isSome).drop hint.2.1.val := by + apply (atomSuffix_iff_paddedShift machine.tm + (first.filter Option.isSome) + (next.filter Option.isSome) + (filter_isSome_noBlank machine.tm first) + (filter_isSome_noBlank machine.tm next) + hint.1.val hint.2.1.val).mpr + intro index + let global := hint.2.1.val + index + by_cases hcovered : + global < (width + 1) * blockSize machine.tm + · have hprefix : hint.2.1.val ≤ global := by + dsimp [global] + omega + have hshift := occupiedRawWindows_suffix_paddedAtom + machine width stack first next hfirstHoles hfirstLength + hint hwindows global hprefix hcovered + have hnextPad := noHoles_padded_compact machine.tm + next hnextHoles global + have hcoordinate : + global - hint.2.1.val + hint.1.val = + hint.1.val + index := by + dsimp [global] + omega + rw [hcoordinate] at hshift + exact hshift.symm.trans hnextPad + · have hbeyond : + (width + 1) * blockSize machine.tm ≤ global := by + omega + have hblock : + (width + 1) * blockSize machine.tm = + width * blockSize machine.tm + blockSize machine.tm := by + simp only [Nat.add_mul, one_mul] + have hdrop := hint.2.1.isLt + have hcapacity := width_le_block_capacity machine.tm width + have hfirstBeyond : + (first.filter Option.isSome).length ≤ + hint.1.val + index := by + dsimp [global] at hbeyond + rw [hblock] at hbeyond + omega + have hnextCompactLength : + (next.filter Option.isSome).length ≤ next.length := + List.length_filter_le Option.isSome next + have hnextBeyond : + (next.filter Option.isSome).length ≤ + hint.2.1.val + index := by + dsimp [global] at hbeyond + omega + rw [paddedAtom_none_of_length_le machine.tm + (first.filter Option.isSome) + (hint.1.val + index) hfirstBeyond, + paddedAtom_none_of_length_le machine.tm + (next.filter Option.isSome) + (hint.2.1.val + index) hnextBeyond] + +private theorem occupiedPackedWindows_decoded_common_suffix + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (stack : machine.tm.K) + (first next : List (CellAtom machine.tm)) + (hfirstHoles : NoInteriorPaddingHoles machine.tm first) + (hnextHoles : NoInteriorPaddingHoles machine.tm next) + (hfirstLength : (first.filter Option.isSome).length ≤ width) + (hnextCapacity : + next.length ≤ (width + 1) * blockSize machine.tm) + (hfirstOccupied : OccupiedAtomTrack machine stack + (first.filter Option.isSome)) + (hnextOccupied : OccupiedAtomTrack machine stack + (next.filter Option.isSome)) + (hint : SingleStackHint machine.tm) + (hwindows : ∀ position : Fin (width + 1), + OccupiedStackShiftAllowed machine stack hint + (stackShiftWindowAt machine.tm width + first next position)) : + (first.filterMap (cellAtomValue machine stack)).drop hint.1.val = + (next.filterMap (cellAtomValue machine stack)).drop + hint.2.1.val := by + have hcompact := decodedCommonSuffix_of_occupied_atom_suffix + machine stack + (first.filter Option.isSome) + (next.filter Option.isSome) + hfirstOccupied hnextOccupied + hint.1.val hint.2.1.val + (occupiedPackedWindows_compact_common_suffix + machine width stack first next hfirstHoles hnextHoles + hfirstLength hnextCapacity hint hwindows) + rw [filterMap_filter_isSome machine stack, + filterMap_filter_isSome machine stack] at hcompact + exact hcompact + +/-- GapCVP reduction support. -/ +def decodedFullPackedPhaseConfiguration + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) : + machine.tm.Cfg := + match machineControlOfBlock machine.tm + (completeMachineHead machine.tm (row 0)) with + | none => Turing.initList machine.tm [] + | some control => { + l := control.1 + var := control.2 + stk := fun stack => decodedFullPackedPhaseStack + machine width row stack + } + +private theorem finiteHeadScriptRun_eq_fullPacked + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (hrow : PhaseRowAtomsWellTyped machine width row) + (hholes : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine width row stack)) + (label : machine.tm.Λ) + (state : machine.tm.σ) : + finiteHeadScriptRun machine label state + (fun stack => stackAtomsOfBlock machine.tm + (completeMachineBlock machine.tm (row 0)) stack) = + executePrefixScript (machine.tm.m label) state + (fun stack => decodedFullPackedPhaseStack + machine width row stack) + (emptyPrefixScript machine.tm.Γ) := by + let heads : machine.tm.K → AtomBlock machine.tm := + fun stack => stackAtomsOfBlock machine.tm + (completeMachineBlock machine.tm (row 0)) stack + let finite := finiteHeadConfiguration + machine (some label, state) heads + have hagreement : StackPrefixAgreement (blockSize machine.tm) + (fun stack => decodedFullPackedPhaseStack + machine width row stack) finite.stk := by + simp only [StackPrefixAgreement, decide_eq_true_eq] + intro stack + change + (decodedFullPackedPhaseStack machine width row stack).take + (blockSize machine.tm) = + (decodedAtomBlock machine stack (heads stack)).take + (blockSize machine.tm) + rw [fullPackedPhaseStack_firstBlock_decode + machine width row hrow stack (hholes stack)] + simp only [List.take_self_eq_iff, List.length_take, inf_le_left] + have hlookahead : StackPrefixAgreement + (statementStackActions (machine.tm.m label) + 1) + (fun stack => decodedFullPackedPhaseStack + machine width row stack) finite.stk := + stackPrefixAgreement_mono + (statementLookahead_le_blockSize machine.tm label) + hagreement + have hscript := executePrefixScript_of_prefix + (machine.tm.m label) state + (fun stack => decodedFullPackedPhaseStack + machine width row stack) + finite.stk (emptyPrefixScript machine.tm.Γ) + (by simpa only [scriptStacks_empty] using hlookahead) + change + executePrefixScript (machine.tm.m label) state finite.stk + (emptyPrefixScript machine.tm.Γ) = + executePrefixScript (machine.tm.m label) state + (fun stack => decodedFullPackedPhaseStack + machine width row stack) + (emptyPrefixScript machine.tm.Γ) + exact hscript.symm + +private theorem allCorrectedVerifierWindows_fullPacked_decoded_suffix + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hfirstTyped : PhaseRowAtomsWellTyped machine width first) + (hnextTyped : PhaseRowAtomsWellTyped machine width next) + (hboundary : ∀ position : Position width, + completeIsFirstBlock machine.tm (first position) = + decide (position.val = 0)) + (hfirstHoles : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine width first stack)) + (hfirstLength : ∀ stack : machine.tm.K, + ((fullPackedPhaseStackAtoms machine width first stack).filter + Option.isSome).length ≤ width) + (hwindows : ∀ position : Position width, + StackSoundAnchoredVerificationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position)) : + ∀ stack : machine.tm.K, + (decodedFullPackedPhaseStack machine width first stack).drop + ((first 0).script.2.1 stack).1.val = + (decodedFullPackedPhaseStack machine width next stack).drop + ((first 0).script.2.1 stack).2.1.val := by + have hnextHoles := + allCorrectedVerifierWindows_preserve_fullPacked_noHoles + machine width first next hboundary hfirstHoles + hfirstLength hwindows + intro stack + exact occupiedPackedWindows_decoded_common_suffix + machine width stack + (fullPackedPhaseStackAtoms machine width first stack) + (fullPackedPhaseStackAtoms machine width next stack) + (hfirstHoles stack) (hnextHoles stack) + (hfirstLength stack) + (by rw [fullPackedPhaseStackAtoms_length]; exact le_rfl) + (fullPackedPhaseStackAtoms_occupied + machine width first hfirstTyped stack) + (fullPackedPhaseStackAtoms_occupied + machine width next hnextTyped stack) + ((first 0).script.2.1 stack) + (allCorrectedVerifierWindows_occupied_fullPackedWindows + machine width first next hboundary hwindows stack) + +private theorem allCorrectedVerifierWindows_actual_fullPackedStep + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hfirstTyped : PhaseRowAtomsWellTyped machine width first) + (hnextTyped : PhaseRowAtomsWellTyped machine width next) + (hboundary : ∀ position : Position width, + completeIsFirstBlock machine.tm (first position) = + decide (position.val = 0)) + (hfirstHoles : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine width first stack)) + (hfirstLength : ∀ stack : machine.tm.K, + ((fullPackedPhaseStackAtoms machine width first stack).filter + Option.isSome).length ≤ width) + (hwindows : ∀ position : Position width, + StackSoundAnchoredVerificationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position)) : + machine.tm.step + (decodedFullPackedPhaseConfiguration machine width first) = + some (decodedFullPackedPhaseConfiguration + machine width next) := by + let window := anchoredVerifierWindowAt machine.tm width first next 0 + have hverification := hwindows 0 + simp only [StackSoundAnchoredVerificationAllowed, decide_eq_true_eq] at hverification + have anchored := hverification.1 + have fields := anchored + simp only [AnchoredVerificationAllowed, CompleteVerificationAllowed, + FirstBlockAnchored, decide_eq_true_eq] at fields + have fieldsOuter := ofClassicalDecide fields + have verificationFields := ofClassicalDecide fieldsOuter.1 + have sourceAnchorFields := ofClassicalDecide fieldsOuter.2.1 + have nextAnchorFields := ofClassicalDecide fieldsOuter.2.2 + have hmarked : + completeIsFirstBlock machine.tm (first 0) = true := by + simpa only [Fin.coe_ofNat_eq_mod, Nat.zero_mod, decide_true] using hboundary 0 + have hsourceAnchor : + completeMachineBlock machine.tm (first 0) = + completeMachineHead machine.tm (first 0) := + (sourceAnchorFields hmarked).1 + have hnextMarked : + completeIsFirstBlock machine.tm (next 0) = true := by + have hkeep := anchoredVerification_boundary machine window anchored + exact hkeep.trans hmarked + have hnextAnchor : + completeMachineBlock machine.tm (next 0) = + completeMachineHead machine.tm (next 0) := + (nextAnchorFields hnextMarked).1 + have hscriptBlock : scriptBlockAllowed machine + (completeScriptWindow machine.tm window) = true := + verificationFields.2.2 + obtain ⟨_, query, hquery, hscript, _⟩ := + (scriptBlockAllowed_iff machine + (completeScriptWindow machine.tm window)).mp hscriptBlock + cases hfirstControl : machineControlOfBlock machine.tm + (first 0).script.1.2 with + | none => + simp only [scriptQueryOfBlockWindow, completeScriptWindow, anchoredVerifierWindowAt, + leftBlock_zero, + hfirstControl, reduceCtorEq, window] at hquery + | some firstControl => + cases hnextControl : machineControlOfBlock machine.tm + (next 0).script.1.2 with + | none => + simp only [scriptQueryOfBlockWindow, completeScriptWindow, anchoredVerifierWindowAt, + leftBlock_zero, + hfirstControl, hnextControl, reduceCtorEq, window] at hquery + | some nextControl => + have hfirstControl' : + machineControlOfBlock machine.tm + (completeMachineHead machine.tm (first 0)) = + some firstControl := by + simpa only [completeMachineHead] using hfirstControl + have hnextControl' : + machineControlOfBlock machine.tm + (completeMachineHead machine.tm (next 0)) = + some nextControl := by + simpa only [completeMachineHead] using hnextControl + have hqueryValue : + query = + ((firstControl, + (fun stack => stackAtomsOfBlock machine.tm + (completeMachineHead machine.tm (first 0)) stack), + nextControl), + (fun stack => stackAtomsOfBlock machine.tm + (completeMachineHead machine.tm (next 0)) stack), + (first 0).script.2.1) := by + have heq := hquery + simp only [scriptQueryOfBlockWindow, completeScriptWindow, anchoredVerifierWindowAt, + leftBlock_zero, + hfirstControl, hnextControl, Option.some.injEq, window] at heq + simpa only [completeMachineHead] using heq.symm + subst query + rw [← hsourceAnchor, ← hnextAnchor] at hscript + obtain ⟨label, hlabel, hcontrol, hstate, hchecks⟩ := + (scriptVerifierAllowed_iff machine _).mp hscript + let heads : machine.tm.K → AtomBlock machine.tm := + fun stack => stackAtomsOfBlock machine.tm + (completeMachineBlock machine.tm (first 0)) stack + let run := finiteHeadScriptRun machine label firstControl.2 heads + have hsourceLabel : firstControl.1 = some label := by exact hlabel + have hnextLabel : run.1 = nextControl.1 := by exact hcontrol + have hnextState : run.2.1 = nextControl.2 := by exact hstate + have hnextHoles := + allCorrectedVerifierWindows_preserve_fullPacked_noHoles + machine width first next hboundary + hfirstHoles hfirstLength hwindows + have hsuffix := + allCorrectedVerifierWindows_fullPacked_decoded_suffix + machine width first next hfirstTyped hnextTyped + hboundary hfirstHoles hfirstLength hwindows + have hstacks : + scriptStacks + (fun stack => decodedFullPackedPhaseStack + machine width first stack) run.2.2 = + (fun stack => decodedFullPackedPhaseStack + machine width next stack) := by + funext stack + have hcheck := hchecks stack + change + ((first 0).script.2.1 stack).1.val = + run.2.2.dropped stack ∧ + ((first 0).script.2.1 stack).2.1.val = + (run.2.2.pushed stack).length ∧ + (decodedAtomBlock machine stack + (stackAtomsOfBlock machine.tm + (completeMachineBlock machine.tm (next 0)) + stack)).take + (run.2.2.pushed stack).length = + run.2.2.pushed stack at hcheck + have hprefix := hcheck.2.2 + rw [fullPackedPhaseStack_firstBlock_decode + machine width next hnextTyped stack + (hnextHoles stack)] at hprefix + have hpushBound : + (run.2.2.pushed stack).length ≤ + blockSize machine.tm := by + have hfin := ((first 0).script.2.1 stack).2.1.isLt + omega + simp only [List.take_take, + Nat.min_eq_left hpushBound] at hprefix + have hcommon := hsuffix stack + rw [hcheck.1, hcheck.2.1] at hcommon + have hnextStack : + decodedFullPackedPhaseStack machine width next stack = + scriptStacks + (fun target => decodedFullPackedPhaseStack + machine width first target) + run.2.2 stack := by + calc + decodedFullPackedPhaseStack machine width next stack = + (decodedFullPackedPhaseStack + machine width next stack).take + (run.2.2.pushed stack).length ++ + (decodedFullPackedPhaseStack + machine width next stack).drop + (run.2.2.pushed stack).length := + (List.take_append_drop + (run.2.2.pushed stack).length + (decodedFullPackedPhaseStack + machine width next stack)).symm + _ = run.2.2.pushed stack ++ + (decodedFullPackedPhaseStack + machine width first stack).drop + (run.2.2.dropped stack) := by + rw [hprefix, ← hcommon] + _ = scriptStacks + (fun target => decodedFullPackedPhaseStack + machine width first target) + run.2.2 stack := rfl + exact hnextStack.symm + have hrun := finiteHeadScriptRun_eq_fullPacked + machine width first hfirstTyped hfirstHoles + label firstControl.2 + change + run = executePrefixScript (machine.tm.m label) + firstControl.2 + (fun stack => decodedFullPackedPhaseStack + machine width first stack) + (emptyPrefixScript machine.tm.Γ) at hrun + have hexecution := executePrefixScript_correct + (machine.tm.m label) firstControl.2 + (fun stack => decodedFullPackedPhaseStack + machine width first stack) + (emptyPrefixScript machine.tm.Γ) + simp only [scriptStacks_empty] at hexecution + rw [← hrun] at hexecution + have htarget : + ({ l := run.1 + var := run.2.1 + stk := scriptStacks + (fun stack => decodedFullPackedPhaseStack + machine width first stack) + run.2.2 } : machine.tm.Cfg) = + decodedFullPackedPhaseConfiguration + machine width next := by + unfold decodedFullPackedPhaseConfiguration + rw [hnextControl'] + apply configuration_eq_of_components machine.tm + · exact hnextLabel + · exact hnextState + · exact hstacks + apply actualStep_of_stepAux machine.tm + (decodedFullPackedPhaseConfiguration + machine width first) + (decodedFullPackedPhaseConfiguration + machine width next) label + · simp only [decodedFullPackedPhaseConfiguration, hfirstControl', hsourceLabel] + · unfold decodedFullPackedPhaseConfiguration + rw [hfirstControl'] + exact hexecution.trans htarget + +end CLFullStackStepSoundness + +namespace CLFullTraceReachability + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLBoundedStates +open GapCVP.CLCellRowBounds GapCVP.CLTableauSimulationCert GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLPhaseCompleteness GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseGlobalSimulation +open GapCVP.CLWholeTraceSoundness GapCVP.CLStackVerifierSimulation +open GapCVP.CLAnchoredTraceSimulation GapCVP.CLArbitraryRowOccupancy GapCVP.CLWholeTimeOccupancy +open GapCVP.CLCompactWindowSoundness GapCVP.CLNoHoleTimeInduction GapCVP.CLBoundedRowInduction +open GapCVP.CLFullStackStepSoundness + +private theorem allCorrectedVerifierWindows_controls + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hwindows : ∀ position : Position width, + StackSoundAnchoredVerificationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position)) : + ∃ (firstControl nextControl : + Option machine.tm.Λ × machine.tm.σ), + machineControlOfBlock machine.tm + (completeMachineHead machine.tm (first 0)) = + some firstControl ∧ + machineControlOfBlock machine.tm + (completeMachineHead machine.tm (next 0)) = + some nextControl := by + let window := anchoredVerifierWindowAt machine.tm + width first next 0 + have verification := hwindows 0 + simp only [StackSoundAnchoredVerificationAllowed, AnchoredVerificationAllowed, + CompleteVerificationAllowed, decide_eq_true_eq] at verification + have hscript : scriptBlockAllowed machine + (completeScriptWindow machine.tm window) = true := + verification.1.1.2.2 + obtain ⟨_, query, hquery, _, _⟩ := + (scriptBlockAllowed_iff machine + (completeScriptWindow machine.tm window)).mp hscript + cases hfirst : machineControlOfBlock machine.tm + (first 0).script.1.2 with + | none => + simp only [scriptQueryOfBlockWindow, completeScriptWindow, anchoredVerifierWindowAt, + CLLocalWindows.leftBlock_zero, hfirst, reduceCtorEq, window] at hquery + | some firstControl => + cases hnext : machineControlOfBlock machine.tm + (next 0).script.1.2 with + | none => + simp only [scriptQueryOfBlockWindow, completeScriptWindow, anchoredVerifierWindowAt, + CLLocalWindows.leftBlock_zero, hfirst, hnext, reduceCtorEq, window] at hquery + | some nextControl => + refine ⟨firstControl, nextControl, ?_, ?_⟩ + · simpa only [completeMachineHead] using hfirst + · simpa only [completeMachineHead] using hnext + +private theorem decodedFullPackedPhaseConfiguration_stack + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (row : Position width → CompletePhaseCell machine.tm) + (control : Option machine.tm.Λ × machine.tm.σ) + (hcontrol : machineControlOfBlock machine.tm + (completeMachineHead machine.tm (row 0)) = some control) + (stack : machine.tm.K) : + (decodedFullPackedPhaseConfiguration + machine width row).stk stack = + decodedFullPackedPhaseStack machine width row stack := by + simp only [decodedFullPackedPhaseConfiguration, hcontrol] + +private theorem fullPackedStack_space_of_actualTimedRun + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (row : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (control : Option machine.tm.Λ × machine.tm.σ) + (hcontrol : machineControlOfBlock machine.tm + (completeMachineHead machine.tm (row 0)) = some control) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row)) elapsed) + (hruntime : elapsed ≤ + (guessTimePolynomial bound machine).eval x.length) + (stack : machine.tm.K) : + (decodedFullPackedPhaseStack machine + (rowWidth bound machine x) row stack).length ≤ + rowWidth bound machine x := by + have hstack := verifying_stack_length_le + bound machine x certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row) + run hruntime stack + rw [decodedFullPackedPhaseConfiguration_stack + machine (rowWidth bound machine x) row + control hcontrol stack] at hstack + exact hstack + +private theorem fullPackedCompact_space_of_actualTimedRun + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (row : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hrow : PhaseRowAtomsWellTyped machine + (rowWidth bound machine x) row) + (control : Option machine.tm.Λ × machine.tm.σ) + (hcontrol : machineControlOfBlock machine.tm + (completeMachineHead machine.tm (row 0)) = some control) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row)) elapsed) + (hruntime : elapsed ≤ + (guessTimePolynomial bound machine).eval x.length) + (stack : machine.tm.K) : + ((fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) row stack).filter + Option.isSome).length ≤ rowWidth bound machine x := by + rw [fullPackedPhaseStackAtoms_compact_length + machine (rowWidth bound machine x) row hrow stack] + exact fullPackedStack_space_of_actualTimedRun + bound machine x certificate row control hcontrol + run hruntime stack + +private theorem stackSoundValidTrace_actualFullPackedStep_of_actualTimedRun + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .verifying) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) + (hholes : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) stack)) + (certificate : List Bool) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))))) elapsed) + (hruntime : elapsed ≤ + (guessTimePolynomial bound machine).eval x.length) : + machine.tm.step + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) = + some (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ))) := by + let first := decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) + let next := decodeCorrectedPhaseRow machine + (trace time.succ) + have hfirstTyped := stackSoundValidTrace_all_verifier_rows_wellTyped + bound machine x trace htrace (Fin.castSucc time) hfirst + have hnextTyped := stackSoundValidTrace_all_verifier_rows_wellTyped + bound machine x trace htrace time.succ hnext + have hwindows := stackSoundValidTrace_occupied_verification_windows + bound machine x trace htrace time hfirst hnext + obtain ⟨control, _, hcontrol, _⟩ := + allCorrectedVerifierWindows_controls machine + (rowWidth bound machine x) first next hwindows + apply allCorrectedVerifierWindows_actual_fullPackedStep + machine (rowWidth bound machine x) first next + hfirstTyped hnextTyped + · intro position + have mask := stackSoundValidTrace_masks_of_not_accepting + bound machine x trace htrace (Fin.castSucc time) + position (by rw [hfirst position]; exact PhaseTag.noConfusion) + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at mask + exact mask.2.2.2 + · exact hholes + · intro stack + exact fullPackedCompact_space_of_actualTimedRun + bound machine x certificate first hfirstTyped + control hcontrol run hruntime stack + · exact hwindows + +private theorem stackSoundValidTrace_allInitializationWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .guessing) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) : + ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine + (trace time.succ)) position) := by + intro position + apply stackSoundPhase_initialization_of_modes machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) position) + · exact stackSoundValidTrace_window + bound machine x trace htrace (windowAt time position) + · exact hfirst position + · exact hnext position + +private theorem stackSoundValidTrace_initialization_rangeFaithful + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .guessing) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) : + PhaseRowStackRangeFaithful machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)) := by + apply allInitializationWindows_next_stackRangeFaithful + machine (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + · intro position + have mask := stackSoundValidTrace_masks_of_not_accepting + bound machine x trace htrace (Fin.castSucc time) + position (by rw [hfirst position]; exact PhaseTag.noConfusion) + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at mask + exact mask.1 + · exact stackSoundValidTrace_allInitializationWindows + bound machine x trace htrace time hfirst hnext + +private noncomputable def stackSoundValidTrace_verifierSuccessor_reachable_space_padding + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .verifying) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) + (hholes : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) stack)) + (certificate : List Bool) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))))) elapsed) + (hruntime : elapsed + 1 ≤ + (guessTimePolynomial bound machine).eval x.length) : + { _nextRun : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)))) (elapsed + 1) // + (∀ stack : machine.tm.K, + (decodedFullPackedPhaseStack machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack).length ≤ + rowWidth bound machine x) ∧ + PhaseRowStackRangeFaithful machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)) ∧ + (∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack)) } := by + let first := decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) + let next := decodeCorrectedPhaseRow machine + (trace time.succ) + have hsourceTime : elapsed ≤ + (guessTimePolynomial bound machine).eval x.length := by + omega + have hstep := + stackSoundValidTrace_actualFullPackedStep_of_actualTimedRun + bound machine x trace htrace time hfirst hnext + hholes certificate run hsourceTime + let nextRun : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) next)) (elapsed + 1) := + FiniteRun.tail run + (GuessStep.execute certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) first) + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) next) hstep) + have hfirstTyped := stackSoundValidTrace_all_verifier_rows_wellTyped + bound machine x trace htrace (Fin.castSucc time) hfirst + have hnextTyped := stackSoundValidTrace_all_verifier_rows_wellTyped + bound machine x trace htrace time.succ hnext + have hwindows := stackSoundValidTrace_occupied_verification_windows + bound machine x trace htrace time hfirst hnext + have hcontrolsExists := allCorrectedVerifierWindows_controls machine + (rowWidth bound machine x) first next hwindows + let firstControl := Classical.choose hcontrolsExists + let nextControl := Classical.choose (Classical.choose_spec hcontrolsExists) + have hcontrols := Classical.choose_spec (Classical.choose_spec hcontrolsExists) + have hfirstControl : machineControlOfBlock machine.tm + (completeMachineHead machine.tm (first 0)) = some firstControl := + hcontrols.1 + have hnextControl : machineControlOfBlock machine.tm + (completeMachineHead machine.tm (next 0)) = some nextControl := + hcontrols.2 + have hsourceCompact : ∀ stack : machine.tm.K, + ((fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) first stack).filter + Option.isSome).length ≤ rowWidth bound machine x := by + intro stack + exact fullPackedCompact_space_of_actualTimedRun + bound machine x certificate first hfirstTyped firstControl + hfirstControl run hsourceTime stack + have hnextHoles : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) next stack) := by + exact stackSoundValidTrace_preserves_fullPacked_noHoles + bound machine x trace htrace time hfirst hnext + hholes hsourceCompact + have hnextSpace : ∀ stack : machine.tm.K, + (decodedFullPackedPhaseStack machine + (rowWidth bound machine x) next stack).length ≤ + rowWidth bound machine x := by + intro stack + exact fullPackedStack_space_of_actualTimedRun + bound machine x certificate next nextControl + hnextControl nextRun hruntime stack + have hnextRange : PhaseRowStackRangeFaithful machine + (rowWidth bound machine x) next := by + apply fullPacked_noHoles_and_bound_implies_stackRangeFaithful + machine (rowWidth bound machine x) next hnextHoles + intro stack + rw [fullPackedPhaseStackAtoms_compact_length + machine (rowWidth bound machine x) next hnextTyped stack] + exact hnextSpace stack + exact ⟨nextRun, hnextSpace, hnextRange, hnextHoles⟩ + +end CLFullTraceReachability + +namespace CLGuessPayloadReachability + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLNondeterminism +open GapCVP.CLBoundedStates GapCVP.CLCellRows GapCVP.CLCellRowBounds GapCVP.CLLocalWindows +open GapCVP.CLExactLocalRules GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseSpecification +open GapCVP.CLPhaseCompleteness GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseTraceInduction +open GapCVP.CLPhaseGlobalSimulation GapCVP.CLValidTraceSoundness GapCVP.CLWholeTraceSoundness +open GapCVP.CLStackVerifierSimulation GapCVP.CLAnchoredTraceSimulation + +private theorem pairedInputTagAt_append_before + (x certificate : List Bool) (bit : Bool) (index : ℕ) + (hindex : index < x.length + certificate.length) : + pairedInputTagAt x (certificate ++ [bit]) index = + pairedInputTagAt x certificate index := by + have hword : index < (pairBitEncoding (x, certificate)).length := by + simpa only [pairBitEncoding_apply, List.length_append, List.length_map] using hindex + unfold pairedInputTagAt + rw [pairBitEncoding_append_guess, + List.getElem?_append_left hword] + split <;> rename_i hentry + · rfl + · have houtside := List.getElem?_eq_none_iff.mp hentry + omega + +private theorem pairedInputTagAt_append_old_marker + (x certificate : List Bool) (bit : Bool) : + pairedInputTagAt x (certificate ++ [bit]) + (x.length + certificate.length) = .bit (.inr bit) := by + unfold pairedInputTagAt + rw [pairBitEncoding_append_guess] + have hindex : + (pairBitEncoding (x, certificate)).length ≤ + x.length + certificate.length := by + simp only [pairBitEncoding_apply, List.length_append, List.length_map, Std.le_refl] + rw [List.getElem?_append_right hindex] + simp only [pairBitEncoding_apply, List.length_append, List.length_map, tsub_self, + List.length_cons, + List.length_nil, zero_add, Order.lt_one_iff, getElem?_pos, List.getElem_cons_zero] + +private theorem pairedInputTagAt_append_new_marker + (x certificate : List Bool) (bit : Bool) : + pairedInputTagAt x (certificate ++ [bit]) + (x.length + certificate.length + 1) = .marker := by + simpa only [Nat.add_assoc, List.length_append, List.length_cons, List.length_nil, zero_add] using + pairedInputTagAt_marker x (certificate ++ [bit]) + +private theorem pairedInputTagAt_append_after + (x certificate : List Bool) (bit : Bool) (index : ℕ) + (hindex : x.length + certificate.length + 1 < index) : + pairedInputTagAt x (certificate ++ [bit]) index = + pairedInputTagAt x certificate index := by + have hold : (pairBitEncoding (x, certificate)).length < index := by + simp only [pairBitEncoding_length] + omega + have hnew : + (pairBitEncoding (x, certificate ++ [bit])).length < index := by + simp only [pairBitEncoding_length, List.length_append, + List.length_singleton] + omega + unfold pairedInputTagAt + rw [List.getElem?_eq_none (Nat.le_of_lt hnew), + List.getElem?_eq_none (Nat.le_of_lt hold)] + have hneOld : index ≠ x.length + certificate.length := by + omega + have hneNew : index ≠ x.length + (certificate.length + 1) := by + omega + simp only [pairBitEncoding_apply, List.map_append, List.map_cons, List.map_nil, + List.length_append, + List.length_map, List.length_cons, List.length_nil, zero_add, hneNew, ↓reduceIte, hneOld] + +private theorem pairedInputTagAt_marker_iff + (x certificate : List Bool) (index : ℕ) : + pairedInputTagAt x certificate index = .marker ↔ + index = x.length + certificate.length := by + unfold pairedInputTagAt + split <;> rename_i hentry + · obtain ⟨hinside, _⟩ := List.getElem?_eq_some_iff.mp hentry + have hlength : + (pairBitEncoding (x, certificate)).length = + x.length + certificate.length := by + simp only [pairBitEncoding_apply, List.length_append, List.length_map] + simp only [reduceCtorEq, false_iff, ne_eq] + omega + · simp only [pairBitEncoding_apply, List.length_append, List.length_map, ite_eq_left_iff, + reduceCtorEq, + imp_false, Decidable.not_not] + +private theorem pairedInputTagAt_blank_after + (x certificate : List Bool) (index : ℕ) + (hindex : x.length + certificate.length < index) : + pairedInputTagAt x certificate index = .blank := by + have houtside : + (pairBitEncoding (x, certificate)).length ≤ index := by + simpa only [pairBitEncoding_apply, List.length_append, List.length_map] using (Nat.le_of_lt + hindex) + unfold pairedInputTagAt + rw [List.getElem?_eq_none houtside] + have hne : index ≠ x.length + certificate.length := by + omega + simp only [pairBitEncoding_apply, List.length_append, List.length_map, hne, ↓reduceIte] + +private theorem pairedInputGuessAllowed_canonical_next + (x certificate : List Bool) (bit : Bool) (index : ℕ) + (left right next : PairedInputTag) + (hleft : left = pairedInputTagAt x certificate (index - 1)) + (hallowed : PairedInputGuessAllowed bit + (left, pairedInputTagAt x certificate index, right, next)) : + next = pairedInputTagAt x (certificate ++ [bit]) index := by + simp only [PairedInputGuessAllowed, decide_eq_true_eq] at hallowed + rcases hallowed with hwrite | hmarker | hunchanged + · have hindex : index = x.length + certificate.length := + (pairedInputTagAt_marker_iff x certificate index).mp hwrite.1 + subst index + exact hwrite.2.2.trans + (pairedInputTagAt_append_old_marker x certificate bit).symm + · have hleftMarker : + pairedInputTagAt x certificate (index - 1) = .marker := by + rw [← hleft] + exact hmarker.2.1 + have hpredecessor : + index - 1 = x.length + certificate.length := + (pairedInputTagAt_marker_iff + x certificate (index - 1)).mp hleftMarker + have hnotMarker : index ≠ x.length + certificate.length := by + intro heq + exact hmarker.1 + ((pairedInputTagAt_marker_iff + x certificate index).mpr heq) + have hindex : index = x.length + certificate.length + 1 := by + omega + subst index + exact hmarker.2.2.trans + (pairedInputTagAt_append_new_marker x certificate bit).symm + · have hnotMarker : index ≠ x.length + certificate.length := by + intro heq + exact hunchanged.1 + ((pairedInputTagAt_marker_iff + x certificate index).mpr heq) + have hnotPrevious : + index - 1 ≠ x.length + certificate.length := by + intro heq + apply hunchanged.2.1 + rw [hleft] + exact (pairedInputTagAt_marker_iff + x certificate (index - 1)).mpr heq + by_cases hbefore : index < x.length + certificate.length + · exact hunchanged.2.2.trans + (pairedInputTagAt_append_before + x certificate bit index hbefore).symm + · have hafter : x.length + certificate.length + 1 < index := by + omega + exact hunchanged.2.2.trans + (pairedInputTagAt_append_after + x certificate bit index hafter).symm + +private theorem broadcastWitnessGuessAllowed_canonical_next + (certificate : List Bool) (bit : Bool) (index : ℕ) + (left right next : PhaseTag) + (hleft : left = certificatePhase certificate (index - 1)) + (hallowed : BroadcastWitnessGuessAllowed bit + (left, certificatePhase certificate index, right, next)) : + next = certificatePhase (certificate ++ [bit]) index := by + simp only [BroadcastWitnessGuessAllowed, GuessPhaseAllowed, decide_eq_true_eq] + at hallowed + rcases hallowed.1 with hwrite | hmarker | hunchanged + · have hindex : index = certificate.length := + (certificatePhase_accepting_iff certificate index).mp hwrite.1 + have hnext : + next = if bit then PhaseTag.verifying else PhaseTag.guessing := + hallowed.2 hwrite.1 + subst index + exact hnext.trans + (certificatePhase_append_old_marker certificate bit).symm + · have hleftMarker : + certificatePhase certificate (index - 1) = .accepting := by + rw [← hleft] + exact hmarker.2.1 + have hpredecessor : index - 1 = certificate.length := + (certificatePhase_accepting_iff + certificate (index - 1)).mp hleftMarker + have hnotMarker : index ≠ certificate.length := by + intro heq + exact hmarker.1 + ((certificatePhase_accepting_iff certificate index).mpr heq) + have hindex : index = certificate.length + 1 := by + omega + subst index + exact hmarker.2.2.trans + (certificatePhase_append_new_marker certificate bit).symm + · have hnotMarker : index ≠ certificate.length := by + intro heq + exact hunchanged.1 + ((certificatePhase_accepting_iff certificate index).mpr heq) + have hnotPrevious : index - 1 ≠ certificate.length := by + intro heq + apply hunchanged.2.1 + rw [hleft] + exact (certificatePhase_accepting_iff + certificate (index - 1)).mpr heq + by_cases hbefore : index < certificate.length + · exact hunchanged.2.2.trans + (certificatePhase_append_before + certificate bit index hbefore).symm + · have hafter : certificate.length + 1 < index := by + omega + exact hunchanged.2.2.trans + (certificatePhase_append_after + certificate bit index hafter).symm + +private theorem pairedInputGuessAllowed_of_append + (x certificate : List Bool) (bit : Bool) (index : ℕ) : + PairedInputGuessAllowed bit + (pairedInputTagAt x certificate (index - 1), + pairedInputTagAt x certificate index, + pairedInputTagAt x certificate (index + 1), + pairedInputTagAt x (certificate ++ [bit]) index) := by + simp only [PairedInputGuessAllowed, decide_eq_true_eq] + by_cases hmarker : index = x.length + certificate.length + · subst index + refine Or.inl ⟨pairedInputTagAt_marker x certificate, ?_, + pairedInputTagAt_append_old_marker x certificate bit⟩ + exact pairedInputTagAt_blank_after x certificate _ (by omega) + · by_cases hnextMarker : index = x.length + certificate.length + 1 + · subst index + refine Or.inr (Or.inl ⟨?_, ?_, + pairedInputTagAt_append_new_marker x certificate bit⟩) + · intro hfalse + have heq := (pairedInputTagAt_marker_iff + x certificate (x.length + certificate.length + 1)).mp hfalse + omega + · have hpred : + x.length + certificate.length + 1 - 1 = + x.length + certificate.length := by + omega + rw [hpred] + exact pairedInputTagAt_marker x certificate + · refine Or.inr (Or.inr ⟨?_, ?_, ?_⟩) + · intro hfalse + exact hmarker + ((pairedInputTagAt_marker_iff + x certificate index).mp hfalse) + · intro hfalse + have hpred := (pairedInputTagAt_marker_iff + x certificate (index - 1)).mp hfalse + omega + · by_cases hbefore : index < x.length + certificate.length + · exact pairedInputTagAt_append_before + x certificate bit index hbefore + · have hafter : x.length + certificate.length + 1 < index := by + omega + exact pairedInputTagAt_append_after + x certificate bit index hafter + +private theorem pairedCertificateBound_le_rowWidth + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + x.length + bound.eval x.length ≤ rowWidth bound machine x := by + simp only [rowWidth, nondeterministicTableauDimensionPolynomial, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_X, + Polynomial.eval_C, Polynomial.eval_one] + omega + +private theorem phaseLeftOffset_coordinate + {α : Type} + (tm : Turing.FinTM2) + (width : ℕ) + (track : Position width → Fin (blockSize tm) → α) + (index : Position width) : + phaseLeftOffset tm + (decide ((coordinateBlock tm width index).val = 0)) + (track (leftBlock width (coordinateBlock tm width index))) + (track (coordinateBlock tm width index)) + (coordinateOffset tm width index) = + track (coordinateBlock tm width (leftBlock width index)) + (coordinateOffset tm width (leftBlock width index)) := by + have hpositive := blockSize_pos tm + by_cases hzero : index.val = 0 + · have hindex : index = 0 := Fin.ext hzero + subst index + simp only [phaseLeftOffset, coordinateOffset, Fin.coe_ofNat_eq_mod, Nat.zero_mod, ↓reduceDIte, + coordinateBlock, Nat.zero_div, Fin.zero_eta, decide_true, ↓reduceIte, leftBlock, zero_tsub] + · have hprevious : index.val - 1 + 1 = index.val := by + omega + by_cases hseam : index.val % blockSize tm = 0 + · have hdivision : + index.val / blockSize tm = + (index.val - 1) / blockSize tm + 1 := by + have hz : + (index.val - 1 + 1) % blockSize tm = 0 := by + simpa only [hprevious] using hseam + simpa only [hprevious] using (Nat.succ_div_of_mod_eq_zero hz) + have hblockPositive : 0 < index.val / blockSize tm := by + rw [hdivision] + exact Nat.zero_lt_succ _ + have hdivisible : + blockSize tm ∣ index.val - 1 + 1 := + Nat.dvd_of_mod_eq_zero (by + simpa only [hprevious] using hseam) + have hpreviousMod : + (index.val - 1) % blockSize tm = blockSize tm - 1 := by + apply (Nat.mod_eq_sub_iff Nat.zero_lt_one (by omega)).mpr + exact hdivisible + have hleftBlock : + leftBlock width (coordinateBlock tm width index) = + coordinateBlock tm width (leftBlock width index) := by + apply Fin.ext + change index.val / blockSize tm - 1 = + (index.val - 1) / blockSize tm + omega + have hleftOffset : + lastPhaseOffset tm = + coordinateOffset tm width (leftBlock width index) := by + apply Fin.ext + change blockSize tm - 1 = + (index.val - 1) % blockSize tm + omega + have hoffset : + (coordinateOffset tm width index).val = 0 := hseam + have hfirst : + decide ((coordinateBlock tm width index).val = 0) = false := by + simp only [coordinateBlock, Nat.ne_of_gt hblockPositive, decide_false] + have hleft : + phaseLeftOffset tm + (decide ((coordinateBlock tm width index).val = 0)) + (track (leftBlock width (coordinateBlock tm width index))) + (track (coordinateBlock tm width index)) + (coordinateOffset tm width index) = + track (leftBlock width (coordinateBlock tm width index)) + (lastPhaseOffset tm) := by + rw [hfirst] + simp only [phaseLeftOffset, hoffset, ↓reduceDIte, Bool.false_eq_true, ↓reduceIte] + rw [hleft, hleftBlock, hleftOffset] + · have hdivision : + index.val / blockSize tm = + (index.val - 1) / blockSize tm := by + have hnonzero : + (index.val - 1 + 1) % blockSize tm ≠ 0 := by + simpa only [hprevious, ne_eq] using hseam + simpa only [hprevious] using (Nat.succ_div_of_mod_ne_zero hnonzero) + have hpreviousMod : + (index.val - 1) % blockSize tm = + index.val % blockSize tm - 1 := by + rw [Nat.mod_eq_sub_div_mul, Nat.mod_eq_sub_div_mul, + ← hdivision] + omega + have hsameBlock : + coordinateBlock tm width index = + coordinateBlock tm width (leftBlock width index) := by + apply Fin.ext + exact hdivision + let predecessorOffset : Fin (blockSize tm) := + ⟨(coordinateOffset tm width index).val - 1, by + have hlt := (coordinateOffset tm width index).isLt + omega⟩ + have hsameOffset : + predecessorOffset = + coordinateOffset tm width (leftBlock width index) := by + apply Fin.ext + change index.val % blockSize tm - 1 = + (index.val - 1) % blockSize tm + omega + have hoffset : + (coordinateOffset tm width index).val ≠ 0 := hseam + have hleft : + phaseLeftOffset tm + (decide ((coordinateBlock tm width index).val = 0)) + (track (leftBlock width (coordinateBlock tm width index))) + (track (coordinateBlock tm width index)) + (coordinateOffset tm width index) = + track (coordinateBlock tm width index) + predecessorOffset := by + simp only [phaseLeftOffset, hoffset, ↓reduceDIte, predecessorOffset] + rw [hleft, hsameBlock, hsameOffset] + +private theorem phaseRangeBlockAt_coordinate + (tm : Turing.FinTM2) + (width : ℕ) + (index : Position width) : + phaseRangeBlockAt tm width + (coordinateBlock tm width index) + (coordinateOffset tm width index) = true := by + change decide + (index.val / blockSize tm * blockSize tm + + index.val % blockSize tm < width + 1) = true + rw [Nat.div_add_mod'] + exact decide_eq_true index.isLt + +private theorem phaseBudgetBlockAt_coordinate + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (index : Position (rowWidth bound machine x)) : + phaseBudgetBlockAt bound machine x + (coordinateBlock machine.tm (rowWidth bound machine x) index) + (coordinateOffset machine.tm (rowWidth bound machine x) index) = + decide (index.val < x.length + bound.eval x.length) := by + change decide + (index.val / blockSize machine.tm * blockSize machine.tm + + index.val % blockSize machine.tm < + x.length + bound.eval x.length) = _ + rw [Nat.div_add_mod'] + +private theorem completeWitnessWindow_left_unpacked + (tm : Turing.FinTM2) + (width : ℕ) + (first next : Position width → CompletePhaseCell tm) + (index : Position width) + (hboundary : completeIsFirstBlock tm + (first (coordinateBlock tm width index)) = + decide ((coordinateBlock tm width index).val = 0)) : + (completeWitnessWindow tm + (anchoredVerifierWindowAt tm width first next + (coordinateBlock tm width index)) + (coordinateOffset tm width index)).1 = + unpackPhaseWitness tm width first (leftBlock width index) := by + change + phaseLeftOffset tm + (completeIsFirstBlock tm + (first (coordinateBlock tm width index))) + (fun offset => + (completeMachineBlock tm + (first (leftBlock width + (coordinateBlock tm width index))) offset).1) + (fun offset => + (completeMachineBlock tm + (first (coordinateBlock tm width index)) offset).1) + (coordinateOffset tm width index) = + (completeMachineBlock tm + (first (coordinateBlock tm width (leftBlock width index))) + (coordinateOffset tm width (leftBlock width index))).1 + rw [hboundary] + exact phaseLeftOffset_coordinate tm width + (fun position offset => + (completeMachineBlock tm (first position) offset).1) index + +private theorem completePayloadWindow_left_unpacked + (tm : Turing.FinTM2) + (width : ℕ) + (first next : Position width → CompletePhaseCell tm) + (index : Position width) + (hboundary : completeIsFirstBlock tm + (first (coordinateBlock tm width index)) = + decide ((coordinateBlock tm width index).val = 0)) : + (completePayloadWindow tm + (anchoredVerifierWindowAt tm width first next + (coordinateBlock tm width index)) + (coordinateOffset tm width index)).1 = + unpackPhasePayload tm width first (leftBlock width index) := by + change + phaseLeftOffset tm + (completeIsFirstBlock tm + (first (coordinateBlock tm width index))) + (first (leftBlock width + (coordinateBlock tm width index))).payload + (first (coordinateBlock tm width index)).payload + (coordinateOffset tm width index) = + (first (coordinateBlock tm width (leftBlock width index))).payload + (coordinateOffset tm width (leftBlock width index)) + rw [hboundary] + exact phaseLeftOffset_coordinate tm width + (fun position => (first position).payload) index + +private structure CanonicalGuessingTracks + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (row : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) where + certificate : List Bool + certificate_le : certificate.length ≤ bound.eval x.length + mode : ∀ position : Position (rowWidth bound machine x), + (row position).mode = .guessing + witness : ∀ index : Position (rowWidth bound machine x), + unpackPhaseWitness machine.tm (rowWidth bound machine x) row index = + certificatePhase certificate index.val + payload : ∀ index : Position (rowWidth bound machine x), + unpackPhasePayload machine.tm (rowWidth bound machine x) row index = + pairedInputTagAt x certificate index.val + +private theorem unpackPhaseWitness_initialPhaseCell + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (index : Position (rowWidth bound machine x)) : + unpackPhaseWitness machine.tm (rowWidth bound machine x) + (initialPhaseCell bound machine x) index = + certificatePhase [] index.val := by + change + (packRow machine.tm (rowWidth bound machine x) + (guessingRow machine.tm (rowWidth bound machine x) []) + (coordinateBlock machine.tm (rowWidth bound machine x) index) + (coordinateOffset machine.tm (rowWidth bound machine x) index)).1 = + certificatePhase [] index.val + rw [packRow_cell] + rfl + +private theorem unpackPhasePayload_initialPhaseCell + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (index : Position (rowWidth bound machine x)) : + unpackPhasePayload machine.tm (rowWidth bound machine x) + (initialPhaseCell bound machine x) index = + pairedInputTagAt x [] index.val := by + have hcoordinate : + index.val / blockSize machine.tm * blockSize machine.tm + + index.val % blockSize machine.tm = index.val := + Nat.div_add_mod' index.val (blockSize machine.tm) + simp only [unpackPhasePayload, initialPhaseCell, coordinateBlock, coordinateOffset, + pairedInputBlockAt, + hcoordinate, Order.lt_add_one_iff, ite_eq_left_iff, not_le] + omega + +private def initialCanonicalGuessingTracks + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + CanonicalGuessingTracks bound machine x + (initialPhaseCell bound machine x) where + certificate := [] + certificate_le := Nat.zero_le _ + mode := fun _ => rfl + witness := unpackPhaseWitness_initialPhaseCell bound machine x + payload := unpackPhasePayload_initialPhaseCell bound machine x + +private theorem correctedGuessingWindows_certificate_lt + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + CorrectedGuessingAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) : + hfirst.certificate.length < bound.eval x.length := by + have hmarkerWidth : + x.length + hfirst.certificate.length ≤ rowWidth bound machine x := + (Nat.add_le_add_left hfirst.certificate_le x.length).trans + (pairedCertificateBound_le_rowWidth bound machine x) + let marker : Position (rowWidth bound machine x) := + ⟨x.length + hfirst.certificate.length, + Nat.lt_succ_of_le hmarkerWidth⟩ + let block := coordinateBlock machine.tm + (rowWidth bound machine x) marker + let offset := coordinateOffset machine.tm + (rowWidth bound machine x) marker + have mask := hmasks block + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at mask + have guess := hwindows block + simp only [CorrectedGuessingAllowed, decide_eq_true_eq] at guess + have hrange : (first block).range offset = true := by + rw [mask.1] + exact phaseRangeBlockAt_coordinate machine.tm + (rowWidth bound machine x) marker + have hmarker : (first block).payload offset = .marker := by + change unpackPhasePayload machine.tm + (rowWidth bound machine x) first marker = .marker + rw [hfirst.payload marker] + exact pairedInputTagAt_marker x hfirst.certificate + have hbudget : (first block).budget offset = true := + (guess.2.2.2.2 offset hrange).2.2 hmarker + rw [mask.2.2.1] at hbudget + change phaseBudgetBlockAt bound machine x + (coordinateBlock machine.tm (rowWidth bound machine x) marker) + (coordinateOffset machine.tm (rowWidth bound machine x) marker) = + true at hbudget + rw [phaseBudgetBlockAt_coordinate] at hbudget + have hbudgetLt : marker.val < x.length + bound.eval x.length := + of_decide_eq_true hbudget + change x.length + hfirst.certificate.length < + x.length + bound.eval x.length at hbudgetLt + omega + +private def correctedGuessingWindows_nextCanonical + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (bit : Bool) + (hbit : ∀ position : Position (rowWidth bound machine x), + (next position).guessBit = bit) + (hwindows : ∀ position : Position (rowWidth bound machine x), + CorrectedGuessingAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) : + CanonicalGuessingTracks bound machine x next := by + let certificate := hfirst.certificate + have hcertificate : certificate.length < bound.eval x.length := + correctedGuessingWindows_certificate_lt + bound machine x first next hfirst hmasks hwindows + refine { + certificate := certificate ++ [bit] + certificate_le := ?_ + mode := ?_ + witness := ?_ + payload := ?_ + } + · simp only [List.length_append, List.length_singleton] + omega + · intro position + have guess := hwindows position + simp only [CorrectedGuessingAllowed, decide_eq_true_eq] at guess + exact guess.1 + · intro index + let block := coordinateBlock machine.tm + (rowWidth bound machine x) index + let offset := coordinateOffset machine.tm + (rowWidth bound machine x) index + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next block + have mask := hmasks block + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at mask + have guess := hwindows block + simp only [CorrectedGuessingAllowed, decide_eq_true_eq] at guess + have hrange : (first block).range offset = true := by + rw [mask.1] + exact phaseRangeBlockAt_coordinate machine.tm + (rowWidth bound machine x) index + have hallowed : BroadcastWitnessGuessAllowed + ((next block).guessBit) + (completeWitnessWindow machine.tm window offset) := + (guess.2.2.2.2 offset hrange).1 + rw [hbit block] at hallowed + have hleft : + (completeWitnessWindow machine.tm window offset).1 = + certificatePhase certificate (index.val - 1) := by + calc + (completeWitnessWindow machine.tm window offset).1 = + unpackPhaseWitness machine.tm + (rowWidth bound machine x) first + (leftBlock (rowWidth bound machine x) index) := + completeWitnessWindow_left_unpacked machine.tm + (rowWidth bound machine x) first next index + mask.2.2.2 + _ = certificatePhase hfirst.certificate + (leftBlock (rowWidth bound machine x) index).val := + hfirst.witness _ + _ = certificatePhase certificate (index.val - 1) := rfl + have hcenter : + (completeWitnessWindow machine.tm window offset).2.1 = + certificatePhase certificate index.val := by + exact hfirst.witness index + change BroadcastWitnessGuessAllowed bit + ((completeWitnessWindow machine.tm window offset).1, + (completeWitnessWindow machine.tm window offset).2.1, + (completeWitnessWindow machine.tm window offset).2.2.1, + (completeWitnessWindow machine.tm window offset).2.2.2) + at hallowed + rw [hcenter] at hallowed + exact broadcastWitnessGuessAllowed_canonical_next + certificate bit index.val + (completeWitnessWindow machine.tm window offset).1 + (completeWitnessWindow machine.tm window offset).2.2.1 + (completeWitnessWindow machine.tm window offset).2.2.2 + hleft hallowed + · intro index + let block := coordinateBlock machine.tm + (rowWidth bound machine x) index + let offset := coordinateOffset machine.tm + (rowWidth bound machine x) index + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next block + have mask := hmasks block + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at mask + have guess := hwindows block + simp only [CorrectedGuessingAllowed, decide_eq_true_eq] at guess + have hrange : (first block).range offset = true := by + rw [mask.1] + exact phaseRangeBlockAt_coordinate machine.tm + (rowWidth bound machine x) index + have hallowed : PairedInputGuessAllowed + ((next block).guessBit) + (completePayloadWindow machine.tm window offset) := + (guess.2.2.2.2 offset hrange).2.1 + rw [hbit block] at hallowed + have hleft : + (completePayloadWindow machine.tm window offset).1 = + pairedInputTagAt x certificate (index.val - 1) := by + calc + (completePayloadWindow machine.tm window offset).1 = + unpackPhasePayload machine.tm + (rowWidth bound machine x) first + (leftBlock (rowWidth bound machine x) index) := + completePayloadWindow_left_unpacked machine.tm + (rowWidth bound machine x) first next index + mask.2.2.2 + _ = pairedInputTagAt x hfirst.certificate + (leftBlock (rowWidth bound machine x) index).val := + hfirst.payload _ + _ = pairedInputTagAt x certificate (index.val - 1) := rfl + have hcenter : + (completePayloadWindow machine.tm window offset).2.1 = + pairedInputTagAt x certificate index.val := by + exact hfirst.payload index + change PairedInputGuessAllowed bit + ((completePayloadWindow machine.tm window offset).1, + (completePayloadWindow machine.tm window offset).2.1, + (completePayloadWindow machine.tm window offset).2.2.1, + (completePayloadWindow machine.tm window offset).2.2.2) + at hallowed + rw [hcenter] at hallowed + exact pairedInputGuessAllowed_canonical_next + x certificate bit index.val + (completePayloadWindow machine.tm window offset).1 + (completePayloadWindow machine.tm window offset).2.2.1 + (completePayloadWindow machine.tm window offset).2.2.2 + hleft hallowed + +private theorem stackSoundValidTrace_guessingTime_lt_width + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Time (rowWidth bound machine x)) + (hguess : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time) position).mode = .guessing) : + time.val < rowWidth bound machine x := by + have hanchored := stackSoundValidTrace_to_anchored + bound machine x trace htrace + obtain ⟨position, haccept⟩ := + anchoredValidTrace_has_acceptingCell + bound machine x trace hanchored + by_contra hnot + have hlastVal : time.val = rowWidth bound machine x := by + have hlt := time.isLt + omega + have hlast : time = Fin.last (rowWidth bound machine x) := by + apply Fin.ext + exact hlastVal + have himpossible := hguess position + rw [hlast, haccept] at himpossible + cases himpossible + +private theorem stackSoundValidTrace_guessingSuccessor_bit_constant + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .guessing) : + ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).guessBit = + (decodeCorrectedPhaseRow machine + (trace time.succ) 0).guessBit := by + have hnextTime := stackSoundValidTrace_guessingTime_lt_width + bound machine x trace htrace time.succ hnext + let following : Fin (rowWidth bound machine x) := + ⟨time.succ.val, hnextTime⟩ + have hrow : trace (Fin.castSucc following) = trace time.succ := by + apply congrArg trace + apply Fin.ext + rfl + intro position + have hconstant := anchoredValidTrace_guessBit_constant + bound machine x trace + (stackSoundValidTrace_to_anchored bound machine x trace htrace) + following position + calc + (decodeCorrectedPhaseRow machine + (trace time.succ) position).guessBit = + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc following)) position).guessBit := + (congrArg (fun row => + (decodeCorrectedPhaseRow machine row position).guessBit) + hrow).symm + _ = (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc following)) 0).guessBit := hconstant + _ = (decodeCorrectedPhaseRow machine + (trace time.succ) 0).guessBit := + congrArg (fun row => + (decodeCorrectedPhaseRow machine row 0).guessBit) hrow + +private theorem stackSoundValidTrace_allGuessingWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .guessing) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .guessing) : + ∀ position : Position (rowWidth bound machine x), + CorrectedGuessingAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine + (trace time.succ)) position) := by + intro position + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine + (trace time.succ)) position + have hallowed := stackSoundValidTrace_window + bound machine x trace htrace (windowAt time position) + change StackSoundAnchoredPhaseAllowed machine window at hallowed + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] at hallowed + have hbranches : + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window := by + have hbranch := hallowed.2 + change + match (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode with + | .guessing => + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window + | .verifying => + StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window + | .accepting => + window.2.2.2 = acceptingPhaseCell machine.tm + at hbranch + simpa only [hfirst position] using hbranch + rcases hbranches with hguess | hinitial + · simp only [AnchoredGuessingAllowed, decide_eq_true_eq] at hguess + exact hguess.1 + · simp only [AnchoredInitializationAllowed, CompleteInitializationAllowed, + decide_eq_true_eq] at hinitial + have hinitialOuter := ofClassicalDecide hinitial + have hinitialCore := ofClassicalDecide hinitialOuter.1 + have himpossible := hinitialCore.1 + change + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying at himpossible + rw [hnext position] at himpossible + cases himpossible + +private def stackSoundValidTrace_guessingSuccessorCanonical + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : CanonicalGuessingTracks bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .guessing) : + CanonicalGuessingTracks bound machine x + (decodeCorrectedPhaseRow machine (trace time.succ)) := by + apply correctedGuessingWindows_nextCanonical + bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + hfirst + (fun position => stackSoundValidTrace_masks_of_not_accepting + bound machine x trace htrace (Fin.castSucc time) position + (by rw [hfirst.mode position]; exact PhaseTag.noConfusion)) + ((decodeCorrectedPhaseRow machine + (trace time.succ) 0).guessBit) + · exact stackSoundValidTrace_guessingSuccessor_bit_constant + bound machine x trace htrace time hnext + · exact stackSoundValidTrace_allGuessingWindows + bound machine x trace htrace time hfirst.mode hnext + +private noncomputable def stackSoundValidTrace_guessingSuccessor_actualStep + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : CanonicalGuessingTracks bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .guessing) : + GuessStep bound machine x + (.guessing hfirst.certificate) + (.guessing + (stackSoundValidTrace_guessingSuccessorCanonical + bound machine x trace htrace time hfirst hnext).certificate) := by + have hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position) := by + intro position + exact stackSoundValidTrace_masks_of_not_accepting + bound machine x trace htrace (Fin.castSucc time) position + (by rw [hfirst.mode position]; exact PhaseTag.noConfusion) + have hwindows := stackSoundValidTrace_allGuessingWindows + bound machine x trace htrace time hfirst.mode hnext + have hbound := correctedGuessingWindows_certificate_lt + bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) + hfirst hmasks hwindows + exact GuessStep.guess hfirst.certificate + ((decodeCorrectedPhaseRow machine + (trace time.succ) 0).guessBit) hbound + +end CLGuessPayloadReachability + +namespace CLReachableTableauCompiler + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLNondeterminism +open GapCVP.CLBoundedStates GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLCellRowBounds +open GapCVP.CLLocalWindows GapCVP.CLExactStackRules GapCVP.CLFiniteShiftWindows +open GapCVP.CLLocalTableauCompiler GapCVP.CLGlobalTableauSimulation +open GapCVP.CLTableauSimulationCert GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseSoundness +open GapCVP.CLPhaseCompleteness GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseGlobalSimulation +open GapCVP.CLWholeTraceSoundness GapCVP.CLStackVerifierSimulation +open GapCVP.CLAnchoredTraceSimulation GapCVP.CLRawTrackSimulation +open GapCVP.CLCompactWindowSoundness GapCVP.CLNoHoleTimeInduction GapCVP.CLBoundedRowInduction +open GapCVP.CLFullStackStepSoundness GapCVP.CLFullTraceReachability +open GapCVP.CLGuessPayloadReachability + +private theorem initialPairedAtom_input_decode + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (bit : Bool ⊕ Bool) : + cellAtomValue machine machine.tm.k₀ + (initialPairedAtom machine machine.tm.k₀ (.bit bit)) = + some (machine.inputAlphabet.invFun bit) := by + simp only [initialPairedAtom, ↓reduceIte, Equiv.invFun_as_coe, canonicalCellAtom_decode] + +private theorem initialPairedAtom_private_blank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (hstack : stack ≠ machine.tm.k₀) + (tag : PairedInputTag) : + initialPairedAtom machine stack tag = none := by + cases tag <;> simp [initialPairedAtom, hstack] + +private theorem initialPairedAtom_pairedInput_decode + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (index : ℕ) : + cellAtomValue machine machine.tm.k₀ + (initialPairedAtom machine machine.tm.k₀ + (pairedInputTagAt x certificate index)) = + (verifierInput machine x certificate)[index]? := by + change + cellAtomValue machine machine.tm.k₀ + (initialPairedAtom machine machine.tm.k₀ + (pairedInputTagAt x certificate index)) = + ((pairBitEncoding (x, certificate)).map + machine.inputAlphabet.invFun)[index]? + rw [List.getElem?_map] + cases hentry : (pairBitEncoding (x, certificate))[index]? with + | none => + simp only [Option.map_none] + have htag : pairedInputTagAt x certificate index = + if index = (pairBitEncoding (x, certificate)).length then + .marker + else + .blank := by + unfold pairedInputTagAt + rw [hentry] + rw [htag] + split <;> rfl + | some bit => + simp only [Option.map_some] + have htag : pairedInputTagAt x certificate index = .bit bit := by + unfold pairedInputTagAt + rw [hentry] + rw [htag] + exact initialPairedAtom_input_decode machine bit + +private theorem allInitializationWindows_stackAtom + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (first next : Position width → CompletePhaseCell machine.tm) + (hwindows : ∀ position : Position width, + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm width + first next position)) + (position : Position width) + (stack : machine.tm.K) + (offset : Fin (blockSize machine.tm)) : + ((completeMachineBlock machine.tm (next position) + offset).2.2.1 stack) = + if (first position).range offset then + initialPairedAtom machine stack + ((first position).payload offset) + else + none := by + have hwindow := hwindows position + simp only [AnchoredInitializationAllowed, + CompleteInitializationAllowed, decide_eq_true_eq] at hwindow + have hwindowOuter := ofClassicalDecide hwindow + have hwindowCore := ofClassicalDecide hwindowOuter.1 + have hblock := hwindowCore.2.2.1 + change + completeMachineBlock machine.tm (next position) = + initializedPhaseBlock machine + (completeMachineBlock machine.tm (first position)) + (first position).payload (first position).range at hblock + rw [hblock] + cases hrange : (first position).range offset <;> + simp [initializedPhaseBlock, hrange, blankCell] + +private theorem allInitializationWindows_fullPackedStackAtoms + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) + (stack : machine.tm.K) : + fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) next stack = + List.ofFn (fun index : Fin + (packedPhaseCapacity machine.tm (rowWidth bound machine x)) => + initialPairedAtom machine stack + (pairedInputTagAt x hfirst.certificate index.val)) := by + unfold fullPackedPhaseStackAtoms + congr 1 + funext index + let position : Position (rowWidth bound machine x) := + ⟨index.val / blockSize machine.tm, + (Nat.div_lt_iff_lt_mul + (blockSize_pos machine.tm)).mpr index.isLt⟩ + let offset : Fin (blockSize machine.tm) := + ⟨index.val % blockSize machine.tm, + Nat.mod_lt index.val (blockSize_pos machine.tm)⟩ + have hatom := allInitializationWindows_stackAtom + machine (rowWidth bound machine x) + first next hwindows position stack offset + have hmaskView := hmasks position + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at hmaskView + by_cases hrange : index.val < rowWidth bound machine x + 1 + · let original : Position (rowWidth bound machine x) := + ⟨index.val, hrange⟩ + have hposition : + position = coordinateBlock machine.tm + (rowWidth bound machine x) original := by + apply Fin.ext + rfl + have hoffset : + offset = coordinateOffset machine.tm + (rowWidth bound machine x) original := by + apply Fin.ext + rfl + have hmask : (first position).range offset = true := by + rw [hmaskView.1] + change decide + (index.val / blockSize machine.tm * blockSize machine.tm + + index.val % blockSize machine.tm < + rowWidth bound machine x + 1) = true + rw [Nat.div_add_mod'] + exact decide_eq_true hrange + have hpayload : + (first position).payload offset = + pairedInputTagAt x hfirst.certificate index.val := by + rw [hposition, hoffset] + exact hfirst.payload original + change + ((completeMachineBlock machine.tm (next position) + offset).2.2.1 stack) = + initialPairedAtom machine stack + (pairedInputTagAt x hfirst.certificate index.val) + rw [hatom, hmask, hpayload] + rfl + · have hmask : (first position).range offset = false := by + rw [hmaskView.1] + change decide + (index.val / blockSize machine.tm * blockSize machine.tm + + index.val % blockSize machine.tm < + rowWidth bound machine x + 1) = false + rw [Nat.div_add_mod'] + exact decide_eq_false hrange + have hcertificateWidth : + x.length + hfirst.certificate.length ≤ + rowWidth bound machine x := + (Nat.add_le_add_left hfirst.certificate_le x.length).trans + (pairedCertificateBound_le_rowWidth bound machine x) + have hblank : + pairedInputTagAt x hfirst.certificate index.val = .blank := by + apply pairedInputTagAt_blank_after + omega + change + ((completeMachineBlock machine.tm (next position) + offset).2.2.1 stack) = + initialPairedAtom machine stack + (pairedInputTagAt x hfirst.certificate index.val) + rw [hatom, hmask, hblank] + rfl + +private theorem allInitializationWindows_decodedFullPackedInputStack + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) : + decodedFullPackedPhaseStack machine + (rowWidth bound machine x) next machine.tm.k₀ = + verifierInput machine x hfirst.certificate := by + unfold decodedFullPackedPhaseStack + rw [allInitializationWindows_fullPackedStackAtoms + bound machine x first next hfirst hmasks hwindows machine.tm.k₀] + rw [← filterMap_ofFn_comp + (packedPhaseCapacity machine.tm (rowWidth bound machine x)) + (fun index : Fin + (packedPhaseCapacity machine.tm (rowWidth bound machine x)) => + initialPairedAtom machine machine.tm.k₀ + (pairedInputTagAt x hfirst.certificate index.val)) + (cellAtomValue machine machine.tm.k₀)] + have hpointwise : + (fun index : Fin + (packedPhaseCapacity machine.tm (rowWidth bound machine x)) => + cellAtomValue machine machine.tm.k₀ + (initialPairedAtom machine machine.tm.k₀ + (pairedInputTagAt x hfirst.certificate index.val))) = + (fun index : Fin + (packedPhaseCapacity machine.tm (rowWidth bound machine x)) => + (verifierInput machine x hfirst.certificate)[index.val]?) := by + funext index + exact initialPairedAtom_pairedInput_decode + machine x hfirst.certificate index.val + rw [hpointwise, filterMap_ofFn_getElem] + apply List.take_of_length_le + have hcertificateWidth : + x.length + hfirst.certificate.length ≤ + rowWidth bound machine x := + (Nat.add_le_add_left hfirst.certificate_le x.length).trans + (pairedCertificateBound_le_rowWidth bound machine x) + have hblock : 1 ≤ blockSize machine.tm := by + have hpositive := blockSize_pos machine.tm + omega + have hcapacity : + rowWidth bound machine x + 1 ≤ + packedPhaseCapacity machine.tm + (rowWidth bound machine x) := by + unfold packedPhaseCapacity + simpa only [Order.lt_add_one_iff, zero_le, le_mul_iff_one_le_right, mul_one] using + Nat.mul_le_mul_left (rowWidth bound machine x + 1) hblock + simp only [verifierInput, List.length_map, + pairBitEncoding_length] + omega + +private theorem allInitializationWindows_decodedFullPackedPrivateStack + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) + (stack : machine.tm.K) + (hstack : stack ≠ machine.tm.k₀) : + decodedFullPackedPhaseStack machine + (rowWidth bound machine x) next stack = [] := by + unfold decodedFullPackedPhaseStack + rw [allInitializationWindows_fullPackedStackAtoms + bound machine x first next hfirst hmasks hwindows stack] + have hblank : + (fun index : Fin + (packedPhaseCapacity machine.tm + (rowWidth bound machine x)) => + initialPairedAtom machine stack + (pairedInputTagAt x hfirst.certificate index.val)) = + (fun _ : Fin + (packedPhaseCapacity machine.tm + (rowWidth bound machine x)) => + (none : CellAtom machine.tm)) := by + funext index + exact initialPairedAtom_private_blank + machine stack hstack + (pairedInputTagAt x hfirst.certificate index.val) + rw [hblank] + rw [List.ofFn_const] + exact List.filterMap_replicate_of_none + (cellAtomValue_blank machine stack) + +private theorem allInitializationWindows_decodedFullPackedStack + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) + (stack : machine.tm.K) : + decodedFullPackedPhaseStack machine + (rowWidth bound machine x) next stack = + (Turing.initList machine.tm + (verifierInput machine x hfirst.certificate)).stk stack := by + classical + by_cases hstack : stack = machine.tm.k₀ + · subst stack + simpa only [initList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq] using + allInitializationWindows_decodedFullPackedInputStack bound machine x first next hfirst + hmasks hwindows + · rw [allInitializationWindows_decodedFullPackedPrivateStack + bound machine x first next hfirst hmasks hwindows stack hstack] + simp only [initList, eq_mpr_eq_cast, hstack, ↓reduceDIte] + +private theorem allInitializationWindows_initialControl + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) : + machineControlOfBlock machine.tm + (completeMachineHead machine.tm (next 0)) = + some + ((Turing.initList machine.tm + (verifierInput machine x hfirst.certificate)).l, + (Turing.initList machine.tm + (verifierInput machine x hfirst.certificate)).var) := by + have hwindow := hwindows 0 + simp only [AnchoredInitializationAllowed, + CompleteInitializationAllowed, decide_eq_true_eq] at hwindow + have hwindowOuter := ofClassicalDecide hwindow + have hwindowCore := ofClassicalDecide hwindowOuter.1 + have hhead := hwindowCore.2.2.2 + have hmask := hmasks 0 + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at hmask + change + completeMachineHead machine.tm (next 0) = + initializedPhaseBlock machine + (completeMachineHead machine.tm (first 0)) + (first 0).payloadHead (first 0).rangeHead at hhead + have hrange : + (first 0).rangeHead (firstPhaseOffset machine.tm) = true := by + rw [hmask.2.1] + simp only [phaseRangeBlockAt, Fin.coe_ofNat_eq_mod, Nat.zero_mod, zero_mul, firstPhaseOffset, + add_zero, + Order.lt_add_one_iff, zero_le, decide_true] + have hrangeZero : + (first 0).rangeHead + (⟨0, blockSize_pos machine.tm⟩ : + Fin (blockSize machine.tm)) = true := by + simpa only [firstPhaseOffset] using hrange + have hlabel : + (initializedPhaseBlock machine + (completeMachineHead machine.tm (first 0)) + (first 0).payloadHead (first 0).rangeHead + (⟨0, blockSize_pos machine.tm⟩ : + Fin (blockSize machine.tm))).2.1 = + some (configurationControl machine.tm + (Turing.initList machine.tm [])) := by + simp only [initializedPhaseBlock, hrangeZero, ↓reduceIte] + have hnonhalt : + (initializedPhaseBlock machine + (completeMachineHead machine.tm (first 0)) + (first 0).payloadHead (first 0).rangeHead + (⟨0, blockSize_pos machine.tm⟩ : + Fin (blockSize machine.tm))).2.2.2 = + true := by + simp only [initializedPhaseBlock, hrangeZero, ↓reduceIte, initList, eq_mpr_eq_cast, + Option.isSome_some] + rw [hhead] + unfold machineControlOfBlock + rw [hlabel, hnonhalt] + simp only [↓reduceIte, configurationControl, initList, eq_mpr_eq_cast, Option.getD_some] + +private theorem allInitializationWindows_actualFullPackedConfiguration + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) : + decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) next = + Turing.initList machine.tm + (verifierInput machine x hfirst.certificate) := by + have hcontrol := allInitializationWindows_initialControl + bound machine x first next hfirst hmasks hwindows + unfold decodedFullPackedPhaseConfiguration + rw [hcontrol] + apply configuration_eq_of_components machine.tm + · rfl + · rfl + · funext stack + exact allInitializationWindows_decodedFullPackedStack + bound machine x first next hfirst hmasks hwindows stack + +private theorem initialPairedAtom_input_ne_blank + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (bit : Bool ⊕ Bool) : + initialPairedAtom machine machine.tm.k₀ (.bit bit) ≠ none := by + intro hblank + have hdecode := initialPairedAtom_input_decode machine bit + rw [hblank, cellAtomValue_blank] at hdecode + cases hdecode + +private theorem initialPairedAtom_pairedInput_blank_iff + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (index : ℕ) : + initialPairedAtom machine machine.tm.k₀ + (pairedInputTagAt x certificate index) = none ↔ + (pairBitEncoding (x, certificate)).length ≤ index := by + constructor + · intro hblank + by_contra hnot + have hinside : index < + (pairBitEncoding (x, certificate)).length := by + omega + have hentry : + (pairBitEncoding (x, certificate))[index]? = + some ((pairBitEncoding (x, certificate))[index]) := + List.getElem?_eq_getElem hinside + have htag : + pairedInputTagAt x certificate index = + .bit ((pairBitEncoding (x, certificate))[index]) := by + unfold pairedInputTagAt + rw [hentry] + rw [htag] at hblank + exact initialPairedAtom_input_ne_blank machine _ hblank + · intro houtside + have hentry := List.getElem?_eq_none houtside + have htag : + pairedInputTagAt x certificate index = + if index = (pairBitEncoding (x, certificate)).length then + .marker + else + .blank := by + unfold pairedInputTagAt + rw [hentry] + rw [htag] + split <;> rfl + +private theorem pairedInputAtomTrack_noInteriorPaddingHoles + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (capacity : ℕ) + (stack : machine.tm.K) : + NoInteriorPaddingHoles machine.tm + (List.ofFn (fun index : Fin capacity => + initialPairedAtom machine stack + (pairedInputTagAt x certificate index.val))) := by + apply noInteriorPaddingHoles_of_blankPaddingMonotone + simp only [BlankPaddingMonotone, decide_eq_true_eq] + intro first next hle hblank + by_cases hnext : next < capacity + · have hfirst : first < capacity := by omega + let firstIndex : Fin capacity := ⟨first, hfirst⟩ + let nextIndex : Fin capacity := ⟨next, hnext⟩ + have hfirstAtom : + paddedAtom + (List.ofFn (fun index : Fin capacity => + initialPairedAtom machine stack + (pairedInputTagAt x certificate index.val))) first = + initialPairedAtom machine stack + (pairedInputTagAt x certificate first) := by + simp only [paddedAtom, List.length_ofFn, hfirst, getElem?_pos, List.getElem_ofFn, + Option.getD_some] + have hnextAtom : + paddedAtom + (List.ofFn (fun index : Fin capacity => + initialPairedAtom machine stack + (pairedInputTagAt x certificate index.val))) next = + initialPairedAtom machine stack + (pairedInputTagAt x certificate next) := by + simp only [paddedAtom, List.length_ofFn, hnext, getElem?_pos, List.getElem_ofFn, + Option.getD_some] + rw [hfirstAtom] at hblank + rw [hnextAtom] + by_cases hstack : stack = machine.tm.k₀ + · subst stack + apply (initialPairedAtom_pairedInput_blank_iff + machine x certificate next).mpr + have hword := (initialPairedAtom_pairedInput_blank_iff + machine x certificate first).mp hblank + omega + · exact initialPairedAtom_private_blank + machine stack hstack + (pairedInputTagAt x certificate next) + · apply paddedAtom_none_of_length_le + machine.tm + (List.ofFn (fun index : Fin capacity => + initialPairedAtom machine stack + (pairedInputTagAt x certificate index.val))) next + simp only [List.length_ofFn] + omega + +private theorem allInitializationWindows_fullPacked_noInteriorPaddingHoles + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) : + ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) next stack) := by + intro stack + rw [allInitializationWindows_fullPackedStackAtoms + bound machine x first next hfirst hmasks hwindows stack] + exact pairedInputAtomTrack_noInteriorPaddingHoles + machine x hfirst.certificate + (packedPhaseCapacity machine.tm (rowWidth bound machine x)) stack + +private theorem allInitializationWindows_fullPackedStack_length_le + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (first next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hfirst : CanonicalGuessingTracks bound machine x first) + (hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position)) + (hwindows : ∀ position : Position (rowWidth bound machine x), + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position)) : + ∀ stack : machine.tm.K, + (decodedFullPackedPhaseStack machine + (rowWidth bound machine x) next stack).length ≤ + rowWidth bound machine x := by + intro stack + classical + by_cases hstack : stack = machine.tm.k₀ + · subst stack + rw [allInitializationWindows_decodedFullPackedInputStack + bound machine x first next hfirst hmasks hwindows] + simp only [verifierInput, List.length_map, + pairBitEncoding_length] + exact (Nat.add_le_add_left hfirst.certificate_le x.length).trans + (pairedCertificateBound_le_rowWidth bound machine x) + · rw [allInitializationWindows_decodedFullPackedPrivateStack + bound machine x first next hfirst hmasks hwindows stack hstack] + exact Nat.zero_le _ + +private theorem stackSoundValidTrace_initialization_actualConfiguration + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : CanonicalGuessingTracks bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) : + decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)) = + Turing.initList machine.tm + (verifierInput machine x hfirst.certificate) := by + apply allInitializationWindows_actualFullPackedConfiguration + bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) hfirst + · intro position + exact stackSoundValidTrace_masks_of_not_accepting + bound machine x trace htrace (Fin.castSucc time) position + (by rw [hfirst.mode position]; exact PhaseTag.noConfusion) + · exact stackSoundValidTrace_allInitializationWindows + bound machine x trace htrace time hfirst.mode hnext + +private noncomputable def stackSoundValidTrace_initialization_actualBegin + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : CanonicalGuessingTracks bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) : + GuessStep bound machine x + (.guessing hfirst.certificate) + (.verifying hfirst.certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)))) := by + rw [stackSoundValidTrace_initialization_actualConfiguration + bound machine x trace htrace time hfirst hnext] + exact GuessStep.begin hfirst.certificate hfirst.certificate_le + +private noncomputable def stackSoundValidTrace_initialization_reachable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : CanonicalGuessingTracks bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) (.guessing hfirst.certificate) elapsed) : + FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying hfirst.certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)))) + (elapsed + 1) := + FiniteRun.tail run + (stackSoundValidTrace_initialization_actualBegin + bound machine x trace htrace time hfirst hnext) + +private theorem stackSoundValidTrace_initialization_space_padding_noHoles + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : CanonicalGuessingTracks bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) : + (∀ stack : machine.tm.K, + (decodedFullPackedPhaseStack machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack).length ≤ + rowWidth bound machine x) ∧ + PhaseRowStackRangeFaithful machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)) ∧ + (∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack)) := by + let first := decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) + let next := decodeCorrectedPhaseRow machine + (trace time.succ) + have hmasks : ∀ position : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x position (first position) := by + intro position + exact stackSoundValidTrace_masks_of_not_accepting + bound machine x trace htrace (Fin.castSucc time) position + (by rw [hfirst.mode position]; exact PhaseTag.noConfusion) + have hwindows := stackSoundValidTrace_allInitializationWindows + bound machine x trace htrace time hfirst.mode hnext + refine ⟨?_, ?_, ?_⟩ + · exact allInitializationWindows_fullPackedStack_length_le + bound machine x first next hfirst hmasks hwindows + · exact stackSoundValidTrace_initialization_rangeFaithful + bound machine x trace htrace time hfirst.mode hnext + · exact allInitializationWindows_fullPacked_noInteriorPaddingHoles + bound machine x first next hfirst hmasks hwindows + +private noncomputable def stackSoundValidTrace_initialization_reachable_space_padding + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : CanonicalGuessingTracks bound machine x + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) (.guessing hfirst.certificate) elapsed) : + { _nextRun : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying hfirst.certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)))) + (elapsed + 1) // + (∀ stack : machine.tm.K, + (decodedFullPackedPhaseStack machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack).length ≤ + rowWidth bound machine x) ∧ + PhaseRowStackRangeFaithful machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)) ∧ + (∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack)) } := by + exact ⟨stackSoundValidTrace_initialization_reachable + bound machine x trace htrace time hfirst hnext run, + stackSoundValidTrace_initialization_space_padding_noHoles + bound machine x trace htrace time hfirst hnext⟩ + +end CLReachableTableauCompiler + +namespace CLNaturalTimeCompiler + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLNondeterminism +open GapCVP.CLBoundedStates GapCVP.CLCellRowBounds GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLPhaseCompleteness GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseGlobalSimulation +open GapCVP.CLValidTraceSoundness GapCVP.CLWholeTraceSoundness GapCVP.CLStackVerifierSimulation +open GapCVP.CLAnchoredTraceSimulation GapCVP.CLCompactWindowSoundness +open GapCVP.CLNoHoleTimeInduction GapCVP.CLBoundedRowInduction GapCVP.CLFullStackStepSoundness +open GapCVP.CLFullTraceReachability GapCVP.CLGuessPayloadReachability +open GapCVP.CLReachableTableauCompiler + +private theorem evalsTo_prefix_steps_le_terminal + {α : Type} + (step : α → Option α) + (initial configuration terminal : α) + (partialRun : StateTransition.EvalsTo step initial (some configuration)) + (halting : StateTransition.EvalsTo step initial (some terminal)) + (hterminal : step terminal = none) : + partialRun.steps ≤ halting.steps := by + by_contra hnot + have hstrict : halting.steps < partialRun.steps := by + omega + let advance : Option α → Option α := flip bind step + let extra : ℕ := partialRun.steps - halting.steps + have hextra : 0 < extra := by + dsimp [extra] + omega + have hsplit : partialRun.steps = extra + halting.steps := by + dsimp [extra] + omega + have hhaltRun : + (advance^[halting.steps]) (some initial) = some terminal := by + simpa only [advance] using halting.evals_in_steps + have hprefixRun : + (advance^[partialRun.steps]) (some initial) = + some configuration := by + simpa only [advance] using partialRun.evals_in_steps + have hremaining : + (advance^[extra]) (some terminal) = some configuration := by + calc + (advance^[extra]) (some terminal) = + (advance^[extra]) + ((advance^[halting.steps]) (some initial)) := by + rw [hhaltRun] + _ = (advance^[extra + halting.steps]) (some initial) := + (Function.iterate_add_apply advance extra halting.steps + (some initial)).symm + _ = some configuration := by + rw [← hsplit] + exact hprefixRun + obtain ⟨count, hcount⟩ := Nat.exists_eq_succ_of_ne_zero + (Nat.ne_of_gt hextra) + have hnone : (advance^[extra]) (some terminal) = none := by + rw [hcount, Function.iterate_succ_apply] + change (advance^[count]) ((some terminal).bind step) = none + rw [Option.bind_some, hterminal] + exact Function.iterate_fixed (by rfl) count + rw [hnone] at hremaining + cases hremaining + +private theorem evalsTo_prefix_steps_lt_terminal_of_step + {α : Type} + (step : α → Option α) + (initial configuration successor terminal : α) + (partialRun : StateTransition.EvalsTo step initial (some configuration)) + (halting : StateTransition.EvalsTo step initial (some terminal)) + (hterminal : step terminal = none) + (hstep : step configuration = some successor) : + partialRun.steps < halting.steps := by + have hle := evalsTo_prefix_steps_le_terminal + step initial configuration terminal partialRun halting hterminal + by_contra hnot + have heq : partialRun.steps = halting.steps := by + omega + have hsame : terminal = configuration := + evalsTo_terminal_unique_of_steps_le + step initial terminal configuration + halting partialRun hterminal (by omega) + rw [← hsame, hterminal] at hstep + cases hstep + +private theorem verifierPrefix_steps_le_witnessTime + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hcertificate : certificate.length ≤ bound.eval x.length) + (configuration : machine.tm.Cfg) + (partialRun : StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (some configuration)) : + partialRun.steps ≤ + (witnessTimePolynomial bound machine).eval x.length := by + let halting := boundedVerifierRun + bound machine x certificate hcertificate + have hprefix := evalsTo_prefix_steps_le_terminal + machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + configuration + (Turing.haltList machine.tm + (verifierOutput machine (verifier (x, certificate)))) + partialRun halting.toEvalsTo + (haltList_step machine.tm + (verifierOutput machine (verifier (x, certificate)))) + exact hprefix.trans halting.steps_le_m + +private theorem verifierPrefix_successor_steps_le_witnessTime + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hcertificate : certificate.length ≤ bound.eval x.length) + (configuration successor : machine.tm.Cfg) + (partialRun : StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (some configuration)) + (hstep : machine.tm.step configuration = some successor) : + partialRun.steps + 1 ≤ + (witnessTimePolynomial bound machine).eval x.length := by + let halting := boundedVerifierRun + bound machine x certificate hcertificate + have hprefix := evalsTo_prefix_steps_lt_terminal_of_step + machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + configuration successor + (Turing.haltList machine.tm + (verifierOutput machine (verifier (x, certificate)))) + partialRun halting.toEvalsTo + (haltList_step machine.tm + (verifierOutput machine (verifier (x, certificate)))) hstep + have hbound := halting.steps_le_m + omega + +private noncomputable def ExactNaturalGuessInvariant + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (elapsed : ℕ) : GuessState machine.tm → Bool + | .guessing certificate => + @decide ( + certificate.length ≤ bound.eval x.length ∧ + elapsed = certificate.length + ) (Classical.propDecidable _) + | .verifying certificate configuration => + @decide ( + certificate.length ≤ bound.eval x.length ∧ + ∃ run : StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (some configuration), + elapsed = certificate.length + 1 + run.steps + ) (Classical.propDecidable _) +private theorem exactNaturalGuessInvariant_step + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + {elapsed : ℕ} + {first next : GuessState machine.tm} + (hfirst : ExactNaturalGuessInvariant + bound machine x elapsed first) + (hstep : GuessStep bound machine x first next) : + ExactNaturalGuessInvariant bound machine x (elapsed + 1) next := by + cases hstep with + | guess certificate bit hbound => + simp only [ExactNaturalGuessInvariant, decide_eq_true_eq] at hfirst ⊢ + rcases hfirst with ⟨_, helapsed⟩ + simp only [List.length_append, List.length_singleton] + constructor <;> omega + | begin certificate hbound => + simp only [ExactNaturalGuessInvariant, decide_eq_true_eq] at hfirst ⊢ + rcases hfirst with ⟨_, helapsed⟩ + refine ⟨hbound, StateTransition.EvalsTo.refl machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)), ?_⟩ + change elapsed + 1 = certificate.length + 1 + 0 + omega + | execute certificate configuration successor hstep => + simp only [ExactNaturalGuessInvariant, decide_eq_true_eq] at hfirst ⊢ + rcases hfirst with ⟨hcertificate, run, helapsed⟩ + let successorRun := StateTransition.EvalsTo.trans machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + configuration (some successor) run + (oneStepEvalsTo machine.tm configuration successor hstep) + refine ⟨hcertificate, successorRun, ?_⟩ + change elapsed + 1 = + certificate.length + 1 + (1 + run.steps) + omega + +private theorem exactNaturalGuessInvariant_run + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + {state : GuessState machine.tm} + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) state elapsed) : + ExactNaturalGuessInvariant bound machine x elapsed state := by + have hinitial : ExactNaturalGuessInvariant + bound machine x 0 (.guessing []) := by + simp only [ExactNaturalGuessInvariant, decide_eq_true_eq, + List.length_nil, Nat.zero_le, and_self] + induction run with + | refl => exact hinitial + | tail prior hstep ih => + exact exactNaturalGuessInvariant_step + bound machine x ih hstep + +private theorem finiteRun_verifying_elapsed_le_guessTime + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (configuration : machine.tm.Cfg) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate configuration) elapsed) : + elapsed ≤ (guessTimePolynomial bound machine).eval x.length := by + have hinvariant := exactNaturalGuessInvariant_run bound machine x run + simp only [ExactNaturalGuessInvariant, decide_eq_true_eq] at hinvariant + obtain ⟨hcertificate, machineRun, helapsed⟩ := hinvariant + have hmachine := verifierPrefix_steps_le_witnessTime + bound machine x certificate hcertificate + configuration machineRun + simp only [guessTimePolynomial, Polynomial.eval_add, + Polynomial.eval_one] + omega + +private theorem finiteRun_verifierSuccessor_elapsed_le_guessTime + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (configuration successor : machine.tm.Cfg) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate configuration) elapsed) + (hstep : machine.tm.step configuration = some successor) : + elapsed + 1 ≤ + (guessTimePolynomial bound machine).eval x.length := by + have hinvariant := exactNaturalGuessInvariant_run bound machine x run + simp only [ExactNaturalGuessInvariant, decide_eq_true_eq] at hinvariant + obtain ⟨hcertificate, machineRun, helapsed⟩ := hinvariant + have hmachine := verifierPrefix_successor_steps_le_witnessTime + bound machine x certificate hcertificate + configuration successor machineRun hstep + simp only [guessTimePolynomial, Polynomial.eval_add, + Polynomial.eval_one] + omega + +private theorem stackSoundValidTrace_actualFullPackedStep_of_run + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .verifying) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) + (hholes : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) stack)) + (certificate : List Bool) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))))) elapsed) : + machine.tm.step + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) = + some + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ))) := by + exact stackSoundValidTrace_actualFullPackedStep_of_actualTimedRun + bound machine x trace htrace time hfirst hnext hholes + certificate run + (finiteRun_verifying_elapsed_le_guessTime + bound machine x certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) run) + +private noncomputable def stackSoundValidTrace_verifierSuccessor_reachable_of_run + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .verifying) + (hnext : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying) + (hholes : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) stack)) + (certificate : List Bool) + {elapsed : ℕ} + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))))) elapsed) : + { _nextRun : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)))) + (elapsed + 1) // + (∀ stack : machine.tm.K, + (decodedFullPackedPhaseStack machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack).length ≤ + rowWidth bound machine x) ∧ + PhaseRowStackRangeFaithful machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ)) ∧ + (∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace time.succ)) stack)) } := by + have hstep := stackSoundValidTrace_actualFullPackedStep_of_run + bound machine x trace htrace time hfirst hnext hholes + certificate run + have hruntime := finiteRun_verifierSuccessor_elapsed_le_guessTime + bound machine x certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine (trace time.succ))) + run hstep + exact stackSoundValidTrace_verifierSuccessor_reachable_space_padding + bound machine x trace htrace time hfirst hnext hholes + certificate run hruntime + +private theorem stackSoundValidTrace_nonacceptingTime_lt_width + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Time (rowWidth bound machine x)) + (hnonaccept : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time) position).mode ≠ .accepting) : + time.val < rowWidth bound machine x := by + obtain ⟨position, haccept⟩ := + anchoredValidTrace_has_acceptingCell + bound machine x trace + (stackSoundValidTrace_to_anchored + bound machine x trace htrace) + by_contra hnot + have hlastVal : time.val = rowWidth bound machine x := by + have hlt := time.isLt + omega + have hlast : time = Fin.last (rowWidth bound machine x) := by + apply Fin.ext + exact hlastVal + apply hnonaccept position + rw [hlast, haccept] + rfl + +private theorem stackSoundValidTrace_nonaccepting_mode_constant + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Time (rowWidth bound machine x)) + (hnonaccept : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time) position).mode ≠ .accepting) : + ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time) position).mode = + (decodeCorrectedPhaseRow machine + (trace time) 0).mode := by + have hlt := stackSoundValidTrace_nonacceptingTime_lt_width + bound machine x trace htrace time hnonaccept + let outgoing : Fin (rowWidth bound machine x) := + ⟨time.val, hlt⟩ + have hrow : trace (Fin.castSucc outgoing) = trace time := by + apply congrArg trace + apply Fin.ext + rfl + intro position + have hconstant := anchoredValidTrace_mode_constant + bound machine x trace + (stackSoundValidTrace_to_anchored + bound machine x trace htrace) + outgoing position + calc + (decodeCorrectedPhaseRow machine + (trace time) position).mode = + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc outgoing)) position).mode := + (congrArg (fun row => + (decodeCorrectedPhaseRow machine row position).mode) + hrow).symm + _ = (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc outgoing)) 0).mode := hconstant + _ = (decodeCorrectedPhaseRow machine + (trace time) 0).mode := + congrArg (fun row => + (decodeCorrectedPhaseRow machine row 0).mode) hrow + +private inductive CorrectedReachablePhase + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (row : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (elapsed : ℕ) : Type where + | guessing + (tracks : CanonicalGuessingTracks bound machine x row) + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) (.guessing tracks.certificate) elapsed) : + CorrectedReachablePhase bound machine x row elapsed + | verifying + (certificate : List Bool) + (mode : ∀ position : Position (rowWidth bound machine x), + (row position).mode = .verifying) + (holes : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) row stack)) + (run : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row)) elapsed) : + CorrectedReachablePhase bound machine x row elapsed + +private theorem stackSoundValidTrace_predecessor_nonaccepting + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hnonaccept : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode ≠ .accepting) : + ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode ≠ .accepting := by + intro position + apply anchoredPhase_old_not_accepting_of_next_not_accepting + machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) position) + · exact stackSoundAnchoredPhaseAllowed_implies_anchored + machine _ + (stackSoundValidTrace_window + bound machine x trace htrace (windowAt time position)) + · exact hnonaccept position + +private theorem stackSoundValidTrace_verifyingSuccessor_modes + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) + (hfirst : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position).mode = .verifying) + (hnonaccept : ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode ≠ .accepting) : + ∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying := by + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time))) + (decodeCorrectedPhaseRow machine (trace time.succ)) 0 + have hallowed := stackSoundValidTrace_window + bound machine x trace htrace (windowAt time 0) + change StackSoundAnchoredPhaseAllowed machine window at hallowed + have hallowed' := hallowed + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + at hallowed' + have hbranches : + StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window := by + have hbranch := hallowed'.2 + change + match (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) 0).mode with + | .guessing => + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window + | .verifying => + StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window + | .accepting => + window.2.2.2 = acceptingPhaseCell machine.tm + at hbranch + simpa only [hfirst 0] using hbranch + have hzero : + (decodeCorrectedPhaseRow machine + (trace time.succ) 0).mode = .verifying := by + rcases hbranches with hverify | haccept + · have hverify' := hverify + simp only [StackSoundAnchoredVerificationAllowed, + AnchoredVerificationAllowed, CompleteVerificationAllowed, + decide_eq_true_eq] at hverify' + exact hverify'.1.1.1 + · have hbad : + (decodeCorrectedPhaseRow machine + (trace time.succ) 0).mode = .accepting := by + change window.2.2.2.mode = .accepting + have haccept' := haccept + simp only [AnchoredAcceptanceAllowed, CompleteAcceptanceAllowed, + decide_eq_true_eq] at haccept' + have hacceptOuter := ofClassicalDecide haccept' + have hacceptCore := ofClassicalDecide hacceptOuter.1 + rw [hacceptCore.1] + rfl + exact (hnonaccept 0 hbad).elim + intro position + exact (stackSoundValidTrace_nonaccepting_mode_constant + bound machine x trace htrace time.succ hnonaccept position).trans hzero + +private noncomputable def stackSoundValidTrace_nonaccepting_reachablePhase + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) + (time : Time (rowWidth bound machine x)) : + (∀ position : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time) position).mode ≠ .accepting) → + CorrectedReachablePhase bound machine x + (decodeCorrectedPhaseRow machine (trace time)) time.val := by + induction time using Fin.induction with + | zero => + intro _ + have hrow : + decodeCorrectedPhaseRow machine (trace 0) = + initialPhaseCell bound machine x := by + funext position + exact anchoredTrace_initial bound machine x trace + (stackSoundValidTrace_to_anchored + bound machine x trace htrace) position + rw [hrow] + exact CorrectedReachablePhase.guessing + (initialCanonicalGuessingTracks bound machine x) + (FiniteRun.refl (GuessState.guessing [])) + | succ time ih => + intro hnonaccept + have hsourceNot := stackSoundValidTrace_predecessor_nonaccepting + bound machine x trace htrace time hnonaccept + have hsource := ih hsourceNot + cases hsource with + | guessing tracks run => + have hconstant := stackSoundValidTrace_nonaccepting_mode_constant + bound machine x trace htrace time.succ hnonaccept + cases hmode : + (decodeCorrectedPhaseRow machine + (trace time.succ) 0).mode with + | guessing => + have hnext : ∀ position : Position + (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .guessing := by + intro position + exact (hconstant position).trans hmode + let nextTracks := + stackSoundValidTrace_guessingSuccessorCanonical + bound machine x trace htrace time tracks hnext + refine CorrectedReachablePhase.guessing nextTracks ?_ + exact FiniteRun.tail run + (stackSoundValidTrace_guessingSuccessor_actualStep + bound machine x trace htrace time tracks hnext) + | verifying => + have hnext : ∀ position : Position + (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .verifying := by + intro position + exact (hconstant position).trans hmode + obtain ⟨nextRun, _, _, holes⟩ := + stackSoundValidTrace_initialization_reachable_space_padding + bound machine x trace htrace time tracks hnext run + exact CorrectedReachablePhase.verifying + tracks.certificate hnext holes nextRun + | accepting => + exact (hnonaccept 0 hmode).elim + | verifying certificate modes holes run => + have hnext := stackSoundValidTrace_verifyingSuccessor_modes + bound machine x trace htrace time modes hnonaccept + obtain ⟨nextRun, _, _, nextHoles⟩ := + stackSoundValidTrace_verifierSuccessor_reachable_of_run + bound machine x trace htrace time modes hnext holes + certificate run + exact CorrectedReachablePhase.verifying + certificate hnext nextHoles nextRun + +theorem stackSoundValidTrace_firstAcceptance_actualReachable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace) : + ∃ (time : Fin (rowWidth bound machine x)) + (position : Position (rowWidth bound machine x)) + (certificate : List Bool), + let first := decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) + let next := decodeCorrectedPhaseRow machine + (trace time.succ) + AnchoredAcceptanceAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position) ∧ + (∀ other : Position (rowWidth bound machine x), + (first other).mode = .verifying) ∧ + (∀ other : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x other (first other)) ∧ + (∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) first stack)) ∧ + certificate.length ≤ bound.eval x.length ∧ + Nonempty (FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) first)) time.val) ∧ + (∃ verifierRun : StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (some (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) first)), + time.val = certificate.length + 1 + verifierRun.steps) ∧ + time.val ≤ + (guessTimePolynomial bound machine).eval x.length ∧ + (∀ (earlier : Time (rowWidth bound machine x)), + earlier.val ≤ time.val → + ∀ other : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace earlier) other).mode ≠ .accepting) := by + obtain ⟨time, position, haccept, hmode, hmasks, hprefix⟩ := + stackSoundValidTrace_has_first_checked_acceptance + bound machine x trace htrace + have hnonaccept : + ∀ other : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) other).mode ≠ .accepting := + hprefix (Fin.castSucc time) (by simp only [Fin.val_castSucc, Std.le_refl]) + have hreachable := stackSoundValidTrace_nonaccepting_reachablePhase + bound machine x trace htrace (Fin.castSucc time) hnonaccept + cases hreachable with + | guessing tracks run => + have hguess := tracks.mode 0 + rw [hmode 0] at hguess + cases hguess + | verifying certificate modes holes run => + have hinvariant := exactNaturalGuessInvariant_run bound machine x run + simp only [ExactNaturalGuessInvariant, decide_eq_true_eq] at hinvariant + obtain ⟨hcertificate, verifierRun, helapsed⟩ := hinvariant + have hruntime := finiteRun_verifying_elapsed_le_guessTime + bound machine x certificate + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)))) run + refine ⟨time, position, certificate, ?_⟩ + dsimp + exact ⟨haccept, hmode, hmasks, holes, hcertificate, ⟨run⟩, + ⟨verifierRun, helapsed⟩, hruntime, hprefix⟩ + +end CLNaturalTimeCompiler + +namespace CLAcceptanceAnchor + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLBoundedStates +open GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLCellRowBounds GapCVP.CLLocalWindows +open GapCVP.CLExactStackRules GapCVP.CLCompleteLocalCompiler GapCVP.CLExactVerifierTransition +open GapCVP.CLLocalTableauCompiler GapCVP.CLTableauSimulationCert +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseTableauSimulation +open GapCVP.CLPhaseTraceInduction GapCVP.CLPhaseGlobalSimulation +open GapCVP.CLStackVerifierSimulation GapCVP.CLArbitraryRowOccupancy +open GapCVP.CLCompactWindowSoundness GapCVP.CLBoundedRowInduction +open GapCVP.CLFullStackStepSoundness GapCVP.CLFullTraceReachability GapCVP.CLNaturalTimeCompiler + +/-- GapCVP reduction support. -/ +noncomputable def ReplicatedMachineHeadCoherent + (tm : Turing.FinTM2) + (window : CompletePhaseWindow tm) : Bool := + @decide ( + completeMachineHead tm window.1 = + completeMachineHead tm window.2.1 ∧ + completeMachineHead tm window.2.2.1 = + completeMachineHead tm window.2.1 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def TrueOutputMachineHead + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (cell : CompletePhaseCell machine.tm) : Bool := + @decide ( + ∀ (offset : Fin (blockSize machine.tm)) + (stack : machine.tm.K), + cellAtomValue machine stack + ((completeMachineHead machine.tm cell offset).2.2.1 stack) = + if offset.val = 0 then + ((Turing.haltList machine.tm + (verifierOutput machine true)).stk stack)[0]? + else + none + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def AcceptanceAnchoredPhaseAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + StackSoundAnchoredPhaseAllowed machine window ∧ + ReplicatedMachineHeadCoherent machine.tm window ∧ + (window.2.2.2.mode = .accepting → + TrueOutputMachineHead machine window.2.1) + ) (Classical.propDecidable _) +private theorem verifierHalt_stack_length_le_one + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (value : Bool) + (stack : machine.tm.K) : + ((Turing.haltList machine.tm + (verifierOutput machine value)).stk stack).length ≤ 1 := by + classical + by_cases hstack : stack = machine.tm.k₁ + · subst stack + rw [GapCVP.TMComposition.haltList_stk_self] + exact (verifierOutput_length machine value).le + · simp only [haltList, eq_mpr_eq_cast, hstack, ↓reduceDIte, List.length_nil, zero_le] + +private theorem canonicalAnchoredVerifyingRow_blockAtom_decode + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (configuration : machine.tm.Cfg) + (hsupported : StackAtomSupported machine configuration) + (hspace : ∀ stack : machine.tm.K, + (configuration.stk stack).length ≤ rowWidth bound machine x) + (hint : FiniteVerifierHint machine.tm) + (annotation : Bool) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (stack : machine.tm.K) : + cellAtomValue machine stack + ((completeMachineBlock machine.tm + (canonicalAnchoredVerifyingRow bound machine x certificate + configuration hsupported hint annotation position) + offset).2.2.1 stack) = + (configuration.stk stack)[ + position.val * blockSize machine.tm + offset.val]? := by + change + cellAtomValue machine stack + ((stackAtomsOfBlock machine.tm + (packRow machine.tm (rowWidth bound machine x) + (canonicalVerifyingRow machine + (rowWidth bound machine x) + certificate configuration hsupported) position) + stack) offset) = _ + rw [stackAtomsOfBlock_pack_canonical machine + (rowWidth bound machine x) certificate configuration + hsupported hspace position stack] + simpa only [atomBlockAt] using + paddedAtom_decode machine stack + (canonicalStackAtoms_forall₂ machine stack (configuration.stk stack) + (stackAtomSupported_supportedValues machine configuration hsupported stack)) + (position.val * blockSize machine.tm + offset.val) + +private theorem canonicalAnchoredVerifyingWindow_replicatedMachineHeadCoherent + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (firstHint nextHint : FiniteVerifierHint machine.tm) + (firstAnnotation nextAnnotation : Bool) + (position : Position (rowWidth bound machine x)) : + ReplicatedMachineHeadCoherent machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + first hfirst firstHint firstAnnotation) + (canonicalAnchoredVerifyingRow bound machine x certificate + next hnext nextHint nextAnnotation) + position) := by + simp only [ReplicatedMachineHeadCoherent, completeMachineHead, anchoredVerifierWindowAt, + canonicalAnchoredVerifyingRow, canonicalScriptBlockRow, Fin.val_eq_zero_iff, and_self, + decide_true] + +private theorem canonicalTrueHalt_trueOutputMachineHead + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.haltList machine.tm + (verifierOutput machine true))) + (hint : FiniteVerifierHint machine.tm) + (annotation : Bool) + (hwidth : 1 ≤ rowWidth bound machine x) + (position : Position (rowWidth bound machine x)) : + TrueOutputMachineHead machine + (canonicalAnchoredVerifyingRow bound machine x certificate + (Turing.haltList machine.tm + (verifierOutput machine true)) + hsupported hint annotation position) := by + simp only [TrueOutputMachineHead, decide_eq_true_eq] + let configuration := Turing.haltList machine.tm + (verifierOutput machine true) + have hspace : ∀ stack : machine.tm.K, + (configuration.stk stack).length ≤ rowWidth bound machine x := by + intro stack + exact (verifierHalt_stack_length_le_one + machine true stack).trans hwidth + intro offset stack + have hatom := canonicalAnchoredVerifyingRow_blockAtom_decode + bound machine x certificate configuration hsupported hspace + hint annotation 0 offset stack + change + cellAtomValue machine stack + ((packRow machine.tm (rowWidth bound machine x) + (canonicalVerifyingRow machine + (rowWidth bound machine x) + certificate configuration hsupported) 0 + offset).2.2.1 stack) = _ + change + cellAtomValue machine stack + ((packRow machine.tm (rowWidth bound machine x) + (canonicalVerifyingRow machine + (rowWidth bound machine x) + certificate configuration hsupported) 0 + offset).2.2.1 stack) = _ + at hatom + rw [hatom] + by_cases hzero : offset.val = 0 + · simp only [Fin.coe_ofNat_eq_mod, Nat.zero_mod, zero_mul, hzero, add_zero, ↓reduceIte, + configuration] + · have hlength := verifierHalt_stack_length_le_one + machine true stack + have hindex : + (configuration.stk stack).length ≤ offset.val := by + change + ((Turing.haltList machine.tm + (verifierOutput machine true)).stk stack).length ≤ _ + omega + simp only [Fin.coe_ofNat_eq_mod, Nat.zero_mod, zero_mul, zero_add, not_lt, hindex, + getElem?_neg, hzero, + ↓reduceIte] + +private theorem trueOutputMachineHead_decodedAtomBlock + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (cell : CompletePhaseCell machine.tm) + (hfirst : completeIsFirstBlock machine.tm cell = true) + (hanchor : FirstBlockAnchored machine.tm cell) + (htrue : TrueOutputMachineHead machine cell) + (stack : machine.tm.K) : + decodedAtomBlock machine stack + (stackAtomsOfBlock machine.tm + (completeMachineBlock machine.tm cell) stack) = + (Turing.haltList machine.tm + (verifierOutput machine true)).stk stack := by + have htrue' := htrue + simp only [TrueOutputMachineHead, decide_eq_true_eq] at htrue' + have hanchor' := hanchor + simp only [FirstBlockAnchored, decide_eq_true_eq] at hanchor' + let output := (Turing.haltList machine.tm + (verifierOutput machine true)).stk stack + have hlength : output.length ≤ 1 := + verifierHalt_stack_length_le_one machine true stack + have hblock := (hanchor' hfirst).1 + have hpointwise : + (fun offset : Fin (blockSize machine.tm) => + cellAtomValue machine stack + ((completeMachineBlock machine.tm cell offset).2.2.1 stack)) = + (fun offset : Fin (blockSize machine.tm) => + output[offset.val]?) := by + funext offset + rw [hblock, htrue' offset stack] + by_cases hzero : offset.val = 0 + · simp only [hzero, ↓reduceIte, output] + · have hout : output.length ≤ offset.val := by + omega + simp only [hzero, ↓reduceIte, not_lt, hout, getElem?_neg] + change + (List.ofFn (fun offset : Fin (blockSize machine.tm) => + cellAtomValue machine stack + ((completeMachineBlock machine.tm cell offset).2.2.1 stack))).filterMap + id = output + rw [hpointwise, filterMap_ofFn_getElem] + exact List.take_of_length_le (by + have hpositive := blockSize_pos machine.tm + omega) + +private theorem finiteTM2_step_none_of_none_label + (tm : Turing.FinTM2) + (configuration : tm.Cfg) + (hlabel : configuration.l = none) : + tm.step configuration = none := by + rcases configuration with ⟨label, machineState, machineStacks⟩ + cases label with + | none => rfl + | some label => simp only [reduceCtorEq] at hlabel + +private theorem reachableHaltedPackedConfiguration_eq_actualVerifierHalt + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (row : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hcertificate : certificate.length ≤ bound.eval x.length) + (verifierRun : StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (some (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row))) + (hcontrol : machineControlOfBlock machine.tm + (completeMachineHead machine.tm (row 0)) = + some + ((Turing.haltList machine.tm + (verifierOutput machine true)).l, + (Turing.haltList machine.tm + (verifierOutput machine true)).var)) : + decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row = + Turing.haltList machine.tm + (verifierOutput machine (verifier (x, certificate))) := by + let actualHalt := boundedVerifierRun + bound machine x certificate hcertificate + have hlabel : + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row).l = none := by + simp only [decodedFullPackedPhaseConfiguration, hcontrol, haltList, eq_mpr_eq_cast] + have hterminal := finiteTM2_step_none_of_none_label machine.tm + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row) hlabel + have hsteps := evalsTo_prefix_steps_le_terminal + machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row) + (Turing.haltList machine.tm + (verifierOutput machine (verifier (x, certificate)))) + verifierRun actualHalt.toEvalsTo + (haltList_step machine.tm + (verifierOutput machine (verifier (x, certificate)))) + exact evalsTo_terminal_unique_of_steps_le machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row) + (Turing.haltList machine.tm + (verifierOutput machine (verifier (x, certificate)))) + verifierRun actualHalt.toEvalsTo hterminal hsteps + +theorem trueOutputMachineHead_actualVerifierHalt + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (row : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (hcertificate : certificate.length ≤ bound.eval x.length) + (verifierRun : StateTransition.EvalsTo machine.tm.step + (Turing.initList machine.tm + (verifierInput machine x certificate)) + (some (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row))) + (hrow : PhaseRowAtomsWellTyped machine + (rowWidth bound machine x) row) + (hholes : ∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) row stack)) + (hfirst : completeIsFirstBlock machine.tm (row 0) = true) + (hanchor : FirstBlockAnchored machine.tm (row 0)) + (htrue : TrueOutputMachineHead machine (row 0)) + (hcontrol : machineControlOfBlock machine.tm + (completeMachineHead machine.tm (row 0)) = + some + ((Turing.haltList machine.tm + (verifierOutput machine true)).l, + (Turing.haltList machine.tm + (verifierOutput machine true)).var)) : + verifier (x, certificate) = true ∧ + decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row = + Turing.haltList machine.tm + (verifierOutput machine true) := by + have hconfiguration := + reachableHaltedPackedConfiguration_eq_actualVerifierHalt + bound machine x certificate row hcertificate verifierRun hcontrol + have hheadBlock := trueOutputMachineHead_decodedAtomBlock + machine (row 0) hfirst hanchor htrue machine.tm.k₁ + have hfullBlock := fullPackedPhaseStack_firstBlock_decode + machine (rowWidth bound machine x) row hrow machine.tm.k₁ + (hholes machine.tm.k₁) + have hactualStack : + decodedFullPackedPhaseStack machine + (rowWidth bound machine x) row machine.tm.k₁ = + verifierOutput machine (verifier (x, certificate)) := by + calc + decodedFullPackedPhaseStack machine + (rowWidth bound machine x) row machine.tm.k₁ = + (decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) row).stk machine.tm.k₁ := + (decodedFullPackedPhaseConfiguration_stack machine + (rowWidth bound machine x) row + ((Turing.haltList machine.tm + (verifierOutput machine true)).l, + (Turing.haltList machine.tm + (verifierOutput machine true)).var) + hcontrol machine.tm.k₁).symm + _ = (Turing.haltList machine.tm + (verifierOutput machine + (verifier (x, certificate)))).stk machine.tm.k₁ := + congrArg (fun configuration : machine.tm.Cfg => + configuration.stk machine.tm.k₁) hconfiguration + _ = verifierOutput machine (verifier (x, certificate)) := + GapCVP.TMComposition.haltList_stk_self + machine.tm (verifierOutput machine + (verifier (x, certificate))) + have htake : + (verifierOutput machine (verifier (x, certificate))).take + (blockSize machine.tm) = + verifierOutput machine true := by + calc + (verifierOutput machine (verifier (x, certificate))).take + (blockSize machine.tm) = + (decodedFullPackedPhaseStack machine + (rowWidth bound machine x) row machine.tm.k₁).take + (blockSize machine.tm) := by + rw [hactualStack] + _ = decodedAtomBlock machine machine.tm.k₁ + (stackAtomsOfBlock machine.tm + (completeMachineBlock machine.tm (row 0)) + machine.tm.k₁) := hfullBlock.symm + _ = (Turing.haltList machine.tm + (verifierOutput machine true)).stk machine.tm.k₁ := + hheadBlock + _ = verifierOutput machine true := + GapCVP.TMComposition.haltList_stk_self + machine.tm (verifierOutput machine true) + have hlength : + (verifierOutput machine (verifier (x, certificate))).length ≤ + blockSize machine.tm := by + rw [verifierOutput_length] + exact blockSize_pos machine.tm + have houtput : + verifierOutput machine (verifier (x, certificate)) = + verifierOutput machine true := by + calc + verifierOutput machine (verifier (x, certificate)) = + (verifierOutput machine (verifier (x, certificate))).take + (blockSize machine.tm) := + (List.take_of_length_le hlength).symm + _ = verifierOutput machine true := htake + have hverifier : verifier (x, certificate) = true := + verifierOutput_injective machine houtput + exact ⟨hverifier, by simpa only [hverifier] using hconfiguration⟩ + +end CLAcceptanceAnchor + +namespace CLVerifiedLocalTableauCompiler + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLNondeterminism +open GapCVP.CLBoundedStates GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLCellRowBounds +open GapCVP.CLLocalWindows GapCVP.CLExactVerifierTransition GapCVP.CLTableauSimulationCert +open GapCVP.CLFullTableauEmitter GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseTraceInduction GapCVP.CLPhaseGlobalSimulation +open GapCVP.CLPhaseVerifierSimulation GapCVP.CLArbitraryVerifierSoundness +open GapCVP.CLStackVerifierSimulation GapCVP.CLAnchoredTraceSimulation +open GapCVP.CLGuessPayloadReachability GapCVP.CLAcceptanceAnchor + +/-- GapCVP reduction support. -/ +def canonicalAnchoredGuessingRow + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) : + Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm := + fun position => { + mode := .guessing + script := canonicalGuessingScriptRow machine + (rowWidth bound machine x) certificate + (defaultVerifierHint machine.tm) position + payload := pairedInputBlockAt machine.tm + (rowWidth bound machine x) x certificate position + payloadHead := pairedInputBlockAt machine.tm + (rowWidth bound machine x) x certificate 0 + range := phaseRangeBlockAt machine.tm + (rowWidth bound machine x) position + rangeHead := phaseRangeBlockAt machine.tm + (rowWidth bound machine x) 0 + budget := phaseBudgetBlockAt bound machine x position + guessBit := annotation + } + +@[simp] theorem canonicalAnchoredGuessingRow_initial + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + canonicalAnchoredGuessingRow bound machine x [] false = + initialPhaseCell bound machine x := by + rfl + +private theorem canonicalAnchoredGuessingRow_boundary + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (position : Position (rowWidth bound machine x)) : + completeIsFirstBlock machine.tm + (canonicalAnchoredGuessingRow + bound machine x certificate annotation position) = + decide (position.val = 0) := by + rfl + +private theorem canonicalAnchoredGuessingRow_firstBlockAnchored + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (position : Position (rowWidth bound machine x)) : + FirstBlockAnchored machine.tm + (canonicalAnchoredGuessingRow + bound machine x certificate annotation position) := by + simp only [FirstBlockAnchored, decide_eq_true_eq] + intro hfirst + have hposition : position.val = 0 := by + simpa only [Fin.val_eq_zero_iff, completeIsFirstBlock, canonicalAnchoredGuessingRow, + canonicalGuessingScriptRow, decide_eq_true_eq] using hfirst + have hzero : position = 0 := Fin.ext hposition + subst position + exact ⟨rfl, rfl, rfl⟩ + +private theorem canonicalAnchoredGuessingWindow_replicatedMachineHeadCoherent + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (position : Position (rowWidth bound machine x)) : + ReplicatedMachineHeadCoherent machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next position) := by + simp only [ReplicatedMachineHeadCoherent, completeMachineHead, anchoredVerifierWindowAt, + canonicalAnchoredGuessingRow, canonicalGuessingScriptRow, Fin.val_eq_zero_iff, and_self, + decide_true] + +@[simp] private theorem canonicalAnchoredGuessingRow_unpackWitness + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (index : Position (rowWidth bound machine x)) : + unpackPhaseWitness machine.tm (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) index = + certificatePhase certificate index.val := by + change + (packRow machine.tm (rowWidth bound machine x) + (guessingRow machine.tm + (rowWidth bound machine x) certificate) + (coordinateBlock machine.tm + (rowWidth bound machine x) index) + (coordinateOffset machine.tm + (rowWidth bound machine x) index)).1 = _ + rw [packRow_cell] + rfl + +@[simp] private theorem canonicalAnchoredGuessingRow_unpackPayload + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (index : Position (rowWidth bound machine x)) : + unpackPhasePayload machine.tm (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) index = + pairedInputTagAt x certificate index.val := by + have hcoordinate : + index.val / blockSize machine.tm * blockSize machine.tm + + index.val % blockSize machine.tm = index.val := + Nat.div_add_mod' index.val (blockSize machine.tm) + simp only [unpackPhasePayload, canonicalAnchoredGuessingRow, coordinateBlock, coordinateOffset, + pairedInputBlockAt, hcoordinate, index.isLt, ↓reduceIte] + +private theorem canonicalGuessingWitnessWindow_left + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (index : Position (rowWidth bound machine x)) : + (completeWitnessWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next (coordinateBlock machine.tm + (rowWidth bound machine x) index)) + (coordinateOffset machine.tm + (rowWidth bound machine x) index)).1 = + certificatePhase certificate + (leftBlock (rowWidth bound machine x) index).val := by + have hboundary := canonicalAnchoredGuessingRow_boundary + bound machine x certificate annotation + (coordinateBlock machine.tm + (rowWidth bound machine x) index) + rw [completeWitnessWindow_left_unpacked machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next index hboundary] + exact canonicalAnchoredGuessingRow_unpackWitness + bound machine x certificate annotation + (leftBlock (rowWidth bound machine x) index) + +private theorem canonicalGuessingPayloadWindow_left + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (index : Position (rowWidth bound machine x)) : + (completePayloadWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next (coordinateBlock machine.tm + (rowWidth bound machine x) index)) + (coordinateOffset machine.tm + (rowWidth bound machine x) index)).1 = + pairedInputTagAt x certificate + (leftBlock (rowWidth bound machine x) index).val := by + have hboundary := canonicalAnchoredGuessingRow_boundary + bound machine x certificate annotation + (coordinateBlock machine.tm + (rowWidth bound machine x) index) + rw [completePayloadWindow_left_unpacked machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next index hboundary] + exact canonicalAnchoredGuessingRow_unpackPayload + bound machine x certificate annotation + (leftBlock (rowWidth bound machine x) index) + +private theorem coordinateBlock_of_packed + (tm : Turing.FinTM2) + (width : ℕ) + (position : Position width) + (offset : Fin (blockSize tm)) + (hinrange : position.val * blockSize tm + offset.val < width + 1) : + coordinateBlock tm width + (⟨position.val * blockSize tm + offset.val, hinrange⟩ : + Position width) = position := by + apply Fin.ext + change + (position.val * blockSize tm + offset.val) / + blockSize tm = position.val + have hdivision := Nat.mul_add_div + (blockSize_pos tm) position.val offset.val + simpa only [Nat.mul_comm, Nat.div_eq_of_lt offset.isLt, add_zero] using hdivision + +private theorem coordinateOffset_of_packed + (tm : Turing.FinTM2) + (width : ℕ) + (position : Position width) + (offset : Fin (blockSize tm)) + (hinrange : position.val * blockSize tm + offset.val < width + 1) : + coordinateOffset tm width + (⟨position.val * blockSize tm + offset.val, hinrange⟩ : + Position width) = offset := by + apply Fin.ext + exact Nat.mul_add_mod_of_lt offset.isLt + +private theorem nondeterministicRowWidth_pos + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + 1 ≤ rowWidth bound machine x := by + simp only [rowWidth, nondeterministicTableauDimensionPolynomial, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_X, + Polynomial.eval_C, Polynomial.eval_one] + omega + +private theorem actualStep_iff_acceptanceAnchoredCanonicalVerifierWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hfirstSpace : ∀ stack : machine.tm.K, + (first.stk stack).length ≤ rowWidth bound machine x) + (hnextSpace : ∀ stack : machine.tm.K, + (next.stk stack).length ≤ rowWidth bound machine x) : + machine.tm.step first = some next ↔ + ∃ (firstHint nextHint : FiniteVerifierHint machine.tm), + ∀ position : Position (rowWidth bound machine x), + AcceptanceAnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow + bound machine x certificate + first hfirst firstHint false) + (canonicalAnchoredVerifyingRow + bound machine x certificate + next hnext nextHint false) position) := by + constructor + · intro hstep + obtain ⟨firstHint, nextHint, hwindows⟩ := + (actualStep_iff_stackSoundCanonicalVerifierWindows + bound machine x certificate first next hfirst hnext + hfirstSpace hnextSpace).mp hstep + refine ⟨firstHint, nextHint, ?_⟩ + intro position + simp only [AcceptanceAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hwindows position, + canonicalAnchoredVerifyingWindow_replicatedMachineHeadCoherent + bound machine x certificate first next hfirst hnext + firstHint nextHint false false position, ?_⟩ + intro himpossible + change PhaseTag.verifying = PhaseTag.accepting at himpossible + cases himpossible + · rintro ⟨firstHint, nextHint, hwindows⟩ + apply (actualStep_iff_stackSoundCanonicalVerifierWindows + bound machine x certificate first next hfirst hnext + hfirstSpace hnextSpace).mpr + refine ⟨firstHint, nextHint, ?_⟩ + intro position + have hwindow := hwindows position + simp only [AcceptanceAnchoredPhaseAllowed, decide_eq_true_eq] at hwindow + exact hwindow.1 + +/-- GapCVP reduction support. -/ +noncomputable def AllCanonicalAcceptanceAnchoredVerifierTraceWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + {steps : ℕ} + (configuration : Fin (steps + 1) → machine.tm.Cfg) + (hsupported : ∀ time : Fin (steps + 1), + StackAtomSupported machine (configuration time)) + (hint : Fin (steps + 1) → FiniteVerifierHint machine.tm) : Bool := + @decide ( + ∀ (time : Fin steps) + (position : Position (rowWidth bound machine x)), + AcceptanceAnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + (configuration (Fin.castSucc time)) + (hsupported (Fin.castSucc time)) + (hint (Fin.castSucc time)) false) + (canonicalAnchoredVerifyingRow bound machine x certificate + (configuration time.succ) + (hsupported time.succ) + (hint time.succ) false) + position) + ) (Classical.propDecidable _) +theorem canonicalAcceptanceAnchoredVerifierTraceWindows_iff_actualRun + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + {steps : ℕ} + (configuration : Fin (steps + 1) → machine.tm.Cfg) + (hsupported : ∀ time : Fin (steps + 1), + StackAtomSupported machine (configuration time)) + (hspace : ∀ (time : Fin (steps + 1)) (stack : machine.tm.K), + ((configuration time).stk stack).length ≤ + rowWidth bound machine x) : + (∃ hint : Fin (steps + 1) → FiniteVerifierHint machine.tm, + AllCanonicalAcceptanceAnchoredVerifierTraceWindows + bound machine x certificate + configuration hsupported hint) ↔ + ∀ time : Fin steps, + machine.tm.step (configuration (Fin.castSucc time)) = + some (configuration time.succ) := by + constructor + · rintro ⟨hint, hwindows⟩ time + have hwindows' := hwindows + simp only [AllCanonicalAcceptanceAnchoredVerifierTraceWindows, + decide_eq_true_eq] at hwindows' + apply (actualStep_iff_acceptanceAnchoredCanonicalVerifierWindows + bound machine x certificate + (configuration (Fin.castSucc time)) + (configuration time.succ) + (hsupported (Fin.castSucc time)) + (hsupported time.succ) + (hspace (Fin.castSucc time)) + (hspace time.succ)).mpr + exact ⟨hint (Fin.castSucc time), + hint time.succ, hwindows' time⟩ + · intro hrun + obtain ⟨hint, hanchored⟩ := + (canonicalAnchoredVerifierTraceWindows_iff_actualRun + bound machine x certificate + configuration hsupported hspace).mpr hrun + have hanchored' := hanchored + simp only [AllCanonicalAnchoredVerifierTraceWindows, + decide_eq_true_eq] at hanchored' + refine ⟨hint, ?_⟩ + simp only [AllCanonicalAcceptanceAnchoredVerifierTraceWindows, + decide_eq_true_eq] + intro time position + let first := configuration (Fin.castSucc time) + let next := configuration time.succ + let firstSupport := hsupported (Fin.castSucc time) + let nextSupport := hsupported time.succ + let firstHint := hint (Fin.castSucc time) + let nextHint := hint time.succ + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow + bound machine x certificate + first firstSupport firstHint false) + (canonicalAnchoredVerifyingRow + bound machine x certificate + next nextSupport nextHint false) + position + have hscriptWindows : + ∀ other : Position (rowWidth bound machine x), + scriptBlockAllowed machine + (scriptBlockWindowAt machine.tm + (rowWidth bound machine x) + (canonicalScriptBlockRow machine + (rowWidth bound machine x) + certificate first firstSupport firstHint) + (canonicalScriptBlockRow machine + (rowWidth bound machine x) + certificate next nextSupport nextHint) + other) = true := by + intro other + exact (canonicalAnchoredVerifierWindow_allowed_iff + bound machine x certificate first next + firstSupport nextSupport firstHint nextHint + false other).mp (hanchored' time other) + obtain ⟨hscript, hstackWindows⟩ := + (canonicalScriptBlockWindows_iff + machine (rowWidth bound machine x) + certificate first next firstSupport nextSupport + (hspace (Fin.castSucc time)) + (hspace time.succ) + firstHint nextHint).mp hscriptWindows + have hoccupied := canonicalVerifierScriptHints_occupied + machine (rowWidth bound machine x) + first next firstSupport nextSupport + firstHint hscript hstackWindows + have hold : AnchoredPhaseAllowed machine window := + hanchored' time position + have hold' := hold + simp only [AnchoredPhaseAllowed, decide_eq_true_eq] at hold' + have hverify := anchoredPhase_verification_of_verifying_modes + machine window hold rfl rfl + have hstack : StackSoundAnchoredPhaseAllowed machine window := by + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hold'.1, ?_⟩ + change + StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window + apply Or.inl + simp only [StackSoundAnchoredVerificationAllowed, + decide_eq_true_eq] + exact ⟨hverify, hoccupied⟩ + simp only [AcceptanceAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hstack, + canonicalAnchoredVerifyingWindow_replicatedMachineHeadCoherent + bound machine x certificate first next + firstSupport nextSupport firstHint nextHint + false false position, ?_⟩ + intro himpossible + change PhaseTag.verifying = PhaseTag.accepting at himpossible + cases himpossible + +private theorem canonicalTrueHalt_acceptingPhaseBlock + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.haltList machine.tm + (verifierOutput machine true))) + (hint : FiniteVerifierHint machine.tm) + (annotation : Bool) + (position : Position (rowWidth bound machine x)) : + AcceptingPhaseBlock machine + (canonicalAnchoredVerifyingRow bound machine x certificate + (Turing.haltList machine.tm + (verifierOutput machine true)) + hsupported hint annotation position) := by + simp only [AcceptingPhaseBlock, decide_eq_true_eq] + let configuration := Turing.haltList machine.tm + (verifierOutput machine true) + have hwidth := nondeterministicRowWidth_pos bound machine x + have hspace : ∀ stack : machine.tm.K, + (configuration.stk stack).length ≤ rowWidth bound machine x := by + intro stack + exact (verifierHalt_stack_length_le_one + machine true stack).trans hwidth + constructor + · change + machineControlOfBlock machine.tm + (packRow machine.tm (rowWidth bound machine x) + (canonicalVerifyingRow machine + (rowWidth bound machine x) + certificate configuration hsupported) 0) = _ + exact machineControlOfBlock_pack_canonical machine + (rowWidth bound machine x) + certificate configuration hsupported + · intro offset stack + rw [canonicalAnchoredVerifyingRow_blockAtom_decode + bound machine x certificate configuration hsupported hspace + hint annotation position offset stack] + change + (configuration.stk stack)[ + position.val * blockSize machine.tm + offset.val]? = + if decide (position.val = 0) = true ∧ + offset.val = 0 then + ((Turing.haltList machine.tm + (verifierOutput machine true)).stk stack)[0]? + else none + by_cases hposition : position.val = 0 + · have hzero : position = 0 := Fin.ext hposition + subst position + by_cases hoffset : offset.val = 0 + · simp only [Fin.coe_ofNat_eq_mod, Nat.zero_mod, zero_mul, hoffset, add_zero, decide_true, + and_self, ↓reduceIte, + configuration] + · have hlength := verifierHalt_stack_length_le_one + machine true stack + have hout : + (configuration.stk stack).length ≤ offset.val := by + change + ((Turing.haltList machine.tm + (verifierOutput machine true)).stk stack).length ≤ _ + omega + simp only [Fin.coe_ofNat_eq_mod, Nat.zero_mod, zero_mul, zero_add, not_lt, hout, + getElem?_neg, decide_true, + hoffset, and_false, ↓reduceIte] + · have hproduct : + 0 < position.val * blockSize machine.tm := + Nat.mul_pos (Nat.pos_of_ne_zero hposition) + (blockSize_pos machine.tm) + have hlength := verifierHalt_stack_length_le_one + machine true stack + have hout : + (configuration.stk stack).length ≤ + position.val * blockSize machine.tm + offset.val := by + change + ((Turing.haltList machine.tm + (verifierOutput machine true)).stk stack).length ≤ _ + omega + simp only [not_lt, hout, getElem?_neg, hposition, decide_false, Bool.false_eq_true, + false_and, ↓reduceIte] + +theorem canonicalTrueHalt_acceptanceAnchoredWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.haltList machine.tm + (verifierOutput machine true))) + (hint : FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + AcceptanceAnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + (Turing.haltList machine.tm + (verifierOutput machine true)) + hsupported hint false) + (fun _ => acceptingPhaseCell machine.tm) + position) := by + let first := canonicalAnchoredVerifyingRow + bound machine x certificate + (Turing.haltList machine.tm + (verifierOutput machine true)) + hsupported hint false + let next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm := + fun _ => acceptingPhaseCell machine.tm + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position + have hcoherent : CompletePhaseCoherent machine.tm window := by + simp only [CompletePhaseCoherent, anchoredVerifierWindowAt, canonicalAnchoredVerifyingRow, + and_self, + decide_true, window, first] + have hhead : ReplicatedMachineHeadCoherent machine.tm window := by + simp only [ReplicatedMachineHeadCoherent, completeMachineHead, anchoredVerifierWindowAt, + canonicalAnchoredVerifyingRow, canonicalScriptBlockRow, Fin.val_eq_zero_iff, and_self, + decide_true, window, first] + have haccept : AnchoredAcceptanceAllowed machine window := by + apply @decide_eq_true _ (Classical.propDecidable _) + refine ⟨?_, canonicalAnchoredVerifyingRow_firstBlockAnchored + bound machine x certificate + (Turing.haltList machine.tm + (verifierOutput machine true)) + hsupported hint false position⟩ + apply @decide_eq_true _ (Classical.propDecidable _) + exact ⟨rfl, canonicalTrueHalt_acceptingPhaseBlock + bound machine x certificate hsupported hint false position⟩ + have hstack : StackSoundAnchoredPhaseAllowed machine window := by + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hcoherent, ?_⟩ + change + StackSoundAnchoredVerificationAllowed machine window ∨ + AnchoredAcceptanceAllowed machine window + exact Or.inr haccept + simp only [AcceptanceAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hstack, hhead, ?_⟩ + intro _ + exact canonicalTrueHalt_trueOutputMachineHead + bound machine x certificate hsupported hint false + (nondeterministicRowWidth_pos bound machine x) position + +end CLVerifiedLocalTableauCompiler + +namespace CLFinalTableauAssembly + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLBoundedStates +open GapCVP.CLPushAlphabet GapCVP.CLCellRows GapCVP.CLCellRowBounds GapCVP.CLLocalWindows +open GapCVP.CLExactLocalRules GapCVP.CLExactStackRules GapCVP.CLFiniteShiftWindows +open GapCVP.CLExactVerifierTransition GapCVP.CLTableauSimulationCert +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseSpecification +open GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseTraceInduction GapCVP.CLPhaseGlobalSimulation +open GapCVP.CLStackVerifierSimulation GapCVP.CLGuessPayloadReachability +open GapCVP.CLReachableTableauCompiler GapCVP.CLAcceptanceAnchor +open GapCVP.CLVerifiedLocalTableauCompiler + +private theorem canonicalGuessingWitnessWindow_center + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (hinrange : + position.val * blockSize machine.tm + offset.val < + rowWidth bound machine x + 1) : + (completeWitnessWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next position) offset).2.1 = + certificatePhase certificate + (position.val * blockSize machine.tm + offset.val) := by + simp only [completeWitnessWindow, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + canonicalGuessingScriptRow, Fin.val_eq_zero_iff, completeMachineBlock, packRow, + Order.lt_add_one_iff, guessingRow, + dite_eq_ite, hinrange, ↓reduceDIte] + +private theorem canonicalGuessingWitnessWindow_next + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (oldAnnotation bit : Bool) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (hinrange : + position.val * blockSize machine.tm + offset.val < + rowWidth bound machine x + 1) : + (completeWitnessWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit) + position) offset).2.2.2 = + certificatePhase (certificate ++ [bit]) + (position.val * blockSize machine.tm + offset.val) := by + simp only [completeWitnessWindow, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + canonicalGuessingScriptRow, Fin.val_eq_zero_iff, completeMachineBlock, packRow, + Order.lt_add_one_iff, guessingRow, + dite_eq_ite, hinrange, ↓reduceDIte] + +private theorem canonicalGuessingPayloadWindow_center + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (hinrange : + position.val * blockSize machine.tm + offset.val < + rowWidth bound machine x + 1) : + (completePayloadWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next position) offset).2.1 = + pairedInputTagAt x certificate + (position.val * blockSize machine.tm + offset.val) := by + simp only [completePayloadWindow, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + pairedInputBlockAt, + hinrange, ↓reduceIte] + +private theorem canonicalGuessingPayloadWindow_next + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (oldAnnotation bit : Bool) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (hinrange : + position.val * blockSize machine.tm + offset.val < + rowWidth bound machine x + 1) : + (completePayloadWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit) + position) offset).2.2.2 = + pairedInputTagAt x (certificate ++ [bit]) + (position.val * blockSize machine.tm + offset.val) := by + simp only [completePayloadWindow, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + pairedInputBlockAt, + hinrange, ↓reduceIte] + +private theorem canonicalGuessingWitnessWindow_right + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (hnext : position.val * blockSize machine.tm + offset.val + 1 < + rowWidth bound machine x + 1) : + (completeWitnessWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next position) offset).2.2.1 = + certificatePhase certificate + (position.val * blockSize machine.tm + offset.val + 1) := by + by_cases hoffset : offset.val + 1 < blockSize machine.tm + · have hinrange : + position.val * blockSize machine.tm + (offset.val + 1) < + rowWidth bound machine x + 1 := by + omega + simp only [completeWitnessWindow, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + canonicalGuessingScriptRow, Fin.val_eq_zero_iff, completeMachineBlock, packRow, + Order.lt_add_one_iff, guessingRow, + dite_eq_ite, phaseRightOffset, hoffset, ↓reduceDIte, hinrange, Nat.add_assoc] + · have hoffsetLast : offset.val + 1 = blockSize machine.tm := by + have hlt := offset.isLt + omega + have hmul : position.val ≤ + position.val * blockSize machine.tm := + Nat.le_mul_of_pos_right position.val + (blockSize_pos machine.tm) + have hright : position.val + 1 ≤ + rowWidth bound machine x := by + omega + have hrightVal : + (rightBlock (rowWidth bound machine x) position).val = + position.val + 1 := by + exact Nat.min_eq_left hright + have hpacked : + position.val * blockSize machine.tm + + blockSize machine.tm ≤ rowWidth bound machine x := by + omega + simp only [completeWitnessWindow, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + canonicalGuessingScriptRow, Fin.val_eq_zero_iff, hrightVal, Nat.add_eq_zero_iff, + one_ne_zero, and_false, + decide_false, completeMachineBlock, packRow, Order.lt_add_one_iff, guessingRow, + dite_eq_ite, phaseRightOffset, + hoffsetLast, lt_self_iff_false, ↓reduceDIte, Nat.add_mul, one_mul, add_zero, hpacked, + Nat.add_assoc] + +private theorem canonicalGuessingPayloadWindow_right + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (annotation : Bool) + (next : Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (hnext : position.val * blockSize machine.tm + offset.val + 1 < + rowWidth bound machine x + 1) : + (completePayloadWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate annotation) + next position) offset).2.2.1 = + pairedInputTagAt x certificate + (position.val * blockSize machine.tm + offset.val + 1) := by + by_cases hoffset : offset.val + 1 < blockSize machine.tm + · have hinrange : + position.val * blockSize machine.tm + (offset.val + 1) < + rowWidth bound machine x + 1 := by + omega + simp only [completePayloadWindow, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + pairedInputBlockAt, + Order.lt_add_one_iff, phaseRightOffset, hoffset, ↓reduceDIte, hinrange, ↓reduceIte, + Nat.add_assoc] + · have hoffsetLast : offset.val + 1 = blockSize machine.tm := by + have hlt := offset.isLt + omega + have hmul : position.val ≤ + position.val * blockSize machine.tm := + Nat.le_mul_of_pos_right position.val + (blockSize_pos machine.tm) + have hright : position.val + 1 ≤ + rowWidth bound machine x := by + omega + have hrightVal : + (rightBlock (rowWidth bound machine x) position).val = + position.val + 1 := by + exact Nat.min_eq_left hright + have hpacked : + position.val * blockSize machine.tm + + blockSize machine.tm ≤ rowWidth bound machine x := by + omega + simp only [completePayloadWindow, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + pairedInputBlockAt, + Order.lt_add_one_iff, phaseRightOffset, hoffsetLast, lt_self_iff_false, ↓reduceDIte, + hrightVal, Nat.add_mul, + one_mul, add_zero, hpacked, ↓reduceIte, Nat.add_assoc] + +private theorem canonicalGuessingWitnessWindow_broadcast + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (oldAnnotation bit : Bool) + (hbound : certificate.length < bound.eval x.length) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (hinrange : + position.val * blockSize machine.tm + offset.val < + rowWidth bound machine x + 1) : + BroadcastWitnessGuessAllowed bit + (completeWitnessWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit) + position) offset) := by + let width := rowWidth bound machine x + let first := canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation + let next := canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit + let index : Position width := + ⟨position.val * blockSize machine.tm + offset.val, hinrange⟩ + let window := completeWitnessWindow machine.tm + (anchoredVerifierWindowAt machine.tm width first next position) + offset + have hblock := coordinateBlock_of_packed machine.tm width + position offset hinrange + have hoffset := coordinateOffset_of_packed machine.tm width + position offset hinrange + have hleft := canonicalGuessingWitnessWindow_left + bound machine x certificate oldAnnotation next index + rw [hblock, hoffset] at hleft + have hcenter := canonicalGuessingWitnessWindow_center + bound machine x certificate oldAnnotation next + position offset hinrange + have hnext := canonicalGuessingWitnessWindow_next + bound machine x certificate oldAnnotation bit + position offset hinrange + have hspace : certificate.length < width := + hbound.trans_le (certificateBound_le_rowWidth + bound machine x) + have hcanonical := guessPhaseWindow_of_append + width certificate bit hspace index + simp only [GuessPhaseAllowed, decide_eq_true_eq] at hcanonical + have hphase : GuessPhaseAllowed window := by + simp only [GuessPhaseAllowed, decide_eq_true_eq] + rcases hcanonical with hwrite | hrest + · refine Or.inl ⟨?_, ?_, ?_⟩ + · exact hcenter.trans hwrite.1 + · have hmarker : index.val = certificate.length := + (certificatePhase_accepting_iff + certificate index.val).mp hwrite.1 + have hrightInRange : + position.val * blockSize machine.tm + + offset.val + 1 < width + 1 := by + change position.val * blockSize machine.tm + + offset.val = certificate.length at hmarker + omega + rw [canonicalGuessingWitnessWindow_right + bound machine x certificate oldAnnotation next + position offset hrightInRange] + change + certificatePhase certificate + (position.val * blockSize machine.tm + + offset.val + 1) = .guessing + apply certificatePhase_after + change position.val * blockSize machine.tm + + offset.val = certificate.length at hmarker + omega + · rcases hwrite.2.2 with hguessing | hverifying + · exact Or.inl (hnext.trans hguessing) + · exact Or.inr (hnext.trans hverifying) + · rcases hrest with hmarker | hunchanged + · refine Or.inr (Or.inl ⟨?_, ?_, ?_⟩) + · intro himpossible + exact hmarker.1 (hcenter.symm.trans himpossible) + · exact hleft.trans hmarker.2.1 + · exact hnext.trans hmarker.2.2 + · refine Or.inr (Or.inr ⟨?_, ?_, ?_⟩) + · intro himpossible + exact hunchanged.1 (hcenter.symm.trans himpossible) + · intro himpossible + exact hunchanged.2.1 (hleft.symm.trans himpossible) + · exact hnext.trans + (hunchanged.2.2.trans hcenter.symm) + simp only [BroadcastWitnessGuessAllowed, decide_eq_true_eq] + refine ⟨hphase, ?_⟩ + intro hmarker + have hindex : index.val = certificate.length := + (certificatePhase_accepting_iff + certificate index.val).mp (hcenter.symm.trans hmarker) + rw [hnext] + change + certificatePhase (certificate ++ [bit]) index.val = + if bit then PhaseTag.verifying else PhaseTag.guessing + rw [hindex, certificatePhase_append_old_marker] + +private theorem canonicalGuessingPayloadWindow_append + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (oldAnnotation bit : Bool) + (hbound : certificate.length < bound.eval x.length) + (position : Position (rowWidth bound machine x)) + (offset : Fin (blockSize machine.tm)) + (hinrange : + position.val * blockSize machine.tm + offset.val < + rowWidth bound machine x + 1) : + PairedInputGuessAllowed bit + (completePayloadWindow machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit) + position) offset) := by + let width := rowWidth bound machine x + let first := canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation + let next := canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit + let index : Position width := + ⟨position.val * blockSize machine.tm + offset.val, hinrange⟩ + let window := completePayloadWindow machine.tm + (anchoredVerifierWindowAt machine.tm width first next position) + offset + have hblock := coordinateBlock_of_packed machine.tm width + position offset hinrange + have hoffset := coordinateOffset_of_packed machine.tm width + position offset hinrange + have hleft := canonicalGuessingPayloadWindow_left + bound machine x certificate oldAnnotation next index + rw [hblock, hoffset] at hleft + have hcenter := canonicalGuessingPayloadWindow_center + bound machine x certificate oldAnnotation next + position offset hinrange + have hnext := canonicalGuessingPayloadWindow_next + bound machine x certificate oldAnnotation bit + position offset hinrange + have hcanonical := pairedInputGuessAllowed_of_append + x certificate bit index.val + simp only [PairedInputGuessAllowed, decide_eq_true_eq] at hcanonical ⊢ + rcases hcanonical with hwrite | hrest + · refine Or.inl ⟨hcenter.trans hwrite.1, ?_, + hnext.trans hwrite.2.2⟩ + have hmarker : index.val = x.length + certificate.length := + (pairedInputTagAt_marker_iff + x certificate index.val).mp hwrite.1 + have hbudget := pairedCertificateBound_le_rowWidth + bound machine x + have hrightInRange : + position.val * blockSize machine.tm + + offset.val + 1 < width + 1 := by + change position.val * blockSize machine.tm + + offset.val = x.length + certificate.length at hmarker + omega + rw [canonicalGuessingPayloadWindow_right + bound machine x certificate oldAnnotation next + position offset hrightInRange] + exact hwrite.2.1 + · rcases hrest with hmarker | hunchanged + · refine Or.inr (Or.inl ⟨?_, ?_, ?_⟩) + · intro himpossible + exact hmarker.1 (hcenter.symm.trans himpossible) + · exact hleft.trans hmarker.2.1 + · exact hnext.trans hmarker.2.2 + · refine Or.inr (Or.inr ⟨?_, ?_, ?_⟩) + · intro himpossible + exact hunchanged.1 (hcenter.symm.trans himpossible) + · intro himpossible + exact hunchanged.2.1 (hleft.symm.trans himpossible) + · exact hnext.trans + (hunchanged.2.2.trans hcenter.symm) + +private theorem canonicalGuessingStep_correctedWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (oldAnnotation bit : Bool) + (hbound : certificate.length < bound.eval x.length) + (position : Position (rowWidth bound machine x)) : + CorrectedGuessingAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit) + position) := by + simp only [CorrectedGuessingAllowed, decide_eq_true_eq] + refine ⟨rfl, rfl, rfl, rfl, ?_⟩ + intro offset hrange + have hinrange : + position.val * blockSize machine.tm + offset.val < + rowWidth bound machine x + 1 := by + change + decide (position.val * blockSize machine.tm + offset.val < + rowWidth bound machine x + 1) = true at hrange + exact of_decide_eq_true hrange + refine ⟨canonicalGuessingWitnessWindow_broadcast + bound machine x certificate oldAnnotation bit hbound + position offset hinrange, + canonicalGuessingPayloadWindow_append + bound machine x certificate oldAnnotation bit hbound + position offset hinrange, ?_⟩ + intro hmarker + have hcenter := canonicalGuessingPayloadWindow_center + bound machine x certificate oldAnnotation + (canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit) + position offset hinrange + have hindex : + position.val * blockSize machine.tm + offset.val = + x.length + certificate.length := + (pairedInputTagAt_marker_iff x certificate _).mp + (hcenter.symm.trans hmarker) + change + decide (position.val * blockSize machine.tm + offset.val < + x.length + bound.eval x.length) = true + apply decide_eq_true + omega + +theorem canonicalGuessingStep_acceptanceAnchoredWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (oldAnnotation bit : Bool) + (hbound : certificate.length < bound.eval x.length) + (position : Position (rowWidth bound machine x)) : + AcceptanceAnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit) + position) := by + let first := canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation + let next := canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position + have hcoherent : CompletePhaseCoherent machine.tm window := by + simp only [CompletePhaseCoherent, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + and_self, + decide_true, window, first] + have hboundary : PhaseBoundaryPreserved machine.tm window := by + simp only [PhaseBoundaryPreserved, completeIsFirstBlock, anchoredVerifierWindowAt, + canonicalAnchoredGuessingRow, canonicalGuessingScriptRow, Fin.val_eq_zero_iff, decide_true, + window, first, next] + have hguess : AnchoredGuessingAllowed machine window := by + simp only [AnchoredGuessingAllowed, decide_eq_true_eq] + refine ⟨canonicalGuessingStep_correctedWindows + bound machine x certificate oldAnnotation bit hbound position, + hboundary, ?_, ?_⟩ + · exact canonicalAnchoredGuessingRow_firstBlockAnchored + bound machine x certificate oldAnnotation position + · exact canonicalAnchoredGuessingRow_firstBlockAnchored + bound machine x (certificate ++ [bit]) bit position + have hstack : StackSoundAnchoredPhaseAllowed machine window := by + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hcoherent, ?_⟩ + change + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window + exact Or.inl hguess + simp only [AcceptanceAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hstack, + canonicalAnchoredGuessingWindow_replicatedMachineHeadCoherent + bound machine x certificate oldAnnotation next position, ?_⟩ + intro himpossible + change PhaseTag.guessing = PhaseTag.accepting at himpossible + cases himpossible + +private theorem canonicalCellAtom_eq_of_value_eq + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (first next : machine.tm.Γ stack) + (hfirst : SupportedStackValue machine stack first) + (hnext : SupportedStackValue machine stack next) + (hvalue : first = next) : + canonicalCellAtom machine stack first hfirst = + canonicalCellAtom machine stack next hnext := by + subst next + rfl + +private theorem paddedCanonicalStackAtoms_get + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (stack : machine.tm.K) + (values : List (machine.tm.Γ stack)) + (hsupported : ∀ value ∈ values, + SupportedStackValue machine stack value) + (index : Fin values.length) : + paddedAtom + (canonicalStackAtoms machine stack values hsupported) + index.val = + canonicalCellAtom machine stack (values.get index) + (hsupported (values.get index) (List.get_mem values index)) := by + simp only [paddedAtom, canonicalStackAtoms, List.length_pmap, Fin.is_lt, getElem?_pos, + List.getElem_pmap, + Option.getD_some, List.get_eq_getElem] + +private theorem canonicalInitialStackAtom_eq_initialPairedAtom + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (stack : machine.tm.K) + (index : ℕ) : + paddedAtom + (canonicalStackAtoms machine stack + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk stack) + (stackAtomSupported_supportedValues machine _ hsupported stack)) index = + initialPairedAtom machine stack + (pairedInputTagAt x certificate index) := by + classical + by_cases hstack : stack = machine.tm.k₀ + · subst stack + by_cases hinside : index < + (verifierInput machine x certificate).length + · have hstackInside : + index < + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀).length := by + simpa only [initList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq, verifierInput_length] + using hinside + let entryIndex : Fin + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀).length := ⟨index, hstackInside⟩ + have hatom := paddedCanonicalStackAtoms_get + machine machine.tm.k₀ + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀) + (stackAtomSupported_supportedValues machine _ hsupported + machine.tm.k₀) entryIndex + have hpairInside : index < + (pairBitEncoding (x, certificate)).length := by + simpa only [pairBitEncoding_apply, List.length_append, List.length_map, verifierInput, + Equiv.invFun_as_coe, + List.map_append, List.map_map] using hinside + have htag : + pairedInputTagAt x certificate index = + .bit ((pairBitEncoding (x, certificate))[index]) := by + unfold pairedInputTagAt + rw [List.getElem?_eq_getElem hpairInside] + have hvalueOptional : + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀)[index]? = + some (machine.inputAlphabet.invFun + ((pairBitEncoding (x, certificate))[index])) := by + rw [show (Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀ = + verifierInput machine x certificate by + simp only [initList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq]] + unfold verifierInput + rw [List.getElem?_map, + List.getElem?_eq_getElem hpairInside] + rfl + have hvalue : + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀).get entryIndex = + machine.inputAlphabet.invFun + ((pairBitEncoding (x, certificate))[index]) := by + apply Option.some.inj + calc + some (((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀).get entryIndex) = + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀)[index]? := by + simp only [List.get_eq_getElem, hstackInside, getElem?_pos, entryIndex] + _ = some (machine.inputAlphabet.invFun + ((pairBitEncoding (x, certificate))[index])) := + hvalueOptional + have hcanonical : + paddedAtom + (canonicalStackAtoms machine machine.tm.k₀ + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀) + (stackAtomSupported_supportedValues machine _ hsupported + machine.tm.k₀)) index = + canonicalCellAtom machine machine.tm.k₀ + (((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀).get entryIndex) + (stackAtomSupported_supportedValues machine _ hsupported + machine.tm.k₀ _ + (List.get_mem _ entryIndex)) := by + simpa only [List.get_eq_getElem] using hatom + rw [htag] + rw [hcanonical] + simp only [initialPairedAtom] + exact canonicalCellAtom_eq_of_value_eq + machine machine.tm.k₀ _ _ _ + (hvalue ▸ stackAtomSupported_supportedValues machine _ hsupported + machine.tm.k₀ _ (List.get_mem _ entryIndex)) hvalue + · have hlength : + (canonicalStackAtoms machine machine.tm.k₀ + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk + machine.tm.k₀) + (stackAtomSupported_supportedValues machine _ hsupported + machine.tm.k₀)).length ≤ index := by + rw [canonicalStackAtoms_length] + simpa only [initList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq, verifierInput_length] using + (Nat.le_of_not_gt hinside) + rw [paddedAtom_none_of_length_le + machine.tm _ index hlength] + symm + apply (initialPairedAtom_pairedInput_blank_iff + machine x certificate index).mpr + simpa only [pairBitEncoding_apply, List.length_append, List.length_map, verifierInput, + Equiv.invFun_as_coe, + List.map_append, List.map_map] using (Nat.le_of_not_gt hinside) + · have hblank : + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk stack).length = + 0 := by + simp only [initList, eq_mpr_eq_cast, hstack, ↓reduceDIte, List.length_nil] + have hlength : + (canonicalStackAtoms machine stack + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk stack) + (stackAtomSupported_supportedValues machine _ hsupported stack)).length ≤ index := by + rw [canonicalStackAtoms_length, hblank] + exact Nat.zero_le index + rw [paddedAtom_none_of_length_le + machine.tm _ index hlength] + exact (initialPairedAtom_private_blank + machine stack hstack + (pairedInputTagAt x certificate index)).symm + +private theorem canonicalInitialMachineBlock_eq_initializedPhaseBlock + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (oldAnnotation : Bool) + (hint : FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + completeMachineBlock machine.tm + (canonicalAnchoredVerifyingRow + bound machine x certificate + (Turing.initList machine.tm + (verifierInput machine x certificate)) + hsupported hint false position) = + initializedPhaseBlock machine + (completeMachineBlock machine.tm + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation position)) + ((canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation position).payload) + ((canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation position).range) := by + funext offset + let index := position.val * blockSize machine.tm + offset.val + by_cases hinrange : index < rowWidth bound machine x + 1 + · have hatoms : + (fun stack : machine.tm.K => + paddedAtom + (canonicalStackAtoms machine stack + ((Turing.initList machine.tm + (verifierInput machine x certificate)).stk stack) + (stackAtomSupported_supportedValues machine _ hsupported stack)) index) = + (fun stack : machine.tm.K => + initialPairedAtom machine stack + (pairedInputTagAt x certificate index)) := by + funext stack + exact canonicalInitialStackAtom_eq_initialPairedAtom + machine x certificate hsupported stack index + have hcontrol : + configurationControl machine.tm + (Turing.initList machine.tm + (verifierInput machine x certificate)) = + configurationControl machine.tm + (Turing.initList machine.tm []) := by + simp only [configurationControl, initList, eq_mpr_eq_cast, Option.getD_some] + have hlabel : + (Turing.initList machine.tm + (verifierInput machine x certificate)).l.isSome = + (Turing.initList machine.tm []).l.isSome := by + simp only [initList, eq_mpr_eq_cast, Option.isSome_some] + simp only [completeMachineBlock, canonicalAnchoredVerifyingRow, canonicalScriptBlockRow, + Fin.val_eq_zero_iff, + packRow, hinrange, ↓reduceDIte, canonicalVerifyingRow, hcontrol, hatoms, hlabel, + initializedPhaseBlock, + canonicalAnchoredGuessingRow, canonicalGuessingScriptRow, phaseRangeBlockAt, decide_true, + ↓reduceIte, guessingRow, + pairedInputBlockAt, index] + · simp only [completeMachineBlock, canonicalAnchoredVerifyingRow, canonicalScriptBlockRow, + Fin.val_eq_zero_iff, + packRow, hinrange, ↓reduceDIte, initializedPhaseBlock, canonicalAnchoredGuessingRow, + canonicalGuessingScriptRow, + phaseRangeBlockAt, decide_false, Bool.false_eq_true, ↓reduceIte, index] + +private theorem canonicalInitialMachineHead_eq_initializedPhaseBlock + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (oldAnnotation : Bool) + (hint : FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + completeMachineHead machine.tm + (canonicalAnchoredVerifyingRow + bound machine x certificate + (Turing.initList machine.tm + (verifierInput machine x certificate)) + hsupported hint false position) = + initializedPhaseBlock machine + (completeMachineHead machine.tm + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation position)) + ((canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation position).payloadHead) + ((canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation position).rangeHead) := by + have hzero := canonicalInitialMachineBlock_eq_initializedPhaseBlock + bound machine x certificate hsupported oldAnnotation hint 0 + simpa only [completeMachineHead, canonicalAnchoredVerifyingRow, canonicalScriptBlockRow, + Fin.val_eq_zero_iff, + canonicalAnchoredGuessingRow, canonicalGuessingScriptRow, completeMachineBlock, + Fin.coe_ofNat_eq_mod, Nat.zero_mod, + decide_true] using hzero + +private theorem canonicalInitialization_staticTracks + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (oldAnnotation : Bool) + (hint : FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + CompleteStaticTracksPreserved machine.tm + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredVerifyingRow + bound machine x certificate + (Turing.initList machine.tm + (verifierInput machine x certificate)) + hsupported hint false) + position) := by + simp only [CompleteStaticTracksPreserved, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + canonicalGuessingScriptRow, Fin.val_eq_zero_iff, canonicalAnchoredVerifyingRow, + canonicalScriptBlockRow, + completeIsFirstBlock, and_self, decide_true] + +private theorem canonicalInitialization_anchoredWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (oldAnnotation : Bool) + (hint : FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + AnchoredInitializationAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredVerifyingRow + bound machine x certificate + (Turing.initList machine.tm + (verifierInput machine x certificate)) + hsupported hint false) + position) := by + apply @decide_eq_true _ (Classical.propDecidable _) + refine ⟨?_, canonicalAnchoredGuessingRow_firstBlockAnchored + bound machine x certificate oldAnnotation position, + canonicalAnchoredVerifyingRow_firstBlockAnchored + bound machine x certificate + (Turing.initList machine.tm + (verifierInput machine x certificate)) + hsupported hint false position⟩ + apply @decide_eq_true _ (Classical.propDecidable _) + exact ⟨rfl, + canonicalInitialization_staticTracks + bound machine x certificate hsupported + oldAnnotation hint position, + canonicalInitialMachineBlock_eq_initializedPhaseBlock + bound machine x certificate hsupported + oldAnnotation hint position, + canonicalInitialMachineHead_eq_initializedPhaseBlock + bound machine x certificate hsupported + oldAnnotation hint position⟩ + +theorem canonicalInitialization_acceptanceAnchoredWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (oldAnnotation : Bool) + (hint : FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + AcceptanceAnchoredPhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredVerifyingRow + bound machine x certificate + (Turing.initList machine.tm + (verifierInput machine x certificate)) + hsupported hint false) + position) := by + let first := canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation + let next := canonicalAnchoredVerifyingRow + bound machine x certificate + (Turing.initList machine.tm + (verifierInput machine x certificate)) + hsupported hint false + let window := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position + have hcoherent : CompletePhaseCoherent machine.tm window := by + simp only [CompletePhaseCoherent, anchoredVerifierWindowAt, canonicalAnchoredGuessingRow, + and_self, + decide_true, window, first] + have hinitial : AnchoredInitializationAllowed machine window := + canonicalInitialization_anchoredWindows + bound machine x certificate hsupported + oldAnnotation hint position + have hstack : StackSoundAnchoredPhaseAllowed machine window := by + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hcoherent, ?_⟩ + change + AnchoredGuessingAllowed machine window ∨ + AnchoredInitializationAllowed machine window + exact Or.inr hinitial + simp only [AcceptanceAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hstack, + canonicalAnchoredGuessingWindow_replicatedMachineHeadCoherent + bound machine x certificate oldAnnotation next position, ?_⟩ + intro himpossible + change PhaseTag.verifying = PhaseTag.accepting at himpossible + cases himpossible + +end CLFinalTableauAssembly + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part03.lean b/LeanPool/GapCVP/Part03.lean new file mode 100644 index 000000000..7fa0b5797 --- /dev/null +++ b/LeanPool/GapCVP/Part03.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part03G + +/-! # GapCVP proof, part 03 -/ diff --git a/LeanPool/GapCVP/Part03A.lean b/LeanPool/GapCVP/Part03A.lean new file mode 100644 index 000000000..2b013888d --- /dev/null +++ b/LeanPool/GapCVP/Part03A.lean @@ -0,0 +1,2181 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part02 + +/-! # GapCVP proof, part 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +private theorem ofClassicalDecide03 {proposition : Prop} + (proof : @decide proposition (Classical.propDecidable proposition) = true) : + proposition := + @of_decide_eq_true proposition (Classical.propDecidable proposition) proof + +namespace CLPaddedAcceptanceCompiler + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLNondeterminism +open GapCVP.CLBoundedStates GapCVP.CLPushAlphabet GapCVP.CLCellRowBounds GapCVP.CLLocalWindows +open GapCVP.CLTableauStitching GapCVP.CLExactVerifierTransition GapCVP.CLTableauSimulationCert +open GapCVP.CLVerifierPhaseCert GapCVP.CLCompleteVerifierSimulation GapCVP.CLPhaseCompleteness +open GapCVP.CLPhaseTableauSimulation GapCVP.CLPhaseTraceInduction GapCVP.CLPhaseGlobalSimulation +open GapCVP.CLWholeTraceSoundness GapCVP.CLStackVerifierSimulation +open GapCVP.CLAnchoredTraceSimulation GapCVP.CLWholeTimeOccupancy +open GapCVP.CLCompactWindowSoundness GapCVP.CLBoundedRowInduction +open GapCVP.CLFullStackStepSoundness GapCVP.CLNaturalTimeCompiler GapCVP.CLAcceptanceAnchor +open GapCVP.CLVerifiedLocalTableauCompiler GapCVP.CLFinalTableauAssembly + +private noncomputable def PaddedAcceptancePhaseAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := + @decide ( + StackSoundAnchoredPhaseAllowed machine window ∧ + ReplicatedMachineHeadCoherent machine.tm window ∧ + (window.2.1.mode = .verifying → + window.2.2.2.mode = .accepting → + TrueOutputMachineHead machine window.2.1) + ) (Classical.propDecidable _) +private def paddedAcceptancePhaseAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : Bool := by + classical + exact decide (PaddedAcceptancePhaseAllowed machine window) + +private theorem paddedAcceptancePhaseAllowed_iff + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) : + paddedAcceptancePhaseAllowed machine window = true ↔ + PaddedAcceptancePhaseAllowed machine window := by + classical + simp only [paddedAcceptancePhaseAllowed, Bool.decide_eq_true] + +private theorem acceptanceAnchoredPhaseAllowed_implies_padded + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : CompletePhaseWindow machine.tm) + (hallowed : AcceptanceAnchoredPhaseAllowed machine window) : + PaddedAcceptancePhaseAllowed machine window := by + simp only [PaddedAcceptancePhaseAllowed, decide_eq_true_eq] + have hallowed' := hallowed + simp only [AcceptanceAnchoredPhaseAllowed, decide_eq_true_eq] at hallowed' + exact ⟨hallowed'.1, hallowed'.2.1, + fun _ haccept => hallowed'.2.2 haccept⟩ + +/-- GapCVP reduction support. -/ +def paddedAcceptancePhaseSymbolAllowed + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : WindowSymbols (completePhaseSymbolCount machine.tm)) : + Bool := + paddedAcceptancePhaseAllowed machine + ((completePhaseSymbolEquiv machine.tm).symm window.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.2) + +/-- GapCVP reduction support. -/ +def paddedAcceptancePhaseSpecification + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + Specification + ((nondeterministicTableauDimensionPolynomial bound machine).eval + x.length) + (completePhaseSymbolCount machine.tm) where + input position := + completePhaseSymbolEquiv machine.tm + (initialPhaseCell bound machine x position) + accept := + completePhaseSymbolEquiv machine.tm + (acceptingPhaseCell machine.tm) + allowed := paddedAcceptancePhaseSymbolAllowed machine + +private theorem paddedAcceptance_acceptingSelfWindow + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (width : ℕ) + (position : Position width) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm width + (fun _ => acceptingPhaseCell machine.tm) + (fun _ => acceptingPhaseCell machine.tm) + position) := by + let window := anchoredVerifierWindowAt machine.tm width + (fun _ => acceptingPhaseCell machine.tm) + (fun _ => acceptingPhaseCell machine.tm) + position + have hcoherent : CompletePhaseCoherent machine.tm window := by + simp only [CompletePhaseCoherent, anchoredVerifierWindowAt, and_self, decide_true, window] + have hstack : StackSoundAnchoredPhaseAllowed machine window := by + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] + refine ⟨hcoherent, ?_⟩ + change acceptingPhaseCell machine.tm = acceptingPhaseCell machine.tm + rfl + simp only [PaddedAcceptancePhaseAllowed, decide_eq_true_eq] + refine ⟨hstack, ?_, ?_⟩ + · simp only [ReplicatedMachineHeadCoherent, anchoredVerifierWindowAt, and_self, decide_true] + · intro himpossible + change PhaseTag.accepting = PhaseTag.verifying at himpossible + cases himpossible + +private theorem canonicalGuessingStep_paddedAcceptanceWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (oldAnnotation bit : Bool) + (hbound : certificate.length < bound.eval x.length) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredGuessingRow + bound machine x (certificate ++ [bit]) bit) + position) := + acceptanceAnchoredPhaseAllowed_implies_padded machine _ + (canonicalGuessingStep_acceptanceAnchoredWindows + bound machine x certificate oldAnnotation bit hbound position) + +private theorem canonicalInitialization_paddedAcceptanceWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x certificate))) + (oldAnnotation : Bool) + (hint : FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredGuessingRow + bound machine x certificate oldAnnotation) + (canonicalAnchoredVerifyingRow + bound machine x certificate + (Turing.initList machine.tm + (verifierInput machine x certificate)) + hsupported hint false) + position) := + acceptanceAnchoredPhaseAllowed_implies_padded machine _ + (canonicalInitialization_acceptanceAnchoredWindows + bound machine x certificate hsupported oldAnnotation hint position) + +private theorem canonicalTrueHalt_paddedAcceptanceWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (hsupported : StackAtomSupported machine + (Turing.haltList machine.tm + (verifierOutput machine true))) + (hint : FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (canonicalAnchoredVerifyingRow bound machine x certificate + (Turing.haltList machine.tm + (verifierOutput machine true)) + hsupported hint false) + (fun _ => acceptingPhaseCell machine.tm) + position) := + acceptanceAnchoredPhaseAllowed_implies_padded machine _ + (canonicalTrueHalt_acceptanceAnchoredWindows + bound machine x certificate hsupported hint position) + +private theorem paddedAcceptanceSymbolAllowed_implies_stackSound + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (window : WindowSymbols (completePhaseSymbolCount machine.tm)) + (hallowed : + paddedAcceptancePhaseSymbolAllowed machine window = true) : + stackSoundAnchoredPhaseSymbolAllowed machine window = true := by + let decoded : CompletePhaseWindow machine.tm := + ((completePhaseSymbolEquiv machine.tm).symm window.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.1, + (completePhaseSymbolEquiv machine.tm).symm window.2.2.2) + have hcorrected : PaddedAcceptancePhaseAllowed machine decoded := by + apply (paddedAcceptancePhaseAllowed_iff machine decoded).mp + exact hallowed + have hcorrected' := hcorrected + simp only [PaddedAcceptancePhaseAllowed, decide_eq_true_eq] at hcorrected' + apply (stackSoundAnchoredPhaseAllowed_iff machine decoded).mpr + exact hcorrected'.1 + +private theorem paddedAcceptanceValidTrace_to_stackSound + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (paddedAcceptancePhaseSpecification bound machine x) trace) : + ValidTrace + (stackSoundAnchoredPhaseSpecification bound machine x) trace := by + have htrace' := htrace + simp only [ValidTrace, decide_eq_true_eq] at htrace' ⊢ + refine ⟨htrace'.1, htrace'.2.1, ?_⟩ + intro window + exact paddedAcceptanceSymbolAllowed_implies_stackSound + machine _ (htrace'.2.2 window) + +private theorem paddedAcceptanceValidTrace_window + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (paddedAcceptancePhaseSpecification bound machine x) trace) + (window : Window (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (decodeCorrectedPhaseRow machine (trace window.1.1) + (leftPosition window), + decodeCorrectedPhaseRow machine (trace window.1.1) + window.1.2, + decodeCorrectedPhaseRow machine (trace window.1.1) + (rightPosition window), + decodeCorrectedPhaseRow machine + (trace (nextTime window)) window.1.2) := by + have htrace' := htrace + simp only [ValidTrace, decide_eq_true_eq] at htrace' + apply (paddedAcceptancePhaseAllowed_iff machine _).mp + exact htrace'.2.2 window + +private theorem paddedAcceptanceValidTrace_machineHead_constant + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (paddedAcceptancePhaseSpecification bound machine x) trace) + (time : Fin (rowWidth bound machine x)) : + ∀ position : Position (rowWidth bound machine x), + completeMachineHead machine.tm + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position) = + completeMachineHead machine.tm + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) 0) := by + intro position + induction position using Fin.induction with + | zero => rfl + | succ position ih => + have hwindow := paddedAcceptanceValidTrace_window + bound machine x trace htrace (windowAt time position.succ) + simp only [PaddedAcceptancePhaseAllowed, + ReplicatedMachineHeadCoherent, decide_eq_true_eq] at hwindow + have hwindowOuter := ofClassicalDecide03 hwindow + have hreplicated := ofClassicalDecide03 hwindowOuter.2.1 + have hleft := hreplicated.1 + change + completeMachineHead machine.tm + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) + (leftBlock (rowWidth bound machine x) + position.succ)) = + completeMachineHead machine.tm + (decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) position.succ) + at hleft + rw [leftBlock_succ] at hleft + exact hleft.symm.trans ih + +private theorem paddedAcceptanceValidTrace_firstAcceptance_trueHalt + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (paddedAcceptancePhaseSpecification bound machine x) trace) : + ∃ (time : Fin (rowWidth bound machine x)) + (position : Position (rowWidth bound machine x)) + (certificate : List Bool), + let first := decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) + let next := decodeCorrectedPhaseRow machine + (trace time.succ) + AnchoredAcceptanceAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position) ∧ + (∀ other : Position (rowWidth bound machine x), + (first other).mode = .verifying) ∧ + (∀ other : Position (rowWidth bound machine x), + AnchoredPhaseMasks bound machine x other (first other)) ∧ + (∀ stack : machine.tm.K, + NoInteriorPaddingHoles machine.tm + (fullPackedPhaseStackAtoms machine + (rowWidth bound machine x) first stack)) ∧ + certificate.length ≤ bound.eval x.length ∧ + TrueOutputMachineHead machine (first 0) ∧ + verifier (x, certificate) = true ∧ + decodedFullPackedPhaseConfiguration machine + (rowWidth bound machine x) first = + Turing.haltList machine.tm + (verifierOutput machine true) ∧ + Nonempty (FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (Turing.haltList machine.tm + (verifierOutput machine true))) time.val) ∧ + time.val ≤ + (guessTimePolynomial bound machine).eval x.length ∧ + (∀ (earlier : Time (rowWidth bound machine x)), + earlier.val ≤ time.val → + ∀ other : Position (rowWidth bound machine x), + (decodeCorrectedPhaseRow machine + (trace earlier) other).mode ≠ .accepting) := by + have hstack := paddedAcceptanceValidTrace_to_stackSound + bound machine x trace htrace + obtain ⟨time, position, certificate, + haccept, hmode, hmasks, hholes, hcertificate, + ⟨run⟩, ⟨verifierRun, _⟩, hruntime, hprefix⟩ := + stackSoundValidTrace_firstAcceptance_actualReachable + bound machine x trace hstack + have haccept' := haccept + simp only [AnchoredAcceptanceAllowed, CompleteAcceptanceAllowed, + AcceptingPhaseBlock, decide_eq_true_eq] at haccept' + have hacceptOuter := ofClassicalDecide03 haccept' + have hacceptComplete := ofClassicalDecide03 hacceptOuter.1 + have hacceptBlock := ofClassicalDecide03 hacceptComplete.2 + let first := decodeCorrectedPhaseRow machine + (trace (Fin.castSucc time)) + let next := decodeCorrectedPhaseRow machine + (trace time.succ) + have hselected := paddedAcceptanceValidTrace_window + bound machine x trace htrace (windowAt time position) + change PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next position) at hselected + simp only [PaddedAcceptancePhaseAllowed, decide_eq_true_eq] at hselected + have hnextAccept : (next position).mode = .accepting := by + change + (decodeCorrectedPhaseRow machine + (trace time.succ) position).mode = .accepting + simpa only [anchoredVerifierWindowAt, acceptingPhaseCell] using + congrArg CompletePhaseCell.mode hacceptComplete.1 + have htrueSelected : + TrueOutputMachineHead machine (first position) := + hselected.2.2 (hmode position) hnextAccept + have hhead := paddedAcceptanceValidTrace_machineHead_constant + bound machine x trace htrace time position + have htrueFirst : TrueOutputMachineHead machine (first 0) := by + simp only [TrueOutputMachineHead, decide_eq_true_eq] + have htrueSelected' := htrueSelected + simp only [TrueOutputMachineHead, decide_eq_true_eq] at htrueSelected' + intro offset stack + rw [← hhead] + exact htrueSelected' offset stack + have hcontrol : machineControlOfBlock machine.tm + (completeMachineHead machine.tm (first 0)) = + some + ((Turing.haltList machine.tm + (verifierOutput machine true)).l, + (Turing.haltList machine.tm + (verifierOutput machine true)).var) := by + rw [← hhead] + exact hacceptBlock.1 + have hmarked : + completeIsFirstBlock machine.tm (first 0) = true := by + have hmask := hmasks 0 + simp only [AnchoredPhaseMasks, decide_eq_true_eq] at hmask + have hboundary := hmask.2.2.2 + simpa only [Fin.coe_ofNat_eq_mod, Nat.zero_mod, decide_true] using hboundary + let zeroWindow := anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) first next 0 + have hzero := stackSoundValidTrace_window + bound machine x trace hstack (windowAt time 0) + change StackSoundAnchoredPhaseAllowed machine zeroWindow at hzero + have hzero' := hzero + simp only [StackSoundAnchoredPhaseAllowed, decide_eq_true_eq] at hzero' + have hsourceZero : (first 0).mode = .verifying := hmode 0 + have hbranches : + StackSoundAnchoredVerificationAllowed machine zeroWindow ∨ + AnchoredAcceptanceAllowed machine zeroWindow := by + have hbranch := hzero'.2 + change + match (first 0).mode with + | .guessing => + AnchoredGuessingAllowed machine zeroWindow ∨ + AnchoredInitializationAllowed machine zeroWindow + | .verifying => + StackSoundAnchoredVerificationAllowed machine zeroWindow ∨ + AnchoredAcceptanceAllowed machine zeroWindow + | .accepting => + zeroWindow.2.2.2 = acceptingPhaseCell machine.tm + at hbranch + simpa only [hsourceZero] using hbranch + have hanchor : FirstBlockAnchored machine.tm (first 0) := by + rcases hbranches with hverify | hacceptZero + · have hverify' := hverify + simp only [StackSoundAnchoredVerificationAllowed, + AnchoredVerificationAllowed, decide_eq_true_eq] at hverify' + exact hverify'.1.2.1 + · have hacceptZero' := hacceptZero + simp only [AnchoredAcceptanceAllowed, decide_eq_true_eq] + at hacceptZero' + exact hacceptZero'.2 + have htyped := stackSoundValidTrace_all_verifier_rows_wellTyped + bound machine x trace hstack (Fin.castSucc time) hmode + have htrueHalt := trueOutputMachineHead_actualVerifierHalt + bound machine x certificate first hcertificate verifierRun + htyped hholes hmarked hanchor htrueFirst hcontrol + have htrueRun : FiniteRun (GuessStep bound machine x) + (.guessing []) + (.verifying certificate + (Turing.haltList machine.tm + (verifierOutput machine true))) time.val := by + rw [← htrueHalt.2] + exact run + refine ⟨time, position, certificate, ?_⟩ + dsimp + exact ⟨haccept, hmode, hmasks, hholes, hcertificate, + htrueFirst, htrueHalt.1, htrueHalt.2, + ⟨htrueRun⟩, hruntime, hprefix⟩ + +private def paddedAcceptanceValidTrace_guessingExecution + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) + (trace : AnchoredPhaseTrace bound machine x) + (htrace : ValidTrace + (paddedAcceptancePhaseSpecification bound machine x) trace) : + GuessingExecution bound machine x := by + classical + apply Classical.choice + obtain ⟨time, _, certificate, _, _, _, _, _, _, _, _, + ⟨run⟩, hruntime, _⟩ := + paddedAcceptanceValidTrace_firstAcceptance_trueHalt + bound machine x trace htrace + exact ⟨{ + certificate := certificate + steps := time.val + steps_le := hruntime + run := run + }⟩ + +private def paddedWitnessAnnotation (certificate : List Bool) + (elapsed : ℕ) : Bool := + if elapsed = 0 then false else + (certificate[elapsed - 1]?).getD false + +@[simp] private theorem paddedWitnessAnnotation_zero + (certificate : List Bool) : + paddedWitnessAnnotation certificate 0 = false := by + simp only [paddedWitnessAnnotation, ↓reduceIte] + +private theorem paddedWitnessAnnotation_succ + (certificate : List Bool) + (index : Fin certificate.length) : + paddedWitnessAnnotation certificate (index.val + 1) = + certificate.get index := by + simp only [paddedWitnessAnnotation, Nat.add_eq_zero_iff, one_ne_zero, and_false, ↓reduceIte, + add_tsub_cancel_right, Fin.is_lt, getElem?_pos, Option.getD_some, List.get_eq_getElem] + +private theorem acceptedExecution_acceptanceTransition_le_rowWidth + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) : + execution.certificate.length + 1 + execution.steps + 1 ≤ + rowWidth bound machine x := by + have hcertificate := execution.certificate_le + have hsteps := execution.steps_le + simp only [rowWidth, nondeterministicTableauDimensionPolynomial, + guessTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, Polynomial.eval_X, + Polynomial.eval_C, Polynomial.eval_one] + omega + +private def paddedAcceptedExecutionNaturalRow + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (elapsed : ℕ) : + Position (rowWidth bound machine x) → + CompletePhaseCell machine.tm := + if hguess : elapsed ≤ execution.certificate.length then + canonicalAnchoredGuessingRow bound machine x + (execution.certificate.take elapsed) + (paddedWitnessAnnotation execution.certificate elapsed) + else if hverify : + elapsed ≤ execution.certificate.length + 1 + execution.steps then + let index : Fin (execution.steps + 1) := + ⟨elapsed - (execution.certificate.length + 1), by omega⟩ + canonicalAnchoredVerifyingRow bound machine x + execution.certificate (execution.trace.configuration index) + (supported index) (hint index) false + else + fun _ => acceptingPhaseCell machine.tm + +private theorem paddedAcceptedExecutionNaturalRow_guessing + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (elapsed : ℕ) + (hguess : elapsed ≤ execution.certificate.length) : + paddedAcceptedExecutionNaturalRow + bound machine execution supported hint elapsed = + canonicalAnchoredGuessingRow bound machine x + (execution.certificate.take elapsed) + (paddedWitnessAnnotation execution.certificate elapsed) := by + simp only [paddedAcceptedExecutionNaturalRow, hguess, ↓reduceDIte] + +private theorem paddedAcceptedExecutionNaturalRow_verifying + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (index : Fin (execution.steps + 1)) : + paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + index.val) = + canonicalAnchoredVerifyingRow bound machine x + execution.certificate + (execution.trace.configuration index) + (supported index) (hint index) false := by + have hguess : + ¬ execution.certificate.length + 1 + index.val ≤ + execution.certificate.length := by + omega + have hverify : + execution.certificate.length + 1 + index.val ≤ + execution.certificate.length + 1 + execution.steps := by + have hindex := index.isLt + omega + have hdifference : + execution.certificate.length + 1 + index.val - + (execution.certificate.length + 1) = index.val := by + omega + have hindex : + (⟨execution.certificate.length + 1 + index.val - + (execution.certificate.length + 1), by omega⟩ : + Fin (execution.steps + 1)) = index := by + apply Fin.ext + exact hdifference + simp only [paddedAcceptedExecutionNaturalRow, + dite_eq_right hguess, dite_eq_left hverify] + rw [hindex] + +private theorem paddedAcceptedExecutionNaturalRow_accepting + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (elapsed : ℕ) + (haccept : + execution.certificate.length + 1 + execution.steps < elapsed) : + paddedAcceptedExecutionNaturalRow + bound machine execution supported hint elapsed = + fun _ => acceptingPhaseCell machine.tm := by + have hguess : ¬ elapsed ≤ execution.certificate.length := by + omega + have hverify : + ¬ elapsed ≤ + execution.certificate.length + 1 + execution.steps := by + omega + simp only [paddedAcceptedExecutionNaturalRow, hguess, ↓reduceDIte, hverify] + +private theorem canonicalAnchoredVerifyingRow_eq_of_configuration_eq + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x certificate : List Bool) + (first next : machine.tm.Cfg) + (hfirst : StackAtomSupported machine first) + (hnext : StackAtomSupported machine next) + (hint : FiniteVerifierHint machine.tm) + (annotation : Bool) + (hconfiguration : first = next) : + canonicalAnchoredVerifyingRow bound machine x certificate + first hfirst hint annotation = + canonicalAnchoredVerifyingRow bound machine x certificate + next hnext hint annotation := by + subst next + rfl + +private theorem acceptedExecution_has_paddedVerifierHints + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) : + ∃ hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm, + AllCanonicalAcceptanceAnchoredVerifierTraceWindows + bound machine x execution.certificate + execution.trace.configuration supported hint := by + apply (canonicalAcceptanceAnchoredVerifierTraceWindows_iff_actualRun + bound machine x execution.certificate + execution.trace.configuration supported + (acceptedExecution_stack_length_le_rowWidth + bound machine execution)).mpr + exact execution.trace.transition + +private theorem paddedAcceptedExecutionNaturalRow_guessingWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (time : Fin execution.certificate.length) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint time.val) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint (time.val + 1)) + position) := by + have hfirst : time.val ≤ execution.certificate.length := + Nat.le_of_lt time.isLt + have hnext : time.val + 1 ≤ execution.certificate.length := by + have htime := time.isLt + omega + rw [paddedAcceptedExecutionNaturalRow_guessing + bound machine execution supported hint time.val hfirst, + paddedAcceptedExecutionNaturalRow_guessing + bound machine execution supported hint + (time.val + 1) hnext, + paddedWitnessAnnotation_succ execution.certificate time] + have htake : + execution.certificate.take (time.val + 1) = + execution.certificate.take time.val ++ + [execution.certificate.get time] := by + exact List.take_succ_eq_append_getElem time.isLt + rw [htake] + have hlength : + (execution.certificate.take time.val).length = time.val := by + simp only [List.length_take, Fin.is_le', inf_of_le_left] + have hbound : + (execution.certificate.take time.val).length < + bound.eval x.length := by + rw [hlength] + exact time.isLt.trans_le execution.certificate_le + exact canonicalGuessingStep_paddedAcceptanceWindows + bound machine x (execution.certificate.take time.val) + (paddedWitnessAnnotation execution.certificate time.val) + (execution.certificate.get time) hbound position + +private theorem paddedAcceptedExecutionNaturalRow_initializationWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + execution.certificate.length) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1)) + position) := by + have hsource := paddedAcceptedExecutionNaturalRow_guessing + bound machine execution supported hint + execution.certificate.length (le_refl _) + have htarget : + paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1) = + canonicalAnchoredVerifyingRow bound machine x + execution.certificate + (execution.trace.configuration 0) + (supported 0) (hint 0) false := by + simpa only [Fin.coe_ofNat_eq_mod, Nat.zero_mod, add_zero] using + paddedAcceptedExecutionNaturalRow_verifying bound machine execution supported hint 0 + rw [hsource, htarget] + simp only [List.take_length] + have hinitialSupport : StackAtomSupported machine + (Turing.initList machine.tm + (verifierInput machine x execution.certificate)) := + initialConfiguration_stackAtomSupported machine x + execution.certificate + have hwindows := canonicalInitialization_paddedAcceptanceWindows + bound machine x execution.certificate hinitialSupport + (paddedWitnessAnnotation execution.certificate + execution.certificate.length) + (hint 0) position + have hrow := canonicalAnchoredVerifyingRow_eq_of_configuration_eq + bound machine x execution.certificate + (execution.trace.configuration 0) + (Turing.initList machine.tm + (verifierInput machine x execution.certificate)) + (supported 0) hinitialSupport (hint 0) false + execution.trace.initial + rw [hrow] + exact hwindows + +private theorem paddedAcceptedExecutionNaturalRow_verifierWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (hwindows : + AllCanonicalAcceptanceAnchoredVerifierTraceWindows + bound machine x execution.certificate + execution.trace.configuration supported hint) + (time : Fin execution.steps) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + time.val)) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + time.val + 1)) + position) := by + have hwindows' := hwindows + simp only [AllCanonicalAcceptanceAnchoredVerifierTraceWindows, + decide_eq_true_eq] at hwindows' + have hsource : + paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + time.val) = + canonicalAnchoredVerifyingRow bound machine x + execution.certificate + (execution.trace.configuration (Fin.castSucc time)) + (supported (Fin.castSucc time)) + (hint (Fin.castSucc time)) false := by + simpa only [Fin.val_castSucc] using + paddedAcceptedExecutionNaturalRow_verifying + bound machine execution supported hint (Fin.castSucc time) + have htarget : + paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + time.val + 1) = + canonicalAnchoredVerifyingRow bound machine x + execution.certificate + (execution.trace.configuration time.succ) + (supported time.succ) (hint time.succ) false := by + simpa only [Nat.add_assoc, Fin.val_succ] using + paddedAcceptedExecutionNaturalRow_verifying bound machine execution supported hint + time.succ + rw [hsource, htarget] + exact acceptanceAnchoredPhaseAllowed_implies_padded machine _ + (hwindows' time position) + +private theorem paddedAcceptedExecutionNaturalRow_trueHaltWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + execution.steps)) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + execution.steps + 1)) + position) := by + have hsource : + paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + execution.steps) = + canonicalAnchoredVerifyingRow bound machine x + execution.certificate + (execution.trace.configuration + (Fin.last execution.steps)) + (supported (Fin.last execution.steps)) + (hint (Fin.last execution.steps)) false := by + simpa only [Fin.val_last] using + paddedAcceptedExecutionNaturalRow_verifying bound machine execution supported hint + (Fin.last execution.steps) + have htarget : + paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (execution.certificate.length + 1 + execution.steps + 1) = + (fun _ => acceptingPhaseCell machine.tm) := by + apply paddedAcceptedExecutionNaturalRow_accepting + bound machine execution supported hint + omega + rw [hsource, htarget] + have hhaltSupported : StackAtomSupported machine + (Turing.haltList machine.tm + (verifierOutput machine true)) := by + rw [← execution.trace.final] + exact supported (Fin.last execution.steps) + have hwindows := canonicalTrueHalt_paddedAcceptanceWindows + bound machine x execution.certificate hhaltSupported + (hint (Fin.last execution.steps)) position + have hrow := canonicalAnchoredVerifyingRow_eq_of_configuration_eq + bound machine x execution.certificate + (execution.trace.configuration (Fin.last execution.steps)) + (Turing.haltList machine.tm + (verifierOutput machine true)) + (supported (Fin.last execution.steps)) + hhaltSupported (hint (Fin.last execution.steps)) false + execution.trace.final + rw [hrow] + exact hwindows + +private theorem paddedAcceptedExecutionNaturalRow_paddingWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (elapsed : ℕ) + (haccept : + execution.certificate.length + 1 + execution.steps < elapsed) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint elapsed) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint (elapsed + 1)) + position) := by + rw [paddedAcceptedExecutionNaturalRow_accepting + bound machine execution supported hint elapsed haccept, + paddedAcceptedExecutionNaturalRow_accepting + bound machine execution supported hint (elapsed + 1) + (by omega)] + exact paddedAcceptance_acceptingSelfWindow + machine (rowWidth bound machine x) position + +private theorem paddedAcceptedExecutionNaturalRow_allWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (hwindows : + AllCanonicalAcceptanceAnchoredVerifierTraceWindows + bound machine x execution.certificate + execution.trace.configuration supported hint) + (time : Fin (rowWidth bound machine x)) + (position : Position (rowWidth bound machine x)) : + PaddedAcceptancePhaseAllowed machine + (anchoredVerifierWindowAt machine.tm + (rowWidth bound machine x) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint time.val) + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint (time.val + 1)) + position) := by + by_cases hguess : time.val < execution.certificate.length + · exact paddedAcceptedExecutionNaturalRow_guessingWindows + bound machine execution supported hint + ⟨time.val, hguess⟩ position + by_cases hinitial : time.val = execution.certificate.length + · simpa only [hinitial] using + paddedAcceptedExecutionNaturalRow_initializationWindows + bound machine execution supported hint position + have hafter : execution.certificate.length + 1 ≤ time.val := by + omega + by_cases hverifier : + time.val < execution.certificate.length + 1 + execution.steps + · let index : Fin execution.steps := + ⟨time.val - (execution.certificate.length + 1), by omega⟩ + have htime : + time.val = + execution.certificate.length + 1 + index.val := by + dsimp [index] + omega + simpa only [htime] using + paddedAcceptedExecutionNaturalRow_verifierWindows + bound machine execution supported hint hwindows index position + by_cases hhalt : + time.val = execution.certificate.length + 1 + execution.steps + · simpa only [hhalt] using + paddedAcceptedExecutionNaturalRow_trueHaltWindows + bound machine execution supported hint position + have hpadding : + execution.certificate.length + 1 + execution.steps < + time.val := by + omega + exact paddedAcceptedExecutionNaturalRow_paddingWindows + bound machine execution supported hint time.val hpadding position + +private def paddedAcceptedExecutionTrace + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) : + AnchoredPhaseTrace bound machine x := + fun time position => + completePhaseSymbolEquiv machine.tm + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint time.val position) + +private theorem paddedAcceptedExecutionTrace_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) + (supported : ∀ time : Fin (execution.steps + 1), + StackAtomSupported machine + (execution.trace.configuration time)) + (hint : Fin (execution.steps + 1) → + FiniteVerifierHint machine.tm) + (hwindows : + AllCanonicalAcceptanceAnchoredVerifierTraceWindows + bound machine x execution.certificate + execution.trace.configuration supported hint) : + ValidTrace (paddedAcceptancePhaseSpecification bound machine x) + (paddedAcceptedExecutionTrace + bound machine execution supported hint) := by + simp only [ValidTrace, decide_eq_true_eq] + refine ⟨?_, ?_, ?_⟩ + · intro position + change + completePhaseSymbolEquiv machine.tm + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint 0 position) = + completePhaseSymbolEquiv machine.tm + (initialPhaseCell bound machine x position) + rw [paddedAcceptedExecutionNaturalRow_guessing + bound machine execution supported hint 0 (Nat.zero_le _)] + simp only [List.take_zero, paddedWitnessAnnotation_zero, canonicalAnchoredGuessingRow_initial] + · refine ⟨0, ?_⟩ + have hbudget := acceptedExecution_acceptanceTransition_le_rowWidth + bound machine execution + have hpadding : + execution.certificate.length + 1 + execution.steps < + rowWidth bound machine x := by + omega + change + completePhaseSymbolEquiv machine.tm + (paddedAcceptedExecutionNaturalRow + bound machine execution supported hint + (rowWidth bound machine x) 0) = + completePhaseSymbolEquiv machine.tm + (acceptingPhaseCell machine.tm) + rw [paddedAcceptedExecutionNaturalRow_accepting + bound machine execution supported hint + (rowWidth bound machine x) hpadding] + · intro window + change + paddedAcceptancePhaseAllowed machine + ((completePhaseSymbolEquiv machine.tm).symm + (paddedAcceptedExecutionTrace + bound machine execution supported hint + window.1.1 (leftPosition window)), + (completePhaseSymbolEquiv machine.tm).symm + (paddedAcceptedExecutionTrace + bound machine execution supported hint + window.1.1 window.1.2), + (completePhaseSymbolEquiv machine.tm).symm + (paddedAcceptedExecutionTrace + bound machine execution supported hint + window.1.1 (rightPosition window)), + (completePhaseSymbolEquiv machine.tm).symm + (paddedAcceptedExecutionTrace + bound machine execution supported hint + (nextTime window) window.1.2)) = true + simp only [paddedAcceptedExecutionTrace, + Equiv.symm_apply_apply] + apply (paddedAcceptancePhaseAllowed_iff machine _).mpr + let time : Fin (rowWidth bound machine x) := + ⟨window.1.1.val, by + have htime := window.2 + change + window.1.1.val + 1 < rowWidth bound machine x + 1 + at htime + omega⟩ + exact paddedAcceptedExecutionNaturalRow_allWindows + bound machine execution supported hint hwindows + time window.1.2 + +private theorem acceptedExecution_paddedAcceptance_validTrace + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {x : List Bool} + (execution : AcceptedExecution bound machine x) : + ∃ trace : AnchoredPhaseTrace bound machine x, + ValidTrace + (paddedAcceptancePhaseSpecification bound machine x) trace := by + let supported := configurationTrace_stackAtomSupported + machine x execution.certificate execution.trace + obtain ⟨hint, hwindows⟩ := + acceptedExecution_has_paddedVerifierHints + bound machine execution supported + exact ⟨paddedAcceptedExecutionTrace + bound machine execution supported hint, + paddedAcceptedExecutionTrace_valid + bound machine execution supported hint hwindows⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +def paddedAcceptanceLocalTableauCompiler + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + GapCVP.CLNondeterminism.LocalTableauCompiler + bound machine where + symbols := completePhaseSymbolCount machine.tm + specification := paddedAcceptancePhaseSpecification bound machine + encode x execution := by + obtain ⟨accepted⟩ := + guessingExecution_accepted bound machine execution + exact acceptedExecution_paddedAcceptance_validTrace + bound machine accepted + decode x trace htrace := + paddedAcceptanceValidTrace_guessingExecution + bound machine x trace htrace + +end CLPaddedAcceptanceCompiler + +namespace CLStructuralCNFVariableBounds + +open GapCVP.CL GapCVP.ThreeCNFReduction + +/-- GapCVP reduction support. -/ +def tableauFiniteVariableCodeBound (T S : ℕ) : ℕ := + ((T + S + 2) ^ 2 + 1) ^ 2 + +theorem tableauVariable_encode_lt + {T S : ℕ} (v : Variable T S) : + Encodable.encode v < tableauFiniteVariableCodeBound T S := by + rcases v with ⟨time, position, symbol⟩ + change Nat.pair time.val (Nat.pair position.val symbol.val) < + ((T + S + 2) ^ 2 + 1) ^ 2 + have hinner : Nat.pair position.val symbol.val < (T + S + 2) ^ 2 := by + calc + Nat.pair position.val symbol.val < + (max position.val symbol.val + 1) ^ 2 := + Nat.pair_lt_max_add_one_sq position.val symbol.val + _ ≤ (T + S + 2) ^ 2 := by + apply Nat.pow_le_pow_left + have hposition := position.isLt + have hsymbol := symbol.isLt + omega + have htime : time.val ≤ (T + S + 2) ^ 2 := by + have hfirst : time.val ≤ T + S + 2 := by + have hactual := time.isLt + omega + calc + time.val ≤ T + S + 2 := hfirst + _ ≤ (T + S + 2) ^ 2 := by + rw [pow_two] + exact Nat.le_mul_self (T + S + 2) + calc + Nat.pair time.val (Nat.pair position.val symbol.val) < + (max time.val (Nat.pair position.val symbol.val) + 1) ^ 2 := + Nat.pair_lt_max_add_one_sq time.val + (Nat.pair position.val symbol.val) + _ ≤ ((T + S + 2) ^ 2 + 1) ^ 2 := by + apply Nat.pow_le_pow_left + omega + +theorem sourceVariable_lt_tableauFiniteBound + {T S : ℕ} (v : Variable T S) : + sourceVariable v < 4 * tableauFiniteVariableCodeBound T S := by + have hcode := tableauVariable_encode_lt v + unfold sourceVariable + omega + +end CLStructuralCNFVariableBounds + +namespace CLStructuralPrefixWriter + +open Turing GapCVP.BinaryEncoding + +private def prefixWriterPeek (stack : Fin 4) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def prefixWriterPop (stack : Fin 4) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool) := + .pop stack (fun symbol _ => symbol) continuation + +private def prefixWriterPushBit (stack : Fin 4) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool) := + .push stack (fun symbol => symbol.getD false) continuation + +private def prefixWriterPushMarker (stack : Fin 4) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool) := + .push stack (fun _ => true) continuation + +private def prefixWriterGoto (phase : Fin 3) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +private def prefixWriterScanStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool) := + prefixWriterPeek 0 + (prefixWriterPop 0 + (prefixWriterPushBit 1 + (prefixWriterPushMarker 2 (prefixWriterGoto 0)))) + (prefixWriterGoto 1) + +private def prefixWriterRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool) := + prefixWriterPeek 1 + (prefixWriterPop 1 + (prefixWriterPushBit 3 (prefixWriterGoto 1))) + (.push 3 (fun _ => false) (prefixWriterGoto 2)) + +private def prefixWriterMarkerStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 3) (Option Bool) := + prefixWriterPeek 2 + (prefixWriterPop 2 + (prefixWriterPushMarker 3 (prefixWriterGoto 2))) + .halt + +private abbrev structuralPrefixWriter : Turing.FinTM2 where + K := Fin 4 + k₀ := 0 + k₁ := 3 + Γ _ := Bool + Λ := Fin 3 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 3) then + prefixWriterScanStatement + else if phase = (1 : Fin 3) then + prefixWriterRestoreStatement + else + prefixWriterMarkerStatement + +private def prefixWriterConfiguration (phase : Fin 3) + (input scratch markers output : List Bool) : + structuralPrefixWriter.Cfg where + l := some phase + var := none + stk := ![input, scratch, markers, output] + +private theorem structuralPrefixWriter_init (input : List Bool) : + Turing.initList structuralPrefixWriter input = + prefixWriterConfiguration 0 input [] [] [] := by + simp only [structuralPrefixWriter, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + prefixWriterConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `prefixWriterStepTac` machine-step simplifier. -/ +macro "prefixWriterStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [structuralPrefixWriter, prefixWriterConfiguration, + prefixWriterPeek, prefixWriterPop, prefixWriterPushBit, + prefixWriterPushMarker, prefixWriterGoto, + prefixWriterScanStatement, prefixWriterRestoreStatement, + prefixWriterMarkerStatement, Turing.haltList, + Turing.FinTM2.step, Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem prefixWriter_scan_step (bit : Bool) + (input scratch markers output : List Bool) : + structuralPrefixWriter.step + (prefixWriterConfiguration 0 + (bit :: input) scratch markers output) = + some (prefixWriterConfiguration 0 + input (bit :: scratch) (true :: markers) output) := by + cases bit <;> prefixWriterStepTac + +private theorem prefixWriter_scan_finish + (scratch markers output : List Bool) : + structuralPrefixWriter.step + (prefixWriterConfiguration 0 [] scratch markers output) = + some (prefixWriterConfiguration 1 [] scratch markers output) := by + prefixWriterStepTac + +private theorem prefixWriter_restore_step (bit : Bool) + (scratch markers output : List Bool) : + structuralPrefixWriter.step + (prefixWriterConfiguration 1 [] + (bit :: scratch) markers output) = + some (prefixWriterConfiguration 1 [] + scratch markers (bit :: output)) := by + cases bit <;> prefixWriterStepTac + +private theorem prefixWriter_restore_finish + (markers output : List Bool) : + structuralPrefixWriter.step + (prefixWriterConfiguration 1 [] [] markers output) = + some (prefixWriterConfiguration 2 [] [] markers + (false :: output)) := by + prefixWriterStepTac + +private theorem prefixWriter_marker_step (bit : Bool) + (markers output : List Bool) : + structuralPrefixWriter.step + (prefixWriterConfiguration 2 [] [] (bit :: markers) output) = + some (prefixWriterConfiguration 2 [] [] markers + (true :: output)) := by + cases bit <;> prefixWriterStepTac + +private theorem prefixWriter_finish (output : List Bool) : + structuralPrefixWriter.step + (prefixWriterConfiguration 2 [] [] [] output) = + some (Turing.haltList structuralPrefixWriter output) := by + prefixWriterStepTac + +private def prefixWriter_scanTrace + (input scratch markers output : List Bool) : + EvalsToInTime structuralPrefixWriter.step + (prefixWriterConfiguration 0 input scratch markers output) + (some (prefixWriterConfiguration 1 [] + (input.reverse ++ scratch) + (List.replicate input.length true ++ markers) output)) + (input.length + 1) := by + induction input generalizing scratch markers with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + List.replicate_zero, + zero_add] using oneStep _ _ (prefixWriter_scan_finish scratch markers output) + | cons bit input ih => + have hfirst := oneStep _ _ (prefixWriter_scan_step bit input scratch markers output) + have hrest := ih (bit :: scratch) (true :: markers) + have hfull := EvalsToInTime.trans structuralPrefixWriter.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, List.replicate_succ', Nat.add_assoc, Nat.reduceAdd] using hfull + +private def prefixWriter_restoreTrace + (scratch markers output : List Bool) : + EvalsToInTime structuralPrefixWriter.step + (prefixWriterConfiguration 1 [] scratch markers output) + (some (prefixWriterConfiguration 2 [] [] markers + (false :: (scratch.reverse ++ output)))) + (scratch.length + 1) := by + induction scratch generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (prefixWriter_restore_finish markers output) + | cons bit scratch ih => + have hfirst := oneStep _ _ (prefixWriter_restore_step bit scratch markers output) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans structuralPrefixWriter.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def prefixWriter_markerTrace (markers output : List Bool) : + EvalsToInTime structuralPrefixWriter.step (prefixWriterConfiguration 2 [] [] markers output) + (some (Turing.haltList structuralPrefixWriter + (List.replicate markers.length true ++ output))) + (markers.length + 1) := by + induction markers generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + zero_add] using + oneStep _ _ (prefixWriter_finish output) + | cons bit markers ih => + have hfirst := oneStep _ _ (prefixWriter_marker_step bit markers output) + have hrest := ih (true :: output) + have hfull := EvalsToInTime.trans structuralPrefixWriter.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ', + List.append_assoc, + List.cons_append, List.nil_append, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def prefixWriter_totalTrace (input : List Bool) : + EvalsToInTime structuralPrefixWriter.step (prefixWriterConfiguration 0 input [] [] []) + (some (Turing.haltList structuralPrefixWriter + (lengthPrefixedWord input))) + (3 * input.length + 3) := by + have hscan := prefixWriter_scanTrace input [] [] [] + simp only [List.append_nil] at hscan + have hrestore := prefixWriter_restoreTrace + input.reverse (List.replicate input.length true) [] + simp only [List.reverse_reverse, List.append_nil] at hrestore + have hmarkers := prefixWriter_markerTrace + (List.replicate input.length true) (false :: input) + simp only [List.length_replicate] at hmarkers + have hfirst := EvalsToInTime.trans structuralPrefixWriter.step _ _ _ _ _ hscan hrestore + have hfull := EvalsToInTime.trans structuralPrefixWriter.step _ _ _ _ _ hfirst hmarkers + have hbounded := rebound (newBudget := 3 * input.length + 3) hfull (by + simp only [List.length_reverse] + omega) + simpa only [FinTM2.step, Fin.isValue, lengthPrefixedWord] using hbounded + +/-- GapCVP reduction support. -/ +noncomputable def structuralPrefixWriterComputable : + Turing.TM2ComputableInPolyTime GapCVP.bitEncoding + GapCVP.bitEncoding + (fun input : List Bool => lengthPrefixedWord input) where + tm := structuralPrefixWriter + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 3 * Polynomial.X + 3 + outputsFun input := { + steps := (prefixWriter_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, structuralPrefixWriter_init, + Option.map_some] using + (prefixWriter_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (prefixWriter_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +end CLStructuralPrefixWriter + +namespace SourceMachineCert + +open Turing + +private def prependBitMachine (bit : Bool) : Turing.FinTM2 where + K := Unit + k₀ := () + k₁ := () + Γ _ := Bool + Λ := Unit + main := () + σ := Unit + initialState := () + m _ := .push () (fun _ => bit) .halt + +/-- GapCVP reduction support. -/ +noncomputable def prependBitComputable (bit : Bool) : + BitTM + (fun input : List Bool => bit :: input) where + tm := prependBitMachine bit + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 1 + outputsFun input := { + steps := 1 + evals_in_steps := by + simp only [prependBitMachine, Option.bind_eq_bind, FinTM2.step, initList, ↓reduceDIte, + Equiv.invFun_as_coe, + Equiv.refl_symm, Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, eq_mpr_eq_cast, + cast_eq, Function.iterate_one, + flip, List.map_cons, Option.map_some, haltList] + congr 2 + steps_le_m := by simp only [id_eq, Polynomial.eval_one, Std.le_refl] + } + +/-- GapCVP reduction support. -/ +noncomputable def prependWordComputable (word : List Bool) : + BitTM + (fun input : List Bool => word ++ input) := by + induction word with + | nil => + exact Turing.idComputableInPolyTime bitEncoding + | cons bit rest ih => + change BitTM + ((fun input : List Bool => bit :: input) ∘ + (fun input : List Bool => rest ++ input)) + exact TMComposition.computableInPolyTime ih + (prependBitComputable bit) + +/-- GapCVP reduction support. -/ +def formulaVariables (formula : ThreeCNF) : List ℕ := + formula.flatMap fun clause => + [(clause 0).1, (clause 1).1, (clause 2).1] + +@[simp] theorem formulaVariables_length (formula : ThreeCNF) : + (formulaVariables formula).length = 3 * formula.length := by + induction formula with + | nil => simp only [formulaVariables, Fin.isValue, List.flatMap_nil, List.length_nil, mul_zero] + | cons clause rest ih => + simp only [formulaVariables, Fin.isValue, List.flatMap_cons, List.cons_append, + List.nil_append, + List.length_cons, List.length_flatMap, List.length_nil, zero_add, Nat.reduceAdd, + List.map_const', + List.sum_replicate, smul_eq_mul] + omega + +theorem mem_formulaVariables + (formula : ThreeCNF) (clause : ThreeClause) + (hclause : clause ∈ formula) (i : Fin 3) : + (clause i).1 ∈ formulaVariables formula := by + unfold formulaVariables + apply List.mem_flatMap.mpr + refine ⟨clause, hclause, ?_⟩ + fin_cases i <;> simp + +/-- GapCVP reduction support. -/ +def variableRank (formula : ThreeCNF) (index : ℕ) : ℕ := + (formulaVariables formula).idxOf index + +end SourceMachineCert + +namespace SourceMachineRouting + +open SourceMachineCert + +/-- GapCVP reduction support. -/ +def canonicalYesInstance : GapCVPInstance where + dimension := 1 + basis := Matrix.of fun _ _ => 1 + target _ := 0 + radius := 1 + +theorem canonicalYesInstance_wellFormed : + gapCVPWellFormed canonicalYesInstance := by + simp only [GapCVP.gapCVPWellFormed, decide_eq_true_eq] + refine ⟨by decide, ?_, by norm_num [canonicalYesInstance]⟩ + unfold canonicalYesInstance + change (Matrix.of (fun _ _ : Fin 1 => (1 : ℤ))).det ≠ 0 + rw [Matrix.det_fin_one] + norm_num + +theorem canonicalYesInstance_gapYES : gapYES canonicalYesInstance := by + simp only [GapCVP.gapYES, decide_eq_true_eq] + refine ⟨canonicalYesInstance_wellFormed, ?_⟩ + refine ⟨fun _ => 0, ?_⟩ + have hdistance : + distanceSquared canonicalYesInstance (fun _ => 0) = 0 := by + simp only [distanceSquared, canonicalYesInstance, + Int.cast_zero, mul_zero, Finset.sum_const_zero, Rat.cast_zero, sub_self, + ne_eq, OfNat.ofNat_ne_zero, + not_false_eq_true, zero_pow] + rw [hdistance] + norm_num [canonicalYesInstance] + +/-- GapCVP reduction support. -/ +def canonicalYesWord : List Bool := + BinaryEncoding.encodeGapCVPInstance canonicalYesInstance + +end SourceMachineRouting + +namespace SourceUniformTuringTM + +open Turing + +private abbrev eraseMachine : Turing.FinTM2 where + K := Unit + k₀ := () + k₁ := () + Γ _ := Bool + Λ := Unit + main := () + σ := Bool + initialState := false + m _ := + .peek () (fun _ symbol => symbol.isSome) + (.branch (fun hasSymbol => hasSymbol) + (.pop () (fun _ _ => false) (.goto (fun _ => ()))) + .halt) + +private theorem eraseMachine_step_cons + (bit : Bool) (rest : List Bool) : + eraseMachine.step (Turing.initList eraseMachine (bit :: rest)) = + some (Turing.initList eraseMachine rest) := by + compactMachineStepTac [eraseMachine, Turing.initList] + +private theorem eraseMachine_step_nil : + eraseMachine.step (Turing.initList eraseMachine []) = + some (Turing.haltList eraseMachine []) := by + compactMachineStepTac [eraseMachine, Turing.initList] + +private theorem eraseMachine_iterate (input : List Bool) : + ((flip Option.bind eraseMachine.step)^[input.length + 1]) + (some (Turing.initList eraseMachine input)) = + some (Turing.haltList eraseMachine []) := by + induction input with + | nil => + change eraseMachine.step (Turing.initList eraseMachine []) = + some (Turing.haltList eraseMachine []) + exact eraseMachine_step_nil + | cons bit rest ih => + change + ((flip Option.bind eraseMachine.step)^[rest.length + 1 + 1]) + (some (Turing.initList eraseMachine (bit :: rest))) = + some (Turing.haltList eraseMachine []) + rw [Function.iterate_succ_apply] + change + ((flip Option.bind eraseMachine.step)^[rest.length + 1]) + (eraseMachine.step + (Turing.initList eraseMachine (bit :: rest))) = + some (Turing.haltList eraseMachine []) + rw [eraseMachine_step_cons] + exact ih + +private noncomputable def eraseComputable : + BitTM + (fun _ : List Bool => []) where + tm := eraseMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := Polynomial.X + 1 + outputsFun input := { + steps := input.length + 1 + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Equiv.invFun_as_coe, Equiv.refl_symm, + Equiv.coe_refl, + bitEncoding, id_eq, List.map_id_fun, Function.iterate_succ, Function.comp_apply, + List.map_nil, + Option.map_some] using eraseMachine_iterate input + steps_le_m := by + simp only [bitEncoding, id_eq, Polynomial.eval_add, Polynomial.eval_X, Polynomial.eval_one, + Std.le_refl] + } + +/-- GapCVP reduction support. -/ +noncomputable def constantWordComputable (word : List Bool) : + BitTM + (fun _ : List Bool => word) := by + have machine := TMComposition.computableInPolyTime eraseComputable + (SourceMachineCert.prependWordComputable word) + have hmap : + ((fun input : List Bool => word ++ input) ∘ + (fun _ : List Bool => [])) = + (fun _ : List Bool => word) := by + funext input + simp only [Function.comp_apply, List.append_nil] + rw [hmap] at machine + exact machine + +end SourceUniformTuringTM + +namespace SourceStructuralTuringTM + +open Turing + +private abbrev unaryPrefixMachine : Turing.FinTM2 where + K := Bool + k₀ := false + k₁ := true + Γ _ := Bool + Λ := Bool + main := true + σ := Option Bool + initialState := none + m phase := + if phase then + .peek false (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.pop false (fun _ _ => none) + (.push true (fun _ => true) + (.goto (fun _ => true)))) + (.branch (fun symbol => symbol.isSome) + (.pop false (fun _ _ => none) + (.goto (fun _ => false))) + (.push true (fun _ => false) .halt))) + else + .peek false (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop false (fun _ _ => none) + (.goto (fun _ => false))) + (.push true (fun _ => true) .halt)) + +private def unaryConfiguration + (phase : Bool) (input : List Bool) (count : ℕ) : + unaryPrefixMachine.Cfg where + l := some phase + var := none + stk + | false => input + | true => List.replicate count true + +private theorem unaryPrefixMachine_step_true + (input : List Bool) (count : ℕ) : + unaryPrefixMachine.step + (unaryConfiguration true (true :: input) count) = + some (unaryConfiguration true input (count + 1)) := by + simp only [unaryPrefixMachine, FinTM2.step, TM2.step, unaryConfiguration, ↓reduceIte, + TM2.stepAux, + List.head?_cons, BEq.rfl, List.tail_cons, ne_eq, Bool.true_eq_false, not_false_eq_true, + Function.update_of_ne, + Option.isSome_some, Bool.cond_true] + congr 2 + funext stack + cases stack <;> simp [Function.update, List.replicate_succ] + +private theorem unaryPrefixMachine_step_false + (input : List Bool) (count : ℕ) : + unaryPrefixMachine.step + (unaryConfiguration true (false :: input) count) = + some (unaryConfiguration false input count) := by + simp only [unaryPrefixMachine, FinTM2.step, TM2.step, unaryConfiguration, ↓reduceIte, + TM2.stepAux, + List.head?_cons, Option.some_beq_some, beq_true, List.tail_cons, ne_eq, Bool.true_eq_false, + not_false_eq_true, + Function.update_of_ne, Option.isSome_some, Bool.cond_true, Bool.cond_false] + congr 2 + funext stack + cases stack <;> simp [Function.update] + +private theorem unaryPrefixMachine_drain_step + (bit : Bool) (input : List Bool) (count : ℕ) : + unaryPrefixMachine.step + (unaryConfiguration false (bit :: input) count) = + some (unaryConfiguration false input count) := by + cases bit <;> + compactMachineStepTac [unaryPrefixMachine, unaryConfiguration] + +private theorem unaryPrefixMachine_finish_prefix (count : ℕ) : + unaryPrefixMachine.step (unaryConfiguration true [] count) = + some (Turing.haltList unaryPrefixMachine + (false :: List.replicate count true)) := by + simp only [unaryPrefixMachine, FinTM2.step, TM2.step, unaryConfiguration, ↓reduceIte, + TM2.stepAux, + List.head?_nil, Option.none_beq_some, List.tail_nil, Function.update_eq_self, ne_eq, + Bool.true_eq_false, + not_false_eq_true, Function.update_of_ne, Option.isSome_none, Bool.cond_false, haltList, + eq_mpr_eq_cast, cast_eq, + dite_eq_ite] + congr 2 + funext stack + cases stack <;> simp [Function.update] + +private theorem unaryPrefixMachine_finish_drain (count : ℕ) : + unaryPrefixMachine.step (unaryConfiguration false [] count) = + some (Turing.haltList unaryPrefixMachine + (true :: List.replicate count true)) := by + simp only [unaryPrefixMachine, FinTM2.step, TM2.step, unaryConfiguration, Bool.false_eq_true, + ↓reduceIte, + TM2.stepAux, List.head?_nil, Option.isSome_none, List.tail_nil, Function.update_eq_self, + Bool.cond_false, haltList, + eq_mpr_eq_cast, cast_eq, dite_eq_ite] + congr 2 + funext stack + cases stack <;> simp [Function.update] + +/-- GapCVP reduction support. -/ +def unaryPrefixLength : List Bool → ℕ + | [] => 0 + | false :: _ => 0 + | true :: rest => unaryPrefixLength rest + 1 + +/-- GapCVP reduction support. -/ +def unaryPrefixHasDelimiter : List Bool → Bool + | [] => false + | false :: _ => true + | true :: rest => unaryPrefixHasDelimiter rest + +/-- GapCVP reduction support. -/ +def unaryPrefixOutput (input : List Bool) : List Bool := + unaryPrefixHasDelimiter input :: + List.replicate (unaryPrefixLength input) true + +private theorem unaryPrefixMachine_drain_iterate + (input : List Bool) (count : ℕ) : + ((flip Option.bind unaryPrefixMachine.step)^[input.length + 1]) + (some (unaryConfiguration false input count)) = + some (Turing.haltList unaryPrefixMachine + (true :: List.replicate count true)) := by + induction input with + | nil => + change unaryPrefixMachine.step + (unaryConfiguration false [] count) = _ + exact unaryPrefixMachine_finish_drain count + | cons bit rest ih => + change + ((flip Option.bind unaryPrefixMachine.step)^[rest.length + 1 + 1]) + (some (unaryConfiguration false (bit :: rest) count)) = _ + rw [Function.iterate_succ_apply] + change + ((flip Option.bind unaryPrefixMachine.step)^[rest.length + 1]) + (unaryPrefixMachine.step + (unaryConfiguration false (bit :: rest) count)) = _ + rw [unaryPrefixMachine_drain_step] + exact ih + +private theorem unaryPrefixMachine_prefix_iterate + (input : List Bool) (count : ℕ) : + ((flip Option.bind unaryPrefixMachine.step)^[input.length + 1]) + (some (unaryConfiguration true input count)) = + some (Turing.haltList unaryPrefixMachine + (unaryPrefixHasDelimiter input :: + List.replicate (unaryPrefixLength input + count) true)) := by + induction input generalizing count with + | nil => + change unaryPrefixMachine.step + (unaryConfiguration true [] count) = _ + simpa only [FinTM2.step, unaryPrefixHasDelimiter, unaryPrefixLength, zero_add] using + unaryPrefixMachine_finish_prefix count + | cons bit rest ih => + cases bit with + | false => + change + ((flip Option.bind unaryPrefixMachine.step)^[rest.length + 1 + 1]) + (some (unaryConfiguration true (false :: rest) count)) = _ + rw [Function.iterate_succ_apply] + change + ((flip Option.bind unaryPrefixMachine.step)^[rest.length + 1]) + (unaryPrefixMachine.step + (unaryConfiguration true (false :: rest) count)) = _ + rw [unaryPrefixMachine_step_false] + simpa only [FinTM2.step, Function.iterate_succ, Function.comp_apply, + unaryPrefixHasDelimiter, + unaryPrefixLength, zero_add] using unaryPrefixMachine_drain_iterate rest count + | true => + change + ((flip Option.bind unaryPrefixMachine.step)^[rest.length + 1 + 1]) + (some (unaryConfiguration true (true :: rest) count)) = _ + rw [Function.iterate_succ_apply] + change + ((flip Option.bind unaryPrefixMachine.step)^[rest.length + 1]) + (unaryPrefixMachine.step + (unaryConfiguration true (true :: rest) count)) = _ + rw [unaryPrefixMachine_step_true] + simpa only [FinTM2.step, Function.iterate_succ, Function.comp_apply, + unaryPrefixHasDelimiter, + unaryPrefixLength, Nat.add_comm, Nat.add_assoc] using ih (count + 1) + +private theorem unaryPrefixMachine_init (input : List Bool) : + Turing.initList unaryPrefixMachine input = + unaryConfiguration true input 0 := by + simp only [unaryPrefixMachine, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + unaryConfiguration, + List.replicate_zero] + congr 1 + funext stack + cases stack <;> simp + +/-- GapCVP reduction support. -/ +noncomputable def unaryPrefixComputable : + BitTM + unaryPrefixOutput where + tm := unaryPrefixMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := Polynomial.X + 1 + outputsFun input := { + steps := input.length + 1 + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Equiv.invFun_as_coe, Equiv.refl_symm, + Equiv.coe_refl, + bitEncoding, id_eq, List.map_id_fun, unaryPrefixMachine_init, Function.iterate_succ, + Function.comp_apply, + unaryPrefixOutput, List.map_cons, List.map_replicate, Option.map_some, add_zero] using + unaryPrefixMachine_prefix_iterate input 0 + steps_le_m := by + simp only [bitEncoding, id_eq, Polynomial.eval_add, Polynomial.eval_X, Polynomial.eval_one, + Std.le_refl] + } + +@[simp] private theorem unaryPrefixLength_replicate_delimiter + (count : ℕ) (suffix : List Bool) : + unaryPrefixLength + (List.replicate count true ++ false :: suffix) = count := by + induction count with + | zero => simp only [List.replicate_zero, List.nil_append, unaryPrefixLength] + | succ count ih => + simp only [List.replicate_succ, List.cons_append, unaryPrefixLength, ih] + +@[simp] private theorem unaryPrefixHasDelimiter_replicate_delimiter + (count : ℕ) (suffix : List Bool) : + unaryPrefixHasDelimiter + (List.replicate count true ++ false :: suffix) = true := by + induction count with + | zero => simp only [List.replicate_zero, List.nil_append, unaryPrefixHasDelimiter] + | succ count ih => + simp only [List.replicate_succ, List.cons_append, unaryPrefixHasDelimiter, ih] + +@[simp] theorem unaryPrefixOutput_replicate_delimiter + (count : ℕ) (suffix : List Bool) : + unaryPrefixOutput + (List.replicate count true ++ false :: suffix) = + true :: List.replicate count true := by + simp only [unaryPrefixOutput, unaryPrefixHasDelimiter_replicate_delimiter, + unaryPrefixLength_replicate_delimiter] + +end SourceStructuralTuringTM + +namespace SourceStructuralDecoder + +open Turing + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev payloadDecoderMachine : Turing.FinTM2 where + K := Fin 4 + k₀ := 0 + k₁ := 3 + Γ _ := Bool + Λ := Fin 5 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 5) then + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.pop 0 (fun _ _ => none) + (.push 1 (fun _ => true) + (.goto (fun _ => 0)))) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) + (.goto (fun _ => 1))) + (.goto (fun _ => 4)))) + else if phase = (1 : Fin 5) then + .peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun state _ => state) + (.pop 0 (fun state _ => state) + (.push 2 (fun state => state.getD false) + (.load (fun _ => none) (.goto (fun _ => 1)))))) + (.goto (fun _ => 4)))) + (.goto (fun _ => 2))) + else if phase = (2 : Fin 5) then + .peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 2 (fun state _ => state) + (.push 3 (fun state => state.getD false) + (.load (fun _ => none) (.goto (fun _ => 2))))) + (.goto (fun _ => 3))) + else if phase = (3 : Fin 5) then + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) (.goto (fun _ => 3))) + (.push 3 (fun _ => true) .halt)) + else + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) (.goto (fun _ => 4))) + (.peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun _ _ => none) (.goto (fun _ => 4))) + (.peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 2 (fun _ _ => none) (.goto (fun _ => 4))) + (.push 3 (fun _ => false) .halt)))))) + +/-- Internal support shared across GapCVP continuation modules. -/ +def payloadConfiguration + (phase : Fin 5) + (input counter reversed output : List Bool) : + payloadDecoderMachine.Cfg where + l := some phase + var := none + stk := ![input, counter, reversed, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_prefix_true + (input counter reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 0 (true :: input) counter reversed output) = + some (payloadConfiguration 0 input (true :: counter) + reversed output) := by + compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +private theorem payload_prefix_delimiter + (input counter reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 0 (false :: input) counter reversed output) = + some (payloadConfiguration 1 input counter reversed output) := by + compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_prefix_missing_delimiter + (counter reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 0 [] counter reversed output) = + some (payloadConfiguration 4 [] counter reversed output) := by + compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_copy_step + (bit : Bool) (input counter reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 1 (bit :: input) + (true :: counter) reversed output) = + some (payloadConfiguration 1 input counter + (bit :: reversed) output) := by + cases bit <;> compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_insufficient + (counter reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 1 [] (true :: counter) reversed output) = + some (payloadConfiguration 4 [] + (true :: counter) reversed output) := by + compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_counter_complete + (input reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 1 input [] reversed output) = + some (payloadConfiguration 2 input [] reversed output) := by + compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +private theorem payload_reverse_step + (bit : Bool) (input reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 2 input [] (bit :: reversed) output) = + some (payloadConfiguration 2 input [] reversed (bit :: output)) := by + cases bit <;> compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_reverse_complete + (input output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 2 input [] [] output) = + some (payloadConfiguration 3 input [] [] output) := by + compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +private theorem payload_drain_step + (bit : Bool) (input output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 3 (bit :: input) [] [] output) = + some (payloadConfiguration 3 input [] [] output) := by + cases bit <;> compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +private theorem payload_drain_finish + (output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 3 [] [] [] output) = + some (Turing.haltList payloadDecoderMachine (true :: output)) := by + compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_failure_drop_input + (bit : Bool) (input counter reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 4 (bit :: input) counter reversed output) = + some (payloadConfiguration 4 input counter reversed output) := by + cases bit <;> compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_failure_drop_counter + (bit : Bool) (counter reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 4 [] (bit :: counter) reversed output) = + some (payloadConfiguration 4 [] counter reversed output) := by + cases bit <;> compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_failure_drop_reversed + (bit : Bool) (reversed output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 4 [] [] (bit :: reversed) output) = + some (payloadConfiguration 4 [] [] reversed output) := by + cases bit <;> compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payload_failure_finish + (output : List Bool) : + payloadDecoderMachine.step + (payloadConfiguration 4 [] [] [] output) = + some (Turing.haltList payloadDecoderMachine (false :: output)) := by + compactMachineStepTac [payloadDecoderMachine, payloadConfiguration] + +@[simp] theorem replicate_true_append_cons + (count : ℕ) (tail : List Bool) : + List.replicate count true ++ true :: tail = + true :: (List.replicate count true ++ tail) := by + induction count with + | zero => rfl + | succ count ih => + simp only [List.replicate_succ, List.cons_append, ih] + +/-- Internal support shared across GapCVP continuation modules. -/ +def payloadPrefixTrace + (count : ℕ) (tail counter reversed output : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 0 + (List.replicate count true ++ false :: tail) + counter reversed output) + (some (payloadConfiguration 1 tail + (List.replicate count true ++ counter) reversed output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (payload_prefix_delimiter tail counter reversed output) + | succ count ih => + have hfirst := oneStep _ _ (payload_prefix_true + (List.replicate count true ++ false :: tail) + counter reversed output) + have hrest := ih (true :: counter) + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 (count + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_true_append_cons] using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +def payloadCopyTrace + (payload suffix reversed output : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 1 (payload ++ suffix) + (List.replicate payload.length true) reversed output) + (some (payloadConfiguration 1 suffix [] + (payload.reverse ++ reversed) output)) + payload.length := by + induction payload generalizing reversed with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil] using + EvalsToInTime.refl payloadDecoderMachine.step (payloadConfiguration 1 suffix [] reversed + output) + | cons bit payload ih => + have hfirst := oneStep _ _ (payload_copy_step bit (payload ++ suffix) + (List.replicate payload.length true) reversed output) + have hrest := ih (bit :: reversed) + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 payload.length + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append] using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +def payloadReverseTrace + (input reversed output : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 2 input [] reversed output) + (some (payloadConfiguration 2 input [] [] + (reversed.reverse ++ output))) + reversed.length := by + induction reversed generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil] + using + EvalsToInTime.refl payloadDecoderMachine.step (payloadConfiguration 2 input [] [] output) + | cons bit reversed ih => + have hfirst := oneStep _ _ (payload_reverse_step bit input reversed output) + have hrest := ih (bit :: output) + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 reversed.length + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons] using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +def payloadDrainTrace + (suffix output : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 3 suffix [] [] output) + (some (Turing.haltList payloadDecoderMachine (true :: output))) + (suffix.length + 1) := by + induction suffix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (payload_drain_finish output) + | cons bit suffix ih => + have hfirst := oneStep _ _ (payload_drain_step bit suffix output) + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 (suffix.length + 1) + _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem payloadDecoderMachine_init (input : List Bool) : + Turing.initList payloadDecoderMachine input = + payloadConfiguration 0 input [] [] [] := by + simp only [payloadDecoderMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + payloadConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +end SourceStructuralDecoder + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part03B.lean b/LeanPool/GapCVP/Part03B.lean new file mode 100644 index 000000000..284026bcb --- /dev/null +++ b/LeanPool/GapCVP/Part03B.lean @@ -0,0 +1,701 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part03A + +/-! # GapCVP proof, part 03, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceStructuralDecoder + +open Turing + +private def payload_validTrace + (payload suffix : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 0 + (BinaryEncoding.lengthPrefixedWord payload ++ suffix) + [] [] []) + (some (Turing.haltList payloadDecoderMachine + (true :: payload))) + (3 * payload.length + suffix.length + 4) := by + have hprefix : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 0 + (BinaryEncoding.lengthPrefixedWord payload ++ suffix) + [] [] []) + (some (payloadConfiguration 1 (payload ++ suffix) + (List.replicate payload.length true) [] [])) + (payload.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, BinaryEncoding.lengthPrefixedWord, List.append_assoc, + List.cons_append, + List.append_nil] using payloadPrefixTrace payload.length (payload ++ suffix) [] [] [] + have hcopy : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 1 (payload ++ suffix) + (List.replicate payload.length true) [] []) + (some (payloadConfiguration 1 suffix [] payload.reverse [])) + payload.length := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using payloadCopyTrace payload suffix + [] [] + have hcounter := oneStep _ _ (payload_counter_complete suffix payload.reverse []) + have hreverse : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 2 suffix [] payload.reverse + []) + (some (payloadConfiguration 2 suffix [] [] payload)) + payload.length := by + simpa only [FinTM2.step, Fin.isValue, List.reverse_reverse, List.append_nil, + List.length_reverse] using + payloadReverseTrace suffix payload.reverse [] + have hreverseDone := oneStep _ _ (payload_reverse_complete suffix payload) + have hdrain := payloadDrainTrace suffix payload + have h01 := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ hprefix hcopy + have h012 := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ h01 hcounter + have h0123 := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ h012 hreverse + have h01234 := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ h0123 hreverseDone + have hfull := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ h01234 hdrain + exact { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := by + have hsteps := hfull.steps_le_m + omega + } + +end SourceStructuralDecoder + +namespace SourceTotalStructuralDecoder + +open Turing GapCVP.SourceStructuralDecoder + +private def payload_failureTrace + (input counter reversed output : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 4 input counter reversed output) + (some (Turing.haltList payloadDecoderMachine (false :: output))) + (input.length + counter.length + reversed.length + 1) := by + induction input generalizing counter reversed output with + | cons bit input ih => + have hfirst := oneStep _ _ (payload_failure_drop_input bit input counter reversed output) + have hrest := ih counter reversed output + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 + (input.length + counter.length + reversed.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using hboth + | nil => + induction counter generalizing reversed output with + | cons bit counter ih => + have hfirst := oneStep _ _ (payload_failure_drop_counter bit counter reversed output) + have hrest : + EvalsToInTime payloadDecoderMachine.step + (payloadConfiguration 4 [] counter reversed output) + (some (Turing.haltList payloadDecoderMachine + (false :: output))) + (counter.length + reversed.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using ih reversed + output + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 + (counter.length + reversed.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using hboth + | nil => + induction reversed generalizing output with + | cons bit reversed ih => + have hfirst := oneStep _ _ (payload_failure_drop_reversed bit reversed output) + have hrest : + EvalsToInTime payloadDecoderMachine.step + (payloadConfiguration 4 [] [] reversed output) + (some (Turing.haltList payloadDecoderMachine + (false :: output))) + (reversed.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using ih + output + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 (reversed.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, + zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using hboth + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using + oneStep _ _ (payload_failure_finish output) + +private def payload_missingPrefixTrace + (count : ℕ) (counter reversed output : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 0 (List.replicate count true) + counter reversed output) + (some (payloadConfiguration 4 [] + (List.replicate count true ++ counter) reversed output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (payload_prefix_missing_delimiter counter reversed output) + | succ count ih => + have hfirst := oneStep _ _ (payload_prefix_true (List.replicate count true) + counter reversed output) + have hrest := ih (true :: counter) + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 (count + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_true_append_cons] using hboth + +private def payload_missingTrace (count : ℕ) : + EvalsToInTime payloadDecoderMachine.step + (payloadConfiguration 0 (List.replicate count true) [] [] []) + (some (Turing.haltList payloadDecoderMachine [false])) + (2 * count + 2) := by + have hprefix : + EvalsToInTime payloadDecoderMachine.step + (payloadConfiguration 0 (List.replicate count true) [] [] []) + (some (payloadConfiguration 4 [] + (List.replicate count true) [] [])) + (count + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using payload_missingPrefixTrace count + [] [] [] + have hcleanup := payload_failureTrace [] (List.replicate count true) [] [] + have hfull := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ hprefix hcleanup + exact { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := by + have hsteps := hfull.steps_le_m + simp only [List.length_replicate, List.length_nil] at hsteps + omega + } + +private def payload_partialCopyTrace + (payload remaining reversed output : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 1 payload + (List.replicate payload.length true ++ remaining) + reversed output) + (some (payloadConfiguration 1 [] remaining + (payload.reverse ++ reversed) output)) + payload.length := by + induction payload generalizing reversed with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + List.reverse_nil] using + EvalsToInTime.refl payloadDecoderMachine.step (payloadConfiguration 1 [] remaining + reversed output) + | cons bit payload ih => + have hfirst := oneStep _ _ (payload_copy_step bit payload + (List.replicate payload.length true ++ remaining) + reversed output) + have hrest := ih (bit :: reversed) + have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 payload.length + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, + List.cons_append, + List.reverse_cons, List.append_assoc, List.nil_append] using hboth + +private def payload_truncatedTrace + (payload : List Bool) (extra : ℕ) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 0 + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) + [] [] []) + (some (Turing.haltList payloadDecoderMachine [false])) + (3 * payload.length + 2 * extra + 6) := by + have hprefix : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 0 + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) + [] [] []) + (some (payloadConfiguration 1 payload + (List.replicate (payload.length + extra + 1) true) [] [])) + (payload.length + extra + 1 + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using + payloadPrefixTrace (payload.length + extra + 1) payload [] [] [] + have hcopy : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 1 payload + (List.replicate (payload.length + extra + 1) true) [] []) + (some (payloadConfiguration 1 [] + (List.replicate (extra + 1) true) payload.reverse [])) + payload.length := by + have hcounter : + List.replicate (payload.length + extra + 1) true = + List.replicate payload.length true ++ + List.replicate (extra + 1) true := by + rw [show payload.length + extra + 1 = + payload.length + (extra + 1) by omega, List.replicate_add] + rw [hcounter] + simpa only [FinTM2.step, Fin.isValue, List.replicate_append_replicate, List.append_nil] using + payload_partialCopyTrace payload (List.replicate (extra + 1) true) [] [] + have hinsufficient : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 1 [] + (List.replicate (extra + 1) true) payload.reverse []) + (some (payloadConfiguration 4 [] + (List.replicate (extra + 1) true) payload.reverse [])) + 1 := by + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ] using + oneStep _ _ (payload_insufficient (List.replicate extra true) payload.reverse []) + have hcleanup := payload_failureTrace [] + (List.replicate (extra + 1) true) payload.reverse [] + have h01 := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ hprefix hcopy + have h012 := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ h01 hinsufficient + have hfull := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ h012 hcleanup + exact { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := by + have hsteps := hfull.steps_le_m + simp only [List.length_nil, List.length_replicate, + List.length_reverse] at hsteps + omega + } + +/-- GapCVP reduction support. -/ +def payloadDecodeOutput (input : List Bool) : List Bool := + match BinaryEncoding.readLengthPrefixedWord input with + | some (payload, _) => true :: payload + | none => [false] + +@[simp] theorem payloadDecodeOutput_valid + (payload suffix : List Bool) : + payloadDecodeOutput + (BinaryEncoding.lengthPrefixedWord payload ++ suffix) = + true :: payload := by + simp only [payloadDecodeOutput, BinaryEncoding.readLengthPrefixedWord_append] + +@[simp] theorem readUnaryPrefix_missing (count : ℕ) : + BinaryEncoding.readUnaryPrefix + (List.replicate count true) = none := by + induction count with + | zero => rfl + | succ count ih => + simp only [List.replicate_succ, BinaryEncoding.readUnaryPrefix, ih] + +@[simp] private theorem payloadDecodeOutput_missing (count : ℕ) : + payloadDecodeOutput (List.replicate count true) = [false] := by + simp only [payloadDecodeOutput, BinaryEncoding.readLengthPrefixedWord, readUnaryPrefix_missing] + +@[simp] private theorem payloadDecodeOutput_truncated + (payload : List Bool) (extra : ℕ) : + payloadDecodeOutput + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) = [false] := by + have hshort : ¬ payload.length + extra + 1 ≤ payload.length := by + omega + simp only [payloadDecodeOutput, BinaryEncoding.readLengthPrefixedWord, + BinaryEncoding.readUnaryPrefix_replicate, hshort, ↓reduceIte] + +/-- GapCVP reduction support. -/ +structure MissingUnaryInput (input : List Bool) where + /-- GapCVP reduction support. -/ + count : ℕ + shape : input = List.replicate count true + +/-- GapCVP reduction support. -/ +structure DelimitedUnaryInput (input : List Bool) where + /-- GapCVP reduction support. -/ + count : ℕ + /-- GapCVP reduction support. -/ + tail : List Bool + shape : input = List.replicate count true ++ false :: tail + +/-- GapCVP reduction support. -/ +def unaryInputSplit (input : List Bool) : + MissingUnaryInput input ⊕ DelimitedUnaryInput input := by + induction input with + | nil => + exact Sum.inl ⟨0, rfl⟩ + | cons bit input ih => + cases bit with + | false => + exact Sum.inr ⟨0, input, rfl⟩ + | true => + cases ih with + | inl witness => + obtain ⟨count, h⟩ := witness + exact Sum.inl ⟨count + 1, by + simp only [h, List.replicate_succ]⟩ + | inr witness => + obtain ⟨count, tail, h⟩ := witness + exact Sum.inr ⟨count + 1, tail, by + simp only [h, List.replicate_succ, List.cons_append]⟩ + +theorem validInput_reconstruct + (count : ℕ) (tail : List Bool) (hlen : count ≤ tail.length) : + List.replicate count true ++ false :: tail = + BinaryEncoding.lengthPrefixedWord (tail.take count) ++ + tail.drop count := by + have htake : (tail.take count).length = count := by + simp only [List.length_take, min_eq_left hlen] + simp only [BinaryEncoding.lengthPrefixedWord, htake, List.append_assoc, List.cons_append, + List.take_append_drop] + +private def payload_totalTrace (input : List Bool) : + EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 0 input [] [] []) + (some (Turing.haltList payloadDecoderMachine + (payloadDecodeOutput input))) + (3 * input.length + 6) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + have htrace := payload_missingTrace count + exact { + steps := htrace.steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, payloadDecodeOutput_missing] + using + htrace.evals_in_steps + steps_le_m := by + have hsteps := htrace.steps_le_m + simp only [List.length_replicate] + omega + } + | inr witness => + obtain ⟨count, tail, hinput⟩ := witness + subst input + by_cases hlen : count ≤ tail.length + · have hreconstruct := validInput_reconstruct count tail hlen + rw [hreconstruct] + have htrace := payload_validTrace (tail.take count) (tail.drop count) + exact { + steps := htrace.steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, payloadDecodeOutput_valid] + using + htrace.evals_in_steps + steps_le_m := by + have hsteps := htrace.steps_le_m + simp only [List.length_append, + BinaryEncoding.lengthPrefixedWord_length] + omega + } + · have hshort : tail.length < count := Nat.lt_of_not_ge hlen + let extra := count - tail.length - 1 + have hcount : count = tail.length + extra + 1 := by + dsimp [extra] + omega + rw [hcount] + have htrace := payload_truncatedTrace tail extra + exact { + steps := htrace.steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, payloadDecodeOutput_truncated] + using + htrace.evals_in_steps + steps_le_m := by + have hsteps := htrace.steps_le_m + simp only [List.length_append, List.length_replicate, + List.length_cons] + omega + } + +/-- GapCVP reduction support. -/ +noncomputable def payloadDecoderComputable : + BitTM + payloadDecodeOutput where + tm := payloadDecoderMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 3 * Polynomial.X + 6 + outputsFun input := { + steps := (payload_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, payloadDecoderMachine_init, + Option.map_some] using + (payload_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (payload_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +end SourceTotalStructuralDecoder + +namespace SourceFormulaStructuralDecoder + +open Turing GapCVP.SourceTotalStructuralDecoder + +private abbrev dropHeadMachine : Turing.FinTM2 where + K := Unit + k₀ := () + k₁ := () + Γ _ := Bool + Λ := Unit + main := () + σ := Unit + initialState := () + m _ := .pop () (fun _ _ => ()) .halt + +private theorem dropHeadMachine_step (input : List Bool) : + dropHeadMachine.step (Turing.initList dropHeadMachine input) = + some (Turing.haltList dropHeadMachine input.tail) := by + compactMachineStepTac [dropHeadMachine, Turing.initList] + +/-- GapCVP reduction support. -/ +noncomputable def dropHeadComputable : + BitTM + List.tail where + tm := dropHeadMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 1 + outputsFun input := { + steps := 1 + evals_in_steps := by + have hinput : + List.map (Equiv.refl Bool).invFun + (bitEncoding input) = input := by + change List.map (fun bit : Bool => bit) input = input + simp only [List.map_id_fun', id_eq] + have houtput : + List.map (Equiv.refl Bool).invFun + (bitEncoding input.tail) = input.tail := by + change List.map (fun bit : Bool => bit) input.tail = input.tail + simp only [List.map_tail, List.map_id_fun', id_eq] + rw [hinput, houtput] + change dropHeadMachine.step + (Turing.initList dropHeadMachine input) = + some (Turing.haltList dropHeadMachine input.tail) + exact dropHeadMachine_step input + steps_le_m := by simp only [id_eq, Polynomial.eval_one, Std.le_refl] + } + +/-- GapCVP reduction support. -/ +def firstFieldContents (input : List Bool) : List Bool := + (payloadDecodeOutput input).tail + +/-- GapCVP reduction support. -/ +noncomputable def firstFieldContentsComputable : + BitTM + firstFieldContents := by + exact TMComposition.computableInPolyTime + payloadDecoderComputable dropHeadComputable + +@[simp] theorem firstFieldContents_valid + (payload suffix : List Bool) : + firstFieldContents + (BinaryEncoding.lengthPrefixedWord payload ++ suffix) = + payload := by + simp only [firstFieldContents, payloadDecodeOutput_valid, List.tail_cons] + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev suffixDecoderMachine : Turing.FinTM2 where + K := Fin 4 + k₀ := 0 + k₁ := 3 + Γ _ := Bool + Λ := Fin 6 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 6) then + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.pop 0 (fun _ _ => none) + (.push 1 (fun _ => true) + (.goto (fun _ => 0)))) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) + (.goto (fun _ => 1))) + (.goto (fun _ => 5)))) + else if phase = (1 : Fin 6) then + .peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun state _ => state) + (.pop 0 (fun state _ => state) + (.push 2 (fun state => state.getD false) + (.load (fun _ => none) (.goto (fun _ => 1)))))) + (.goto (fun _ => 5)))) + (.goto (fun _ => 2))) + else if phase = (2 : Fin 6) then + .peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 2 (fun _ _ => none) (.goto (fun _ => 2))) + (.goto (fun _ => 3))) + else if phase = (3 : Fin 6) then + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun state _ => state) + (.push 2 (fun state => state.getD false) + (.load (fun _ => none) (.goto (fun _ => 3))))) + (.goto (fun _ => 4))) + else if phase = (4 : Fin 6) then + .peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 2 (fun state _ => state) + (.push 3 (fun state => state.getD false) + (.load (fun _ => none) (.goto (fun _ => 4))))) + .halt) + else + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) (.goto (fun _ => 5))) + (.peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun _ _ => none) (.goto (fun _ => 5))) + (.peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 2 (fun _ _ => none) (.goto (fun _ => 5))) + .halt))))) + +/-- Internal support shared across GapCVP continuation modules. -/ +def suffixConfiguration + (phase : Fin 6) + (input counter reversed output : List Bool) : + suffixDecoderMachine.Cfg where + l := some phase + var := none + stk := ![input, counter, reversed, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_prefix_true + (input counter reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 0 (true :: input) counter reversed output) = + some (suffixConfiguration 0 input (true :: counter) + reversed output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_prefix_delimiter + (input counter reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 0 (false :: input) counter reversed output) = + some (suffixConfiguration 1 input counter reversed output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_prefix_missing_delimiter + (counter reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 0 [] counter reversed output) = + some (suffixConfiguration 5 [] counter reversed output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_copy_step + (bit : Bool) (input counter reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 1 (bit :: input) + (true :: counter) reversed output) = + some (suffixConfiguration 1 input counter + (bit :: reversed) output) := by + cases bit <;> compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_insufficient + (counter reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 1 [] (true :: counter) reversed output) = + some (suffixConfiguration 5 [] + (true :: counter) reversed output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_counter_complete + (input reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 1 input [] reversed output) = + some (suffixConfiguration 2 input [] reversed output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_discard_step + (bit : Bool) (input reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 2 input [] (bit :: reversed) output) = + some (suffixConfiguration 2 input [] reversed output) := by + cases bit <;> compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_discard_complete + (input output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 2 input [] [] output) = + some (suffixConfiguration 3 input [] [] output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_collect_step + (bit : Bool) (input reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 3 (bit :: input) [] reversed output) = + some (suffixConfiguration 3 input [] + (bit :: reversed) output) := by + cases bit <;> compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_collect_complete + (reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 3 [] [] reversed output) = + some (suffixConfiguration 4 [] [] reversed output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_restore_step + (bit : Bool) (reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 4 [] [] (bit :: reversed) output) = + some (suffixConfiguration 4 [] [] reversed (bit :: output)) := by + cases bit <;> compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_restore_finish + (output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 4 [] [] [] output) = + some (Turing.haltList suffixDecoderMachine output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_failure_drop_input + (bit : Bool) (input counter reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 5 (bit :: input) counter reversed output) = + some (suffixConfiguration 5 input counter reversed output) := by + cases bit <;> compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_failure_drop_counter + (bit : Bool) (counter reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 5 [] (bit :: counter) reversed output) = + some (suffixConfiguration 5 [] counter reversed output) := by + cases bit <;> compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_failure_drop_reversed + (bit : Bool) (reversed output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 5 [] [] (bit :: reversed) output) = + some (suffixConfiguration 5 [] [] reversed output) := by + cases bit <;> compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem suffix_failure_finish + (output : List Bool) : + suffixDecoderMachine.step + (suffixConfiguration 5 [] [] [] output) = + some (Turing.haltList suffixDecoderMachine output) := by + compactMachineStepTac [suffixDecoderMachine, suffixConfiguration] + +end SourceFormulaStructuralDecoder + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part03C.lean b/LeanPool/GapCVP/Part03C.lean new file mode 100644 index 000000000..0a9159c26 --- /dev/null +++ b/LeanPool/GapCVP/Part03C.lean @@ -0,0 +1,2312 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part03B + +/-! # GapCVP proof, part 03, continuation 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceFormulaStructuralDecoder + +open Turing GapCVP.SourceTotalStructuralDecoder + +private def suffix_prefixTrace + (count : ℕ) (tail counter reversed output : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 0 + (List.replicate count true ++ false :: tail) + counter reversed output) + (some (suffixConfiguration 1 tail + (List.replicate count true ++ counter) reversed output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (suffix_prefix_delimiter tail counter reversed output) + | succ count ih => + have hfirst := oneStep _ _ (suffix_prefix_true + (List.replicate count true ++ false :: tail) + counter reversed output) + have hrest := ih (true :: counter) + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 (count + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hboth + +private def suffix_copyTrace + (payload suffix reversed output : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 1 (payload ++ suffix) + (List.replicate payload.length true) reversed output) + (some (suffixConfiguration 1 suffix [] + (payload.reverse ++ reversed) output)) + payload.length := by + induction payload generalizing reversed with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil] using + EvalsToInTime.refl suffixDecoderMachine.step (suffixConfiguration 1 suffix [] reversed + output) + | cons bit payload ih => + have hfirst := oneStep _ _ (suffix_copy_step bit (payload ++ suffix) + (List.replicate payload.length true) reversed output) + have hrest := ih (bit :: reversed) + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 payload.length + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append] using hboth + +private def suffix_discardTrace + (input reversed output : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 2 input [] reversed output) + (some (suffixConfiguration 3 input [] [] output)) + (reversed.length + 1) := by + induction reversed with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (suffix_discard_complete input output) + | cons bit reversed ih => + have hfirst := oneStep _ _ (suffix_discard_step bit input reversed output) + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 (reversed.length + 1) + _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hboth + +private def suffix_collectTrace + (input reversed output : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 3 input [] reversed output) + (some (suffixConfiguration 4 [] [] + (input.reverse ++ reversed) output)) + (input.length + 1) := by + induction input generalizing reversed with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (suffix_collect_complete reversed output) + | cons bit input ih => + have hfirst := oneStep _ _ (suffix_collect_step bit input reversed output) + have hrest := ih (bit :: reversed) + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 (input.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hboth + +private def suffix_restoreTrace + (reversed output : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 4 [] [] reversed output) + (some (Turing.haltList suffixDecoderMachine + (reversed.reverse ++ output))) + (reversed.length + 1) := by + induction reversed generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (suffix_restore_finish output) + | cons bit reversed ih => + have hfirst := oneStep _ _ (suffix_restore_step bit reversed output) + have hrest := ih (bit :: output) + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 (reversed.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hboth + +private def suffix_validTrace + (payload suffix : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 0 + (BinaryEncoding.lengthPrefixedWord payload ++ suffix) + [] [] []) + (some (Turing.haltList suffixDecoderMachine suffix)) + (3 * payload.length + 2 * suffix.length + 5) := by + have hprefix : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 0 + (BinaryEncoding.lengthPrefixedWord payload ++ suffix) + [] [] []) + (some (suffixConfiguration 1 (payload ++ suffix) + (List.replicate payload.length true) [] [])) + (payload.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, BinaryEncoding.lengthPrefixedWord, List.append_assoc, + List.cons_append, + List.append_nil] using suffix_prefixTrace payload.length (payload ++ suffix) [] [] [] + have hcopy : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 1 (payload ++ suffix) + (List.replicate payload.length true) [] []) + (some (suffixConfiguration 1 suffix [] payload.reverse [])) + payload.length := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using suffix_copyTrace payload suffix [] + [] + have hcounter := oneStep _ _ (suffix_counter_complete suffix payload.reverse []) + have hdiscard := suffix_discardTrace suffix payload.reverse [] + have hcollect : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 3 suffix [] [] []) + (some (suffixConfiguration 4 [] [] suffix.reverse [])) + (suffix.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using suffix_collectTrace suffix [] [] + have hrestore : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 4 [] [] suffix.reverse []) + (some (Turing.haltList suffixDecoderMachine suffix)) + (suffix.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.reverse_reverse, List.append_nil, + List.length_reverse] using + suffix_restoreTrace suffix.reverse [] + have h01 := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ hprefix hcopy + have h012 := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ h01 hcounter + have h0123 := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ h012 hdiscard + have h01234 := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ h0123 hcollect + have hfull := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ h01234 hrestore + exact { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := by + have hsteps := hfull.steps_le_m + simp only [List.length_reverse] at hsteps + omega + } + +private def suffix_failureTrace + (input counter reversed output : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 5 input counter reversed output) + (some (Turing.haltList suffixDecoderMachine output)) + (input.length + counter.length + reversed.length + 1) := by + induction input generalizing counter reversed output with + | cons bit input ih => + have hfirst := oneStep _ _ (suffix_failure_drop_input bit input counter reversed output) + have hrest := ih counter reversed output + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 + (input.length + counter.length + reversed.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using hboth + | nil => + induction counter generalizing reversed output with + | cons bit counter ih => + have hfirst := oneStep _ _ (suffix_failure_drop_counter bit counter reversed output) + have hrest : + EvalsToInTime suffixDecoderMachine.step + (suffixConfiguration 5 [] counter reversed output) + (some (Turing.haltList suffixDecoderMachine output)) + (counter.length + reversed.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using ih reversed + output + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 + (counter.length + reversed.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using hboth + | nil => + induction reversed generalizing output with + | cons bit reversed ih => + have hfirst := oneStep _ _ (suffix_failure_drop_reversed bit reversed output) + have hrest : + EvalsToInTime suffixDecoderMachine.step + (suffixConfiguration 5 [] [] reversed output) + (some (Turing.haltList suffixDecoderMachine output)) + (reversed.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using ih + output + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 (reversed.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, + zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using hboth + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using + oneStep _ _ (suffix_failure_finish output) + +private def suffix_missingPrefixTrace + (count : ℕ) (counter reversed output : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 0 (List.replicate count true) + counter reversed output) + (some (suffixConfiguration 5 [] + (List.replicate count true ++ counter) reversed output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (suffix_prefix_missing_delimiter counter reversed output) + | succ count ih => + have hfirst := oneStep _ _ (suffix_prefix_true (List.replicate count true) + counter reversed output) + have hrest := ih (true :: counter) + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 (count + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hboth + +private def suffix_missingTrace (count : ℕ) : + EvalsToInTime suffixDecoderMachine.step + (suffixConfiguration 0 (List.replicate count true) [] [] []) + (some (Turing.haltList suffixDecoderMachine [])) + (2 * count + 2) := by + have hprefix : + EvalsToInTime suffixDecoderMachine.step + (suffixConfiguration 0 (List.replicate count true) [] [] []) + (some (suffixConfiguration 5 [] + (List.replicate count true) [] [])) + (count + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using suffix_missingPrefixTrace count [] + [] [] + have hcleanup := suffix_failureTrace [] + (List.replicate count true) [] [] + have hfull := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ hprefix hcleanup + exact { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := by + have hsteps := hfull.steps_le_m + simp only [List.length_replicate, List.length_nil] at hsteps + omega + } + +private def suffix_partialCopyTrace + (payload remaining reversed output : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 1 payload + (List.replicate payload.length true ++ remaining) + reversed output) + (some (suffixConfiguration 1 [] remaining + (payload.reverse ++ reversed) output)) + payload.length := by + induction payload generalizing reversed with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + List.reverse_nil] using + EvalsToInTime.refl suffixDecoderMachine.step (suffixConfiguration 1 [] remaining reversed + output) + | cons bit payload ih => + have hfirst := oneStep _ _ (suffix_copy_step bit payload + (List.replicate payload.length true ++ remaining) + reversed output) + have hrest := ih (bit :: reversed) + have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 payload.length + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, + List.cons_append, + List.reverse_cons, List.append_assoc, List.nil_append] using hboth + +private def suffix_truncatedTrace + (payload : List Bool) (extra : ℕ) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 0 + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) + [] [] []) + (some (Turing.haltList suffixDecoderMachine [])) + (3 * payload.length + 2 * extra + 6) := by + have hprefix : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 0 + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) + [] [] []) + (some (suffixConfiguration 1 payload + (List.replicate (payload.length + extra + 1) true) [] [])) + (payload.length + extra + 1 + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using + suffix_prefixTrace (payload.length + extra + 1) payload [] [] [] + have hcopy : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 1 payload + (List.replicate (payload.length + extra + 1) true) [] []) + (some (suffixConfiguration 1 [] + (List.replicate (extra + 1) true) payload.reverse [])) + payload.length := by + have hcounter : + List.replicate (payload.length + extra + 1) true = + List.replicate payload.length true ++ + List.replicate (extra + 1) true := by + rw [show payload.length + extra + 1 = + payload.length + (extra + 1) by omega, List.replicate_add] + rw [hcounter] + simpa only [FinTM2.step, Fin.isValue, List.replicate_append_replicate, List.append_nil] using + suffix_partialCopyTrace payload (List.replicate (extra + 1) true) [] [] + have hinsufficient : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 1 [] + (List.replicate (extra + 1) true) payload.reverse []) + (some (suffixConfiguration 5 [] + (List.replicate (extra + 1) true) payload.reverse [])) + 1 := by + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ] using + oneStep _ _ (suffix_insufficient (List.replicate extra true) payload.reverse []) + have hcleanup := suffix_failureTrace [] + (List.replicate (extra + 1) true) payload.reverse [] + have h01 := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ hprefix hcopy + have h012 := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ h01 hinsufficient + have hfull := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ h012 hcleanup + exact { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := by + have hsteps := hfull.steps_le_m + simp only [List.length_nil, List.length_replicate, + List.length_reverse] at hsteps + omega + } + +/-- GapCVP reduction support. -/ +def firstFieldSuffix (input : List Bool) : List Bool := + match BinaryEncoding.readLengthPrefixedWord input with + | some (_, suffix) => suffix + | none => [] + +@[simp] theorem firstFieldSuffix_valid + (payload suffix : List Bool) : + firstFieldSuffix + (BinaryEncoding.lengthPrefixedWord payload ++ suffix) = + suffix := by + simp only [firstFieldSuffix, BinaryEncoding.readLengthPrefixedWord_append] + +@[simp] private theorem firstFieldSuffix_missing (count : ℕ) : + firstFieldSuffix (List.replicate count true) = [] := by + simp only [firstFieldSuffix, BinaryEncoding.readLengthPrefixedWord, readUnaryPrefix_missing] + +@[simp] private theorem firstFieldSuffix_truncated + (payload : List Bool) (extra : ℕ) : + firstFieldSuffix + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) = [] := by + have hshort : ¬ payload.length + extra + 1 ≤ payload.length := by + omega + simp only [firstFieldSuffix, BinaryEncoding.readLengthPrefixedWord, + BinaryEncoding.readUnaryPrefix_replicate, + hshort, ↓reduceIte] + +private theorem suffixDecoderMachine_init (input : List Bool) : + Turing.initList suffixDecoderMachine input = + suffixConfiguration 0 input [] [] [] := by + simp only [suffixDecoderMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + suffixConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +private def suffix_totalTrace (input : List Bool) : + EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 0 input [] [] []) + (some (Turing.haltList suffixDecoderMachine + (firstFieldSuffix input))) + (3 * input.length + 6) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + have htrace := suffix_missingTrace count + exact { + steps := htrace.steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, firstFieldSuffix_missing] + using + htrace.evals_in_steps + steps_le_m := by + have hsteps := htrace.steps_le_m + simp only [List.length_replicate] + omega + } + | inr witness => + obtain ⟨count, tail, hinput⟩ := witness + subst input + by_cases hlen : count ≤ tail.length + · have hreconstruct := validInput_reconstruct count tail hlen + rw [hreconstruct] + have htrace := suffix_validTrace + (tail.take count) (tail.drop count) + exact { + steps := htrace.steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, firstFieldSuffix_valid] + using htrace.evals_in_steps + steps_le_m := by + have hsteps := htrace.steps_le_m + simp only [List.length_append, + BinaryEncoding.lengthPrefixedWord_length] + omega + } + · have hshort : tail.length < count := Nat.lt_of_not_ge hlen + let extra := count - tail.length - 1 + have hcount : count = tail.length + extra + 1 := by + dsimp [extra] + omega + rw [hcount] + have htrace := suffix_truncatedTrace tail extra + exact { + steps := htrace.steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, firstFieldSuffix_truncated] + using + htrace.evals_in_steps + steps_le_m := by + have hsteps := htrace.steps_le_m + simp only [List.length_append, List.length_replicate, + List.length_cons] + omega + } + +/-- GapCVP reduction support. -/ +noncomputable def firstFieldSuffixComputable : + BitTM + firstFieldSuffix where + tm := suffixDecoderMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 3 * Polynomial.X + 6 + outputsFun input := { + steps := (suffix_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, suffixDecoderMachine_init, + Option.map_some] using + (suffix_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (suffix_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +/-- GapCVP reduction support. -/ +def literalSuffix : List Bool → List Bool := + List.tail ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def literalSuffixComputable : + BitTM + literalSuffix := by + exact TMComposition.computableInPolyTime + firstFieldSuffixComputable dropHeadComputable + +@[simp] theorem literalSuffix_valid + (literal : Literal) (suffix : List Bool) : + literalSuffix + (BinaryEncoding.encodeLiteral literal ++ suffix) = + suffix := by + rcases literal with ⟨index, sign⟩ + simp only [literalSuffix, BinaryEncoding.encodeLiteral, List.append_assoc, List.cons_append, + List.nil_append, + Function.comp_apply, firstFieldSuffix_valid, List.tail_cons] + +/-- GapCVP reduction support. -/ +def clauseSuffix : List Bool → List Bool := + literalSuffix ∘ literalSuffix ∘ literalSuffix + +/-- GapCVP reduction support. -/ +noncomputable def clauseSuffixComputable : + BitTM + clauseSuffix := by + exact TMComposition.computableInPolyTime + (TMComposition.computableInPolyTime + literalSuffixComputable literalSuffixComputable) + literalSuffixComputable + +@[simp] theorem clauseSuffix_valid + (clause : ThreeClause) (suffix : List Bool) : + clauseSuffix + (BinaryEncoding.encodeThreeClause clause ++ suffix) = + suffix := by + simp only [clauseSuffix, Function.comp_def, BinaryEncoding.encodeThreeClause, Fin.isValue, + List.append_assoc, + Function.comp_apply, literalSuffix_valid] + +@[simp] theorem firstFieldSuffix_encodeThreeCNF + (clauses : ThreeCNF) : + firstFieldSuffix + (BinaryEncoding.encodeThreeCNF clauses) = + clauses.flatMap BinaryEncoding.encodeThreeClause := by + simp only [BinaryEncoding.encodeThreeCNF, firstFieldSuffix_valid] + +end SourceFormulaStructuralDecoder + +namespace SourceVariableFormulaDecoder + +open Turing GapCVP.SourceFormulaStructuralDecoder + +private def variablePrefixLabel (position : Fin 3) : Fin 7 := + ⟨position.val, by omega⟩ + +private def variablePayloadLabel (position : Fin 3) : Fin 7 := + ⟨position.val + 3, by omega⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +def nextLiteralPosition (position : Fin 3) : Fin 3 := + if position = 0 then 1 else if position = 1 then 2 else 0 + +private def variablePrefixStatement (position : Fin 3) : + Turing.TM2.Stmt (fun _ : Fin 3 => Bool) (Fin 7) (Option Bool) := + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.pop 0 (fun _ _ => none) + (.push 1 (fun _ => true) + (.goto (fun _ => variablePrefixLabel position)))) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) + (.goto (fun _ => variablePayloadLabel position))) + (.peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.load (fun _ => none) (.goto (fun _ => (6 : Fin 7)))) + (if position = 0 then + .push 2 (fun _ => true) .halt + else + .goto (fun _ => (6 : Fin 7))))))) + +private def variablePayloadStatement (position : Fin 3) : + Turing.TM2.Stmt (fun _ : Fin 3 => Bool) (Fin 7) (Option Bool) := + .peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun _ _ => none) + (.pop 0 (fun _ _ => none) + (.goto (fun _ => variablePayloadLabel position)))) + (.goto (fun _ => (6 : Fin 7))))) + (.peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) + (if position = 2 then + .push 2 (fun _ => true) + (.goto (fun _ => variablePrefixLabel 0)) + else + .goto (fun _ => variablePrefixLabel + (nextLiteralPosition position)))) + (.goto (fun _ => (6 : Fin 7)))))) + +private abbrev variableClauseMachine : Turing.FinTM2 where + K := Fin 3 + k₀ := 0 + k₁ := 2 + Γ _ := Bool + Λ := Fin 7 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 7) then variablePrefixStatement 0 + else if phase = (1 : Fin 7) then variablePrefixStatement 1 + else if phase = (2 : Fin 7) then variablePrefixStatement 2 + else if phase = (3 : Fin 7) then variablePayloadStatement 0 + else if phase = (4 : Fin 7) then variablePayloadStatement 1 + else if phase = (5 : Fin 7) then variablePayloadStatement 2 + else + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) (.goto (fun _ => 6))) + (.peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun _ _ => none) (.goto (fun _ => 6))) + (.push 2 (fun _ => false) .halt)))) + +private def variableConfiguration + (phase : Fin 7) (input counter : List Bool) (count : ℕ) : + variableClauseMachine.Cfg where + l := some phase + var := none + stk := ![input, counter, List.replicate count true] + +private theorem variable_prefix_true + (position : Fin 3) (input counter : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePrefixLabel position) + (true :: input) counter count) = + some (variableConfiguration (variablePrefixLabel position) + input (true :: counter) count) := by + fin_cases position <;> + compactMachineStepTac [variableClauseMachine, variableConfiguration, variablePrefixLabel, + variablePrefixStatement] + +private theorem variable_prefix_delimiter + (position : Fin 3) (input counter : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePrefixLabel position) + (false :: input) counter count) = + some (variableConfiguration (variablePayloadLabel position) + input counter count) := by + fin_cases position <;> + compactMachineStepTac [variableClauseMachine, variableConfiguration, variablePrefixLabel, + variablePayloadLabel, variablePrefixStatement] + +private theorem variable_payload_step + (position : Fin 3) (bit counterBit : Bool) + (input counter : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePayloadLabel position) + (bit :: input) (counterBit :: counter) count) = + some (variableConfiguration (variablePayloadLabel position) + input counter count) := by + fin_cases position <;> cases bit <;> cases counterBit <;> + compactMachineStepTac [variableClauseMachine, variableConfiguration, variablePayloadLabel, + variablePayloadStatement] + +private theorem variable_sign_step + (position : Fin 3) (hposition : position ≠ 2) + (sign : Bool) (input : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePayloadLabel position) + (sign :: input) [] count) = + some (variableConfiguration + (variablePrefixLabel (nextLiteralPosition position)) + input [] count) := by + fin_cases position <;> cases sign <;> + first + | exact (hposition rfl).elim + | compactMachineStepTac [variableClauseMachine, variableConfiguration, + variablePrefixLabel, variablePayloadLabel, nextLiteralPosition, + variablePayloadStatement] + +private theorem variable_completeClause_step + (sign : Bool) (input : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePayloadLabel 2) + (sign :: input) [] count) = + some (variableConfiguration (variablePrefixLabel 0) + input [] (count + 1)) := by + cases sign <;> + compactMachineStepTac [variableClauseMachine, variableConfiguration, + variablePrefixLabel, variablePayloadLabel, variablePayloadStatement, + List.replicate_succ] + +private theorem variable_finish_valid (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePrefixLabel 0) [] [] count) = + some (Turing.haltList variableClauseMachine + (true :: List.replicate count true)) := by + compactMachineStepTac [variableClauseMachine, variableConfiguration, variablePrefixLabel, + variablePrefixStatement] + +private theorem variable_prefix_unfinished + (position : Fin 3) (bit : Bool) + (counter : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePrefixLabel position) + [] (bit :: counter) count) = + some (variableConfiguration 6 [] (bit :: counter) count) := by + fin_cases position <;> cases bit <;> + compactMachineStepTac [variableClauseMachine, variableConfiguration, variablePrefixLabel, + variablePrefixStatement] + +private theorem variable_prefix_incompleteClause + (position : Fin 3) (hposition : position ≠ 0) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePrefixLabel position) + [] [] count) = + some (variableConfiguration 6 [] [] count) := by + fin_cases position <;> + simp_all [variableClauseMachine, variableConfiguration, + variablePrefixLabel, variablePrefixStatement, + Turing.FinTM2.step, Turing.TM2.step, Turing.TM2.stepAux] <;> + rfl + +private theorem variable_payload_missing + (position : Fin 3) (counter : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration (variablePayloadLabel position) + [] counter count) = + some (variableConfiguration 6 [] counter count) := by + fin_cases position <;> cases counter <;> + compactMachineStepTac [variableClauseMachine, variableConfiguration, variablePayloadLabel, + variablePayloadStatement] + +private theorem variable_failure_drop_input + (bit : Bool) (input counter : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration 6 (bit :: input) counter count) = + some (variableConfiguration 6 input counter count) := by + cases bit <;> compactMachineStepTac [variableClauseMachine, variableConfiguration] + +private theorem variable_failure_drop_counter + (bit : Bool) (counter : List Bool) (count : ℕ) : + variableClauseMachine.step + (variableConfiguration 6 [] (bit :: counter) count) = + some (variableConfiguration 6 [] counter count) := by + cases bit <;> compactMachineStepTac [variableClauseMachine, variableConfiguration] + +private theorem variable_failure_finish (count : ℕ) : + variableClauseMachine.step + (variableConfiguration 6 [] [] count) = + some (Turing.haltList variableClauseMachine + (false :: List.replicate count true)) := by + compactMachineStepTac [variableClauseMachine, variableConfiguration] + +private def variable_failureTrace + (input counter : List Bool) (count : ℕ) : + EvalsToInTime variableClauseMachine.step (variableConfiguration 6 input counter count) + (some (Turing.haltList variableClauseMachine + (false :: List.replicate count true))) + (input.length + counter.length + 1) := by + induction input generalizing counter count with + | cons bit input ih => + have hfirst := oneStep _ _ (variable_failure_drop_input bit input counter count) + have hrest := ih counter count + have hboth := EvalsToInTime.trans variableClauseMachine.step 1 + (input.length + counter.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using hboth + | nil => + induction counter generalizing count with + | cons bit counter ih => + have hfirst := oneStep _ _ (variable_failure_drop_counter bit counter count) + have hrest : + EvalsToInTime variableClauseMachine.step (variableConfiguration 6 [] counter count) + (some (Turing.haltList variableClauseMachine + (false :: List.replicate count true))) + (counter.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using ih count + have hboth := EvalsToInTime.trans variableClauseMachine.step 1 (counter.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using hboth + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using + oneStep _ _ (variable_failure_finish count) + +private def variableScanPhase (payload : Bool) (position : Fin 3) : Fin 7 := + if payload then variablePayloadLabel position + else variablePrefixLabel position + +private def variableScanOutput : + List Bool → Bool → Fin 3 → List Bool → ℕ → List Bool + | [], true, _, _, count => false :: List.replicate count true + | [], false, position, [], count => + if position = 0 then true :: List.replicate count true + else false :: List.replicate count true + | [], false, _, _ :: _, count => + false :: List.replicate count true + | bit :: rest, false, position, counter, count => + if bit then + variableScanOutput rest false position (true :: counter) count + else + variableScanOutput rest true position counter count + | _ :: rest, true, position, [], count => + variableScanOutput rest false (nextLiteralPosition position) [] + (if position = 2 then count + 1 else count) + | _ :: rest, true, position, _ :: counter, count => + variableScanOutput rest true position counter count + +private def variableScanTrace + (input : List Bool) (payload : Bool) (position : Fin 3) + (counter : List Bool) (count : ℕ) : + EvalsToInTime variableClauseMachine.step + (variableConfiguration (variableScanPhase payload position) + input counter count) + (some (Turing.haltList variableClauseMachine + (variableScanOutput input payload position counter count))) + (2 * input.length + counter.length + 2) := by + induction input generalizing payload position counter count with + | nil => + cases payload with + | false => + cases counter with + | nil => + by_cases hposition : position = 0 + · subst position + have htrace := oneStep _ _ (variable_finish_valid count) + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, Bool.false_eq_true, + ↓reduceIte, variableScanOutput, + List.length_nil, mul_zero, add_zero, zero_add] using rebound (newBudget := 2) + htrace (by omega) + · have hfirst := oneStep _ _ (variable_prefix_incompleteClause + position hposition count) + have hcleanup := variable_failureTrace [] [] count + have hfull := EvalsToInTime.trans + variableClauseMachine.step _ _ _ _ _ hfirst hcleanup + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, Bool.false_eq_true, + ↓reduceIte, variableScanOutput, + hposition, List.length_nil, mul_zero, add_zero, zero_add] using + rebound (newBudget := 2) hfull + (by + simp only [List.length_nil] + omega) + | cons counterBit counter => + have hfirst := oneStep _ _ (variable_prefix_unfinished position + counterBit counter count) + have hcleanup := variable_failureTrace [] + (counterBit :: counter) count + have hfull := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hfirst + hcleanup + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, Bool.false_eq_true, + ↓reduceIte, variableScanOutput, + List.length_nil, mul_zero, List.length_cons, zero_add] using + rebound (newBudget := counter.length + 3) hfull + (by + simp only [List.length_nil, List.length_cons] + omega) + | true => + have hfirst := oneStep _ _ (variable_payload_missing position counter count) + have hcleanup := variable_failureTrace [] counter count + have hfull := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hfirst hcleanup + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, ↓reduceIte, variableScanOutput, + List.length_nil, + mul_zero, zero_add] using + rebound (newBudget := counter.length + 2) hfull + (by + simp only [List.length_nil] + omega) + | cons bit input ih => + cases payload with + | false => + cases bit with + | false => + have hfirst := oneStep _ _ (variable_prefix_delimiter position input counter count) + have hrest := ih true position counter count + have hfull := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, Bool.false_eq_true, + ↓reduceIte, variableScanOutput, + List.length_cons] using rebound (newBudget := 2 * (input.length + 1) + + counter.length + 2) hfull (by omega) + | true => + have hfirst := oneStep _ _ (variable_prefix_true position input counter count) + have hrest := ih false position (true :: counter) count + have hfull := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, Bool.false_eq_true, + ↓reduceIte, variableScanOutput, + List.length_cons] using + rebound (newBudget := 2 * (input.length + 1) + counter.length + 2) hfull + (by + simp only [List.length_cons] + omega) + | true => + cases counter with + | nil => + by_cases hcomplete : position = 2 + · subst position + have hfirst := oneStep _ _ (variable_completeClause_step bit input count) + have hrest := ih false 0 [] (count + 1) + have hfull := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, ↓reduceIte, + variableScanOutput, nextLiteralPosition, + Fin.reduceEq, List.length_cons, List.length_nil, add_zero] using + rebound (newBudget := 2 * (input.length + 1) + 2) hfull + (by + simp only [List.length_nil] + omega) + · have hfirst := oneStep _ _ (variable_sign_step position hcomplete + bit input count) + have hrest := ih false + (nextLiteralPosition position) [] count + have hfull := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, ↓reduceIte, + variableScanOutput, hcomplete, + List.length_cons, List.length_nil, add_zero] using + rebound (newBudget := 2 * (input.length + 1) + 2) hfull + (by + simp only [List.length_nil] + omega) + | cons counterBit counter => + have hfirst := oneStep _ _ (variable_payload_step position bit counterBit + input counter count) + have hrest := ih true position counter count + have hfull := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, variableScanPhase, ↓reduceIte, + variableScanOutput, + List.length_cons] using rebound (newBudget := 2 * (input.length + 1) + + (counter.length + 1) + 2) hfull (by omega) + +private theorem variableClauseMachine_init (input : List Bool) : + Turing.initList variableClauseMachine input = + variableConfiguration (variablePrefixLabel 0) input [] 0 := by + simp only [variableClauseMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + variableConfiguration, variablePrefixLabel, Fin.coe_ofNat_eq_mod, Nat.zero_mod, Fin.zero_eta, + List.replicate_zero] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- GapCVP reduction support. -/ +def variableClauseBodyOutput (input : List Bool) : List Bool := + variableScanOutput input false 0 [] 0 + +/-- GapCVP reduction support. -/ +noncomputable def variableClauseBodyComputable : + BitTM + variableClauseBodyOutput where + tm := variableClauseMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 2 * Polynomial.X + 2 + outputsFun input := { + steps := (variableScanTrace input false 0 [] 0).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, variableScanPhase, + Bool.false_eq_true, ↓dreduceIte, + List.length_nil, Nat.add_zero, Equiv.invFun_as_coe, Equiv.refl_symm, Equiv.coe_refl, + bitEncoding, id_eq, + List.map_id_fun, variableClauseMachine_init, variableClauseBodyOutput, Option.map_some, + ↓reduceIte] using + (variableScanTrace input false 0 [] 0).evals_in_steps + steps_le_m := by + have hsteps := (variableScanTrace input false 0 [] 0).steps_le_m + simpa only [FinTM2.step, Fin.isValue, List.length_nil, Nat.add_zero, bitEncoding, id_eq, + Polynomial.eval_add, + Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le, add_zero] + using hsteps + } + +private theorem variableScanOutput_prefix + (length : ℕ) (tail counter : List Bool) + (position : Fin 3) (count : ℕ) : + variableScanOutput + (List.replicate length true ++ false :: tail) + false position counter count = + variableScanOutput tail true position + (List.replicate length true ++ counter) count := by + induction length generalizing counter with + | zero => + simp only [List.replicate_zero, List.nil_append, variableScanOutput, Bool.false_eq_true, + ↓reduceIte] + | succ length ih => + simp only [List.replicate_succ, List.cons_append, variableScanOutput, ↓reduceIte, ih, + SourceStructuralDecoder.replicate_true_append_cons] + +private theorem variableScanOutput_payload + (payload tail counter : List Bool) + (position : Fin 3) (count : ℕ) : + variableScanOutput (payload ++ tail) true position + (List.replicate payload.length true ++ counter) count = + variableScanOutput tail true position counter count := by + induction payload generalizing counter with + | nil => + simp only [List.nil_append, List.length_nil, List.replicate_zero] + | cons bit payload ih => + simp only [List.cons_append, List.length_cons, List.replicate_succ, variableScanOutput, ih] + +private theorem variableScanOutput_literal + (literal : Literal) (suffix : List Bool) + (position : Fin 3) (count : ℕ) : + variableScanOutput + (BinaryEncoding.encodeLiteral literal ++ suffix) + false position [] count = + variableScanOutput suffix false + (nextLiteralPosition position) [] + (if position = 2 then count + 1 else count) := by + rcases literal with ⟨index, sign⟩ + unfold BinaryEncoding.encodeLiteral + rw [BinaryEncoding.lengthPrefixedWord] + simp only [List.append_assoc, List.cons_append] + rw [variableScanOutput_prefix] + rw [variableScanOutput_payload] + simp only [variableScanOutput, List.nil_append, Fin.isValue] + +private theorem variableScanOutput_clause + (clause : ThreeClause) (suffix : List Bool) (count : ℕ) : + variableScanOutput + (BinaryEncoding.encodeThreeClause clause ++ suffix) + false 0 [] count = + variableScanOutput suffix false 0 [] (count + 1) := by + unfold BinaryEncoding.encodeThreeClause + simp only [List.append_assoc] + rw [variableScanOutput_literal, + variableScanOutput_literal, variableScanOutput_literal] + simp only [nextLiteralPosition, Fin.isValue, ↓reduceIte, one_ne_zero, Fin.reduceEq] + +private theorem variableScanOutput_clauses + (clauses : ThreeCNF) (suffix : List Bool) (count : ℕ) : + variableScanOutput + (clauses.flatMap BinaryEncoding.encodeThreeClause ++ + suffix) + false 0 [] count = + variableScanOutput suffix false 0 [] + (count + clauses.length) := by + induction clauses generalizing count with + | nil => + simp only [List.flatMap_nil, List.nil_append, Fin.isValue, List.length_nil, add_zero] + | cons clause clauses ih => + simp only [List.flatMap_cons, List.length_cons] + rw [List.append_assoc, variableScanOutput_clause, ih] + congr 1 + omega + +@[simp] theorem variableClauseBodyOutput_valid + (clauses : ThreeCNF) : + variableClauseBodyOutput + (clauses.flatMap BinaryEncoding.encodeThreeClause) = + true :: List.replicate clauses.length true := by + unfold variableClauseBodyOutput + have hscan := variableScanOutput_clauses clauses [] 0 + simpa only [Fin.isValue, List.append_nil, variableScanOutput, ↓reduceIte, zero_add] using hscan + +/-- GapCVP reduction support. -/ +noncomputable def variableFormulaBodyComputable : + BitTM + (variableClauseBodyOutput ∘ firstFieldSuffix) := + TMComposition.computableInPolyTime + firstFieldSuffixComputable variableClauseBodyComputable + +end SourceVariableFormulaDecoder + +namespace FormulaTuringTM + +open Turing GapCVP.SourceVariableFormulaDecoder + +/-- Internal support shared across GapCVP continuation modules. -/ +def binaryStackValue : List Bool → ℕ + | [] => 0 + | bit :: rest => (if bit then 1 else 0) + 2 * binaryStackValue rest + +private theorem binaryStackValue_encodePosNum (value : PosNum) : + binaryStackValue (Computability.encodePosNum value) = + (value : ℕ) := by + induction value with + | one => + simp only [Computability.encodePosNum, binaryStackValue, ↓reduceIte, mul_zero, add_zero, + PosNum.cast_one'] + | bit0 value ih => + simp only [Computability.encodePosNum, binaryStackValue, Bool.false_eq_true, ↓reduceIte, ih, + zero_add, + PosNum.cast_bit0] + omega + | bit1 value ih => + simp only [Computability.encodePosNum, binaryStackValue, ↓reduceIte, ih, PosNum.cast_bit1] + omega + +private theorem binaryStackValue_encodeNum (value : Num) : + binaryStackValue (Computability.encodeNum value) = + (value : ℕ) := by + cases value with + | zero => + rfl + | pos value => + simpa only [Computability.encodeNum, Num.cast_pos] using binaryStackValue_encodePosNum value + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem binaryStackValue_encodeNat (value : ℕ) : + binaryStackValue (Computability.encodeNat value) = value := by + change binaryStackValue (Computability.encodeNum (value : Num)) = + value + rw [binaryStackValue_encodeNum] + exact Num.to_of_nat value + +/-- Internal support shared across GapCVP continuation modules. -/ +def binaryStackDecrement : List Bool → Option (List Bool) + | [] => none + | true :: rest => some (false :: rest) + | false :: rest => + match binaryStackDecrement rest with + | none => none + | some remaining => some (true :: remaining) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem binaryStackDecrement_value + (bits remaining : List Bool) + (hdecrement : binaryStackDecrement bits = some remaining) : + binaryStackValue remaining + 1 = binaryStackValue bits := by + induction bits generalizing remaining with + | nil => + simp only [binaryStackDecrement, reduceCtorEq] at hdecrement + | cons bit bits ih => + cases bit with + | true => + simp only [binaryStackDecrement, Option.some.injEq] at hdecrement + subst remaining + simp only [binaryStackValue, Bool.false_eq_true, ↓reduceIte, zero_add] + omega + | false => + cases hrest : binaryStackDecrement bits with + | none => + simp only [binaryStackDecrement, hrest, reduceCtorEq] at hdecrement + | some rest => + simp only [binaryStackDecrement, hrest, Option.some.injEq] at hdecrement + subst remaining + have hvalue := ih rest hrest + simp only [binaryStackValue, ↓reduceIte, Bool.false_eq_true, zero_add] + omega + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem binaryStackValue_eq_zero_iff + (bits : List Bool) : + binaryStackValue bits = 0 ↔ ∀ bit ∈ bits, bit = false := by + induction bits with + | nil => + simp only [binaryStackValue, List.not_mem_nil, IsEmpty.forall_iff, implies_true] + | cons bit bits ih => + cases bit <;> + simp [binaryStackValue, ih] + +/-- GapCVP reduction support. -/ +def canonicalPrefixLabel (position : Fin 3) : Fin 17 := + ⟨position.val + 4, by omega⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalPayloadLabel (position : Fin 3) : Fin 17 := + ⟨position.val + 7, by omega⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalClearLabel (position : Fin 3) : Fin 17 := + ⟨position.val + 10, by omega⟩ + +private def canonicalSignStatement (position : Fin 3) : + Turing.TM2.Stmt (fun _ : Fin 6 => Bool) (Fin 17) (Option Bool) := + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) + (if position = 2 then + .goto (fun _ => (13 : Fin 17)) + else + .goto (fun _ => canonicalPrefixLabel + (nextLiteralPosition position)))) + (.goto (fun _ => (15 : Fin 17)))) + +/-- GapCVP reduction support. -/ +def canonicalPrefixStatement (position : Fin 3) : + Turing.TM2.Stmt (fun _ : Fin 6 => Bool) (Fin 17) (Option Bool) := + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.pop 0 (fun _ _ => none) + (.push 1 (fun _ => true) + (.goto (fun _ => canonicalPrefixLabel position)))) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) + (.goto (fun _ => canonicalPayloadLabel position))) + (.peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.load (fun _ => none) (.goto (fun _ => (15 : Fin 17)))) + (if position = 0 then + .goto (fun _ => (16 : Fin 17)) + else + .goto (fun _ => (15 : Fin 17))))))) + +/-- GapCVP reduction support. -/ +def canonicalPayloadStatement (position : Fin 3) : + Turing.TM2.Stmt (fun _ : Fin 6 => Bool) (Fin 17) (Option Bool) := + .peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun state _ => state) + (.pop 0 (fun state _ => state) + (.push 2 (fun state => state.getD false) + (.load (fun _ => none) + (.goto (fun _ => canonicalPayloadLabel position)))))) + (.goto (fun _ => (15 : Fin 17))))) + (.peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.load (fun _ => none) + (.goto (fun _ => canonicalClearLabel position))) + (.branch (fun symbol => symbol.isSome) + (.load (fun _ => none) + (.goto (fun _ => (15 : Fin 17)))) + (canonicalSignStatement position))))) + +/-- GapCVP reduction support. -/ +def canonicalClearStatement (position : Fin 3) : + Turing.TM2.Stmt (fun _ : Fin 6 => Bool) (Fin 17) (Option Bool) := + .peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 2 (fun _ _ => none) + (.goto (fun _ => canonicalClearLabel position))) + (canonicalSignStatement position)) + +/-- GapCVP reduction support. -/ +abbrev canonicalFormulaMachine : Turing.FinTM2 where + K := Fin 6 + k₀ := 0 + k₁ := 5 + Γ _ := Bool + Λ := Fin 17 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 17) then + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.pop 0 (fun _ _ => none) + (.push 1 (fun _ => true) (.goto (fun _ => 0)))) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) (.goto (fun _ => 1))) + (.goto (fun _ => 15)))) + else if phase = (1 : Fin 17) then + .peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun state _ => state) + (.pop 0 (fun state _ => state) + (.push 2 (fun state => state.getD false) + (.load (fun _ => none) (.goto (fun _ => 1)))))) + (.goto (fun _ => 15)))) + (.goto (fun _ => 2))) + else if phase = (2 : Fin 17) then + .peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.load (fun _ => none) (.goto (fun _ => 3))) + (.branch (fun symbol => symbol.isSome) + (.load (fun _ => none) (.goto (fun _ => 15))) + (.goto (fun _ => canonicalPrefixLabel 0)))) + else if phase = (3 : Fin 17) then + .peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 2 (fun state _ => state) + (.push 3 (fun state => state.getD false) + (.load (fun _ => none) (.goto (fun _ => 3))))) + (.goto (fun _ => canonicalPrefixLabel 0))) + else if phase = (4 : Fin 17) then canonicalPrefixStatement 0 + else if phase = (5 : Fin 17) then canonicalPrefixStatement 1 + else if phase = (6 : Fin 17) then canonicalPrefixStatement 2 + else if phase = (7 : Fin 17) then canonicalPayloadStatement 0 + else if phase = (8 : Fin 17) then canonicalPayloadStatement 1 + else if phase = (9 : Fin 17) then canonicalPayloadStatement 2 + else if phase = (10 : Fin 17) then canonicalClearStatement 0 + else if phase = (11 : Fin 17) then canonicalClearStatement 1 + else if phase = (12 : Fin 17) then canonicalClearStatement 2 + else if phase = (13 : Fin 17) then + .peek 3 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.pop 3 (fun _ _ => none) + (.push 3 (fun _ => false) (.goto (fun _ => 14)))) + (.branch (fun symbol => symbol.isSome) + (.pop 3 (fun _ _ => none) + (.push 4 (fun _ => true) (.goto (fun _ => 13)))) + (.goto (fun _ => 15)))) + else if phase = (14 : Fin 17) then + .peek 4 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 4 (fun _ _ => none) + (.push 3 (fun _ => true) (.goto (fun _ => 14)))) + (.goto (fun _ => canonicalPrefixLabel 0))) + else if phase = (15 : Fin 17) then + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 0 (fun _ _ => none) (.goto (fun _ => 15))) + (.peek 1 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 1 (fun _ _ => none) (.goto (fun _ => 15))) + (.peek 2 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 2 (fun _ _ => none) (.goto (fun _ => 15))) + (.peek 3 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 3 (fun _ _ => none) (.goto (fun _ => 15))) + (.peek 4 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop 4 (fun _ _ => none) + (.goto (fun _ => 15))) + (.push 5 (fun _ => false) .halt)))))))))) + else + .peek 3 (fun _ symbol => symbol) + (.branch (fun symbol => symbol == some true) + (.load (fun _ => none) (.goto (fun _ => 15))) + (.branch (fun symbol => symbol.isSome) + (.pop 3 (fun _ _ => none) (.goto (fun _ => 16))) + (.push 5 (fun _ => true) .halt))) + +/-- GapCVP reduction support. -/ +def canonicalConfiguration + (phase : Fin 17) + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.Cfg where + l := some phase + var := none + stk := ![input, counter, field, binary, borrow, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_header_prefix_true + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 0 (true :: input) + counter field binary borrow output) = + some (canonicalConfiguration 0 input + (true :: counter) field binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_header_prefix_delimiter + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 0 (false :: input) + counter field binary borrow output) = + some (canonicalConfiguration 1 input + counter field binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_header_prefix_missing + (counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 0 [] + counter field binary borrow output) = + some (canonicalConfiguration 15 [] + counter field binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_header_payload_step + (bit : Bool) (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 1 (bit :: input) + (true :: counter) field binary borrow output) = + some (canonicalConfiguration 1 input + counter (bit :: field) binary borrow output) := by + cases bit <;> compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_header_payload_missing + (counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 1 [] (true :: counter) + field binary borrow output) = + some (canonicalConfiguration 15 [] (true :: counter) + field binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_header_payload_complete + (input field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 1 input [] + field binary borrow output) = + some (canonicalConfiguration 2 input [] + field binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_header_check_true + (input field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 2 input [] + (true :: field) binary borrow output) = + some (canonicalConfiguration 3 input [] + (true :: field) binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_header_check_false + (input field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 2 input [] + (false :: field) binary borrow output) = + some (canonicalConfiguration 15 input [] + (false :: field) binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_header_check_zero + (input binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 2 input [] + [] binary borrow output) = + some (canonicalConfiguration (canonicalPrefixLabel 0) input [] + [] binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, canonicalPrefixLabel] + +private theorem canonical_header_reverse_step + (bit : Bool) (input field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 3 input [] + (bit :: field) binary borrow output) = + some (canonicalConfiguration 3 input [] + field (bit :: binary) borrow output) := by + cases bit <;> compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_header_reverse_complete + (input binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 3 input [] + [] binary borrow output) = + some (canonicalConfiguration (canonicalPrefixLabel 0) input [] + [] binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, canonicalPrefixLabel] + +private theorem canonical_borrow_zero + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 13 input counter field + (false :: binary) borrow output) = + some (canonicalConfiguration 13 input counter field + binary (true :: borrow) output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_borrow_one + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 13 input counter field + (true :: binary) borrow output) = + some (canonicalConfiguration 14 input counter field + (false :: binary) borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_borrow_exhausted + (input counter field borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 13 input counter field + [] borrow output) = + some (canonicalConfiguration 15 input counter field + [] borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_borrow_restore_step + (bit : Bool) (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 14 input counter field + binary (bit :: borrow) output) = + some (canonicalConfiguration 14 input counter field + (true :: binary) borrow output) := by + cases bit <;> compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_borrow_restore_complete + (input counter field binary output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 14 input counter field + binary [] output) = + some (canonicalConfiguration (canonicalPrefixLabel 0) + input counter field binary [] output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, canonicalPrefixLabel] + +private theorem canonical_zeroCheck_false + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 16 input counter field + (false :: binary) borrow output) = + some (canonicalConfiguration 16 input counter field + binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_zeroCheck_true + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 16 input counter field + (true :: binary) borrow output) = + some (canonicalConfiguration 15 input counter field + (true :: binary) borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_zeroCheck_finish : + canonicalFormulaMachine.step + (canonicalConfiguration 16 [] [] [] [] [] []) = + some (Turing.haltList canonicalFormulaMachine [true]) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_prefix_true + (position : Fin 3) + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPrefixLabel position) + (true :: input) counter field binary borrow output) = + some (canonicalConfiguration (canonicalPrefixLabel position) + input (true :: counter) field binary borrow output) := by + fin_cases position <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPrefixLabel, + canonicalPrefixStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_prefix_delimiter + (position : Fin 3) + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPrefixLabel position) + (false :: input) counter field binary borrow output) = + some (canonicalConfiguration (canonicalPayloadLabel position) + input counter field binary borrow output) := by + fin_cases position <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPrefixLabel, + canonicalPayloadLabel, canonicalPrefixStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_payload_step + (position : Fin 3) (bit : Bool) + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPayloadLabel position) + (bit :: input) (true :: counter) + field binary borrow output) = + some (canonicalConfiguration (canonicalPayloadLabel position) + input counter (bit :: field) binary borrow output) := by + fin_cases position <;> cases bit <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPayloadLabel, canonicalPayloadStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_payload_missing + (position : Fin 3) + (counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPayloadLabel position) + [] (true :: counter) field binary borrow output) = + some (canonicalConfiguration 15 [] + (true :: counter) field binary borrow output) := by + fin_cases position <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPayloadLabel, canonicalPayloadStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_field_true + (position : Fin 3) + (input field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPayloadLabel position) + input [] (true :: field) binary borrow output) = + some (canonicalConfiguration (canonicalClearLabel position) + input [] (true :: field) binary borrow output) := by + fin_cases position <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPayloadLabel, canonicalClearLabel, canonicalPayloadStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_field_false + (position : Fin 3) + (input field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPayloadLabel position) + input [] (false :: field) binary borrow output) = + some (canonicalConfiguration 15 + input [] (false :: field) binary borrow output) := by + fin_cases position <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPayloadLabel, canonicalPayloadStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_clear_step + (position : Fin 3) (bit : Bool) + (input field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalClearLabel position) + input [] (bit :: field) binary borrow output) = + some (canonicalConfiguration (canonicalClearLabel position) + input [] field binary borrow output) := by + fin_cases position <;> cases bit <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, canonicalClearLabel, + canonicalClearStatement] + +private theorem canonical_clear_sign_step + (position : Fin 3) (hposition : position ≠ 2) + (sign : Bool) (input binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalClearLabel position) + (sign :: input) [] [] binary borrow output) = + some (canonicalConfiguration + (canonicalPrefixLabel (nextLiteralPosition position)) + input [] [] binary borrow output) := by + fin_cases position <;> cases sign <;> + first + | exact (hposition rfl).elim + | compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalClearLabel, canonicalPrefixLabel, canonicalClearStatement, + canonicalSignStatement, nextLiteralPosition] + +private theorem canonical_clear_completeClause + (sign : Bool) (input binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalClearLabel 2) + (sign :: input) [] [] binary borrow output) = + some (canonicalConfiguration 13 + input [] [] binary borrow output) := by + cases sign <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, canonicalClearLabel, + canonicalClearStatement, canonicalSignStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_zero_field_sign_step + (position : Fin 3) (hposition : position ≠ 2) + (sign : Bool) (input binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPayloadLabel position) + (sign :: input) [] [] binary borrow output) = + some (canonicalConfiguration + (canonicalPrefixLabel (nextLiteralPosition position)) + input [] [] binary borrow output) := by + fin_cases position <;> cases sign <;> + first + | exact (hposition rfl).elim + | compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPayloadLabel, canonicalPrefixLabel, canonicalPayloadStatement, + canonicalSignStatement, nextLiteralPosition] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_zero_field_completeClause + (sign : Bool) (input binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPayloadLabel 2) + (sign :: input) [] [] binary borrow output) = + some (canonicalConfiguration 13 + input [] [] binary borrow output) := by + cases sign <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPayloadLabel, canonicalPayloadStatement, canonicalSignStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_body_finish + (binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPrefixLabel 0) + [] [] [] binary borrow output) = + some (canonicalConfiguration 16 [] [] [] + binary borrow output) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, canonicalPrefixLabel, + canonicalPrefixStatement] + +private def canonical_borrowZerosTrace + (zeros : ℕ) (tail input counter field borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 13 input counter field + (List.replicate zeros false ++ true :: tail) borrow output) + (some (canonicalConfiguration 14 input counter field + (false :: tail) (List.replicate zeros true ++ borrow) output)) + (zeros + 1) := by + induction zeros generalizing borrow with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (canonical_borrow_one input counter field tail borrow output) + | succ zeros ih => + have hfirst := oneStep _ _ (canonical_borrow_zero input counter field + (List.replicate zeros false ++ true :: tail) + borrow output) + have hrest := ih (true :: borrow) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 (zeros + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hboth + +private def canonical_restoreTrace + (zeros : ℕ) + (input counter field binary output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 14 input counter field + binary (List.replicate zeros true) output) + (some (canonicalConfiguration (canonicalPrefixLabel 0) + input counter field + (List.replicate zeros true ++ binary) [] output)) + (zeros + 1) := by + induction zeros generalizing binary with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (canonical_borrow_restore_complete input counter field binary output) + | succ zeros ih => + have hfirst := oneStep _ _ (canonical_borrow_restore_step true input counter field + binary (List.replicate zeros true) output) + have hrest := ih (true :: binary) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 (zeros + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hboth + +private def canonical_decrementTrace + (zeros : ℕ) + (tail input counter field output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 13 input counter field + (List.replicate zeros false ++ true :: tail) [] output) + (some (canonicalConfiguration (canonicalPrefixLabel 0) + input counter field + (List.replicate zeros true ++ false :: tail) [] output)) + (2 * zeros + 2) := by + have hborrow : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 13 input counter field + (List.replicate zeros false ++ true :: tail) [] output) + (some (canonicalConfiguration 14 input counter field + (false :: tail) (List.replicate zeros true) output)) + (zeros + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using + canonical_borrowZerosTrace zeros tail input counter field [] output + have hrestore := canonical_restoreTrace zeros + input counter field (false :: tail) output + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hborrow hrestore + exact { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := by + have hsteps := hfull.steps_le_m + omega + } + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem binaryStackDecrement_replicate + (zeros : ℕ) (tail : List Bool) : + binaryStackDecrement + (List.replicate zeros false ++ true :: tail) = + some (List.replicate zeros true ++ false :: tail) := by + induction zeros with + | zero => + rfl + | succ zeros ih => + simp only [List.replicate_succ, List.cons_append, binaryStackDecrement, ih] + +private theorem canonical_failure_drop_input + (bit : Bool) + (input counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 15 (bit :: input) + counter field binary borrow output) = + some (canonicalConfiguration 15 input + counter field binary borrow output) := by + cases bit <;> compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_failure_drop_counter + (bit : Bool) + (counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 15 [] + (bit :: counter) field binary borrow output) = + some (canonicalConfiguration 15 [] + counter field binary borrow output) := by + cases bit <;> compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_failure_drop_field + (bit : Bool) (field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 15 [] [] + (bit :: field) binary borrow output) = + some (canonicalConfiguration 15 [] [] + field binary borrow output) := by + cases bit <;> compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_failure_drop_binary + (bit : Bool) (binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 15 [] [] [] + (bit :: binary) borrow output) = + some (canonicalConfiguration 15 [] [] [] + binary borrow output) := by + cases bit <;> compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_failure_drop_borrow + (bit : Bool) (borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 15 [] [] [] [] + (bit :: borrow) output) = + some (canonicalConfiguration 15 [] [] [] [] + borrow output) := by + cases bit <;> compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +private theorem canonical_failure_finish (output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration 15 [] [] [] [] [] output) = + some (Turing.haltList canonicalFormulaMachine + (false :: output)) := by + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration] + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalFailureTrace + (input counter field binary borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 15 input + counter field binary borrow output) + (some (Turing.haltList canonicalFormulaMachine + (false :: output))) + (input.length + counter.length + field.length + + binary.length + borrow.length + 1) := by + induction input generalizing counter field binary borrow output with + | cons bit input ih => + have hfirst := oneStep _ _ (canonical_failure_drop_input + bit input counter field binary borrow output) + have hrest := ih counter field binary borrow output + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using hboth + | nil => + induction counter generalizing field binary borrow output with + | cons bit counter ih => + have hfirst := oneStep _ _ (canonical_failure_drop_counter + bit counter field binary borrow output) + have hrest := ih field binary borrow output + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using hboth + | nil => + induction field generalizing binary borrow output with + | cons bit field ih => + have hfirst := oneStep _ _ (canonical_failure_drop_field + bit field binary borrow output) + have hrest := ih binary borrow output + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, + zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using hboth + | nil => + induction binary generalizing borrow output with + | cons bit binary ih => + have hfirst := oneStep _ _ + (canonical_failure_drop_binary bit binary borrow output) + have hrest := ih borrow output + have hboth := EvalsToInTime.trans + canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using hboth + | nil => + induction borrow generalizing output with + | cons bit borrow ih => + have hfirst := oneStep _ _ (canonical_failure_drop_borrow bit borrow output) + have hrest := ih output + have hboth := EvalsToInTime.trans + canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using hboth + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] + using + oneStep _ _ (canonical_failure_finish output) + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalZeroTrace (zeros : ℕ) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 16 [] [] [] + (List.replicate zeros false) [] []) + (some (Turing.haltList canonicalFormulaMachine [true])) + (zeros + 1) := by + induction zeros with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ canonical_zeroCheck_finish + | succ zeros ih => + have hfirst := oneStep _ _ (canonical_zeroCheck_false [] [] [] + (List.replicate zeros false) [] []) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 (zeros + 1) + _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd] + using hboth + +end FormulaTuringTM + +namespace FormulaCert + +open Turing GapCVP.SourceVariableFormulaDecoder GapCVP.FormulaTuringTM + +/-- Internal support shared across GapCVP continuation modules. -/ +def isCanonicalBinaryWord (word : List Bool) : Bool := + match word.reverse with + | [] => true + | true :: _ => true + | false :: _ => false + +private theorem encodePosNum_canonical (number : PosNum) : + isCanonicalBinaryWord + (Computability.encodePosNum number) = true := by + induction number with + | one => + rfl + | bit0 number ih => + unfold isCanonicalBinaryWord at ih ⊢ + simp only [Computability.encodePosNum, List.reverse_cons] + cases hreverse : + (Computability.encodePosNum number).reverse with + | nil => + have hnonempty := Computability.encodePosNum_nonempty number + have hempty : Computability.encodePosNum number = [] := by + simpa only [List.reverse_reverse, List.reverse_nil] using congrArg List.reverse + hreverse + exact (hnonempty hempty).elim + | cons head tail => + cases head with + | false => + simp only [hreverse, Bool.false_eq_true] at ih + | true => + simp only [List.cons_append] + | bit1 number ih => + unfold isCanonicalBinaryWord at ih ⊢ + simp only [Computability.encodePosNum, List.reverse_cons] + cases hreverse : + (Computability.encodePosNum number).reverse with + | nil => + have hnonempty := Computability.encodePosNum_nonempty number + have hempty : Computability.encodePosNum number = [] := by + simpa only [List.reverse_reverse, List.reverse_nil] using congrArg List.reverse + hreverse + exact (hnonempty hempty).elim + | cons head tail => + cases head with + | false => + simp only [hreverse, Bool.false_eq_true] at ih + | true => + simp only [List.cons_append] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem encodeNat_canonical (number : ℕ) : + isCanonicalBinaryWord (Computability.encodeNat number) = true := by + change isCanonicalBinaryWord + (Computability.encodeNum (number : Num)) = true + cases hnum : (number : Num) with + | zero => + simp only [isCanonicalBinaryWord, Computability.encodeNum, List.reverse_nil] + | pos positive => + simpa only [Computability.encodeNum] using encodePosNum_canonical positive + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalHeaderPrefixTrace + (length : ℕ) + (tail counter field binary borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 0 + (List.replicate length true ++ false :: tail) + counter field binary borrow output) + (some (canonicalConfiguration 1 tail + (List.replicate length true ++ counter) + field binary borrow output)) + (length + 1) := by + induction length generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (canonical_header_prefix_delimiter tail counter field binary borrow output) + | succ length ih => + have hfirst := oneStep _ _ (canonical_header_prefix_true + (List.replicate length true ++ false :: tail) + counter field binary borrow output) + have hrest := ih (true :: counter) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 (length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalHeaderCopyTrace + (header suffix field binary borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 1 (header ++ suffix) + (List.replicate header.length true) + field binary borrow output) + (some (canonicalConfiguration 1 suffix [] + (header.reverse ++ field) binary borrow output)) + header.length := by + induction header generalizing field with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil] using + EvalsToInTime.refl canonicalFormulaMachine.step (canonicalConfiguration 1 suffix [] field + binary borrow output) + | cons bit header ih => + have hfirst := oneStep _ _ (canonical_header_payload_step bit + (header ++ suffix) + (List.replicate header.length true) + field binary borrow output) + have hrest := ih (bit :: field) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 header.length + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append] using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalHeaderReverseTrace + (field input binary borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 3 input [] + field binary borrow output) + (some (canonicalConfiguration (canonicalPrefixLabel 0) + input [] [] (field.reverse ++ binary) borrow output)) + (field.length + 1) := by + induction field generalizing binary with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (canonical_header_reverse_complete input binary borrow output) + | cons bit field ih => + have hfirst := oneStep _ _ (canonical_header_reverse_step bit + input field binary borrow output) + have hrest := ih (bit :: binary) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 (field.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +structure PositiveBinarySplit (bits : List Bool) where + /-- Number of leading zero bits. -/ + zeros : ℕ + /-- Bits following the first positive bit. -/ + tail : List Bool + /-- Decomposition of the positive binary word. -/ + shape : bits = List.replicate zeros false ++ true :: tail + +/-- Internal support shared across GapCVP continuation modules. -/ +def positiveBinarySplit + (bits : List Bool) (hpositive : 0 < binaryStackValue bits) : + PositiveBinarySplit bits := by + induction bits with + | nil => + simp only [binaryStackValue, lt_self_iff_false] at hpositive + | cons bit bits ih => + cases bit with + | true => + exact ⟨0, bits, rfl⟩ + | false => + have hrest : 0 < binaryStackValue bits := by + simpa only [binaryStackValue, Bool.false_eq_true, ↓reduceIte, zero_add, + Order.lt_two_iff, zero_le, + mul_pos_iff_of_pos_left] using hpositive + obtain ⟨zeros, tail, hshape⟩ := ih hrest + exact ⟨zeros + 1, tail, by + simp only [hshape, List.replicate_succ, List.cons_append]⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem binaryStackDecrement_none_shape + (bits : List Bool) + (hdecrement : binaryStackDecrement bits = none) : + bits = List.replicate bits.length false := by + induction bits with + | nil => + rfl + | cons bit bits ih => + cases bit with + | true => + simp only [binaryStackDecrement, reduceCtorEq] at hdecrement + | false => + cases hrest : binaryStackDecrement bits with + | none => + have hshape := ih hrest + change false :: bits = + List.replicate (bits.length + 1) false + rw [List.replicate_succ, ← hshape] + | some remaining => + simp only [binaryStackDecrement, hrest, reduceCtorEq] at hdecrement + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem binaryStackValue_zero_shape + (bits : List Bool) (hzero : binaryStackValue bits = 0) : + bits = List.replicate bits.length false := by + apply List.eq_replicate_of_mem + exact (binaryStackValue_eq_zero_iff bits).mp hzero + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalBorrowFailureTrace + (zeros : ℕ) + (input counter field borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 13 input counter field + (List.replicate zeros false) borrow output) + (some (canonicalConfiguration 15 input counter field + [] (List.replicate zeros true ++ borrow) output)) + (zeros + 1) := by + induction zeros generalizing borrow with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (canonical_borrow_exhausted input counter field borrow output) + | succ zeros ih => + have hfirst := oneStep _ _ (canonical_borrow_zero input counter field + (List.replicate zeros false) borrow output) + have hrest := ih (true :: borrow) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 (zeros + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalClearFieldTrace + (position : Fin 3) (hposition : position ≠ 2) + (field : List Bool) (sign : Bool) + (input binary borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step + (canonicalConfiguration (canonicalClearLabel position) + (sign :: input) [] field binary borrow output) + (some (canonicalConfiguration + (canonicalPrefixLabel (nextLiteralPosition position)) + input [] [] binary borrow output)) + (field.length + 1) := by + induction field with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (canonical_clear_sign_step position hposition sign input binary borrow + output) + | cons bit field ih => + have hfirst := oneStep _ _ (canonical_literal_clear_step position bit + (sign :: input) field binary borrow output) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 (field.length + 1) + _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalClearThirdFieldTrace + (field : List Bool) (sign : Bool) + (input binary borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration (canonicalClearLabel 2) + (sign :: input) [] field binary borrow output) + (some (canonicalConfiguration 13 + input [] [] binary borrow output)) + (field.length + 1) := by + induction field with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (canonical_clear_completeClause sign input binary borrow output) + | cons bit field ih => + have hfirst := oneStep _ _ (canonical_literal_clear_step 2 bit + (sign :: input) field binary borrow output) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 (field.length + 1) + _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hboth + +end FormulaCert + +namespace FormulaTotalCert + +open Turing GapCVP.SourceTotalStructuralDecoder GapCVP.SourceVariableFormulaDecoder +open GapCVP.FormulaTuringTM GapCVP.FormulaCert + +/-- GapCVP reduction support. -/ +def canonicalFormulaExpected (input : List Bool) : List Bool := + match BinaryEncoding.decodeThreeCNF input with + | none => [false] + | some formula => + if BinaryEncoding.encodeThreeCNF formula = input + then [true] else [false] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonicalFormulaExpected_eq_true_iff (input : List Bool) : + canonicalFormulaExpected input = [true] ↔ + ∃ formula : ThreeCNF, + BinaryEncoding.encodeThreeCNF formula = input := by + constructor + · intro haccept + cases hdecode : BinaryEncoding.decodeThreeCNF input with + | none => + simp only [canonicalFormulaExpected, hdecode, List.cons.injEq, Bool.false_eq_true, + and_true] at haccept + | some formula => + have hcanonical : + BinaryEncoding.encodeThreeCNF formula = input := by + simpa only [canonicalFormulaExpected, hdecode, ite_eq_left_iff, List.cons.injEq, + Bool.false_eq_true, and_true, + imp_false, Decidable.not_not] using haccept + exact ⟨formula, hcanonical⟩ + · rintro ⟨formula, rfl⟩ + simp only [canonicalFormulaExpected, BinaryEncoding.decodeThreeCNF_encode, ↓reduceIte] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem binaryStackDecrement_length + (bits remaining : List Bool) + (hdecrement : binaryStackDecrement bits = some remaining) : + remaining.length = bits.length := by + induction bits generalizing remaining with + | nil => + simp only [binaryStackDecrement, reduceCtorEq] at hdecrement + | cons bit bits ih => + cases bit with + | true => + simp only [binaryStackDecrement, Option.some.injEq] at hdecrement + subst remaining + rfl + | false => + cases hrest : binaryStackDecrement bits with + | none => + simp only [binaryStackDecrement, hrest, reduceCtorEq] at hdecrement + | some tail => + simp only [binaryStackDecrement, hrest, Option.some.injEq] at hdecrement + subst remaining + simp only [List.length_cons, ih tail hrest] + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalDecrementSomeTrace + (bits remaining : List Bool) + (hdecrement : binaryStackDecrement bits = some remaining) + (input counter field output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step + (canonicalConfiguration 13 input counter field bits [] output) + (some (canonicalConfiguration (canonicalPrefixLabel 0) + input counter field remaining [] output)) + (2 * bits.length + 2) := by + have hpositive : 0 < binaryStackValue bits := by + have hvalue := binaryStackDecrement_value bits remaining hdecrement + omega + obtain ⟨zeros, tail, hshape⟩ := positiveBinarySplit bits hpositive + subst bits + rw [binaryStackDecrement_replicate] at hdecrement + cases Option.some.inj hdecrement + apply rebound (canonical_decrementTrace zeros tail input counter field output) + simp only [List.length_append, List.length_replicate, + List.length_cons] + omega + +private def canonical_zeroPrefixTrace + (zeros : ℕ) (tail : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 16 [] [] [] + (List.replicate zeros false ++ tail) [] []) + (some (canonicalConfiguration 16 [] [] [] tail [] [])) + zeros := by + induction zeros with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append] using + EvalsToInTime.refl canonicalFormulaMachine.step (canonicalConfiguration 16 [] [] [] tail + [] []) + | succ zeros ih => + have hfirst := oneStep _ _ (canonical_zeroCheck_false [] [] [] + (List.replicate zeros false ++ tail) [] []) + have hboth := EvalsToInTime.trans canonicalFormulaMachine.step 1 zeros _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append] using hboth + +/-- Internal support shared across GapCVP continuation modules. -/ +def canonicalZeroFailureTrace + (bits : List Bool) (hpositive : 0 < binaryStackValue bits) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 16 [] [] [] bits [] []) + (some (Turing.haltList canonicalFormulaMachine [false])) + (2 * bits.length + 3) := by + obtain ⟨zeros, tail, hshape⟩ := positiveBinarySplit bits hpositive + subst bits + have hprefix := canonical_zeroPrefixTrace zeros (true :: tail) + have hreject := oneStep _ _ (canonical_zeroCheck_true [] [] [] tail [] []) + have hcleanup := canonicalFailureTrace [] [] [] (true :: tail) [] [] + have hfirst := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hprefix hreject + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hcleanup + apply rebound hfull + simp only [List.length_append, List.length_replicate, + List.length_cons, List.length_nil] + omega + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_prefix_missing_counter + (position : Fin 3) (counterBit : Bool) + (counter field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPrefixLabel position) + [] (counterBit :: counter) field binary borrow output) = + some (canonicalConfiguration 15 + [] (counterBit :: counter) field binary borrow output) := by + fin_cases position <;> cases counterBit <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPrefixLabel, + canonicalPrefixStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_literal_prefix_incomplete + (position : Fin 3) (hposition : position ≠ 0) + (field binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPrefixLabel position) + [] [] field binary borrow output) = + some (canonicalConfiguration 15 + [] [] field binary borrow output) := by + fin_cases position <;> + simp_all [canonicalFormulaMachine, canonicalConfiguration, + canonicalPrefixLabel, canonicalPrefixStatement, + Turing.FinTM2.step, Turing.TM2.step, Turing.TM2.stepAux] <;> + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_zero_field_missing_sign + (position : Fin 3) (binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalPayloadLabel position) + [] [] [] binary borrow output) = + some (canonicalConfiguration 15 + [] [] [] binary borrow output) := by + fin_cases position <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, + canonicalPayloadLabel, canonicalPayloadStatement, canonicalSignStatement] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem canonical_clear_missing_sign + (position : Fin 3) (binary borrow output : List Bool) : + canonicalFormulaMachine.step + (canonicalConfiguration (canonicalClearLabel position) + [] [] [] binary borrow output) = + some (canonicalConfiguration 15 + [] [] [] binary borrow output) := by + fin_cases position <;> + compactMachineStepTac [canonicalFormulaMachine, canonicalConfiguration, canonicalClearLabel, + canonicalClearStatement, canonicalSignStatement] + +end FormulaTotalCert + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part03D.lean b/LeanPool/GapCVP/Part03D.lean new file mode 100644 index 000000000..e0adbbdb6 --- /dev/null +++ b/LeanPool/GapCVP/Part03D.lean @@ -0,0 +1,2316 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part03C + +/-! # GapCVP proof, part 03, continuation 04 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace FormulaTotalCert + +open Turing GapCVP.SourceTotalStructuralDecoder GapCVP.SourceVariableFormulaDecoder + +open GapCVP.FormulaTuringTM GapCVP.FormulaCert + +private def canonical_clearMissingTrace + (position : Fin 3) (field binary : List Bool) : + EvalsToInTime canonicalFormulaMachine.step + (canonicalConfiguration (canonicalClearLabel position) + [] [] field binary [] []) + (some (Turing.haltList canonicalFormulaMachine [false])) + (field.length + binary.length + 2) := by + induction field with + | nil => + have hfirst := oneStep _ _ (canonical_clear_missing_sign position binary [] []) + have hcleanup := canonicalFailureTrace [] [] [] binary [] [] + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hcleanup + exact rebound hfull (by + simp only [List.length_nil] + omega) + | cons bit field ih => + have hfirst := oneStep _ _ (canonical_literal_clear_step position bit + [] field binary [] []) + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst ih + exact rebound hfull (by + simp only [List.length_cons] + omega) + +private def canonical_decrementNoneFailureTrace + (bits : List Bool) + (hdecrement : binaryStackDecrement bits = none) + (input : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 13 input [] [] bits [] []) + (some (Turing.haltList canonicalFormulaMachine [false])) + (input.length + 2 * bits.length + 2) := by + have hshape := binaryStackDecrement_none_shape bits hdecrement + have hborrow := canonicalBorrowFailureTrace bits.length + input [] [] [] [] + simp only [List.append_nil] at hborrow + rw [← hshape] at hborrow + have hcleanup := canonicalFailureTrace input [] [] [] + (List.replicate bits.length true) [] + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hborrow hcleanup + apply rebound hfull + simp only [List.length_replicate, List.length_nil] + omega + +private def canonicalBodyOutput : + List Bool → Bool → Fin 3 → ℕ → List Bool → List Bool → Bool + | [], true, _, _, _, _ => false + | [], false, position, 0, [], binary => + if position = 0 then decide (binaryStackValue binary = 0) + else false + | [], false, _, _, _, _ => false + | bit :: rest, false, position, count, field, binary => + if bit then + canonicalBodyOutput rest false position (count + 1) field binary + else + canonicalBodyOutput rest true position count field binary + | bit :: rest, true, position, count + 1, field, binary => + canonicalBodyOutput rest true position count (bit :: field) binary + | _ :: rest, true, position, 0, field, binary => + match field with + | false :: _ => false + | _ => + if position = 2 then + match binaryStackDecrement binary with + | none => false + | some remaining => + canonicalBodyOutput rest false 0 0 [] remaining + else + canonicalBodyOutput rest false + (nextLiteralPosition position) 0 [] binary + +private def canonicalBodyPhase (payload : Bool) (position : Fin 3) : Fin 17 := + if payload then canonicalPayloadLabel position + else canonicalPrefixLabel position + +private def canonicalBodyBudget + (binaryBound : ℕ) (input : List Bool) + (counterLength : ℕ) (field : List Bool) : ℕ := + (2 * binaryBound + 10) * + (2 * input.length + counterLength + field.length + 1) + + binaryBound + 4 + +private def canonical_failFromStep + (source : canonicalFormulaMachine.Cfg) + (input counter field binary borrow : List Bool) + (hstep : canonicalFormulaMachine.step source = + some (canonicalConfiguration 15 + input counter field binary borrow [])) : + EvalsToInTime canonicalFormulaMachine.step + source (some (Turing.haltList canonicalFormulaMachine [false])) + (input.length + counter.length + field.length + + binary.length + borrow.length + 2) := by + have hfirst := oneStep _ _ hstep + have hcleanup := canonicalFailureTrace + input counter field binary borrow [] + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hcleanup + exact rebound hfull (by omega) + +private def canonical_finalCountTrace (binary : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration (canonicalPrefixLabel 0) + [] [] [] binary [] []) + (some (Turing.haltList canonicalFormulaMachine + [decide (binaryStackValue binary = 0)])) + (2 * binary.length + 4) := by + have henter := oneStep _ _ (canonical_body_finish binary [] []) + by_cases hzero : binaryStackValue binary = 0 + · have hshape := binaryStackValue_zero_shape binary hzero + have hzeroTrace := canonicalZeroTrace binary.length + rw [← hshape] at hzeroTrace + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ henter hzeroTrace + have hbounded := rebound (newBudget := 2 * binary.length + 4) hfull (by omega) + simpa only [FinTM2.step, Fin.isValue, hzero, decide_true] using hbounded + · have hpositive : 0 < binaryStackValue binary := by omega + have hreject := canonicalZeroFailureTrace binary hpositive + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ henter hreject + have hbounded := rebound (newBudget := 2 * binary.length + 4) hfull (by omega) + simpa only [FinTM2.step, Fin.isValue, hzero, decide_false] using hbounded + +private def canonicalBodyTrace + (binaryBound : ℕ) + (input : List Bool) (payload : Bool) (position : Fin 3) + (counterLength : ℕ) (field binary : List Bool) + (hbinary : binary.length ≤ binaryBound) + (hfield : payload = false → field = []) : + EvalsToInTime canonicalFormulaMachine.step + (canonicalConfiguration (canonicalBodyPhase payload position) + input (List.replicate counterLength true) + field binary [] []) + (some (Turing.haltList canonicalFormulaMachine + [canonicalBodyOutput input payload position + counterLength field binary])) + (canonicalBodyBudget binaryBound input counterLength field) := by + induction input generalizing payload position counterLength field binary with + | nil => + cases payload with + | false => + have hempty := hfield rfl + subst field + cases counterLength with + | zero => + by_cases hposition : position = 0 + · subst position + have htrace := canonical_finalCountTrace binary + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound [] 0 []) htrace (by + simp only [canonicalBodyBudget, List.length_nil, mul_zero, add_zero, + zero_add, mul_one, add_le_add_iff_right] + omega) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, Bool.false_eq_true, + ↓reduceIte, List.replicate_zero, + canonicalBodyOutput] using hbounded + · have hfailure := canonical_failFromStep + (canonicalConfiguration + (canonicalPrefixLabel position) + [] [] [] binary [] []) + [] [] [] binary [] + (canonical_literal_prefix_incomplete + position hposition [] binary [] []) + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound [] 0 []) hfailure (by + simp only [List.length_nil, add_zero, zero_add, canonicalBodyBudget, + mul_zero, mul_one, add_le_add_iff_right] + omega) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, Bool.false_eq_true, + ↓reduceIte, List.replicate_zero, + canonicalBodyOutput, hposition] using hbounded + | succ counterLength => + have hfailure := canonical_failFromStep + (canonicalConfiguration + (canonicalPrefixLabel position) + [] (true :: List.replicate counterLength true) + [] binary [] []) + [] (true :: List.replicate counterLength true) + [] binary [] + (canonical_literal_prefix_missing_counter + position true (List.replicate counterLength true) + [] binary [] []) + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound [] (counterLength + 1) []) + hfailure (by + simp only [List.length_nil, List.length_cons, List.length_replicate, zero_add, + add_zero, canonicalBodyBudget, + mul_zero, add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, Bool.false_eq_true, + ↓reduceIte, List.replicate_succ, + canonicalBodyOutput] using hbounded + | true => + cases counterLength with + | succ counterLength => + have hfailure := canonical_failFromStep + (canonicalConfiguration + (canonicalPayloadLabel position) + [] (true :: List.replicate counterLength true) + field binary [] []) + [] (true :: List.replicate counterLength true) + field binary [] + (canonical_literal_payload_missing position + (List.replicate counterLength true) + field binary [] []) + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound [] (counterLength + 1) field) + hfailure (by + simp only [List.length_nil, List.length_cons, List.length_replicate, zero_add, + add_zero, canonicalBodyBudget, + mul_zero, add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_succ, + canonicalBodyOutput] using hbounded + | zero => + cases field with + | nil => + have hfailure := canonical_failFromStep + (canonicalConfiguration + (canonicalPayloadLabel position) + [] [] [] binary [] []) + [] [] [] binary [] + (canonical_zero_field_missing_sign + position binary [] []) + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound [] 0 []) hfailure (by + simp only [List.length_nil, add_zero, zero_add, canonicalBodyBudget, + mul_zero, mul_one, add_le_add_iff_right] + omega) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput] using hbounded + | cons fieldBit field => + cases fieldBit with + | false => + have hfailure := canonical_failFromStep + (canonicalConfiguration + (canonicalPayloadLabel position) + [] [] (false :: field) binary [] []) + [] [] (false :: field) binary [] + (canonical_literal_field_false position [] + field binary [] []) + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound [] 0 (false :: field)) + hfailure (by + simp only [List.length_nil, add_zero, List.length_cons, zero_add, + canonicalBodyBudget, mul_zero, + add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput] using hbounded + | true => + have hcheck := oneStep _ _ (canonical_literal_field_true position [] + field binary [] []) + have hcleanup := canonical_clearMissingTrace + position (true :: field) binary + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hcheck hcleanup + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound [] 0 (true :: field)) + hfull (by + simp only [List.length_cons, canonicalBodyBudget, List.length_nil, + mul_zero, add_zero, zero_add, + add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput] using hbounded + | cons bit input ih => + cases payload with + | false => + have hempty := hfield rfl + subst field + cases bit with + | false => + have hfirst := oneStep _ _ (canonical_literal_prefix_delimiter + position input + (List.replicate counterLength true) + [] binary [] []) + have hrest := ih true position counterLength + [] binary hbinary (by intro _; rfl) + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + have hbounded := rebound (newBudget := canonicalBodyBudget binaryBound + (false :: input) counterLength []) + hfull (by + simp only [canonicalBodyBudget, List.length_nil, add_zero, List.length_cons, + add_le_add_iff_right, + Nat.reduceLeDiff, Order.add_one_le_iff, add_lt_add_iff_right, add_pos_iff, + Order.lt_two_iff, zero_le, + mul_pos_iff_of_pos_left, Nat.ofNat_pos, or_true, mul_lt_mul_iff_right₀, + Order.lt_add_one_iff, lt_add_iff_pos_right, + Order.lt_one_iff]) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, Bool.false_eq_true, + ↓reduceIte, + canonicalBodyOutput] using hbounded + | true => + have hfirst := oneStep _ _ (canonical_literal_prefix_true + position input + (List.replicate counterLength true) + [] binary [] []) + have hrest := ih false position (counterLength + 1) + [] binary hbinary (by intro _; rfl) + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + have hbounded := rebound (newBudget := canonicalBodyBudget binaryBound + (true :: input) counterLength []) + hfull (by + simp only [canonicalBodyBudget, List.length_nil, add_zero, List.length_cons, + add_le_add_iff_right, + Nat.reduceLeDiff, Order.add_one_le_iff, add_lt_add_iff_right, add_pos_iff, + Order.lt_two_iff, zero_le, + mul_pos_iff_of_pos_left, Nat.ofNat_pos, or_true, mul_lt_mul_iff_right₀, + Order.lt_add_one_iff] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, Bool.false_eq_true, + ↓reduceIte, + canonicalBodyOutput] using hbounded + | true => + cases counterLength with + | succ counterLength => + have hfirst := oneStep _ _ (canonical_literal_payload_step + position bit input + (List.replicate counterLength true) + field binary [] []) + have hrest := ih true position counterLength + (bit :: field) binary hbinary (by + intro hfalse + cases hfalse) + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + have hbounded := rebound (newBudget := canonicalBodyBudget binaryBound + (bit :: input) (counterLength + 1) field) + hfull (by + simp only [canonicalBodyBudget, List.length_cons, add_le_add_iff_right, + Nat.reduceLeDiff, + Order.add_one_le_iff, add_lt_add_iff_right, add_pos_iff, Order.lt_two_iff, + zero_le, mul_pos_iff_of_pos_left, + Nat.ofNat_pos, or_true, mul_lt_mul_iff_right₀, Order.lt_add_one_iff] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_succ, + canonicalBodyOutput] using hbounded + | zero => + cases field with + | nil => + by_cases hposition : position = 2 + · subst position + have hfirst := oneStep _ _ (canonical_zero_field_completeClause + bit input binary [] []) + cases hdecrement : + binaryStackDecrement binary with + | none => + have hreject := + canonical_decrementNoneFailureTrace + binary hdecrement input + have hfull := + EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hfirst hreject + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound (bit :: input) 0 []) + hfull (by + simp only [canonicalBodyBudget, List.length_cons, add_zero, + List.length_nil, add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput, hdecrement] using hbounded + | some remaining => + have hremaining : + remaining.length ≤ binaryBound := by + rw [binaryStackDecrement_length + binary remaining hdecrement] + exact hbinary + have hborrow := canonicalDecrementSomeTrace + binary remaining hdecrement + input [] [] [] + have hrest := ih false 0 0 [] remaining + hremaining (by intro _; rfl) + have hstart := + EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hfirst hborrow + have hfull := + EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hstart hrest + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound (bit :: input) 0 []) + hfull (by + simp only [canonicalBodyBudget, add_zero, List.length_nil, + List.length_cons] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput, hdecrement] using hbounded + · have hfirst := oneStep _ _ (canonical_zero_field_sign_step position + hposition bit input binary [] []) + have hrest := ih false + (nextLiteralPosition position) 0 [] binary + hbinary (by intro _; rfl) + have hfull := + EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hfirst hrest + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound (bit :: input) 0 []) + hfull (by + simp only [canonicalBodyBudget, add_zero, List.length_nil, + List.length_cons, add_le_add_iff_right, + Nat.reduceLeDiff, Order.add_one_le_iff, add_lt_add_iff_right, + add_pos_iff, Order.lt_two_iff, zero_le, + mul_pos_iff_of_pos_left, Nat.ofNat_pos, or_true, mul_lt_mul_iff_right₀, + Order.lt_add_one_iff, lt_add_iff_pos_right, + Order.lt_one_iff]) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput, hposition] using hbounded + | cons fieldBit field => + cases fieldBit with + | false => + have hfailure := canonical_failFromStep + (canonicalConfiguration + (canonicalPayloadLabel position) + (bit :: input) [] + (false :: field) binary [] []) + (bit :: input) [] + (false :: field) binary [] + (canonical_literal_field_false position + (bit :: input) field binary [] []) + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound (bit :: input) + 0 (false :: field)) + hfailure (by + simp only [List.length_cons, List.length_nil, add_zero, + canonicalBodyBudget, add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput] using hbounded + | true => + have hcheck := oneStep _ _ (canonical_literal_field_true position + (bit :: input) field binary [] []) + by_cases hposition : position = 2 + · subst position + have hclear := canonicalClearThirdFieldTrace + (true :: field) bit input binary [] [] + have hchecked := + EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hcheck hclear + cases hdecrement : + binaryStackDecrement binary with + | none => + have hreject := + canonical_decrementNoneFailureTrace + binary hdecrement input + have hfull := + EvalsToInTime.trans canonicalFormulaMachine.step + _ _ _ _ _ hchecked hreject + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound (bit :: input) + 0 (true :: field)) + hfull (by + simp only [List.length_cons, canonicalBodyBudget, add_zero] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput, hdecrement] using hbounded + | some remaining => + have hremaining : + remaining.length ≤ binaryBound := by + rw [binaryStackDecrement_length + binary remaining hdecrement] + exact hbinary + have hborrow := + canonicalDecrementSomeTrace + binary remaining hdecrement + input [] [] [] + have hrest := ih false 0 0 [] remaining + hremaining (by intro _; rfl) + have hborrowed := + EvalsToInTime.trans canonicalFormulaMachine.step + _ _ _ _ _ hchecked hborrow + have hfull := + EvalsToInTime.trans canonicalFormulaMachine.step + _ _ _ _ _ hborrowed hrest + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound (bit :: input) + 0 (true :: field)) + hfull (by + simp only [canonicalBodyBudget, add_zero, List.length_nil, + List.length_cons] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput, hdecrement] using hbounded + · have hclear := canonicalClearFieldTrace + position hposition (true :: field) + bit input binary [] [] + have hchecked := + EvalsToInTime.trans canonicalFormulaMachine.step + _ _ _ _ _ hcheck hclear + have hrest := ih false + (nextLiteralPosition position) 0 [] binary + hbinary (by intro _; rfl) + have hfull := + EvalsToInTime.trans canonicalFormulaMachine.step + _ _ _ _ _ hchecked hrest + have hbounded := rebound (newBudget := canonicalBodyBudget + binaryBound (bit :: input) + 0 (true :: field)) + hfull (by + simp only [canonicalBodyBudget, add_zero, List.length_nil, + List.length_cons] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, canonicalBodyPhase, ↓reduceIte, + List.replicate_zero, + canonicalBodyOutput, hposition] using hbounded + +private def canonical_headerMissingPrefixTrace + (count : ℕ) + (counter field binary borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 0 (List.replicate count + true) + counter field binary borrow output) + (some (canonicalConfiguration 15 [] + (List.replicate count true ++ counter) + field binary borrow output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (canonical_header_prefix_missing counter field binary borrow output) + | succ count ih => + have hfirst := oneStep _ _ (canonical_header_prefix_true + (List.replicate count true) + counter field binary borrow output) + have hrest := ih (true :: counter) + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def canonical_headerMissingTrace (count : ℕ) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 0 + (List.replicate count true) [] [] [] [] []) + (some (Turing.haltList canonicalFormulaMachine [false])) + (2 * count + 2) := by + have hprefix := canonical_headerMissingPrefixTrace + count [] [] [] [] [] + simp only [List.append_nil] at hprefix + have hcleanup := canonicalFailureTrace [] + (List.replicate count true) [] [] [] [] + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hprefix hcleanup + apply rebound hfull + simp only [List.length_nil, List.length_replicate] + omega + +private def canonical_headerPartialCopyTrace + (payload remaining field binary borrow output : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 1 payload + (List.replicate payload.length true ++ remaining) + field binary borrow output) + (some (canonicalConfiguration 1 [] remaining + (payload.reverse ++ field) binary borrow output)) + payload.length := by + induction payload generalizing field with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + List.reverse_nil] using + EvalsToInTime.refl canonicalFormulaMachine.step (canonicalConfiguration 1 [] remaining + field binary borrow output) + | cons bit payload ih => + have hfirst := oneStep _ _ (canonical_header_payload_step bit payload + (List.replicate payload.length true ++ remaining) + field binary borrow output) + have hrest := ih (bit :: field) + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, + List.cons_append, + List.reverse_cons, List.append_assoc, List.nil_append] using hfull + +private def canonical_headerTruncatedTrace + (payload : List Bool) (extra : ℕ) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 0 + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) + [] [] [] [] []) + (some (Turing.haltList canonicalFormulaMachine [false])) + (3 * payload.length + 2 * extra + 6) := by + have hprefix := canonicalHeaderPrefixTrace + (payload.length + extra + 1) payload [] [] [] [] [] + simp only [List.append_nil] at hprefix + have hcounter : + List.replicate (payload.length + extra + 1) true = + List.replicate payload.length true ++ + List.replicate (extra + 1) true := by + rw [show payload.length + extra + 1 = + payload.length + (extra + 1) by omega, + List.replicate_add] + have hcopy := canonical_headerPartialCopyTrace payload + (List.replicate (extra + 1) true) [] [] [] [] + simp only [List.append_nil] at hcopy + rw [← hcounter] at hcopy + have hmissing : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 1 [] + (List.replicate (extra + 1) true) + payload.reverse [] [] []) + (some (canonicalConfiguration 15 [] + (List.replicate (extra + 1) true) + payload.reverse [] [] [])) 1 := by + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ] using + oneStep _ _ (canonical_header_payload_missing (List.replicate extra true) payload.reverse + [] [] []) + have hcleanup := canonicalFailureTrace [] + (List.replicate (extra + 1) true) + payload.reverse [] [] [] + have hstart := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hprefix hcopy + have hdetect := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hstart hmissing + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hdetect hcleanup + apply rebound hfull + simp only [List.length_nil, List.length_replicate, + List.length_reverse] + omega + +/-- GapCVP reduction support. -/ +def canonicalMachineOutput (input : List Bool) : List Bool := + match BinaryEncoding.readLengthPrefixedWord input with + | none => [false] + | some (header, body) => + if isCanonicalBinaryWord header then + [canonicalBodyOutput body false 0 0 [] header] + else + [false] + +@[simp] private theorem canonicalMachineOutput_lengthPrefixed + (header body : List Bool) : + canonicalMachineOutput + (BinaryEncoding.lengthPrefixedWord header ++ body) = + if isCanonicalBinaryWord header then + [canonicalBodyOutput body false 0 0 [] header] + else [false] := by + simp only [canonicalMachineOutput, BinaryEncoding.readLengthPrefixedWord_append, Fin.isValue] + +/-- GapCVP reduction support. -/ +def canonicalInputBudget (input : List Bool) : ℕ := + 64 * (input.length + 1) * (input.length + 1) + 64 + +private def canonical_headerValidTrace (header body : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 0 + (BinaryEncoding.lengthPrefixedWord header ++ body) + [] [] [] [] []) + (some (Turing.haltList canonicalFormulaMachine + (canonicalMachineOutput + (BinaryEncoding.lengthPrefixedWord header ++ body)))) + (canonicalInputBudget + (BinaryEncoding.lengthPrefixedWord header ++ body)) := by + have hprefix := canonicalHeaderPrefixTrace + header.length (header ++ body) [] [] [] [] [] + simp only [List.append_nil] at hprefix + have hcopy := canonicalHeaderCopyTrace + header body [] [] [] [] + simp only [List.append_nil] at hcopy + have hcomplete := oneStep _ _ (canonical_header_payload_complete + body header.reverse [] [] []) + have hfirst := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hprefix hcopy + have hchecked := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hfirst hcomplete + cases hreverse : header.reverse with + | nil => + have hempty : header = [] := by + simpa only [List.reverse_reverse, List.reverse_nil] using congrArg List.reverse hreverse + subst header + have hzero := oneStep _ _ (canonical_header_check_zero body [] [] []) + have hbody := canonicalBodyTrace + 0 body false 0 0 [] [] (by simp only [List.length_nil, Std.le_refl]) (by intro _; rfl) + have hstart := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hchecked hzero + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ hstart hbody + have hbounded := rebound (newBudget := canonicalInputBudget + (BinaryEncoding.lengthPrefixedWord [] ++ body)) + hfull (by + simp only [canonicalBodyBudget, mul_zero, zero_add, add_zero, List.length_nil, + Nat.reduceAdd, + canonicalInputBudget, BinaryEncoding.lengthPrefixedWord, List.replicate_zero, + List.nil_append, List.cons_append, + List.length_cons, add_le_add_iff_right] + nlinarith) + rw [canonicalMachineOutput_lengthPrefixed] + simp only [isCanonicalBinaryWord, List.reverse_nil, ↓reduceIte] + simpa only [BinaryEncoding.lengthPrefixedWord, + List.length_nil, List.replicate_zero, List.nil_append, + List.append_assoc, List.cons_append] using hbounded + | cons highBit reversedTail => + cases highBit with + | false => + rw [hreverse] at hchecked + have hreject := oneStep _ _ (canonical_header_check_false + body reversedTail [] [] []) + have hcleanup := canonicalFailureTrace + body [] (false :: reversedTail) [] [] [] + have hstart := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hchecked hreject + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hstart hcleanup + have hlength : + reversedTail.length + 1 = header.length := by + have heq := congrArg List.length hreverse + simpa only [List.length_cons, List.length_reverse] using heq.symm + have hcanonical : + isCanonicalBinaryWord header = false := by + simp only [isCanonicalBinaryWord, hreverse] + have hbounded := rebound (newBudget := canonicalInputBudget + (BinaryEncoding.lengthPrefixedWord + header ++ body)) + hfull (by + simp only [List.length_nil, add_zero, List.length_cons, canonicalInputBudget, + BinaryEncoding.lengthPrefixedWord, List.append_assoc, List.cons_append, + List.length_append, List.length_replicate] + nlinarith only [hlength, + Nat.zero_le header.length, + Nat.zero_le body.length, + Nat.zero_le reversedTail.length]) + rw [canonicalMachineOutput_lengthPrefixed, hcanonical] + simp only [Bool.false_eq_true, ↓reduceIte] + simpa only [BinaryEncoding.lengthPrefixedWord, + List.append_assoc, List.cons_append] using hbounded + | true => + rw [hreverse] at hchecked + have hcanonical : + isCanonicalBinaryWord header = true := by + simp only [isCanonicalBinaryWord, hreverse] + have hbits : + (true :: reversedTail).reverse = header := by + simpa only [List.reverse_cons, List.reverse_reverse] using (congrArg List.reverse + hreverse).symm + have hpositive := oneStep _ _ (canonical_header_check_true + body reversedTail [] [] []) + have hrestore := canonicalHeaderReverseTrace + (true :: reversedTail) body [] [] [] + simp only [List.append_nil] at hrestore + rw [hbits] at hrestore + have hbody := canonicalBodyTrace + header.length body false 0 0 [] header + (Nat.le_refl _) (by intro _; rfl) + have hstart := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hchecked hpositive + have hrestored := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hstart hrestore + have hfull := EvalsToInTime.trans canonicalFormulaMachine.step _ _ _ _ _ + hrestored hbody + have hlength : + reversedTail.length + 1 = header.length := by + have heq := congrArg List.length hreverse + simpa only [List.length_cons, List.length_reverse] using heq.symm + have hbounded := rebound (newBudget := canonicalInputBudget + (BinaryEncoding.lengthPrefixedWord + header ++ body)) + hfull (by + simp only [canonicalBodyBudget, add_zero, List.length_nil, List.length_cons, + canonicalInputBudget, + BinaryEncoding.lengthPrefixedWord, List.append_assoc, List.cons_append, + List.length_append, List.length_replicate] + nlinarith only [hlength, + Nat.zero_le header.length, + Nat.zero_le body.length, + Nat.zero_le reversedTail.length]) + rw [canonicalMachineOutput_lengthPrefixed, hcanonical] + simp only [↓reduceIte] + simpa only [BinaryEncoding.lengthPrefixedWord, + List.append_assoc, List.cons_append] using hbounded + +@[simp] private theorem canonicalMachineOutput_missing (count : ℕ) : + canonicalMachineOutput (List.replicate count true) = [false] := by + simp only [canonicalMachineOutput, BinaryEncoding.readLengthPrefixedWord, + readUnaryPrefix_missing] + +@[simp] private theorem canonicalMachineOutput_truncated + (payload : List Bool) (extra : ℕ) : + canonicalMachineOutput + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) = [false] := by + have hshort : ¬ payload.length + extra + 1 ≤ payload.length := by + omega + simp only [canonicalMachineOutput, BinaryEncoding.readLengthPrefixedWord, + BinaryEncoding.readUnaryPrefix_replicate, hshort, ↓reduceIte] + +/-- GapCVP reduction support. -/ +def canonicalTotalTrace (input : List Bool) : + EvalsToInTime canonicalFormulaMachine.step (canonicalConfiguration 0 input [] [] [] [] []) + (some (Turing.haltList canonicalFormulaMachine + (canonicalMachineOutput input))) + (canonicalInputBudget input) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + have htrace := canonical_headerMissingTrace count + have hbounded := rebound (newBudget := canonicalInputBudget + (List.replicate count true)) + htrace (by + simp only [canonicalInputBudget, List.length_replicate, add_le_add_iff_right] + nlinarith) + simpa only [canonicalMachineOutput_missing] using hbounded + | inr witness => + obtain ⟨count, tail, hinput⟩ := witness + subst input + by_cases hlength : count ≤ tail.length + · have hreconstruct := validInput_reconstruct count tail hlength + rw [hreconstruct] + exact canonical_headerValidTrace + (tail.take count) (tail.drop count) + · have hshort : tail.length < count := + Nat.lt_of_not_ge hlength + let extra := count - tail.length - 1 + have hcount : count = tail.length + extra + 1 := by + dsimp [extra] + omega + rw [hcount] + have htrace := canonical_headerTruncatedTrace tail extra + have hbounded := rebound (newBudget := canonicalInputBudget + (List.replicate (tail.length + extra + 1) true ++ + false :: tail)) + htrace (by + simp only [canonicalInputBudget, List.length_append, List.length_replicate, + List.length_cons, + add_le_add_iff_right] + nlinarith) + simpa only [canonicalMachineOutput_truncated] + using hbounded + +end FormulaTotalCert + +namespace FormulaSemanticCert + +open Turing GapCVP.SourceTotalStructuralDecoder GapCVP.SourceVariableFormulaDecoder +open GapCVP.FormulaTuringTM GapCVP.FormulaCert GapCVP.FormulaTotalCert + +private theorem canonicalBinaryWord_tail + (bit : Bool) (tail : List Bool) + (hcanonical : isCanonicalBinaryWord (bit :: tail) = true) : + isCanonicalBinaryWord tail = true := by + cases hreverse : tail.reverse with + | nil => + simp only [isCanonicalBinaryWord, hreverse] + | cons high remaining => + cases high with + | false => + simp only [isCanonicalBinaryWord, List.reverse_cons, hreverse, List.cons_append, + Bool.false_eq_true] at hcanonical + | true => + simp only [isCanonicalBinaryWord, hreverse] + +private theorem canonicalBinaryWord_zero + (word : List Bool) + (hcanonical : isCanonicalBinaryWord word = true) + (hzero : binaryStackValue word = 0) : + word = [] := by + cases word with + | nil => + rfl + | cons bit tail => + cases hreverse : (bit :: tail).reverse with + | nil => + have hlength := congrArg List.length hreverse + simp only [List.reverse_cons, List.length_append, List.length_reverse, List.length_cons, + List.length_nil, + zero_add, Nat.add_eq_zero_iff, List.length_eq_zero_iff, one_ne_zero, and_false] + at hlength + | cons high remaining => + have hmember : high ∈ bit :: tail := by + have hreversed : high ∈ (bit :: tail).reverse := by + rw [hreverse] + simp only [List.mem_cons, true_or] + simpa only [List.mem_cons, List.reverse_cons, List.mem_append, List.mem_reverse, + List.not_mem_nil, or_comm, + false_or] using hreversed + have hfalse := + (binaryStackValue_eq_zero_iff (bit :: tail)).mp + hzero high hmember + cases high with + | false => + simp only [isCanonicalBinaryWord, hreverse, Bool.false_eq_true] at hcanonical + | true => + cases hfalse + +private theorem canonicalBinaryWord_injective + (first second : List Bool) + (hfirst : isCanonicalBinaryWord first = true) + (hsecond : isCanonicalBinaryWord second = true) + (hvalue : binaryStackValue first = binaryStackValue second) : + first = second := by + induction first generalizing second with + | nil => + have hzero : binaryStackValue second = 0 := by + simpa only [binaryStackValue] using hvalue.symm + exact (canonicalBinaryWord_zero second hsecond hzero).symm + | cons firstBit firstTail ih => + cases second with + | nil => + have hzero : + binaryStackValue (firstBit :: firstTail) = 0 := by + simpa only [binaryStackValue, Nat.add_eq_zero_iff, ite_eq_right_iff, one_ne_zero, + imp_false, Bool.not_eq_true, + mul_eq_zero, OfNat.ofNat_ne_zero, false_or] using hvalue + have hempty := canonicalBinaryWord_zero + (firstBit :: firstTail) hfirst hzero + cases hempty + | cons secondBit secondTail => + have hfirstTail := canonicalBinaryWord_tail + firstBit firstTail hfirst + have hsecondTail := canonicalBinaryWord_tail + secondBit secondTail hsecond + cases firstBit <;> cases secondBit + · have htail : + binaryStackValue firstTail = + binaryStackValue secondTail := by + simp only [binaryStackValue] at hvalue + omega + exact congrArg (List.cons false) + (ih secondTail hfirstTail hsecondTail htail) + · simp only [binaryStackValue, Bool.false_eq_true, + ↓reduceIte, Nat.zero_add] at hvalue + omega + · simp only [binaryStackValue, Bool.false_eq_true, + ↓reduceIte, Nat.zero_add] at hvalue + omega + · have htail : + binaryStackValue firstTail = + binaryStackValue secondTail := by + simp only [binaryStackValue, + ↓reduceIte] at hvalue + omega + exact congrArg (List.cons true) + (ih secondTail hfirstTail hsecondTail htail) + +private theorem canonicalBinaryWord_encodeNat + (word : List Bool) + (hcanonical : isCanonicalBinaryWord word = true) : + Computability.encodeNat (binaryStackValue word) = word := by + apply canonicalBinaryWord_injective + (Computability.encodeNat (binaryStackValue word)) word + (encodeNat_canonical (binaryStackValue word)) hcanonical + exact binaryStackValue_encodeNat (binaryStackValue word) + +private theorem canonicalBinaryWord_decodeNat + (word : List Bool) + (hcanonical : isCanonicalBinaryWord word = true) : + binaryStackValue word = Computability.decodeNat word := by + have hword := canonicalBinaryWord_encodeNat word hcanonical + have hdecoded := congrArg Computability.decodeNat hword + simpa only [Computability.decode_encodeNat] using hdecoded + +private theorem canonicalBodyOutput_prefix + (length : ℕ) (tail : List Bool) + (position : Fin 3) (counter : ℕ) + (field binary : List Bool) : + canonicalBodyOutput + (List.replicate length true ++ false :: tail) + false position counter field binary = + canonicalBodyOutput tail true position + (counter + length) field binary := by + induction length generalizing counter with + | zero => + simp only [List.replicate_zero, List.nil_append, canonicalBodyOutput, Bool.false_eq_true, + ↓reduceIte, + add_zero] + | succ length ih => + simp only [List.replicate_succ, List.cons_append, canonicalBodyOutput, ↓reduceIte, ih, + Nat.add_comm, + Nat.add_left_comm] + +private theorem canonicalBodyOutput_missingPrefix + (length : ℕ) (position : Fin 3) (counter : ℕ) + (field binary : List Bool) : + canonicalBodyOutput (List.replicate length true) + false position counter field binary = + canonicalBodyOutput [] false position + (counter + length) field binary := by + induction length generalizing counter with + | zero => + simp only [List.replicate_zero, add_zero] + | succ length ih => + simp only [List.replicate_succ, canonicalBodyOutput, ↓reduceIte, ih, Nat.add_comm, + Nat.add_left_comm] + +private theorem canonicalBodyOutput_payload + (payload tail : List Bool) + (position : Fin 3) (counter : ℕ) + (field binary : List Bool) : + canonicalBodyOutput (payload ++ tail) + true position (payload.length + counter) field binary = + canonicalBodyOutput tail true position counter + (payload.reverse ++ field) binary := by + induction payload generalizing counter field with + | nil => + simp only [List.nil_append, List.length_nil, zero_add, List.reverse_nil] + | cons bit payload ih => + simpa only [List.cons_append, List.length_cons, Nat.add_comm, canonicalBodyOutput, + Nat.add_eq, + List.reverse_cons, List.append_assoc, List.nil_append] using ih counter (bit :: field) + +private theorem canonicalBodyOutput_canonicalSign + (sign : Bool) (suffix : List Bool) (position : Fin 3) + (word binary : List Bool) + (hcanonical : isCanonicalBinaryWord word = true) : + canonicalBodyOutput (sign :: suffix) + true position 0 word.reverse binary = + if position = 2 then + match binaryStackDecrement binary with + | none => false + | some remaining => + canonicalBodyOutput suffix false 0 0 [] remaining + else + canonicalBodyOutput suffix false + (nextLiteralPosition position) 0 [] binary := by + cases hreverse : word.reverse with + | nil => + simp only [canonicalBodyOutput] + | cons high remaining => + cases high with + | false => + simp only [isCanonicalBinaryWord, hreverse, Bool.false_eq_true] at hcanonical + | true => + simp only [canonicalBodyOutput] + +private theorem canonicalBodyOutput_literal_extract + (input : List Bool) (position : Fin 3) (binary : List Bool) + (hnonempty : input ≠ []) + (haccept : canonicalBodyOutput input + false position 0 [] binary = true) : + ∃ (literal : Literal) (suffix : List Bool), + input = BinaryEncoding.encodeLiteral literal ++ suffix ∧ + (if position = 2 then + match binaryStackDecrement binary with + | none => false + | some remaining => + canonicalBodyOutput suffix false 0 0 [] remaining + else + canonicalBodyOutput suffix false + (nextLiteralPosition position) 0 [] binary) = true := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hshape⟩ := witness + subst input + cases count with + | zero => + exact (hnonempty rfl).elim + | succ count => + rw [canonicalBodyOutput_missingPrefix] at haccept + simp only [zero_add, canonicalBodyOutput, Bool.false_eq_true] at haccept + | inr witness => + obtain ⟨count, tail, hshape⟩ := witness + subst input + have hprefix := canonicalBodyOutput_prefix + count tail position 0 [] binary + simp only [Nat.zero_add] at hprefix + rw [hprefix] at haccept + by_cases hlength : count ≤ tail.length + · let word := tail.take count + let remaining := tail.drop count + have hsplit : tail = word ++ remaining := by + dsimp [word, remaining] + exact (List.take_append_drop count tail).symm + have hwordlength : word.length = count := by + simp only [List.length_take, min_eq_left hlength, word] + rw [hsplit, ← hwordlength] at haccept + have hpayload := canonicalBodyOutput_payload + word remaining position 0 [] binary + simp only [Nat.add_zero, List.append_nil] at hpayload + rw [hpayload] at haccept + cases hremaining : remaining with + | nil => + simp only [hremaining, canonicalBodyOutput, Bool.false_eq_true] at haccept + | cons sign suffix => + have hcanonical : isCanonicalBinaryWord word = true := by + cases hreverse : word.reverse with + | nil => + simp only [isCanonicalBinaryWord, hreverse] + | cons high reverseTail => + cases high with + | false => + simp only [hremaining, hreverse, canonicalBodyOutput, Bool.false_eq_true] + at haccept + | true => + simp only [isCanonicalBinaryWord, hreverse] + have hword : + Computability.encodeNat + (Computability.decodeNat word) = word := by + rw [← canonicalBinaryWord_decodeNat word hcanonical] + exact canonicalBinaryWord_encodeNat word hcanonical + refine ⟨(Computability.decodeNat word, sign), + suffix, ?_, ?_⟩ + · have htail : tail = word ++ sign :: suffix := by + simpa only [hremaining] using hsplit + simp only [htail, BinaryEncoding.encodeLiteral, BinaryEncoding.lengthPrefixedWord, + hword, hwordlength, + List.append_assoc, List.cons_append, List.nil_append] + · have hsign := canonicalBodyOutput_canonicalSign + sign suffix position word binary hcanonical + rw [hremaining] at haccept + rw [hsign] at haccept + exact haccept + · have hshort : tail.length < count := + Nat.lt_of_not_ge hlength + let extra := count - tail.length + have hcount : count = tail.length + extra := by + dsimp [extra] + omega + rw [hcount] at haccept + have hpayload := canonicalBodyOutput_payload + tail [] position extra [] binary + simp only [List.append_nil] at hpayload + rw [hpayload] at haccept + simp only [canonicalBodyOutput, Bool.false_eq_true] at haccept + +private theorem canonicalBodyOutput_literal + (literal : Literal) (suffix : List Bool) + (position : Fin 3) (binary : List Bool) : + canonicalBodyOutput + (BinaryEncoding.encodeLiteral literal ++ suffix) + false position 0 [] binary = + if position = 2 then + match binaryStackDecrement binary with + | none => false + | some remaining => + canonicalBodyOutput suffix false 0 0 [] remaining + else + canonicalBodyOutput suffix false + (nextLiteralPosition position) 0 [] binary := by + rcases literal with ⟨index, sign⟩ + let word := Computability.encodeNat index + have hprefix := canonicalBodyOutput_prefix word.length + (word ++ sign :: suffix) position 0 [] binary + simp only [Nat.zero_add] at hprefix + have hpayload := canonicalBodyOutput_payload + word (sign :: suffix) position 0 [] binary + simp only [List.append_nil] at hpayload + have hsign := canonicalBodyOutput_canonicalSign + sign suffix position word binary (encodeNat_canonical index) + dsimp [word] at hprefix hpayload hsign ⊢ + simpa only [BinaryEncoding.encodeLiteral, BinaryEncoding.lengthPrefixedWord, List.append_assoc, + List.cons_append, List.nil_append, Fin.isValue] using hprefix.trans (hpayload.trans hsign) + +private theorem canonicalBodyOutput_clause + (clause : ThreeClause) (suffix binary : List Bool) : + canonicalBodyOutput + (BinaryEncoding.encodeThreeClause clause ++ suffix) + false 0 0 [] binary = + match binaryStackDecrement binary with + | none => false + | some remaining => + canonicalBodyOutput suffix false 0 0 [] remaining := by + simp only [BinaryEncoding.encodeThreeClause, Fin.isValue, List.append_assoc, + canonicalBodyOutput_literal, + Fin.reduceEq, ↓reduceIte, nextLiteralPosition, one_ne_zero] + +private theorem canonicalBodyOutput_clause_extract + (input binary : List Bool) + (hnonempty : input ≠ []) + (haccept : canonicalBodyOutput + input false 0 0 [] binary = true) : + ∃ (clause : ThreeClause) (suffix remaining : List Bool), + input = BinaryEncoding.encodeThreeClause clause ++ suffix ∧ + binaryStackDecrement binary = some remaining ∧ + canonicalBodyOutput suffix false 0 0 [] remaining = true := by + obtain ⟨first, firstRest, hfirst, hfirstAccept⟩ := + canonicalBodyOutput_literal_extract + input 0 binary hnonempty haccept + have hfirstPhase : + canonicalBodyOutput firstRest false 1 0 [] binary = true := by + simpa only [Fin.isValue, Fin.reduceEq, ↓reduceIte, nextLiteralPosition] using hfirstAccept + have hfirstNonempty : firstRest ≠ [] := by + intro hempty + subst firstRest + simp only [Fin.isValue, canonicalBodyOutput, one_ne_zero, ↓reduceIte, Bool.false_eq_true] + at hfirstPhase + obtain ⟨second, secondRest, hsecond, hsecondAccept⟩ := + canonicalBodyOutput_literal_extract + firstRest 1 binary hfirstNonempty hfirstPhase + have hsecondPhase : + canonicalBodyOutput secondRest false 2 0 [] binary = true := by + simpa only [Fin.isValue, Fin.reduceEq, ↓reduceIte, nextLiteralPosition, one_ne_zero] + using hsecondAccept + have hsecondNonempty : secondRest ≠ [] := by + intro hempty + subst secondRest + simp only [Fin.isValue, canonicalBodyOutput, Fin.reduceEq, ↓reduceIte, Bool.false_eq_true] + at hsecondPhase + obtain ⟨third, suffix, hthird, hthirdAccept⟩ := + canonicalBodyOutput_literal_extract + secondRest 2 binary hsecondNonempty hsecondPhase + simp only [↓reduceIte] at hthirdAccept + cases hdecrement : binaryStackDecrement binary with + | none => + simp only [hdecrement, Bool.false_eq_true] at hthirdAccept + | some remaining => + have hremaining : + canonicalBodyOutput suffix false 0 0 [] remaining = true := by + simpa only [Fin.isValue, hdecrement] using hthirdAccept + refine ⟨![first, second, third], suffix, remaining, + ?_, rfl, hremaining⟩ + calc + input = BinaryEncoding.encodeLiteral first ++ + firstRest := hfirst + _ = BinaryEncoding.encodeLiteral first ++ + (BinaryEncoding.encodeLiteral second ++ + secondRest) := by rw [hsecond] + _ = BinaryEncoding.encodeLiteral first ++ + (BinaryEncoding.encodeLiteral second ++ + (BinaryEncoding.encodeLiteral third ++ + suffix)) := by rw [hthird] + _ = BinaryEncoding.encodeThreeClause + ![first, second, third] ++ suffix := by + simp only [BinaryEncoding.encodeThreeClause, Fin.isValue, Matrix.cons_val_zero, + Matrix.cons_val_one, + Matrix.cons_val, List.append_assoc] + +theorem readLengthPrefixedWord_some_reconstruct + (input word suffix : List Bool) + (hread : BinaryEncoding.readLengthPrefixedWord input = + some (word, suffix)) : + input = BinaryEncoding.lengthPrefixedWord word ++ suffix := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hshape⟩ := witness + subst input + simp only [BinaryEncoding.readLengthPrefixedWord, readUnaryPrefix_missing, reduceCtorEq] + at hread + | inr witness => + obtain ⟨count, tail, hshape⟩ := witness + subst input + by_cases hlength : count ≤ tail.length + · have hpair : + (tail.take count, tail.drop count) = + (word, suffix) := by + simpa only [Prod.mk.injEq, BinaryEncoding.readLengthPrefixedWord, + BinaryEncoding.readUnaryPrefix_replicate, + hlength, ↓reduceIte, Option.some.injEq] using hread + cases hpair + exact validInput_reconstruct count tail hlength + · simp only [BinaryEncoding.readLengthPrefixedWord, BinaryEncoding.readUnaryPrefix_replicate, + hlength, + ↓reduceIte, reduceCtorEq] at hread + +private theorem canonicalBodyOutput_accepted_extract + (fuel : ℕ) (input binary : List Bool) + (hlength : input.length ≤ fuel) + (haccept : canonicalBodyOutput + input false 0 0 [] binary = true) : + ∃ clauses : ThreeCNF, + input = clauses.flatMap + BinaryEncoding.encodeThreeClause ∧ + clauses.length = binaryStackValue binary := by + induction fuel using Nat.strong_induction_on + generalizing input binary with + | h fuel ih => + by_cases hempty : input = [] + · subst input + have hzero : binaryStackValue binary = 0 := by + simpa only [Fin.isValue, canonicalBodyOutput, ↓reduceIte, decide_eq_true_eq] + using haccept + exact ⟨[], rfl, hzero.symm⟩ + · obtain ⟨clause, suffix, remaining, + hshape, hdecrement, hrest⟩ := + canonicalBodyOutput_clause_extract + input binary hempty haccept + have hclause : + 0 < (BinaryEncoding.encodeThreeClause + clause).length := by + simp only [BinaryEncoding.encodeThreeClause, BinaryEncoding.encodeLiteral, + BinaryEncoding.lengthPrefixedWord, + Fin.isValue, List.append_assoc, List.cons_append, List.nil_append, + List.length_append, List.length_replicate, + List.length_cons, List.length_nil, zero_add, add_pos_iff, Order.lt_add_one_iff, + zero_le, or_true] + have hshort : suffix.length < fuel := by + have hinputlength : + input.length = + (BinaryEncoding.encodeThreeClause + clause).length + suffix.length := by + rw [hshape, List.length_append] + omega + obtain ⟨clauses, hsuffix, hcount⟩ := + ih suffix.length hshort suffix remaining + (Nat.le_refl _) hrest + refine ⟨clause :: clauses, ?_, ?_⟩ + · simpa only [List.flatMap_cons, hsuffix] using hshape + · have hvalue := binaryStackDecrement_value + binary remaining hdecrement + simp only [List.length_cons] + omega + +private theorem canonicalBodyOutput_clauses_valid + (clauses : ThreeCNF) (binary : List Bool) + (hcount : binaryStackValue binary = clauses.length) : + canonicalBodyOutput + (clauses.flatMap BinaryEncoding.encodeThreeClause) + false 0 0 [] binary = true := by + induction clauses generalizing binary with + | nil => + simp only [List.flatMap_nil, Fin.isValue, canonicalBodyOutput, ↓reduceIte, hcount, + List.length_nil, + decide_true] + | cons clause clauses ih => + have hpositive : 0 < binaryStackValue binary := by + simp only [List.length_cons] at hcount + omega + cases hdecrement : binaryStackDecrement binary with + | none => + obtain ⟨zeros, tail, hshape⟩ := + positiveBinarySplit binary hpositive + rw [hshape, binaryStackDecrement_replicate] at hdecrement + simp only [reduceCtorEq] at hdecrement + | some remaining => + have hremaining : + binaryStackValue remaining = clauses.length := by + have hvalue := binaryStackDecrement_value + binary remaining hdecrement + simp only [List.length_cons] at hcount + omega + simp only [List.flatMap_cons, Fin.isValue, canonicalBodyOutput_clause, hdecrement, ih + remaining hremaining] + +private theorem canonicalBodyOutput_eq_true_iff + (input binary : List Bool) : + canonicalBodyOutput input false 0 0 [] binary = true ↔ + ∃ clauses : ThreeCNF, + input = clauses.flatMap + BinaryEncoding.encodeThreeClause ∧ + clauses.length = binaryStackValue binary := by + constructor + · intro haccept + exact canonicalBodyOutput_accepted_extract + input.length input binary (Nat.le_refl _) haccept + · rintro ⟨clauses, hshape, hcount⟩ + subst input + exact canonicalBodyOutput_clauses_valid + clauses binary hcount.symm + +@[simp] private theorem canonicalMachineOutput_encodeThreeCNF + (clauses : ThreeCNF) : + canonicalMachineOutput + (BinaryEncoding.encodeThreeCNF clauses) = [true] := by + rw [BinaryEncoding.encodeThreeCNF] + rw [canonicalMachineOutput_lengthPrefixed] + rw [encodeNat_canonical] + simp only [↓reduceIte] + congr 1 + apply canonicalBodyOutput_clauses_valid + exact binaryStackValue_encodeNat clauses.length + +private theorem canonicalMachineOutput_eq_true_iff (input : List Bool) : + canonicalMachineOutput input = [true] ↔ + ∃ clauses : ThreeCNF, + BinaryEncoding.encodeThreeCNF clauses = input := by + constructor + · intro haccept + cases hread : + BinaryEncoding.readLengthPrefixedWord input with + | none => + simp only [canonicalMachineOutput, hread, List.cons.injEq, Bool.false_eq_true, and_true] + at haccept + | some parsed => + obtain ⟨header, body⟩ := parsed + cases hcanonical : isCanonicalBinaryWord header with + | false => + simp only [canonicalMachineOutput, hread, hcanonical, Bool.false_eq_true, ↓reduceIte, + List.cons.injEq, + and_true] at haccept + | true => + have hbody : + canonicalBodyOutput body + false 0 0 [] header = true := by + simpa only [Fin.isValue, canonicalMachineOutput, hread, hcanonical, ↓reduceIte, + List.cons.injEq, + and_true] using haccept + obtain ⟨clauses, hshape, hcount⟩ := + (canonicalBodyOutput_eq_true_iff body header).mp hbody + have hheader : + Computability.encodeNat clauses.length = header := by + rw [hcount] + exact canonicalBinaryWord_encodeNat header hcanonical + have hinput := readLengthPrefixedWord_some_reconstruct + input header body hread + refine ⟨clauses, ?_⟩ + calc + BinaryEncoding.encodeThreeCNF clauses = + BinaryEncoding.lengthPrefixedWord + header ++ clauses.flatMap + BinaryEncoding.encodeThreeClause := by + simp only [BinaryEncoding.encodeThreeCNF, hheader] + _ = BinaryEncoding.lengthPrefixedWord + header ++ body := by rw [← hshape] + _ = input := hinput.symm + · rintro ⟨clauses, rfl⟩ + exact canonicalMachineOutput_encodeThreeCNF clauses + +private theorem canonicalMachineOutput_boolean (input : List Bool) : + canonicalMachineOutput input = [true] ∨ + canonicalMachineOutput input = [false] := by + cases hread : + BinaryEncoding.readLengthPrefixedWord input with + | none => + exact Or.inr (by simp only [canonicalMachineOutput, hread]) + | some parsed => + obtain ⟨header, body⟩ := parsed + cases hcanonical : isCanonicalBinaryWord header with + | false => + exact Or.inr (by + simp only [canonicalMachineOutput, hread, hcanonical, Bool.false_eq_true, ↓reduceIte]) + | true => + cases hbody : canonicalBodyOutput + body false 0 0 [] header with + | false => + exact Or.inr (by + simp only [canonicalMachineOutput, hread, hcanonical, ↓reduceIte, Fin.isValue, + hbody]) + | true => + exact Or.inl (by + simp only [canonicalMachineOutput, hread, hcanonical, ↓reduceIte, Fin.isValue, + hbody]) + +private theorem canonicalFormulaExpected_boolean (input : List Bool) : + canonicalFormulaExpected input = [true] ∨ + canonicalFormulaExpected input = [false] := by + cases hdecode : BinaryEncoding.decodeThreeCNF input with + | none => + exact Or.inr (by + simp only [canonicalFormulaExpected, hdecode]) + | some clauses => + by_cases hcanonical : + BinaryEncoding.encodeThreeCNF clauses = input + · exact Or.inl (by + simp only [canonicalFormulaExpected, hdecode, hcanonical, ↓reduceIte]) + · exact Or.inr (by + simp only [canonicalFormulaExpected, hdecode, hcanonical, ↓reduceIte]) + +theorem canonicalMachineOutput_eq_expected (input : List Bool) : + canonicalMachineOutput input = canonicalFormulaExpected input := by + rcases canonicalMachineOutput_boolean input with hmachine | hmachine + · have himage := + (canonicalMachineOutput_eq_true_iff input).mp hmachine + have hexpected := + (canonicalFormulaExpected_eq_true_iff input).mpr himage + exact hmachine.trans hexpected.symm + · rcases canonicalFormulaExpected_boolean input with + hexpected | hexpected + · have himage := + (canonicalFormulaExpected_eq_true_iff input).mp hexpected + have haccept := + (canonicalMachineOutput_eq_true_iff input).mpr himage + rw [hmachine] at haccept + simp only [List.cons.injEq, Bool.false_eq_true, and_true] at haccept + · exact hmachine.trans hexpected.symm + +end FormulaSemanticCert + +namespace CLStructuralNaturalBinaryWriter + +open Turing + +private def structuralBinaryIncrement : List Bool → List Bool + | [] => [true] + | false :: digits => true :: digits + | true :: digits => false :: structuralBinaryIncrement digits + +private theorem structuralBinaryIncrement_encodePosNum + (number : PosNum) : + structuralBinaryIncrement + (Computability.encodePosNum number) = + Computability.encodePosNum (PosNum.succ number) := by + induction number with + | one => + rfl + | bit0 number ih => + rfl + | bit1 number ih => + simp only [Computability.encodePosNum, structuralBinaryIncrement, ih, PosNum.succ] + +private theorem structuralBinaryIncrement_encodeNat (number : ℕ) : + structuralBinaryIncrement (Computability.encodeNat number) = + Computability.encodeNat (number + 1) := by + have hsucc : + ((number + 1 : ℕ) : Num) = + Num.succ (number : Num) := by + apply Num.to_nat_inj.mp + rw [Num.to_of_nat, Num.succ_to_nat, Num.to_of_nat] + change structuralBinaryIncrement + (Computability.encodeNum (number : Num)) = + Computability.encodeNum ((number + 1 : ℕ) : Num) + rw [hsucc] + generalize (number : Num) = encoded + cases encoded with + | zero => + rfl + | pos positive => + simpa only [Computability.encodeNum, Num.succ, Num.succ'] using + structuralBinaryIncrement_encodePosNum positive + +private def structuralBinaryCarrySplit : List Bool → ℕ × List Bool + | [] => (0, [true]) + | false :: digits => (0, true :: digits) + | true :: digits => + let result := structuralBinaryCarrySplit digits + (result.1 + 1, result.2) + +private theorem structuralBinaryIncrement_eq_carrySplit + (digits : List Bool) : + structuralBinaryIncrement digits = + List.replicate (structuralBinaryCarrySplit digits).1 false ++ + (structuralBinaryCarrySplit digits).2 := by + induction digits with + | nil => + simp only [structuralBinaryIncrement, structuralBinaryCarrySplit, List.replicate_zero, + List.nil_append] + | cons bit digits ih => + cases bit with + | false => + simp only [structuralBinaryIncrement, structuralBinaryCarrySplit, List.replicate_zero, + List.nil_append] + | true => + simp only [structuralBinaryIncrement, ih, structuralBinaryCarrySplit, + List.replicate_succ, List.cons_append] + +private theorem structuralBinaryCarrySplit_count_le + (digits : List Bool) : + (structuralBinaryCarrySplit digits).1 ≤ digits.length := by + induction digits with + | nil => + simp only [structuralBinaryCarrySplit, List.length_nil, Std.le_refl] + | cons bit digits ih => + cases bit <;> simp [structuralBinaryCarrySplit, ih] + +private theorem structuralBinaryIncrement_length_le + (digits : List Bool) : + (structuralBinaryIncrement digits).length ≤ digits.length + 1 := by + induction digits with + | nil => + simp only [structuralBinaryIncrement, List.length_cons, List.length_nil, zero_add, + Std.le_refl] + | cons bit digits ih => + cases bit with + | false => + simp only [structuralBinaryIncrement, List.length_cons, le_add_iff_nonneg_right, zero_le] + | true => + simpa only [structuralBinaryIncrement, List.length_cons, Nat.add_assoc, Nat.reduceAdd, + add_le_add_iff_right] using Nat.add_le_add_right ih 1 + +private def structuralBinaryIncrementN : ℕ → List Bool → List Bool + | 0, digits => digits + | count + 1, digits => + structuralBinaryIncrementN count + (structuralBinaryIncrement digits) + +private theorem structuralBinaryIncrementN_encodeNat + (count number : ℕ) : + structuralBinaryIncrementN count + (Computability.encodeNat number) = + Computability.encodeNat (number + count) := by + induction count generalizing number with + | zero => + simp only [structuralBinaryIncrementN, add_zero] + | succ count ih => + rw [structuralBinaryIncrementN, + structuralBinaryIncrement_encodeNat, ih] + congr 1 + omega + +private theorem structuralBinaryIncrementN_length_le + (count : ℕ) (digits : List Bool) : + (structuralBinaryIncrementN count digits).length ≤ + digits.length + count := by + induction count generalizing digits with + | zero => + simp only [structuralBinaryIncrementN, add_zero, Std.le_refl] + | succ count ih => + have hcarry := structuralBinaryIncrement_length_le digits + have hrest := ih (structuralBinaryIncrement digits) + simp only [structuralBinaryIncrementN] + omega + +private def naturalBinaryWriterPeek (stack : Fin 4) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def naturalBinaryWriterPop (stack : Fin 4) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + .pop stack (fun symbol _ => symbol) continuation + +private def naturalBinaryWriterPushBit (stack : Fin 4) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + .push stack (fun symbol => symbol.getD false) continuation + +private def naturalBinaryWriterPushConstant (stack : Fin 4) (bit : Bool) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + .push stack (fun _ => bit) continuation + +private def naturalBinaryWriterGoto (phase : Fin 5) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +private def naturalBinaryWriterInputStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + naturalBinaryWriterPeek 0 + (naturalBinaryWriterPop 0 (naturalBinaryWriterGoto 1)) + (naturalBinaryWriterGoto 3) + +private def naturalBinaryWriterCarryStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + naturalBinaryWriterPeek 1 + (.branch (fun symbol => symbol == some true) + (naturalBinaryWriterPop 1 + (naturalBinaryWriterPushConstant 2 false + (naturalBinaryWriterGoto 1))) + (naturalBinaryWriterPop 1 + (naturalBinaryWriterPushConstant 1 true + (naturalBinaryWriterGoto 2)))) + (naturalBinaryWriterPushConstant 1 true + (naturalBinaryWriterGoto 2)) + +private def naturalBinaryWriterRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + naturalBinaryWriterPeek 2 + (naturalBinaryWriterPop 2 + (naturalBinaryWriterPushBit 1 + (naturalBinaryWriterGoto 2))) + (naturalBinaryWriterGoto 0) + +private def naturalBinaryWriterPrepareStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + naturalBinaryWriterPeek 1 + (naturalBinaryWriterPop 1 + (naturalBinaryWriterPushBit 2 + (naturalBinaryWriterGoto 3))) + (naturalBinaryWriterGoto 4) + +private def naturalBinaryWriterOutputStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 5) (Option Bool) := + naturalBinaryWriterPeek 2 + (naturalBinaryWriterPop 2 + (naturalBinaryWriterPushBit 3 + (naturalBinaryWriterGoto 4))) + .halt + +private abbrev structuralNaturalBinaryWriter : Turing.FinTM2 where + K := Fin 4 + k₀ := 0 + k₁ := 3 + Γ _ := Bool + Λ := Fin 5 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 5) then + naturalBinaryWriterInputStatement + else if phase = (1 : Fin 5) then + naturalBinaryWriterCarryStatement + else if phase = (2 : Fin 5) then + naturalBinaryWriterRestoreStatement + else if phase = (3 : Fin 5) then + naturalBinaryWriterPrepareStatement + else + naturalBinaryWriterOutputStatement + +private def naturalBinaryWriterConfiguration (phase : Fin 5) + (input digits carry output : List Bool) : + structuralNaturalBinaryWriter.Cfg where + l := some phase + var := none + stk := ![input, digits, carry, output] + +private theorem structuralNaturalBinaryWriter_init (input : List Bool) : + Turing.initList structuralNaturalBinaryWriter input = + naturalBinaryWriterConfiguration 0 input [] [] [] := by + simp only [structuralNaturalBinaryWriter, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + naturalBinaryWriterConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `naturalBinaryWriterStepTac` machine-step simplifier. -/ +macro "naturalBinaryWriterStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [structuralNaturalBinaryWriter, + naturalBinaryWriterConfiguration, naturalBinaryWriterPeek, + naturalBinaryWriterPop, naturalBinaryWriterPushBit, + naturalBinaryWriterPushConstant, naturalBinaryWriterGoto, + naturalBinaryWriterInputStatement, + naturalBinaryWriterCarryStatement, + naturalBinaryWriterRestoreStatement, + naturalBinaryWriterPrepareStatement, + naturalBinaryWriterOutputStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem naturalBinaryWriter_input_step (bit : Bool) + (input digits carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 0 + (bit :: input) digits carry output) = + some (naturalBinaryWriterConfiguration 1 + input digits carry output) := by + cases bit <;> naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_input_finish + (digits carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 0 [] digits carry output) = + some (naturalBinaryWriterConfiguration 3 + [] digits carry output) := by + naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_carry_true_step + (input digits carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 1 + input (true :: digits) carry output) = + some (naturalBinaryWriterConfiguration 1 + input digits (false :: carry) output) := by + naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_carry_false_step + (input digits carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 1 + input (false :: digits) carry output) = + some (naturalBinaryWriterConfiguration 2 + input (true :: digits) carry output) := by + naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_carry_empty_step + (input carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 1 + input [] carry output) = + some (naturalBinaryWriterConfiguration 2 + input [true] carry output) := by + naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_restore_step (bit : Bool) + (input digits carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 2 + input digits (bit :: carry) output) = + some (naturalBinaryWriterConfiguration 2 + input (bit :: digits) carry output) := by + cases bit <;> naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_restore_finish + (input digits output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 2 + input digits [] output) = + some (naturalBinaryWriterConfiguration 0 + input digits [] output) := by + naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_prepare_step (bit : Bool) + (digits carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 3 + [] (bit :: digits) carry output) = + some (naturalBinaryWriterConfiguration 3 + [] digits (bit :: carry) output) := by + cases bit <;> naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_prepare_finish + (carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 3 [] [] carry output) = + some (naturalBinaryWriterConfiguration 4 + [] [] carry output) := by + naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_output_step (bit : Bool) + (carry output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 4 + [] [] (bit :: carry) output) = + some (naturalBinaryWriterConfiguration 4 + [] [] carry (bit :: output)) := by + cases bit <;> naturalBinaryWriterStepTac + +private theorem naturalBinaryWriter_output_finish (output : List Bool) : + structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 4 [] [] [] output) = + some (Turing.haltList structuralNaturalBinaryWriter output) := by + naturalBinaryWriterStepTac + +private def naturalBinaryWriter_carrySearchTrace + (input digits carry output : List Bool) : + EvalsToInTime structuralNaturalBinaryWriter.step (naturalBinaryWriterConfiguration 1 + input digits carry output) + (some (naturalBinaryWriterConfiguration 2 + input (structuralBinaryCarrySplit digits).2 + (List.replicate (structuralBinaryCarrySplit digits).1 false ++ + carry) + output)) + (digits.length + 1) := by + induction digits generalizing carry with + | nil => + simpa only [FinTM2.step, Fin.isValue, structuralBinaryCarrySplit, List.replicate_zero, + List.nil_append, + List.length_nil, zero_add] using oneStep _ _ (naturalBinaryWriter_carry_empty_step input + carry output) + | cons bit digits ih => + cases bit with + | false => + have hstep := oneStep _ _ (naturalBinaryWriter_carry_false_step + input digits carry output) + have hbounded := rebound (newBudget := (false :: digits).length + 1) + hstep (by simp only [List.length_cons, le_add_iff_nonneg_left, zero_le]) + simpa only [FinTM2.step, Fin.isValue, structuralBinaryCarrySplit, List.replicate_zero, + List.nil_append, + List.length_cons] using hbounded + | true => + have hfirst := oneStep _ _ (naturalBinaryWriter_carry_true_step + input digits carry output) + have hrest := ih (false :: carry) + have hfull := EvalsToInTime.trans structuralNaturalBinaryWriter.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, structuralBinaryCarrySplit, List.replicate_succ', + List.append_assoc, + List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hfull + +private def naturalBinaryWriter_carryRestoreTrace + (input digits carry output : List Bool) : + EvalsToInTime structuralNaturalBinaryWriter.step (naturalBinaryWriterConfiguration 2 + input digits carry output) + (some (naturalBinaryWriterConfiguration 0 + input (carry.reverse ++ digits) [] output)) + (carry.length + 1) := by + induction carry generalizing digits with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (naturalBinaryWriter_restore_finish input digits output) + | cons bit carry ih => + have hfirst := oneStep _ _ (naturalBinaryWriter_restore_step bit + input digits carry output) + have hrest := ih (bit :: digits) + have hfull := EvalsToInTime.trans structuralNaturalBinaryWriter.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def naturalBinaryWriter_carryTrace + (input digits output : List Bool) : + EvalsToInTime structuralNaturalBinaryWriter.step (naturalBinaryWriterConfiguration 1 + input digits [] output) + (some (naturalBinaryWriterConfiguration 0 + input (structuralBinaryIncrement digits) [] output)) + (2 * digits.length + 2) := by + have hsearch := naturalBinaryWriter_carrySearchTrace + input digits [] output + simp only [List.append_nil] at hsearch + have hrestore := naturalBinaryWriter_carryRestoreTrace + input (structuralBinaryCarrySplit digits).2 + (List.replicate (structuralBinaryCarrySplit digits).1 false) + output + simp only [List.reverse_replicate, List.length_replicate] at hrestore + have hfull := EvalsToInTime.trans structuralNaturalBinaryWriter.step _ _ _ _ _ hsearch hrestore + rw [← structuralBinaryIncrement_eq_carrySplit digits] at hfull + have hcount := structuralBinaryCarrySplit_count_le digits + exact rebound hfull (by omega) + +private def naturalBinaryWriterScanBudget : List Bool → List Bool → ℕ + | [], _ => 1 + | _ :: input, digits => + 1 + (2 * digits.length + 2) + + naturalBinaryWriterScanBudget input + (structuralBinaryIncrement digits) + +private def naturalBinaryWriter_scanTrace + (input digits output : List Bool) : + EvalsToInTime structuralNaturalBinaryWriter.step (naturalBinaryWriterConfiguration 0 + input digits [] output) + (some (naturalBinaryWriterConfiguration 3 [] + (structuralBinaryIncrementN input.length digits) + [] output)) + (naturalBinaryWriterScanBudget input digits) := by + induction input generalizing digits with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, structuralBinaryIncrementN, + naturalBinaryWriterScanBudget] using oneStep _ _ (naturalBinaryWriter_input_finish digits + [] output) + | cons bit input ih => + have hfirst := oneStep _ _ (naturalBinaryWriter_input_step bit + input digits [] output) + have hcarry := naturalBinaryWriter_carryTrace + input digits output + have hrest := ih (structuralBinaryIncrement digits) + have hfirstCarry := EvalsToInTime.trans structuralNaturalBinaryWriter.step + _ _ _ _ _ hfirst hcarry + have hfull := EvalsToInTime.trans structuralNaturalBinaryWriter.step + _ _ _ _ _ hfirstCarry hrest + have hbounded := rebound (newBudget := + naturalBinaryWriterScanBudget (bit :: input) digits) + hfull (by + simp only [naturalBinaryWriterScanBudget] + omega) + simpa only [FinTM2.step, Fin.isValue, List.length_cons, structuralBinaryIncrementN] + using hbounded + +private theorem naturalBinaryWriterScanBudget_le + (input digits : List Bool) : + naturalBinaryWriterScanBudget input digits ≤ + 2 * input.length * (digits.length + input.length + 1) + 1 := by + induction input generalizing digits with + | nil => + simp only [naturalBinaryWriterScanBudget, List.length_nil, mul_zero, add_zero, zero_mul, + zero_add, + Std.le_refl] + | cons bit input ih => + have hrecursive := ih (structuralBinaryIncrement digits) + have hlength := structuralBinaryIncrement_length_le digits + have hmonotone : + 2 * input.length * + ((structuralBinaryIncrement digits).length + + input.length + 1) ≤ + 2 * input.length * + (digits.length + input.length + 2) := by + apply Nat.mul_le_mul_left + omega + calc + naturalBinaryWriterScanBudget (bit :: input) digits = + 1 + (2 * digits.length + 2) + + naturalBinaryWriterScanBudget input + (structuralBinaryIncrement digits) := rfl + _ ≤ 1 + (2 * digits.length + 2) + + (2 * input.length * + (digits.length + input.length + 2) + 1) := by + omega + _ ≤ 2 * (bit :: input).length * + (digits.length + (bit :: input).length + 1) + 1 := by + simp only [List.length_cons] + linarith + +private def naturalBinaryWriter_prepareTrace + (digits carry output : List Bool) : + EvalsToInTime structuralNaturalBinaryWriter.step (naturalBinaryWriterConfiguration 3 + [] digits carry output) + (some (naturalBinaryWriterConfiguration 4 + [] [] (digits.reverse ++ carry) output)) + (digits.length + 1) := by + induction digits generalizing carry with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (naturalBinaryWriter_prepare_finish carry output) + | cons bit digits ih => + have hfirst := oneStep _ _ (naturalBinaryWriter_prepare_step bit digits carry output) + have hrest := ih (bit :: carry) + have hfull := EvalsToInTime.trans structuralNaturalBinaryWriter.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def naturalBinaryWriter_outputTrace + (carry output : List Bool) : + EvalsToInTime structuralNaturalBinaryWriter.step (naturalBinaryWriterConfiguration 4 + [] [] carry output) + (some (Turing.haltList structuralNaturalBinaryWriter + (carry.reverse ++ output))) + (carry.length + 1) := by + induction carry generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (naturalBinaryWriter_output_finish output) + | cons bit carry ih => + have hfirst := oneStep _ _ (naturalBinaryWriter_output_step bit carry output) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans structuralNaturalBinaryWriter.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def naturalBinaryWriter_totalTrace (input : List Bool) : + EvalsToInTime structuralNaturalBinaryWriter.step + (naturalBinaryWriterConfiguration 0 input [] [] []) + (some (Turing.haltList structuralNaturalBinaryWriter + (Computability.encodeNat input.length))) + (8 * (input.length + 1) ^ 2 + 8) := by + have hdigits : + structuralBinaryIncrementN input.length [] = + Computability.encodeNat input.length := by + simpa only [Computability.encodeNat, Computability.encodeNum, CharP.cast_eq_zero, zero_add] + using + structuralBinaryIncrementN_encodeNat input.length 0 + have hscan := naturalBinaryWriter_scanTrace input [] [] + rw [hdigits] at hscan + have hprepare := naturalBinaryWriter_prepareTrace + (Computability.encodeNat input.length) [] [] + simp only [List.append_nil] at hprepare + have houtput := naturalBinaryWriter_outputTrace + (Computability.encodeNat input.length).reverse [] + simp only [List.reverse_reverse, List.append_nil] at houtput + have hfirst := EvalsToInTime.trans structuralNaturalBinaryWriter.step _ _ _ _ _ hscan hprepare + have hfull := EvalsToInTime.trans structuralNaturalBinaryWriter.step _ _ _ _ _ hfirst houtput + have hscanBound := naturalBinaryWriterScanBudget_le input [] + simp only [List.length_nil, Nat.zero_add] at hscanBound + have hdigitBound := structuralBinaryIncrementN_length_le + input.length [] + rw [hdigits] at hdigitBound + simp only [List.length_nil, Nat.zero_add] at hdigitBound + have htotal : + (Computability.encodeNat input.length).length + 1 + + ((Computability.encodeNat input.length).length + 1 + + naturalBinaryWriterScanBudget input []) ≤ + 8 * (input.length + 1) ^ 2 + 8 := by + linarith [sq_nonneg (input.length + 1)] + exact rebound hfull (by + simpa only [List.length_reverse] using htotal) + +/-- GapCVP reduction support. -/ +noncomputable def structuralNaturalBinaryWriterComputable : + Turing.TM2ComputableInPolyTime GapCVP.bitEncoding + GapCVP.bitEncoding + (fun input : List Bool => + Computability.encodeNat input.length) where + tm := structuralNaturalBinaryWriter + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 8 * (Polynomial.X + 1) ^ 2 + 8 + outputsFun input := { + steps := (naturalBinaryWriter_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, structuralNaturalBinaryWriter_init, + Option.map_some] using + (naturalBinaryWriter_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (naturalBinaryWriter_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X, Polynomial.eval_one, + ge_iff_le] using hsteps + } + +end CLStructuralNaturalBinaryWriter + +namespace CLStructuralAtomicNaturalWriter + +open GapCVP.BinaryEncoding GapCVP.CLStructuralPrefixWriter +open GapCVP.CLStructuralNaturalBinaryWriter + +/-- GapCVP reduction support. -/ +def structuralAtomicNaturalWord (input : List Bool) : List Bool := + encodeAtomic input.length + +theorem structuralAtomicNaturalWord_eq_prefix (input : List Bool) : + structuralAtomicNaturalWord input = + lengthPrefixedWord (Computability.encodeNat input.length) := by + rfl + +/-- GapCVP reduction support. -/ +noncomputable def structuralAtomicNaturalWriterComputable : + Turing.TM2ComputableInPolyTime GapCVP.bitEncoding + GapCVP.bitEncoding structuralAtomicNaturalWord := by + have hcomposite := + GapCVP.TMComposition.computableInPolyTime + structuralNaturalBinaryWriterComputable + structuralPrefixWriterComputable + change Turing.TM2ComputableInPolyTime GapCVP.bitEncoding + GapCVP.bitEncoding + (fun input : List Bool => + lengthPrefixedWord (Computability.encodeNat input.length)) + simpa only [Function.comp_def] using hcomposite + +end CLStructuralAtomicNaturalWriter + +namespace CLStructuralWholeCNFOutputTM + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLNondeterminism +open GapCVP.CLCellRowBounds GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLPaddedAcceptanceCompiler GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction + +/-- GapCVP reduction support. -/ +def paddedStructuralTableauSimulation + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + TableauSimulation bound machine := + tableauSimulationOfLocalCompiler bound machine + (paddedAcceptanceLocalTableauCompiler bound machine) + +/-- GapCVP reduction support. -/ +def structuralWholeSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + List (Clause (rowWidth bound machine x) + (completePhaseSymbolCount machine.tm)) := + sortedElements + (tableauFormula (paddedAcceptancePhaseSpecification + bound machine x)) + +/-- GapCVP reduction support. -/ +def structuralWholeThreeCNF + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : GapCVP.ThreeCNF := + encodeFormulaFrom 0 + (structuralWholeSourceClauses bound machine x) + +/-- GapCVP reduction support. -/ +def structuralWholeCNFWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : List Bool := + encodeThreeCNF (structuralWholeThreeCNF bound machine x) + +private theorem structuralWholeThreeCNF_eq_encodeTableau + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + structuralWholeThreeCNF bound machine x = + ThreeCNFReduction.encodeTableau + (paddedAcceptancePhaseSpecification bound machine x) := by + rfl + +private theorem structuralWholeCNFWord_eq_encodedTableau + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + structuralWholeCNFWord bound machine x = + encodedTableau (paddedStructuralTableauSimulation + bound machine) x := by + rfl + +theorem structuralWholeCNFWord_mem_threeSAT_iff + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + threeSATLanguage (structuralWholeCNFWord bound machine x) ↔ + ∃ certificate : List Bool, + certificate.length ≤ bound.eval x.length ∧ + verifier (x, certificate) = true := by + rw [structuralWholeCNFWord_eq_encodedTableau] + exact compiledTableau_iff_verifier bound machine + (paddedAcceptanceLocalTableauCompiler bound machine) x + +theorem structuralWholeThreeCNF_allDistinct + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (x : List Bool) : + allDistinct (structuralWholeThreeCNF bound machine x) := by + rw [structuralWholeThreeCNF_eq_encodeTableau] + exact encodeFormula_allDistinct + (tableauFormula + (paddedAcceptancePhaseSpecification bound machine x)) + +theorem structuralNatSize_le_self (value : ℕ) : + Nat.size value ≤ value := by + exact Nat.size_le.mpr Nat.lt_two_pow_self + +end CLStructuralWholeCNFOutputTM + +namespace CNFClauseLoop + +open Computability Turing + +/-- GapCVP reduction support. -/ +def clauseLoopFiniteElements (α : Type) [Fintype α] : List α := + List.ofFn (Fintype.equivFin α).symm + +theorem mem_clauseLoopFiniteElements + (α : Type) [Fintype α] (value : α) : + value ∈ clauseLoopFiniteElements α := by + simp only [clauseLoopFiniteElements, List.mem_ofFn] + exact ⟨(Fintype.equivFin α) value, by simp only [Equiv.symm_apply_apply]⟩ + +end CNFClauseLoop + +namespace CNFSortingDedup + +open Computability Turing + +theorem replicate_append_bit_cons + (bit : Bool) (count : ℕ) (tail : List Bool) : + List.replicate count bit ++ bit :: tail = + bit :: (List.replicate count bit ++ tail) := by + induction count with + | zero => simp only [List.replicate_zero, List.nil_append] + | succ count ih => + simp only [List.replicate_succ, List.cons_append, ih] + +end CNFSortingDedup + +namespace CNFEncodedClauseSort + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.CNFSortingDedup + +/-- GapCVP reduction support. -/ +inductive EncodedWordOrdering where + | invalid + | less + | equal + | greater + deriving DecidableEq + +noncomputable instance : Fintype EncodedWordOrdering where + elems := {.invalid, .less, .equal, .greater} + complete ordering := by cases ordering <;> simp + +/-- GapCVP reduction support. -/ +def encodedWordOrderingFirst : EncodedWordOrdering → Bool + | .invalid => false + | .less => false + | .equal => true + | .greater => true + +/-- GapCVP reduction support. -/ +def encodedWordOrderingSecond : EncodedWordOrdering → Bool + | .invalid => false + | .less => true + | .equal => false + | .greater => true + +/-- GapCVP reduction support. -/ +def encodedWordOrderingWord (outcome : EncodedWordOrdering) : List Bool := + [encodedWordOrderingFirst outcome, encodedWordOrderingSecond outcome] + +/-- GapCVP reduction support. -/ +def lexicographicEncodedWordOrdering : + List Bool → List Bool → EncodedWordOrdering + | [], [] => .equal + | [], _ :: _ => .less + | _ :: _, [] => .greater + | false :: _, true :: _ => .less + | true :: _, false :: _ => .greater + | false :: left, false :: right => + lexicographicEncodedWordOrdering left right + | true :: left, true :: right => + lexicographicEncodedWordOrdering left right + +/-- GapCVP reduction support. -/ +def delimitedPairWordOrdering (input : List Bool) : EncodedWordOrdering := + match readLengthPrefixedWord input with + | none => .invalid + | some (first, suffix) => + match readLengthPrefixedWord suffix with + | none => .invalid + | some (second, _) => + lexicographicEncodedWordOrdering first second + +/-- GapCVP reduction support. -/ +def sourcePreservingDelimitedPairComparisonWord + (input : List Bool) : List Bool := + lengthPrefixedWord input ++ + encodedWordOrderingWord (delimitedPairWordOrdering input) + +theorem delimitedPairWordOrdering_valid + (first second suffix : List Bool) : + delimitedPairWordOrdering + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) = + lexicographicEncodedWordOrdering first second := by + simp only [delimitedPairWordOrdering, List.append_assoc, readLengthPrefixedWord_append] + +end CNFEncodedClauseSort + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part03E.lean b/LeanPool/GapCVP/Part03E.lean new file mode 100644 index 000000000..0d2b9a025 --- /dev/null +++ b/LeanPool/GapCVP/Part03E.lean @@ -0,0 +1,847 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part03D + +/-! # GapCVP proof, part 03, continuation 05 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFEncodedClauseSort + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder + +open GapCVP.CNFSortingDedup + +/-- GapCVP reduction support. -/ +structure DelimitedPairComparisonState where + /-- GapCVP reduction support. -/ + first : Option Bool + /-- GapCVP reduction support. -/ + second : Option Bool + /-- GapCVP reduction support. -/ + outcome : EncodedWordOrdering + deriving Fintype + +/-- GapCVP reduction support. -/ +def delimitedComparePeekFirst (stack : Fin 10) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState) : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + .peek stack (fun state bit => { state with first := bit }) + (.branch (fun state => state.first.isSome) present absent) + +/-- GapCVP reduction support. -/ +def delimitedComparePeekSecond (stack : Fin 10) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState) : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + .peek stack (fun state bit => { state with second := bit }) + (.branch (fun state => state.second.isSome) present absent) + +/-- GapCVP reduction support. -/ +def delimitedComparePop (stack : Fin 10) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState) : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + .pop stack (fun state _ => state) continuation + +/-- GapCVP reduction support. -/ +def delimitedComparePushFirst (stack : Fin 10) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState) : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + .push stack (fun state => state.first.getD false) continuation + +/-- GapCVP reduction support. -/ +def delimitedComparePushConstant (stack : Fin 10) (bit : Bool) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState) : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + .push stack (fun _ => bit) continuation + +/-- GapCVP reduction support. -/ +def delimitedCompareGoto (phase : Fin 12) : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + .load (fun state => ⟨none, none, state.outcome⟩) + (.goto (fun _ => phase)) + +/-- GapCVP reduction support. -/ +def delimitedCompareSetOutcome + (outcome : EncodedWordOrdering) (phase : Fin 12) : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + .load (fun _ => ⟨none, none, outcome⟩) + (.goto (fun _ => phase)) + +/-- GapCVP reduction support. -/ +def delimitedCompareFirstPrefixStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 0 + (delimitedComparePop 0 + (delimitedComparePushFirst 7 + (delimitedComparePushConstant 8 true + (.branch (fun state => state.first.getD false) + (delimitedComparePushConstant 1 true + (delimitedCompareGoto 0)) + (delimitedCompareGoto 1))))) + (delimitedCompareSetOutcome .invalid 7) + +/-- GapCVP reduction support. -/ +def delimitedCompareFirstPayloadStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 1 + (delimitedComparePop 1 + (delimitedComparePeekFirst 0 + (delimitedComparePop 0 + (delimitedComparePushFirst 2 + (delimitedComparePushFirst 7 + (delimitedComparePushConstant 8 true + (delimitedCompareGoto 1))))) + (delimitedCompareSetOutcome .invalid 7))) + (delimitedCompareGoto 2) + +/-- GapCVP reduction support. -/ +def delimitedCompareSecondPrefixStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 0 + (delimitedComparePop 0 + (delimitedComparePushFirst 7 + (delimitedComparePushConstant 8 true + (.branch (fun state => state.first.getD false) + (delimitedComparePushConstant 3 true + (delimitedCompareGoto 2)) + (delimitedCompareGoto 3))))) + (delimitedCompareSetOutcome .invalid 7) + +/-- GapCVP reduction support. -/ +def delimitedCompareSecondPayloadStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 3 + (delimitedComparePop 3 + (delimitedComparePeekFirst 0 + (delimitedComparePop 0 + (delimitedComparePushFirst 4 + (delimitedComparePushFirst 7 + (delimitedComparePushConstant 8 true + (delimitedCompareGoto 3))))) + (delimitedCompareSetOutcome .invalid 7))) + (delimitedCompareGoto 4) + +/-- GapCVP reduction support. -/ +def delimitedCompareReverseFirstStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 2 + (delimitedComparePop 2 + (delimitedComparePushFirst 5 (delimitedCompareGoto 4))) + (delimitedCompareGoto 5) + +/-- GapCVP reduction support. -/ +def delimitedCompareReverseSecondStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 4 + (delimitedComparePop 4 + (delimitedComparePushFirst 6 (delimitedCompareGoto 5))) + (delimitedCompareGoto 6) + +/-- GapCVP reduction support. -/ +def delimitedCompareWordsStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 5 + (delimitedComparePeekSecond 6 + (.branch (fun state => state.first = state.second) + (delimitedComparePop 5 + (delimitedComparePop 6 (delimitedCompareGoto 6))) + (.branch (fun state => state.first = some false) + (delimitedCompareSetOutcome .less 7) + (delimitedCompareSetOutcome .greater 7))) + (delimitedCompareSetOutcome .greater 7)) + (delimitedComparePeekSecond 6 + (delimitedCompareSetOutcome .less 7) + (delimitedCompareSetOutcome .equal 7)) + +/-- GapCVP reduction support. -/ +def delimitedCompareCleanupStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 1 + (delimitedComparePop 1 (delimitedCompareGoto 7)) + (delimitedComparePeekFirst 2 + (delimitedComparePop 2 (delimitedCompareGoto 7)) + (delimitedComparePeekFirst 3 + (delimitedComparePop 3 (delimitedCompareGoto 7)) + (delimitedComparePeekFirst 4 + (delimitedComparePop 4 (delimitedCompareGoto 7)) + (delimitedComparePeekFirst 5 + (delimitedComparePop 5 (delimitedCompareGoto 7)) + (delimitedComparePeekFirst 6 + (delimitedComparePop 6 (delimitedCompareGoto 7)) + (delimitedCompareGoto 8)))))) + +/-- GapCVP reduction support. -/ +def delimitedCompareTrailingStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 0 + (delimitedComparePop 0 + (delimitedComparePushFirst 7 + (delimitedComparePushConstant 8 true + (delimitedCompareGoto 8)))) + (delimitedCompareGoto 9) + +/-- GapCVP reduction support. -/ +def delimitedCompareOutcomeStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + .push 9 (fun state => encodedWordOrderingSecond state.outcome) + (.push 9 (fun state => encodedWordOrderingFirst state.outcome) + (delimitedCompareGoto 10)) + +/-- GapCVP reduction support. -/ +def delimitedCompareSourceStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 7 + (delimitedComparePop 7 + (delimitedComparePushFirst 9 (delimitedCompareGoto 10))) + (delimitedComparePushConstant 9 false + (delimitedCompareGoto 11)) + +/-- GapCVP reduction support. -/ +def delimitedComparePrefixStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 8 + (delimitedComparePop 8 + (delimitedComparePushConstant 9 true + (delimitedCompareGoto 11))) + (.load (fun _ => ⟨none, none, .invalid⟩) .halt) + +/-- GapCVP reduction support. -/ +abbrev delimitedPairComparisonMachine : Turing.FinTM2 where + K := Fin 10 + k₀ := 0 + k₁ := 9 + Γ _ := Bool + Λ := Fin 12 + main := 0 + σ := DelimitedPairComparisonState + initialState := ⟨none, none, .invalid⟩ + m phase := + if phase = (0 : Fin 12) then + delimitedCompareFirstPrefixStatement + else if phase = (1 : Fin 12) then + delimitedCompareFirstPayloadStatement + else if phase = (2 : Fin 12) then + delimitedCompareSecondPrefixStatement + else if phase = (3 : Fin 12) then + delimitedCompareSecondPayloadStatement + else if phase = (4 : Fin 12) then + delimitedCompareReverseFirstStatement + else if phase = (5 : Fin 12) then + delimitedCompareReverseSecondStatement + else if phase = (6 : Fin 12) then + delimitedCompareWordsStatement + else if phase = (7 : Fin 12) then + delimitedCompareCleanupStatement + else if phase = (8 : Fin 12) then + delimitedCompareTrailingStatement + else if phase = (9 : Fin 12) then + delimitedCompareOutcomeStatement + else if phase = (10 : Fin 12) then + delimitedCompareSourceStatement + else + delimitedComparePrefixStatement + +/-- GapCVP reduction support. -/ +def delimitedCompareConfiguration (phase : Fin 12) + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.Cfg where + l := some phase + var := ⟨none, none, outcome⟩ + stk := ![input, firstCounter, firstReversed, + secondCounter, secondReversed, firstForward, secondForward, + source, sourcePrefix, output] + +theorem delimitedPairComparisonMachine_init (input : List Bool) : + Turing.initList delimitedPairComparisonMachine input = + delimitedCompareConfiguration 0 .invalid + input [] [] [] [] [] [] [] [] [] := by + simp only [delimitedPairComparisonMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + delimitedCompareConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `delimitedCompareStepTac` machine-step simplifier. -/ +macro "delimitedCompareStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [delimitedPairComparisonMachine, + delimitedCompareConfiguration, + delimitedComparePeekFirst, delimitedComparePeekSecond, + delimitedComparePop, delimitedComparePushFirst, + delimitedComparePushConstant, delimitedCompareGoto, + delimitedCompareSetOutcome, + delimitedCompareFirstPrefixStatement, + delimitedCompareFirstPayloadStatement, + delimitedCompareSecondPrefixStatement, + delimitedCompareSecondPayloadStatement, + delimitedCompareReverseFirstStatement, + delimitedCompareReverseSecondStatement, + delimitedCompareWordsStatement, + delimitedCompareCleanupStatement, + delimitedCompareTrailingStatement, + delimitedCompareOutcomeStatement, + delimitedCompareSourceStatement, + delimitedComparePrefixStatement, + encodedWordOrderingWord, + encodedWordOrderingFirst, encodedWordOrderingSecond, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +theorem delimitedCompare_firstPrefix_true + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 0 outcome + (true :: input) firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 0 outcome + input (true :: firstCounter) firstReversed + secondCounter secondReversed firstForward secondForward + (true :: source) (true :: sourcePrefix) output) := by + delimitedCompareStepTac + +theorem delimitedCompare_firstPrefix_delimiter + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 0 outcome + (false :: input) firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 1 outcome + input firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + (false :: source) (true :: sourcePrefix) output) := by + delimitedCompareStepTac + +theorem delimitedCompare_firstPrefix_missing + (outcome : EncodedWordOrdering) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 0 outcome + [] firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .invalid + [] firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) := by + delimitedCompareStepTac + +theorem delimitedCompare_firstPayload_step + (outcome : EncodedWordOrdering) (bit marker : Bool) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 1 outcome + (bit :: input) (marker :: firstCounter) firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 1 outcome + input firstCounter (bit :: firstReversed) + secondCounter secondReversed firstForward secondForward + (bit :: source) (true :: sourcePrefix) output) := by + cases bit <;> cases marker <;> delimitedCompareStepTac + +theorem delimitedCompare_firstPayload_finish + (outcome : EncodedWordOrdering) + (input firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 1 outcome + input [] firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 2 outcome + input [] firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) := by + delimitedCompareStepTac + +theorem delimitedCompare_firstPayload_missing + (outcome : EncodedWordOrdering) (marker : Bool) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 1 outcome + [] (marker :: firstCounter) firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .invalid + [] firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) := by + cases marker <;> delimitedCompareStepTac + +theorem delimitedCompare_secondPrefix_true + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 2 outcome + (true :: input) firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 2 outcome + input firstCounter firstReversed + (true :: secondCounter) secondReversed + firstForward secondForward + (true :: source) (true :: sourcePrefix) output) := by + delimitedCompareStepTac + +theorem delimitedCompare_secondPrefix_delimiter + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 2 outcome + (false :: input) firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 3 outcome + input firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + (false :: source) (true :: sourcePrefix) output) := by + delimitedCompareStepTac + +theorem delimitedCompare_secondPrefix_missing + (outcome : EncodedWordOrdering) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 2 outcome + [] firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .invalid + [] firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) := by + delimitedCompareStepTac + +theorem delimitedCompare_secondPayload_step + (outcome : EncodedWordOrdering) (bit marker : Bool) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 3 outcome + (bit :: input) firstCounter firstReversed + (marker :: secondCounter) secondReversed + firstForward secondForward source sourcePrefix output) = + some (delimitedCompareConfiguration 3 outcome + input firstCounter firstReversed + secondCounter (bit :: secondReversed) + firstForward secondForward + (bit :: source) (true :: sourcePrefix) output) := by + cases bit <;> cases marker <;> delimitedCompareStepTac + +theorem delimitedCompare_secondPayload_finish + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 3 outcome + input firstCounter firstReversed + [] secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 4 outcome + input firstCounter firstReversed + [] secondReversed firstForward secondForward + source sourcePrefix output) := by + delimitedCompareStepTac + +theorem delimitedCompare_secondPayload_missing + (outcome : EncodedWordOrdering) (marker : Bool) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 3 outcome + [] firstCounter firstReversed + (marker :: secondCounter) secondReversed + firstForward secondForward source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .invalid + [] firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) := by + cases marker <;> delimitedCompareStepTac + +theorem delimitedCompare_reverseFirst_step + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 4 outcome + input firstCounter (bit :: firstReversed) + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 4 outcome + input firstCounter firstReversed + secondCounter secondReversed (bit :: firstForward) + secondForward source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_reverseFirst_finish + (outcome : EncodedWordOrdering) + (input firstCounter secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 4 outcome + input firstCounter [] + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 5 outcome + input firstCounter [] + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) := by + delimitedCompareStepTac + +theorem delimitedCompare_reverseSecond_step + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 5 outcome + input firstCounter firstReversed + secondCounter (bit :: secondReversed) + firstForward secondForward source sourcePrefix output) = + some (delimitedCompareConfiguration 5 outcome + input firstCounter firstReversed + secondCounter secondReversed firstForward + (bit :: secondForward) source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_reverseSecond_finish + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 5 outcome + input firstCounter firstReversed + secondCounter [] firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter [] firstForward secondForward + source sourcePrefix output) := by + delimitedCompareStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedCompare_words_equalBit + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed + (bit :: firstForward) (bit :: secondForward) + source sourcePrefix output) = + some (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed + firstForward secondForward source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedCompare_words_lessBit + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed + (false :: firstForward) (true :: secondForward) + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .less + input firstCounter firstReversed + secondCounter secondReversed + (false :: firstForward) (true :: secondForward) + source sourcePrefix output) := by + delimitedCompareStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedCompare_words_greaterBit + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed + (true :: firstForward) (false :: secondForward) + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .greater + input firstCounter firstReversed + secondCounter secondReversed + (true :: firstForward) (false :: secondForward) + source sourcePrefix output) := by + delimitedCompareStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedCompare_words_firstEmpty + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstCounter firstReversed secondCounter secondReversed + secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed [] (bit :: secondForward) + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .less + input firstCounter firstReversed + secondCounter secondReversed [] (bit :: secondForward) + source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedCompare_words_secondEmpty + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstCounter firstReversed secondCounter secondReversed + firstForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed (bit :: firstForward) [] + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .greater + input firstCounter firstReversed + secondCounter secondReversed (bit :: firstForward) [] + source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedCompare_words_bothEmpty + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed [] [] + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 .equal + input firstCounter firstReversed + secondCounter secondReversed [] [] + source sourcePrefix output) := by + delimitedCompareStepTac + +theorem delimitedCompare_cleanup_firstCounter + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 7 outcome + input (bit :: firstCounter) firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 outcome + input firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_cleanup_firstReversed + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 7 outcome + input [] (bit :: firstReversed) + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 outcome + input [] firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_cleanup_secondCounter + (outcome : EncodedWordOrdering) (bit : Bool) + (input secondCounter secondReversed firstForward secondForward + source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 7 outcome + input [] [] (bit :: secondCounter) secondReversed + firstForward secondForward source sourcePrefix output) = + some (delimitedCompareConfiguration 7 outcome + input [] [] secondCounter secondReversed + firstForward secondForward source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_cleanup_secondReversed + (outcome : EncodedWordOrdering) (bit : Bool) + (input secondReversed firstForward secondForward + source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 7 outcome + input [] [] [] (bit :: secondReversed) + firstForward secondForward source sourcePrefix output) = + some (delimitedCompareConfiguration 7 outcome + input [] [] [] secondReversed + firstForward secondForward source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_cleanup_firstForward + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstForward secondForward + source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 7 outcome + input [] [] [] [] (bit :: firstForward) secondForward + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 outcome + input [] [] [] [] firstForward secondForward + source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_cleanup_secondForward + (outcome : EncodedWordOrdering) (bit : Bool) + (input secondForward source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 7 outcome + input [] [] [] [] [] (bit :: secondForward) + source sourcePrefix output) = + some (delimitedCompareConfiguration 7 outcome + input [] [] [] [] [] secondForward + source sourcePrefix output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_cleanup_finish + (outcome : EncodedWordOrdering) + (input source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 7 outcome + input [] [] [] [] [] [] source sourcePrefix output) = + some (delimitedCompareConfiguration 8 outcome + input [] [] [] [] [] [] source sourcePrefix output) := by + delimitedCompareStepTac + +theorem delimitedCompare_trailing_step + (outcome : EncodedWordOrdering) (bit : Bool) + (input source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 8 outcome + (bit :: input) [] [] [] [] [] [] source sourcePrefix output) = + some (delimitedCompareConfiguration 8 outcome + input [] [] [] [] [] [] + (bit :: source) (true :: sourcePrefix) output) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_trailing_finish + (outcome : EncodedWordOrdering) + (source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 8 outcome + [] [] [] [] [] [] [] source sourcePrefix output) = + some (delimitedCompareConfiguration 9 outcome + [] [] [] [] [] [] [] source sourcePrefix output) := by + delimitedCompareStepTac + +theorem delimitedCompare_outcome_step + (outcome : EncodedWordOrdering) + (source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 9 outcome + [] [] [] [] [] [] [] source sourcePrefix output) = + some (delimitedCompareConfiguration 10 outcome + [] [] [] [] [] [] [] source sourcePrefix + (encodedWordOrderingWord outcome ++ output)) := by + cases outcome <;> delimitedCompareStepTac + +theorem delimitedCompare_source_step + (outcome : EncodedWordOrdering) (bit : Bool) + (source sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 10 outcome + [] [] [] [] [] [] [] (bit :: source) sourcePrefix output) = + some (delimitedCompareConfiguration 10 outcome + [] [] [] [] [] [] [] source sourcePrefix (bit :: output)) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_source_finish + (outcome : EncodedWordOrdering) + (sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 10 outcome + [] [] [] [] [] [] [] [] sourcePrefix output) = + some (delimitedCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] sourcePrefix (false :: output)) := by + delimitedCompareStepTac + +theorem delimitedCompare_prefix_step + (outcome : EncodedWordOrdering) (bit : Bool) + (sourcePrefix output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] (bit :: sourcePrefix) output) = + some (delimitedCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] sourcePrefix (true :: output)) := by + cases bit <;> delimitedCompareStepTac + +theorem delimitedCompare_prefix_finish + (outcome : EncodedWordOrdering) (output : List Bool) : + delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] [] output) = + some (Turing.haltList delimitedPairComparisonMachine output) := by + cases outcome <;> delimitedCompareStepTac + +end CNFEncodedClauseSort + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part03F.lean b/LeanPool/GapCVP/Part03F.lean new file mode 100644 index 000000000..837e67087 --- /dev/null +++ b/LeanPool/GapCVP/Part03F.lean @@ -0,0 +1,1094 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part03E + +/-! # GapCVP proof, part 03, continuation 06 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFEncodedClauseSort + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder + +open GapCVP.CNFSortingDedup + +private def delimitedCompare_cleanupTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 7 outcome + input firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) + (some (delimitedCompareConfiguration 8 outcome + input [] [] [] [] [] [] source sourcePrefix output)) + (firstCounter.length + firstReversed.length + + secondCounter.length + secondReversed.length + + firstForward.length + secondForward.length + 1) := by + induction firstCounter with + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_cleanup_firstCounter outcome bit + input remaining firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst ih + exact rebound hfull (by simp only [List.length_cons, add_le_add_iff_right, + Order.add_one_le_iff, add_lt_add_iff_right, + lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction firstReversed with + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_cleanup_firstReversed outcome bit + input remaining secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst ih + exact rebound hfull (by simp only [List.length_nil, zero_add, List.length_cons, + add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, + Order.lt_one_iff]) + | nil => + induction secondCounter with + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_cleanup_secondCounter outcome bit + input remaining secondReversed firstForward secondForward + source sourcePrefix output) + have hfull := EvalsToInTime.trans + delimitedPairComparisonMachine.step _ _ _ _ _ hfirst ih + exact rebound hfull (by simp only [List.length_nil, add_zero, zero_add, + List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, + Order.lt_one_iff]) + | nil => + induction secondReversed with + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_cleanup_secondReversed outcome bit + input remaining firstForward secondForward + source sourcePrefix output) + have hfull := EvalsToInTime.trans + delimitedPairComparisonMachine.step _ _ _ _ _ hfirst ih + exact rebound hfull (by simp only [List.length_nil, add_zero, zero_add, + List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, + Order.lt_one_iff]) + | nil => + induction firstForward with + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_cleanup_firstForward outcome bit + input remaining secondForward + source sourcePrefix output) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step + _ _ _ _ _ hfirst ih + exact rebound hfull (by simp only [List.length_nil, add_zero, zero_add, + List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, + Order.lt_one_iff]) + | nil => + induction secondForward with + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_cleanup_secondForward + outcome bit input remaining + source sourcePrefix output) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step + _ _ _ _ _ hfirst ih + exact rebound hfull (by simp only [List.length_nil, add_zero, zero_add, + List.length_cons, Std.le_refl]) + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + zero_add] using + oneStep _ _ (delimitedCompare_cleanup_finish outcome input source + sourcePrefix output) + +private def delimitedCompare_trailingTrace + (outcome : EncodedWordOrdering) + (input source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 8 outcome + input [] [] [] [] [] [] source sourcePrefix output) + (some (delimitedCompareConfiguration 9 outcome + [] [] [] [] [] [] [] + (input.reverse ++ source) + (List.replicate input.length true ++ sourcePrefix) output)) + (input.length + 1) := by + induction input generalizing source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + List.replicate_zero, + zero_add] using oneStep _ _ (delimitedCompare_trailing_finish outcome source sourcePrefix + output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_trailing_step outcome bit + remaining source sourcePrefix output) + have hrest := ih (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def delimitedCompare_sourceTrace + (outcome : EncodedWordOrdering) + (source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 10 outcome + [] [] [] [] [] [] [] source sourcePrefix output) + (some (delimitedCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] sourcePrefix + (false :: (source.reverse ++ output)))) + (source.length + 1) := by + induction source generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (delimitedCompare_source_finish outcome sourcePrefix output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_source_step outcome bit + remaining sourcePrefix output) + have hrest := ih (output := bit :: output) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def delimitedCompare_prefixTrace + (outcome : EncodedWordOrdering) + (sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] sourcePrefix output) + (some (Turing.haltList delimitedPairComparisonMachine + (List.replicate sourcePrefix.length true ++ output))) + (sourcePrefix.length + 1) := by + induction sourcePrefix generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + zero_add] using + oneStep _ _ (delimitedCompare_prefix_finish outcome output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_prefix_step outcome bit remaining output) + have hrest := ih (output := true :: output) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, + List.cons_append, Nat.add_assoc, + Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] using hfull + +/-- GapCVP reduction support. -/ +def delimitedCompareRestoredWord + (outcome : EncodedWordOrdering) + (input source sourcePrefix output : List Bool) : List Bool := + List.replicate (input.length + sourcePrefix.length) true ++ + false :: + (source.reverse ++ input ++ encodedWordOrderingWord outcome ++ output) + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareFinishTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 7 outcome + input firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) + (some (Turing.haltList delimitedPairComparisonMachine + (delimitedCompareRestoredWord outcome + input source sourcePrefix output))) + (firstCounter.length + firstReversed.length + + secondCounter.length + secondReversed.length + + firstForward.length + secondForward.length + + 3 * input.length + source.length + sourcePrefix.length + 5) := by + have hcleanup := delimitedCompare_cleanupTrace outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output + have htrailing := delimitedCompare_trailingTrace outcome + input source sourcePrefix output + have houtcome := oneStep _ _ (delimitedCompare_outcome_step outcome + (input.reverse ++ source) + (List.replicate input.length true ++ sourcePrefix) output) + have hsource := delimitedCompare_sourceTrace outcome + (input.reverse ++ source) + (List.replicate input.length true ++ sourcePrefix) + (encodedWordOrderingWord outcome ++ output) + have hprefix : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] + (List.replicate input.length true ++ sourcePrefix) + (false :: + ((input.reverse ++ source).reverse ++ + (encodedWordOrderingWord outcome ++ output)))) + (some (Turing.haltList delimitedPairComparisonMachine + (delimitedCompareRestoredWord outcome + input source sourcePrefix output))) + ((List.replicate input.length true ++ sourcePrefix).length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.reverse_append, List.reverse_reverse, + List.append_assoc, + delimitedCompareRestoredWord, List.length_append, List.length_replicate] using + delimitedCompare_prefixTrace outcome (List.replicate input.length true ++ sourcePrefix) + (false :: ((input.reverse ++ source).reverse ++ (encodedWordOrderingWord outcome ++ + output))) + have hfirst := EvalsToInTime.trans + delimitedPairComparisonMachine.step _ _ _ _ _ hcleanup htrailing + have hsecond := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst houtcome + have hthird := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hsecond hsource + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hthird hprefix + apply rebound hfull + simp only [List.length_append, List.length_reverse, + List.length_replicate] + omega + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareFirstPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (tail firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 1 outcome + tail (List.replicate count true ++ firstCounter) + firstReversed secondCounter secondReversed + firstForward secondForward + (false :: (List.replicate count true ++ source)) + (List.replicate (count + 1) true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing firstCounter source sourcePrefix with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add, + List.replicate_one, + List.cons_append] using + oneStep _ _ + (delimitedCompare_firstPrefix_delimiter outcome tail firstCounter firstReversed + secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + | succ count ih => + have hfirst := oneStep _ _ (delimitedCompare_firstPrefix_true outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) + have hrest := ih (firstCounter := true :: firstCounter) + (source := true :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareFirstMissingPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 7 .invalid + [] (List.replicate count true ++ firstCounter) + firstReversed secondCounter secondReversed + firstForward secondForward + (List.replicate count true ++ source) + (List.replicate count true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing firstCounter source sourcePrefix with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ + (delimitedCompare_firstPrefix_missing outcome firstCounter firstReversed secondCounter + secondReversed firstForward + secondForward source sourcePrefix output) + | succ count ih => + have hfirst := oneStep _ _ (delimitedCompare_firstPrefix_true outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (firstCounter := true :: firstCounter) + (source := true :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def delimitedCompare_firstPayloadTrace + (outcome : EncodedWordOrdering) + (payload tail firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 1 outcome + (payload ++ tail) (List.replicate payload.length true) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 2 outcome + tail [] (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + (payload.length + 1) := by + induction payload generalizing firstReversed source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil, + zero_add] using + oneStep _ _ + (delimitedCompare_firstPayload_finish outcome tail firstReversed secondCounter + secondReversed firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_firstPayload_step outcome bit true + (remaining ++ tail) + (List.replicate remaining.length true) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih + (firstReversed := bit :: firstReversed) + (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareFirstPartialPayloadTrace + (outcome : EncodedWordOrdering) + (payload remainingCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 1 outcome + payload + (List.replicate payload.length true ++ remainingCounter) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 1 outcome + [] remainingCounter (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + payload.length := by + induction payload generalizing firstReversed source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + List.reverse_nil] using + EvalsToInTime.refl delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 1 outcome [] remainingCounter firstReversed + secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_firstPayload_step outcome bit true + remaining + (List.replicate remaining.length true ++ remainingCounter) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih + (firstReversed := bit :: firstReversed) + (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, + List.cons_append, + List.reverse_cons, List.append_assoc, List.nil_append, replicate_append_bit_cons] + using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareSecondPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (tail firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 3 outcome + tail firstCounter firstReversed + (List.replicate count true ++ secondCounter) secondReversed + firstForward secondForward + (false :: (List.replicate count true ++ source)) + (List.replicate (count + 1) true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing secondCounter source sourcePrefix with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add, + List.replicate_one, + List.cons_append] using + oneStep _ _ + (delimitedCompare_secondPrefix_delimiter outcome tail firstCounter firstReversed + secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + | succ count ih => + have hfirst := oneStep _ _ (delimitedCompare_secondPrefix_true outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) + have hrest := ih (secondCounter := true :: secondCounter) + (source := true :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareSecondMissingPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 7 .invalid + [] firstCounter firstReversed + (List.replicate count true ++ secondCounter) secondReversed + firstForward secondForward + (List.replicate count true ++ source) + (List.replicate count true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing secondCounter source sourcePrefix with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ + (delimitedCompare_secondPrefix_missing outcome firstCounter firstReversed secondCounter + secondReversed + firstForward secondForward source sourcePrefix output) + | succ count ih => + have hfirst := oneStep _ _ (delimitedCompare_secondPrefix_true outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (secondCounter := true :: secondCounter) + (source := true :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def delimitedCompare_secondPayloadTrace + (outcome : EncodedWordOrdering) + (payload tail firstCounter firstReversed secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 3 outcome + (payload ++ tail) firstCounter firstReversed + (List.replicate payload.length true) secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 4 outcome + tail firstCounter firstReversed + [] (payload.reverse ++ secondReversed) + firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + (payload.length + 1) := by + induction payload generalizing secondReversed source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil, + zero_add] using + oneStep _ _ + (delimitedCompare_secondPayload_finish outcome tail firstCounter firstReversed + secondReversed firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_secondPayload_step outcome bit true + (remaining ++ tail) firstCounter firstReversed + (List.replicate remaining.length true) secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih + (secondReversed := bit :: secondReversed) + (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareSecondPartialPayloadTrace + (outcome : EncodedWordOrdering) + (payload remainingCounter firstCounter firstReversed + secondReversed firstForward secondForward + source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 3 outcome + payload firstCounter firstReversed + (List.replicate payload.length true ++ remainingCounter) + secondReversed firstForward secondForward + source sourcePrefix output) + (some (delimitedCompareConfiguration 3 outcome + [] firstCounter firstReversed remainingCounter + (payload.reverse ++ secondReversed) + firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + payload.length := by + induction payload generalizing secondReversed source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + List.reverse_nil] using + EvalsToInTime.refl delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 3 outcome [] firstCounter firstReversed remainingCounter + secondReversed + firstForward secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_secondPayload_step outcome bit true + remaining firstCounter firstReversed + (List.replicate remaining.length true ++ remainingCounter) + secondReversed firstForward secondForward + source sourcePrefix output) + have hrest := ih + (secondReversed := bit :: secondReversed) + (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, + List.cons_append, + List.reverse_cons, List.append_assoc, List.nil_append, replicate_append_bit_cons] + using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareFirstRecordTrace + (outcome : EncodedWordOrdering) + (payload tail firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome + (lengthPrefixedWord payload ++ tail) + [] firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 2 outcome + tail [] (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix) + output)) + (2 * payload.length + 2) := by + have hprefix := delimitedCompareFirstPrefixTrace outcome + payload.length (payload ++ tail) [] firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output + simp only [List.append_nil] at hprefix + have hpayload := delimitedCompare_firstPayloadTrace outcome + payload tail firstReversed secondCounter secondReversed + firstForward secondForward + (false :: (List.replicate payload.length true ++ source)) + (List.replicate (payload.length + 1) true ++ sourcePrefix) + output + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hprefix hpayload + have hsource : + payload.reverse ++ + (false :: (List.replicate payload.length true ++ source)) = + (lengthPrefixedWord payload).reverse ++ source := by + simp only [lengthPrefixedWord, List.reverse_append, List.reverse_cons, List.reverse_replicate, + List.append_assoc, List.cons_append, List.nil_append] + have hmarkers : + List.replicate payload.length true ++ + (List.replicate (payload.length + 1) true ++ sourcePrefix) = + List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix := by + have hlength : + payload.length + (payload.length + 1) = + (lengthPrefixedWord payload).length := by + simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] + rw [← List.append_assoc, ← List.replicate_add, hlength] + rw [hsource, hmarkers] at hfull + have hcast : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome + (lengthPrefixedWord payload ++ tail) + [] firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 2 outcome + tail [] (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix) + output)) + ((payload.length + 1) + (payload.length + 1)) := by + simpa only [lengthPrefixedWord, List.append_assoc, + List.cons_append] using hfull + exact rebound hcast (by omega) + +private def delimitedCompare_secondRecordTrace + (outcome : EncodedWordOrdering) + (payload tail firstCounter firstReversed secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 outcome + (lengthPrefixedWord payload ++ tail) + firstCounter firstReversed [] secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 4 outcome + tail firstCounter firstReversed [] + (payload.reverse ++ secondReversed) + firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix) + output)) + (2 * payload.length + 2) := by + have hprefix := delimitedCompareSecondPrefixTrace outcome + payload.length (payload ++ tail) firstCounter firstReversed [] + secondReversed firstForward secondForward + source sourcePrefix output + simp only [List.append_nil] at hprefix + have hpayload := delimitedCompare_secondPayloadTrace outcome + payload tail firstCounter firstReversed secondReversed + firstForward secondForward + (false :: (List.replicate payload.length true ++ source)) + (List.replicate (payload.length + 1) true ++ sourcePrefix) + output + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hprefix hpayload + have hsource : + payload.reverse ++ + (false :: (List.replicate payload.length true ++ source)) = + (lengthPrefixedWord payload).reverse ++ source := by + simp only [lengthPrefixedWord, List.reverse_append, List.reverse_cons, List.reverse_replicate, + List.append_assoc, List.cons_append, List.nil_append] + have hmarkers : + List.replicate payload.length true ++ + (List.replicate (payload.length + 1) true ++ sourcePrefix) = + List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix := by + have hlength : + payload.length + (payload.length + 1) = + (lengthPrefixedWord payload).length := by + simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] + rw [← List.append_assoc, ← List.replicate_add, hlength] + rw [hsource, hmarkers] at hfull + have hcast : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 outcome + (lengthPrefixedWord payload ++ tail) + firstCounter firstReversed [] secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 4 outcome + tail firstCounter firstReversed [] + (payload.reverse ++ secondReversed) + firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix) + output)) + ((payload.length + 1) + (payload.length + 1)) := by + simpa only [lengthPrefixedWord, List.append_assoc, + List.cons_append] using hfull + exact rebound hcast (by omega) + +private def delimitedCompare_reverseFirstTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 4 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 5 outcome + input firstCounter [] secondCounter secondReversed + (firstReversed.reverse ++ firstForward) secondForward + source sourcePrefix output)) + (firstReversed.length + 1) := by + induction firstReversed generalizing firstForward with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ + (delimitedCompare_reverseFirst_finish outcome input firstCounter secondCounter + secondReversed firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_reverseFirst_step outcome bit + input firstCounter remaining secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (firstForward := bit :: firstForward) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def delimitedCompare_reverseSecondTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 5 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter [] + firstForward (secondReversed.reverse ++ secondForward) + source sourcePrefix output)) + (secondReversed.length + 1) := by + induction secondReversed generalizing secondForward with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ + (delimitedCompare_reverseSecond_finish outcome input firstCounter firstReversed + secondCounter firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (delimitedCompare_reverseSecond_step outcome bit + input firstCounter firstReversed secondCounter remaining + firstForward secondForward source sourcePrefix output) + have hrest := ih (secondForward := bit :: secondForward) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def lexicographicEncodedWordResiduals : + List Bool → List Bool → List Bool × List Bool + | [], right => ([], right) + | bit :: left, [] => (bit :: left, []) + | false :: left, true :: right => + (false :: left, true :: right) + | true :: left, false :: right => + (true :: left, false :: right) + | false :: left, false :: right => + lexicographicEncodedWordResiduals left right + | true :: left, true :: right => + lexicographicEncodedWordResiduals left right + +private def delimitedCompare_wordsTrace + (outcome : EncodedWordOrdering) + (first second input firstCounter firstReversed + secondCounter secondReversed source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + first second source sourcePrefix output) + (some (delimitedCompareConfiguration 7 + (lexicographicEncodedWordOrdering first second) + input firstCounter firstReversed secondCounter secondReversed + (lexicographicEncodedWordResiduals first second).1 + (lexicographicEncodedWordResiduals first second).2 + source sourcePrefix output)) + (first.length + 1) := by + induction first generalizing second with + | nil => + cases second with + | nil => + simpa only [FinTM2.step, Fin.isValue, lexicographicEncodedWordOrdering, + lexicographicEncodedWordResiduals, + List.length_nil, zero_add] using + oneStep _ _ + (delimitedCompare_words_bothEmpty outcome input firstCounter firstReversed + secondCounter secondReversed source + sourcePrefix output) + | cons bit remaining => + simpa only [FinTM2.step, Fin.isValue, lexicographicEncodedWordOrdering, + lexicographicEncodedWordResiduals, + List.length_nil, zero_add] using + oneStep _ _ + (delimitedCompare_words_firstEmpty outcome bit input firstCounter firstReversed + secondCounter secondReversed + remaining source sourcePrefix output) + | cons bit remaining ih => + cases second with + | nil => + have hstep := oneStep _ _ (delimitedCompare_words_secondEmpty outcome bit + input firstCounter firstReversed + secondCounter secondReversed remaining + source sourcePrefix output) + have hcast : + EvalsToInTime delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed + (bit :: remaining) [] source sourcePrefix output) + (some (delimitedCompareConfiguration 7 + (lexicographicEncodedWordOrdering + (bit :: remaining) []) + input firstCounter firstReversed + secondCounter secondReversed + (lexicographicEncodedWordResiduals + (bit :: remaining) []).1 + (lexicographicEncodedWordResiduals + (bit :: remaining) []).2 + source sourcePrefix output)) + 1 := by + simpa only [FinTM2.step, Fin.isValue, lexicographicEncodedWordOrdering, + lexicographicEncodedWordResiduals] using hstep + exact rebound hcast (by simp only [List.length_cons, le_add_iff_nonneg_left, zero_le]) + | cons next secondRemaining => + cases bit <;> cases next + · have hfirst := oneStep _ _ (delimitedCompare_words_equalBit outcome false + input firstCounter firstReversed + secondCounter secondReversed remaining secondRemaining + source sourcePrefix output) + have hrest := ih (second := secondRemaining) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, lexicographicEncodedWordOrdering, + lexicographicEncodedWordResiduals, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + · have hstep := oneStep _ _ (delimitedCompare_words_lessBit outcome + input firstCounter firstReversed + secondCounter secondReversed remaining secondRemaining + source sourcePrefix output) + have hcast : + EvalsToInTime delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed + (false :: remaining) (true :: secondRemaining) + source sourcePrefix output) + (some (delimitedCompareConfiguration 7 + (lexicographicEncodedWordOrdering + (false :: remaining) (true :: secondRemaining)) + input firstCounter firstReversed + secondCounter secondReversed + (lexicographicEncodedWordResiduals + (false :: remaining) (true :: secondRemaining)).1 + (lexicographicEncodedWordResiduals + (false :: remaining) (true :: secondRemaining)).2 + source sourcePrefix output)) + 1 := by + simpa only [FinTM2.step, Fin.isValue, lexicographicEncodedWordOrdering, + lexicographicEncodedWordResiduals] using hstep + exact rebound hcast (by simp only [List.length_cons, le_add_iff_nonneg_left, zero_le]) + · have hstep := oneStep _ _ (delimitedCompare_words_greaterBit outcome + input firstCounter firstReversed + secondCounter secondReversed remaining secondRemaining + source sourcePrefix output) + have hcast : + EvalsToInTime delimitedPairComparisonMachine.step + (delimitedCompareConfiguration 6 outcome + input firstCounter firstReversed + secondCounter secondReversed + (true :: remaining) (false :: secondRemaining) + source sourcePrefix output) + (some (delimitedCompareConfiguration 7 + (lexicographicEncodedWordOrdering + (true :: remaining) (false :: secondRemaining)) + input firstCounter firstReversed + secondCounter secondReversed + (lexicographicEncodedWordResiduals + (true :: remaining) (false :: secondRemaining)).1 + (lexicographicEncodedWordResiduals + (true :: remaining) (false :: secondRemaining)).2 + source sourcePrefix output)) + 1 := by + simpa only [FinTM2.step, Fin.isValue, lexicographicEncodedWordOrdering, + lexicographicEncodedWordResiduals] using hstep + exact rebound hcast (by simp only [List.length_cons, le_add_iff_nonneg_left, zero_le]) + · have hfirst := oneStep _ _ (delimitedCompare_words_equalBit outcome true + input firstCounter firstReversed + secondCounter secondReversed remaining secondRemaining + source sourcePrefix output) + have hrest := ih (second := secondRemaining) + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, lexicographicEncodedWordOrdering, + lexicographicEncodedWordResiduals, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private theorem lexicographicEncodedWordResiduals_first_length_le + (first second : List Bool) : + (lexicographicEncodedWordResiduals first second).1.length ≤ + first.length := by + induction first generalizing second with + | nil => simp only [lexicographicEncodedWordResiduals, List.length_nil, Std.le_refl] + | cons bit remaining ih => + cases second with + | nil => simp only [lexicographicEncodedWordResiduals, List.length_cons, Std.le_refl] + | cons next second => + cases bit <;> cases next + · simpa only [lexicographicEncodedWordResiduals, List.length_cons, Nat.succ_eq_add_one] + using + Nat.le_trans (ih second) (Nat.le_succ remaining.length) + · simp only [lexicographicEncodedWordResiduals, List.length_cons, Std.le_refl] + · simp only [lexicographicEncodedWordResiduals, List.length_cons, Std.le_refl] + · simpa only [lexicographicEncodedWordResiduals, List.length_cons, Nat.succ_eq_add_one] + using + Nat.le_trans (ih second) (Nat.le_succ remaining.length) + +private theorem lexicographicEncodedWordResiduals_second_length_le + (first second : List Bool) : + (lexicographicEncodedWordResiduals first second).2.length ≤ + second.length := by + induction first generalizing second with + | nil => simp only [lexicographicEncodedWordResiduals, Std.le_refl] + | cons bit remaining ih => + cases second with + | nil => simp only [lexicographicEncodedWordResiduals, List.length_nil, Std.le_refl] + | cons next second => + cases bit <;> cases next + · simpa only [lexicographicEncodedWordResiduals, List.length_cons, Nat.succ_eq_add_one] + using + Nat.le_trans (ih second) (Nat.le_succ second.length) + · simp only [lexicographicEncodedWordResiduals, List.length_cons, Std.le_refl] + · simp only [lexicographicEncodedWordResiduals, List.length_cons, Std.le_refl] + · simpa only [lexicographicEncodedWordResiduals, List.length_cons, Nat.succ_eq_add_one] + using + Nat.le_trans (ih second) (Nat.le_succ second.length) + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareValidTrace + (first second suffix : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedPairComparisonMachine + (sourcePreservingDelimitedPairComparisonWord + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix)))) + (24 * + ((lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix).length + 1) + 24) := by + let firstCode := lengthPrefixedWord first + let secondCode := lengthPrefixedWord second + let saved := secondCode.reverse ++ firstCode.reverse + let prefixMarkers := + List.replicate secondCode.length true ++ + List.replicate firstCode.length true + have hfirst : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] []) + (some (delimitedCompareConfiguration 2 .invalid + (lengthPrefixedWord second ++ suffix) + [] first.reverse [] [] [] [] + firstCode.reverse + (List.replicate firstCode.length true) [])) + (2 * first.length + 2) := by + simpa [firstCode, List.append_assoc] using + delimitedCompareFirstRecordTrace .invalid first + (lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] + have hsecond : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 .invalid + (lengthPrefixedWord second ++ suffix) + [] first.reverse [] [] [] [] + firstCode.reverse + (List.replicate firstCode.length true) []) + (some (delimitedCompareConfiguration 4 .invalid + suffix [] first.reverse [] second.reverse [] [] + saved prefixMarkers [])) + (2 * second.length + 2) := by + simpa [firstCode, secondCode, saved, prefixMarkers] using + delimitedCompare_secondRecordTrace .invalid second suffix + [] first.reverse [] [] [] + firstCode.reverse (List.replicate firstCode.length true) [] + have hreverseFirst : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 4 .invalid + suffix [] first.reverse [] second.reverse [] [] + saved prefixMarkers []) + (some (delimitedCompareConfiguration 5 .invalid + suffix [] [] [] second.reverse first [] + saved prefixMarkers [])) + (first.length + 1) := by + simpa using delimitedCompare_reverseFirstTrace .invalid + suffix [] first.reverse [] second.reverse [] [] + saved prefixMarkers [] + have hreverseSecond : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 5 .invalid + suffix [] [] [] second.reverse first [] + saved prefixMarkers []) + (some (delimitedCompareConfiguration 6 .invalid + suffix [] [] [] [] first second saved prefixMarkers [])) + (second.length + 1) := by + simpa using delimitedCompare_reverseSecondTrace .invalid + suffix [] [] [] second.reverse first [] + saved prefixMarkers [] + have hcompare := delimitedCompare_wordsTrace .invalid + first second suffix [] [] [] [] saved prefixMarkers [] + have hfinish := delimitedCompareFinishTrace + (lexicographicEncodedWordOrdering first second) + suffix [] [] [] [] + (lexicographicEncodedWordResiduals first second).1 + (lexicographicEncodedWordResiduals first second).2 + saved prefixMarkers [] + have hprefixLength : + suffix.length + prefixMarkers.length = + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix).length := by + simp only [prefixMarkers, firstCode, secondCode, + List.length_append, List.length_replicate, + lengthPrefixedWord_length] + omega + have hrestored : + delimitedCompareRestoredWord + (lexicographicEncodedWordOrdering first second) + suffix saved prefixMarkers [] = + sourcePreservingDelimitedPairComparisonWord + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) := by + simp only [delimitedCompareRestoredWord, + sourcePreservingDelimitedPairComparisonWord, + delimitedPairWordOrdering_valid, List.append_nil] + rw [hprefixLength] + simp [saved, firstCode, secondCode, lengthPrefixedWord, + List.reverse_append, List.append_assoc] + rw [hrestored] at hfinish + have h01 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hsecond + have h012 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h01 hreverseFirst + have h0123 := EvalsToInTime.trans + delimitedPairComparisonMachine.step _ _ _ _ _ h012 hreverseSecond + have h01234 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h0123 hcompare + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h01234 hfinish + apply rebound hfull + have hfirstResidual := + lexicographicEncodedWordResiduals_first_length_le first second + have hsecondResidual := + lexicographicEncodedWordResiduals_second_length_le first second + simp only [saved, prefixMarkers, firstCode, secondCode, + List.length_append, List.length_reverse, + List.length_replicate, List.length_nil, + lengthPrefixedWord_length] + omega + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem delimitedPairWordOrdering_missingFirst + (count : ℕ) : + delimitedPairWordOrdering (List.replicate count true) = .invalid := by + simp only [delimitedPairWordOrdering, readLengthPrefixedWord, readUnaryPrefix_missing] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedPairWordOrdering_shortFirst + (count : ℕ) (payload : List Bool) + (hshort : payload.length < count) : + delimitedPairWordOrdering + (List.replicate count true ++ false :: payload) = .invalid := by + have hinsufficient : ¬ count ≤ payload.length := by + omega + simp only [delimitedPairWordOrdering, readLengthPrefixedWord, readUnaryPrefix_replicate, + hinsufficient, + ↓reduceIte] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem delimitedPairWordOrdering_missingSecond + (first : List Bool) (count : ℕ) : + delimitedPairWordOrdering + (lengthPrefixedWord first ++ + List.replicate count true) = .invalid := by + unfold delimitedPairWordOrdering + rw [readLengthPrefixedWord_append first + (List.replicate count true)] + simp only [readLengthPrefixedWord, readUnaryPrefix_missing] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedPairWordOrdering_shortSecond + (first : List Bool) (count : ℕ) (payload : List Bool) + (hshort : payload.length < count) : + delimitedPairWordOrdering + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)) = .invalid := by + unfold delimitedPairWordOrdering + rw [readLengthPrefixedWord_append first + (List.replicate count true ++ false :: payload)] + have hinsufficient : ¬ count ≤ payload.length := by + omega + simp only [readLengthPrefixedWord, readUnaryPrefix_replicate, hinsufficient, ↓reduceIte] + +end CNFEncodedClauseSort + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part03G.lean b/LeanPool/GapCVP/Part03G.lean new file mode 100644 index 000000000..796fdb2fd --- /dev/null +++ b/LeanPool/GapCVP/Part03G.lean @@ -0,0 +1,451 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part03F + +/-! # GapCVP proof, part 03, continuation 07 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFEncodedClauseSort + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder + +open GapCVP.CNFSortingDedup + +private def delimitedCompare_missingFirstTrace (count : ℕ) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (List.replicate count true) [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedPairComparisonMachine + (sourcePreservingDelimitedPairComparisonWord + (List.replicate count true)))) + (24 * ((List.replicate count true).length + 1) + 24) := by + have hscan : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (List.replicate count true) [] [] [] [] [] [] [] [] []) + (some (delimitedCompareConfiguration 7 .invalid + [] (List.replicate count true) [] [] [] [] [] + (List.replicate count true) + (List.replicate count true) [])) + (count + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using + delimitedCompareFirstMissingPrefixTrace .invalid count [] [] [] [] [] [] [] [] [] + have hfinish := delimitedCompareFinishTrace .invalid + [] (List.replicate count true) [] [] [] [] [] + (List.replicate count true) (List.replicate count true) [] + have hrestored : + delimitedCompareRestoredWord .invalid [] + (List.replicate count true) (List.replicate count true) [] = + sourcePreservingDelimitedPairComparisonWord + (List.replicate count true) := by + simp only [delimitedCompareRestoredWord, List.length_nil, List.length_replicate, zero_add, + List.reverse_replicate, List.append_nil, sourcePreservingDelimitedPairComparisonWord, + lengthPrefixedWord, + delimitedPairWordOrdering_missingFirst, List.append_assoc, List.cons_append] + rw [hrestored] at hfinish + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hscan hfinish + apply rebound hfull + simp only [List.length_replicate, List.length_nil] + omega + +private def delimitedCompare_truncatedFirstTrace + (count : ℕ) (payload : List Bool) + (hshort : payload.length < count) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (List.replicate count true ++ false :: payload) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedPairComparisonMachine + (sourcePreservingDelimitedPairComparisonWord + (List.replicate count true ++ false :: payload)))) + (24 * + ((List.replicate count true ++ false :: payload).length + 1) + + 24) := by + let extra := count - payload.length - 1 + have hcount : count = payload.length + extra + 1 := by + dsimp [extra] + omega + have hcounter : + List.replicate count true = + List.replicate payload.length true ++ + List.replicate (extra + 1) true := by + have hsplit : count = payload.length + (extra + 1) := by + omega + rw [hsplit, List.replicate_add] + let saved := + payload.reverse ++ false :: List.replicate count true + let prefixMarkers := + List.replicate payload.length true ++ + List.replicate (count + 1) true + have hprefix : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (List.replicate count true ++ false :: payload) + [] [] [] [] [] [] [] [] []) + (some (delimitedCompareConfiguration 1 .invalid + payload (List.replicate count true) [] [] [] [] [] + (false :: List.replicate count true) + (List.replicate (count + 1) true) [])) + (count + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using + delimitedCompareFirstPrefixTrace .invalid count payload [] [] [] [] [] [] [] [] [] + have hpartial : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 1 .invalid + payload (List.replicate count true) [] [] [] [] [] + (false :: List.replicate count true) + (List.replicate (count + 1) true) []) + (some (delimitedCompareConfiguration 1 .invalid + [] (true :: List.replicate extra true) + payload.reverse [] [] [] [] saved prefixMarkers [])) + payload.length := by + have hremaining : + List.replicate (extra + 1) true = + true :: List.replicate extra true := by + simp only [List.replicate_succ] + have hraw := delimitedCompareFirstPartialPayloadTrace + .invalid payload (List.replicate (extra + 1) true) + [] [] [] [] [] + (false :: List.replicate count true) + (List.replicate (count + 1) true) [] + rw [← hcounter, hremaining] at hraw + simpa only [saved, prefixMarkers, List.append_nil] using hraw + have hmissing := oneStep _ _ (delimitedCompare_firstPayload_missing .invalid true + (List.replicate extra true) payload.reverse + [] [] [] [] saved prefixMarkers []) + have hfinish := delimitedCompareFinishTrace .invalid + [] (List.replicate extra true) payload.reverse + [] [] [] [] saved prefixMarkers [] + have hprefixLength : + prefixMarkers.length = + (List.replicate count true ++ false :: payload).length := by + simp only [prefixMarkers, List.length_append, + List.length_replicate, List.length_cons] + omega + have hordering := + delimitedPairWordOrdering_shortFirst count payload hshort + have hrestored : + delimitedCompareRestoredWord .invalid [] + saved prefixMarkers [] = + sourcePreservingDelimitedPairComparisonWord + (List.replicate count true ++ false :: payload) := by + simp only [delimitedCompareRestoredWord, + sourcePreservingDelimitedPairComparisonWord, + hordering, List.length_nil, Nat.zero_add, List.append_nil] + rw [hprefixLength] + simp only [List.length_append, List.length_replicate, List.length_cons, List.reverse_append, + List.reverse_cons, List.reverse_replicate, List.reverse_reverse, List.append_assoc, + List.cons_append, + List.nil_append, lengthPrefixedWord, saved] + rw [hrestored] at hfinish + have h01 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hprefix hpartial + have h012 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h01 hmissing + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h012 hfinish + apply rebound hfull + simp only [saved, prefixMarkers, + List.length_append, List.length_replicate, + List.length_reverse, List.length_cons, List.length_nil] + omega + +private def delimitedCompare_missingSecondTrace + (first : List Bool) (count : ℕ) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ List.replicate count true) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedPairComparisonMachine + (sourcePreservingDelimitedPairComparisonWord + (lengthPrefixedWord first ++ List.replicate count true)))) + (24 * + ((lengthPrefixedWord first ++ List.replicate count true).length + + 1) + 24) := by + let firstCode := lengthPrefixedWord first + let saved := List.replicate count true ++ firstCode.reverse + let prefixMarkers := + List.replicate count true ++ + List.replicate firstCode.length true + have hfirst : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ List.replicate count true) + [] [] [] [] [] [] [] [] []) + (some (delimitedCompareConfiguration 2 .invalid + (List.replicate count true) + [] first.reverse [] [] [] [] firstCode.reverse + (List.replicate firstCode.length true) [])) + (2 * first.length + 2) := by + simpa [firstCode] using delimitedCompareFirstRecordTrace + .invalid first (List.replicate count true) + [] [] [] [] [] [] [] [] + have hmissing : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 .invalid + (List.replicate count true) + [] first.reverse [] [] [] [] firstCode.reverse + (List.replicate firstCode.length true) []) + (some (delimitedCompareConfiguration 7 .invalid + [] [] first.reverse (List.replicate count true) + [] [] [] saved prefixMarkers [])) + (count + 1) := by + simpa [saved, prefixMarkers] using + delimitedCompareSecondMissingPrefixTrace .invalid count + [] first.reverse [] [] [] [] + firstCode.reverse (List.replicate firstCode.length true) [] + have hfinish := delimitedCompareFinishTrace .invalid + [] [] first.reverse (List.replicate count true) + [] [] [] saved prefixMarkers [] + have hprefixLength : + prefixMarkers.length = + (lengthPrefixedWord first ++ + List.replicate count true).length := by + simp only [prefixMarkers, firstCode, + List.length_append, List.length_replicate] + omega + have hrestored : + delimitedCompareRestoredWord .invalid [] + saved prefixMarkers [] = + sourcePreservingDelimitedPairComparisonWord + (lengthPrefixedWord first ++ List.replicate count true) := by + simp only [delimitedCompareRestoredWord, + sourcePreservingDelimitedPairComparisonWord, + delimitedPairWordOrdering_missingSecond, + List.length_nil, Nat.zero_add, List.append_nil] + rw [hprefixLength] + simp [saved, firstCode, lengthPrefixedWord, + List.reverse_append, List.append_assoc] + rw [hrestored] at hfinish + have hfirstTwo := EvalsToInTime.trans + delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hmissing + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirstTwo hfinish + apply rebound hfull + simp only [saved, prefixMarkers, firstCode, + List.length_append, List.length_replicate, + List.length_reverse, List.length_nil, + lengthPrefixedWord_length] + omega + +private def delimitedCompare_truncatedSecondTrace + (first : List Bool) (count : ℕ) (payload : List Bool) + (hshort : payload.length < count) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedPairComparisonMachine + (sourcePreservingDelimitedPairComparisonWord + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload))))) + (24 * + ((lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)).length + 1) + + 24) := by + let extra := count - payload.length - 1 + have hcount : count = payload.length + extra + 1 := by + dsimp [extra] + omega + have hcounter : + List.replicate count true = + List.replicate payload.length true ++ + List.replicate (extra + 1) true := by + have hsplit : count = payload.length + (extra + 1) := by + omega + rw [hsplit, List.replicate_add] + let firstCode := lengthPrefixedWord first + let saved := + payload.reverse ++ + false :: (List.replicate count true ++ firstCode.reverse) + let prefixMarkers := + List.replicate payload.length true ++ + (List.replicate (count + 1) true ++ + List.replicate firstCode.length true) + have hfirst : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)) + [] [] [] [] [] [] [] [] []) + (some (delimitedCompareConfiguration 2 .invalid + (List.replicate count true ++ false :: payload) + [] first.reverse [] [] [] [] + firstCode.reverse + (List.replicate firstCode.length true) [])) + (2 * first.length + 2) := by + simpa [firstCode] using + delimitedCompareFirstRecordTrace .invalid first + (List.replicate count true ++ false :: payload) + [] [] [] [] [] [] [] [] + have hprefix : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 .invalid + (List.replicate count true ++ false :: payload) + [] first.reverse [] [] [] [] + firstCode.reverse + (List.replicate firstCode.length true) []) + (some (delimitedCompareConfiguration 3 .invalid + payload [] first.reverse + (List.replicate count true) [] [] [] + (false :: + (List.replicate count true ++ firstCode.reverse)) + (List.replicate (count + 1) true ++ + List.replicate firstCode.length true) [])) + (count + 1) := by + simpa using delimitedCompareSecondPrefixTrace .invalid count + payload [] first.reverse [] [] [] [] + firstCode.reverse (List.replicate firstCode.length true) [] + have hpartial : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 3 .invalid + payload [] first.reverse + (List.replicate count true) [] [] [] + (false :: + (List.replicate count true ++ firstCode.reverse)) + (List.replicate (count + 1) true ++ + List.replicate firstCode.length true) []) + (some (delimitedCompareConfiguration 3 .invalid + [] [] first.reverse (true :: List.replicate extra true) + payload.reverse [] [] saved prefixMarkers [])) + payload.length := by + have hremaining : + List.replicate (extra + 1) true = + true :: List.replicate extra true := by + simp [List.replicate_succ] + have hraw := delimitedCompareSecondPartialPayloadTrace + .invalid payload (List.replicate (extra + 1) true) + [] first.reverse [] [] [] + (false :: (List.replicate count true ++ firstCode.reverse)) + (List.replicate (count + 1) true ++ + List.replicate firstCode.length true) [] + rw [← hcounter, hremaining] at hraw + simpa only [saved, prefixMarkers, List.append_nil] using hraw + have hmissing := oneStep _ _ (delimitedCompare_secondPayload_missing .invalid true + [] first.reverse (List.replicate extra true) + payload.reverse [] [] saved prefixMarkers []) + have hfinish := delimitedCompareFinishTrace .invalid + [] [] first.reverse (List.replicate extra true) + payload.reverse [] [] saved prefixMarkers [] + have hprefixLength : + prefixMarkers.length = + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)).length := by + simp only [prefixMarkers, firstCode, List.length_append, + List.length_replicate, List.length_cons, + lengthPrefixedWord_length] + omega + have hordering := + delimitedPairWordOrdering_shortSecond first count payload hshort + have hrestored : + delimitedCompareRestoredWord .invalid [] + saved prefixMarkers [] = + sourcePreservingDelimitedPairComparisonWord + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)) := by + simp only [delimitedCompareRestoredWord, + sourcePreservingDelimitedPairComparisonWord, + hordering, List.length_nil, Nat.zero_add, List.append_nil] + rw [hprefixLength] + simp [saved, firstCode, lengthPrefixedWord, + List.reverse_append, List.append_assoc] + rw [hrestored] at hfinish + have h01 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hprefix + have h012 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h01 hpartial + have h0123 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h012 hmissing + have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h0123 hfinish + apply rebound hfull + simp only [saved, prefixMarkers, firstCode, + List.length_append, List.length_replicate, + List.length_reverse, List.length_cons, List.length_nil, + lengthPrefixedWord_length] + omega + +private def delimitedCompare_totalTrace (input : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid + input [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedPairComparisonMachine + (sourcePreservingDelimitedPairComparisonWord input))) + (24 * (input.length + 1) + 24) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + exact delimitedCompare_missingFirstTrace count + | inr witness => + obtain ⟨count, tail, hinput⟩ := witness + subst input + by_cases hlength : count ≤ tail.length + · let first := tail.take count + let rest := tail.drop count + have hfirstRecord : + List.replicate count true ++ false :: tail = + lengthPrefixedWord first ++ rest := by + simpa only using validInput_reconstruct count tail hlength + rw [hfirstRecord] + cases unaryInputSplit rest with + | inl secondWitness => + obtain ⟨secondCount, hsecond⟩ := secondWitness + rw [hsecond] + exact delimitedCompare_missingSecondTrace + first secondCount + | inr secondWitness => + obtain ⟨secondCount, secondTail, hsecond⟩ := secondWitness + rw [hsecond] + by_cases hsecondLength : secondCount ≤ secondTail.length + · have hsecondRecord := validInput_reconstruct + secondCount secondTail hsecondLength + rw [hsecondRecord] + simpa only [FinTM2.step, Fin.isValue, List.length_append, lengthPrefixedWord_length, + List.length_take, + List.length_drop, List.append_assoc] using + delimitedCompareValidTrace first (secondTail.take secondCount) (secondTail.drop + secondCount) + · exact delimitedCompare_truncatedSecondTrace + first secondCount secondTail + (Nat.lt_of_not_ge hsecondLength) + · exact delimitedCompare_truncatedFirstTrace + count tail (Nat.lt_of_not_ge hlength) + +/-- GapCVP reduction support. -/ +def sourcePreservingDelimitedPairComparisonComputable : + BitTM + sourcePreservingDelimitedPairComparisonWord where + tm := delimitedPairComparisonMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 24 * (Polynomial.X + 1) + 24 + outputsFun input := { + steps := (delimitedCompare_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, delimitedPairComparisonMachine_init, + Option.map_some] using + (delimitedCompare_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (delimitedCompare_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, Polynomial.eval_one, ge_iff_le] using hsteps + } + +theorem lexicographicEncodedWordOrdering_eq_equal_iff + (first second : List Bool) : + lexicographicEncodedWordOrdering first second = .equal ↔ + first = second := by + induction first generalizing second with + | nil => + cases second <;> + simp [lexicographicEncodedWordOrdering] + | cons bit remaining ih => + cases second with + | nil => simp only [lexicographicEncodedWordOrdering, reduceCtorEq] + | cons next second => + cases bit <;> cases next <;> + simp [lexicographicEncodedWordOrdering, ih] + +end CNFEncodedClauseSort + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part04.lean b/LeanPool/GapCVP/Part04.lean new file mode 100644 index 000000000..a63b95012 --- /dev/null +++ b/LeanPool/GapCVP/Part04.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part04G + +/-! # GapCVP proof, part 04 -/ diff --git a/LeanPool/GapCVP/Part04A.lean b/LeanPool/GapCVP/Part04A.lean new file mode 100644 index 000000000..4239dc1e5 --- /dev/null +++ b/LeanPool/GapCVP/Part04A.lean @@ -0,0 +1,735 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part03 + +/-! # GapCVP proof, part 04 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiniteRecordSort + +open Computability Turing GapCVP.ThreeCNFReduction + +/-- GapCVP reduction support. -/ +def sourceOrderedDistinctRecords + {α : Type} [Encodable α] [DecidableEq α] + (records : List α) : List α := + sortedElements records.toFinset + +@[simp] theorem sourceOrderedDistinctRecords_sortedElements + {α : Type} [Encodable α] [DecidableEq α] + (records : Finset α) : + sourceOrderedDistinctRecords (sortedElements records) = + sortedElements records := by + simp only [sourceOrderedDistinctRecords, sortedElements, Finset.sort_toFinset] + +end CNFFiniteRecordSort + +namespace CNFInputDependentRecordSort + +open Computability Turing GapCVP.CNFFiniteRecordSort + +theorem sourceOrderedDistinctRecords_eq_of_nodup_pairwise + {α : Type} [Encodable α] [DecidableEq α] + (source candidate : List α) + (hmembership : ∀ record : α, + record ∈ candidate ↔ record ∈ source) + (hnodup : candidate.Nodup) + (hpairwise : candidate.Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second)) : + sourceOrderedDistinctRecords source = candidate := by + let relation : α → α → Prop := + fun first second => + Encodable.encode first ≤ Encodable.encode second + let : IsTrans α relation := + ⟨fun _ _ _ hab hbc => Nat.le_trans hab hbc⟩ + let : Std.Antisymm relation := + ⟨fun _ _ hab hba => + Encodable.encode_injective (Nat.le_antisymm hab hba)⟩ + let : Std.Total relation := + ⟨fun _ _ => Nat.le_total _ _⟩ + have hset : source.toFinset = candidate.toFinset := by + ext record + simpa only [List.mem_toFinset] using (hmembership record).symm + change source.toFinset.sort relation = candidate + rw [hset] + exact (List.toFinset_sort relation hnodup).2 hpairwise + +end CNFInputDependentRecordSort + +namespace CNFNaturalOrderComparator + +open Computability Turing GapCVP.BinaryEncoding GapCVP.CNFEncodedClauseSort + +/-- GapCVP reduction support. -/ +def littleEndianNaturalValue : List Bool → ℕ + | [] => 0 + | false :: remaining => 2 * littleEndianNaturalValue remaining + | true :: remaining => 2 * littleEndianNaturalValue remaining + 1 + +@[simp] private theorem littleEndianNaturalValue_encodePosNum (number : PosNum) : + littleEndianNaturalValue (Computability.encodePosNum number) = + (number : ℕ) := by + induction number with + | one => rfl + | bit0 number ih => + simp only [encodePosNum, littleEndianNaturalValue, ih, PosNum.cast_bit0] + omega + | bit1 number ih => + simp only [encodePosNum, littleEndianNaturalValue, ih, PosNum.cast_bit1, + Nat.add_right_cancel_iff] + omega + +@[simp] private theorem littleEndianNaturalValue_encodeNum (number : Num) : + littleEndianNaturalValue (Computability.encodeNum number) = + (number : ℕ) := by + cases number with + | zero => rfl + | pos number => + exact littleEndianNaturalValue_encodePosNum number + +@[simp] theorem littleEndianNaturalValue_encodeNat (number : ℕ) : + littleEndianNaturalValue (Computability.encodeNat number) = number := by + change littleEndianNaturalValue + (Computability.encodeNum (number : Num)) = number + rw [littleEndianNaturalValue_encodeNum, Num.to_of_nat] + +private def littleEndianNaturalFold : + EncodedWordOrdering → List Bool → List Bool → EncodedWordOrdering + | current, [], [] => current + | current, false :: first, [] => + littleEndianNaturalFold current first [] + | _, true :: first, [] => + littleEndianNaturalFold .greater first [] + | current, [], false :: second => + littleEndianNaturalFold current [] second + | _, [], true :: second => + littleEndianNaturalFold .less [] second + | current, false :: first, false :: second => + littleEndianNaturalFold current first second + | _, false :: first, true :: second => + littleEndianNaturalFold .less first second + | _, true :: first, false :: second => + littleEndianNaturalFold .greater first second + | current, true :: first, true :: second => + littleEndianNaturalFold current first second +termination_by _ first second => first.length + second.length +decreasing_by all_goals simp_wf <;> omega + +/-- GapCVP reduction support. -/ +def littleEndianNaturalOrdering + (first second : List Bool) : EncodedWordOrdering := + littleEndianNaturalFold .equal first second + +private theorem littleEndianNaturalFold_eq_value_order + (first second : List Bool) (current : EncodedWordOrdering) : + littleEndianNaturalFold current first second = + if littleEndianNaturalValue first < + littleEndianNaturalValue second then .less + else if littleEndianNaturalValue second < + littleEndianNaturalValue first then .greater + else current := by + induction first generalizing second current with + | nil => + induction second generalizing current with + | nil => simp only [littleEndianNaturalFold, littleEndianNaturalValue, lt_self_iff_false, + ↓reduceIte] + | cons bit remaining ih => + cases bit <;> + simp [littleEndianNaturalFold, littleEndianNaturalValue, ih] + | cons bit first ih => + cases second with + | nil => + cases bit <;> + simp [littleEndianNaturalFold, littleEndianNaturalValue, ih] <;> + split_ifs <;> simp_all + | cons next second => + cases bit <;> cases next <;> + simp [littleEndianNaturalFold, littleEndianNaturalValue, ih] <;> + split_ifs <;> simp_all <;> omega + +theorem littleEndianNaturalOrdering_eq_value_order + (first second : List Bool) : + littleEndianNaturalOrdering first second = + if littleEndianNaturalValue first < + littleEndianNaturalValue second then .less + else if littleEndianNaturalValue second < + littleEndianNaturalValue first then .greater + else .equal := by + exact littleEndianNaturalFold_eq_value_order first second .equal + +@[simp] theorem littleEndianNaturalOrdering_encodeNat + (first second : ℕ) : + littleEndianNaturalOrdering + (Computability.encodeNat first) + (Computability.encodeNat second) = + if first < second then .less + else if second < first then .greater + else .equal := by + simp only [littleEndianNaturalOrdering_eq_value_order, littleEndianNaturalValue_encodeNat] + +/-- GapCVP reduction support. -/ +def delimitedNaturalPairOrdering (input : List Bool) : + EncodedWordOrdering := + match readLengthPrefixedWord input with + | none => .invalid + | some (first, remaining) => + match readLengthPrefixedWord remaining with + | none => .invalid + | some (second, _) => littleEndianNaturalOrdering first second + +/-- GapCVP reduction support. -/ +def sourcePreservingDelimitedNaturalComparisonWord + (input : List Bool) : List Bool := + lengthPrefixedWord input ++ + encodedWordOrderingWord (delimitedNaturalPairOrdering input) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedNaturalPairOrdering_valid + (first second suffix : List Bool) : + delimitedNaturalPairOrdering + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) = + littleEndianNaturalOrdering first second := by + simp only [delimitedNaturalPairOrdering, List.append_assoc, readLengthPrefixedWord_append] + +theorem delimitedNaturalPairOrdering_encodeNat + (first second : ℕ) (suffix : List Bool) : + delimitedNaturalPairOrdering + (lengthPrefixedWord (Computability.encodeNat first) ++ + lengthPrefixedWord (Computability.encodeNat second) ++ suffix) = + if first < second then .less + else if second < first then .greater + else .equal := by + rw [delimitedNaturalPairOrdering_valid, + littleEndianNaturalOrdering_encodeNat] + +private def naturalCompareConsumeBoth + (continuation : Turing.TM2.Stmt + (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState) : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePop 5 (delimitedComparePop 6 continuation) + +/-- Internal support shared across GapCVP continuation modules. -/ +def naturalCompareWordsStatement : + Turing.TM2.Stmt (fun _ : Fin 10 => Bool) (Fin 12) + DelimitedPairComparisonState := + delimitedComparePeekFirst 5 + (delimitedComparePeekSecond 6 + (.branch (fun state => state.first = state.second) + (naturalCompareConsumeBoth (delimitedCompareGoto 6)) + (.branch (fun state => state.first = some false) + (naturalCompareConsumeBoth + (delimitedCompareSetOutcome .less 6)) + (naturalCompareConsumeBoth + (delimitedCompareSetOutcome .greater 6)))) + (.branch (fun state => state.first = some false) + (delimitedComparePop 5 (delimitedCompareGoto 6)) + (delimitedComparePop 5 + (delimitedCompareSetOutcome .greater 6)))) + (delimitedComparePeekSecond 6 + (.branch (fun state => state.second = some false) + (delimitedComparePop 6 (delimitedCompareGoto 6)) + (delimitedComparePop 6 + (delimitedCompareSetOutcome .less 6))) + (.branch (fun state => state.outcome = .invalid) + (delimitedCompareSetOutcome .equal 7) + (delimitedCompareGoto 7))) + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev delimitedNaturalComparisonMachine : Turing.FinTM2 where + K := Fin 10 + k₀ := 0 + k₁ := 9 + Γ _ := Bool + Λ := Fin 12 + main := 0 + σ := DelimitedPairComparisonState + initialState := ⟨none, none, .invalid⟩ + m phase := + if phase = (0 : Fin 12) then + delimitedCompareFirstPrefixStatement + else if phase = (1 : Fin 12) then + delimitedCompareFirstPayloadStatement + else if phase = (2 : Fin 12) then + delimitedCompareSecondPrefixStatement + else if phase = (3 : Fin 12) then + delimitedCompareSecondPayloadStatement + else if phase = (4 : Fin 12) then + delimitedCompareReverseFirstStatement + else if phase = (5 : Fin 12) then + delimitedCompareReverseSecondStatement + else if phase = (6 : Fin 12) then + naturalCompareWordsStatement + else if phase = (7 : Fin 12) then + delimitedCompareCleanupStatement + else if phase = (8 : Fin 12) then + delimitedCompareTrailingStatement + else if phase = (9 : Fin 12) then + delimitedCompareOutcomeStatement + else if phase = (10 : Fin 12) then + delimitedCompareSourceStatement + else + delimitedComparePrefixStatement + +/-- Internal support shared across GapCVP continuation modules. -/ +def naturalCompareConfiguration (phase : Fin 12) + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.Cfg := + delimitedCompareConfiguration phase outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedNaturalComparisonMachine_init (input : List Bool) : + Turing.initList delimitedNaturalComparisonMachine input = + naturalCompareConfiguration 0 .invalid + input [] [] [] [] [] [] [] [] [] := by + exact delimitedPairComparisonMachine_init input + +/-- Executes the `naturalCompareStepTac` machine-step simplifier. -/ +macro "naturalCompareStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [delimitedNaturalComparisonMachine, + naturalCompareConfiguration, delimitedCompareConfiguration, + naturalCompareWordsStatement, naturalCompareConsumeBoth, + delimitedComparePeekFirst, delimitedComparePeekSecond, + delimitedComparePop, delimitedComparePushFirst, + delimitedComparePushConstant, delimitedCompareGoto, + delimitedCompareSetOutcome, + delimitedCompareFirstPrefixStatement, + delimitedCompareFirstPayloadStatement, + delimitedCompareSecondPrefixStatement, + delimitedCompareSecondPayloadStatement, + delimitedCompareReverseFirstStatement, + delimitedCompareReverseSecondStatement, + delimitedCompareCleanupStatement, + delimitedCompareTrailingStatement, + delimitedCompareOutcomeStatement, + delimitedCompareSourceStatement, + delimitedComparePrefixStatement, + encodedWordOrderingWord, + encodedWordOrderingFirst, encodedWordOrderingSecond, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem naturalCompare_words_equalBit + (outcome : EncodedWordOrdering) (bit : Bool) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + (bit :: firstForward) (bit :: secondForward) + source sourcePrefix output) = + some (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) := by + cases bit <;> naturalCompareStepTac + +private theorem naturalCompare_words_lessBit + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + (false :: firstForward) (true :: secondForward) + source sourcePrefix output) = + some (naturalCompareConfiguration 6 .less + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) := by + naturalCompareStepTac + +private theorem naturalCompare_words_greaterBit + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + (true :: firstForward) (false :: secondForward) + source sourcePrefix output) = + some (naturalCompareConfiguration 6 .greater + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) := by + naturalCompareStepTac + +private theorem naturalCompare_words_firstEmpty_false + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + secondForward source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + [] (false :: secondForward) source sourcePrefix output) = + some (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + [] secondForward source sourcePrefix output) := by + naturalCompareStepTac + +private theorem naturalCompare_words_firstEmpty_true + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + secondForward source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + [] (true :: secondForward) source sourcePrefix output) = + some (naturalCompareConfiguration 6 .less + input firstCounter firstReversed secondCounter secondReversed + [] secondForward source sourcePrefix output) := by + naturalCompareStepTac + +private theorem naturalCompare_words_secondEmpty_false + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + (false :: firstForward) [] source sourcePrefix output) = + some (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward [] source sourcePrefix output) := by + naturalCompareStepTac + +private theorem naturalCompare_words_secondEmpty_true + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + (true :: firstForward) [] source sourcePrefix output) = + some (naturalCompareConfiguration 6 .greater + input firstCounter firstReversed secondCounter secondReversed + firstForward [] source sourcePrefix output) := by + naturalCompareStepTac + +private theorem naturalCompare_words_bothEmpty_invalid + (input firstCounter firstReversed secondCounter secondReversed + source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 .invalid + input firstCounter firstReversed secondCounter secondReversed + [] [] source sourcePrefix output) = + some (naturalCompareConfiguration 7 .equal + input firstCounter firstReversed secondCounter secondReversed + [] [] source sourcePrefix output) := by + naturalCompareStepTac + +private theorem naturalCompare_words_bothEmpty + (outcome : EncodedWordOrdering) + (hvalid : outcome ≠ .invalid) + (input firstCounter firstReversed secondCounter secondReversed + source sourcePrefix output : List Bool) : + delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + [] [] source sourcePrefix output) = + some (naturalCompareConfiguration 7 outcome + input firstCounter firstReversed secondCounter secondReversed + [] [] source sourcePrefix output) := by + cases outcome with + | invalid => exact (hvalid rfl).elim + | less => naturalCompareStepTac + | equal => naturalCompareStepTac + | greater => naturalCompareStepTac + +private def naturalComparisonEffectiveOutcome + (outcome : EncodedWordOrdering) : EncodedWordOrdering := + if outcome = .invalid then .equal else outcome + +private def naturalCompare_wordsTrace + (outcome : EncodedWordOrdering) + (first second input firstCounter firstReversed + secondCounter secondReversed source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter secondReversed + first second source sourcePrefix output) + (some (naturalCompareConfiguration 7 + (littleEndianNaturalFold + (naturalComparisonEffectiveOutcome outcome) first second) + input firstCounter firstReversed secondCounter secondReversed + [] [] source sourcePrefix output)) + (first.length + second.length + 1) := by + induction first generalizing second outcome with + | nil => + induction second generalizing outcome with + | nil => + cases outcome with + | invalid => + simpa only [FinTM2.step, Fin.isValue, naturalComparisonEffectiveOutcome, ↓reduceIte, + littleEndianNaturalFold, + List.length_nil, add_zero, zero_add] using + oneStep _ _ + (naturalCompare_words_bothEmpty_invalid input firstCounter firstReversed + secondCounter secondReversed source + sourcePrefix output) + | less => + simpa only [FinTM2.step, Fin.isValue, naturalComparisonEffectiveOutcome, + reduceCtorEq, ↓reduceIte, + littleEndianNaturalFold, List.length_nil, add_zero, zero_add] using + oneStep _ _ + (naturalCompare_words_bothEmpty .less (by decide) input firstCounter + firstReversed secondCounter secondReversed + source sourcePrefix output) + | equal => + simpa only [FinTM2.step, Fin.isValue, naturalComparisonEffectiveOutcome, + reduceCtorEq, ↓reduceIte, + littleEndianNaturalFold, List.length_nil, add_zero, zero_add] using + oneStep _ _ + (naturalCompare_words_bothEmpty .equal (by decide) input firstCounter + firstReversed secondCounter secondReversed + source sourcePrefix output) + | greater => + simpa only [FinTM2.step, Fin.isValue, naturalComparisonEffectiveOutcome, + reduceCtorEq, ↓reduceIte, + littleEndianNaturalFold, List.length_nil, add_zero, zero_add] using + oneStep _ _ + (naturalCompare_words_bothEmpty .greater (by decide) input firstCounter + firstReversed secondCounter secondReversed + source sourcePrefix output) + | cons bit remaining ih => + cases bit with + | false => + have hfirst := oneStep _ _ (naturalCompare_words_firstEmpty_false outcome + input firstCounter firstReversed + secondCounter secondReversed remaining + source sourcePrefix output) + have hrest := ih (outcome := outcome) + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, littleEndianNaturalFold, List.length_nil, + List.length_cons, zero_add, + Nat.add_assoc, Nat.reduceAdd] using hfull + | true => + have hfirst := oneStep _ _ (naturalCompare_words_firstEmpty_true outcome + input firstCounter firstReversed + secondCounter secondReversed remaining + source sourcePrefix output) + have hrest := ih (outcome := .less) + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, naturalComparisonEffectiveOutcome, + littleEndianNaturalFold, + List.length_nil, List.length_cons, zero_add, Nat.add_assoc, Nat.reduceAdd, + reduceCtorEq, ↓reduceIte] using hfull + | cons bit remaining ih => + cases second with + | nil => + cases bit with + | false => + have hfirst := oneStep _ _ (naturalCompare_words_secondEmpty_false outcome + input firstCounter firstReversed + secondCounter secondReversed remaining + source sourcePrefix output) + have hrest := ih (second := []) (outcome := outcome) + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, littleEndianNaturalFold, List.length_cons, + List.length_nil, add_zero, + Nat.add_assoc, Nat.reduceAdd] using hfull + | true => + have hfirst := oneStep _ _ (naturalCompare_words_secondEmpty_true outcome + input firstCounter firstReversed + secondCounter secondReversed remaining + source sourcePrefix output) + have hrest := ih (second := []) (outcome := .greater) + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, naturalComparisonEffectiveOutcome, + littleEndianNaturalFold, + List.length_cons, List.length_nil, add_zero, Nat.add_assoc, Nat.reduceAdd, + reduceCtorEq, ↓reduceIte] using hfull + | cons next second => + cases bit <;> cases next + · have hfirst := oneStep _ _ (naturalCompare_words_equalBit outcome false + input firstCounter firstReversed + secondCounter secondReversed remaining second + source sourcePrefix output) + have hrest := ih (second := second) (outcome := outcome) + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst hrest + exact rebound (by simpa only [FinTM2.step, Fin.isValue, littleEndianNaturalFold, + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd] using hfull) + (by simp only [List.length_cons]; omega) + · have hfirst := oneStep _ _ (naturalCompare_words_lessBit outcome + input firstCounter firstReversed + secondCounter secondReversed remaining second + source sourcePrefix output) + have hrest := ih (second := second) (outcome := .less) + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst hrest + exact rebound (by simpa only [FinTM2.step, Fin.isValue, + naturalComparisonEffectiveOutcome, littleEndianNaturalFold, + reduceCtorEq, ↓reduceIte, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using hfull) + (by simp only [List.length_cons]; omega) + · have hfirst := oneStep _ _ (naturalCompare_words_greaterBit outcome + input firstCounter firstReversed + secondCounter secondReversed remaining second + source sourcePrefix output) + have hrest := ih (second := second) (outcome := .greater) + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst hrest + exact rebound (by simpa only [FinTM2.step, Fin.isValue, + naturalComparisonEffectiveOutcome, littleEndianNaturalFold, + reduceCtorEq, ↓reduceIte, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using hfull) + (by simp only [List.length_cons]; omega) + · have hfirst := oneStep _ _ (naturalCompare_words_equalBit outcome true + input firstCounter firstReversed + secondCounter secondReversed remaining second + source sourcePrefix output) + have hrest := ih (second := second) (outcome := outcome) + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst hrest + exact rebound (by simpa only [FinTM2.step, Fin.isValue, littleEndianNaturalFold, + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd] using hfull) + (by simp only [List.length_cons]; omega) + +/-- Internal support shared across GapCVP continuation modules. -/ +def naturalCompareWordsTraceInitial + (first second input firstCounter firstReversed + secondCounter secondReversed source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 6 .invalid + input firstCounter firstReversed secondCounter secondReversed + first second source sourcePrefix output) + (some (naturalCompareConfiguration 7 + (littleEndianNaturalOrdering first second) + input firstCounter firstReversed secondCounter secondReversed + [] [] source sourcePrefix output)) + (first.length + second.length + 1) := by + simpa only [FinTM2.step, Fin.isValue, littleEndianNaturalOrdering, + naturalComparisonEffectiveOutcome, + ↓reduceIte] using + naturalCompare_wordsTrace .invalid first second input firstCounter firstReversed + secondCounter secondReversed source + sourcePrefix output + +end CNFNaturalOrderComparator + +namespace CNFNaturalOrderTotalComparator + +open Computability Turing GapCVP.BinaryEncoding GapCVP.CNFEncodedClauseSort +open GapCVP.CNFNaturalOrderComparator + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem delimitedNaturalPairOrdering_missingFirst + (count : ℕ) : + delimitedNaturalPairOrdering (List.replicate count true) = .invalid := by + simp only [delimitedNaturalPairOrdering, readLengthPrefixedWord, + SourceTotalStructuralDecoder.readUnaryPrefix_missing] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedNaturalPairOrdering_shortFirst + (count : ℕ) (payload : List Bool) + (hshort : payload.length < count) : + delimitedNaturalPairOrdering + (List.replicate count true ++ false :: payload) = .invalid := by + have hnot : ¬ count ≤ payload.length := by omega + simp only [delimitedNaturalPairOrdering, readLengthPrefixedWord, readUnaryPrefix_replicate, hnot, + ↓reduceIte] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem delimitedNaturalPairOrdering_missingSecond + (first : List Bool) (count : ℕ) : + delimitedNaturalPairOrdering + (lengthPrefixedWord first ++ + List.replicate count true) = .invalid := by + unfold delimitedNaturalPairOrdering + rw [readLengthPrefixedWord_append first + (List.replicate count true)] + simp only [readLengthPrefixedWord, SourceTotalStructuralDecoder.readUnaryPrefix_missing] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem delimitedNaturalPairOrdering_shortSecond + (first : List Bool) (count : ℕ) (payload : List Bool) + (hshort : payload.length < count) : + delimitedNaturalPairOrdering + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)) = .invalid := by + unfold delimitedNaturalPairOrdering + rw [readLengthPrefixedWord_append first + (List.replicate count true ++ false :: payload)] + have hnot : ¬ count ≤ payload.length := by omega + simp only [readLengthPrefixedWord, readUnaryPrefix_replicate, hnot, ↓reduceIte] + +theorem sourcePreservingNaturalComparison_valid + (first second suffix : List Bool) : + sourcePreservingDelimitedNaturalComparisonWord + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) = + lengthPrefixedWord + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) ++ + encodedWordOrderingWord + (littleEndianNaturalOrdering first second) := by + simp only [sourcePreservingDelimitedNaturalComparisonWord] + rw [delimitedNaturalPairOrdering_valid] + +end CNFNaturalOrderTotalComparator + +namespace CNFNaturalOrderCertifiedComparator + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.CNFSortingDedup GapCVP.CNFEncodedClauseSort GapCVP.CNFNaturalOrderComparator +open GapCVP.CNFNaturalOrderTotalComparator + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem certifiedNatural_step_eq_old + (configuration : delimitedNaturalComparisonMachine.Cfg) + (hphase : configuration.l ≠ some (6 : Fin 12)) : + delimitedNaturalComparisonMachine.step configuration = + delimitedPairComparisonMachine.step configuration := by + rcases configuration with ⟨phase, state, stackWords⟩ + cases phase with + | none => + simp only [FinTM2.step, TM2.step] + rfl + | some phase => + have hnot : phase ≠ (6 : Fin 12) := by + simpa only [Fin.isValue, ne_eq, Option.some.injEq] using hphase + have hprogram : + delimitedNaturalComparisonMachine.m phase = + delimitedPairComparisonMachine.m phase := by + simp only [delimitedNaturalComparisonMachine, Fin.isValue, hnot, ↓reduceIte] + change + some (Turing.TM2.stepAux + (delimitedNaturalComparisonMachine.m phase) state stackWords) = + some (Turing.TM2.stepAux + (delimitedPairComparisonMachine.m phase) state stackWords) + rw [hprogram] + +end CNFNaturalOrderCertifiedComparator + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part04B.lean b/LeanPool/GapCVP/Part04B.lean new file mode 100644 index 000000000..e3bea05b3 --- /dev/null +++ b/LeanPool/GapCVP/Part04B.lean @@ -0,0 +1,2079 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part04A + +/-! # GapCVP proof, part 04, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFNaturalOrderCertifiedComparator + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder + +open GapCVP.CNFSortingDedup GapCVP.CNFEncodedClauseSort GapCVP.CNFNaturalOrderComparator + +open GapCVP.CNFNaturalOrderTotalComparator + +private def certifiedNatural_liftStep + {first next : delimitedNaturalComparisonMachine.Cfg} + (hphase : first.l ≠ some (6 : Fin 12)) + (hstep : delimitedPairComparisonMachine.step first = some next) : + EvalsToInTime delimitedNaturalComparisonMachine.step first (some next) 1 := + oneStep first next + ((certifiedNatural_step_eq_old first hphase).trans hstep) + +private def certifiedNatural_cleanupTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 7 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 8 outcome + input [] [] [] [] [] [] source sourcePrefix output)) + (firstCounter.length + firstReversed.length + + secondCounter.length + secondReversed.length + + firstForward.length + secondForward.length + 1) := by + induction firstCounter with + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_cleanup_firstCounter outcome bit + input remaining firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + exact rebound (EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst ih) + (by simp only [List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, + lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction firstReversed with + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_cleanup_firstReversed outcome bit + input remaining secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + exact rebound (EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst ih) + (by simp only [List.length_nil, zero_add, List.length_cons, add_le_add_iff_right, + Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction secondCounter with + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, + Option.some.injEq, Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_cleanup_secondCounter outcome bit + input remaining secondReversed firstForward secondForward + source sourcePrefix output) + exact rebound (EvalsToInTime.trans + delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst ih) + (by simp only [List.length_nil, add_zero, zero_add, List.length_cons, + add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction secondReversed with + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, + Option.some.injEq, Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_cleanup_secondReversed outcome bit + input remaining firstForward secondForward + source sourcePrefix output) + exact rebound (EvalsToInTime.trans + delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst ih) + (by simp only [List.length_nil, add_zero, zero_add, List.length_cons, + add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction firstForward with + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, + Option.some.injEq, Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_cleanup_firstForward outcome bit + input remaining secondForward + source sourcePrefix output) + exact rebound (EvalsToInTime.trans + delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst ih) + (by simp only [List.length_nil, add_zero, zero_add, List.length_cons, + add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction secondForward with + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, + Option.some.injEq, Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_cleanup_secondForward + outcome bit input remaining + source sourcePrefix output) + exact rebound (EvalsToInTime.trans + delimitedNaturalComparisonMachine.step + _ _ _ _ _ hfirst ih) + (by simp only [List.length_nil, add_zero, zero_add, List.length_cons, + Std.le_refl]) + | nil => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, + List.length_nil, add_zero, zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_cleanup_finish outcome input source sourcePrefix + output) + +private def certifiedNatural_trailingTrace + (outcome : EncodedWordOrdering) + (input source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 8 outcome + input [] [] [] [] [] [] source sourcePrefix output) + (some (naturalCompareConfiguration 9 outcome + [] [] [] [] [] [] [] + (input.reverse ++ source) + (List.replicate input.length true ++ sourcePrefix) output)) + (input.length + 1) := by + induction input generalizing source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_nil, + List.nil_append, + List.length_nil, List.replicate_zero, zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_trailing_finish outcome source sourcePrefix output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_trailing_step outcome bit + remaining source sourcePrefix output) + have hrest := ih (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_cons, + List.append_assoc, + List.cons_append, List.nil_append, List.length_cons, List.replicate_succ, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_sourceTrace + (outcome : EncodedWordOrdering) + (source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 10 outcome + [] [] [] [] [] [] [] source sourcePrefix output) + (some (naturalCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] sourcePrefix + (false :: (source.reverse ++ output)))) + (source.length + 1) := by + induction source generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_nil, + List.nil_append, + List.length_nil, zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_source_finish outcome sourcePrefix output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_source_step outcome bit + remaining sourcePrefix output) + have hrest := ih (output := bit :: output) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_cons, + List.append_assoc, + List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_prefixTrace + (outcome : EncodedWordOrdering) + (sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] sourcePrefix output) + (some (Turing.haltList delimitedNaturalComparisonMachine + (List.replicate sourcePrefix.length true ++ output))) + (sourcePrefix.length + 1) := by + induction sourcePrefix generalizing output with + | nil => + simpa only [delimitedNaturalComparisonMachine, Fin.isValue, FinTM2.step, + naturalCompareConfiguration, + haltList, List.length_nil, List.replicate_zero, List.nil_append, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, zero_add, + delimitedPairComparisonMachine] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_prefix_finish outcome output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_prefix_step outcome bit remaining output) + have hrest := ih (output := true :: output) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.length_cons, + List.replicate_succ, + List.cons_append, Nat.add_assoc, Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_finishTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 7 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (Turing.haltList delimitedNaturalComparisonMachine + (delimitedCompareRestoredWord outcome + input source sourcePrefix output))) + (firstCounter.length + firstReversed.length + + secondCounter.length + secondReversed.length + + firstForward.length + secondForward.length + + 3 * input.length + source.length + sourcePrefix.length + 5) := by + have hcleanup := certifiedNatural_cleanupTrace outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output + have htrailing := certifiedNatural_trailingTrace outcome + input source sourcePrefix output + have houtcome := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_outcome_step outcome + (input.reverse ++ source) + (List.replicate input.length true ++ sourcePrefix) output) + have hsource := certifiedNatural_sourceTrace outcome + (input.reverse ++ source) + (List.replicate input.length true ++ sourcePrefix) + (encodedWordOrderingWord outcome ++ output) + have hprefix : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 11 outcome + [] [] [] [] [] [] [] [] + (List.replicate input.length true ++ sourcePrefix) + (false :: + ((input.reverse ++ source).reverse ++ + (encodedWordOrderingWord outcome ++ output)))) + (some (Turing.haltList delimitedNaturalComparisonMachine + (delimitedCompareRestoredWord outcome + input source sourcePrefix output))) + ((List.replicate input.length true ++ sourcePrefix).length + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.reverse_append, List.reverse_reverse, + List.append_assoc, + delimitedCompareRestoredWord, List.length_append, List.length_replicate] using + certifiedNatural_prefixTrace outcome (List.replicate input.length true ++ sourcePrefix) + (false :: ((input.reverse ++ source).reverse ++ (encodedWordOrderingWord outcome ++ + output))) + have hfirst := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hcleanup htrailing + have hsecond := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst houtcome + have hthird := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hsecond hsource + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hthird hprefix + apply rebound hfull + simp only [List.length_append, List.length_reverse, + List.length_replicate] + omega + +private def certifiedNatural_firstPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (tail firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 1 outcome + tail (List.replicate count true ++ firstCounter) + firstReversed secondCounter secondReversed + firstForward secondForward + (false :: (List.replicate count true ++ source)) + (List.replicate (count + 1) true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing firstCounter source sourcePrefix with + | zero => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_zero, + List.nil_append, + zero_add, List.replicate_one, List.cons_append] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPrefix_delimiter outcome tail firstCounter firstReversed + secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + | succ count ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_firstPrefix_true outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (firstCounter := true :: firstCounter) + (source := true :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_succ, + List.cons_append, + Nat.add_assoc, Nat.reduceAdd, replicate_append_bit_cons] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_firstMissingPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 7 .invalid + [] (List.replicate count true ++ firstCounter) + firstReversed secondCounter secondReversed + firstForward secondForward + (List.replicate count true ++ source) + (List.replicate count true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing firstCounter source sourcePrefix with + | zero => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_zero, + List.nil_append, + zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPrefix_missing outcome firstCounter firstReversed secondCounter + secondReversed firstForward + secondForward source sourcePrefix output) + | succ count ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_firstPrefix_true outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (firstCounter := true :: firstCounter) + (source := true :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_succ, + List.cons_append, + Nat.add_assoc, Nat.reduceAdd, replicate_append_bit_cons] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_firstPayloadTrace + (outcome : EncodedWordOrdering) + (payload tail firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 1 outcome + (payload ++ tail) (List.replicate payload.length true) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 2 outcome + tail [] (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + (payload.length + 1) := by + induction payload generalizing firstReversed source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.nil_append, + List.length_nil, + List.replicate_zero, List.reverse_nil, zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPayload_finish outcome tail firstReversed secondCounter + secondReversed firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_firstPayload_step outcome bit true + (remaining ++ tail) (List.replicate remaining.length true) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih + (firstReversed := bit :: firstReversed) + (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.cons_append, + List.length_cons, + List.replicate_succ, List.reverse_cons, List.append_assoc, List.nil_append, + Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_firstPartialPayloadTrace + (outcome : EncodedWordOrdering) + (payload remainingCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 1 outcome + payload (List.replicate payload.length true ++ remainingCounter) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 1 outcome + [] remainingCounter (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + payload.length := by + induction payload generalizing firstReversed source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + List.reverse_nil] using + EvalsToInTime.refl delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 1 outcome [] remainingCounter firstReversed secondCounter + secondReversed firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_firstPayload_step outcome bit true + remaining + (List.replicate remaining.length true ++ remainingCounter) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (firstReversed := bit :: firstReversed) + (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.length_cons, + List.replicate_succ, + List.cons_append, List.reverse_cons, List.append_assoc, List.nil_append, + replicate_append_bit_cons] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_secondPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (tail firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 2 outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 3 outcome + tail firstCounter firstReversed + (List.replicate count true ++ secondCounter) secondReversed + firstForward secondForward + (false :: (List.replicate count true ++ source)) + (List.replicate (count + 1) true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing secondCounter source sourcePrefix with + | zero => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_zero, + List.nil_append, + zero_add, List.replicate_one, List.cons_append] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPrefix_delimiter outcome tail firstCounter firstReversed + secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + | succ count ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_secondPrefix_true outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (secondCounter := true :: secondCounter) + (source := true :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_succ, + List.cons_append, + Nat.add_assoc, Nat.reduceAdd, replicate_append_bit_cons] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_secondMissingPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 2 outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 7 .invalid + [] firstCounter firstReversed + (List.replicate count true ++ secondCounter) secondReversed + firstForward secondForward + (List.replicate count true ++ source) + (List.replicate count true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing secondCounter source sourcePrefix with + | zero => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_zero, + List.nil_append, + zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPrefix_missing outcome firstCounter firstReversed secondCounter + secondReversed + firstForward secondForward source sourcePrefix output) + | succ count ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_secondPrefix_true outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (secondCounter := true :: secondCounter) + (source := true :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_succ, + List.cons_append, + Nat.add_assoc, Nat.reduceAdd, replicate_append_bit_cons] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_secondPayloadTrace + (outcome : EncodedWordOrdering) + (payload tail firstCounter firstReversed secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 3 outcome + (payload ++ tail) firstCounter firstReversed + (List.replicate payload.length true) secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 4 outcome + tail firstCounter firstReversed [] + (payload.reverse ++ secondReversed) + firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + (payload.length + 1) := by + induction payload generalizing secondReversed source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.nil_append, + List.length_nil, + List.replicate_zero, List.reverse_nil, zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPayload_finish outcome tail firstCounter firstReversed + secondReversed firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_secondPayload_step outcome bit true + (remaining ++ tail) firstCounter firstReversed + (List.replicate remaining.length true) secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (secondReversed := bit :: secondReversed) + (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.cons_append, + List.length_cons, + List.replicate_succ, List.reverse_cons, List.append_assoc, List.nil_append, + Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_secondPartialPayloadTrace + (outcome : EncodedWordOrdering) + (payload remainingCounter firstCounter firstReversed + secondReversed firstForward secondForward + source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 3 outcome + payload firstCounter firstReversed + (List.replicate payload.length true ++ remainingCounter) + secondReversed firstForward secondForward + source sourcePrefix output) + (some (naturalCompareConfiguration 3 outcome + [] firstCounter firstReversed remainingCounter + (payload.reverse ++ secondReversed) + firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + payload.length := by + induction payload generalizing secondReversed source sourcePrefix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + List.reverse_nil] using + EvalsToInTime.refl delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 3 outcome [] firstCounter firstReversed remainingCounter + secondReversed firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_secondPayload_step outcome bit true + remaining firstCounter firstReversed + (List.replicate remaining.length true ++ remainingCounter) + secondReversed firstForward secondForward + source sourcePrefix output) + have hrest := ih (secondReversed := bit :: secondReversed) + (source := bit :: source) + (sourcePrefix := true :: sourcePrefix) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.length_cons, + List.replicate_succ, + List.cons_append, List.reverse_cons, List.append_assoc, List.nil_append, + replicate_append_bit_cons] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_firstRecordTrace + (outcome : EncodedWordOrdering) + (payload tail firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 outcome + (lengthPrefixedWord payload ++ tail) + [] firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 2 outcome + tail [] (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix) output)) + (2 * payload.length + 2) := by + have hprefix := certifiedNatural_firstPrefixTrace outcome + payload.length (payload ++ tail) [] firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output + simp only [List.append_nil] at hprefix + have hpayload := certifiedNatural_firstPayloadTrace outcome + payload tail firstReversed secondCounter secondReversed + firstForward secondForward + (false :: (List.replicate payload.length true ++ source)) + (List.replicate (payload.length + 1) true ++ sourcePrefix) output + have hfull := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hprefix hpayload + have hsource : + payload.reverse ++ + (false :: (List.replicate payload.length true ++ source)) = + (lengthPrefixedWord payload).reverse ++ source := by + simp only [lengthPrefixedWord, List.reverse_append, List.reverse_cons, List.reverse_replicate, + List.append_assoc, List.cons_append, List.nil_append] + have hmarkers : + List.replicate payload.length true ++ + (List.replicate (payload.length + 1) true ++ sourcePrefix) = + List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix := by + have hlength : + payload.length + (payload.length + 1) = + (lengthPrefixedWord payload).length := by + simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] + rw [← List.append_assoc, ← List.replicate_add, hlength] + rw [hsource, hmarkers] at hfull + have hcast : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 0 outcome + (lengthPrefixedWord payload ++ tail) + [] firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 2 outcome + tail [] (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix) output)) + ((payload.length + 1) + (payload.length + 1)) := by + simpa only [lengthPrefixedWord, List.append_assoc, + List.cons_append] using hfull + exact rebound hcast (by omega) + +private def certifiedNatural_secondRecordTrace + (outcome : EncodedWordOrdering) + (payload tail firstCounter firstReversed secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 2 outcome + (lengthPrefixedWord payload ++ tail) + firstCounter firstReversed [] secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 4 outcome + tail firstCounter firstReversed [] + (payload.reverse ++ secondReversed) + firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix) output)) + (2 * payload.length + 2) := by + have hprefix := certifiedNatural_secondPrefixTrace outcome + payload.length (payload ++ tail) firstCounter firstReversed [] + secondReversed firstForward secondForward source sourcePrefix output + simp only [List.append_nil] at hprefix + have hpayload := certifiedNatural_secondPayloadTrace outcome + payload tail firstCounter firstReversed secondReversed + firstForward secondForward + (false :: (List.replicate payload.length true ++ source)) + (List.replicate (payload.length + 1) true ++ sourcePrefix) output + have hfull := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hprefix hpayload + have hsource : + payload.reverse ++ + (false :: (List.replicate payload.length true ++ source)) = + (lengthPrefixedWord payload).reverse ++ source := by + simp only [lengthPrefixedWord, List.reverse_append, List.reverse_cons, List.reverse_replicate, + List.append_assoc, List.cons_append, List.nil_append] + have hmarkers : + List.replicate payload.length true ++ + (List.replicate (payload.length + 1) true ++ sourcePrefix) = + List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix := by + have hlength : + payload.length + (payload.length + 1) = + (lengthPrefixedWord payload).length := by + simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] + rw [← List.append_assoc, ← List.replicate_add, hlength] + rw [hsource, hmarkers] at hfull + have hcast : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 2 outcome + (lengthPrefixedWord payload ++ tail) + firstCounter firstReversed [] secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 4 outcome + tail firstCounter firstReversed [] + (payload.reverse ++ secondReversed) + firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ + sourcePrefix) output)) + ((payload.length + 1) + (payload.length + 1)) := by + simpa only [lengthPrefixedWord, List.append_assoc, + List.cons_append] using hfull + exact rebound hcast (by omega) + +private def certifiedNatural_reverseFirstTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 4 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 5 outcome + input firstCounter [] secondCounter secondReversed + (firstReversed.reverse ++ firstForward) secondForward + source sourcePrefix output)) + (firstReversed.length + 1) := by + induction firstReversed generalizing firstForward with + | nil => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_nil, + List.nil_append, + List.length_nil, zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_reverseFirst_finish outcome input firstCounter secondCounter + secondReversed firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_reverseFirst_step outcome bit + input firstCounter remaining secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + have hrest := ih (firstForward := bit :: firstForward) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_cons, + List.append_assoc, + List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_reverseSecondTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 5 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (naturalCompareConfiguration 6 outcome + input firstCounter firstReversed secondCounter [] + firstForward (secondReversed.reverse ++ secondForward) + source sourcePrefix output)) + (secondReversed.length + 1) := by + induction secondReversed generalizing secondForward with + | nil => + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_nil, + List.nil_append, + List.length_nil, zero_add] using + certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) + (delimitedCompare_reverseSecond_finish outcome input firstCounter firstReversed + secondCounter firstForward + secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_reverseSecond_step outcome bit + input firstCounter firstReversed secondCounter remaining + firstForward secondForward source sourcePrefix output) + have hrest := ih (secondForward := bit :: secondForward) + simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_cons, + List.append_assoc, + List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + +private def certifiedNatural_validTrace + (first second suffix : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedNaturalComparisonMachine + (sourcePreservingDelimitedNaturalComparisonWord + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix)))) + (24 * + ((lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix).length + 1) + 24) := by + let firstCode := lengthPrefixedWord first + let secondCode := lengthPrefixedWord second + let saved := secondCode.reverse ++ firstCode.reverse + let prefixMarkers := + List.replicate secondCode.length true ++ + List.replicate firstCode.length true + have hfirst : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] []) + (some (naturalCompareConfiguration 2 .invalid + (lengthPrefixedWord second ++ suffix) + [] first.reverse [] [] [] [] firstCode.reverse + (List.replicate firstCode.length true) [])) + (2 * first.length + 2) := by + simpa [firstCode, List.append_assoc] using + certifiedNatural_firstRecordTrace .invalid first + (lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] + have hsecond : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 2 .invalid + (lengthPrefixedWord second ++ suffix) + [] first.reverse [] [] [] [] firstCode.reverse + (List.replicate firstCode.length true) []) + (some (naturalCompareConfiguration 4 .invalid + suffix [] first.reverse [] second.reverse [] [] + saved prefixMarkers [])) + (2 * second.length + 2) := by + simpa [firstCode, secondCode, saved, prefixMarkers] using + certifiedNatural_secondRecordTrace .invalid second suffix + [] first.reverse [] [] [] + firstCode.reverse (List.replicate firstCode.length true) [] + have hreverseFirst : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 4 .invalid + suffix [] first.reverse [] second.reverse [] [] + saved prefixMarkers []) + (some (naturalCompareConfiguration 5 .invalid + suffix [] [] [] second.reverse first [] + saved prefixMarkers [])) + (first.length + 1) := by + simpa using certifiedNatural_reverseFirstTrace .invalid + suffix [] first.reverse [] second.reverse [] [] + saved prefixMarkers [] + have hreverseSecond : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 5 .invalid + suffix [] [] [] second.reverse first [] + saved prefixMarkers []) + (some (naturalCompareConfiguration 6 .invalid + suffix [] [] [] [] first second saved prefixMarkers [])) + (second.length + 1) := by + simpa using certifiedNatural_reverseSecondTrace .invalid + suffix [] [] [] second.reverse first [] + saved prefixMarkers [] + have hcompare := naturalCompareWordsTraceInitial + first second suffix [] [] [] [] saved prefixMarkers [] + have hfinish := certifiedNatural_finishTrace + (littleEndianNaturalOrdering first second) + suffix [] [] [] [] [] [] saved prefixMarkers [] + have hprefixLength : + suffix.length + prefixMarkers.length = + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix).length := by + simp only [prefixMarkers, firstCode, secondCode, + List.length_append, List.length_replicate, + lengthPrefixedWord_length] + omega + have hrestored : + delimitedCompareRestoredWord + (littleEndianNaturalOrdering first second) + suffix saved prefixMarkers [] = + sourcePreservingDelimitedNaturalComparisonWord + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) := by + simp only [delimitedCompareRestoredWord, + sourcePreservingDelimitedNaturalComparisonWord, + delimitedNaturalPairOrdering_valid, List.append_nil] + rw [hprefixLength] + simp [saved, firstCode, secondCode, lengthPrefixedWord, + List.reverse_append, List.append_assoc] + rw [hrestored] at hfinish + have h01 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hsecond + have h012 := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ h01 hreverseFirst + have h0123 := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ h012 hreverseSecond + have h01234 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h0123 + hcompare + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h01234 hfinish + apply rebound hfull + simp only [saved, prefixMarkers, firstCode, secondCode, + List.length_append, List.length_reverse, + List.length_replicate, List.length_nil, + lengthPrefixedWord_length] + omega + +private def certifiedNatural_missingFirstTrace (count : ℕ) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 .invalid + (List.replicate count true) [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedNaturalComparisonMachine + (sourcePreservingDelimitedNaturalComparisonWord + (List.replicate count true)))) + (24 * ((List.replicate count true).length + 1) + 24) := by + have hscan : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 0 .invalid + (List.replicate count true) [] [] [] [] [] [] [] [] []) + (some (naturalCompareConfiguration 7 .invalid + [] (List.replicate count true) [] [] [] [] [] + (List.replicate count true) + (List.replicate count true) [])) + (count + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using + certifiedNatural_firstMissingPrefixTrace .invalid count [] [] [] [] [] [] [] [] [] + have hfinish := certifiedNatural_finishTrace .invalid + [] (List.replicate count true) [] [] [] [] [] + (List.replicate count true) (List.replicate count true) [] + have hrestored : + delimitedCompareRestoredWord .invalid [] + (List.replicate count true) (List.replicate count true) [] = + sourcePreservingDelimitedNaturalComparisonWord + (List.replicate count true) := by + simp only [delimitedCompareRestoredWord, List.length_nil, List.length_replicate, zero_add, + List.reverse_replicate, List.append_nil, sourcePreservingDelimitedNaturalComparisonWord, + lengthPrefixedWord, + delimitedNaturalPairOrdering_missingFirst, List.append_assoc, List.cons_append] + rw [hrestored] at hfinish + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hscan hfinish + apply rebound hfull + simp only [List.length_replicate, List.length_nil] + omega + +private def certifiedNatural_truncatedFirstTrace + (count : ℕ) (payload : List Bool) + (hshort : payload.length < count) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 .invalid + (List.replicate count true ++ false :: payload) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedNaturalComparisonMachine + (sourcePreservingDelimitedNaturalComparisonWord + (List.replicate count true ++ false :: payload)))) + (24 * + ((List.replicate count true ++ false :: payload).length + 1) + 24) := by + let extra := count - payload.length - 1 + have hcount : count = payload.length + extra + 1 := by + dsimp [extra] + omega + have hcounter : + List.replicate count true = + List.replicate payload.length true ++ + List.replicate (extra + 1) true := by + have hsplit : count = payload.length + (extra + 1) := by omega + rw [hsplit, List.replicate_add] + let saved := payload.reverse ++ false :: List.replicate count true + let prefixMarkers := + List.replicate payload.length true ++ + List.replicate (count + 1) true + have hprefix : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 0 .invalid + (List.replicate count true ++ false :: payload) + [] [] [] [] [] [] [] [] []) + (some (naturalCompareConfiguration 1 .invalid + payload (List.replicate count true) [] [] [] [] [] + (false :: List.replicate count true) + (List.replicate (count + 1) true) [])) + (count + 1) := by + simpa only [FinTM2.step, Fin.isValue, List.append_nil] using + certifiedNatural_firstPrefixTrace .invalid count payload [] [] [] [] [] [] [] [] [] + have hpartial : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 1 .invalid + payload (List.replicate count true) [] [] [] [] [] + (false :: List.replicate count true) + (List.replicate (count + 1) true) []) + (some (naturalCompareConfiguration 1 .invalid + [] (true :: List.replicate extra true) + payload.reverse [] [] [] [] saved prefixMarkers [])) + payload.length := by + have hremaining : + List.replicate (extra + 1) true = + true :: List.replicate extra true := by + simp only [List.replicate_succ] + have hraw := certifiedNatural_firstPartialPayloadTrace + .invalid payload (List.replicate (extra + 1) true) + [] [] [] [] [] (false :: List.replicate count true) + (List.replicate (count + 1) true) [] + rw [← hcounter, hremaining] at hraw + simpa only [saved, prefixMarkers, List.append_nil] using hraw + have hmissing := certifiedNatural_liftStep + (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, + Fin.reduceEq, + not_false_eq_true]) + (delimitedCompare_firstPayload_missing .invalid true + (List.replicate extra true) payload.reverse + [] [] [] [] saved prefixMarkers []) + have hfinish := certifiedNatural_finishTrace .invalid + [] (List.replicate extra true) payload.reverse + [] [] [] [] saved prefixMarkers [] + have hprefixLength : + prefixMarkers.length = + (List.replicate count true ++ false :: payload).length := by + simp only [prefixMarkers, List.length_append, + List.length_replicate, List.length_cons] + omega + have hordering := + delimitedNaturalPairOrdering_shortFirst count payload hshort + have hrestored : + delimitedCompareRestoredWord .invalid [] + saved prefixMarkers [] = + sourcePreservingDelimitedNaturalComparisonWord + (List.replicate count true ++ false :: payload) := by + simp only [delimitedCompareRestoredWord, + sourcePreservingDelimitedNaturalComparisonWord, + hordering, List.length_nil, Nat.zero_add, List.append_nil] + rw [hprefixLength] + simp only [List.length_append, List.length_replicate, List.length_cons, List.reverse_append, + List.reverse_cons, List.reverse_replicate, List.reverse_reverse, List.append_assoc, + List.cons_append, + List.nil_append, lengthPrefixedWord, saved] + rw [hrestored] at hfinish + have h01 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hprefix hpartial + have h012 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h01 hmissing + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h012 hfinish + apply rebound hfull + simp only [saved, prefixMarkers, List.length_append, + List.length_replicate, List.length_reverse, + List.length_cons, List.length_nil] + omega + +private def certifiedNatural_missingSecondTrace + (first : List Bool) (count : ℕ) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ List.replicate count true) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedNaturalComparisonMachine + (sourcePreservingDelimitedNaturalComparisonWord + (lengthPrefixedWord first ++ List.replicate count true)))) + (24 * + ((lengthPrefixedWord first ++ List.replicate count true).length + + 1) + 24) := by + let firstCode := lengthPrefixedWord first + let saved := List.replicate count true ++ firstCode.reverse + let prefixMarkers := + List.replicate count true ++ + List.replicate firstCode.length true + have hfirst : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ List.replicate count true) + [] [] [] [] [] [] [] [] []) + (some (naturalCompareConfiguration 2 .invalid + (List.replicate count true) + [] first.reverse [] [] [] [] firstCode.reverse + (List.replicate firstCode.length true) [])) + (2 * first.length + 2) := by + simpa [firstCode] using certifiedNatural_firstRecordTrace + .invalid first (List.replicate count true) + [] [] [] [] [] [] [] [] + have hmissing : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 2 .invalid + (List.replicate count true) + [] first.reverse [] [] [] [] firstCode.reverse + (List.replicate firstCode.length true) []) + (some (naturalCompareConfiguration 7 .invalid + [] [] first.reverse (List.replicate count true) + [] [] [] saved prefixMarkers [])) + (count + 1) := by + simpa [saved, prefixMarkers] using + certifiedNatural_secondMissingPrefixTrace .invalid count + [] first.reverse [] [] [] [] + firstCode.reverse (List.replicate firstCode.length true) [] + have hfinish := certifiedNatural_finishTrace .invalid + [] [] first.reverse (List.replicate count true) + [] [] [] saved prefixMarkers [] + have hprefixLength : + prefixMarkers.length = + (lengthPrefixedWord first ++ List.replicate count true).length := by + simp only [prefixMarkers, firstCode, + List.length_append, List.length_replicate] + omega + have hrestored : + delimitedCompareRestoredWord .invalid [] + saved prefixMarkers [] = + sourcePreservingDelimitedNaturalComparisonWord + (lengthPrefixedWord first ++ List.replicate count true) := by + simp only [delimitedCompareRestoredWord, + sourcePreservingDelimitedNaturalComparisonWord, + delimitedNaturalPairOrdering_missingSecond, + List.length_nil, Nat.zero_add, List.append_nil] + rw [hprefixLength] + simp [saved, firstCode, lengthPrefixedWord, + List.reverse_append, List.append_assoc] + rw [hrestored] at hfinish + have hfirstTwo := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hmissing + have hfull := EvalsToInTime.trans + delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirstTwo hfinish + apply rebound hfull + simp only [saved, prefixMarkers, firstCode, + List.length_append, List.length_replicate, + List.length_reverse, List.length_nil, + lengthPrefixedWord_length] + omega + +private def certifiedNatural_truncatedSecondTrace + (first : List Bool) (count : ℕ) (payload : List Bool) + (hshort : payload.length < count) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedNaturalComparisonMachine + (sourcePreservingDelimitedNaturalComparisonWord + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload))))) + (24 * + ((lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)).length + 1) + + 24) := by + let extra := count - payload.length - 1 + have hcount : count = payload.length + extra + 1 := by + dsimp [extra] + omega + have hcounter : + List.replicate count true = + List.replicate payload.length true ++ + List.replicate (extra + 1) true := by + have hsplit : count = payload.length + (extra + 1) := by omega + rw [hsplit, List.replicate_add] + let firstCode := lengthPrefixedWord first + let saved := payload.reverse ++ + false :: (List.replicate count true ++ firstCode.reverse) + let prefixMarkers := + List.replicate payload.length true ++ + (List.replicate (count + 1) true ++ + List.replicate firstCode.length true) + have hfirst : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)) + [] [] [] [] [] [] [] [] []) + (some (naturalCompareConfiguration 2 .invalid + (List.replicate count true ++ false :: payload) + [] first.reverse [] [] [] [] firstCode.reverse + (List.replicate firstCode.length true) [])) + (2 * first.length + 2) := by + simpa [firstCode] using certifiedNatural_firstRecordTrace + .invalid first (List.replicate count true ++ false :: payload) + [] [] [] [] [] [] [] [] + have hprefix : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 2 .invalid + (List.replicate count true ++ false :: payload) + [] first.reverse [] [] [] [] firstCode.reverse + (List.replicate firstCode.length true) []) + (some (naturalCompareConfiguration 3 .invalid + payload [] first.reverse + (List.replicate count true) [] [] [] + (false :: (List.replicate count true ++ firstCode.reverse)) + (List.replicate (count + 1) true ++ + List.replicate firstCode.length true) [])) + (count + 1) := by + simpa using certifiedNatural_secondPrefixTrace .invalid count + payload [] first.reverse [] [] [] [] + firstCode.reverse (List.replicate firstCode.length true) [] + have hpartial : + EvalsToInTime delimitedNaturalComparisonMachine.step + (naturalCompareConfiguration 3 .invalid + payload [] first.reverse + (List.replicate count true) [] [] [] + (false :: (List.replicate count true ++ firstCode.reverse)) + (List.replicate (count + 1) true ++ + List.replicate firstCode.length true) []) + (some (naturalCompareConfiguration 3 .invalid + [] [] first.reverse (true :: List.replicate extra true) + payload.reverse [] [] saved prefixMarkers [])) + payload.length := by + have hremaining : + List.replicate (extra + 1) true = + true :: List.replicate extra true := by + simp [List.replicate_succ] + have hraw := certifiedNatural_secondPartialPayloadTrace + .invalid payload (List.replicate (extra + 1) true) + [] first.reverse [] [] [] + (false :: (List.replicate count true ++ firstCode.reverse)) + (List.replicate (count + 1) true ++ + List.replicate firstCode.length true) [] + rw [← hcounter, hremaining] at hraw + simpa only [saved, prefixMarkers, List.append_nil] using hraw + have hmissing := certifiedNatural_liftStep + (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPayload_missing .invalid true + [] first.reverse (List.replicate extra true) + payload.reverse [] [] saved prefixMarkers []) + have hfinish := certifiedNatural_finishTrace .invalid + [] [] first.reverse (List.replicate extra true) + payload.reverse [] [] saved prefixMarkers [] + have hprefixLength : + prefixMarkers.length = + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)).length := by + simp only [prefixMarkers, firstCode, List.length_append, + List.length_replicate, List.length_cons, + lengthPrefixedWord_length] + omega + have hordering := + delimitedNaturalPairOrdering_shortSecond first count payload hshort + have hrestored : + delimitedCompareRestoredWord .invalid [] + saved prefixMarkers [] = + sourcePreservingDelimitedNaturalComparisonWord + (lengthPrefixedWord first ++ + (List.replicate count true ++ false :: payload)) := by + simp only [delimitedCompareRestoredWord, + sourcePreservingDelimitedNaturalComparisonWord, + hordering, List.length_nil, Nat.zero_add, List.append_nil] + rw [hprefixLength] + simp [saved, firstCode, lengthPrefixedWord, + List.reverse_append, List.append_assoc] + rw [hrestored] at hfinish + have h01 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hprefix + have h012 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h01 hpartial + have h0123 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h012 hmissing + have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h0123 hfinish + apply rebound hfull + simp only [saved, prefixMarkers, firstCode, + List.length_append, List.length_replicate, + List.length_reverse, List.length_cons, List.length_nil, + lengthPrefixedWord_length] + omega + +private def certifiedNatural_totalTrace (input : List Bool) : + EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 0 .invalid + input [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedNaturalComparisonMachine + (sourcePreservingDelimitedNaturalComparisonWord input))) + (24 * (input.length + 1) + 24) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + exact certifiedNatural_missingFirstTrace count + | inr witness => + obtain ⟨count, tail, hinput⟩ := witness + subst input + by_cases hlength : count ≤ tail.length + · let first := tail.take count + let rest := tail.drop count + have hfirstRecord : + List.replicate count true ++ false :: tail = + lengthPrefixedWord first ++ rest := by + simpa only using validInput_reconstruct count tail hlength + rw [hfirstRecord] + cases unaryInputSplit rest with + | inl secondWitness => + obtain ⟨secondCount, hsecond⟩ := secondWitness + rw [hsecond] + exact certifiedNatural_missingSecondTrace first secondCount + | inr secondWitness => + obtain ⟨secondCount, secondTail, hsecond⟩ := secondWitness + rw [hsecond] + by_cases hsecondLength : secondCount ≤ secondTail.length + · have hsecondRecord := validInput_reconstruct + secondCount secondTail hsecondLength + rw [hsecondRecord] + simpa only [FinTM2.step, Fin.isValue, List.length_append, lengthPrefixedWord_length, + List.length_take, + List.length_drop, List.append_assoc] using + certifiedNatural_validTrace first (secondTail.take secondCount) (secondTail.drop + secondCount) + · exact certifiedNatural_truncatedSecondTrace + first secondCount secondTail + (Nat.lt_of_not_ge hsecondLength) + · exact certifiedNatural_truncatedFirstTrace + count tail (Nat.lt_of_not_ge hlength) + +/-- GapCVP reduction support. -/ +def sourcePreservingDelimitedNaturalComparisonComputable : + BitTM + sourcePreservingDelimitedNaturalComparisonWord where + tm := delimitedNaturalComparisonMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 24 * (Polynomial.X + 1) + 24 + outputsFun input := { + steps := (certifiedNatural_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, + delimitedNaturalComparisonMachine_init, Option.map_some] using + (certifiedNatural_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (certifiedNatural_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, Polynomial.eval_one, ge_iff_le] using hsteps + } + +end CNFNaturalOrderCertifiedComparator + +namespace CNFPolynomialRowMarkerTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder + +/-- GapCVP reduction support. -/ +def sourcePreservingPolynomialMarkerWord + (polynomial : Polynomial ℕ) + (input : List Bool) : List Bool := + lengthPrefixedWord input ++ + lengthPrefixedWord + (List.replicate (polynomial.eval input.length) true) + +private theorem read_sourcePreservingPolynomialMarkerWord + (polynomial : Polynomial ℕ) + (input : List Bool) : + readLengthPrefixedWord + (sourcePreservingPolynomialMarkerWord polynomial input) = + some + (input, + lengthPrefixedWord + (List.replicate (polynomial.eval input.length) true)) := by + exact readLengthPrefixedWord_append input + (lengthPrefixedWord + (List.replicate (polynomial.eval input.length) true)) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem firstFieldSuffix_sourcePreservingPolynomialMarkerWord + (polynomial : Polynomial ℕ) + (input : List Bool) : + firstFieldSuffix + (sourcePreservingPolynomialMarkerWord polynomial input) = + lengthPrefixedWord + (List.replicate (polynomial.eval input.length) true) := by + unfold firstFieldSuffix + rw [read_sourcePreservingPolynomialMarkerWord] + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerHorner + (polynomial : Polynomial ℕ) (value : ℕ) : + ℕ → ℕ → ℕ + | 0, accumulator => accumulator + | stage + 1, accumulator => + polynomialRowMarkerHorner polynomial value stage + (accumulator * value + polynomial.coeff stage) + +private theorem polynomialRowMarkerHorner_closed + (polynomial : Polynomial ℕ) + (value stages accumulator : ℕ) : + polynomialRowMarkerHorner + polynomial value stages accumulator = + accumulator * value ^ stages + + ∑ stage ∈ Finset.range stages, + polynomial.coeff stage * value ^ stage := by + induction stages generalizing accumulator with + | zero => + simp only [polynomialRowMarkerHorner, pow_zero, mul_one, Finset.range_zero, Finset.sum_empty, + add_zero] + | succ stage ih => + rw [polynomialRowMarkerHorner, ih, + Finset.sum_range_succ, pow_succ] + ring + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarkerHorner_eval + (polynomial : Polynomial ℕ) + (value : ℕ) : + polynomialRowMarkerHorner + polynomial value (polynomial.natDegree + 1) 0 = + polynomial.eval value := by + rw [polynomialRowMarkerHorner_closed] + simp only [zero_mul, zero_add] + have hdegree : + polynomial.natDegree < polynomial.natDegree + 1 := by + omega + simpa only using (Polynomial.eval_eq_sum_range' (x := value) hdegree).symm + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev PolynomialRowMarkerStage (polynomial : Polynomial ℕ) := + Fin (polynomial.natDegree + 1) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerTopStage + (polynomial : Polynomial ℕ) : + PolynomialRowMarkerStage polynomial := + ⟨polynomial.natDegree, by omega⟩ + +private def polynomialRowMarkerPeek + (polynomial : Polynomial ℕ) + (stack : Fin 7) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + .peek stack (fun _ bit => bit) + (.branch (fun bit => bit.isSome) present absent) + +private def polynomialRowMarkerPop + (polynomial : Polynomial ℕ) + (stack : Fin 7) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + .pop stack (fun bit _ => bit) continuation + +private def polynomialRowMarkerPushBit + (polynomial : Polynomial ℕ) + (stack : Fin 7) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + .push stack (fun bit => bit.getD false) continuation + +private def polynomialRowMarkerPushConstant + (polynomial : Polynomial ℕ) + (stack : Fin 7) (bit : Bool) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + .push stack (fun _ => bit) continuation + +private def polynomialRowMarkerGoto + (polynomial : Polynomial ℕ) + (phase : Fin 9) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + .load (fun _ => none) (.goto (fun _ => (phase, stage))) + +private def polynomialRowMarkerPushBits + (polynomial : Polynomial ℕ) + (stack : Fin 7) : + List Bool → + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) → + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) + | [], continuation => continuation + | bit :: remaining, continuation => + polynomialRowMarkerPushConstant polynomial stack bit + (polynomialRowMarkerPushBits polynomial stack + remaining continuation) + +private theorem polynomialRowMarkerPushBits_stepAux + (polynomial : Polynomial ℕ) + (stack : Fin 7) + (bits : List Bool) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool)) + (state : Option Bool) + (stackWords : (index : Fin 7) → List Bool) : + Turing.TM2.stepAux + (polynomialRowMarkerPushBits + polynomial stack bits continuation) + state stackWords = + Turing.TM2.stepAux continuation state + (Function.update stackWords stack + (bits.reverse ++ stackWords stack)) := by + induction bits generalizing stackWords with + | nil => + simp only [polynomialRowMarkerPushBits, List.reverse_nil, List.nil_append, + Function.update_eq_self] + | cons bit remaining ih => + simp only [polynomialRowMarkerPushBits, + polynomialRowMarkerPushConstant, + Turing.TM2.stepAux] + rw [ih] + congr 1 + funext index + by_cases heq : index = stack + · subst index + simp only [Function.update, ↓reduceDIte, List.reverse_cons, List.append_assoc, + List.cons_append, + List.nil_append] + · simp only [Function.update, heq, ↓reduceDIte] + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerScanStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 0 + (polynomialRowMarkerPop polynomial 0 + (polynomialRowMarkerPushBit polynomial 1 + (polynomialRowMarkerPushConstant polynomial 2 true + (polynomialRowMarkerGoto polynomial 0 stage)))) + (polynomialRowMarkerGoto polynomial 1 stage) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerMultiplyStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 4 + (polynomialRowMarkerPop polynomial 4 + (polynomialRowMarkerGoto polynomial 2 stage)) + (polynomialRowMarkerGoto polynomial 4 stage) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerBaseStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 2 + (polynomialRowMarkerPop polynomial 2 + (polynomialRowMarkerPushConstant polynomial 3 true + (polynomialRowMarkerPushConstant polynomial 5 true + (polynomialRowMarkerGoto polynomial 2 stage)))) + (polynomialRowMarkerGoto polynomial 3 stage) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerRestoreBaseStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 3 + (polynomialRowMarkerPop polynomial 3 + (polynomialRowMarkerPushConstant polynomial 2 true + (polynomialRowMarkerGoto polynomial 3 stage))) + (polynomialRowMarkerGoto polynomial 1 stage) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerPredStage + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (_hstage : stage.val ≠ 0) : + PolynomialRowMarkerStage polynomial := + ⟨stage.val - 1, by have h := stage.isLt; omega⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerCoefficientStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 5 + (polynomialRowMarkerPop polynomial 5 + (polynomialRowMarkerPushConstant polynomial 4 true + (polynomialRowMarkerGoto polynomial 4 stage))) + (if hzero : stage.val = 0 then + polynomialRowMarkerPushBits polynomial 4 + (List.replicate (polynomial.coeff stage.val) true) + (polynomialRowMarkerGoto polynomial 5 stage) + else + polynomialRowMarkerPushBits polynomial 4 + (List.replicate (polynomial.coeff stage.val) true) + (polynomialRowMarkerGoto polynomial 1 + (polynomialRowMarkerPredStage polynomial stage hzero))) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerPayloadStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 4 + (polynomialRowMarkerPop polynomial 4 + (polynomialRowMarkerPushConstant polynomial 5 true + (polynomialRowMarkerPushConstant polynomial 6 true + (polynomialRowMarkerGoto polynomial 5 stage)))) + (polynomialRowMarkerPushConstant polynomial 6 false + (polynomialRowMarkerGoto polynomial 6 stage)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerHeaderStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 5 + (polynomialRowMarkerPop polynomial 5 + (polynomialRowMarkerPushConstant polynomial 6 true + (polynomialRowMarkerGoto polynomial 6 stage))) + (polynomialRowMarkerGoto polynomial 7 stage) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerSourceStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 1 + (polynomialRowMarkerPop polynomial 1 + (polynomialRowMarkerPushBit polynomial 6 + (polynomialRowMarkerGoto polynomial 7 stage))) + (polynomialRowMarkerPushConstant polynomial 6 false + (polynomialRowMarkerGoto polynomial 8 stage)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerPrefixStatement + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) : + Turing.TM2.Stmt + (fun _ : Fin 7 => Bool) + (Fin 9 × PolynomialRowMarkerStage polynomial) + (Option Bool) := + polynomialRowMarkerPeek polynomial 2 + (polynomialRowMarkerPop polynomial 2 + (polynomialRowMarkerPushConstant polynomial 6 true + (polynomialRowMarkerGoto polynomial 8 stage))) + .halt + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev polynomialRowMarkerMachine + (polynomial : Polynomial ℕ) : Turing.FinTM2 where + K := Fin 7 + k₀ := 0 + k₁ := 6 + Γ _ := Bool + Λ := Fin 9 × PolynomialRowMarkerStage polynomial + main := (0, polynomialRowMarkerTopStage polynomial) + σ := Option Bool + initialState := none + m label := + if label.1 = (0 : Fin 9) then + polynomialRowMarkerScanStatement polynomial label.2 + else if label.1 = (1 : Fin 9) then + polynomialRowMarkerMultiplyStatement polynomial label.2 + else if label.1 = (2 : Fin 9) then + polynomialRowMarkerBaseStatement polynomial label.2 + else if label.1 = (3 : Fin 9) then + polynomialRowMarkerRestoreBaseStatement polynomial label.2 + else if label.1 = (4 : Fin 9) then + polynomialRowMarkerCoefficientStatement polynomial label.2 + else if label.1 = (5 : Fin 9) then + polynomialRowMarkerPayloadStatement polynomial label.2 + else if label.1 = (6 : Fin 9) then + polynomialRowMarkerHeaderStatement polynomial label.2 + else if label.1 = (7 : Fin 9) then + polynomialRowMarkerSourceStatement polynomial label.2 + else + polynomialRowMarkerPrefixStatement polynomial label.2 + +/-- Internal support shared across GapCVP continuation modules. -/ +def polynomialRowMarkerConfiguration + (polynomial : Polynomial ℕ) + (phase : Fin 9) + (stage : PolynomialRowMarkerStage polynomial) + (input source base baseScratch accumulator product output : + List Bool) : + (polynomialRowMarkerMachine polynomial).Cfg where + l := some (phase, stage) + var := none + stk := ![input, source, base, baseScratch, + accumulator, product, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarkerMachine_init + (polynomial : Polynomial ℕ) + (input : List Bool) : + Turing.initList (polynomialRowMarkerMachine polynomial) input = + polynomialRowMarkerConfiguration polynomial + 0 (polynomialRowMarkerTopStage polynomial) + input [] [] [] [] [] [] := by + simp only [polynomialRowMarkerMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + polynomialRowMarkerConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `polynomialRowMarkerStepTac` machine-step simplifier. -/ +macro "polynomialRowMarkerStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [polynomialRowMarkerMachine, + polynomialRowMarkerConfiguration, + polynomialRowMarkerPeek, polynomialRowMarkerPop, + polynomialRowMarkerPushBit, + polynomialRowMarkerPushConstant, + polynomialRowMarkerGoto, + polynomialRowMarkerScanStatement, + polynomialRowMarkerMultiplyStatement, + polynomialRowMarkerBaseStatement, + polynomialRowMarkerRestoreBaseStatement, + polynomialRowMarkerCoefficientStatement, + polynomialRowMarkerPayloadStatement, + polynomialRowMarkerHeaderStatement, + polynomialRowMarkerSourceStatement, + polynomialRowMarkerPrefixStatement, + polynomialRowMarkerPushBits_stepAux, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_scan_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (bit : Bool) + (input source base baseScratch accumulator product output : + List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 0 stage + (bit :: input) source base baseScratch + accumulator product output) = + some + (polynomialRowMarkerConfiguration polynomial 0 stage + input (bit :: source) (true :: base) baseScratch + accumulator product output) := by + cases bit <;> polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_scan_finish + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base baseScratch accumulator product output : + List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 0 stage + [] source base baseScratch accumulator product output) = + some + (polynomialRowMarkerConfiguration polynomial 1 stage + [] source base baseScratch accumulator product output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_multiply_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base baseScratch accumulator product output : + List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 1 stage + [] source base baseScratch (true :: accumulator) + product output) = + some + (polynomialRowMarkerConfiguration polynomial 2 stage + [] source base baseScratch accumulator product output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_multiply_finish + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base baseScratch product output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 1 stage + [] source base baseScratch [] product output) = + some + (polynomialRowMarkerConfiguration polynomial 4 stage + [] source base baseScratch [] product output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_base_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base baseScratch accumulator product output : + List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 2 stage + [] source (true :: base) baseScratch + accumulator product output) = + some + (polynomialRowMarkerConfiguration polynomial 2 stage + [] source base (true :: baseScratch) + accumulator (true :: product) output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_base_finish + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source baseScratch accumulator product output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 2 stage + [] source [] baseScratch accumulator product output) = + some + (polynomialRowMarkerConfiguration polynomial 3 stage + [] source [] baseScratch accumulator product output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_restoreBase_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base baseScratch accumulator product output : + List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 3 stage + [] source base (true :: baseScratch) + accumulator product output) = + some + (polynomialRowMarkerConfiguration polynomial 3 stage + [] source (true :: base) baseScratch + accumulator product output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_restoreBase_finish + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base accumulator product output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 3 stage + [] source base [] accumulator product output) = + some + (polynomialRowMarkerConfiguration polynomial 1 stage + [] source base [] accumulator product output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_product_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base accumulator product output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 4 stage + [] source base [] accumulator (true :: product) output) = + some + (polynomialRowMarkerConfiguration polynomial 4 stage + [] source base [] (true :: accumulator) product output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_coefficient_zero_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (hstage : stage.val = 0) + (source base accumulator output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 4 stage + [] source base [] accumulator [] output) = + some + (polynomialRowMarkerConfiguration polynomial 5 stage + [] source base [] + (List.replicate (polynomial.coeff stage.val) true ++ + accumulator) + [] output) := by + have hstage' : stage = (0 : PolynomialRowMarkerStage polynomial) := + Fin.ext hstage + polynomialRowMarkerStepTac; + simp only [Fin.isValue, hstage', ↓reduceDIte, Fin.coe_ofNat_eq_mod, Nat.zero_mod, + polynomialRowMarkerPushBits_stepAux, TM2.stepAux, List.reverse_replicate, Matrix.cons_val]; + try { congr 2; funext stack; fin_cases stack <;> + simp [Function.update] } + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_coefficient_succ_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (hstage : stage.val ≠ 0) + (source base accumulator output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 4 stage + [] source base [] accumulator [] output) = + some + (polynomialRowMarkerConfiguration polynomial 1 + (polynomialRowMarkerPredStage polynomial stage hstage) + [] source base [] + (List.replicate (polynomial.coeff stage.val) true ++ + accumulator) + [] output) := by + have hstage' : stage ≠ (0 : PolynomialRowMarkerStage polynomial) := by + intro heq + apply hstage + simpa only [Fin.val_eq_zero_iff, Fin.coe_ofNat_eq_mod, Nat.zero_mod] using congrArg Fin.val heq + polynomialRowMarkerStepTac; + simp only [Fin.isValue, hstage', ↓reduceDIte, polynomialRowMarkerPushBits_stepAux, TM2.stepAux, + List.reverse_replicate, Matrix.cons_val]; + try { congr 2; funext stack; fin_cases stack <;> + simp [Function.update] } + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_payload_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base accumulator product output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 5 stage + [] source base [] (true :: accumulator) + product output) = + some + (polynomialRowMarkerConfiguration polynomial 5 stage + [] source base [] accumulator + (true :: product) (true :: output)) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_payload_finish + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base product output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 5 stage + [] source base [] [] product output) = + some + (polynomialRowMarkerConfiguration polynomial 6 stage + [] source base [] [] product (false :: output)) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_header_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base product output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 6 stage + [] source base [] [] (true :: product) output) = + some + (polynomialRowMarkerConfiguration polynomial 6 stage + [] source base [] [] product (true :: output)) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_header_finish + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 6 stage + [] source base [] [] [] output) = + some + (polynomialRowMarkerConfiguration polynomial 7 stage + [] source base [] [] [] output) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_source_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (bit : Bool) + (source base output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 7 stage + [] (bit :: source) base [] [] [] output) = + some + (polynomialRowMarkerConfiguration polynomial 7 stage + [] source base [] [] [] (bit :: output)) := by + cases bit <;> polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_source_finish + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (base output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 7 stage + [] [] base [] [] [] output) = + some + (polynomialRowMarkerConfiguration polynomial 8 stage + [] [] base [] [] [] (false :: output)) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_prefix_step + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (base output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 8 stage + [] [] (true :: base) [] [] [] output) = + some + (polynomialRowMarkerConfiguration polynomial 8 stage + [] [] base [] [] [] (true :: output)) := by + polynomialRowMarkerStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem polynomialRowMarker_finish + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (output : List Bool) : + (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 8 stage + [] [] [] [] [] [] output) = + some + (Turing.haltList + (polynomialRowMarkerMachine polynomial) output) := by + polynomialRowMarkerStepTac + +end CNFPolynomialRowMarkerTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part04C.lean b/LeanPool/GapCVP/Part04C.lean new file mode 100644 index 000000000..3af9aa835 --- /dev/null +++ b/LeanPool/GapCVP/Part04C.lean @@ -0,0 +1,1144 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part04B + +/-! # GapCVP proof, part 04, continuation 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFPolynomialRowMarkerTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder + +end CNFPolynomialRowMarkerTM + +namespace CLStructuralCNFOutputMachinesUnconditional + +open Computability Turing GapCVP.BinaryEncoding GapCVP.CNFSortingDedup +open GapCVP.CNFPolynomialRowMarkerTM + +private def polynomialRowMarker_scanTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (input source base baseScratch accumulator product output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 0 stage + input source base baseScratch accumulator product output) + (some (polynomialRowMarkerConfiguration polynomial 1 stage + [] (input.reverse ++ source) + (List.replicate input.length true ++ base) + baseScratch accumulator product output)) + (input.length + 1) := by + induction input generalizing source base with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + List.replicate_zero, + zero_add] using + oneStep _ _ (polynomialRowMarker_scan_finish polynomial stage source base baseScratch + accumulator product output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (polynomialRowMarker_scan_step polynomial stage bit remaining + source base baseScratch accumulator product output) + have hrest := ih (source := bit :: source) (base := true :: base) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def polynomialRowMarker_baseTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (baseCount : ℕ) + (source baseScratch accumulator product output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 2 stage + [] source (List.replicate baseCount true) baseScratch + accumulator product output) + (some (polynomialRowMarkerConfiguration polynomial 3 stage + [] source [] (List.replicate baseCount true ++ baseScratch) + accumulator (List.replicate baseCount true ++ product) output)) + (baseCount + 1) := by + induction baseCount generalizing baseScratch product with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (polynomialRowMarker_base_finish polynomial stage source baseScratch + accumulator product output) + | succ count ih => + have hfirst := oneStep _ _ (polynomialRowMarker_base_step polynomial stage source + (List.replicate count true) baseScratch accumulator product output) + have hrest := ih (baseScratch := true :: baseScratch) + (product := true :: product) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def polynomialRowMarker_restoreBaseTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (scratchCount : ℕ) + (source base accumulator product output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 3 stage + [] source base (List.replicate scratchCount true) + accumulator product output) + (some (polynomialRowMarkerConfiguration polynomial 1 stage + [] source (List.replicate scratchCount true ++ base) [] + accumulator product output)) + (scratchCount + 1) := by + induction scratchCount generalizing base with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (polynomialRowMarker_restoreBase_finish polynomial stage source base + accumulator product output) + | succ count ih => + have hfirst := oneStep _ _ (polynomialRowMarker_restoreBase_step polynomial stage source + base (List.replicate count true) accumulator product output) + have hrest := ih (base := true :: base) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def polynomialRowMarker_multiplyTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (baseCount accumulatorCount productCount : ℕ) + (source output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 1 stage + [] source (List.replicate baseCount true) [] + (List.replicate accumulatorCount true) + (List.replicate productCount true) output) + (some (polynomialRowMarkerConfiguration polynomial 4 stage + [] source (List.replicate baseCount true) [] [] + (List.replicate + (baseCount * accumulatorCount + productCount) true) + output)) + (accumulatorCount * (2 * baseCount + 3) + 1) := by + induction accumulatorCount generalizing productCount with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, mul_zero, zero_add, zero_mul] + using + oneStep _ _ + (polynomialRowMarker_multiply_finish polynomial stage source (List.replicate baseCount + true) [] + (List.replicate productCount true) output) + | succ count ih => + have hfirst := oneStep _ _ (polynomialRowMarker_multiply_step polynomial stage source + (List.replicate baseCount true) [] + (List.replicate count true) + (List.replicate productCount true) output) + have hbase := polynomialRowMarker_baseTrace polynomial stage + baseCount source [] (List.replicate count true) + (List.replicate productCount true) output + have hrestore := polynomialRowMarker_restoreBaseTrace + polynomial stage baseCount source [] + (List.replicate count true) + (List.replicate baseCount true ++ + List.replicate productCount true) output + simp only [List.append_nil] at hbase hrestore + have hprefix := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hbase + have hcycle := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hprefix hrestore + have hremaining := ih (productCount := baseCount + productCount) + have hproduct : + List.replicate (baseCount + productCount) true = + List.replicate baseCount true ++ + List.replicate productCount true := + List.replicate_add baseCount productCount true + have hremaining' : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 1 stage + [] source (List.replicate baseCount true) [] + (List.replicate count true) + (List.replicate baseCount true ++ + List.replicate productCount true) output) + (some (polynomialRowMarkerConfiguration polynomial 4 stage + [] source (List.replicate baseCount true) [] [] + (List.replicate + (baseCount * count + (baseCount + productCount)) true) + output)) + (count * (2 * baseCount + 3) + 1) := by + simpa only [hproduct] using hremaining + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hcycle hremaining' + have hproductCount : + baseCount * count + (baseCount + productCount) = + baseCount * (count + 1) + productCount := by + ring + have hbudget : + (count * (2 * baseCount + 3) + 1) + + ((baseCount + 1) + ((baseCount + 1) + 1)) = + (count + 1) * (2 * baseCount + 3) + 1 := by + ring + rw [hproductCount, hbudget] at hfull + simpa only [List.replicate_succ, Nat.succ_eq_add_one] using hfull + +private def polynomialRowMarker_productTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (productCount : ℕ) + (source base accumulator output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 4 stage + [] source base [] accumulator + (List.replicate productCount true) output) + (some (polynomialRowMarkerConfiguration polynomial 4 stage + [] source base [] + (List.replicate productCount true ++ accumulator) + [] output)) + productCount := by + induction productCount generalizing accumulator with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append] using + EvalsToInTime.refl (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 4 stage [] source base [] accumulator [] + output) + | succ count ih => + have hfirst := oneStep _ _ (polynomialRowMarker_product_step polynomial stage source base + accumulator (List.replicate count true) output) + have hrest := ih (accumulator := true :: accumulator) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, + replicate_append_bit_cons] using + hfull + +private def polynomialRowMarkerHornerCostPolynomial + (polynomial : Polynomial ℕ) : ℕ → Polynomial ℕ → Polynomial ℕ + | 0, _ => 0 + | remaining + 1, accumulator => + accumulator * (2 * Polynomial.X + 3) + 1 + + Polynomial.X * accumulator + 1 + + polynomialRowMarkerHornerCostPolynomial polynomial remaining + (Polynomial.X * accumulator + + Polynomial.C (polynomial.coeff remaining)) + +private def polynomialRowMarker_hornerTrace + (polynomial : Polynomial ℕ) + (baseCount stages : ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (hstage : stage.val + 1 = stages) + (accumulatorPolynomial : Polynomial ℕ) + (source output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 1 stage + [] source (List.replicate baseCount true) [] + (List.replicate (accumulatorPolynomial.eval baseCount) true) + [] output) + (some (polynomialRowMarkerConfiguration polynomial 5 0 + [] source (List.replicate baseCount true) [] + (List.replicate + (polynomialRowMarkerHorner polynomial baseCount stages + (accumulatorPolynomial.eval baseCount)) true) + [] output)) + ((polynomialRowMarkerHornerCostPolynomial + polynomial stages accumulatorPolynomial).eval baseCount) := by + induction stages generalizing stage accumulatorPolynomial with + | zero => + omega + | succ remaining ih => + have hindex : stage.val = remaining := by omega + let accumulator := accumulatorPolynomial.eval baseCount + have hmul := polynomialRowMarker_multiplyTrace + polynomial stage baseCount accumulator 0 source output + have hproduct := polynomialRowMarker_productTrace + polynomial stage (baseCount * accumulator) source + (List.replicate baseCount true) [] output + simp only [Nat.add_zero, List.replicate_zero, + List.append_nil] at hmul hproduct + have hfirst := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hmul hproduct + by_cases hremaining : remaining = 0 + · have hzero : stage.val = 0 := by omega + have hstageZero : + stage = (0 : PolynomialRowMarkerStage polynomial) := + Fin.ext hzero + have hcoefficient := oneStep _ _ (polynomialRowMarker_coefficient_zero_step polynomial + stage + hzero source (List.replicate baseCount true) + (List.replicate (baseCount * accumulator) true) output) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hcoefficient + have hvalue : + polynomial.coeff stage.val + baseCount * accumulator = + polynomialRowMarkerHorner polynomial baseCount + (remaining + 1) accumulator := by + simp only [hindex, hremaining, polynomialRowMarkerHorner] + ring + have hmarkers : + List.replicate (polynomial.coeff stage.val) true ++ + List.replicate (baseCount * accumulator) true = + List.replicate + (polynomialRowMarkerHorner polynomial baseCount + (remaining + 1) accumulator) true := by + rw [← List.replicate_add, hvalue] + have hbudget : + 1 + (baseCount * accumulator + + (accumulator * (2 * baseCount + 3) + 1)) = + (polynomialRowMarkerHornerCostPolynomial polynomial + (remaining + 1) accumulatorPolynomial).eval baseCount := by + simp only [polynomialRowMarkerHornerCostPolynomial, hremaining, eq_natCast, add_zero, + Polynomial.eval_add, + Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, Polynomial.eval_one, + accumulator] + ring + rw [hmarkers, hbudget] at hfull + simpa only [hstageZero, Nat.succ_eq_add_one] using hfull + · have hnot : stage.val ≠ 0 := by omega + let nextAccumulator : Polynomial ℕ := + Polynomial.X * accumulatorPolynomial + + Polynomial.C (polynomial.coeff remaining) + have hnext : + nextAccumulator.eval baseCount = + polynomial.coeff stage.val + baseCount * accumulator := by + simp only [eq_natCast, Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_X, + Polynomial.eval_natCast, + Nat.cast_id, hindex, nextAccumulator, accumulator] + ring + have hmarkers : + List.replicate (polynomial.coeff stage.val) true ++ + List.replicate (baseCount * accumulator) true = + List.replicate + (nextAccumulator.eval baseCount) true := by + rw [← List.replicate_add, ← hnext] + have hcoefficient := oneStep _ _ (polynomialRowMarker_coefficient_succ_step polynomial + stage + hnot source (List.replicate baseCount true) + (List.replicate (baseCount * accumulator) true) output) + rw [hmarkers] at hcoefficient + have hprefix := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hcoefficient + have hpred : + (polynomialRowMarkerPredStage polynomial stage hnot).val + 1 = + remaining := by + simp only [polynomialRowMarkerPredStage] + omega + have hrest := ih + (stage := polynomialRowMarkerPredStage polynomial stage hnot) + hpred (accumulatorPolynomial := nextAccumulator) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hprefix hrest + have hvalue : + polynomialRowMarkerHorner polynomial baseCount remaining + (nextAccumulator.eval baseCount) = + polynomialRowMarkerHorner polynomial baseCount + (remaining + 1) accumulator := by + rw [polynomialRowMarkerHorner, hnext, hindex] + congr 1 + ring + have hbudget : + (polynomialRowMarkerHornerCostPolynomial polynomial + remaining nextAccumulator).eval baseCount + + (1 + (baseCount * accumulator + + (accumulator * (2 * baseCount + 3) + 1))) = + (polynomialRowMarkerHornerCostPolynomial polynomial + (remaining + 1) accumulatorPolynomial).eval baseCount := by + simp only [eq_natCast, polynomialRowMarkerHornerCostPolynomial, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, Polynomial.eval_one, nextAccumulator, + accumulator] + ring + rw [hvalue, hbudget] at hfull + simpa only [Nat.succ_eq_add_one] using hfull + +private def polynomialRowMarker_payloadTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (markerCount : ℕ) + (source base product output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 5 stage + [] source base [] (List.replicate markerCount true) + product output) + (some (polynomialRowMarkerConfiguration polynomial 6 stage + [] source base [] [] + (List.replicate markerCount true ++ product) + (false :: (List.replicate markerCount true ++ output)))) + (markerCount + 1) := by + induction markerCount generalizing product output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (polynomialRowMarker_payload_finish polynomial stage source base product + output) + | succ count ih => + have hfirst := oneStep _ _ (polynomialRowMarker_payload_step polynomial stage source base + (List.replicate count true) product output) + have hrest := ih (product := true :: product) + (output := true :: output) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def polynomialRowMarker_headerTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (markerCount : ℕ) + (source base output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 6 stage + [] source base [] [] (List.replicate markerCount true) output) + (some (polynomialRowMarkerConfiguration polynomial 7 stage + [] source base [] [] [] + (List.replicate markerCount true ++ output))) + (markerCount + 1) := by + induction markerCount generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (polynomialRowMarker_header_finish polynomial stage source base output) + | succ count ih => + have hfirst := oneStep _ _ (polynomialRowMarker_header_step polynomial stage source base + (List.replicate count true) output) + have hrest := ih (output := true :: output) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def polynomialRowMarker_sourceTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (source base output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 7 stage + [] source base [] [] [] output) + (some (polynomialRowMarkerConfiguration polynomial 8 stage + [] [] base [] [] [] + (false :: (source.reverse ++ output)))) + (source.length + 1) := by + induction source generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (polynomialRowMarker_source_finish polynomial stage base output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (polynomialRowMarker_source_step polynomial stage bit + remaining base output) + have hrest := ih (output := bit :: output) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def polynomialRowMarker_prefixTrace + (polynomial : Polynomial ℕ) + (stage : PolynomialRowMarkerStage polynomial) + (baseCount : ℕ) + (output : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 8 stage + [] [] (List.replicate baseCount true) [] [] [] output) + (some (Turing.haltList (polynomialRowMarkerMachine polynomial) + (List.replicate baseCount true ++ output))) + (baseCount + 1) := by + induction baseCount generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (polynomialRowMarker_finish polynomial stage output) + | succ count ih => + have hfirst := oneStep _ _ (polynomialRowMarker_prefix_step polynomial stage + (List.replicate count true) output) + have hrest := ih (output := true :: output) + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + replicate_append_bit_cons] using hfull + +private def polynomialRowMarkerTotalTimePolynomial + (polynomial : Polynomial ℕ) : Polynomial ℕ := + polynomialRowMarkerHornerCostPolynomial + polynomial (polynomial.natDegree + 1) 0 + + 3 * Polynomial.X + 2 * polynomial + 5 + +private def polynomialRowMarker_totalTrace + (polynomial : Polynomial ℕ) + (input : List Bool) : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 0 + (polynomialRowMarkerTopStage polynomial) + input [] [] [] [] [] []) + (some (Turing.haltList + (polynomialRowMarkerMachine polynomial) + (sourcePreservingPolynomialMarkerWord polynomial input))) + ((polynomialRowMarkerTotalTimePolynomial polynomial).eval + input.length) := by + let sourcePrefix := List.replicate input.length true + let markerCount := polynomial.eval input.length + let markerPayload := List.replicate markerCount true + let markerField := lengthPrefixedWord markerPayload + have htop : + (polynomialRowMarkerTopStage polynomial).val + 1 = + polynomial.natDegree + 1 := by + rfl + have hscan : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 0 + (polynomialRowMarkerTopStage polynomial) + input [] [] [] [] [] []) + (some (polynomialRowMarkerConfiguration polynomial 1 + (polynomialRowMarkerTopStage polynomial) + [] input.reverse sourcePrefix [] [] [] [])) + (input.length + 1) := by + simpa [sourcePrefix] using polynomialRowMarker_scanTrace + polynomial (polynomialRowMarkerTopStage polynomial) + input [] [] [] [] [] [] + have hhorner : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 1 + (polynomialRowMarkerTopStage polynomial) + [] input.reverse sourcePrefix [] [] [] []) + (some (polynomialRowMarkerConfiguration polynomial 5 0 + [] input.reverse sourcePrefix [] markerPayload [] [])) + ((polynomialRowMarkerHornerCostPolynomial polynomial + (polynomial.natDegree + 1) 0).eval input.length) := by + have h := polynomialRowMarker_hornerTrace polynomial + input.length (polynomial.natDegree + 1) + (polynomialRowMarkerTopStage polynomial) htop 0 + input.reverse [] + simpa [sourcePrefix, markerPayload, markerCount, + polynomialRowMarkerHorner_eval] using h + have hpayload : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 5 0 + [] input.reverse sourcePrefix [] markerPayload [] []) + (some (polynomialRowMarkerConfiguration polynomial 6 0 + [] input.reverse sourcePrefix [] [] markerPayload + (false :: markerPayload))) + (markerCount + 1) := by + simpa [markerPayload] using polynomialRowMarker_payloadTrace + polynomial 0 markerCount input.reverse sourcePrefix [] [] + have hheader : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 6 0 + [] input.reverse sourcePrefix [] [] markerPayload + (false :: markerPayload)) + (some (polynomialRowMarkerConfiguration polynomial 7 0 + [] input.reverse sourcePrefix [] [] [] markerField)) + (markerCount + 1) := by + simpa [markerField, markerPayload, lengthPrefixedWord] using + polynomialRowMarker_headerTrace polynomial 0 markerCount + input.reverse sourcePrefix (false :: markerPayload) + have hsource : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 7 0 + [] input.reverse sourcePrefix [] [] [] markerField) + (some (polynomialRowMarkerConfiguration polynomial 8 0 + [] [] sourcePrefix [] [] [] + (false :: (input ++ markerField)))) + (input.length + 1) := by + simpa using polynomialRowMarker_sourceTrace + polynomial 0 input.reverse sourcePrefix markerField + have hprefix : + EvalsToInTime (polynomialRowMarkerMachine polynomial).step + (polynomialRowMarkerConfiguration polynomial 8 0 + [] [] sourcePrefix [] [] [] + (false :: (input ++ markerField))) + (some (Turing.haltList (polynomialRowMarkerMachine polynomial) + (sourcePreservingPolynomialMarkerWord polynomial input))) + (input.length + 1) := by + simpa [sourcePrefix, sourcePreservingPolynomialMarkerWord, + markerField, markerPayload, markerCount, + lengthPrefixedWord, List.append_assoc] using + polynomialRowMarker_prefixTrace polynomial 0 input.length + (false :: (input ++ markerField)) + have hfirst := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step _ _ _ _ _ + hscan hhorner + have hsecond := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step _ _ _ _ _ + hfirst hpayload + have hthird := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step _ _ _ _ _ + hsecond hheader + have hfourth := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step _ _ _ _ _ + hthird hsource + have hfull := EvalsToInTime.trans (polynomialRowMarkerMachine polynomial).step _ _ _ _ _ + hfourth hprefix + apply rebound hfull + simp [polynomialRowMarkerTotalTimePolynomial, markerCount, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + omega + +/-- GapCVP reduction support. -/ +def sourcePreservingPolynomialMarkerComputable + (polynomial : Polynomial ℕ) : + BitTM + (sourcePreservingPolynomialMarkerWord polynomial) where + tm := polynomialRowMarkerMachine polynomial + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := polynomialRowMarkerTotalTimePolynomial polynomial + outputsFun input := { + steps := (polynomialRowMarker_totalTrace polynomial input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, polynomialRowMarkerMachine_init, + Option.map_some] using + (polynomialRowMarker_totalTrace polynomial input).evals_in_steps + steps_le_m := by + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq] using + (polynomialRowMarker_totalTrace polynomial input).steps_le_m + } + +end CLStructuralCNFOutputMachinesUnconditional + +namespace CNFDependentFiveFamilyRecordTM + +open Computability Turing GapCVP.CL GapCVP.CNFClauseLoop + +@[simp] private theorem mem_executableFiveFamilyFiniteElements + (α : Type) [Fintype α] (value : α) : + value ∈ clauseLoopFiniteElements α := + mem_clauseLoopFiniteElements α value + +/-- GapCVP reduction support. -/ +def executableAtLeastOneFamilyClauses (T S : ℕ) : + List (Clause T S) := + (clauseLoopFiniteElements (Time T × Position T)).map + (fun position => atLeastOneClause (S := S) + position.1 position.2) + +/-- Internal support shared across GapCVP continuation modules. -/ +def executableAtMostOneFamilyClauses (T S : ℕ) : + List (Clause T S) := + (clauseLoopFiniteElements + ((Time T × Position T) × (Symbol S × Symbol S))).filterMap + (fun position => + if position.2.1 < position.2.2 then + some (atMostOneClause position.1.1 position.1.2 + position.2.1 position.2.2) + else + none) + +/-- GapCVP reduction support. -/ +def executableInitialFamilyClauses {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + (clauseLoopFiniteElements (Position T)).map + (initialClause specification.input) + +/-- GapCVP reduction support. -/ +def executableAcceptanceFamilyClauses {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + [acceptanceClause specification.accept] + +/-- Internal support shared across GapCVP continuation modules. -/ +def executableForbiddenTransitionFamilyClauses {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + (clauseLoopFiniteElements (Window T × WindowSymbols S)).filterMap + (fun window => + if specification.allowed window.2 = false then + some (transitionClause window.1 window.2) + else + none) + +/-- Internal support shared across GapCVP continuation modules. -/ +def executableFiveFamilySourceClauseCandidates {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + executableAtLeastOneFamilyClauses T S ++ + executableAtMostOneFamilyClauses T S ++ + executableInitialFamilyClauses specification ++ + executableAcceptanceFamilyClauses specification ++ + executableForbiddenTransitionFamilyClauses specification + +private theorem executableAtLeastOneFamilyClauses_toFinset + (T S : ℕ) : + (executableAtLeastOneFamilyClauses T S).toFinset = + Finset.univ.image + (fun position : Time T × Position T => + atLeastOneClause (S := S) position.1 position.2) := by + ext clause + simp only [executableAtLeastOneFamilyClauses, List.mem_toFinset, List.mem_map, + mem_executableFiveFamilyFiniteElements, true_and, Prod.exists, Finset.mem_image, + Finset.mem_univ] + +private theorem executableAtMostOneFamilyClauses_toFinset + (T S : ℕ) : + (executableAtMostOneFamilyClauses T S).toFinset = + (Finset.univ.filter + (fun position : + (Time T × Position T) × (Symbol S × Symbol S) => + position.2.1 < position.2.2)).image + (fun position => atMostOneClause position.1.1 + position.1.2 position.2.1 position.2.2) := by + ext clause + simp only [executableAtMostOneFamilyClauses, List.mem_toFinset, List.mem_filterMap, + mem_executableFiveFamilyFiniteElements, Option.ite_none_right_eq_some, Option.some.injEq, + true_and, Prod.exists, + Finset.mem_image, Finset.mem_filter, Finset.mem_univ] + +private theorem executableInitialFamilyClauses_toFinset + {T S : ℕ} (specification : Specification T S) : + (executableInitialFamilyClauses specification).toFinset = + initialClauses specification := by + ext clause + simp only [executableInitialFamilyClauses, List.mem_toFinset, List.mem_map, + mem_executableFiveFamilyFiniteElements, true_and, initialClauses, Finset.mem_image, + Finset.mem_univ] + +private theorem executableForbiddenTransitionFamilyClauses_toFinset + {T S : ℕ} (specification : Specification T S) : + (executableForbiddenTransitionFamilyClauses specification).toFinset = + transitionClauses specification := by + ext clause + simp only [executableForbiddenTransitionFamilyClauses, List.mem_toFinset, List.mem_filterMap, + mem_executableFiveFamilyFiniteElements, Option.ite_none_right_eq_some, Option.some.injEq, + true_and, Prod.exists, + Subtype.exists, Order.lt_add_one_iff, Order.add_one_le_iff, transitionClauses, + Finset.mem_image, Finset.mem_filter, + Finset.mem_univ] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem executableFiveFamilySourceClauseCandidates_toFinset + {T S : ℕ} (specification : Specification T S) : + (executableFiveFamilySourceClauseCandidates specification).toFinset = + tableauFormula specification := by + simp only [executableFiveFamilySourceClauseCandidates, List.append_assoc, + executableAcceptanceFamilyClauses, + List.cons_append, List.nil_append, List.toFinset_append, + executableAtLeastOneFamilyClauses_toFinset, + executableAtMostOneFamilyClauses_toFinset, executableInitialFamilyClauses_toFinset, + List.toFinset_cons, + executableForbiddenTransitionFamilyClauses_toFinset, Finset.union_insert, tableauFormula, + structuralClauses, + Finset.union_assoc, Finset.union_singleton, Finset.insert_union] + +end CNFDependentFiveFamilyRecordTM + +namespace OutputPolynomialCompositionClosure + +open Turing + +/-- GapCVP reduction support. -/ +def markerConditionalOutput + (valid : List Bool → List Bool) (fallback : List Bool) : + List Bool → List Bool + | true :: input => valid input + | _ => fallback + +/-- GapCVP reduction support. -/ +abbrev ConditionalLabel (tm : Turing.FinTM2) := tm.Λ ⊕ Bool + +/-- GapCVP reduction support. -/ +abbrev ConditionalState (tm : Turing.FinTM2) := Option Bool × tm.σ + +/-- GapCVP reduction support. -/ +def liftValidStatement (tm : Turing.FinTM2) : + Turing.TM2.Stmt tm.Γ tm.Λ tm.σ → + Turing.TM2.Stmt tm.Γ (ConditionalLabel tm) + (ConditionalState tm) + | .push k f q => + .push k (fun state => f state.2) (liftValidStatement tm q) + | .peek k f q => + .peek k (fun state symbol => (state.1, f state.2 symbol)) + (liftValidStatement tm q) + | .pop k f q => + .pop k (fun state symbol => (state.1, f state.2 symbol)) + (liftValidStatement tm q) + | .load f q => + .load (fun state => (state.1, f state.2)) + (liftValidStatement tm q) + | .branch test yes no => + .branch (fun state => test state.2) + (liftValidStatement tm yes) (liftValidStatement tm no) + | .goto next => .goto (fun state => .inl (next state.2)) + | .halt => .load (fun state => (none, state.2)) .halt + +private def fixedOutputStatement + {valid : List Bool → List Bool} + (computer : BitTM valid) : + List Bool → + Turing.TM2.Stmt computer.tm.Γ (ConditionalLabel computer.tm) + (ConditionalState computer.tm) + | [] => .halt + | bit :: remaining => + .push computer.tm.k₁ + (fun _ => computer.outputAlphabet.invFun bit) + (fixedOutputStatement computer remaining) + +/-- GapCVP reduction support. -/ +noncomputable abbrev markerConditionalMachine + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) : Turing.FinTM2 := by + classical + letI : DecidableEq computer.tm.K := computer.tm.kDecidableEq + letI : Fintype computer.tm.K := computer.tm.kFin + letI : Fintype computer.tm.Λ := computer.tm.ΛFin + letI : Fintype computer.tm.σ := computer.tm.σFin + letI : Fintype (computer.tm.Γ computer.tm.k₀) := + computer.tm.Γk₀Fin + exact { + K := computer.tm.K + kDecidableEq := computer.tm.kDecidableEq + k₀ := computer.tm.k₀ + k₁ := computer.tm.k₁ + Γ := computer.tm.Γ + Λ := ConditionalLabel computer.tm + main := .inr false + σ := ConditionalState computer.tm + initialState := (none, computer.tm.initialState) + m := fun + | .inl label => liftValidStatement computer.tm (computer.tm.m label) + | .inr false => + .pop computer.tm.k₀ + (fun state symbol => + (symbol.map computer.inputAlphabet, state.2)) + (.branch (fun state => state.1.getD false) + (.goto (fun _ => .inl computer.tm.main)) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr true)))) + | .inr true => + .peek computer.tm.k₀ + (fun state symbol => + (symbol.map computer.inputAlphabet, state.2)) + (.branch (fun state => state.1.isSome) + (.pop computer.tm.k₀ + (fun state _ => (none, state.2)) + (.goto (fun _ => .inr true))) + (fixedOutputStatement computer fallback.reverse)) + } + +/-- GapCVP reduction support. -/ +noncomputable def validConfiguration + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (configuration : computer.tm.Cfg) : + (markerConditionalMachine computer fallback).Cfg where + l := configuration.l.map Sum.inl + var := + (if configuration.l.isSome then some true else none, + configuration.var) + stk := configuration.stk + +theorem liftValidStatement_stepAux + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (statement : Turing.TM2.Stmt + computer.tm.Γ computer.tm.Λ computer.tm.σ) + (state : computer.tm.σ) + (sourceStacks : ∀ k, List (computer.tm.Γ k)) : + Turing.TM2.stepAux (liftValidStatement computer.tm statement) + (some true, state) sourceStacks = + validConfiguration computer fallback + (Turing.TM2.stepAux statement state sourceStacks) := by + classical + induction statement generalizing state sourceStacks with + | push k f q ih => + exact ih (state := state) + (sourceStacks := Function.update sourceStacks k + (f state :: sourceStacks k)) + | peek k f q ih => + exact ih (state := f state (sourceStacks k).head?) + (sourceStacks := sourceStacks) + | pop k f q ih => + exact ih (state := f state (sourceStacks k).head?) + (sourceStacks := Function.update sourceStacks k + (sourceStacks k).tail) + | load f q ih => + exact ih (state := f state) (sourceStacks := sourceStacks) + | branch test yes no ihYes ihNo => + cases htest : test state with + | false => + simpa only [liftValidStatement, TM2.stepAux, htest, Bool.cond_false] using + ihNo (state := state) (sourceStacks := sourceStacks) + | true => + simpa only [liftValidStatement, TM2.stepAux, htest, Bool.cond_true] using + ihYes (state := state) (sourceStacks := sourceStacks) + | goto next => rfl + | halt => rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem validConfiguration_step + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (configuration next : computer.tm.Cfg) + (hstep : computer.tm.step configuration = some next) : + (markerConditionalMachine computer fallback).step + (validConfiguration computer fallback configuration) = + some (validConfiguration computer fallback next) := by + rcases configuration with ⟨label, state, sourceStacks⟩ + cases label with + | none => + simp only [FinTM2.step, TM2.step, reduceCtorEq] at hstep + | some label => + change some (Turing.TM2.stepAux (computer.tm.m label) + state sourceStacks) = some next at hstep + have hnext := Option.some.inj hstep + subst next + change some (Turing.TM2.stepAux + (liftValidStatement computer.tm (computer.tm.m label)) + (some true, state) sourceStacks) = + some (validConfiguration computer fallback + (Turing.TM2.stepAux (computer.tm.m label) + state sourceStacks)) + rw [liftValidStatement_stepAux computer fallback] + rfl + +@[simp] theorem initialStack_input + (tm : Turing.FinTM2) + (input : List (tm.Γ tm.k₀)) : + (Turing.initList tm input).stk tm.k₀ = input := by + classical + simp only [initList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq] + +private theorem initialStack_of_ne + (tm : Turing.FinTM2) + (input : List (tm.Γ tm.k₀)) + (k : tm.K) (hk : k ≠ tm.k₀) : + (Turing.initList tm input).stk k = [] := by + classical + simp only [initList, eq_mpr_eq_cast, hk, ↓reduceDIte] + +@[simp] theorem initialStack_empty + (tm : Turing.FinTM2) (k : tm.K) : + (Turing.initList tm []).stk k = [] := by + classical + unfold Turing.initList + dsimp + split + next h => + subst k + rfl + next h => rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fallbackConfiguration + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (remaining : List (computer.tm.Γ computer.tm.k₀)) : + (markerConditionalMachine computer fallback).Cfg where + l := some (.inr true) + var := (none, computer.tm.initialState) + stk := (Turing.initList computer.tm remaining).stk + +private theorem fixedOutputStatement_stepAux + {valid : List Bool → List Bool} + (computer : BitTM valid) + (bits : List Bool) + (marker : Option Bool) + (state : computer.tm.σ) + (sourceStacks : ∀ k, List (computer.tm.Γ k)) : + @Turing.TM2.stepAux computer.tm.K computer.tm.Γ + (ConditionalLabel computer.tm) (ConditionalState computer.tm) + computer.tm.kDecidableEq + (fixedOutputStatement computer bits) + (marker, state) sourceStacks = + ⟨none, (marker, state), + Function.update sourceStacks computer.tm.k₁ + (List.map computer.outputAlphabet.invFun bits.reverse ++ + sourceStacks computer.tm.k₁)⟩ := by + classical + let : DecidableEq computer.tm.K := computer.tm.kDecidableEq + induction bits generalizing sourceStacks with + | nil => + simp only [fixedOutputStatement, TM2.stepAux, Equiv.invFun_as_coe, List.reverse_nil, + List.map_nil, + List.nil_append, Function.update_eq_self] + | cons bit remaining ih => + change Turing.TM2.stepAux + (fixedOutputStatement computer remaining) (marker, state) + (Function.update sourceStacks computer.tm.k₁ + (computer.outputAlphabet.invFun bit :: + sourceStacks computer.tm.k₁)) = _ + rw [ih] + congr 1 + funext k + by_cases hk : k = computer.tm.k₁ + · subst k + simp only [Equiv.invFun_as_coe, List.map_reverse, Function.update_self, List.reverse_cons, + List.map_append, + List.map_cons, List.map_nil, List.append_assoc, List.cons_append, List.nil_append] + · simp only [Function.update, hk, ↓reduceDIte] + +private theorem fallbackConfiguration_step + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (symbol : computer.tm.Γ computer.tm.k₀) + (remaining : List (computer.tm.Γ computer.tm.k₀)) : + (markerConditionalMachine computer fallback).step + (fallbackConfiguration computer fallback + (symbol :: remaining)) = + some (fallbackConfiguration computer fallback remaining) := by + classical + let : DecidableEq computer.tm.K := computer.tm.kDecidableEq + simp only [markerConditionalMachine, FinTM2.step, TM2.step, fallbackConfiguration, TM2.stepAux, + initialStack_input, List.head?_cons, Option.map_some, Option.isSome_some, List.tail_cons, + Bool.cond_true] + congr 2 + funext k + by_cases hk : k = computer.tm.k₀ + · subst k + rw [Function.update_self] + exact (initialStack_input computer.tm remaining).symm + · simp only [Function.update, hk, ↓reduceDIte, ne_eq, not_false_eq_true, initialStack_of_ne] + +private theorem fallbackConfiguration_finish + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) : + (markerConditionalMachine computer fallback).step + (fallbackConfiguration computer fallback []) = + some (Turing.haltList + (markerConditionalMachine computer fallback) + (List.map computer.outputAlphabet.invFun fallback)) := by + classical + let : DecidableEq computer.tm.K := computer.tm.kDecidableEq + simp only [markerConditionalMachine, fallbackConfiguration, + Turing.FinTM2.step, Turing.TM2.step, Turing.TM2.stepAux, + initialStack_input, List.head?_nil, Option.map_none, + Option.isSome_none, Bool.cond_false] + change some + (@Turing.TM2.stepAux computer.tm.K computer.tm.Γ + (ConditionalLabel computer.tm) (ConditionalState computer.tm) + computer.tm.kDecidableEq + (fixedOutputStatement computer fallback.reverse) + (none, computer.tm.initialState) + (Turing.initList computer.tm []).stk) = _ + rw [fixedOutputStatement_stepAux computer] + simp only [List.reverse_reverse] + congr 2 + funext k + by_cases hk : k = computer.tm.k₁ + · subst k + simp only [Equiv.invFun_as_coe, initialStack_empty, List.append_nil, Function.update_self, + ↓reduceDIte, + eq_mpr_eq_cast, cast_eq] + · simp only [Function.update, hk, ↓reduceDIte, initialStack_empty] + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fallbackTrace + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (remaining : List (computer.tm.Γ computer.tm.k₀)) : + EvalsToInTime (markerConditionalMachine computer fallback).step + (fallbackConfiguration computer fallback remaining) + (some (Turing.haltList + (markerConditionalMachine computer fallback) + (List.map computer.outputAlphabet.invFun fallback))) + (remaining.length + 1) := by + induction remaining with + | nil => + exact oneStep _ _ (fallbackConfiguration_finish computer fallback) + | cons symbol remaining ih => + have hfirst := oneStep _ _ (fallbackConfiguration_step computer fallback + symbol remaining) + have hfull := EvalsToInTime.trans (markerConditionalMachine computer fallback).step + 1 (remaining.length + 1) _ _ _ hfirst ih + simpa only [FinTM2.step, Equiv.invFun_as_coe, List.length_cons, Nat.add_comm] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem markerConditional_start_true + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (remaining : List (computer.tm.Γ computer.tm.k₀)) : + (markerConditionalMachine computer fallback).step + (Turing.initList (markerConditionalMachine computer fallback) + (computer.inputAlphabet.invFun true :: remaining)) = + some (validConfiguration computer fallback + (Turing.initList computer.tm remaining)) := by + classical + let : DecidableEq computer.tm.K := computer.tm.kDecidableEq + simp only [markerConditionalMachine, FinTM2.step, TM2.step, initList, + Equiv.invFun_as_coe, eq_mpr_eq_cast, + TM2.stepAux, ↓reduceDIte, cast_eq, List.head?_cons, Option.map_some, Equiv.apply_symm_apply, + Option.getD_some, + List.tail_cons, Bool.cond_true, validConfiguration, Option.isSome_some, ↓reduceIte] + congr 2 + funext k + by_cases hk : k = computer.tm.k₀ + · subst k + simp only [Function.update_self, ↓reduceDIte, cast_eq] + · simp only [Function.update, hk, ↓reduceDIte] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem markerConditional_start_false + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (remaining : List (computer.tm.Γ computer.tm.k₀)) : + (markerConditionalMachine computer fallback).step + (Turing.initList (markerConditionalMachine computer fallback) + (computer.inputAlphabet.invFun false :: remaining)) = + some (fallbackConfiguration computer fallback remaining) := by + classical + let : DecidableEq computer.tm.K := computer.tm.kDecidableEq + simp only [markerConditionalMachine, FinTM2.step, TM2.step, initList, + Equiv.invFun_as_coe, eq_mpr_eq_cast, + TM2.stepAux, ↓reduceDIte, cast_eq, List.head?_cons, Option.map_some, Equiv.apply_symm_apply, + Option.getD_some, + List.tail_cons, Bool.cond_false, fallbackConfiguration] + congr 2 + funext k + by_cases hk : k = computer.tm.k₀ + · subst k + simp only [Function.update_self, ↓reduceDIte, cast_eq] + · simp only [Function.update, hk, ↓reduceDIte] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem markerConditional_start_missing + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) : + (markerConditionalMachine computer fallback).step + (Turing.initList (markerConditionalMachine computer fallback) []) = + some (fallbackConfiguration computer fallback []) := by + classical + let : DecidableEq computer.tm.K := computer.tm.kDecidableEq + simp only [markerConditionalMachine, FinTM2.step, TM2.step, initList, + eq_mpr_eq_cast, TM2.stepAux, + ↓reduceDIte, cast_eq, List.head?_nil, Option.map_none, Option.getD_none, List.tail_nil, + Bool.cond_false, + fallbackConfiguration] + congr 2 + funext k + by_cases hk : k = computer.tm.k₀ + · subst k + simp only [Function.update, ↓reduceDIte, cast_eq] + · simp only [Function.update, hk, ↓reduceDIte] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem validConfiguration_halt + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) + (output : List (computer.tm.Γ computer.tm.k₁)) : + validConfiguration computer fallback + (Turing.haltList computer.tm output) = + Turing.haltList (markerConditionalMachine computer fallback) + output := by + rfl + +end OutputPolynomialCompositionClosure + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part04D.lean b/LeanPool/GapCVP/Part04D.lean new file mode 100644 index 000000000..80c0a5a87 --- /dev/null +++ b/LeanPool/GapCVP/Part04D.lean @@ -0,0 +1,1255 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part04C + +/-! # GapCVP proof, part 04, continuation 04 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace OutputPolynomialCompositionClosure + +open Turing + +private noncomputable def markerConditional_trueTrace + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback input : List Bool) : + EvalsToInTime (markerConditionalMachine computer fallback).step + (Turing.initList (markerConditionalMachine computer fallback) + (computer.inputAlphabet.invFun true :: + List.map computer.inputAlphabet.invFun input)) + (some (Turing.haltList + (markerConditionalMachine computer fallback) + (List.map computer.outputAlphabet.invFun (valid input)))) + (computer.time.eval input.length + 1) := by + have hstart := oneStep _ _ (markerConditional_start_true computer fallback + (List.map computer.inputAlphabet.invFun input)) + have hvalid : + EvalsToInTime (markerConditionalMachine computer fallback).step + (validConfiguration computer fallback + (Turing.initList computer.tm + (List.map computer.inputAlphabet.invFun input))) + (some (validConfiguration computer fallback + (Turing.haltList computer.tm + (List.map computer.outputAlphabet.invFun (valid input))))) + (computer.time.eval input.length) := by + simpa only [FinTM2.step, bitEncoding, Equiv.invFun_as_coe, id_eq] using + (GapCVP.TMComposition.evalsToInTimeMapOfStep computer.tm.step (markerConditionalMachine + computer fallback).step + (validConfiguration computer fallback) (validConfiguration_step computer fallback) + (computer.outputsFun input)) + rw [validConfiguration_halt computer fallback] at hvalid + have hfull := EvalsToInTime.trans (markerConditionalMachine computer fallback).step + 1 (computer.time.eval input.length) + _ _ _ hstart hvalid + refine { + steps := hfull.steps + evals_in_steps := ?_ + steps_le_m := ?_ + } + · exact hfull.evals_in_steps + · have hbudget := hfull.steps_le_m + omega + +private noncomputable def markerConditional_falseTrace + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback input : List Bool) : + EvalsToInTime (markerConditionalMachine computer fallback).step + (Turing.initList (markerConditionalMachine computer fallback) + (computer.inputAlphabet.invFun false :: + List.map computer.inputAlphabet.invFun input)) + (some (Turing.haltList + (markerConditionalMachine computer fallback) + (List.map computer.outputAlphabet.invFun fallback))) + (input.length + 2) := by + have hstart := oneStep _ _ (markerConditional_start_false computer fallback + (List.map computer.inputAlphabet.invFun input)) + have hrest := fallbackTrace computer fallback + (List.map computer.inputAlphabet.invFun input) + have hfull := EvalsToInTime.trans (markerConditionalMachine computer fallback).step + 1 ((List.map computer.inputAlphabet.invFun input).length + 1) + _ _ _ hstart hrest + refine { + steps := hfull.steps + evals_in_steps := ?_ + steps_le_m := ?_ + } + · exact hfull.evals_in_steps + · have hbudget := hfull.steps_le_m + simp only [List.length_map] at hbudget + omega + +private noncomputable def markerConditional_missingTrace + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) : + EvalsToInTime (markerConditionalMachine computer fallback).step + (Turing.initList (markerConditionalMachine computer fallback) []) + (some (Turing.haltList + (markerConditionalMachine computer fallback) + (List.map computer.outputAlphabet.invFun fallback))) 2 := by + have hstart := oneStep _ _ (markerConditional_start_missing computer fallback) + have hrest := fallbackTrace computer fallback [] + exact EvalsToInTime.trans (markerConditionalMachine computer fallback).step + 1 1 _ _ _ hstart hrest + +private noncomputable def markerConditional_totalTrace + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback input : List Bool) : + EvalsToInTime (markerConditionalMachine computer fallback).step + (Turing.initList (markerConditionalMachine computer fallback) + (List.map computer.inputAlphabet.invFun input)) + (some (Turing.haltList + (markerConditionalMachine computer fallback) + (List.map computer.outputAlphabet.invFun + (markerConditionalOutput valid fallback input)))) + ((computer.time + Polynomial.X + 3).eval input.length) := by + cases input with + | nil => + have hbudget : + 2 ≤ (computer.time + Polynomial.X + 3).eval 0 := by + simp only [Polynomial.eval_add, Polynomial.eval_X, add_zero, Polynomial.eval_ofNat, + Nat.reduceLeDiff] + convert rebound (markerConditional_missingTrace computer fallback) hbudget using 1 <;> + simp [markerConditionalOutput] + | cons marker input => + cases marker with + | false => + have hbudget : + input.length + 2 ≤ + (computer.time + Polynomial.X + 3).eval + (input.length + 1) := by + simp only [Polynomial.eval_add, Polynomial.eval_X, Polynomial.eval_ofNat, + Nat.reduceLeDiff] + omega + convert rebound (markerConditional_falseTrace computer fallback input) hbudget using 1 + <;> + simp [markerConditionalOutput] + | true => + have hmonotone : + computer.time.eval input.length ≤ + computer.time.eval (input.length + 1) := + GapCVP.TMComposition.natPolynomial_eval_monotone + computer.time (by omega) + have hbudget : + computer.time.eval input.length + 1 ≤ + (computer.time + Polynomial.X + 3).eval + (input.length + 1) := by + simp only [Polynomial.eval_add, Polynomial.eval_X, Polynomial.eval_ofNat, + Order.add_one_le_iff] + omega + convert rebound (markerConditional_trueTrace computer fallback input) hbudget using 1 <;> + simp [markerConditionalOutput] + +/-- GapCVP reduction support. -/ +noncomputable def markerConditionalComputable + {valid : List Bool → List Bool} + (computer : BitTM valid) + (fallback : List Bool) : + BitTM + (markerConditionalOutput valid fallback) where + tm := markerConditionalMachine computer fallback + inputAlphabet := computer.inputAlphabet + outputAlphabet := computer.outputAlphabet + time := computer.time + Polynomial.X + 3 + outputsFun input := by + change EvalsToInTime + (markerConditionalMachine computer fallback).step + (Turing.initList (markerConditionalMachine computer fallback) + (List.map computer.inputAlphabet.invFun input)) + (some (Turing.haltList + (markerConditionalMachine computer fallback) + (List.map computer.outputAlphabet.invFun + (markerConditionalOutput valid fallback input)))) + ((computer.time + Polynomial.X + 3).eval input.length) + exact markerConditional_totalTrace computer fallback input + +/-- GapCVP reduction support. -/ +noncomputable def sourcePreservingConditionalComputable + {selector : List Bool → Bool} + {valid : List Bool → List Bool} + (selection : BitTM + (fun input => selector input :: input)) + (computer : BitTM valid) + (fallback : List Bool) : + BitTM + (fun input => if selector input then valid input else fallback) := by + convert GapCVP.TMComposition.computableInPolyTime + selection (markerConditionalComputable computer fallback) using 1 + funext input + cases hselector : selector input <;> + simp [Function.comp_apply, markerConditionalOutput, hselector] + +end OutputPolynomialCompositionClosure + +namespace CNFBoundedRecordFoldTM + +open Computability Turing GapCVP.CL GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction +open GapCVP.CLStructuralWholeCNFOutputTM GapCVP.CNFClauseLoop GapCVP.CNFFiniteRecordSort +open GapCVP.CNFPolynomialRowMarkerTM GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CLStructuralCNFOutputMachinesUnconditional GapCVP.CNFDependentFiveFamilyRecordTM + +/-- GapCVP reduction support. -/ +def actualWindowIndexEquiv (T : ℕ) : + Window T ≃ (Fin T × Position T) where + toFun window := + (⟨window.1.1.val, by have h := window.2; omega⟩, + window.1.2) + invFun index := windowAt index.1 index.2 + left_inv window := by + apply Subtype.ext + apply Prod.ext + · apply Fin.ext + rfl + · rfl + right_inv index := by + apply Prod.ext + · apply Fin.ext + rfl + · rfl + +/-- GapCVP reduction support. -/ +def totalAtMostOneFamilyClauses (T S : ℕ) : List (Clause T S) := + (clauseLoopFiniteElements + ((Time T × Position T) × (Symbol S × Symbol S))).map + (fun candidate => + if candidate.2.1 < candidate.2.2 then + atMostOneClause candidate.1.1 candidate.1.2 + candidate.2.1 candidate.2.2 + else + atLeastOneClause candidate.1.1 candidate.1.2) + +/-- GapCVP reduction support. -/ +def totalForbiddenTransitionFamilyClauses {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + (clauseLoopFiniteElements (Window T × WindowSymbols S)).map + (fun candidate => + if specification.allowed candidate.2 = false then + transitionClause candidate.1 candidate.2 + else + atLeastOneClause candidate.1.1.1 candidate.1.1.2) + +/-- GapCVP reduction support. -/ +def totalFiveFamilySourceClauseCandidates {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + executableAtLeastOneFamilyClauses T S ++ + totalAtMostOneFamilyClauses T S ++ + executableInitialFamilyClauses specification ++ + executableAcceptanceFamilyClauses specification ++ + totalForbiddenTransitionFamilyClauses specification + +private theorem totalAtMostOneFamilyClauses_mem_tableauFormula + {T S : ℕ} (specification : Specification T S) + (clause : Clause T S) + (hclause : clause ∈ totalAtMostOneFamilyClauses T S) : + clause ∈ tableauFormula specification := by + obtain ⟨candidate, _, hvalue⟩ := List.mem_map.mp hclause + by_cases hvalid : candidate.2.1 < candidate.2.2 + · simp only [hvalid, ↓reduceIte] at hvalue + subst clause + exact atMostOneClause_mem_tableauFormula specification + candidate.1.1 candidate.1.2 + candidate.2.1 candidate.2.2 hvalid + · simp only [hvalid, ↓reduceIte] at hvalue + subst clause + exact atLeastOneClause_mem_tableauFormula specification + candidate.1.1 candidate.1.2 + +private theorem totalForbiddenTransitionFamilyClauses_mem_tableauFormula + {T S : ℕ} (specification : Specification T S) + (clause : Clause T S) + (hclause : clause ∈ + totalForbiddenTransitionFamilyClauses specification) : + clause ∈ tableauFormula specification := by + obtain ⟨candidate, _, hvalue⟩ := List.mem_map.mp hclause + by_cases hvalid : specification.allowed candidate.2 = false + · simp only [hvalid, ↓reduceIte] at hvalue + subst clause + exact transitionClause_mem_tableauFormula specification + candidate.1 candidate.2 hvalid + · simp only [hvalid, Bool.true_eq_false, ↓reduceIte] at hvalue + subst clause + exact atLeastOneClause_mem_tableauFormula specification + candidate.1.1.1 candidate.1.1.2 + +private theorem executableAtMostOneFamilyClauses_subset_total + (T S : ℕ) (clause : Clause T S) + (hclause : clause ∈ executableAtMostOneFamilyClauses T S) : + clause ∈ totalAtMostOneFamilyClauses T S := by + unfold executableAtMostOneFamilyClauses at hclause + obtain ⟨candidate, hcandidate, hvalue⟩ := + List.mem_filterMap.mp hclause + by_cases hvalid : candidate.2.1 < candidate.2.2 + · simp only [hvalid, ↓reduceIte, Option.some.injEq] at hvalue + apply List.mem_map.mpr + refine ⟨candidate, hcandidate, ?_⟩ + simpa only [hvalid, ↓reduceIte] using hvalue + · simp only [hvalid, ↓reduceIte, reduceCtorEq] at hvalue + +private theorem executableForbiddenTransitionFamilyClauses_subset_total + {T S : ℕ} (specification : Specification T S) + (clause : Clause T S) + (hclause : clause ∈ + executableForbiddenTransitionFamilyClauses specification) : + clause ∈ totalForbiddenTransitionFamilyClauses specification := by + unfold executableForbiddenTransitionFamilyClauses at hclause + obtain ⟨candidate, hcandidate, hvalue⟩ := + List.mem_filterMap.mp hclause + by_cases hvalid : specification.allowed candidate.2 = false + · simp only [hvalid, ↓reduceIte, Option.some.injEq] at hvalue + apply List.mem_map.mpr + refine ⟨candidate, hcandidate, ?_⟩ + simpa only [hvalid, ↓reduceIte] using hvalue + · simp only [hvalid, Bool.true_eq_false, ↓reduceIte, reduceCtorEq] at hvalue + +theorem totalFiveFamilySourceClauseCandidates_toFinset + {T S : ℕ} (specification : Specification T S) : + (totalFiveFamilySourceClauseCandidates specification).toFinset = + tableauFormula specification := by + ext clause + simp only [List.mem_toFinset] + constructor + · intro hclause + simp only [totalFiveFamilySourceClauseCandidates, + List.mem_append] at hclause + rcases hclause with hremaining | hforbidden + · rcases hremaining with hremaining | haccept + · rcases hremaining with hremaining | hinitial + · rcases hremaining with hleast | hmost + · obtain ⟨index, _, rfl⟩ := List.mem_map.mp hleast + exact atLeastOneClause_mem_tableauFormula specification + index.1 index.2 + · exact totalAtMostOneFamilyClauses_mem_tableauFormula + specification clause hmost + · obtain ⟨position, _, rfl⟩ := List.mem_map.mp hinitial + exact initialClause_mem_tableauFormula specification position + · have haccept' : + clause = acceptanceClause specification.accept := by + simpa only [executableAcceptanceFamilyClauses, List.mem_cons, List.not_mem_nil, or_false] + using haccept + subst clause + exact acceptanceClause_mem_tableauFormula specification + · exact totalForbiddenTransitionFamilyClauses_mem_tableauFormula + specification clause hforbidden + · intro hclause + have hexecutable : + clause ∈ executableFiveFamilySourceClauseCandidates + specification := by + have hfinset : + clause ∈ + (executableFiveFamilySourceClauseCandidates + specification).toFinset := by + rw [executableFiveFamilySourceClauseCandidates_toFinset] + exact hclause + simpa only [List.mem_toFinset] using hfinset + simp only [executableFiveFamilySourceClauseCandidates, + List.mem_append] at hexecutable + simp only [totalFiveFamilySourceClauseCandidates, + List.mem_append] + rcases hexecutable with hremaining | hforbidden + · rcases hremaining with hremaining | haccept + · rcases hremaining with hremaining | hinitial + · rcases hremaining with hleast | hmost + · exact Or.inl (Or.inl (Or.inl (Or.inl hleast))) + · exact Or.inl (Or.inl (Or.inl (Or.inr + (executableAtMostOneFamilyClauses_subset_total + T S clause hmost)))) + · exact Or.inl (Or.inl (Or.inr hinitial)) + · exact Or.inl (Or.inr haccept) + · exact Or.inr + (executableForbiddenTransitionFamilyClauses_subset_total + specification clause hforbidden) + +/-- GapCVP reduction support. -/ +def totalVerifierFiveFamilySourceClauseCandidates + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) := + totalFiveFamilySourceClauseCandidates + ((paddedStructuralTableauSimulation bound machine).specification input) + +theorem totalVerifierFiveFamilySourceClauseCandidates_sorted + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : + sourceOrderedDistinctRecords + (totalVerifierFiveFamilySourceClauseCandidates + bound machine input) = + structuralWholeSourceClauses bound machine input := by + unfold sourceOrderedDistinctRecords + totalVerifierFiveFamilySourceClauseCandidates + rw [totalFiveFamilySourceClauseCandidates_toFinset] + rfl + +private theorem encodeFormulaFrom_totalVerifierFiveFamilies + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : + encodeFormulaFrom 0 + (sourceOrderedDistinctRecords + (totalVerifierFiveFamilySourceClauseCandidates + bound machine input)) = + structuralWholeThreeCNF bound machine input := by + rw [totalVerifierFiveFamilySourceClauseCandidates_sorted] + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem encodeThreeCNF_totalVerifierFiveFamilies + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : + encodeThreeCNF + (encodeFormulaFrom 0 + (sourceOrderedDistinctRecords + (totalVerifierFiveFamilySourceClauseCandidates + bound machine input))) = + structuralWholeCNFWord bound machine input := by + rw [encodeFormulaFrom_totalVerifierFiveFamilies] + rfl + +/-- GapCVP reduction support. -/ +noncomputable def polynomialValueUnaryComputable + (polynomial : Polynomial ℕ) : + BitTM + (fun input : List Bool => + List.replicate (polynomial.eval input.length) true) := by + have hsuffix := GapCVP.TMComposition.computableInPolyTime + (sourcePreservingPolynomialMarkerComputable polynomial) + firstFieldSuffixComputable + have hcontents := GapCVP.TMComposition.computableInPolyTime + hsuffix firstFieldContentsComputable + have hfunction : + (fun input : List Bool => + firstFieldContents + (firstFieldSuffix + (sourcePreservingPolynomialMarkerWord polynomial input))) = + (fun input : List Bool => + List.replicate (polynomial.eval input.length) true) := by + funext input + rw [firstFieldSuffix_sourcePreservingPolynomialMarkerWord] + simpa only [List.append_nil] using + (firstFieldContents_valid (List.replicate (polynomial.eval input.length) true) []) + rw [← hfunction] + simpa only [Function.comp_def] using hcontents + +end CNFBoundedRecordFoldTM + +namespace OutputBoundedDependentRecordFold + +open Turing + +@[simp] private theorem boundedFold_cast_nil + {α β : Type} (h : α = β) : + cast (congrArg List h) ([] : List α) = ([] : List β) := by + cases h + rfl + +/-- GapCVP reduction support. -/ +def parseUnaryBoundedFold : List Bool → Option (ℕ × List Bool) + | [] => none + | false :: remaining => some (0, remaining) + | true :: remaining => + (parseUnaryBoundedFold remaining).map + (fun parsed => (parsed.1 + 1, parsed.2)) + +/-- GapCVP reduction support. -/ +def unaryBoundedFoldWord (count : ℕ) (seed : List Bool) : List Bool := + List.replicate count true ++ false :: seed + +@[simp] theorem parseUnaryBoundedFold_word + (count : ℕ) (seed : List Bool) : + parseUnaryBoundedFold (unaryBoundedFoldWord count seed) = + some (count, seed) := by + induction count with + | zero => rfl + | succ count ih => + simpa only [unaryBoundedFoldWord, List.replicate_succ, List.cons_append, + parseUnaryBoundedFold, + Option.map_eq_some_iff, Prod.mk.injEq, Nat.add_right_cancel_iff, Prod.exists, + exists_eq_right_right, + exists_eq_right, Option.map_some] using + congrArg (Option.map (fun parsed : ℕ × List Bool => (parsed.1 + 1, parsed.2))) ih + +/-- GapCVP reduction support. -/ +def boundedRecordFoldOutput + (worker : List Bool → List Bool) (input : List Bool) : List Bool := + match parseUnaryBoundedFold input with + | none => [] + | some (count, seed) => (worker^[count]) seed + +theorem parsedUnaryFold_count_le_length + (input : List Bool) (count : ℕ) (seed : List Bool) + (hparse : parseUnaryBoundedFold input = some (count, seed)) : + count ≤ input.length := by + induction input generalizing count seed with + | nil => simp only [parseUnaryBoundedFold, reduceCtorEq] at hparse + | cons bit remaining ih => + cases bit with + | false => + simp only [parseUnaryBoundedFold, Option.some.injEq, Prod.mk.injEq] at hparse + omega + | true => + cases hrest : parseUnaryBoundedFold remaining with + | none => simp only [parseUnaryBoundedFold, hrest, Option.map_none, reduceCtorEq] + at hparse + | some parsed => + obtain ⟨parsedCount, parsedSeed⟩ := parsed + simp only [parseUnaryBoundedFold, hrest, Option.map_some, Option.some.injEq, + Prod.mk.injEq] at hparse + obtain ⟨hcount, hseed⟩ := hparse + subst count + have hbounded := ih parsedCount parsedSeed hrest + simp only [List.length_cons] + omega + +/-- GapCVP reduction support. -/ +noncomputable def PolynomiallyBoundedFoldStates + (worker : List Bool → List Bool) + (bound : Polynomial ℕ) : Bool := + @decide ( + ∀ (input : List Bool) (count : ℕ) (seed : List Bool), + parseUnaryBoundedFold input = some (count, seed) → + ∀ stage : ℕ, stage ≤ count → + ((worker^[stage]) seed).length ≤ bound.eval input.length + ) (Classical.propDecidable _) +private abbrev BoundedFoldStack (tm : Turing.FinTM2) := tm.K ⊕ Bool + +private abbrev boundedFoldAlphabet (tm : Turing.FinTM2) : + BoundedFoldStack tm → Type + | .inl k => tm.Γ k + | .inr _ => Bool + +private abbrev BoundedFoldLabel (tm : Turing.FinTM2) := tm.Λ ⊕ Fin 5 + +private abbrev BoundedFoldState (tm : Turing.FinTM2) := Option Bool × tm.σ + +private def liftBoundedFoldWorkerStatement (tm : Turing.FinTM2) : + Turing.TM2.Stmt tm.Γ tm.Λ tm.σ → + Turing.TM2.Stmt (boundedFoldAlphabet tm) + (BoundedFoldLabel tm) (BoundedFoldState tm) + | .push k f next => + .push (.inl k) (fun state => f state.2) + (liftBoundedFoldWorkerStatement tm next) + | .peek k f next => + .peek (.inl k) + (fun state symbol => (state.1, f state.2 symbol)) + (liftBoundedFoldWorkerStatement tm next) + | .pop k f next => + .pop (.inl k) + (fun state symbol => (state.1, f state.2 symbol)) + (liftBoundedFoldWorkerStatement tm next) + | .load f next => + .load (fun state => (state.1, f state.2)) + (liftBoundedFoldWorkerStatement tm next) + | .branch test yes no => + .branch (fun state => test state.2) + (liftBoundedFoldWorkerStatement tm yes) + (liftBoundedFoldWorkerStatement tm no) + | .goto next => .goto (fun state => .inl (next state.2)) + | .halt => + .load (fun state => (none, state.2)) + (.goto (fun _ => .inr (2 : Fin 5))) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def boundedDependentRecordFoldMachine + {worker : List Bool → List Bool} + (computer : BitTM worker) : Turing.FinTM2 := by + classical + letI : DecidableEq computer.tm.K := computer.tm.kDecidableEq + letI : Fintype computer.tm.K := computer.tm.kFin + letI : Fintype computer.tm.Λ := computer.tm.ΛFin + letI : Fintype computer.tm.σ := computer.tm.σFin + letI : Fintype (computer.tm.Γ computer.tm.k₀) := + computer.tm.Γk₀Fin + exact { + K := BoundedFoldStack computer.tm + k₀ := .inl computer.tm.k₀ + k₁ := .inl computer.tm.k₀ + Γ := boundedFoldAlphabet computer.tm + Λ := BoundedFoldLabel computer.tm + main := .inr (0 : Fin 5) + σ := BoundedFoldState computer.tm + initialState := (none, computer.tm.initialState) + m := fun + | .inl label => + liftBoundedFoldWorkerStatement computer.tm + (computer.tm.m label) + | .inr phase => + if phase = (0 : Fin 5) then + .peek (.inl computer.tm.k₀) + (fun state symbol => + (symbol.map computer.inputAlphabet, state.2)) + (.branch (fun state => state.1.isSome) + (.branch (fun state => state.1.getD false) + (.pop (.inl computer.tm.k₀) + (fun state _ => (none, state.2)) + (.push (.inr false) (fun _ => true) + (.goto (fun _ => .inr (0 : Fin 5))))) + (.pop (.inl computer.tm.k₀) + (fun state _ => (none, state.2)) + (.goto (fun _ => .inr (1 : Fin 5))))) + (.goto (fun _ => .inr (4 : Fin 5)))) + else if phase = (1 : Fin 5) then + .peek (.inr false) + (fun state symbol => (symbol, state.2)) + (.branch (fun state => state.1.isSome) + (.pop (.inr false) + (fun state _ => (none, state.2)) + (.goto (fun _ => .inl computer.tm.main))) + (.load (fun state => (none, state.2)) .halt)) + else if phase = (2 : Fin 5) then + .peek (.inl computer.tm.k₁) + (fun state symbol => + (symbol.map computer.outputAlphabet, state.2)) + (.branch (fun state => state.1.isSome) + (.pop (.inl computer.tm.k₁) + (fun state _ => state) + (.push (.inr true) + (fun state => state.1.getD false) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (2 : Fin 5)))))) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (3 : Fin 5))))) + else if phase = (3 : Fin 5) then + .peek (.inr true) + (fun state symbol => (symbol, state.2)) + (.branch (fun state => state.1.isSome) + (.pop (.inr true) + (fun state _ => state) + (.push (.inl computer.tm.k₀) + (fun state => + computer.inputAlphabet.invFun + (state.1.getD false)) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (3 : Fin 5)))))) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (1 : Fin 5))))) + else + .peek (.inr false) + (fun state symbol => (symbol, state.2)) + (.branch (fun state => state.1.isSome) + (.pop (.inr false) + (fun state _ => (none, state.2)) + (.goto (fun _ => .inr (4 : Fin 5)))) + (.load (fun state => (none, state.2)) .halt)) + } + +private def boundedFoldStacks + (tm : Turing.FinTM2) + (sourceStacks : ∀ k, List (tm.Γ k)) + (counter scratch : List Bool) : + (k : BoundedFoldStack tm) → List (boundedFoldAlphabet tm k) + | .inl k => sourceStacks k + | .inr false => counter + | .inr true => scratch + +private noncomputable def boundedFoldPhaseConfiguration + {worker : List Bool → List Bool} + (computer : BitTM worker) + (phase : Fin 5) + (sourceStacks : ∀ k, List (computer.tm.Γ k)) + (counter scratch : List Bool) : + (boundedDependentRecordFoldMachine computer).Cfg where + l := some (.inr phase) + var := (none, computer.tm.initialState) + stk := boundedFoldStacks computer.tm sourceStacks counter scratch + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def boundedFoldWorkerConfiguration + {worker : List Bool → List Bool} + (computer : BitTM worker) + (counter : List Bool) + (configuration : computer.tm.Cfg) : + (boundedDependentRecordFoldMachine computer).Cfg where + l := match configuration.l with + | some label => some (.inl label) + | none => some (.inr (2 : Fin 5)) + var := (none, configuration.var) + stk := boundedFoldStacks computer.tm configuration.stk counter [] + +private theorem boundedFoldStacks_update_worker + (tm : Turing.FinTM2) + (sourceStacks : ∀ k, List (tm.Γ k)) + (counter scratch : List Bool) + (k : tm.K) (value : List (tm.Γ k)) : + boundedFoldStacks tm (Function.update sourceStacks k value) + counter scratch = + Function.update + (boundedFoldStacks tm sourceStacks counter scratch) + (.inl k) value := by + classical + funext stack + cases stack with + | inl stack => + by_cases heq : stack = k + · subst stack + simp only [boundedFoldStacks, Function.update_self] + · simp only [boundedFoldStacks, Function.update, heq, ↓reduceDIte, Sum.inl.injEq] + | inr stack => + cases stack <;> simp [boundedFoldStacks, Function.update] + +private theorem liftBoundedFoldWorkerStatement_stepAux + {worker : List Bool → List Bool} + (computer : BitTM worker) + (counter : List Bool) + (statement : Turing.TM2.Stmt + computer.tm.Γ computer.tm.Λ computer.tm.σ) + (state : computer.tm.σ) + (sourceStacks : ∀ k, List (computer.tm.Γ k)) : + Turing.TM2.stepAux + (liftBoundedFoldWorkerStatement computer.tm statement) + (none, state) + (boundedFoldStacks computer.tm sourceStacks counter []) = + boundedFoldWorkerConfiguration computer counter + (Turing.TM2.stepAux statement state sourceStacks) := by + classical + induction statement generalizing state sourceStacks with + | push k f next ih => + change Turing.TM2.stepAux + (liftBoundedFoldWorkerStatement computer.tm next) + (none, state) + (Function.update + (boundedFoldStacks computer.tm sourceStacks counter []) + (.inl k) (f state :: sourceStacks k)) = _ + rw [← boundedFoldStacks_update_worker] + exact ih (state := state) + (sourceStacks := + Function.update sourceStacks k (f state :: sourceStacks k)) + | peek k f next ih => + exact ih (state := f state (sourceStacks k).head?) + (sourceStacks := sourceStacks) + | pop k f next ih => + change Turing.TM2.stepAux + (liftBoundedFoldWorkerStatement computer.tm next) + (none, f state (sourceStacks k).head?) + (Function.update + (boundedFoldStacks computer.tm sourceStacks counter []) + (.inl k) (sourceStacks k).tail) = _ + rw [← boundedFoldStacks_update_worker] + exact ih (state := f state (sourceStacks k).head?) + (sourceStacks := + Function.update sourceStacks k (sourceStacks k).tail) + | load f next ih => + exact ih (state := f state) (sourceStacks := sourceStacks) + | branch test yes no ihYes ihNo => + cases htest : test state with + | false => + simpa only [liftBoundedFoldWorkerStatement, TM2.stepAux, htest, Bool.cond_false] using + ihNo (state := state) (sourceStacks := sourceStacks) + | true => + simpa only [liftBoundedFoldWorkerStatement, TM2.stepAux, htest, Bool.cond_true] using + ihYes (state := state) (sourceStacks := sourceStacks) + | goto next => rfl + | halt => rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFoldWorkerConfiguration_step + {worker : List Bool → List Bool} + (computer : BitTM worker) + (counter : List Bool) + (configuration next : computer.tm.Cfg) + (hstep : computer.tm.step configuration = some next) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldWorkerConfiguration computer counter configuration) = + some (boundedFoldWorkerConfiguration computer counter next) := by + rcases configuration with ⟨label, state, sourceStacks⟩ + cases label with + | none => + simp only [FinTM2.step, TM2.step, reduceCtorEq] at hstep + | some label => + change some (Turing.TM2.stepAux (computer.tm.m label) + state sourceStacks) = some next at hstep + have hnext := Option.some.inj hstep + subst next + change some (Turing.TM2.stepAux + (liftBoundedFoldWorkerStatement computer.tm + (computer.tm.m label)) + (none, state) + (boundedFoldStacks computer.tm sourceStacks counter [])) = + some (boundedFoldWorkerConfiguration computer counter + (Turing.TM2.stepAux (computer.tm.m label) + state sourceStacks)) + rw [liftBoundedFoldWorkerStatement_stepAux computer counter] + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def boundedFoldScanConfiguration + {worker : List Bool → List Bool} + (computer : BitTM worker) + (remaining : List (computer.tm.Γ computer.tm.k₀)) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).Cfg := + boundedFoldPhaseConfiguration computer 0 + (Turing.initList computer.tm remaining).stk counter [] + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def boundedFoldDispatchConfiguration + {worker : List Bool → List Bool} + (computer : BitTM worker) + (input : List (computer.tm.Γ computer.tm.k₀)) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).Cfg := + boundedFoldPhaseConfiguration computer 1 + (Turing.initList computer.tm input).stk counter [] + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def boundedFoldDrainConfiguration + {worker : List Bool → List Bool} + (computer : BitTM worker) + (output : List (computer.tm.Γ computer.tm.k₁)) + (counter scratch : List Bool) : + (boundedDependentRecordFoldMachine computer).Cfg := + boundedFoldPhaseConfiguration computer 2 + (Turing.haltList computer.tm output).stk counter scratch + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def boundedFoldRestoreConfiguration + {worker : List Bool → List Bool} + (computer : BitTM worker) + (input : List (computer.tm.Γ computer.tm.k₀)) + (counter scratch : List Bool) : + (boundedDependentRecordFoldMachine computer).Cfg := + boundedFoldPhaseConfiguration computer 3 + (Turing.initList computer.tm input).stk counter scratch + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def boundedFoldMalformedConfiguration + {worker : List Bool → List Bool} + (computer : BitTM worker) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).Cfg := + boundedFoldPhaseConfiguration computer 4 + (Turing.initList computer.tm []).stk counter [] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem boundedFoldWorkerConfiguration_halt + {worker : List Bool → List Bool} + (computer : BitTM worker) + (counter : List Bool) + (output : List (computer.tm.Γ computer.tm.k₁)) : + boundedFoldWorkerConfiguration computer counter + (Turing.haltList computer.tm output) = + boundedFoldDrainConfiguration computer output counter [] := by + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedDependentRecordFoldMachine_init + {worker : List Bool → List Bool} + (computer : BitTM worker) + (input : List (computer.tm.Γ computer.tm.k₀)) : + Turing.initList (boundedDependentRecordFoldMachine computer) input = + boundedFoldScanConfiguration computer input [] := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, initList, + eq_mpr_eq_cast, + boundedFoldScanConfiguration, boundedFoldPhaseConfiguration] + congr 1 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₀ + · subst stack + simp only [↓reduceDIte, cast_eq, boundedFoldStacks] + rfl + · simp only [Sum.inl.injEq, heq, ↓reduceDIte, boundedFoldStacks] + | inr stack => + cases stack <;> simp [boundedFoldStacks] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_scan_true + {worker : List Bool → List Bool} + (computer : BitTM worker) + (remaining : List (computer.tm.Γ computer.tm.k₀)) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldScanConfiguration computer + (computer.inputAlphabet.invFun true :: remaining) counter) = + some (boundedFoldScanConfiguration computer remaining + (true :: counter)) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldScanConfiguration, boundedFoldPhaseConfiguration, initList, eq_mpr_eq_cast, + ↓reduceIte, TM2.stepAux, + boundedFoldStacks, ↓reduceDIte, cast_eq, List.head?_cons, Option.map_some, + Equiv.apply_symm_apply, + Option.isSome_some, Option.getD_some, List.tail_cons, ne_eq, reduceCtorEq, not_false_eq_true, + Function.update_of_ne, + Bool.cond_true] + congr 2 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₀ + · subst stack + simp only [Function.update, reduceCtorEq, ↓reduceDIte, boundedFoldStacks, cast_eq] + · simp only [Function.update, reduceCtorEq, ↓reduceDIte, Sum.inl.injEq, heq, + boundedFoldStacks] + | inr stack => + cases stack <;> simp [Function.update, boundedFoldStacks] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_scan_delimiter + {worker : List Bool → List Bool} + (computer : BitTM worker) + (remaining : List (computer.tm.Γ computer.tm.k₀)) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldScanConfiguration computer + (computer.inputAlphabet.invFun false :: remaining) counter) = + some (boundedFoldDispatchConfiguration computer remaining + counter) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldScanConfiguration, boundedFoldPhaseConfiguration, initList, eq_mpr_eq_cast, + ↓reduceIte, TM2.stepAux, + boundedFoldStacks, ↓reduceDIte, cast_eq, List.head?_cons, Option.map_some, + Equiv.apply_symm_apply, + Option.isSome_some, Option.getD_some, List.tail_cons, ne_eq, reduceCtorEq, not_false_eq_true, + Function.update_of_ne, + Bool.cond_false, Bool.cond_true, boundedFoldDispatchConfiguration] + congr 2 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₀ + · subst stack + simp only [Function.update, ↓reduceDIte, boundedFoldStacks, cast_eq] + · simp only [Function.update, Sum.inl.injEq, heq, ↓reduceDIte, boundedFoldStacks] + | inr stack => + cases stack <;> simp [Function.update, boundedFoldStacks] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_scan_missing + {worker : List Bool → List Bool} + (computer : BitTM worker) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldScanConfiguration computer [] counter) = + some (boundedFoldMalformedConfiguration computer counter) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldScanConfiguration, boundedFoldPhaseConfiguration, initList, eq_mpr_eq_cast, + ↓reduceIte, TM2.stepAux, + boundedFoldStacks, ↓reduceDIte, cast_eq, List.head?_nil, Option.map_none, Option.isSome_none, + Option.getD_none, + List.tail_nil, ne_eq, reduceCtorEq, not_false_eq_true, Function.update_of_ne, + Bool.cond_false, + boundedFoldMalformedConfiguration] + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_dispatch_step + {worker : List Bool → List Bool} + (computer : BitTM worker) + (input : List (computer.tm.Γ computer.tm.k₀)) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldDispatchConfiguration computer input + (true :: counter)) = + some (boundedFoldWorkerConfiguration computer counter + (Turing.initList computer.tm input)) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldDispatchConfiguration, boundedFoldPhaseConfiguration, initList, eq_mpr_eq_cast, + one_ne_zero, ↓reduceIte, + TM2.stepAux, boundedFoldStacks, List.head?_cons, Option.isSome_some, List.tail_cons, + Bool.cond_true, + boundedFoldWorkerConfiguration] + congr 2 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₀ + · subst stack + simp only [Function.update, reduceCtorEq, ↓reduceDIte, boundedFoldStacks, cast_eq] + · simp only [Function.update, reduceCtorEq, ↓reduceDIte, boundedFoldStacks, heq] + | inr stack => + cases stack <;> simp [boundedFoldStacks, Function.update] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_dispatch_finish + {worker : List Bool → List Bool} + (computer : BitTM worker) + (input : List (computer.tm.Γ computer.tm.k₀)) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldDispatchConfiguration computer input []) = + some (Turing.haltList + (boundedDependentRecordFoldMachine computer) input) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldDispatchConfiguration, boundedFoldPhaseConfiguration, initList, eq_mpr_eq_cast, + one_ne_zero, ↓reduceIte, + TM2.stepAux, boundedFoldStacks, List.head?_nil, Option.isSome_none, List.tail_nil, + Bool.cond_false, haltList] + congr 2 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₀ + · subst stack + simp only [boundedFoldStacks, ↓reduceDIte, cast_eq] + rfl + · simp only [boundedFoldStacks, heq, ↓reduceDIte, Sum.inl.injEq] + | inr stack => + cases stack <;> simp [boundedFoldStacks] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_drain_step + {worker : List Bool → List Bool} + (computer : BitTM worker) + (symbol : computer.tm.Γ computer.tm.k₁) + (remaining : List (computer.tm.Γ computer.tm.k₁)) + (counter scratch : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldDrainConfiguration computer + (symbol :: remaining) counter scratch) = + some (boundedFoldDrainConfiguration computer + remaining counter + (computer.outputAlphabet symbol :: scratch)) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldDrainConfiguration, boundedFoldPhaseConfiguration, haltList, eq_mpr_eq_cast, + Fin.reduceEq, ↓reduceIte, + TM2.stepAux, boundedFoldStacks, ↓reduceDIte, cast_eq, List.head?_cons, Option.map_some, + Option.isSome_some, + List.tail_cons, Option.getD_some, ne_eq, reduceCtorEq, not_false_eq_true, + Function.update_of_ne, Bool.cond_true] + congr 2 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₁ + · subst stack + simp only [Function.update, reduceCtorEq, ↓reduceDIte, boundedFoldStacks, cast_eq] + · simp only [Function.update, reduceCtorEq, ↓reduceDIte, Sum.inl.injEq, heq, + boundedFoldStacks] + | inr stack => + cases stack <;> simp [boundedFoldStacks, Function.update] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_drain_finish + {worker : List Bool → List Bool} + (computer : BitTM worker) + (counter scratch : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldDrainConfiguration computer [] counter scratch) = + some (boundedFoldRestoreConfiguration computer [] + counter scratch) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldDrainConfiguration, boundedFoldPhaseConfiguration, haltList, eq_mpr_eq_cast, + Fin.reduceEq, ↓reduceIte, + TM2.stepAux, boundedFoldStacks, ↓reduceDIte, cast_eq, List.head?_nil, Option.map_none, + Option.isSome_none, + List.tail_nil, Option.getD_none, ne_eq, reduceCtorEq, not_false_eq_true, + Function.update_of_ne, Bool.cond_false, + boundedFoldRestoreConfiguration, initList] + congr 2 + funext stack + cases stack with + | inl stack => + by_cases hin : stack = computer.tm.k₀ + · subst stack + simp only [boundedFoldStacks, ↓reduceDIte, cast_eq, dite_eq_right_iff] + intro h + first + | exact boundedFold_cast_nil (congrArg computer.tm.Γ h) + | exact boundedFold_cast_nil (congrArg computer.tm.Γ h.symm) + · by_cases hout : stack = computer.tm.k₁ + · subst stack + simp only [boundedFoldStacks, ↓reduceDIte, cast_eq, hin] + · simp only [boundedFoldStacks, hout, ↓reduceDIte, hin] + | inr stack => + cases stack <;> simp [boundedFoldStacks] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_restore_step + {worker : List Bool → List Bool} + (computer : BitTM worker) + (input : List (computer.tm.Γ computer.tm.k₀)) + (counter : List Bool) + (bit : Bool) (scratch : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldRestoreConfiguration computer input + counter (bit :: scratch)) = + some (boundedFoldRestoreConfiguration computer + (computer.inputAlphabet.invFun bit :: input) + counter scratch) := by + classical + cases bit <;> + compactMachineStepTac [boundedDependentRecordFoldMachine, + boundedFoldRestoreConfiguration, boundedFoldPhaseConfiguration, + boundedFoldStacks, Turing.initList] + all_goals + congr 2 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₀ + · subst stack + simp only [Function.update, ↓reduceDIte, boundedFoldStacks, cast_eq, + reduceCtorEq] + · simp only [Function.update, Sum.inl.injEq, heq, ↓reduceDIte, reduceCtorEq, + boundedFoldStacks] + | inr stack => + cases stack <;> simp [boundedFoldStacks, Function.update] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_restore_finish + {worker : List Bool → List Bool} + (computer : BitTM worker) + (input : List (computer.tm.Γ computer.tm.k₀)) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldRestoreConfiguration computer input counter []) = + some (boundedFoldDispatchConfiguration computer input counter) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldRestoreConfiguration, boundedFoldPhaseConfiguration, initList, eq_mpr_eq_cast, + Fin.reduceEq, ↓reduceIte, + TM2.stepAux, boundedFoldStacks, List.head?_nil, Option.isSome_none, List.tail_nil, + Option.getD_none, + Bool.cond_false, + boundedFoldDispatchConfiguration] + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_malformed_step + {worker : List Bool → List Bool} + (computer : BitTM worker) + (counter : List Bool) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldMalformedConfiguration computer + (true :: counter)) = + some (boundedFoldMalformedConfiguration computer counter) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldMalformedConfiguration, boundedFoldPhaseConfiguration, initList, eq_mpr_eq_cast, + Fin.reduceEq, + ↓reduceIte, TM2.stepAux, boundedFoldStacks, List.head?_cons, Option.isSome_some, + List.tail_cons, Bool.cond_true] + congr 2 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₀ + · subst stack + simp only [Function.update, reduceCtorEq, ↓reduceDIte, boundedFoldStacks, cast_eq] + · simp only [Function.update, reduceCtorEq, ↓reduceDIte, boundedFoldStacks, heq] + | inr stack => + cases stack <;> simp [boundedFoldStacks, Function.update] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedFold_malformed_finish + {worker : List Bool → List Bool} + (computer : BitTM worker) : + (boundedDependentRecordFoldMachine computer).step + (boundedFoldMalformedConfiguration computer []) = + some (Turing.haltList + (boundedDependentRecordFoldMachine computer) []) := by + classical + simp only [boundedDependentRecordFoldMachine, Fin.isValue, Equiv.invFun_as_coe, FinTM2.step, + TM2.step, + boundedFoldMalformedConfiguration, boundedFoldPhaseConfiguration, initList, eq_mpr_eq_cast, + Fin.reduceEq, + ↓reduceIte, TM2.stepAux, boundedFoldStacks, List.head?_nil, Option.isSome_none, + List.tail_nil, Bool.cond_false, haltList] + congr 2 + funext stack + cases stack with + | inl stack => + by_cases heq : stack = computer.tm.k₀ + · subst stack + simp only [boundedFoldStacks, ↓reduceDIte, cast_eq] + rfl + · simp only [boundedFoldStacks, heq, ↓reduceDIte, Sum.inl.injEq] + | inr stack => + cases stack <;> simp [boundedFoldStacks] + +end OutputBoundedDependentRecordFold + +namespace CNFTypedRecordWorkerTM + +open Turing GapCVP.CL GapCVP.OutputBoundedDependentRecordFold + +theorem parsedUnaryFold_seed_length_le + (raw : List Bool) (count : ℕ) (seed : List Bool) + (hparse : parseUnaryBoundedFold raw = some (count, seed)) : + seed.length ≤ raw.length := by + induction raw generalizing count seed with + | nil => + simp only [parseUnaryBoundedFold, reduceCtorEq] at hparse + | cons bit remaining ih => + cases bit with + | false => + simp only [parseUnaryBoundedFold, Option.some.injEq, Prod.mk.injEq] at hparse + obtain ⟨hcount, hseed⟩ := hparse + subst count + subst seed + simp only [List.length_cons, le_add_iff_nonneg_right, zero_le] + | true => + cases hrest : parseUnaryBoundedFold remaining with + | none => + simp only [parseUnaryBoundedFold, hrest, Option.map_none, reduceCtorEq] at hparse + | some parsed => + obtain ⟨parsedCount, parsedSeed⟩ := parsed + simp only [parseUnaryBoundedFold, hrest, Option.map_some, Option.some.injEq, + Prod.mk.injEq] at hparse + obtain ⟨hcount, hseed⟩ := hparse + subst count + subst seed + have hbounded := ih parsedCount parsedSeed hrest + simp only [List.length_cons] + omega + +theorem acceptanceClause_exact_card + {T S : ℕ} (accept : Symbol S) : + (acceptanceClause (T := T) accept).card = T + 1 := by + classical + have hinjective : Function.Injective + (fun position : Position T => + positive ((Fin.last T), position, accept)) := by + intro first second heq + exact congrArg + (fun literal : SignedLiteral T S => literal.1.2.1) heq + unfold acceptanceClause + calc + (Finset.univ.image + (fun position : Position T => + positive ((Fin.last T), position, accept))).card = + (Finset.univ : Finset (Position T)).card := + Finset.card_image_of_injective Finset.univ hinjective + _ = T + 1 := by simp only [Finset.card_univ, Fintype.card_fin] + +end CNFTypedRecordWorkerTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part04E.lean b/LeanPool/GapCVP/Part04E.lean new file mode 100644 index 000000000..61fc6cf62 --- /dev/null +++ b/LeanPool/GapCVP/Part04E.lean @@ -0,0 +1,1094 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part04D + +/-! # GapCVP proof, part 04, continuation 05 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFTypedRecordWorkerTM + +open Turing GapCVP.CL GapCVP.OutputBoundedDependentRecordFold + +end CNFTypedRecordWorkerTM + +namespace OutputBoundedDependentRecordFold + +open Turing + +private noncomputable def boundedFold_validScanTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (count : ℕ) (seed : List Bool) (counter : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (boundedFoldScanConfiguration computer + (List.map computer.inputAlphabet.invFun + (unaryBoundedFoldWord count seed)) counter) + (some (boundedFoldDispatchConfiguration computer + (List.map computer.inputAlphabet.invFun seed) + (List.replicate count true ++ counter))) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Equiv.invFun_as_coe, unaryBoundedFoldWord, List.replicate_zero, + List.nil_append, + List.map_cons, zero_add] using + oneStep _ _ (boundedFold_scan_delimiter computer (List.map computer.inputAlphabet.invFun + seed) counter) + | succ count ih => + have hfirst := oneStep _ _ (boundedFold_scan_true computer + (List.map computer.inputAlphabet.invFun + (unaryBoundedFoldWord count seed)) counter) + have hrest := ih (true :: counter) + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + 1 (count + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Equiv.invFun_as_coe, unaryBoundedFoldWord, List.replicate_succ, + List.cons_append, + List.map_cons, List.map_append, List.map_replicate, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private noncomputable def boundedFold_drainTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (output : List (computer.tm.Γ computer.tm.k₁)) + (counter scratch : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (boundedFoldDrainConfiguration computer output counter scratch) + (some (boundedFoldRestoreConfiguration computer [] counter + (List.map computer.outputAlphabet output.reverse ++ scratch))) + (output.length + 1) := by + induction output generalizing scratch with + | nil => + simpa only [FinTM2.step, List.reverse_nil, List.map_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (boundedFold_drain_finish computer counter scratch) + | cons symbol remaining ih => + have hfirst := oneStep _ _ (boundedFold_drain_step computer symbol remaining + counter scratch) + have hrest := ih (computer.outputAlphabet symbol :: scratch) + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, List.reverse_cons, List.map_append, List.map_reverse, List.map_cons, + List.map_nil, + List.append_assoc, List.cons_append, List.nil_append, List.length_cons, Nat.add_comm] + using hfull + +private noncomputable def boundedFold_restoreTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (scratch : List Bool) + (input : List (computer.tm.Γ computer.tm.k₀)) + (counter : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (boundedFoldRestoreConfiguration computer input + counter scratch) + (some (boundedFoldDispatchConfiguration computer + (List.map computer.inputAlphabet.invFun scratch.reverse ++ input) + counter)) + (scratch.length + 1) := by + induction scratch generalizing input with + | nil => + simpa only [FinTM2.step, Equiv.invFun_as_coe, List.reverse_nil, List.map_nil, + List.nil_append, + List.length_nil, zero_add] using oneStep _ _ (boundedFold_restore_finish computer input + counter) + | cons bit remaining ih => + have hfirst := oneStep _ _ (boundedFold_restore_step computer input counter bit remaining) + have hrest := ih + (computer.inputAlphabet.invFun bit :: input) + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Equiv.invFun_as_coe, List.reverse_cons, List.map_append, + List.map_reverse, + List.map_cons, List.map_nil, List.append_assoc, List.cons_append, List.nil_append, + List.length_cons, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using hfull + +private noncomputable def boundedFold_outputTransportTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (output counter : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (boundedFoldDrainConfiguration computer + (List.map computer.outputAlphabet.invFun output) counter []) + (some (boundedFoldDispatchConfiguration computer + (List.map computer.inputAlphabet.invFun output) counter)) + (2 * output.length + 2) := by + have hfirst := boundedFold_drainTrace computer + (List.map computer.outputAlphabet.invFun output) counter [] + simp only [List.append_nil] at hfirst + have hrestore := boundedFold_restoreTrace computer + (List.map computer.outputAlphabet + (List.map computer.outputAlphabet.invFun output).reverse) + [] counter + simp only [List.append_nil] at hrestore + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + ((List.map computer.outputAlphabet.invFun output).length + 1) + ((List.map computer.outputAlphabet + (List.map computer.outputAlphabet.invFun output).reverse).length + 1) + _ _ _ hfirst hrestore + refine { + steps := hfull.steps + evals_in_steps := ?_ + steps_le_m := ?_ + } + · simpa only [Option.bind_eq_bind, FinTM2.step, Equiv.invFun_as_coe, List.map_reverse, + List.map_map, + Function.comp_def, Equiv.apply_symm_apply, List.map_id_fun', id_eq, List.reverse_reverse] + using hfull.evals_in_steps + · have hbudget := hfull.steps_le_m + simp only [List.length_map, List.length_reverse] at hbudget + omega + +private noncomputable def boundedFold_workerExecutionTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (input counter : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (boundedFoldWorkerConfiguration computer counter + (Turing.initList computer.tm + (List.map computer.inputAlphabet.invFun input))) + (some (boundedFoldDrainConfiguration computer + (List.map computer.outputAlphabet.invFun (worker input)) + counter [])) + (computer.time.eval input.length) := by + have hphysical := + GapCVP.TMComposition.evalsToInTimeMapOfStep + computer.tm.step + (boundedDependentRecordFoldMachine computer).step + (boundedFoldWorkerConfiguration computer counter) + (boundedFoldWorkerConfiguration_step computer counter) + (computer.outputsFun input) + simpa only [FinTM2.step, bitEncoding, Equiv.invFun_as_coe, id_eq, + boundedFoldWorkerConfiguration_halt] using + hphysical + +private noncomputable def boundedFoldRunBudget + {worker : List Bool → List Bool} + (computer : BitTM worker) : ℕ → List Bool → ℕ + | 0, _ => 1 + | count + 1, seed => + 1 + computer.time.eval seed.length + + (2 * (worker seed).length + 2) + + boundedFoldRunBudget computer count (worker seed) + +private noncomputable def boundedFold_iterationTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (count : ℕ) (seed : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (boundedFoldDispatchConfiguration computer + (List.map computer.inputAlphabet.invFun seed) + (List.replicate count true)) + (some (Turing.haltList + (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun + ((worker^[count]) seed)))) + (boundedFoldRunBudget computer count seed) := by + induction count generalizing seed with + | zero => + change EvalsToInTime + (boundedDependentRecordFoldMachine computer).step + (boundedFoldDispatchConfiguration computer + (List.map computer.inputAlphabet.invFun seed) []) + (some (Turing.haltList + (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun seed))) 1 + exact oneStep _ _ (boundedFold_dispatch_finish computer + (List.map computer.inputAlphabet.invFun seed)) + | succ count ih => + have hdispatch := oneStep _ _ (boundedFold_dispatch_step computer + (List.map computer.inputAlphabet.invFun seed) + (List.replicate count true)) + have hworker := boundedFold_workerExecutionTrace + computer seed (List.replicate count true) + have htransport := boundedFold_outputTransportTrace + computer (worker seed) (List.replicate count true) + have hremaining := ih (worker seed) + have hfirst := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + 1 (computer.time.eval seed.length) + _ _ _ hdispatch hworker + have hsecond := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + (computer.time.eval seed.length + 1) + (2 * (worker seed).length + 2) + _ _ _ hfirst htransport + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + ((2 * (worker seed).length + 2) + + (computer.time.eval seed.length + 1)) + (boundedFoldRunBudget computer count (worker seed)) + _ _ _ hsecond hremaining + refine { + steps := hfull.steps + evals_in_steps := ?_ + steps_le_m := ?_ + } + · simpa only [List.replicate_succ, + Function.iterate_succ_apply] using hfull.evals_in_steps + · have hbudget := hfull.steps_le_m + simp only [boundedFoldRunBudget] + omega + +private noncomputable def boundedFold_validTotalTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (count : ℕ) (seed : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (Turing.initList (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun + (unaryBoundedFoldWord count seed))) + (some (Turing.haltList + (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun + ((worker^[count]) seed)))) + (count + 1 + boundedFoldRunBudget computer count seed) := by + have hscan := boundedFold_validScanTrace + computer count seed [] + simp only [List.append_nil] at hscan + rw [← boundedDependentRecordFoldMachine_init] at hscan + have hrun := boundedFold_iterationTrace computer count seed + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + (count + 1) (boundedFoldRunBudget computer count seed) + _ _ _ hscan hrun + refine { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := ?_ + } + have hbudget := hfull.steps_le_m + omega + +theorem parseUnaryBoundedFold_eq_word + (input : List Bool) (count : ℕ) (seed : List Bool) + (hparse : parseUnaryBoundedFold input = some (count, seed)) : + input = unaryBoundedFoldWord count seed := by + induction input generalizing count seed with + | nil => simp only [parseUnaryBoundedFold, reduceCtorEq] at hparse + | cons marker remaining ih => + cases marker with + | false => + simp only [parseUnaryBoundedFold, Option.some.injEq, Prod.mk.injEq] at hparse + obtain ⟨rfl, rfl⟩ := hparse + rfl + | true => + cases hremaining : parseUnaryBoundedFold remaining with + | none => + simp only [parseUnaryBoundedFold, hremaining, Option.map_none, reduceCtorEq] + at hparse + | some parsed => + obtain ⟨parsedCount, parsedSeed⟩ := parsed + simp only [parseUnaryBoundedFold, hremaining, Option.map_some, Option.some.injEq, + Prod.mk.injEq] at hparse + obtain ⟨rfl, rfl⟩ := hparse + have hexact := ih parsedCount parsedSeed hremaining + simp only [hexact, unaryBoundedFoldWord, List.replicate_succ, List.cons_append] + +private theorem parseUnaryBoundedFold_none_eq_replicate + (input : List Bool) + (hparse : parseUnaryBoundedFold input = none) : + input = List.replicate input.length true := by + induction input with + | nil => rfl + | cons marker remaining ih => + cases marker with + | false => simp only [parseUnaryBoundedFold, reduceCtorEq] at hparse + | true => + have hremaining : + parseUnaryBoundedFold remaining = none := by + cases hcase : parseUnaryBoundedFold remaining with + | none => rfl + | some parsed => + simp only [parseUnaryBoundedFold, hcase, Option.map_some, reduceCtorEq] at hparse + have hexact := ih hremaining + change true :: remaining = + true :: List.replicate remaining.length true + exact congrArg (List.cons true) hexact + +private noncomputable def boundedFold_missingScanTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (count : ℕ) (counter : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (boundedFoldScanConfiguration computer + (List.map computer.inputAlphabet.invFun + (List.replicate count true)) counter) + (some (boundedFoldMalformedConfiguration computer + (List.replicate count true ++ counter))) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Equiv.invFun_as_coe, List.replicate_zero, List.map_nil, + List.nil_append, + zero_add] using oneStep _ _ (boundedFold_scan_missing computer counter) + | succ count ih => + have hfirst := oneStep _ _ (boundedFold_scan_true computer + (List.map computer.inputAlphabet.invFun + (List.replicate count true)) counter) + have hrest := ih (true :: counter) + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + 1 (count + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Equiv.invFun_as_coe, List.replicate_succ, List.map_cons, + List.map_replicate, + List.cons_append, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private noncomputable def boundedFold_malformedTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (count : ℕ) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (boundedFoldMalformedConfiguration computer + (List.replicate count true)) + (some (Turing.haltList + (boundedDependentRecordFoldMachine computer) [])) + (count + 1) := by + induction count with + | zero => + exact oneStep _ _ (boundedFold_malformed_finish computer) + | succ count ih => + have hfirst := oneStep _ _ (boundedFold_malformed_step computer + (List.replicate count true)) + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + 1 (count + 1) _ _ _ hfirst ih + simpa only [FinTM2.step, List.replicate_succ, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] + using hfull + +private noncomputable def boundedFold_malformedTotalTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (count : ℕ) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (Turing.initList (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun + (List.replicate count true))) + (some (Turing.haltList + (boundedDependentRecordFoldMachine computer) [])) + (2 * count + 2) := by + have hscan := boundedFold_missingScanTrace computer count [] + simp only [List.append_nil] at hscan + rw [← boundedDependentRecordFoldMachine_init] at hscan + have hclear := boundedFold_malformedTrace computer count + have hfull := EvalsToInTime.trans (boundedDependentRecordFoldMachine computer).step + (count + 1) (count + 1) _ _ _ hscan hclear + refine { + steps := hfull.steps + evals_in_steps := hfull.evals_in_steps + steps_le_m := ?_ + } + have hbudget := hfull.steps_le_m + omega + +private noncomputable def boundedDependentRecordFoldTimePolynomial + {worker : List Bool → List Bool} + (computer : BitTM worker) + (bound : Polynomial ℕ) : Polynomial ℕ := + Polynomial.X * + (computer.time.comp bound + 2 * bound + 3) + + 2 * Polynomial.X + 5 + +private theorem boundedFoldRunBudget_le + {worker : List Bool → List Bool} + (computer : BitTM worker) + (bound : Polynomial ℕ) + (inputLength count : ℕ) + (seed : List Bool) + (hstates : ∀ stage : ℕ, stage ≤ count → + ((worker^[stage]) seed).length ≤ bound.eval inputLength) : + boundedFoldRunBudget computer count seed ≤ + count * + (computer.time.eval (bound.eval inputLength) + + 2 * bound.eval inputLength + 3) + 1 := by + induction count generalizing seed with + | zero => simp only [boundedFoldRunBudget, zero_mul, zero_add, Std.le_refl] + | succ count ih => + have hseed : seed.length ≤ bound.eval inputLength := by + simpa only [Function.iterate_zero, id_eq] using hstates 0 (by omega) + have htime : + computer.time.eval seed.length ≤ + computer.time.eval (bound.eval inputLength) := + GapCVP.TMComposition.natPolynomial_eval_monotone + computer.time hseed + have houtput : (worker seed).length ≤ + bound.eval inputLength := by + simpa only [Function.iterate_one] using hstates 1 (by omega) + have hremaining : + ∀ stage : ℕ, stage ≤ count → + ((worker^[stage]) (worker seed)).length ≤ + bound.eval inputLength := by + intro stage hstage + simpa only [Function.iterate_succ_apply] using + hstates (stage + 1) (by omega) + have htail := ih (worker seed) hremaining + let cost := + computer.time.eval (bound.eval inputLength) + + 2 * bound.eval inputLength + 3 + have htail' : + boundedFoldRunBudget computer count (worker seed) ≤ + count * cost + 1 := by + simpa only using htail + change + 1 + computer.time.eval seed.length + + (2 * (worker seed).length + 2) + + boundedFoldRunBudget computer count (worker seed) ≤ + (count + 1) * cost + 1 + calc + _ ≤ 1 + computer.time.eval (bound.eval inputLength) + + (2 * bound.eval inputLength + 2) + + (count * cost + 1) := by omega + _ = (count + 1) * cost + 1 := by + dsimp [cost] + ring + +private theorem boundedFold_validTotalBudget_le + {worker : List Bool → List Bool} + (computer : BitTM worker) + (bound : Polynomial ℕ) + (hbounded : PolynomiallyBoundedFoldStates worker bound) + (input : List Bool) (count : ℕ) (seed : List Bool) + (hparse : parseUnaryBoundedFold input = some (count, seed)) : + count + 1 + boundedFoldRunBudget computer count seed ≤ + (boundedDependentRecordFoldTimePolynomial + computer bound).eval input.length := by + have bounded := hbounded + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] at bounded + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hstates := bounded input count seed hparse + have hrun := boundedFoldRunBudget_le computer bound + input.length count seed hstates + let transitionCost := + computer.time.eval (bound.eval input.length) + + 2 * bound.eval input.length + 3 + have hproduct : + count * transitionCost ≤ input.length * transitionCost := + Nat.mul_le_mul_right transitionCost hcount + simp only [boundedDependentRecordFoldTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_comp, Polynomial.eval_X, + Polynomial.eval_ofNat] + change count + 1 + boundedFoldRunBudget computer count seed ≤ + input.length * transitionCost + 2 * input.length + 5 + change boundedFoldRunBudget computer count seed ≤ + count * transitionCost + 1 at hrun + omega + +private theorem boundedFold_malformedTotalBudget_le + {worker : List Bool → List Bool} + (computer : BitTM worker) + (bound : Polynomial ℕ) (inputLength : ℕ) : + 2 * inputLength + 2 ≤ + (boundedDependentRecordFoldTimePolynomial + computer bound).eval inputLength := by + simp only [boundedDependentRecordFoldTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_comp, Polynomial.eval_X, + Polynomial.eval_ofNat] + omega + +private noncomputable def boundedDependentRecordFold_totalTrace + {worker : List Bool → List Bool} + (computer : BitTM worker) + (bound : Polynomial ℕ) + (hbounded : PolynomiallyBoundedFoldStates worker bound) + (input : List Bool) : + EvalsToInTime (boundedDependentRecordFoldMachine computer).step + (Turing.initList (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun input)) + (some (Turing.haltList + (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun + (boundedRecordFoldOutput worker input)))) + ((boundedDependentRecordFoldTimePolynomial + computer bound).eval input.length) := by + cases hparse : parseUnaryBoundedFold input with + | none => + have hinput := parseUnaryBoundedFold_none_eq_replicate + input hparse + have hphysical := boundedFold_malformedTotalTrace + computer input.length + rw [← hinput] at hphysical + have hbudget := boundedFold_malformedTotalBudget_le + computer bound input.length + have htotal := rebound hphysical hbudget + convert htotal using 1 ; + simp [boundedRecordFoldOutput, hparse] ; rfl + | some parsed => + obtain ⟨count, seed⟩ := parsed + have hinput := parseUnaryBoundedFold_eq_word + input count seed hparse + have hphysical := boundedFold_validTotalTrace + computer count seed + rw [← hinput] at hphysical + have hbudget := boundedFold_validTotalBudget_le + computer bound hbounded input count seed hparse + have htotal := rebound hphysical hbudget + simpa only [FinTM2.step, Equiv.invFun_as_coe, boundedRecordFoldOutput, hparse] using htotal + +/-- GapCVP reduction support. -/ +noncomputable def boundedDependentRecordFoldComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) + (bound : Polynomial ℕ) + (hbounded : PolynomiallyBoundedFoldStates worker bound) : + BitTM + (boundedRecordFoldOutput worker) where + tm := boundedDependentRecordFoldMachine computer + inputAlphabet := computer.inputAlphabet + outputAlphabet := computer.inputAlphabet + time := boundedDependentRecordFoldTimePolynomial + computer bound + outputsFun input := by + change EvalsToInTime + (boundedDependentRecordFoldMachine computer).step + (Turing.initList (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun input)) + (some (Turing.haltList + (boundedDependentRecordFoldMachine computer) + (List.map computer.inputAlphabet.invFun + (boundedRecordFoldOutput worker input)))) + ((boundedDependentRecordFoldTimePolynomial + computer bound).eval input.length) + exact boundedDependentRecordFold_totalTrace + computer bound hbounded input + +end OutputBoundedDependentRecordFold + +namespace CNFFlatStructuralRecordWorkerTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.CNFTypedRecordWorkerTM + +/-- GapCVP reduction support. -/ +def flatSignedLiteralDescriptor (literal : Literal) : List Bool := + lengthPrefixedWord (literal.2 :: encodeNat literal.1) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordStep (input : List Bool) : List Bool := + match readLengthPrefixedWord input with + | some (sign :: payload, suffix) => + suffix ++ lengthPrefixedWord payload ++ [sign] + | _ => [] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatLiteralRecordStep_descriptor + (literal : Literal) (suffix : List Bool) : + flatLiteralRecordStep + (flatSignedLiteralDescriptor literal ++ suffix) = + suffix ++ encodeLiteral literal := by + rcases literal with ⟨index, sign⟩ + simp only [flatLiteralRecordStep, flatSignedLiteralDescriptor, readLengthPrefixedWord_append, + List.append_assoc, encodeLiteral] + +/-- GapCVP reduction support. -/ +def flatSignedLiteralDescriptorStream + (literals : List Literal) : List Bool := + literals.flatMap flatSignedLiteralDescriptor + +private theorem flatLiteralRecordStep_length_le (input : List Bool) : + (flatLiteralRecordStep input).length ≤ input.length := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + simp only [flatLiteralRecordStep, readLengthPrefixedWord, readUnaryPrefix_missing, + List.length_nil, + List.length_replicate, zero_le] + | inr witness => + obtain ⟨count, tail, hinput⟩ := witness + subst input + by_cases hlength : count ≤ tail.length + · rw [validInput_reconstruct count tail hlength] + generalize hbody : tail.take count = body + cases body with + | nil => + simp only [flatLiteralRecordStep, readLengthPrefixedWord_append, List.length_nil, + List.length_append, + lengthPrefixedWord_length, mul_zero, zero_add, List.length_drop, zero_le] + | cons sign payload => + simp only [flatLiteralRecordStep, + readLengthPrefixedWord_append, + List.length_append, lengthPrefixedWord_length, + List.length_cons, List.length_nil, List.length_drop] + omega + · simp only [flatLiteralRecordStep, readLengthPrefixedWord, readUnaryPrefix_replicate, + hlength, ↓reduceIte, + List.length_nil, List.length_append, List.length_replicate, List.length_cons, zero_le] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecordStep_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + flatLiteralRecordStep Polynomial.X := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed : seed.length ≤ input.length := + parsedUnaryFold_seed_length_le input count seed hparse + have hiterate : ∀ n : ℕ, + ((flatLiteralRecordStep^[n]) seed).length ≤ seed.length := by + intro n + induction n with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ n ih => + rw [Function.iterate_succ_apply'] + exact (flatLiteralRecordStep_length_le _).trans ih + simpa only [Polynomial.eval_X, ge_iff_le] using (hiterate stage).trans hseed + +/-- Internal support shared across GapCVP continuation modules. -/ +structure FlatLiteralRecordState where + /-- The inspected literal bit, when present. -/ + inspected : Option Bool + /-- The literal sign bit, when present. -/ + sign : Option Bool + deriving Fintype + +private def flatLiteralRecordPeek (stack : Fin 6) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState) : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + .peek stack (fun state bit => { state with inspected := bit }) + (.branch (fun state => state.inspected.isSome) present absent) + +private def flatLiteralRecordPop (stack : Fin 6) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState) : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + .pop stack (fun state _ => state) continuation + +private def flatLiteralRecordPushBit (stack : Fin 6) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState) : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + .push stack (fun state => state.inspected.getD false) continuation + +private def flatLiteralRecordPushConstant (stack : Fin 6) (bit : Bool) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState) : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + .push stack (fun _ => bit) continuation + +private def flatLiteralRecordGoto (phase : Fin 8) : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + .load (fun state => { state with inspected := none }) + (.goto (fun _ => phase)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordPrefixStatement : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + flatLiteralRecordPeek 0 + (.branch (fun state => state.inspected.getD false) + (flatLiteralRecordPop 0 + (flatLiteralRecordPushConstant 1 true + (flatLiteralRecordGoto 0))) + (flatLiteralRecordPop 0 + (flatLiteralRecordGoto 1))) + (flatLiteralRecordGoto 7) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordSignStatement : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + flatLiteralRecordPeek 1 + (flatLiteralRecordPeek 0 + (flatLiteralRecordPop 1 + (flatLiteralRecordPop 0 + (.load (fun state => + { inspected := none, sign := state.inspected }) + (.goto (fun _ => (2 : Fin 8)))))) + (flatLiteralRecordGoto 7)) + (flatLiteralRecordGoto 7) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordPayloadStatement : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + flatLiteralRecordPeek 1 + (flatLiteralRecordPeek 0 + (flatLiteralRecordPop 1 + (flatLiteralRecordPop 0 + (flatLiteralRecordPushBit 2 + (flatLiteralRecordPushConstant 3 true + (flatLiteralRecordGoto 2))))) + (flatLiteralRecordGoto 7)) + (.push 5 (fun state => state.sign.getD false) + (flatLiteralRecordGoto 3)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + flatLiteralRecordPeek 2 + (flatLiteralRecordPop 2 + (flatLiteralRecordPushBit 5 + (flatLiteralRecordGoto 3))) + (flatLiteralRecordPushConstant 5 false + (flatLiteralRecordGoto 4)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordMarkerStatement : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + flatLiteralRecordPeek 3 + (flatLiteralRecordPop 3 + (flatLiteralRecordPushConstant 5 true + (flatLiteralRecordGoto 4))) + (flatLiteralRecordGoto 5) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordSuffixScanStatement : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + flatLiteralRecordPeek 0 + (flatLiteralRecordPop 0 + (flatLiteralRecordPushBit 4 + (flatLiteralRecordGoto 5))) + (flatLiteralRecordGoto 6) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordSuffixRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + flatLiteralRecordPeek 4 + (flatLiteralRecordPop 4 + (flatLiteralRecordPushBit 5 + (flatLiteralRecordGoto 6))) + (.load (fun _ => { inspected := none, sign := none }) .halt) + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordInvalidStatement : + Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 8) FlatLiteralRecordState := + flatLiteralRecordPeek 1 + (flatLiteralRecordPop 1 (flatLiteralRecordGoto 7)) + (flatLiteralRecordPeek 2 + (flatLiteralRecordPop 2 (flatLiteralRecordGoto 7)) + (flatLiteralRecordPeek 3 + (flatLiteralRecordPop 3 (flatLiteralRecordGoto 7)) + (flatLiteralRecordPeek 0 + (flatLiteralRecordPop 0 (flatLiteralRecordGoto 7)) + (.load (fun _ => { inspected := none, sign := none }) + .halt)))) + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev actualFlatLiteralRecordWorker : Turing.FinTM2 where + K := Fin 6 + k₀ := 0 + k₁ := 5 + Γ _ := Bool + Λ := Fin 8 + main := 0 + σ := FlatLiteralRecordState + initialState := { inspected := none, sign := none } + m phase := + if phase = (0 : Fin 8) then flatLiteralRecordPrefixStatement + else if phase = (1 : Fin 8) then flatLiteralRecordSignStatement + else if phase = (2 : Fin 8) then flatLiteralRecordPayloadStatement + else if phase = (3 : Fin 8) then flatLiteralRecordRestoreStatement + else if phase = (4 : Fin 8) then flatLiteralRecordMarkerStatement + else if phase = (5 : Fin 8) then flatLiteralRecordSuffixScanStatement + else if phase = (6 : Fin 8) then flatLiteralRecordSuffixRestoreStatement + else flatLiteralRecordInvalidStatement + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatLiteralRecordConfiguration (phase : Fin 8) + (sign : Option Bool) + (input count reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.Cfg where + l := some phase + var := { inspected := none, sign := sign } + stk := ![input, count, reversed, markers, suffix, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem actualFlatLiteralRecordWorker_init (input : List Bool) : + Turing.initList actualFlatLiteralRecordWorker input = + flatLiteralRecordConfiguration 0 none input [] [] [] [] [] := by + simp only [actualFlatLiteralRecordWorker, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + flatLiteralRecordConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `flatLiteralRecordStepTac` machine-step simplifier. -/ +macro "flatLiteralRecordStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [actualFlatLiteralRecordWorker, + flatLiteralRecordConfiguration, flatLiteralRecordPeek, + flatLiteralRecordPop, flatLiteralRecordPushBit, + flatLiteralRecordPushConstant, flatLiteralRecordGoto, + flatLiteralRecordPrefixStatement, + flatLiteralRecordSignStatement, + flatLiteralRecordPayloadStatement, + flatLiteralRecordRestoreStatement, + flatLiteralRecordMarkerStatement, + flatLiteralRecordSuffixScanStatement, + flatLiteralRecordSuffixRestoreStatement, + flatLiteralRecordInvalidStatement, + Turing.haltList, Turing.FinTM2.step, Turing.TM2.step, + Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_prefix_true + (sign : Option Bool) + (input count reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 0 sign + (true :: input) count reversed markers suffix output) = + some (flatLiteralRecordConfiguration 0 sign input + (true :: count) reversed markers suffix output) := by + flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_prefix_false + (sign : Option Bool) + (input count reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 0 sign + (false :: input) count reversed markers suffix output) = + some (flatLiteralRecordConfiguration 1 sign + input count reversed markers suffix output) := by + flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_prefix_missing + (sign : Option Bool) + (count reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 0 sign + [] count reversed markers suffix output) = + some (flatLiteralRecordConfiguration 7 sign + [] count reversed markers suffix output) := by + flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_sign_step + (oldSign : Option Bool) (sign marker : Bool) + (input count reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 1 oldSign + (sign :: input) (marker :: count) + reversed markers suffix output) = + some (flatLiteralRecordConfiguration 2 (some sign) + input count reversed markers suffix output) := by + cases sign <;> cases marker <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_sign_empty + (sign : Option Bool) + (input reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 1 sign + input [] reversed markers suffix output) = + some (flatLiteralRecordConfiguration 7 sign + input [] reversed markers suffix output) := by + flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_sign_missing + (sign : Option Bool) (marker : Bool) + (count reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 1 sign + [] (marker :: count) reversed markers suffix output) = + some (flatLiteralRecordConfiguration 7 sign + [] (marker :: count) reversed markers suffix output) := by + cases marker <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_payload_step + (sign : Option Bool) (bit marker : Bool) + (input count reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 2 sign + (bit :: input) (marker :: count) + reversed markers suffix output) = + some (flatLiteralRecordConfiguration 2 sign input count + (bit :: reversed) (true :: markers) suffix output) := by + cases bit <;> cases marker <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_payload_finish + (sign : Bool) + (input reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 2 (some sign) + input [] reversed markers suffix output) = + some (flatLiteralRecordConfiguration 3 (some sign) + input [] reversed markers suffix (sign :: output)) := by + cases sign <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_payload_missing + (sign : Option Bool) (marker : Bool) + (count reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 2 sign + [] (marker :: count) reversed markers suffix output) = + some (flatLiteralRecordConfiguration 7 sign + [] (marker :: count) reversed markers suffix output) := by + cases marker <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_restore_step + (sign : Option Bool) (bit : Bool) + (input reversed markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 3 sign + input [] (bit :: reversed) markers suffix output) = + some (flatLiteralRecordConfiguration 3 sign + input [] reversed markers suffix (bit :: output)) := by + cases bit <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_restore_finish + (sign : Option Bool) + (input markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 3 sign + input [] [] markers suffix output) = + some (flatLiteralRecordConfiguration 4 sign + input [] [] markers suffix (false :: output)) := by + flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_marker_step + (sign : Option Bool) (marker : Bool) + (input markers suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 4 sign + input [] [] (marker :: markers) suffix output) = + some (flatLiteralRecordConfiguration 4 sign + input [] [] markers suffix (true :: output)) := by + cases marker <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_marker_finish + (sign : Option Bool) + (input suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 4 sign + input [] [] [] suffix output) = + some (flatLiteralRecordConfiguration 5 sign + input [] [] [] suffix output) := by + flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_suffix_scan_step + (sign : Option Bool) (bit : Bool) + (input suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 5 sign + (bit :: input) [] [] [] suffix output) = + some (flatLiteralRecordConfiguration 5 sign + input [] [] [] (bit :: suffix) output) := by + cases bit <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_suffix_scan_finish + (sign : Option Bool) (suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 5 sign + [] [] [] [] suffix output) = + some (flatLiteralRecordConfiguration 6 sign + [] [] [] [] suffix output) := by + flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_suffix_restore_step + (sign : Option Bool) (bit : Bool) + (suffix output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 6 sign + [] [] [] [] (bit :: suffix) output) = + some (flatLiteralRecordConfiguration 6 sign + [] [] [] [] suffix (bit :: output)) := by + cases bit <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_suffix_restore_finish + (sign : Option Bool) (output : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 6 sign + [] [] [] [] [] output) = + some (Turing.haltList actualFlatLiteralRecordWorker output) := by + flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_invalid_count + (sign : Option Bool) (bit : Bool) + (input count reversed markers : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 7 sign + input (bit :: count) reversed markers [] []) = + some (flatLiteralRecordConfiguration 7 sign + input count reversed markers [] []) := by + cases bit <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_invalid_reversed + (sign : Option Bool) (bit : Bool) + (input reversed markers : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 7 sign + input [] (bit :: reversed) markers [] []) = + some (flatLiteralRecordConfiguration 7 sign + input [] reversed markers [] []) := by + cases bit <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_invalid_markers + (sign : Option Bool) (bit : Bool) + (input markers : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 7 sign + input [] [] (bit :: markers) [] []) = + some (flatLiteralRecordConfiguration 7 sign + input [] [] markers [] []) := by + cases bit <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_invalid_input + (sign : Option Bool) (bit : Bool) (input : List Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 7 sign + (bit :: input) [] [] [] [] []) = + some (flatLiteralRecordConfiguration 7 sign + input [] [] [] [] []) := by + cases bit <;> flatLiteralRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatLiteralRecord_invalid_finish (sign : Option Bool) : + actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 7 sign + [] [] [] [] [] []) = + some (Turing.haltList actualFlatLiteralRecordWorker []) := by + flatLiteralRecordStepTac + +end CNFFlatStructuralRecordWorkerTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part04F.lean b/LeanPool/GapCVP/Part04F.lean new file mode 100644 index 000000000..4829e7192 --- /dev/null +++ b/LeanPool/GapCVP/Part04F.lean @@ -0,0 +1,1801 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part04E + +/-! # GapCVP proof, part 04, continuation 06 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFlatStructuralRecordWorkerTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder + +open GapCVP.OutputBoundedDependentRecordFold GapCVP.CNFTypedRecordWorkerTM + +private def flatLiteralRecord_prefixTrace + (sign : Option Bool) (count : ℕ) + (tail counter reversed markers suffix output : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 0 sign + (List.replicate count true ++ false :: tail) + counter reversed markers suffix output) + (some (flatLiteralRecordConfiguration 1 sign + tail (List.replicate count true ++ counter) + reversed markers suffix output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (flatLiteralRecord_prefix_false sign tail counter reversed markers suffix + output) + | succ count ih => + have hfirst := oneStep _ _ (flatLiteralRecord_prefix_true sign + (List.replicate count true ++ false :: tail) + counter reversed markers suffix output) + have hrest := ih (true :: counter) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest + +private def flatLiteralRecord_missingPrefixTrace + (sign : Option Bool) (count : ℕ) + (counter reversed markers suffix output : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 0 sign + (List.replicate count true) + counter reversed markers suffix output) + (some (flatLiteralRecordConfiguration 7 sign + [] (List.replicate count true ++ counter) + reversed markers suffix output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (flatLiteralRecord_prefix_missing sign counter reversed markers suffix + output) + | succ count ih => + have hfirst := oneStep _ _ (flatLiteralRecord_prefix_true sign + (List.replicate count true) + counter reversed markers suffix output) + have hrest := ih (true :: counter) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest + +private def flatLiteralRecord_payloadTrace + (sign : Bool) (payload input reversed markers suffix output : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 2 (some sign) + (payload ++ input) (List.replicate payload.length true) + reversed markers suffix output) + (some (flatLiteralRecordConfiguration 3 (some sign) + input [] (payload.reverse ++ reversed) + (List.replicate payload.length true ++ markers) + suffix (sign :: output))) + (payload.length + 1) := by + induction payload generalizing reversed markers with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil, + zero_add] using oneStep _ _ (flatLiteralRecord_payload_finish sign input reversed markers + suffix output) + | cons bit payload ih => + have hfirst := oneStep _ _ (flatLiteralRecord_payload_step (some sign) bit true + (payload ++ input) (List.replicate payload.length true) + reversed markers suffix output) + have hrest := ih (bit :: reversed) (true :: markers) + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest + +private def flatLiteralRecord_restoreTrace + (sign : Option Bool) + (input reversed markers suffix output : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 3 sign + input [] reversed markers suffix output) + (some (flatLiteralRecordConfiguration 4 sign + input [] [] markers suffix + (false :: (reversed.reverse ++ output)))) + (reversed.length + 1) := by + induction reversed generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (flatLiteralRecord_restore_finish sign input markers suffix output) + | cons bit reversed ih => + have hfirst := oneStep _ _ (flatLiteralRecord_restore_step sign bit + input reversed markers suffix output) + have hrest := ih (bit :: output) + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest + +private def flatLiteralRecord_markerTrace + (sign : Option Bool) + (input markers suffix output : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 4 sign + input [] [] markers suffix output) + (some (flatLiteralRecordConfiguration 5 sign + input [] [] [] suffix + (List.replicate markers.length true ++ output))) + (markers.length + 1) := by + induction markers generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, + zero_add] using + oneStep _ _ (flatLiteralRecord_marker_finish sign input suffix output) + | cons bit markers ih => + have hfirst := oneStep _ _ (flatLiteralRecord_marker_step sign bit + input markers suffix output) + have hrest := ih (true :: output) + simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, + List.cons_append, Nat.add_assoc, + Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest + +private def flatLiteralRecord_suffixScanTrace + (sign : Option Bool) + (input suffix output : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 5 sign + input [] [] [] suffix output) + (some (flatLiteralRecordConfiguration 6 sign + [] [] [] [] (input.reverse ++ suffix) output)) + (input.length + 1) := by + induction input generalizing suffix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (flatLiteralRecord_suffix_scan_finish sign suffix output) + | cons bit input ih => + have hfirst := oneStep _ _ (flatLiteralRecord_suffix_scan_step sign bit + input suffix output) + have hrest := ih (bit :: suffix) + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest + +private def flatLiteralRecord_suffixRestoreTrace + (sign : Option Bool) (suffix output : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 6 sign + [] [] [] [] suffix output) + (some (Turing.haltList actualFlatLiteralRecordWorker + (suffix.reverse ++ output))) + (suffix.length + 1) := by + induction suffix generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (flatLiteralRecord_suffix_restore_finish sign output) + | cons bit suffix ih => + have hfirst := oneStep _ _ (flatLiteralRecord_suffix_restore_step sign bit suffix output) + have hrest := ih (bit :: output) + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest + +private def flatLiteralRecord_invalidTrace + (sign : Option Bool) + (input count reversed markers : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 7 sign + input count reversed markers [] []) + (some (Turing.haltList actualFlatLiteralRecordWorker [])) + (input.length + count.length + reversed.length + + markers.length + 1) := by + induction count generalizing input reversed markers with + | cons bit count ih => + have hfirst := oneStep _ _ (flatLiteralRecord_invalid_count sign bit + input count reversed markers) + have hrest := ih input reversed markers + exact rebound (EvalsToInTime.trans + actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest) + (by simp only [List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, + add_lt_add_iff_right, + add_lt_add_iff_left, lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction reversed generalizing input markers with + | cons bit reversed ih => + have hfirst := oneStep _ _ (flatLiteralRecord_invalid_reversed sign bit + input reversed markers) + have hrest := ih input markers + exact rebound (EvalsToInTime.trans + actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest) + (by simp only [List.length_nil, add_zero, List.length_cons, add_le_add_iff_right, + Order.add_one_le_iff, + add_lt_add_iff_right, add_lt_add_iff_left, lt_add_iff_pos_right, + Order.lt_one_iff]) + | nil => + induction markers generalizing input with + | cons bit markers ih => + have hfirst := oneStep _ _ (flatLiteralRecord_invalid_markers sign bit input markers) + have hrest := ih input + exact rebound (EvalsToInTime.trans + actualFlatLiteralRecordWorker.step _ _ _ _ _ + hfirst hrest) + (by simp only [List.length_nil, add_zero, List.length_cons, add_le_add_iff_right, + Order.add_one_le_iff, + add_lt_add_iff_left, lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction input with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using + oneStep _ _ (flatLiteralRecord_invalid_finish sign) + | cons bit input ih => + have hfirst := oneStep _ _ (flatLiteralRecord_invalid_input sign bit input) + exact rebound (EvalsToInTime.trans + actualFlatLiteralRecordWorker.step _ _ _ _ _ + hfirst ih) + (by simp only [List.length_nil, add_zero, List.length_cons, Std.le_refl]) + +private def flatLiteralRecord_truncatedPayloadTrace + (sign : Bool) (payload : List Bool) (count : ℕ) + (hshort : payload.length < count) + (reversed markers : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 2 (some sign) + payload (List.replicate count true) + reversed markers [] []) + (some (flatLiteralRecordConfiguration 7 (some sign) + [] (List.replicate (count - payload.length) true) + (payload.reverse ++ reversed) + (List.replicate payload.length true ++ markers) [] [])) + (payload.length + 1) := by + induction payload generalizing count reversed markers with + | nil => + cases count with + | zero => simp only [List.length_nil, lt_self_iff_false] at hshort + | succ count => + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.length_nil, tsub_zero, + List.reverse_nil, + List.nil_append, List.replicate_zero, zero_add] using + oneStep _ _ (flatLiteralRecord_payload_missing (some sign) true (List.replicate count + true) reversed markers [] []) + | cons bit payload ih => + cases count with + | zero => simp only [List.length_cons, not_lt_zero] at hshort + | succ count => + have hcount : payload.length < count := by + simp only [List.length_cons] at hshort + omega + have hfirst := oneStep _ _ (flatLiteralRecord_payload_step (some sign) bit true + payload (List.replicate count true) + reversed markers [] []) + have hrest := ih count hcount + (bit :: reversed) (true :: markers) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.length_cons, + Nat.reduceSubDiff, + List.reverse_cons, List.append_assoc, List.cons_append, List.nil_append, + Nat.add_assoc, Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest + +private def flatLiteralRecord_validTrace + (sign : Bool) (payload suffix : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step (flatLiteralRecordConfiguration 0 none + (lengthPrefixedWord (sign :: payload) ++ suffix) + [] [] [] [] []) + (some (Turing.haltList actualFlatLiteralRecordWorker + (suffix ++ lengthPrefixedWord payload ++ [sign]))) + (8 * (lengthPrefixedWord (sign :: payload) ++ suffix).length + + 16) := by + have hprefix := flatLiteralRecord_prefixTrace + none (payload.length + 1) + (sign :: (payload ++ suffix)) [] [] [] [] [] + simp only [List.append_nil, List.replicate_succ] at hprefix + have hsign := oneStep _ _ (flatLiteralRecord_sign_step none sign true + (payload ++ suffix) + (List.replicate payload.length true) [] [] [] []) + have hpayload := flatLiteralRecord_payloadTrace + sign payload suffix [] [] [] [] + simp only [List.append_nil] at hpayload + have hrestore := flatLiteralRecord_restoreTrace + (some sign) suffix payload.reverse + (List.replicate payload.length true) [] [sign] + simp only [List.reverse_reverse] at hrestore + have hmarkers := flatLiteralRecord_markerTrace + (some sign) suffix (List.replicate payload.length true) + [] (false :: (payload ++ [sign])) + simp only [List.length_replicate] at hmarkers + have hsuffixScan := flatLiteralRecord_suffixScanTrace + (some sign) suffix [] + (List.replicate payload.length true ++ + false :: (payload ++ [sign])) + simp only [List.append_nil] at hsuffixScan + have hsuffixRestore := flatLiteralRecord_suffixRestoreTrace + (some sign) suffix.reverse + (List.replicate payload.length true ++ + false :: (payload ++ [sign])) + simp only [List.reverse_reverse, List.length_reverse] at hsuffixRestore + have hprefixSign := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefix hsign + have hprefixPayload := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefixSign hpayload + have hprefixRestore := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefixPayload hrestore + have hprefixMarkers := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefixRestore hmarkers + have hprefixSuffix := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefixMarkers hsuffixScan + have hfull := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefixSuffix hsuffixRestore + have hbounded := rebound (newBudget := + 8 * (lengthPrefixedWord (sign :: payload) ++ suffix).length + + 16) hfull (by + simp only [List.length_reverse, lengthPrefixedWord, List.length_cons, List.append_assoc, + List.cons_append, + List.length_append, List.length_replicate] + omega) + simpa only [FinTM2.step, Fin.isValue, lengthPrefixedWord, List.length_cons, List.replicate_succ, + List.cons_append, List.append_assoc, List.length_append, List.length_replicate] + using hbounded + +private def flatLiteralRecord_totalTrace (input : List Bool) : + EvalsToInTime actualFlatLiteralRecordWorker.step + (flatLiteralRecordConfiguration 0 none input [] [] [] [] []) + (some (Turing.haltList actualFlatLiteralRecordWorker + (flatLiteralRecordStep input))) + (20 * input.length + 30) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + have hprefix := flatLiteralRecord_missingPrefixTrace + none count [] [] [] [] [] + simp only [List.append_nil] at hprefix + have hclean := flatLiteralRecord_invalidTrace + none [] (List.replicate count true) [] [] + have hfull := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefix hclean + have hbounded := rebound (newBudget := + 20 * (List.replicate count true).length + 30) + hfull (by simp only [List.length_nil, List.length_replicate, zero_add, add_zero]; omega) + simpa only [FinTM2.step, Fin.isValue, flatLiteralRecordStep, readLengthPrefixedWord, + readUnaryPrefix_missing, + List.length_replicate] using hbounded + | inr witness => + obtain ⟨count, tail, hinput⟩ := witness + subst input + cases count with + | zero => + have hprefix := flatLiteralRecord_prefixTrace + none 0 tail [] [] [] [] [] + have hsign := oneStep _ _ (flatLiteralRecord_sign_empty none tail [] [] [] []) + have hclean := flatLiteralRecord_invalidTrace + none tail [] [] [] + have hfirst := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefix hsign + have hfull := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hfirst hclean + have hbounded := rebound (newBudget := + 20 * (List.replicate 0 true ++ false :: tail).length + + 30) + hfull (by simp only [List.length_nil, add_zero, zero_add, Nat.reduceAdd, + List.replicate_zero, List.nil_append, + List.length_cons, add_le_add_iff_right]; omega) + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, + flatLiteralRecordStep, + readLengthPrefixedWord, readUnaryPrefix, zero_le, ↓reduceIte, List.take_zero, + List.drop_zero, + List.length_cons] using hbounded + | succ count => + cases tail with + | nil => + have hprefix := flatLiteralRecord_prefixTrace + none (count + 1) [] [] [] [] [] [] + simp only [List.append_nil, + List.replicate_succ] at hprefix + have hsign := oneStep _ _ (flatLiteralRecord_sign_missing none true + (List.replicate count true) [] [] [] []) + have hclean := flatLiteralRecord_invalidTrace + none [] (true :: List.replicate count true) [] [] + have hfirst := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefix hsign + have hfull := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hfirst hclean + have hbounded := rebound (newBudget := + 20 * (List.replicate (count + 1) true ++ + [false]).length + 30) + hfull (by simp only [List.length_nil, List.length_cons, List.length_replicate, + zero_add, add_zero, List.length_append]; omega) + have hempty : + flatLiteralRecordStep + (List.replicate (count + 1) true ++ [false]) = [] := by + simp only [flatLiteralRecordStep, readLengthPrefixedWord, + readUnaryPrefix_replicate, List.length_nil, + nonpos_iff_eq_zero, Nat.add_eq_zero_iff, one_ne_zero, and_false, ↓reduceIte] + rw [hempty] + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, + List.length_cons, + List.length_append, List.length_replicate, List.length_nil, zero_add] + using hbounded + | cons sign tail => + by_cases hlength : count ≤ tail.length + · have houter : + count + 1 ≤ (sign :: tail).length := by + simp only [List.length_cons] + omega + have hshape := validInput_reconstruct + (count + 1) (sign :: tail) houter + have hshape' : + List.replicate (count + 1) true ++ + false :: sign :: tail = + lengthPrefixedWord + (sign :: tail.take count) ++ + tail.drop count := by + simpa only [List.take_succ_cons, List.drop_succ_cons] using hshape + rw [hshape'] + have hvalid := flatLiteralRecord_validTrace + sign (tail.take count) (tail.drop count) + have hbounded := rebound (newBudget := + 20 * (lengthPrefixedWord + (sign :: tail.take count) ++ + tail.drop count).length + 30) + hvalid (by omega) + simpa only [FinTM2.step, Fin.isValue, flatLiteralRecordStep, + readLengthPrefixedWord_append, List.append_assoc, + List.length_append, lengthPrefixedWord_length, List.length_cons, + List.length_take, List.length_drop] using hbounded + · have hshort : tail.length < count := by omega + have hprefix := flatLiteralRecord_prefixTrace + none (count + 1) (sign :: tail) + [] [] [] [] [] + simp only [List.append_nil, + List.replicate_succ] at hprefix + have hsign := oneStep _ _ (flatLiteralRecord_sign_step none sign true + tail (List.replicate count true) + [] [] [] []) + have htruncated := + flatLiteralRecord_truncatedPayloadTrace + sign tail count hshort [] [] + simp only [List.append_nil] at htruncated + have hclean := flatLiteralRecord_invalidTrace + (some sign) [] + (List.replicate (count - tail.length) true) + tail.reverse + (List.replicate tail.length true) + have hfirst := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hprefix hsign + have hsecond := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hfirst htruncated + have hfull := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ + hsecond hclean + have hbounded := rebound (newBudget := + 20 * (List.replicate (count + 1) true ++ + false :: sign :: tail).length + 30) + hfull (by + simp only [List.length_nil, List.length_replicate, zero_add, + List.length_reverse, List.length_append, + List.length_cons] + omega) + have hempty : + flatLiteralRecordStep + (List.replicate (count + 1) true ++ + false :: sign :: tail) = [] := by + simp only [flatLiteralRecordStep, readLengthPrefixedWord, + readUnaryPrefix_replicate, List.length_cons, + add_le_add_iff_right, hlength, ↓reduceIte] + rw [hempty] + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, + List.length_cons, + List.length_append, List.length_replicate] using hbounded + +private noncomputable def actualFlatLiteralRecordWorkerComputable : + BitTM + flatLiteralRecordStep where + tm := actualFlatLiteralRecordWorker + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 20 * Polynomial.X + 30 + outputsFun input := { + steps := (flatLiteralRecord_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, actualFlatLiteralRecordWorker_init, + Option.map_some] using + (flatLiteralRecord_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (flatLiteralRecord_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +private noncomputable def actualFlatLiteralRecordFoldComputable : + BitTM + (boundedRecordFoldOutput flatLiteralRecordStep) := + boundedDependentRecordFoldComputable + actualFlatLiteralRecordWorkerComputable + Polynomial.X + flatLiteralRecordStep_polynomiallyBoundedFoldStates + +/-- GapCVP reduction support. -/ +def flatThreeClauseLiterals (clauses : ThreeCNF) : List Literal := + clauses.flatMap (fun clause => [clause 0, clause 1, clause 2]) + +@[simp] private theorem flatThreeClauseLiterals_length + (clauses : ThreeCNF) : + (flatThreeClauseLiterals clauses).length = 3 * clauses.length := by + induction clauses with + | nil => simp only [flatThreeClauseLiterals, Fin.isValue, List.flatMap_nil, List.length_nil, + mul_zero] + | cons clause remaining ih => + simp only [flatThreeClauseLiterals, Fin.isValue, List.length_flatMap, List.length_cons, + List.length_nil, + zero_add, Nat.reduceAdd, List.map_const', List.sum_replicate, smul_eq_mul, + List.flatMap_cons, List.cons_append, + List.nil_append] at ih ⊢ + omega + +private theorem flatThreeClauseLiterals_encoded + (clauses : ThreeCNF) : + (flatThreeClauseLiterals clauses).flatMap encodeLiteral = + clauses.flatMap encodeThreeClause := by + induction clauses with + | nil => simp only [flatThreeClauseLiterals, Fin.isValue, List.flatMap_nil] + | cons clause remaining ih => + simpa only [flatThreeClauseLiterals, Fin.isValue, List.flatMap_cons, List.cons_append, + List.nil_append, + encodeThreeClause, List.append_assoc, List.append_cancel_left_eq] using ih + +end CNFFlatStructuralRecordWorkerTM + +namespace CNFFlatSourceOrder + +open GapCVP.ThreeCNFReduction GapCVP.CNFEncodedClauseSort + +private def flatSourceListValue : List ℕ → ℕ + | [] => 0 + | head :: tail => Nat.succ (Nat.pair head (flatSourceListValue tail)) + +private theorem flatSourceListValue_map_encode + {α : Type} [Encodable α] (records : List α) : + flatSourceListValue (records.map Encodable.encode) = + Encodable.encode records := by + induction records with + | nil => rfl + | cons head tail ih => + simp only [List.map_cons, flatSourceListValue, ih, Nat.succ_eq_add_one, + Encodable.encode_list_cons] + +/-- GapCVP reduction support. -/ +def cappedFlatSourceListValue (cap : ℕ) : List ℕ → ℕ + | [] => 0 + | head :: tail => + min cap + (Nat.succ + (Nat.pair head (cappedFlatSourceListValue cap tail))) + +private theorem cappedFlatSourceListValue_eq_min + (cap : ℕ) (records : List ℕ) : + cappedFlatSourceListValue cap records = + min cap (flatSourceListValue records) := by + induction records with + | nil => simp only [cappedFlatSourceListValue, flatSourceListValue, zero_le, inf_of_le_right] + | cons head tail ih => + simp only [cappedFlatSourceListValue, flatSourceListValue, ih] + by_cases hcap : cap ≤ flatSourceListValue tail + · have hleft : + cap ≤ Nat.succ (Nat.pair head cap) := + (Nat.right_le_pair head cap).trans (Nat.le_succ _) + have hright : + cap ≤ Nat.succ + (Nat.pair head (flatSourceListValue tail)) := + hcap.trans + ((Nat.right_le_pair head (flatSourceListValue tail)).trans + (Nat.le_succ _)) + simp only [Nat.min_eq_left hcap, Nat.succ_eq_add_one, Nat.min_eq_left hleft, + Nat.min_eq_left hright] + · have hle : flatSourceListValue tail ≤ cap := + Nat.le_of_lt (Nat.lt_of_not_ge hcap) + simp only [Nat.min_eq_right hle, Nat.succ_eq_add_one] + +/-- GapCVP reduction support. -/ +def flatSourceNaturalOrdering (first second : ℕ) : EncodedWordOrdering := + if first < second then .less + else if second < first then .greater + else .equal + +private theorem flatSourceNaturalOrdering_capped_right + (literal : ℕ) (records : List ℕ) : + flatSourceNaturalOrdering literal + (cappedFlatSourceListValue (literal + 1) records) = + flatSourceNaturalOrdering literal + (flatSourceListValue records) := by + rw [cappedFlatSourceListValue_eq_min] + by_cases hvalue : flatSourceListValue records ≤ literal + · have hcap : + min (literal + 1) (flatSourceListValue records) = + flatSourceListValue records := + Nat.min_eq_right (by omega) + rw [hcap] + · have hlt : literal < flatSourceListValue records := by omega + have hcap : + min (literal + 1) (flatSourceListValue records) = literal + 1 := + Nat.min_eq_left (by omega) + rw [hcap] + simp only [flatSourceNaturalOrdering, lt_add_iff_pos_right, Order.lt_one_iff, ↓reduceIte, hlt] + +private theorem flatSourceNaturalOrdering_capped_left + (records : List ℕ) (literal : ℕ) : + flatSourceNaturalOrdering + (cappedFlatSourceListValue (literal + 1) records) literal = + flatSourceNaturalOrdering + (flatSourceListValue records) literal := by + rw [cappedFlatSourceListValue_eq_min] + by_cases hvalue : flatSourceListValue records ≤ literal + · have hcap : + min (literal + 1) (flatSourceListValue records) = + flatSourceListValue records := + Nat.min_eq_right (by omega) + rw [hcap] + · have hlt : literal < flatSourceListValue records := by omega + have hcap : + min (literal + 1) (flatSourceListValue records) = literal + 1 := + Nat.min_eq_left (by omega) + rw [hcap] + simp only [flatSourceNaturalOrdering, add_lt_iff_neg_left, not_lt_zero, ↓reduceIte, + lt_add_iff_pos_right, + Order.lt_one_iff, hlt, right_eq_ite_iff, reduceCtorEq, imp_false, not_lt, Nat.le_of_lt hlt] + +/-- GapCVP reduction support. -/ +def resolveFlatSourceOrder + (major : EncodedWordOrdering) (first second : ℕ) : + EncodedWordOrdering := + match major with + | .equal => flatSourceNaturalOrdering first second + | other => other + +private theorem flatSourceSquareBlock_lt + {firstMajor secondMajor firstOffset secondOffset : ℕ} + (hfirst : firstOffset ≤ firstMajor) + (_hsecond : secondOffset ≤ secondMajor) + (hmajor : firstMajor < secondMajor) : + firstMajor ^ 2 + firstOffset + 1 < + secondMajor ^ 2 + secondOffset + 1 := by + have hstep : firstMajor + 1 ≤ secondMajor := by omega + have hsquare := Nat.mul_self_le_mul_self hstep + linarith + +private theorem flatSourceSquareBlock_ordering + (firstMajor secondMajor firstOffset secondOffset : ℕ) + (hfirst : firstOffset ≤ firstMajor) + (hsecond : secondOffset ≤ secondMajor) : + flatSourceNaturalOrdering + (firstMajor ^ 2 + firstOffset + 1) + (secondMajor ^ 2 + secondOffset + 1) = + resolveFlatSourceOrder + (flatSourceNaturalOrdering firstMajor secondMajor) + firstOffset secondOffset := by + rcases lt_trichotomy firstMajor secondMajor with hmajor | hmajor | hmajor + · have hvalue := flatSourceSquareBlock_lt hfirst hsecond hmajor + simp only [flatSourceNaturalOrdering, hvalue, ↓reduceIte, resolveFlatSourceOrder, hmajor] + · subst secondMajor + simp only [flatSourceNaturalOrdering, Order.lt_add_one_iff, Order.add_one_le_iff, + add_lt_add_iff_left, + resolveFlatSourceOrder, lt_self_iff_false, ↓reduceIte] + · have hvalue := flatSourceSquareBlock_lt hsecond hfirst hmajor + simp only [flatSourceNaturalOrdering, Nat.not_lt_of_gt hvalue, ↓reduceIte, hvalue, + resolveFlatSourceOrder, + Nat.not_lt_of_gt hmajor, hmajor] + +private def flatSourceListMajor (head : ℕ) : List ℕ → ℕ + | [] => head + | next :: tail => flatSourceListValue (next :: tail) + +private theorem flatSourceList_head_le_major + (head : ℕ) (tail : List ℕ) + (hsorted : (head :: tail).Pairwise (· ≤ ·)) : + head ≤ flatSourceListMajor head tail := by + cases tail with + | nil => simp only [flatSourceListMajor, Std.le_refl] + | cons next remaining => + have hnext : head ≤ next := + (List.pairwise_cons.mp hsorted).1 next (by simp only [List.mem_cons, true_or]) + have hp := Nat.left_le_pair next + (flatSourceListValue remaining) + simp only [flatSourceListMajor, flatSourceListValue] + omega + +private theorem flatSourceListValue_cons_eq_square + (head : ℕ) (tail : List ℕ) + (hsorted : (head :: tail).Pairwise (· ≤ ·)) : + flatSourceListValue (head :: tail) = + (flatSourceListMajor head tail) ^ 2 + head + 1 := by + cases tail with + | nil => + simp only [flatSourceListValue, Nat.pair, not_lt_zero, ↓reduceIte, add_zero, + Nat.succ_eq_add_one, + flatSourceListMajor, pow_two] + | cons next remaining => + have hnext : head ≤ next := + (List.pairwise_cons.mp hsorted).1 next (by simp only [List.mem_cons, true_or]) + have hp := Nat.left_le_pair next + (flatSourceListValue remaining) + have hlt : head < flatSourceListValue (next :: remaining) := by + simp only [flatSourceListValue] + omega + simp only [flatSourceListMajor] + change + Nat.succ + (Nat.pair head (flatSourceListValue (next :: remaining))) = + (flatSourceListValue (next :: remaining)) ^ 2 + head + 1 + rw [Nat.pair, ite_eq_left hlt, pow_two] + +/-- GapCVP reduction support. -/ +def flatSortedSourceListOrdering : + List ℕ → List ℕ → EncodedWordOrdering + | [], [] => .equal + | [], _ :: _ => .less + | _ :: _, [] => .greater + | [head₁], [head₂] => + resolveFlatSourceOrder + (flatSourceNaturalOrdering head₁ head₂) + head₁ head₂ + | [head₁], head₂ :: next₂ :: tail₂ => + resolveFlatSourceOrder + (flatSourceNaturalOrdering head₁ + (cappedFlatSourceListValue (head₁ + 1) (next₂ :: tail₂))) + head₁ head₂ + | head₁ :: next₁ :: tail₁, [head₂] => + resolveFlatSourceOrder + (flatSourceNaturalOrdering + (cappedFlatSourceListValue (head₂ + 1) (next₁ :: tail₁)) + head₂) + head₁ head₂ + | head₁ :: next₁ :: tail₁, head₂ :: next₂ :: tail₂ => + resolveFlatSourceOrder + (flatSortedSourceListOrdering + (next₁ :: tail₁) (next₂ :: tail₂)) + head₁ head₂ +termination_by first second => first.length + second.length +decreasing_by simp_wf; omega + +private theorem flatSortedSourceListOrdering_eq_godel + (first second : List ℕ) + (hfirst : first.Pairwise (· ≤ ·)) + (hsecond : second.Pairwise (· ≤ ·)) : + flatSortedSourceListOrdering first second = + flatSourceNaturalOrdering + (flatSourceListValue first) (flatSourceListValue second) := by + induction first generalizing second with + | nil => + cases second with + | nil => + simp only [flatSortedSourceListOrdering, flatSourceNaturalOrdering, flatSourceListValue, + lt_self_iff_false, + ↓reduceIte] + | cons head tail => + simp only [flatSortedSourceListOrdering, flatSourceNaturalOrdering, flatSourceListValue, + Nat.succ_eq_add_one, + lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le, ↓reduceIte] + | cons firstHead firstTail ih => + cases second with + | nil => + simp only [flatSortedSourceListOrdering, flatSourceNaturalOrdering, flatSourceListValue, + Nat.succ_eq_add_one, + not_lt_zero, ↓reduceIte, lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le] + | cons secondHead secondTail => + have hfirstMajor := flatSourceList_head_le_major + firstHead firstTail hfirst + have hsecondMajor := flatSourceList_head_le_major + secondHead secondTail hsecond + rw [flatSourceListValue_cons_eq_square + firstHead firstTail hfirst, + flatSourceListValue_cons_eq_square + secondHead secondTail hsecond] + rw [flatSourceSquareBlock_ordering _ _ _ _ + hfirstMajor hsecondMajor] + cases firstTail with + | nil => + cases secondTail with + | nil => + simp only [flatSortedSourceListOrdering, flatSourceListMajor] + | cons next tail => + simp only [flatSortedSourceListOrdering, flatSourceNaturalOrdering_capped_right, + flatSourceListMajor] + | cons next tail => + cases secondTail with + | nil => + simp only [flatSortedSourceListOrdering, flatSourceNaturalOrdering_capped_left, + flatSourceListMajor] + | cons other remaining => + have hfirstTail : + (next :: tail).Pairwise (· ≤ ·) := + (List.pairwise_cons.mp hfirst).2 + have hsecondTail : + (other :: remaining).Pairwise (· ≤ ·) := + (List.pairwise_cons.mp hsecond).2 + simp only [flatSortedSourceListOrdering, + flatSourceListMajor] + rw [ih (other :: remaining) + hfirstTail hsecondTail] + +/-- GapCVP reduction support. -/ +def flatSourceFinsetCodes + {α : Type} [Encodable α] (records : Finset α) : List ℕ := + (sortedElements records).map Encodable.encode + +private theorem flatSourceFinsetCodes_value + {α : Type} [Encodable α] (records : Finset α) : + flatSourceListValue (flatSourceFinsetCodes records) = + Encodable.encode records := by + change + flatSourceListValue + ((sortedElements records).map Encodable.encode) = + Encodable.encode records + rw [flatSourceListValue_map_encode] + rfl + +private theorem flatSourceFinsetCodes_pairwise + {α : Type} [Encodable α] (records : Finset α) : + (flatSourceFinsetCodes records).Pairwise (· ≤ ·) := by + let : IsTrans α + (fun first second : α => + Encodable.encode first ≤ Encodable.encode second) := + ⟨fun _ _ _ hfirst hsecond => Nat.le_trans hfirst hsecond⟩ + let : Std.Antisymm + (fun first second : α => + Encodable.encode first ≤ Encodable.encode second) := + ⟨fun _ _ hfirst hsecond => + Encodable.encode_injective (Nat.le_antisymm hfirst hsecond)⟩ + let : Std.Total + (fun first second : α => + Encodable.encode first ≤ Encodable.encode second) := + ⟨fun _ _ => Nat.le_total _ _⟩ + simp only [flatSourceFinsetCodes, sortedElements, List.pairwise_map, Finset.pairwise_sort] + +theorem flatSourceFinsetOrdering_eq_godel + {α : Type} [Encodable α] (first second : Finset α) : + flatSortedSourceListOrdering + (flatSourceFinsetCodes first) + (flatSourceFinsetCodes second) = + flatSourceNaturalOrdering + (Encodable.encode first) (Encodable.encode second) := by + rw [flatSortedSourceListOrdering_eq_godel + (flatSourceFinsetCodes first) (flatSourceFinsetCodes second) + (flatSourceFinsetCodes_pairwise first) + (flatSourceFinsetCodes_pairwise second), + flatSourceFinsetCodes_value, flatSourceFinsetCodes_value] + +theorem flatSourceFinsetOrdering_equal_iff + {α : Type} [Encodable α] (first second : Finset α) : + flatSortedSourceListOrdering + (flatSourceFinsetCodes first) + (flatSourceFinsetCodes second) = .equal ↔ first = second := by + rw [flatSourceFinsetOrdering_eq_godel] + constructor + · intro horder + have hcode : Encodable.encode first = Encodable.encode second := by + by_cases hless : Encodable.encode first < Encodable.encode second + · simp only [flatSourceNaturalOrdering, hless, ↓reduceIte, reduceCtorEq] at horder + · by_cases hgreater : + Encodable.encode second < Encodable.encode first + · simp only [flatSourceNaturalOrdering, hless, ↓reduceIte, hgreater, reduceCtorEq] + at horder + · exact Nat.le_antisymm + (Nat.le_of_not_gt hgreater) (Nat.le_of_not_gt hless) + exact Encodable.encode_injective hcode + · intro hrecords + subst second + simp only [flatSourceNaturalOrdering, lt_self_iff_false, ↓reduceIte] + +end CNFFlatSourceOrder + +namespace CNFFlatWholeWordFoldTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction +open GapCVP.CLStructuralWholeCNFOutputTM GapCVP.CNFFiniteRecordSort +open GapCVP.CNFBoundedRecordFoldTM GapCVP.CNFFlatStructuralRecordWorkerTM +open GapCVP.OutputBoundedDependentRecordFold + +private theorem flatLiteralRecordStep_iterate_preservedSuffix + (pending : List Literal) (suffix : List Bool) : + ((flatLiteralRecordStep^[pending.length]) + (flatSignedLiteralDescriptorStream pending ++ suffix)) = + suffix ++ pending.flatMap encodeLiteral := by + induction pending generalizing suffix with + | nil => simp only [List.length_nil, flatSignedLiteralDescriptorStream, List.flatMap_nil, + List.nil_append, + Function.iterate_zero, id_eq, List.append_nil] + | cons literal remaining ih => + rw [List.length_cons, Function.iterate_succ_apply] + simp only [flatSignedLiteralDescriptorStream, + List.flatMap_cons, List.append_assoc] + rw [flatLiteralRecordStep_descriptor] + simpa only [List.append_assoc, flatSignedLiteralDescriptorStream] using ih (suffix ++ + encodeLiteral literal) + +/-- GapCVP reduction support. -/ +def structuralThreeCNFFlatFoldInput + (clauses : ThreeCNF) : List Bool := + unaryBoundedFoldWord (3 * clauses.length) + (flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals clauses) ++ + lengthPrefixedWord (encodeNat clauses.length)) + +private theorem boundedRecordFoldOutput_structuralThreeCNF + (clauses : ThreeCNF) : + boundedRecordFoldOutput flatLiteralRecordStep + (structuralThreeCNFFlatFoldInput clauses) = + encodeThreeCNF clauses := by + simp only [structuralThreeCNFFlatFoldInput, + boundedRecordFoldOutput, parseUnaryBoundedFold_word] + rw [← flatThreeClauseLiterals_length] + rw [flatLiteralRecordStep_iterate_preservedSuffix] + rw [flatThreeClauseLiterals_encoded] + rfl + +/-- GapCVP reduction support. -/ +def totalVerifierSortedFiveFamilyFlatFoldInput + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + structuralThreeCNFFlatFoldInput + (encodeFormulaFrom 0 + (sourceOrderedDistinctRecords + (totalVerifierFiveFamilySourceClauseCandidates + bound machine input))) + +private theorem boundedRecordFoldOutput_totalVerifierSortedFiveFamilies + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : + boundedRecordFoldOutput flatLiteralRecordStep + (totalVerifierSortedFiveFamilyFlatFoldInput + bound machine input) = + structuralWholeCNFWord bound machine input := by + unfold totalVerifierSortedFiveFamilyFlatFoldInput + rw [boundedRecordFoldOutput_structuralThreeCNF] + exact encodeThreeCNF_totalVerifierFiveFamilies + bound machine input + +/-- GapCVP reduction support. -/ +noncomputable def actualWholeStructuralCNFOutputComputableOfFlatPreparation + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (preparation : BitTM + (totalVerifierSortedFiveFamilyFlatFoldInput bound machine)) : + BitTM + (structuralWholeCNFWord bound machine) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + preparation actualFlatLiteralRecordFoldComputable + have hequality : + (fun input : List Bool => + boundedRecordFoldOutput flatLiteralRecordStep + (totalVerifierSortedFiveFamilyFlatFoldInput + bound machine input)) = + structuralWholeCNFWord bound machine := by + funext input + exact boundedRecordFoldOutput_totalVerifierSortedFiveFamilies + bound machine input + rw [← hequality] + simpa only [Function.comp_def] using hphysical + +end CNFFlatWholeWordFoldTM + +namespace CNFFlatSourceOrderPolynomialBounds + +open GapCVP.CL GapCVP.CLStructuralCNFVariableBounds GapCVP.CNFFlatSourceOrder + +/-- GapCVP reduction support. -/ +def tableauSignedLiteralCodeBound (time symbols : ℕ) : ℕ := + (tableauFiniteVariableCodeBound time symbols + 2) ^ 2 + +private theorem tableauSignedLiteral_encode_lt + {time symbols : ℕ} (literal : SignedLiteral time symbols) : + Encodable.encode literal < + tableauSignedLiteralCodeBound time symbols := by + obtain ⟨atom, sign⟩ := literal + have hvariable := tableauVariable_encode_lt atom + have hsign : Encodable.encode sign ≤ 1 := by + cases sign <;> simp + change Nat.pair (Encodable.encode atom) (Encodable.encode sign) < + tableauSignedLiteralCodeBound time symbols + calc + Nat.pair (Encodable.encode atom) (Encodable.encode sign) < + (max (Encodable.encode atom) (Encodable.encode sign) + 1) ^ 2 := + Nat.pair_lt_max_add_one_sq _ _ + _ ≤ (tableauFiniteVariableCodeBound time symbols + 2) ^ 2 := by + apply Nat.pow_le_pow_left + omega + +theorem flatSourceClauseLiteralCode_lt + {time symbols : ℕ} (clause : Clause time symbols) + (code : ℕ) (hcode : code ∈ flatSourceFinsetCodes clause) : + code < tableauSignedLiteralCodeBound time symbols := by + obtain ⟨literal, _, rfl⟩ := + List.mem_map.mp hcode + exact tableauSignedLiteral_encode_lt literal + +end CNFFlatSourceOrderPolynomialBounds + +namespace CNFFlatSourceGridDescriptorTM + +open Computability Turing GapCVP.CL GapCVP.ThreeCNFReduction GapCVP.BinaryEncoding +open GapCVP.CLStructuralPrefixWriter GapCVP.CLStructuralNaturalBinaryWriter +open GapCVP.SourceMachineCert GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatStructuralRecordWorkerTM + +/-- GapCVP reduction support. -/ +def polynomialSignedLiteralDescriptorWord + (polynomial : Polynomial ℕ) (sign : Bool) + (input : List Bool) : List Bool := + lengthPrefixedWord + (sign :: encodeNat (polynomial.eval input.length)) + +private noncomputable def polynomialSignedLiteralDescriptorComputable + (polynomial : Polynomial ℕ) (sign : Bool) : + BitTM + (polynomialSignedLiteralDescriptorWord polynomial sign) := by + have hunary := polynomialValueUnaryComputable polynomial + have hbinary := GapCVP.TMComposition.computableInPolyTime + hunary structuralNaturalBinaryWriterComputable + have hsign := GapCVP.TMComposition.computableInPolyTime + hbinary (prependBitComputable sign) + have hprefix := GapCVP.TMComposition.computableInPolyTime + hsign structuralPrefixWriterComputable + change BitTM + (fun input : List Bool => + lengthPrefixedWord + (sign :: encodeNat (polynomial.eval input.length))) + simpa only [Function.comp_def, List.length_replicate] using hprefix + +/-- GapCVP reduction support. -/ +def tableauSourceSignedLiteralDescriptorWord + (sign : Bool) : List Bool → List Bool := + polynomialSignedLiteralDescriptorWord (4 * Polynomial.X) sign + +/-- GapCVP reduction support. -/ +noncomputable def tableauSourceSignedLiteralDescriptorComputable + (sign : Bool) : + BitTM + (tableauSourceSignedLiteralDescriptorWord sign) := + polynomialSignedLiteralDescriptorComputable + (4 * Polynomial.X) sign + +@[simp] theorem tableauSourceSignedLiteralDescriptorWord_variable + {T S : ℕ} (sourceVar : Variable T S) (sign : Bool) : + tableauSourceSignedLiteralDescriptorWord sign + (List.replicate (Encodable.encode sourceVar) true) = + flatSignedLiteralDescriptor + (sourceVariable sourceVar, sign) := by + simp only [tableauSourceSignedLiteralDescriptorWord, polynomialSignedLiteralDescriptorWord, + List.length_replicate, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, + flatSignedLiteralDescriptor, + sourceVariable] + +/-- GapCVP reduction support. -/ +def accumulatorSignedLiteralDescriptorWord + (sign : Bool) : List Bool → List Bool := + polynomialSignedLiteralDescriptorWord + (4 * Polynomial.X + 1) sign + +/-- GapCVP reduction support. -/ +noncomputable def accumulatorSignedLiteralDescriptorComputable + (sign : Bool) : + BitTM + (accumulatorSignedLiteralDescriptorWord sign) := + polynomialSignedLiteralDescriptorComputable + (4 * Polynomial.X + 1) sign + +@[simp] theorem accumulatorSignedLiteralDescriptorWord_index + (clauseIndex prefixIndex : ℕ) (sign : Bool) : + accumulatorSignedLiteralDescriptorWord sign + (List.replicate (Nat.pair clauseIndex prefixIndex) true) = + flatSignedLiteralDescriptor + (accumulatorVariable clauseIndex prefixIndex, sign) := by + simp only [accumulatorSignedLiteralDescriptorWord, polynomialSignedLiteralDescriptorWord, + List.length_replicate, Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X, + Polynomial.eval_one, flatSignedLiteralDescriptor, accumulatorVariable, + Encodable.encode_prod_val, + Encodable.encode_nat] + +/-- GapCVP reduction support. -/ +def paddingSignedLiteralDescriptorWord + (index : ℕ) (sign : Bool) : List Bool → List Bool := + polynomialSignedLiteralDescriptorWord (Polynomial.C index) sign + +/-- GapCVP reduction support. -/ +noncomputable def paddingSignedLiteralDescriptorComputable + (index : ℕ) (sign : Bool) : + BitTM + (paddingSignedLiteralDescriptorWord index sign) := + polynomialSignedLiteralDescriptorComputable + (Polynomial.C index) sign + +@[simp] theorem paddingSignedLiteralDescriptorWord_eq + (index : ℕ) (sign : Bool) (input : List Bool) : + paddingSignedLiteralDescriptorWord index sign input = + flatSignedLiteralDescriptor (index, sign) := by + simp only [paddingSignedLiteralDescriptorWord, polynomialSignedLiteralDescriptorWord, eq_natCast, + Polynomial.eval_natCast, Nat.cast_id, flatSignedLiteralDescriptor] + +end CNFFlatSourceGridDescriptorTM + +namespace CNFUnaryPairIndexTM + +open Computability Turing GapCVP.BinaryEncoding + +/-- GapCVP reduction support. -/ +def unarySourcePairWord (first second : ℕ) : List Bool := + List.replicate first true ++ + false :: (List.replicate second true ++ [false]) + +/-- GapCVP reduction support. -/ +def unarySourcePairOutput (input : List Bool) : List Bool := + match readUnaryPrefix input with + | none => [] + | some (first, remaining) => + match readUnaryPrefix remaining with + | some (second, []) => + List.replicate (Nat.pair first second) true + | _ => [] + +@[simp] theorem unarySourcePairOutput_word + (first second : ℕ) : + unarySourcePairOutput (unarySourcePairWord first second) = + List.replicate (Nat.pair first second) true := by + simp only [unarySourcePairOutput, unarySourcePairWord, readUnaryPrefix_replicate] + +private def unaryPairPeek (stack : Fin 9) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def unaryPairPop (stack : Fin 9) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + .pop stack (fun symbol _ => symbol) continuation + +private def unaryPairPush (stack : Fin 9) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + .push stack (fun _ => true) continuation + +private def unaryPairGoto (phase : Fin 12) : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +/-- GapCVP reduction support. -/ +def unaryPairFirstStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 0 + (.branch (fun symbol => symbol.getD false) + (unaryPairPop 0 (unaryPairPush 1 (unaryPairGoto 0))) + (unaryPairPop 0 (unaryPairGoto 1))) + (unaryPairGoto 11) + +/-- GapCVP reduction support. -/ +def unaryPairSecondStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 0 + (.branch (fun symbol => symbol.getD false) + (unaryPairPop 0 (unaryPairPush 2 (unaryPairGoto 1))) + (unaryPairPop 0 (unaryPairGoto 2))) + (unaryPairGoto 11) + +/-- GapCVP reduction support. -/ +def unaryPairCompareStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 0 + (unaryPairGoto 11) + (unaryPairPeek 1 + (unaryPairPeek 2 + (unaryPairPop 1 + (unaryPairPop 2 + (unaryPairPush 3 + (unaryPairPush 4 (unaryPairGoto 2))))) + (unaryPairGoto 3)) + (unaryPairPeek 2 + (unaryPairGoto 5) + (unaryPairGoto 3))) + +/-- GapCVP reduction support. -/ +def unaryPairGreaterBaseStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 1 + (unaryPairPop 1 + (unaryPairPush 5 + (unaryPairPush 6 + (unaryPairPush 7 (unaryPairGoto 3))))) + (unaryPairPeek 3 + (unaryPairPop 3 + (unaryPairPush 5 + (unaryPairPush 6 + (unaryPairPush 7 (unaryPairGoto 3))))) + (unaryPairGoto 4)) + +/-- GapCVP reduction support. -/ +def unaryPairGreaterOffsetStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 4 + (unaryPairPop 4 + (unaryPairPush 7 (unaryPairGoto 4))) + (unaryPairGoto 7) + +/-- GapCVP reduction support. -/ +def unaryPairLessBaseStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 2 + (unaryPairPop 2 + (unaryPairPush 5 + (unaryPairPush 6 (unaryPairGoto 5)))) + (unaryPairPeek 4 + (unaryPairPop 4 + (unaryPairPush 5 + (unaryPairPush 6 (unaryPairGoto 5)))) + (unaryPairGoto 6)) + +/-- GapCVP reduction support. -/ +def unaryPairLessOffsetStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 3 + (unaryPairPop 3 + (unaryPairPush 7 (unaryPairGoto 6))) + (unaryPairGoto 7) + +/-- GapCVP reduction support. -/ +def unaryPairOuterStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 6 + (unaryPairPop 6 (unaryPairGoto 8)) + (unaryPairGoto 10) + +/-- GapCVP reduction support. -/ +def unaryPairSquareCopyStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 5 + (unaryPairPop 5 + (unaryPairPush 8 + (unaryPairPush 7 (unaryPairGoto 8)))) + (unaryPairGoto 9) + +/-- GapCVP reduction support. -/ +def unaryPairSquareRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 8 + (unaryPairPop 8 + (unaryPairPush 5 (unaryPairGoto 9))) + (unaryPairGoto 7) + +/-- GapCVP reduction support. -/ +def unaryPairSquareCleanupStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 5 + (unaryPairPop 5 (unaryPairGoto 10)) + .halt + +/-- GapCVP reduction support. -/ +def unaryPairFailureStatement : + Turing.TM2.Stmt + (fun _ : Fin 9 => Bool) (Fin 12) (Option Bool) := + unaryPairPeek 0 + (unaryPairPop 0 (unaryPairGoto 11)) + (unaryPairPeek 1 + (unaryPairPop 1 (unaryPairGoto 11)) + (unaryPairPeek 2 + (unaryPairPop 2 (unaryPairGoto 11)) + (unaryPairPeek 3 + (unaryPairPop 3 (unaryPairGoto 11)) + (unaryPairPeek 4 + (unaryPairPop 4 (unaryPairGoto 11)) + (unaryPairPeek 5 + (unaryPairPop 5 (unaryPairGoto 11)) + (unaryPairPeek 6 + (unaryPairPop 6 (unaryPairGoto 11)) + (unaryPairPeek 8 + (unaryPairPop 8 (unaryPairGoto 11)) + .halt))))))) + +/-- GapCVP reduction support. -/ +abbrev actualUnaryPairIndexMachine : Turing.FinTM2 where + K := Fin 9 + k₀ := 0 + k₁ := 7 + Γ _ := Bool + Λ := Fin 12 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 12) then unaryPairFirstStatement + else if phase = (1 : Fin 12) then unaryPairSecondStatement + else if phase = (2 : Fin 12) then unaryPairCompareStatement + else if phase = (3 : Fin 12) then unaryPairGreaterBaseStatement + else if phase = (4 : Fin 12) then unaryPairGreaterOffsetStatement + else if phase = (5 : Fin 12) then unaryPairLessBaseStatement + else if phase = (6 : Fin 12) then unaryPairLessOffsetStatement + else if phase = (7 : Fin 12) then unaryPairOuterStatement + else if phase = (8 : Fin 12) then unaryPairSquareCopyStatement + else if phase = (9 : Fin 12) then unaryPairSquareRestoreStatement + else if phase = (10 : Fin 12) then unaryPairSquareCleanupStatement + else unaryPairFailureStatement + +/-- GapCVP reduction support. -/ +def unaryPairConfiguration (phase : Fin 12) + (input first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.Cfg where + l := some phase + var := none + stk := ![input, first, second, matchedFirst, matchedSecond, + base, outer, output, scratch] + +theorem actualUnaryPairIndexMachine_init (input : List Bool) : + Turing.initList actualUnaryPairIndexMachine input = + unaryPairConfiguration 0 input [] [] [] [] [] [] [] [] := by + simp only [actualUnaryPairIndexMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + unaryPairConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `unaryPairStepTac` machine-step simplifier. -/ +macro "unaryPairStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [actualUnaryPairIndexMachine, unaryPairConfiguration, + unaryPairPeek, unaryPairPop, unaryPairPush, unaryPairGoto, + unaryPairFirstStatement, unaryPairSecondStatement, + unaryPairCompareStatement, unaryPairGreaterBaseStatement, + unaryPairGreaterOffsetStatement, unaryPairLessBaseStatement, + unaryPairLessOffsetStatement, unaryPairOuterStatement, + unaryPairSquareCopyStatement, unaryPairSquareRestoreStatement, + unaryPairSquareCleanupStatement, unaryPairFailureStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +theorem unaryPair_first_true + (input first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 0 + (true :: input) first second matchedFirst matchedSecond + base outer output scratch) = + some (unaryPairConfiguration 0 input + (true :: first) second matchedFirst matchedSecond + base outer output scratch) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_first_false + (input first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 0 + (false :: input) first second matchedFirst matchedSecond + base outer output scratch) = + some (unaryPairConfiguration 1 input + first second matchedFirst matchedSecond + base outer output scratch) := by + unaryPairStepTac + +theorem unaryPair_first_missing + (first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 0 [] + first second matchedFirst matchedSecond + base outer output scratch) = + some (unaryPairConfiguration 11 [] + first second matchedFirst matchedSecond + base outer output scratch) := by + unaryPairStepTac + +theorem unaryPair_second_true + (input first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 1 + (true :: input) first second matchedFirst matchedSecond + base outer output scratch) = + some (unaryPairConfiguration 1 input first + (true :: second) matchedFirst matchedSecond + base outer output scratch) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_second_false + (input first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 1 + (false :: input) first second matchedFirst matchedSecond + base outer output scratch) = + some (unaryPairConfiguration 2 input first second + matchedFirst matchedSecond base outer output scratch) := by + unaryPairStepTac + +theorem unaryPair_second_missing + (first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 1 [] first second + matchedFirst matchedSecond base outer output scratch) = + some (unaryPairConfiguration 11 [] first second + matchedFirst matchedSecond base outer output scratch) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_compare_match + (first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 2 [] + (true :: first) (true :: second) + matchedFirst matchedSecond base outer output scratch) = + some (unaryPairConfiguration 2 [] first second + (true :: matchedFirst) (true :: matchedSecond) + base outer output scratch) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_compare_greater + (first matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 2 [] first [] + matchedFirst matchedSecond base outer output scratch) = + some (unaryPairConfiguration 3 [] first [] + matchedFirst matchedSecond base outer output scratch) := by + cases first <;> unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_compare_less + (second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 2 [] [] (true :: second) + matchedFirst matchedSecond base outer output scratch) = + some (unaryPairConfiguration 5 [] [] (true :: second) + matchedFirst matchedSecond base outer output scratch) := by + unaryPairStepTac + +theorem unaryPair_compare_trailing + (bit : Bool) + (input first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 2 (bit :: input) + first second matchedFirst matchedSecond + base outer output scratch) = + some (unaryPairConfiguration 11 (bit :: input) + first second matchedFirst matchedSecond + base outer output scratch) := by + cases bit <;> unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_greater_base_first + (first matchedFirst matchedSecond base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 3 [] + (true :: first) [] matchedFirst matchedSecond + base outer output []) = + some (unaryPairConfiguration 3 [] first [] + matchedFirst matchedSecond + (true :: base) (true :: outer) (true :: output) []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_greater_base_matched + (matchedFirst matchedSecond base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 3 [] [] [] + (true :: matchedFirst) matchedSecond + base outer output []) = + some (unaryPairConfiguration 3 [] [] [] + matchedFirst matchedSecond + (true :: base) (true :: outer) (true :: output) []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_greater_base_finish + (matchedSecond base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 3 [] [] [] [] matchedSecond + base outer output []) = + some (unaryPairConfiguration 4 [] [] [] [] matchedSecond + base outer output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_greater_offset_step + (matchedSecond base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 4 [] [] [] [] + (true :: matchedSecond) base outer output []) = + some (unaryPairConfiguration 4 [] [] [] [] matchedSecond + base outer (true :: output) []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_greater_offset_finish + (base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 4 [] [] [] [] [] + base outer output []) = + some (unaryPairConfiguration 7 [] [] [] [] [] + base outer output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_less_base_second + (second matchedFirst matchedSecond base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 5 [] [] (true :: second) + matchedFirst matchedSecond base outer output []) = + some (unaryPairConfiguration 5 [] [] second + matchedFirst matchedSecond + (true :: base) (true :: outer) output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_less_base_matched + (matchedFirst matchedSecond base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 5 [] [] [] + matchedFirst (true :: matchedSecond) + base outer output []) = + some (unaryPairConfiguration 5 [] [] [] + matchedFirst matchedSecond + (true :: base) (true :: outer) output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_less_base_finish + (matchedFirst base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 5 [] [] [] matchedFirst [] + base outer output []) = + some (unaryPairConfiguration 6 [] [] [] matchedFirst [] + base outer output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_less_offset_step + (matchedFirst base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 6 [] [] [] + (true :: matchedFirst) [] base outer output []) = + some (unaryPairConfiguration 6 [] [] [] + matchedFirst [] base outer (true :: output) []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_less_offset_finish + (base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 6 [] [] [] [] [] + base outer output []) = + some (unaryPairConfiguration 7 [] [] [] [] [] + base outer output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_outer_step + (base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 7 [] [] [] [] [] + base (true :: outer) output []) = + some (unaryPairConfiguration 8 [] [] [] [] [] + base outer output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_outer_finish + (base output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 7 [] [] [] [] [] + base [] output []) = + some (unaryPairConfiguration 10 [] [] [] [] [] + base [] output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_square_copy_step + (base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 8 [] [] [] [] [] + (true :: base) outer output scratch) = + some (unaryPairConfiguration 8 [] [] [] [] [] + base outer (true :: output) (true :: scratch)) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_square_copy_finish + (outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 8 [] [] [] [] [] + [] outer output scratch) = + some (unaryPairConfiguration 9 [] [] [] [] [] + [] outer output scratch) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_square_restore_step + (base outer output scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 9 [] [] [] [] [] + base outer output (true :: scratch)) = + some (unaryPairConfiguration 9 [] [] [] [] [] + (true :: base) outer output scratch) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_square_restore_finish + (base outer output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 9 [] [] [] [] [] + base outer output []) = + some (unaryPairConfiguration 7 [] [] [] [] [] + base outer output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_square_cleanup_step + (base output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 10 [] [] [] [] [] + (true :: base) [] output []) = + some (unaryPairConfiguration 10 [] [] [] [] [] + base [] output []) := by + unaryPairStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem unaryPair_square_cleanup_finish (output : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 10 [] [] [] [] [] [] [] output []) = + some (Turing.haltList actualUnaryPairIndexMachine output) := by + unaryPairStepTac + +theorem unaryPair_failure_input_step + (bit : Bool) + (input first second matchedFirst matchedSecond + base outer scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 (bit :: input) + first second matchedFirst matchedSecond base outer [] scratch) = + some (unaryPairConfiguration 11 input + first second matchedFirst matchedSecond base outer [] scratch) := by + cases bit <;> unaryPairStepTac + +theorem unaryPair_failure_first_step + (bit : Bool) + (first second matchedFirst matchedSecond + base outer scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 [] + (bit :: first) second matchedFirst matchedSecond + base outer [] scratch) = + some (unaryPairConfiguration 11 [] first second + matchedFirst matchedSecond base outer [] scratch) := by + cases bit <;> unaryPairStepTac + +theorem unaryPair_failure_second_step + (bit : Bool) + (second matchedFirst matchedSecond + base outer scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 [] [] + (bit :: second) matchedFirst matchedSecond + base outer [] scratch) = + some (unaryPairConfiguration 11 [] [] second + matchedFirst matchedSecond base outer [] scratch) := by + cases bit <;> unaryPairStepTac + +theorem unaryPair_failure_matchedFirst_step + (bit : Bool) + (matchedFirst matchedSecond base outer scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 [] [] [] + (bit :: matchedFirst) matchedSecond + base outer [] scratch) = + some (unaryPairConfiguration 11 [] [] [] + matchedFirst matchedSecond base outer [] scratch) := by + cases bit <;> unaryPairStepTac + +theorem unaryPair_failure_matchedSecond_step + (bit : Bool) + (matchedSecond base outer scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 [] [] [] [] + (bit :: matchedSecond) base outer [] scratch) = + some (unaryPairConfiguration 11 [] [] [] [] + matchedSecond base outer [] scratch) := by + cases bit <;> unaryPairStepTac + +theorem unaryPair_failure_base_step + (bit : Bool) (base outer scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 [] [] [] [] [] + (bit :: base) outer [] scratch) = + some (unaryPairConfiguration 11 [] [] [] [] [] + base outer [] scratch) := by + cases bit <;> unaryPairStepTac + +theorem unaryPair_failure_outer_step + (bit : Bool) (outer scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 [] [] [] [] [] [] + (bit :: outer) [] scratch) = + some (unaryPairConfiguration 11 [] [] [] [] [] [] + outer [] scratch) := by + cases bit <;> unaryPairStepTac + +theorem unaryPair_failure_scratch_step + (bit : Bool) (scratch : List Bool) : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 [] [] [] [] [] [] [] + [] (bit :: scratch)) = + some (unaryPairConfiguration 11 [] [] [] [] [] [] [] + [] scratch) := by + cases bit <;> unaryPairStepTac + +theorem unaryPair_failure_finish : + actualUnaryPairIndexMachine.step + (unaryPairConfiguration 11 [] [] [] [] [] [] [] [] []) = + some (Turing.haltList actualUnaryPairIndexMachine []) := by + unaryPairStepTac + +end CNFUnaryPairIndexTM + +namespace CNFUnaryPairIndexTotalCert + +open Computability Turing GapCVP.CNFUnaryPairIndexTM + +theorem unaryPair_replicate_append_true + (count : ℕ) (suffix : List Bool) : + List.replicate count true ++ true :: suffix = + List.replicate (count + 1) true ++ suffix := by + simp only [SourceStructuralDecoder.replicate_true_append_cons, List.replicate_succ', + List.append_nil, + List.cons_append] + +end CNFUnaryPairIndexTotalCert + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part04G.lean b/LeanPool/GapCVP/Part04G.lean new file mode 100644 index 000000000..ee9155cf1 --- /dev/null +++ b/LeanPool/GapCVP/Part04G.lean @@ -0,0 +1,408 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part04F + +/-! # GapCVP proof, part 04, continuation 07 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFUnaryPairIndexTotalCert + +open Computability Turing GapCVP.CNFUnaryPairIndexTM + +/-- GapCVP reduction support. -/ +def unaryPairFirstTrace + (count : ℕ) + (tail first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 0 + (List.replicate count true ++ false :: tail) + first second matchedFirst matchedSecond + base outer output scratch) + (some (unaryPairConfiguration 1 tail + (List.replicate count true ++ first) + second matchedFirst matchedSecond + base outer output scratch)) + (count + 1) := by + induction count generalizing first with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPair_first_false tail first second matchedFirst matchedSecond base + outer output scratch) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_first_true + (List.replicate count true ++ false :: tail) + first second matchedFirst matchedSecond + base outer output scratch) + have hrest := ih (true :: first) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + +/-- GapCVP reduction support. -/ +def unaryPairSecondTrace + (count : ℕ) + (tail first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 1 + (List.replicate count true ++ false :: tail) + first second matchedFirst matchedSecond + base outer output scratch) + (some (unaryPairConfiguration 2 tail first + (List.replicate count true ++ second) + matchedFirst matchedSecond base outer output scratch)) + (count + 1) := by + induction count generalizing second with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPair_second_false tail first second matchedFirst matchedSecond base + outer output scratch) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_second_true + (List.replicate count true ++ false :: tail) + first second matchedFirst matchedSecond + base outer output scratch) + have hrest := ih (true :: second) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + +private def unaryPair_squareCopyTrace + (count : ℕ) (outer output scratch : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 8 [] [] [] [] [] + (List.replicate count true) outer output scratch) + (some (unaryPairConfiguration 9 [] [] [] [] [] [] + outer (List.replicate count true ++ output) + (List.replicate count true ++ scratch))) + (count + 1) := by + induction count generalizing output scratch with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPair_square_copy_finish outer output scratch) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_square_copy_step + (List.replicate count true) + outer output scratch) + have hrest := ih (true :: output) (true :: scratch) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + +private def unaryPair_squareRestoreTrace + (count : ℕ) (base outer output : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 9 [] [] [] [] [] + base outer output (List.replicate count true)) + (some (unaryPairConfiguration 7 [] [] [] [] [] + (List.replicate count true ++ base) + outer output [])) + (count + 1) := by + induction count generalizing base with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPair_square_restore_finish base outer output) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_square_restore_step + base outer output (List.replicate count true)) + have hrest := ih (true :: base) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + +private def unaryPair_squareCleanupTrace + (count : ℕ) (output : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 10 [] [] [] [] [] + (List.replicate count true) [] output []) + (some (Turing.haltList actualUnaryPairIndexMachine output)) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ (unaryPair_square_cleanup_finish output) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_square_cleanup_step + (List.replicate count true) output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd] + using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst ih + +/-- GapCVP reduction support. -/ +def unaryPairSquareTrace + (baseCount outerCount : ℕ) (output : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 7 [] [] [] [] [] + (List.replicate baseCount true) + (List.replicate outerCount true) output []) + (some (Turing.haltList actualUnaryPairIndexMachine + (List.replicate (baseCount * outerCount) true ++ output))) + (outerCount * (2 * baseCount + 3) + baseCount + 2) := by + induction outerCount generalizing output with + | zero => + have houter := oneStep _ _ (unaryPair_outer_finish + (List.replicate baseCount true) output) + have hclean := unaryPair_squareCleanupTrace baseCount output + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, mul_zero, List.nil_append, + zero_mul, zero_add, + Nat.add_assoc, Nat.reduceAdd] using EvalsToInTime.trans actualUnaryPairIndexMachine.step + _ _ _ _ _ houter hclean + | succ outerCount ih => + have houter := oneStep _ _ (unaryPair_outer_step (List.replicate baseCount true) + (List.replicate outerCount true) output) + have hcopy := unaryPair_squareCopyTrace baseCount + (List.replicate outerCount true) output [] + simp only [List.append_nil] at hcopy + have hrestore := unaryPair_squareRestoreTrace baseCount [] + (List.replicate outerCount true) + (List.replicate baseCount true ++ output) + simp only [List.append_nil] at hrestore + have hcycleFirst := EvalsToInTime.trans + actualUnaryPairIndexMachine.step _ _ _ _ _ houter hcopy + have hcycle := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hcycleFirst hrestore + have hrest := ih (List.replicate baseCount true ++ output) + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hcycle hrest + have htarget : + List.replicate (baseCount * outerCount) true ++ + (List.replicate baseCount true ++ output) = + List.replicate (baseCount * (outerCount + 1)) true ++ + output := by + simp only [Nat.mul_succ, List.replicate_add, + List.append_assoc] + have hbounded := rebound (newBudget := + (outerCount + 1) * (2 * baseCount + 3) + + baseCount + 2) + hfull (by + simp only [Nat.succ_mul, one_mul] + omega) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, htarget] using hbounded + +/-- GapCVP reduction support. -/ +def unaryPairComparedConfiguration + (first second matched : ℕ) : + actualUnaryPairIndexMachine.Cfg := + if first < second then + unaryPairConfiguration 5 [] [] + (List.replicate (second - first) true) + (List.replicate (matched + first) true) + (List.replicate (matched + first) true) + [] [] [] [] + else + unaryPairConfiguration 3 [] + (List.replicate (first - second) true) [] + (List.replicate (matched + second) true) + (List.replicate (matched + second) true) + [] [] [] [] + +/-- GapCVP reduction support. -/ +def unaryPairCompareTrace + (first second matched : ℕ) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 2 [] + (List.replicate first true) + (List.replicate second true) + (List.replicate matched true) + (List.replicate matched true) + [] [] [] []) + (some (unaryPairComparedConfiguration first second matched)) + (min first second + 1) := by + induction first generalizing second matched with + | zero => + cases second with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, + unaryPairComparedConfiguration, lt_self_iff_false, + ↓reduceIte, tsub_self, add_zero, min_self, zero_add] using + oneStep _ _ (unaryPair_compare_greater [] (List.replicate matched true) + (List.replicate matched true) [] [] [] []) + | succ second => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.replicate_succ, + unaryPairComparedConfiguration, lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le, + ↓reduceIte, tsub_zero, add_zero, + le_add_iff_nonneg_left, inf_of_le_left, zero_add] using + oneStep _ _ + (unaryPair_compare_less (List.replicate second true) (List.replicate matched true) + (List.replicate matched true) + [] [] [] []) + | succ first ih => + cases second with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.replicate_zero, + unaryPairComparedConfiguration, not_lt_zero, ↓reduceIte, tsub_zero, add_zero, + le_add_iff_nonneg_left, zero_le, + inf_of_le_right, zero_add] using + oneStep _ _ + (unaryPair_compare_greater (List.replicate (first + 1) true) (List.replicate + matched true) + (List.replicate matched true) [] [] [] []) + | succ second => + have hfirst := oneStep _ _ (unaryPair_compare_match + (List.replicate first true) + (List.replicate second true) + (List.replicate matched true) + (List.replicate matched true) [] [] [] []) + have hrest := ih second (matched + 1) + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, + unaryPairComparedConfiguration, + Order.lt_add_one_iff, Order.add_one_le_iff, Nat.succ_sub_succ_eq_sub, + Nat.add_left_comm, Nat.succ_min_succ, + Nat.succ_eq_add_one, Nat.add_comm, Nat.reduceAdd] using hfull + +/-- GapCVP reduction support. -/ +def unaryPairGreaterBaseTrace + (first matchedFirst matchedSecond : ℕ) + (base outer output : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 3 [] + (List.replicate first true) [] + (List.replicate matchedFirst true) + (List.replicate matchedSecond true) + base outer output []) + (some (unaryPairConfiguration 4 [] [] [] [] + (List.replicate matchedSecond true) + (List.replicate (first + matchedFirst) true ++ base) + (List.replicate (first + matchedFirst) true ++ outer) + (List.replicate (first + matchedFirst) true ++ output) [])) + (first + matchedFirst + 1) := by + induction first generalizing base outer output with + | zero => + induction matchedFirst generalizing base outer output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, add_zero, List.nil_append, + zero_add] using + oneStep _ _ (unaryPair_greater_base_finish (List.replicate matchedSecond true) base + outer output) + | succ matchedFirst ih => + have hfirst := oneStep _ _ (unaryPair_greater_base_matched + (List.replicate matchedFirst true) + (List.replicate matchedSecond true) + base outer output) + have hrest := ih + (true :: base) (true :: outer) (true :: output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.replicate_succ, zero_add, + List.cons_append, + Nat.add_assoc, Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] + using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + | succ first ih => + have hfirst := oneStep _ _ (unaryPair_greater_base_first + (List.replicate first true) + (List.replicate matchedFirst true) + (List.replicate matchedSecond true) + base outer output) + have hrest := ih + (true :: base) (true :: outer) (true :: output) + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + simp only [unaryPair_replicate_append_true] at hfull + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using hfull + +/-- GapCVP reduction support. -/ +def unaryPairGreaterOffsetTrace + (count : ℕ) (base outer output : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 4 [] [] [] [] + (List.replicate count true) base outer output []) + (some (unaryPairConfiguration 7 [] [] [] [] [] + base outer (List.replicate count true ++ output) [])) + (count + 1) := by + induction count generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPair_greater_offset_finish base outer output) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_greater_offset_step + (List.replicate count true) base outer output) + have hrest := ih (true :: output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + +/-- GapCVP reduction support. -/ +def unaryPairLessBaseTrace + (second matchedFirst matchedSecond : ℕ) + (base outer output : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 5 [] [] + (List.replicate second true) + (List.replicate matchedFirst true) + (List.replicate matchedSecond true) + base outer output []) + (some (unaryPairConfiguration 6 [] [] [] + (List.replicate matchedFirst true) [] + (List.replicate (second + matchedSecond) true ++ base) + (List.replicate (second + matchedSecond) true ++ outer) + output [])) + (second + matchedSecond + 1) := by + induction second generalizing base outer with + | zero => + induction matchedSecond generalizing base outer with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, add_zero, List.nil_append, + zero_add] using + oneStep _ _ (unaryPair_less_base_finish (List.replicate matchedFirst true) base outer + output) + | succ matchedSecond ih => + have hfirst := oneStep _ _ (unaryPair_less_base_matched + (List.replicate matchedFirst true) + (List.replicate matchedSecond true) + base outer output) + have hrest := ih (true :: base) (true :: outer) + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.replicate_succ, zero_add, + List.cons_append, + Nat.add_assoc, Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] + using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + | succ second ih => + have hfirst := oneStep _ _ (unaryPair_less_base_second + (List.replicate second true) + (List.replicate matchedFirst true) + (List.replicate matchedSecond true) + base outer output) + have hrest := ih (true :: base) (true :: outer) + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + simp only [unaryPair_replicate_append_true] at hfull + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using hfull + +/-- GapCVP reduction support. -/ +def unaryPairLessOffsetTrace + (count : ℕ) (base outer output : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 6 [] [] [] + (List.replicate count true) [] base outer output []) + (some (unaryPairConfiguration 7 [] [] [] [] [] + base outer (List.replicate count true ++ output) [])) + (count + 1) := by + induction count generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPair_less_offset_finish base outer output) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_less_offset_step + (List.replicate count true) base outer output) + have hrest := ih (true :: output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + +end CNFUnaryPairIndexTotalCert + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part05.lean b/LeanPool/GapCVP/Part05.lean new file mode 100644 index 000000000..7b0dd6129 --- /dev/null +++ b/LeanPool/GapCVP/Part05.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part05F + +/-! # GapCVP proof, part 05 -/ diff --git a/LeanPool/GapCVP/Part05A.lean b/LeanPool/GapCVP/Part05A.lean new file mode 100644 index 000000000..0871913a3 --- /dev/null +++ b/LeanPool/GapCVP/Part05A.lean @@ -0,0 +1,806 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part04 + +/-! # GapCVP proof, part 05 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFUnaryPairIndexTotalRuntimeCert + +open Computability Turing GapCVP.SourceTotalStructuralDecoder GapCVP.CNFUnaryPairIndexTM +open GapCVP.CNFUnaryPairIndexTotalCert + +private def unaryPairValidBudget (first second : ℕ) : ℕ := + (first + 1) + (second + 1) + (min first second + 1) + + if first < second then + ((second - first) + first + 1) + (first + 1) + + (second * (2 * second + 3) + second + 2) + else + ((first - second) + second + 1) + (second + 1) + + (first * (2 * first + 3) + first + 2) + +private def unaryPair_validTrace (first second : ℕ) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 0 + (unarySourcePairWord first second) + [] [] [] [] [] [] [] []) + (some (Turing.haltList actualUnaryPairIndexMachine + (List.replicate (Nat.pair first second) true))) + (unaryPairValidBudget first second) := by + have hfirst := unaryPairFirstTrace first + (List.replicate second true ++ [false]) + [] [] [] [] [] [] [] [] + simp only [List.append_nil] at hfirst + have hsecond := unaryPairSecondTrace second [] + (List.replicate first true) [] [] [] [] [] [] [] + simp only [List.append_nil] at hsecond + have hscan := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hsecond + by_cases hlt : first < second + · have hcomparison := unaryPairCompareTrace first second 0 + simp only [FinTM2.step, Fin.isValue, List.replicate_zero, unaryPairComparedConfiguration, hlt, + ↓reduceIte, + zero_add] at hcomparison + have hbeforeBase := EvalsToInTime.trans + actualUnaryPairIndexMachine.step _ _ _ _ _ hscan hcomparison + have hbase := unaryPairLessBaseTrace + (second - first) first first [] [] [] + simp only [List.append_nil] at hbase + have hrestore : second - first + first = second := + Nat.sub_add_cancel (Nat.le_of_lt hlt) + rw [hrestore] at hbase + have hbeforeOffset := EvalsToInTime.trans + actualUnaryPairIndexMachine.step _ _ _ _ _ hbeforeBase hbase + have hoffset := unaryPairLessOffsetTrace first + (List.replicate second true) + (List.replicate second true) [] + simp only [List.append_nil] at hoffset + have hbeforeSquare := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hbeforeOffset hoffset + have hsquare := unaryPairSquareTrace + second second (List.replicate first true) + have houtput : + List.replicate (second * second) true ++ + List.replicate first true = + List.replicate (Nat.pair first second) true := by + rw [← List.replicate_add, Nat.pair, ite_eq_left hlt] + rw [houtput] at hsquare + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hbeforeSquare hsquare + have hbounded := rebound (newBudget := unaryPairValidBudget first second) + hfull (by + simp only [unaryPairValidBudget, hlt, ↓reduceIte]; omega) + simpa only [FinTM2.step, Fin.isValue, unarySourcePairWord] using hbounded + · have hcomparison := unaryPairCompareTrace first second 0 + simp only [FinTM2.step, Fin.isValue, List.replicate_zero, unaryPairComparedConfiguration, hlt, + ↓reduceIte, + zero_add] at hcomparison + have hbeforeBase := EvalsToInTime.trans + actualUnaryPairIndexMachine.step _ _ _ _ _ hscan hcomparison + have hbase := unaryPairGreaterBaseTrace + (first - second) second second [] [] [] + simp only [List.append_nil] at hbase + have hrestore : first - second + second = first := + Nat.sub_add_cancel (Nat.le_of_not_gt hlt) + rw [hrestore] at hbase + have hbeforeOffset := EvalsToInTime.trans + actualUnaryPairIndexMachine.step _ _ _ _ _ hbeforeBase hbase + have hoffset := unaryPairGreaterOffsetTrace second + (List.replicate first true) + (List.replicate first true) + (List.replicate first true) + have hbeforeSquare := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hbeforeOffset hoffset + have hsquare := unaryPairSquareTrace + first first + (List.replicate second true ++ List.replicate first true) + have houtput : + List.replicate (first * first) true ++ + (List.replicate second true ++ + List.replicate first true) = + List.replicate (Nat.pair first second) true := by + rw [← List.replicate_add, ← List.replicate_add, + Nat.pair, ite_eq_right hlt] + simp only [Nat.add_comm, Nat.add_assoc, Nat.add_left_comm] + rw [houtput] at hsquare + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hbeforeSquare hsquare + have hbounded := rebound (newBudget := unaryPairValidBudget first second) + hfull (by + simp only [unaryPairValidBudget, hlt, ↓reduceIte]; omega) + simpa only [FinTM2.step, Fin.isValue, unarySourcePairWord] using hbounded + +private def unaryPair_failureTrace + (input first second matchedFirst matchedSecond + base outer scratch : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 11 input first second + matchedFirst matchedSecond base outer [] scratch) + (some (Turing.haltList actualUnaryPairIndexMachine [])) + (input.length + first.length + second.length + + matchedFirst.length + matchedSecond.length + + base.length + outer.length + scratch.length + 1) := by + induction input generalizing first second matchedFirst + matchedSecond base outer scratch with + | cons bit input ih => + have hfirst := oneStep _ _ (unaryPair_failure_input_step bit input first second + matchedFirst matchedSecond base outer scratch) + have hrest := ih first second matchedFirst matchedSecond + base outer scratch + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hfirst hrest + | nil => + induction first generalizing second matchedFirst matchedSecond + base outer scratch with + | cons bit first ih => + have hfirst := oneStep _ _ (unaryPair_failure_first_step bit first second + matchedFirst matchedSecond base outer scratch) + have hrest := ih second matchedFirst matchedSecond + base outer scratch + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + | nil => + induction second generalizing matchedFirst matchedSecond + base outer scratch with + | cons bit second ih => + have hfirst := oneStep _ _ (unaryPair_failure_second_step bit second + matchedFirst matchedSecond base outer scratch) + have hrest := ih matchedFirst matchedSecond + base outer scratch + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, + zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + | nil => + induction matchedFirst generalizing matchedSecond + base outer scratch with + | cons bit matchedFirst ih => + have hfirst := oneStep _ _ (unaryPair_failure_matchedFirst_step bit + matchedFirst matchedSecond base outer scratch) + have hrest := ih matchedSecond base outer scratch + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + | nil => + induction matchedSecond generalizing + base outer scratch with + | cons bit matchedSecond ih => + have hfirst := oneStep _ _ (unaryPair_failure_matchedSecond_step bit + matchedSecond base outer scratch) + have hrest := ih base outer scratch + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst + hrest + | nil => + induction base generalizing outer scratch with + | cons bit base ih => + have hfirst := oneStep _ _ (unaryPair_failure_base_step bit + base outer scratch) + have hrest := ih outer scratch + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst + hrest + | nil => + induction outer generalizing scratch with + | cons bit outer ih => + have hfirst := oneStep _ _ (unaryPair_failure_outer_step bit + outer scratch) + have hrest := ih scratch + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hfirst hrest + | nil => + induction scratch with + | cons bit scratch ih => + have hfirst := oneStep _ _ (unaryPair_failure_scratch_step + bit scratch) + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using EvalsToInTime.trans + actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst ih + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + zero_add] using + oneStep _ _ unaryPair_failure_finish + +private def unaryPair_firstMissingTrace + (count : ℕ) + (first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step + (unaryPairConfiguration 0 (List.replicate count true) + first second matchedFirst matchedSecond + base outer output scratch) + (some (unaryPairConfiguration 11 [] + (List.replicate count true ++ first) second + matchedFirst matchedSecond base outer output scratch)) + (count + 1) := by + induction count generalizing first with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPair_first_missing first second matchedFirst matchedSecond base outer + output scratch) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_first_true (List.replicate count true) + first second matchedFirst matchedSecond + base outer output scratch) + have hrest := ih (true :: first) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + +private def unaryPair_secondMissingTrace + (count : ℕ) + (first second matchedFirst matchedSecond + base outer output scratch : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step + (unaryPairConfiguration 1 (List.replicate count true) + first second matchedFirst matchedSecond + base outer output scratch) + (some (unaryPairConfiguration 11 [] first + (List.replicate count true ++ second) + matchedFirst matchedSecond base outer output scratch)) + (count + 1) := by + induction count generalizing second with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPair_second_missing first second matchedFirst matchedSecond base outer + output scratch) + | succ count ih => + have hfirst := oneStep _ _ (unaryPair_second_true (List.replicate count true) + first second matchedFirst matchedSecond + base outer output scratch) + have hrest := ih (true :: second) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest + +private def unaryPairInputBudget (input : List Bool) : ℕ := + 64 * input.length ^ 2 + 128 * input.length + 128 + +private theorem unaryPairValidBudget_le_quadratic + (first second : ℕ) : + unaryPairValidBudget first second ≤ + 64 * (first + second + 2) ^ 2 + + 128 * (first + second + 2) + 128 := by + unfold unaryPairValidBudget + split_ifs with hlt + · have hle : first ≤ second := Nat.le_of_lt hlt + rw [min_eq_left hle, Nat.sub_add_cancel hle] + nlinarith + · have hle : second ≤ first := Nat.le_of_not_gt hlt + rw [min_eq_right hle, Nat.sub_add_cancel hle] + nlinarith + +private def unaryPair_totalTrace (input : List Bool) : + EvalsToInTime actualUnaryPairIndexMachine.step (unaryPairConfiguration 0 input + [] [] [] [] [] [] [] []) + (some (Turing.haltList actualUnaryPairIndexMachine + (unarySourcePairOutput input))) + (unaryPairInputBudget input) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + have hprefix := unaryPair_firstMissingTrace count + [] [] [] [] [] [] [] [] + simp only [List.append_nil] at hprefix + have hclean := unaryPair_failureTrace [] + (List.replicate count true) [] [] [] [] [] [] + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hprefix hclean + have hbounded := rebound (newBudget := unaryPairInputBudget + (List.replicate count true)) + hfull (by + simp only [unaryPairInputBudget, + List.length_replicate, List.length_nil] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, unarySourcePairOutput, readUnaryPrefix_missing] + using hbounded + | inr witness => + obtain ⟨first, tail, hinput⟩ := witness + subst input + cases unaryInputSplit tail with + | inl missing => + obtain ⟨second, htail⟩ := missing + subst tail + have hfirst := unaryPairFirstTrace first + (List.replicate second true) + [] [] [] [] [] [] [] [] + simp only [List.append_nil] at hfirst + have hsecond := unaryPair_secondMissingTrace second + (List.replicate first true) + [] [] [] [] [] [] [] + simp only [List.append_nil] at hsecond + have hscan := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hfirst hsecond + have hclean := unaryPair_failureTrace [] + (List.replicate first true) + (List.replicate second true) [] [] [] [] [] + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hscan hclean + have hbounded := rebound (newBudget := unaryPairInputBudget + (List.replicate first true ++ + false :: List.replicate second true)) + hfull (by + simp only [unaryPairInputBudget, + List.length_append, List.length_replicate, + List.length_cons, List.length_nil] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, unarySourcePairOutput, + BinaryEncoding.readUnaryPrefix_replicate, + readUnaryPrefix_missing] using hbounded + | inr delimited => + obtain ⟨second, remaining, htail⟩ := delimited + subst tail + cases remaining with + | nil => + have hvalid := unaryPair_validTrace first second + have hbounded := rebound (newBudget := unaryPairInputBudget + (unarySourcePairWord first second)) + hvalid (by + simpa only [unaryPairInputBudget, unarySourcePairWord, List.length_append, + List.length_replicate, + List.length_cons, List.length_nil, zero_add, Nat.add_assoc, Nat.reduceAdd] + using + unaryPairValidBudget_le_quadratic first second) + simpa only [FinTM2.step, Fin.isValue, unarySourcePairOutput, + BinaryEncoding.readUnaryPrefix_replicate, + unarySourcePairWord] using hbounded + | cons bit remaining => + have hfirst := unaryPairFirstTrace first + (List.replicate second true ++ + false :: bit :: remaining) + [] [] [] [] [] [] [] [] + simp only [List.append_nil] at hfirst + have hsecond := unaryPairSecondTrace second + (bit :: remaining) + (List.replicate first true) + [] [] [] [] [] [] [] + simp only [List.append_nil] at hsecond + have hscan := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hfirst hsecond + have htrailing := oneStep _ _ (unaryPair_compare_trailing bit remaining + (List.replicate first true) + (List.replicate second true) + [] [] [] [] [] []) + have hreject := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hscan htrailing + have hclean := unaryPair_failureTrace + (bit :: remaining) + (List.replicate first true) + (List.replicate second true) + [] [] [] [] [] + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + hreject hclean + have hbounded := rebound (newBudget := unaryPairInputBudget + (List.replicate first true ++ + false :: (List.replicate second true ++ + false :: bit :: remaining))) + hfull (by + simp only [unaryPairInputBudget, + List.length_append, List.length_replicate, + List.length_cons, List.length_nil] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, unarySourcePairOutput, + BinaryEncoding.readUnaryPrefix_replicate] using + hbounded + +/-- GapCVP reduction support. -/ +noncomputable def actualUnaryPairIndexComputable : + BitTM + unarySourcePairOutput where + tm := actualUnaryPairIndexMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 64 * Polynomial.X ^ 2 + 128 * Polynomial.X + 128 + outputsFun input := { + steps := (unaryPair_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, actualUnaryPairIndexMachine_init, + Option.map_some] using + (unaryPair_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (unaryPair_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, unaryPairInputBudget, bitEncoding, id_eq, + Polynomial.eval_add, + Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X, + ge_iff_le] using hsteps + } + +end CNFUnaryPairIndexTotalRuntimeCert + +namespace CNFPairedSourceGridDescriptorTM + +open Computability Turing GapCVP.ThreeCNFReduction GapCVP.CNFFlatStructuralRecordWorkerTM +open GapCVP.CNFFlatSourceGridDescriptorTM GapCVP.CNFUnaryPairIndexTM +open GapCVP.CNFUnaryPairIndexTotalRuntimeCert + +/-- GapCVP reduction support. -/ +def pairedAccumulatorSignedLiteralDescriptorWord + (sign : Bool) (input : List Bool) : List Bool := + accumulatorSignedLiteralDescriptorWord sign + (unarySourcePairOutput input) + +/-- GapCVP reduction support. -/ +noncomputable def pairedAccumulatorSignedLiteralDescriptorComputable + (sign : Bool) : + BitTM + (pairedAccumulatorSignedLiteralDescriptorWord sign) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + actualUnaryPairIndexComputable + (accumulatorSignedLiteralDescriptorComputable sign) + change BitTM + (fun input : List Bool => + accumulatorSignedLiteralDescriptorWord sign + (unarySourcePairOutput input)) + simpa only [Function.comp_def] using hphysical + +@[simp] theorem pairedAccumulatorSignedLiteralDescriptorWord_pair + (clauseIndex prefixIndex : ℕ) (sign : Bool) : + pairedAccumulatorSignedLiteralDescriptorWord sign + (unarySourcePairWord clauseIndex prefixIndex) = + flatSignedLiteralDescriptor + (accumulatorVariable clauseIndex prefixIndex, sign) := by + simp only [pairedAccumulatorSignedLiteralDescriptorWord, unarySourcePairOutput_word, + accumulatorSignedLiteralDescriptorWord_index] + +end CNFPairedSourceGridDescriptorTM + +namespace CNFSourcePairPrefixWorkerTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.CNFUnaryPairIndexTM + +/-- GapCVP reduction support. -/ +def sourcePairPrefixOutput (input : List Bool) : List Bool := + match readUnaryPrefix input with + | none => [] + | some (first, remaining) => + match readUnaryPrefix remaining with + | none => [] + | some (second, _) => unarySourcePairWord first second + +@[simp] theorem sourcePairPrefixOutput_pair + (first second : ℕ) (suffix : List Bool) : + sourcePairPrefixOutput + (unarySourcePairWord first second ++ suffix) = + unarySourcePairWord first second := by + simp only [sourcePairPrefixOutput, unarySourcePairWord, List.append_assoc, List.cons_append, + List.nil_append, + readUnaryPrefix_replicate] + +private def sourcePairPrefixPeek (stack : Fin 4) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def sourcePairPrefixPop (stack : Fin 4) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + .pop stack (fun symbol _ => symbol) continuation + +private def sourcePairPrefixPush (stack : Fin 4) (bit : Bool) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + .push stack (fun _ => bit) continuation + +private def sourcePairPrefixGoto (phase : Fin 6) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourcePairPrefixFirstStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + sourcePairPrefixPeek 0 + (.branch (fun symbol => symbol.getD false) + (sourcePairPrefixPop 0 + (sourcePairPrefixPush 1 true (sourcePairPrefixGoto 0))) + (sourcePairPrefixPop 0 (sourcePairPrefixGoto 1))) + (sourcePairPrefixGoto 5) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourcePairPrefixSecondStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + sourcePairPrefixPeek 0 + (.branch (fun symbol => symbol.getD false) + (sourcePairPrefixPop 0 + (sourcePairPrefixPush 2 true (sourcePairPrefixGoto 1))) + (sourcePairPrefixPop 0 + (sourcePairPrefixPush 3 false (sourcePairPrefixGoto 2)))) + (sourcePairPrefixGoto 5) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourcePairPrefixSuffixStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + sourcePairPrefixPeek 0 + (sourcePairPrefixPop 0 (sourcePairPrefixGoto 2)) + (sourcePairPrefixGoto 3) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourcePairPrefixSecondRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + sourcePairPrefixPeek 2 + (sourcePairPrefixPop 2 + (sourcePairPrefixPush 3 true (sourcePairPrefixGoto 3))) + (sourcePairPrefixPush 3 false (sourcePairPrefixGoto 4)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourcePairPrefixFirstRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + sourcePairPrefixPeek 1 + (sourcePairPrefixPop 1 + (sourcePairPrefixPush 3 true (sourcePairPrefixGoto 4))) + .halt + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourcePairPrefixFailureStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 6) (Option Bool) := + sourcePairPrefixPeek 0 + (sourcePairPrefixPop 0 (sourcePairPrefixGoto 5)) + (sourcePairPrefixPeek 1 + (sourcePairPrefixPop 1 (sourcePairPrefixGoto 5)) + (sourcePairPrefixPeek 2 + (sourcePairPrefixPop 2 (sourcePairPrefixGoto 5)) + (sourcePairPrefixPeek 3 + (sourcePairPrefixPop 3 (sourcePairPrefixGoto 5)) + .halt))) + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev actualSourcePairPrefixMachine : Turing.FinTM2 where + K := Fin 4 + k₀ := 0 + k₁ := 3 + Γ _ := Bool + Λ := Fin 6 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 6) then sourcePairPrefixFirstStatement + else if phase = (1 : Fin 6) then sourcePairPrefixSecondStatement + else if phase = (2 : Fin 6) then sourcePairPrefixSuffixStatement + else if phase = (3 : Fin 6) then + sourcePairPrefixSecondRestoreStatement + else if phase = (4 : Fin 6) then + sourcePairPrefixFirstRestoreStatement + else sourcePairPrefixFailureStatement + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourcePairPrefixConfiguration (phase : Fin 6) + (input first second output : List Bool) : + actualSourcePairPrefixMachine.Cfg where + l := some phase + var := none + stk := ![input, first, second, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem actualSourcePairPrefixMachine_init (input : List Bool) : + Turing.initList actualSourcePairPrefixMachine input = + sourcePairPrefixConfiguration 0 input [] [] [] := by + simp only [actualSourcePairPrefixMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + sourcePairPrefixConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `sourcePairPrefixStepTac` machine-step simplifier. -/ +macro "sourcePairPrefixStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [actualSourcePairPrefixMachine, + sourcePairPrefixConfiguration, + sourcePairPrefixPeek, sourcePairPrefixPop, + sourcePairPrefixPush, sourcePairPrefixGoto, + sourcePairPrefixFirstStatement, + sourcePairPrefixSecondStatement, + sourcePairPrefixSuffixStatement, + sourcePairPrefixSecondRestoreStatement, + sourcePairPrefixFirstRestoreStatement, + sourcePairPrefixFailureStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_first_true + (input first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 0 + (true :: input) first second output) = + some (sourcePairPrefixConfiguration 0 + input (true :: first) second output) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_first_false + (input first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 0 + (false :: input) first second output) = + some (sourcePairPrefixConfiguration 1 + input first second output) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_first_missing + (first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 0 [] first second output) = + some (sourcePairPrefixConfiguration 5 [] first second output) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_second_true + (input first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 1 + (true :: input) first second output) = + some (sourcePairPrefixConfiguration 1 + input first (true :: second) output) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_second_false + (input first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 1 + (false :: input) first second output) = + some (sourcePairPrefixConfiguration 2 + input first second (false :: output)) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_second_missing + (first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 1 [] first second output) = + some (sourcePairPrefixConfiguration 5 [] first second output) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_suffix_step + (bit : Bool) (input first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 2 + (bit :: input) first second output) = + some (sourcePairPrefixConfiguration 2 + input first second output) := by + cases bit <;> sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_suffix_finish + (first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 2 [] first second output) = + some (sourcePairPrefixConfiguration 3 + [] first second output) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_secondRestore_step + (first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 3 + [] first (true :: second) output) = + some (sourcePairPrefixConfiguration 3 + [] first second (true :: output)) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_secondRestore_finish + (first output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 3 [] first [] output) = + some (sourcePairPrefixConfiguration 4 + [] first [] (false :: output)) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_firstRestore_step + (first output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 4 + [] (true :: first) [] output) = + some (sourcePairPrefixConfiguration 4 + [] first [] (true :: output)) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_firstRestore_finish + (output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 4 [] [] [] output) = + some (Turing.haltList actualSourcePairPrefixMachine output) := by + sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_failure_input_step + (bit : Bool) (input first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 5 + (bit :: input) first second output) = + some (sourcePairPrefixConfiguration 5 + input first second output) := by + cases bit <;> sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_failure_first_step + (bit : Bool) (first second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 5 + [] (bit :: first) second output) = + some (sourcePairPrefixConfiguration 5 + [] first second output) := by + cases bit <;> sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_failure_second_step + (bit : Bool) (second output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 5 + [] [] (bit :: second) output) = + some (sourcePairPrefixConfiguration 5 + [] [] second output) := by + cases bit <;> sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_failure_output_step + (bit : Bool) (output : List Bool) : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 5 [] [] [] (bit :: output)) = + some (sourcePairPrefixConfiguration 5 [] [] [] output) := by + cases bit <;> sourcePairPrefixStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourcePairPrefix_failure_finish : + actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 5 [] [] [] []) = + some (Turing.haltList actualSourcePairPrefixMachine []) := by + sourcePairPrefixStepTac + +end CNFSourcePairPrefixWorkerTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part05B.lean b/LeanPool/GapCVP/Part05B.lean new file mode 100644 index 000000000..e88d8334a --- /dev/null +++ b/LeanPool/GapCVP/Part05B.lean @@ -0,0 +1,1788 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part05A + +/-! # GapCVP proof, part 05, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFSourcePairPrefixWorkerTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.CNFUnaryPairIndexTM + +end CNFSourcePairPrefixWorkerTM + +namespace CNFSourcePairPrefixWorkerTotalCert + +open Computability Turing GapCVP.SourceTotalStructuralDecoder GapCVP.CNFUnaryPairIndexTM +open GapCVP.CNFSourcePairPrefixWorkerTM + +private def sourcePairPrefix_firstTrace + (count : ℕ) (tail first second output : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step (sourcePairPrefixConfiguration 0 + (List.replicate count true ++ false :: tail) + first second output) + (some (sourcePairPrefixConfiguration 1 tail + (List.replicate count true ++ first) second output)) + (count + 1) := by + induction count generalizing first with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourcePairPrefix_first_false tail first second output) + | succ count ih => + have hfirst := oneStep _ _ (sourcePairPrefix_first_true + (List.replicate count true ++ false :: tail) + first second output) + have hrest := ih (true :: first) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest + +private def sourcePairPrefix_secondTrace + (count : ℕ) (tail first second output : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step (sourcePairPrefixConfiguration 1 + (List.replicate count true ++ false :: tail) + first second output) + (some (sourcePairPrefixConfiguration 2 tail first + (List.replicate count true ++ second) + (false :: output))) + (count + 1) := by + induction count generalizing second with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourcePairPrefix_second_false tail first second output) + | succ count ih => + have hfirst := oneStep _ _ (sourcePairPrefix_second_true + (List.replicate count true ++ false :: tail) + first second output) + have hrest := ih (true :: second) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest + +private def sourcePairPrefix_suffixTrace + (suffix first second output : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 2 suffix first second output) + (some (sourcePairPrefixConfiguration 3 + [] first second output)) + (suffix.length + 1) := by + induction suffix with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (sourcePairPrefix_suffix_finish first second output) + | cons bit suffix ih => + have hfirst := oneStep _ _ (sourcePairPrefix_suffix_step bit suffix + first second output) + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst ih + +private def sourcePairPrefix_secondRestoreTrace + (count : ℕ) (first output : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step (sourcePairPrefixConfiguration 3 + [] first (List.replicate count true) output) + (some (sourcePairPrefixConfiguration 4 [] first [] + (false :: (List.replicate count true ++ output)))) + (count + 1) := by + induction count generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourcePairPrefix_secondRestore_finish first output) + | succ count ih => + have hfirst := oneStep _ _ (sourcePairPrefix_secondRestore_step first + (List.replicate count true) output) + have hrest := ih (true :: output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest + +private def sourcePairPrefix_firstRestoreTrace + (count : ℕ) (output : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step (sourcePairPrefixConfiguration 4 + [] (List.replicate count true) [] output) + (some (Turing.haltList actualSourcePairPrefixMachine + (List.replicate count true ++ output))) + (count + 1) := by + induction count generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourcePairPrefix_firstRestore_finish output) + | succ count ih => + have hfirst := oneStep _ _ (sourcePairPrefix_firstRestore_step + (List.replicate count true) output) + have hrest := ih (true :: output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest + +private def sourcePairPrefix_validTrace + (first second : ℕ) (suffix : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step (sourcePairPrefixConfiguration 0 + (unarySourcePairWord first second ++ suffix) [] [] []) + (some (Turing.haltList actualSourcePairPrefixMachine + (unarySourcePairWord first second))) + (2 * first + 2 * second + suffix.length + 5) := by + have hfirst := sourcePairPrefix_firstTrace first + (List.replicate second true ++ false :: suffix) + [] [] [] + simp only [List.append_nil] at hfirst + have hsecond := sourcePairPrefix_secondTrace second suffix + (List.replicate first true) [] [] + simp only [List.append_nil] at hsecond + have hscan := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hsecond + have hsuffix := sourcePairPrefix_suffixTrace suffix + (List.replicate first true) + (List.replicate second true) [false] + have hbeforeRestore := EvalsToInTime.trans + actualSourcePairPrefixMachine.step _ _ _ _ _ hscan hsuffix + have hsecondRestore := sourcePairPrefix_secondRestoreTrace second + (List.replicate first true) [false] + have hbeforeFirst := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ + hbeforeRestore hsecondRestore + have hfirstRestore := sourcePairPrefix_firstRestoreTrace first + (false :: (List.replicate second true ++ [false])) + have hfull := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ + hbeforeFirst hfirstRestore + have hbounded := rebound (newBudget := 2 * first + 2 * second + suffix.length + 5) + hfull (by omega) + simpa only [FinTM2.step, Fin.isValue, unarySourcePairWord, List.append_assoc, List.cons_append, + List.nil_append] using hbounded + +private def sourcePairPrefix_failureTrace + (input first second output : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 5 input first second output) + (some (Turing.haltList actualSourcePairPrefixMachine [])) + (input.length + first.length + second.length + + output.length + 1) := by + induction input generalizing first second output with + | cons bit input ih => + have hfirst := oneStep _ _ (sourcePairPrefix_failure_input_step bit input + first second output) + have hrest := ih first second output + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ + hfirst hrest + | nil => + induction first generalizing second output with + | cons bit first ih => + have hfirst := oneStep _ _ (sourcePairPrefix_failure_first_step bit first + second output) + have hrest := ih second output + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest + | nil => + induction second generalizing output with + | cons bit second ih => + have hfirst := oneStep _ _ (sourcePairPrefix_failure_second_step bit + second output) + have hrest := ih output + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, + zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest + | nil => + induction output with + | cons bit output ih => + have hfirst := oneStep _ _ (sourcePairPrefix_failure_output_step bit output) + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using EvalsToInTime.trans + actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst ih + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using + oneStep _ _ sourcePairPrefix_failure_finish + +private def sourcePairPrefix_firstMissingTrace + (count : ℕ) (first second output : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step (sourcePairPrefixConfiguration 0 + (List.replicate count true) first second output) + (some (sourcePairPrefixConfiguration 5 [] + (List.replicate count true ++ first) second output)) + (count + 1) := by + induction count generalizing first with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourcePairPrefix_first_missing first second output) + | succ count ih => + have hfirst := oneStep _ _ (sourcePairPrefix_first_true + (List.replicate count true) first second output) + have hrest := ih (true :: first) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest + +private def sourcePairPrefix_secondMissingTrace + (count : ℕ) (first second output : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step (sourcePairPrefixConfiguration 1 + (List.replicate count true) first second output) + (some (sourcePairPrefixConfiguration 5 [] first + (List.replicate count true ++ second) output)) + (count + 1) := by + induction count generalizing second with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourcePairPrefix_second_missing first second output) + | succ count ih => + have hfirst := oneStep _ _ (sourcePairPrefix_second_true + (List.replicate count true) first second output) + have hrest := ih (true :: second) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest + +private def sourcePairPrefix_totalTrace (input : List Bool) : + EvalsToInTime actualSourcePairPrefixMachine.step + (sourcePairPrefixConfiguration 0 input [] [] []) + (some (Turing.haltList actualSourcePairPrefixMachine + (sourcePairPrefixOutput input))) + (6 * input.length + 12) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + have hprefix := sourcePairPrefix_firstMissingTrace count + [] [] [] + simp only [List.append_nil] at hprefix + have hclean := sourcePairPrefix_failureTrace [] + (List.replicate count true) [] [] + have hfull := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ + hprefix hclean + have hbounded := rebound (newBudget := 6 * (List.replicate count true).length + 12) + hfull (by simp only [List.length_nil, List.length_replicate, zero_add, add_zero]; omega) + simpa only [FinTM2.step, Fin.isValue, sourcePairPrefixOutput, readUnaryPrefix_missing, + List.length_replicate] using hbounded + | inr witness => + obtain ⟨first, remaining, hinput⟩ := witness + subst input + cases unaryInputSplit remaining with + | inl missing => + obtain ⟨second, hremaining⟩ := missing + subst remaining + have hfirst := sourcePairPrefix_firstTrace first + (List.replicate second true) [] [] [] + simp only [List.append_nil] at hfirst + have hsecond := sourcePairPrefix_secondMissingTrace second + (List.replicate first true) [] [] + simp only [List.append_nil] at hsecond + have hscan := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ + hfirst hsecond + have hclean := sourcePairPrefix_failureTrace [] + (List.replicate first true) + (List.replicate second true) [] + have hfull := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ + hscan hclean + have hbounded := rebound (newBudget := 6 * + (List.replicate first true ++ + false :: List.replicate second true).length + 12) + hfull (by + simp only [List.length_nil, List.length_replicate, zero_add, add_zero, + List.length_append, List.length_cons] + omega) + simpa only [FinTM2.step, Fin.isValue, sourcePairPrefixOutput, + BinaryEncoding.readUnaryPrefix_replicate, + readUnaryPrefix_missing, List.length_append, List.length_replicate, List.length_cons] + using hbounded + | inr delimited => + obtain ⟨second, suffix, hremaining⟩ := delimited + subst remaining + have hvalid := sourcePairPrefix_validTrace + first second suffix + have hbounded := rebound (newBudget := 6 * + (unarySourcePairWord first second ++ suffix).length + 12) + hvalid (by + simp only [unarySourcePairWord, List.append_assoc, List.cons_append, List.nil_append, + List.length_append, + List.length_replicate, List.length_cons, add_le_add_iff_right] + omega) + simpa only [FinTM2.step, Fin.isValue, sourcePairPrefixOutput, + BinaryEncoding.readUnaryPrefix_replicate, + unarySourcePairWord, List.length_append, List.length_replicate, List.length_cons, + List.append_assoc, + List.cons_append, List.nil_append] using hbounded + +/-- GapCVP reduction support. -/ +noncomputable def actualSourcePairPrefixComputable : + BitTM + sourcePairPrefixOutput where + tm := actualSourcePairPrefixMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 6 * Polynomial.X + 12 + outputsFun input := { + steps := (sourcePairPrefix_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, actualSourcePairPrefixMachine_init, + Option.map_some] using + (sourcePairPrefix_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (sourcePairPrefix_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +end CNFSourcePairPrefixWorkerTotalCert + +namespace SourceLatticeFormulaPreservation + +open Turing GapCVP.FormulaTuringTM GapCVP.FormulaTotalCert GapCVP.FormulaSemanticCert + +private def formulaPreservationCanonicalStack (stack : Fin 6) : Fin 8 := + ⟨stack.val, by omega⟩ + +private def formulaPreservationCanonicalLabel (phase : Fin 17) : Fin 20 := + ⟨phase.val, by omega⟩ + +private def liftFormulaPreservationCanonicalStmt : + Turing.TM2.Stmt (fun _ : Fin 6 => Bool) + (Fin 17) (Option Bool) → + Turing.TM2.Stmt (fun _ : Fin 8 => Bool) + (Fin 20) (Option Bool) + | .push stack push continuation => + .push (formulaPreservationCanonicalStack stack) push + (liftFormulaPreservationCanonicalStmt continuation) + | .peek stack peek continuation => + .peek (formulaPreservationCanonicalStack stack) peek + (liftFormulaPreservationCanonicalStmt continuation) + | .pop stack pop continuation => + .pop (formulaPreservationCanonicalStack stack) pop + (liftFormulaPreservationCanonicalStmt continuation) + | .load load continuation => + .load load (liftFormulaPreservationCanonicalStmt continuation) + | .branch branch yes no => + .branch branch + (liftFormulaPreservationCanonicalStmt yes) + (liftFormulaPreservationCanonicalStmt no) + | .goto target => + .goto (fun state => + formulaPreservationCanonicalLabel (target state)) + | .halt => + .goto (fun _ => (19 : Fin 20)) + +private def formulaPreservationPeek (stack : Fin 8) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def formulaPreservationPop (stack : Fin 8) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool) := + .pop stack (fun state _ => state) continuation + +private def formulaPreservationPush (stack : Fin 8) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool) := + .push stack (fun state => state.getD false) continuation + +private def formulaPreservationGoto (phase : Fin 20) : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +private def formulaPreservationCopyStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool) := + formulaPreservationPeek 0 + (formulaPreservationPop 0 + (formulaPreservationPush 6 + (formulaPreservationPush 7 + (formulaPreservationGoto 17)))) + (formulaPreservationGoto 18) + +private def formulaPreservationRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool) := + formulaPreservationPeek 7 + (formulaPreservationPop 7 + (formulaPreservationPush 0 + (formulaPreservationGoto 18))) + (formulaPreservationGoto 0) + +private def formulaPreservationOutputStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 20) (Option Bool) := + formulaPreservationPeek 6 + (formulaPreservationPop 6 + (formulaPreservationPush 5 + (formulaPreservationGoto 19))) + .halt + +private abbrev formulaPreservationMachine : Turing.FinTM2 where + K := Fin 8 + k₀ := 0 + k₁ := 5 + Γ _ := Bool + Λ := Fin 20 + main := 17 + σ := Option Bool + initialState := none + m phase := + if h : phase.val < 17 then + liftFormulaPreservationCanonicalStmt + (canonicalFormulaMachine.m ⟨phase.val, h⟩) + else if phase = (17 : Fin 20) then + formulaPreservationCopyStatement + else if phase = (18 : Fin 20) then + formulaPreservationRestoreStatement + else + formulaPreservationOutputStatement + +private def formulaPreservationConfiguration (phase : Fin 20) + (input counter field binary borrow output backup scratch : List Bool) : + formulaPreservationMachine.Cfg where + l := some phase + var := none + stk := ![input, counter, field, binary, + borrow, output, backup, scratch] + +private theorem formulaPreservationMachine_init (input : List Bool) : + Turing.initList formulaPreservationMachine input = + formulaPreservationConfiguration 17 + input [] [] [] [] [] [] [] := by + simp only [formulaPreservationMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + formulaPreservationConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `formulaPreservationStepTac` machine-step simplifier. -/ +macro "formulaPreservationStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [formulaPreservationMachine, + formulaPreservationConfiguration, + formulaPreservationCopyStatement, + formulaPreservationRestoreStatement, + formulaPreservationOutputStatement, + formulaPreservationPeek, + formulaPreservationPop, formulaPreservationPush, + formulaPreservationGoto, Turing.haltList, + Turing.FinTM2.step, Turing.TM2.step, + Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem formulaPreservation_copy_step (bit : Bool) + (input counter field binary borrow output backup scratch : List Bool) : + formulaPreservationMachine.step + (formulaPreservationConfiguration 17 + (bit :: input) counter field binary borrow output backup scratch) = + some (formulaPreservationConfiguration 17 + input counter field binary borrow output + (bit :: backup) (bit :: scratch)) := by + cases bit <;> formulaPreservationStepTac + +private theorem formulaPreservation_copy_finish + (counter field binary borrow output backup scratch : List Bool) : + formulaPreservationMachine.step + (formulaPreservationConfiguration 17 + [] counter field binary borrow output backup scratch) = + some (formulaPreservationConfiguration 18 + [] counter field binary borrow output backup scratch) := by + formulaPreservationStepTac + +private theorem formulaPreservation_restore_step (bit : Bool) + (input counter field binary borrow output backup scratch : List Bool) : + formulaPreservationMachine.step + (formulaPreservationConfiguration 18 + input counter field binary borrow output backup + (bit :: scratch)) = + some (formulaPreservationConfiguration 18 + (bit :: input) counter field binary borrow output backup scratch) := by + cases bit <;> formulaPreservationStepTac + +private theorem formulaPreservation_restore_finish + (input counter field binary borrow output backup : List Bool) : + formulaPreservationMachine.step + (formulaPreservationConfiguration 18 + input counter field binary borrow output backup []) = + some (formulaPreservationConfiguration 0 + input counter field binary borrow output backup []) := by + formulaPreservationStepTac + +private theorem formulaPreservation_output_step (bit : Bool) + (input counter field binary borrow output backup scratch : List Bool) : + formulaPreservationMachine.step + (formulaPreservationConfiguration 19 + input counter field binary borrow output + (bit :: backup) scratch) = + some (formulaPreservationConfiguration 19 + input counter field binary borrow (bit :: output) + backup scratch) := by + cases bit <;> formulaPreservationStepTac + +private theorem formulaPreservation_output_finish (output : List Bool) : + formulaPreservationMachine.step + (formulaPreservationConfiguration 19 + [] [] [] [] [] output [] []) = + some (Turing.haltList formulaPreservationMachine output) := by + formulaPreservationStepTac + +private def formulaPreservationCanonicalStacks + (source : (stack : Fin 6) → List Bool) + (backup scratch : List Bool) : + (stack : Fin 8) → List Bool := + ![source 0, source 1, source 2, source 3, + source 4, source 5, backup, scratch] + +@[simp] private theorem formulaPreservationCanonicalStacks_apply + (source : (stack : Fin 6) → List Bool) + (backup scratch : List Bool) (stack : Fin 6) : + formulaPreservationCanonicalStacks source backup scratch + (formulaPreservationCanonicalStack stack) = source stack := by + fin_cases stack <;> + simp [formulaPreservationCanonicalStacks, + formulaPreservationCanonicalStack] + +private theorem formulaPreservationCanonicalStacks_update + (source : (stack : Fin 6) → List Bool) + (backup scratch : List Bool) (stack : Fin 6) + (value : List Bool) : + formulaPreservationCanonicalStacks + (Function.update source stack value) + backup scratch = + Function.update + (formulaPreservationCanonicalStacks source backup scratch) + (formulaPreservationCanonicalStack stack) value := by + funext target + fin_cases stack <;> fin_cases target <;> + simp [formulaPreservationCanonicalStacks, + formulaPreservationCanonicalStack, Function.update] + +private def formulaPreservationCanonicalConfiguration + (source : canonicalFormulaMachine.Cfg) + (backup scratch : List Bool) : + formulaPreservationMachine.Cfg where + l := match source.l with + | some phase => some (formulaPreservationCanonicalLabel phase) + | none => some 19 + var := source.var + stk := formulaPreservationCanonicalStacks + source.stk backup scratch + +private theorem formulaPreservationCanonicalProgram (phase : Fin 17) : + formulaPreservationMachine.m + (formulaPreservationCanonicalLabel phase) = + liftFormulaPreservationCanonicalStmt + (canonicalFormulaMachine.m phase) := by + simp only [formulaPreservationMachine, Fin.isValue, formulaPreservationCanonicalLabel, Fin.is_lt, + ↓reduceDIte, Fin.eta] + rfl + +private theorem liftFormulaPreservationCanonicalStmt_stepAux + (statement : Turing.TM2.Stmt + (fun _ : Fin 6 => Bool) (Fin 17) (Option Bool)) + (state : Option Bool) + (source : (stack : Fin 6) → List Bool) + (backup scratch : List Bool) : + Turing.TM2.stepAux + (liftFormulaPreservationCanonicalStmt statement) + state + (formulaPreservationCanonicalStacks + source backup scratch) = + formulaPreservationCanonicalConfiguration + (Turing.TM2.stepAux statement state source) + backup scratch := by + induction statement generalizing state source with + | push stack push continuation ih => + simp only [liftFormulaPreservationCanonicalStmt, + Turing.TM2.stepAux, + formulaPreservationCanonicalStacks_apply] + rw [← formulaPreservationCanonicalStacks_update] + exact ih state (Function.update source stack + (push state :: source stack)) + | peek stack peek continuation ih => + simpa only [liftFormulaPreservationCanonicalStmt, + Turing.TM2.stepAux, + formulaPreservationCanonicalStacks_apply] using + ih (peek state (source stack).head?) source + | pop stack pop continuation ih => + simp only [liftFormulaPreservationCanonicalStmt, + Turing.TM2.stepAux, + formulaPreservationCanonicalStacks_apply] + rw [← formulaPreservationCanonicalStacks_update] + exact ih (pop state (source stack).head?) + (Function.update source stack (source stack).tail) + | load load continuation ih => + simpa only [liftFormulaPreservationCanonicalStmt, + Turing.TM2.stepAux] using + ih (load state) source + | branch branch yes no ihyes ihno => + cases hbranch : branch state with + | false => + simpa only [liftFormulaPreservationCanonicalStmt, TM2.stepAux, hbranch, Bool.cond_false] + using ihno state source + | true => + simpa only [liftFormulaPreservationCanonicalStmt, TM2.stepAux, hbranch, Bool.cond_true] + using ihyes state source + | goto target => + rfl + | halt => + rfl + +private theorem formulaPreservationCanonicalConfiguration_step + (backup scratch : List Bool) + (source target : canonicalFormulaMachine.Cfg) + (hstep : canonicalFormulaMachine.step source = some target) : + formulaPreservationMachine.step + (formulaPreservationCanonicalConfiguration + source backup scratch) = + some (formulaPreservationCanonicalConfiguration + target backup scratch) := by + rcases source with ⟨phase, state, sourceStacks⟩ + cases phase with + | none => + simp only [FinTM2.step, TM2.step, reduceCtorEq] at hstep + | some phase => + change some (Turing.TM2.stepAux + (canonicalFormulaMachine.m phase) + state sourceStacks) = some target at hstep + have htarget := Option.some.inj hstep + subst target + change some (Turing.TM2.stepAux + (formulaPreservationMachine.m + (formulaPreservationCanonicalLabel phase)) + state (formulaPreservationCanonicalStacks + sourceStacks backup scratch)) = + some (formulaPreservationCanonicalConfiguration + (Turing.TM2.stepAux + (canonicalFormulaMachine.m phase) + state sourceStacks) + backup scratch) + rw [formulaPreservationCanonicalProgram, + liftFormulaPreservationCanonicalStmt_stepAux] + rfl + +private noncomputable def formulaPreservationCanonical_evalsToInTime + (backup scratch : List Bool) + {source target : canonicalFormulaMachine.Cfg} + {budget : ℕ} + (trace : EvalsToInTime + canonicalFormulaMachine.step + source (some target) budget) : + EvalsToInTime formulaPreservationMachine.step + (formulaPreservationCanonicalConfiguration + source backup scratch) + (some (formulaPreservationCanonicalConfiguration + target backup scratch)) budget := + GapCVP.TMComposition.evalsToInTimeMapOfStep + canonicalFormulaMachine.step + formulaPreservationMachine.step + (fun state => formulaPreservationCanonicalConfiguration + state backup scratch) + (formulaPreservationCanonicalConfiguration_step + backup scratch) + trace + +private def formulaPreservation_copyTrace + (input counter field binary borrow output backup scratch : List Bool) : + EvalsToInTime formulaPreservationMachine.step (formulaPreservationConfiguration 17 + input counter field binary borrow output backup scratch) + (some (formulaPreservationConfiguration 18 + [] counter field binary borrow output + (input.reverse ++ backup) (input.reverse ++ scratch))) + (input.length + 1) := by + induction input generalizing backup scratch with + | nil => + simpa only [FinTM2.step, Fin.isValue, Fin.mk_eq_zero, Fin.val_eq_zero_iff, Fin.mk_eq_one, + List.reverse_nil, + List.nil_append, List.length_nil, zero_add] using + oneStep _ _ (formulaPreservation_copy_finish counter field binary borrow output backup + scratch) + | cons bit rest ih => + have hfirst := oneStep _ _ (formulaPreservation_copy_step bit rest + counter field binary borrow output backup scratch) + have hrest := ih (bit :: backup) (bit :: scratch) + have hfull := EvalsToInTime.trans formulaPreservationMachine.step 1 (rest.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, Fin.mk_eq_zero, Fin.val_eq_zero_iff, Fin.mk_eq_one, + List.reverse_cons, + List.append_assoc, List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, + Nat.reduceAdd] using hfull + +private def formulaPreservation_restoreTrace + (scratch input counter field binary borrow output backup : List Bool) : + EvalsToInTime formulaPreservationMachine.step (formulaPreservationConfiguration 18 + input counter field binary borrow output backup scratch) + (some (formulaPreservationConfiguration 0 + (scratch.reverse ++ input) counter field binary + borrow output backup [])) + (scratch.length + 1) := by + induction scratch generalizing input with + | nil => + simpa only [FinTM2.step, Fin.isValue, Fin.mk_eq_zero, Fin.val_eq_zero_iff, Fin.mk_eq_one, + List.reverse_nil, + List.nil_append, List.length_nil, zero_add] using + oneStep _ _ (formulaPreservation_restore_finish input counter field binary borrow output + backup) + | cons bit rest ih => + have hfirst := oneStep _ _ (formulaPreservation_restore_step bit + input counter field binary borrow output backup rest) + have hrest := ih (bit :: input) + have hfull := EvalsToInTime.trans formulaPreservationMachine.step 1 (rest.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, Fin.mk_eq_zero, Fin.val_eq_zero_iff, Fin.mk_eq_one, + List.reverse_cons, + List.append_assoc, List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, + Nat.reduceAdd] using hfull + +private theorem formulaPreservationCanonical_initial + (input backup scratch : List Bool) : + formulaPreservationCanonicalConfiguration + (canonicalConfiguration 0 input [] [] [] [] []) + backup scratch = + formulaPreservationConfiguration 0 + input [] [] [] [] [] backup scratch := by + simp only [formulaPreservationCanonicalConfiguration, canonicalConfiguration, Fin.isValue, + formulaPreservationCanonicalLabel, Fin.coe_ofNat_eq_mod, Nat.zero_mod, Fin.zero_eta, + formulaPreservationCanonicalStacks, Matrix.cons_val_zero, Matrix.cons_val_one, + Matrix.cons_val, + formulaPreservationConfiguration] + rfl + +private theorem formulaPreservationCanonical_halt + (output backup scratch : List Bool) : + formulaPreservationCanonicalConfiguration + (Turing.haltList canonicalFormulaMachine output) + backup scratch = + formulaPreservationConfiguration 19 + [] [] [] [] [] output backup scratch := by + simp only [formulaPreservationCanonicalConfiguration, canonicalFormulaMachine, Fin.isValue, + haltList, + eq_mpr_eq_cast, cast_eq, dite_eq_ite, formulaPreservationCanonicalStacks, Fin.reduceEq, + ↓reduceIte, + formulaPreservationConfiguration] + rfl + +private def formulaPreservation_outputTrace + (backup output : List Bool) : + EvalsToInTime formulaPreservationMachine.step (formulaPreservationConfiguration 19 + [] [] [] [] [] output backup []) + (some (Turing.haltList formulaPreservationMachine + (backup.reverse ++ output))) + (backup.length + 1) := by + induction backup generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, Fin.mk_eq_zero, Fin.val_eq_zero_iff, Fin.mk_eq_one, + List.reverse_nil, + List.nil_append, List.length_nil, zero_add] using oneStep _ _ + (formulaPreservation_output_finish output) + | cons bit rest ih => + have hfirst := oneStep _ _ (formulaPreservation_output_step bit + [] [] [] [] [] output rest []) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans formulaPreservationMachine.step 1 (rest.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, Fin.mk_eq_zero, Fin.val_eq_zero_iff, Fin.mk_eq_one, + List.reverse_cons, + List.append_assoc, List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, + Nat.reduceAdd] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def formulaPreservedOutput (input : List Bool) : List Bool := + input ++ canonicalMachineOutput input + +private def formulaPreservationInputBudget (input : List Bool) : ℕ := + canonicalInputBudget input + 4 * input.length + 4 + +private noncomputable def formulaPreservation_totalTrace (input : List Bool) : + EvalsToInTime formulaPreservationMachine.step (formulaPreservationConfiguration 17 + input [] [] [] [] [] [] []) + (some (Turing.haltList formulaPreservationMachine + (formulaPreservedOutput input))) + (formulaPreservationInputBudget input) := by + have hcopy := formulaPreservation_copyTrace + input [] [] [] [] [] [] [] + simp only [List.append_nil] at hcopy + have hrestore := formulaPreservation_restoreTrace + input.reverse [] [] [] [] [] [] input.reverse + simp only [List.reverse_reverse, List.append_nil, + List.length_reverse] at hrestore + have hcanonical := formulaPreservationCanonical_evalsToInTime + input.reverse [] (canonicalTotalTrace input) + rw [formulaPreservationCanonical_initial, + formulaPreservationCanonical_halt] at hcanonical + have houtput := formulaPreservation_outputTrace + input.reverse (canonicalMachineOutput input) + simp only [List.reverse_reverse, List.length_reverse] at houtput + have hfirst := EvalsToInTime.trans formulaPreservationMachine.step _ _ _ _ _ hcopy hrestore + have hsecond := EvalsToInTime.trans formulaPreservationMachine.step _ _ _ _ _ hfirst hcanonical + have hfull := EvalsToInTime.trans formulaPreservationMachine.step _ _ _ _ _ hsecond houtput + apply rebound hfull + simp only [formulaPreservationInputBudget] + omega + +private noncomputable def formulaPreservationComputable : + BitTM + formulaPreservedOutput where + tm := formulaPreservationMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := + 64 * (Polynomial.X + 1) * (Polynomial.X + 1) + + 64 + 4 * Polynomial.X + 4 + outputsFun input := { + steps := (formulaPreservation_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Fin.mk_eq_zero, + Fin.val_eq_zero_iff, Fin.mk_eq_one, + Equiv.invFun_as_coe, Equiv.refl_symm, Equiv.coe_refl, bitEncoding, id_eq, + List.map_id_fun, + formulaPreservationMachine_init, Option.map_some] using (formulaPreservation_totalTrace + input).evals_in_steps + steps_le_m := by + have hsteps := (formulaPreservation_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, Fin.mk_eq_zero, Fin.val_eq_zero_iff, Fin.mk_eq_one, + formulaPreservationInputBudget, canonicalInputBudget, bitEncoding, id_eq, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, Polynomial.eval_one, ge_iff_le] using hsteps + } + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem formulaPreservedOutput_eq_expected (input : List Bool) : + formulaPreservedOutput input = + input ++ canonicalFormulaExpected input := by + simp only [formulaPreservedOutput, canonicalMachineOutput_eq_expected] + +end SourceLatticeFormulaPreservation + +namespace SourceLatticeDependentSectionComputation + +open Turing GapCVP.SourceLatticeFormulaPreservation + +private def sourceMarkerPeek (stack : Fin 3) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def sourceMarkerPop (stack : Fin 3) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .pop stack (fun state _ => state) continuation + +private def sourceMarkerPush (stack : Fin 3) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .push stack (fun state => state.getD false) continuation + +private def sourceMarkerGoto (phase : Fin 4) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +private abbrev sourceMarkerRotationMachine : Turing.FinTM2 where + K := Fin 3 + k₀ := 0 + k₁ := 2 + Γ _ := Bool + Λ := Fin 4 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 4) then + sourceMarkerPeek 0 + (sourceMarkerPop 0 + (sourceMarkerPush 1 (sourceMarkerGoto 0))) + (sourceMarkerGoto 1) + else if phase = (1 : Fin 4) then + sourceMarkerPeek 1 + (sourceMarkerPop 1 + (sourceMarkerPush 0 (sourceMarkerGoto 2))) + (.push 0 (fun _ => false) (sourceMarkerGoto 2)) + else if phase = (2 : Fin 4) then + sourceMarkerPeek 1 + (sourceMarkerPop 1 + (sourceMarkerPush 2 (sourceMarkerGoto 2))) + (sourceMarkerGoto 3) + else + sourceMarkerPeek 0 + (sourceMarkerPop 0 + (sourceMarkerPush 2 (.load (fun _ => none) .halt))) + .halt + +private def sourceMarkerConfiguration (phase : Fin 4) + (input scratch output : List Bool) : + sourceMarkerRotationMachine.Cfg where + l := some phase + var := none + stk := ![input, scratch, output] + +private theorem sourceMarkerRotationMachine_init (input : List Bool) : + Turing.initList sourceMarkerRotationMachine input = + sourceMarkerConfiguration 0 input [] [] := by + simp only [sourceMarkerRotationMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + sourceMarkerConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `sourceMarkerStepTac` machine-step simplifier. -/ +macro "sourceMarkerStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [sourceMarkerRotationMachine, + sourceMarkerConfiguration, sourceMarkerPeek, + sourceMarkerPop, sourceMarkerPush, sourceMarkerGoto, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem sourceMarker_copy_step (bit : Bool) + (input scratch output : List Bool) : + sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 0 + (bit :: input) scratch output) = + some (sourceMarkerConfiguration 0 + input (bit :: scratch) output) := by + cases bit <;> sourceMarkerStepTac + +private theorem sourceMarker_copy_finish + (scratch output : List Bool) : + sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 0 [] scratch output) = + some (sourceMarkerConfiguration 1 [] scratch output) := by + sourceMarkerStepTac + +private theorem sourceMarker_extract_step (bit : Bool) + (scratch output : List Bool) : + sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 1 [] (bit :: scratch) output) = + some (sourceMarkerConfiguration 2 [bit] scratch output) := by + cases bit <;> sourceMarkerStepTac + +private theorem sourceMarker_extract_missing (output : List Bool) : + sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 1 [] [] output) = + some (sourceMarkerConfiguration 2 [false] [] output) := by + sourceMarkerStepTac + +private theorem sourceMarker_restore_step (bit : Bool) + (input scratch output : List Bool) : + sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 2 + input (bit :: scratch) output) = + some (sourceMarkerConfiguration 2 + input scratch (bit :: output)) := by + cases bit <;> sourceMarkerStepTac + +private theorem sourceMarker_restore_finish + (input output : List Bool) : + sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 2 input [] output) = + some (sourceMarkerConfiguration 3 input [] output) := by + sourceMarkerStepTac + +private theorem sourceMarker_output_finish (bit : Bool) + (output : List Bool) : + sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 3 [bit] [] output) = + some (Turing.haltList sourceMarkerRotationMachine + (bit :: output)) := by + cases bit <;> sourceMarkerStepTac + +private def sourceMarker_copyTrace + (input scratch output : List Bool) : + EvalsToInTime sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 0 input scratch output) + (some (sourceMarkerConfiguration 1 [] + (input.reverse ++ scratch) output)) + (input.length + 1) := by + induction input generalizing scratch with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (sourceMarker_copy_finish scratch output) + | cons bit rest ih => + have hfirst := oneStep _ _ (sourceMarker_copy_step bit rest scratch output) + have hrest := ih (bit :: scratch) + have hfull := EvalsToInTime.trans sourceMarkerRotationMachine.step 1 (rest.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def sourceMarker_restoreTrace + (scratch input output : List Bool) : + EvalsToInTime sourceMarkerRotationMachine.step + (sourceMarkerConfiguration 2 input scratch output) + (some (sourceMarkerConfiguration 3 input [] + (scratch.reverse ++ output))) + (scratch.length + 1) := by + induction scratch generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (sourceMarker_restore_finish input output) + | cons bit rest ih => + have hfirst := oneStep _ _ (sourceMarker_restore_step bit input rest output) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans sourceMarkerRotationMachine.step 1 (rest.length + 1) + _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceMarkerRotatedOutput (input : List Bool) : List Bool := + match input.reverse with + | [] => [false] + | marker :: formula => marker :: formula.reverse + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem sourceMarkerRotatedOutput_append_marker + (input : List Bool) (marker : Bool) : + sourceMarkerRotatedOutput (input ++ [marker]) = + marker :: input := by + simp only [sourceMarkerRotatedOutput, List.reverse_append, List.reverse_cons, List.reverse_nil, + List.nil_append, List.cons_append, List.reverse_reverse] + +private def sourceMarker_totalTrace (input : List Bool) : + EvalsToInTime sourceMarkerRotationMachine.step (sourceMarkerConfiguration 0 input [] []) + (some (Turing.haltList sourceMarkerRotationMachine + (sourceMarkerRotatedOutput input))) + (2 * input.length + 5) := by + have hcopy := sourceMarker_copyTrace input [] [] + simp only [List.append_nil] at hcopy + cases input with + | nil => + have hextract := oneStep _ _ (sourceMarker_extract_missing []) + have hrestore := sourceMarker_restoreTrace [] [false] [] + have hfinish := oneStep _ _ (sourceMarker_output_finish false []) + have hfirst := EvalsToInTime.trans sourceMarkerRotationMachine.step _ _ _ _ _ hcopy hextract + have hsecond := EvalsToInTime.trans sourceMarkerRotationMachine.step _ _ _ _ _ hfirst + hrestore + have hfull := EvalsToInTime.trans sourceMarkerRotationMachine.step _ _ _ _ _ hsecond hfinish + have hbounded := rebound (newBudget := 2 * ([] : List Bool).length + 5) + hfull (by simp only [List.length_nil, zero_add, Nat.reduceAdd, mul_zero, Nat.reduceLeDiff]) + simpa only [FinTM2.step, Fin.isValue, sourceMarkerRotatedOutput, List.reverse_nil, + List.length_nil, mul_zero, + zero_add] using hbounded + | cons first rest => + cases hreverse : (first :: rest).reverse with + | nil => + have hnonempty : + 0 < (first :: rest).reverse.length := by simp only [List.reverse_cons, + List.length_append, List.length_reverse, List.length_cons, List.length_nil, + zero_add, lt_add_iff_pos_left, + Order.lt_add_one_iff, zero_le] + rw [hreverse] at hnonempty + simp only [List.length_nil, lt_self_iff_false] at hnonempty + | cons marker formula => + rw [hreverse] at hcopy + have hextract := oneStep _ _ (sourceMarker_extract_step marker formula []) + have hrestore := sourceMarker_restoreTrace + formula [marker] [] + simp only [List.append_nil] at hrestore + have hfinish := oneStep _ _ (sourceMarker_output_finish marker formula.reverse) + have hfirst := EvalsToInTime.trans + sourceMarkerRotationMachine.step _ _ _ _ _ hcopy hextract + have hsecond := EvalsToInTime.trans + sourceMarkerRotationMachine.step _ _ _ _ _ hfirst hrestore + have hfull := EvalsToInTime.trans + sourceMarkerRotationMachine.step _ _ _ _ _ hsecond hfinish + have hlength : + formula.length + 1 = (first :: rest).length := by + have h := congrArg List.length hreverse + simpa only [List.length_reverse, List.length_cons] using + h.symm + have hbounded := rebound (newBudget := 2 * (first :: rest).length + 5) + hfull (by + simp only [List.length_cons] at hlength ⊢ + omega) + simpa only [FinTM2.step, Fin.isValue, sourceMarkerRotatedOutput, hreverse, + List.length_cons] using hbounded + +private noncomputable def sourceMarkerRotationComputable : + BitTM + sourceMarkerRotatedOutput where + tm := sourceMarkerRotationMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 2 * Polynomial.X + 5 + outputsFun input := { + steps := (sourceMarker_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, sourceMarkerRotationMachine_init, + Option.map_some] using + (sourceMarker_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (sourceMarker_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +/-- Internal support shared across GapCVP continuation modules. -/ +def validatedPreservedFormulaOutput : List Bool → List Bool := + sourceMarkerRotatedOutput ∘ formulaPreservedOutput + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def validatedPreservedFormulaComputable : + BitTM + validatedPreservedFormulaOutput := + GapCVP.TMComposition.computableInPolyTime + formulaPreservationComputable sourceMarkerRotationComputable + +end SourceLatticeDependentSectionComputation + +namespace SourceLatticeNormalizedSectionSynthesis + +open Turing + +/-- Internal support shared across GapCVP continuation modules. -/ +def normalizedRadiusPeek (stack : Fin 5) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +/-- Internal support shared across GapCVP continuation modules. -/ +def normalizedRadiusPop (stack : Fin 5) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .pop stack (fun _ _ => none) continuation + +/-- Internal support shared across GapCVP continuation modules. -/ +def normalizedRadiusPush (stack : Fin 5) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .push stack (fun _ => true) continuation + +/-- Internal support shared across GapCVP continuation modules. -/ +def normalizedRadiusGoto (phase : Fin 7) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +private def normalizedRadiusFailureCheck (stack : Fin 5) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + normalizedRadiusPeek stack + (normalizedRadiusPop stack (normalizedRadiusGoto 6)) + continuation + +end SourceLatticeNormalizedSectionSynthesis + +namespace SourceLatticeStructuralRadiusNumerator + +open Turing + +private def radiusMarkerTailPeek (stack : Fin 3) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def radiusMarkerTailPop (stack : Fin 3) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool) := + .pop stack (fun symbol _ => symbol) continuation + +private def radiusMarkerTailPush (stack : Fin 3) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool) := + .push stack (fun symbol => symbol.getD false) continuation + +private def radiusMarkerTailGoto (phase : Fin 3) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +private def radiusMarkerTailDropStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool) := + radiusMarkerTailPeek 0 + (radiusMarkerTailPop 0 (radiusMarkerTailGoto 1)) + .halt + +private def radiusMarkerTailCopyStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool) := + radiusMarkerTailPeek 0 + (radiusMarkerTailPop 0 + (radiusMarkerTailPush 1 (radiusMarkerTailGoto 1))) + (radiusMarkerTailGoto 2) + +private def radiusMarkerTailOutputStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 3) (Option Bool) := + radiusMarkerTailPeek 1 + (radiusMarkerTailPop 1 + (radiusMarkerTailPush 2 (radiusMarkerTailGoto 2))) + .halt + +private abbrev radiusMarkerTailMachine : Turing.FinTM2 where + K := Fin 3 + k₀ := 0 + k₁ := 2 + Γ _ := Bool + Λ := Fin 3 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 3) then + radiusMarkerTailDropStatement + else if phase = (1 : Fin 3) then + radiusMarkerTailCopyStatement + else + radiusMarkerTailOutputStatement + +private def radiusMarkerTailConfiguration (phase : Fin 3) + (input scratch output : List Bool) : radiusMarkerTailMachine.Cfg where + l := some phase + var := none + stk := ![input, scratch, output] + +private theorem radiusMarkerTailMachine_init (input : List Bool) : + Turing.initList radiusMarkerTailMachine input = + radiusMarkerTailConfiguration 0 input [] [] := by + simp only [radiusMarkerTailMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + radiusMarkerTailConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `radiusMarkerTailStepTac` machine-step simplifier. -/ +macro "radiusMarkerTailStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [radiusMarkerTailMachine, radiusMarkerTailConfiguration, + radiusMarkerTailPeek, radiusMarkerTailPop, + radiusMarkerTailPush, radiusMarkerTailGoto, + radiusMarkerTailDropStatement, + radiusMarkerTailCopyStatement, + radiusMarkerTailOutputStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem radiusMarkerTail_empty_finish : + radiusMarkerTailMachine.step + (radiusMarkerTailConfiguration 0 [] [] []) = + some (Turing.haltList radiusMarkerTailMachine []) := by + radiusMarkerTailStepTac + +private theorem radiusMarkerTail_drop_step (bit : Bool) + (input scratch output : List Bool) : + radiusMarkerTailMachine.step + (radiusMarkerTailConfiguration 0 + (bit :: input) scratch output) = + some (radiusMarkerTailConfiguration 1 + input scratch output) := by + cases bit <;> radiusMarkerTailStepTac + +private theorem radiusMarkerTail_copy_step (bit : Bool) + (input scratch output : List Bool) : + radiusMarkerTailMachine.step + (radiusMarkerTailConfiguration 1 + (bit :: input) scratch output) = + some (radiusMarkerTailConfiguration 1 + input (bit :: scratch) output) := by + cases bit <;> radiusMarkerTailStepTac + +private theorem radiusMarkerTail_copy_finish + (scratch output : List Bool) : + radiusMarkerTailMachine.step + (radiusMarkerTailConfiguration 1 [] scratch output) = + some (radiusMarkerTailConfiguration 2 [] scratch output) := by + radiusMarkerTailStepTac + +private theorem radiusMarkerTail_output_step (bit : Bool) + (scratch output : List Bool) : + radiusMarkerTailMachine.step + (radiusMarkerTailConfiguration 2 + [] (bit :: scratch) output) = + some (radiusMarkerTailConfiguration 2 + [] scratch (bit :: output)) := by + cases bit <;> radiusMarkerTailStepTac + +private theorem radiusMarkerTail_output_finish (output : List Bool) : + radiusMarkerTailMachine.step + (radiusMarkerTailConfiguration 2 [] [] output) = + some (Turing.haltList radiusMarkerTailMachine output) := by + radiusMarkerTailStepTac + +private def radiusMarkerTail_copyTrace + (input scratch output : List Bool) : + EvalsToInTime radiusMarkerTailMachine.step + (radiusMarkerTailConfiguration 1 input scratch output) + (some (radiusMarkerTailConfiguration 2 [] + (input.reverse ++ scratch) output)) + (input.length + 1) := by + induction input generalizing scratch with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (radiusMarkerTail_copy_finish scratch output) + | cons bit input ih => + have hfirst := oneStep _ _ (radiusMarkerTail_copy_step bit input scratch output) + have hrest := ih (bit :: scratch) + have hfull := EvalsToInTime.trans radiusMarkerTailMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def radiusMarkerTail_outputTrace (scratch output : List Bool) : + EvalsToInTime radiusMarkerTailMachine.step (radiusMarkerTailConfiguration 2 [] scratch output) + (some (Turing.haltList radiusMarkerTailMachine + (scratch.reverse ++ output))) + (scratch.length + 1) := by + induction scratch generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (radiusMarkerTail_output_finish output) + | cons bit scratch ih => + have hfirst := oneStep _ _ (radiusMarkerTail_output_step bit scratch output) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans radiusMarkerTailMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def radiusMarkerTail_totalTrace (input : List Bool) : + EvalsToInTime radiusMarkerTailMachine.step (radiusMarkerTailConfiguration 0 input [] []) + (some (Turing.haltList radiusMarkerTailMachine input.tail)) + (2 * input.length + 3) := by + cases input with + | nil => + exact rebound (oneStep _ _ radiusMarkerTail_empty_finish) + (by simp only [List.length_nil, mul_zero, zero_add, Nat.one_le_ofNat]) + | cons bit input => + have hdrop := oneStep _ _ (radiusMarkerTail_drop_step bit input [] []) + have hcopy := radiusMarkerTail_copyTrace input [] [] + simp only [List.append_nil] at hcopy + have houtput := radiusMarkerTail_outputTrace input.reverse [] + simp only [List.reverse_reverse, List.append_nil] at houtput + have hfirst := EvalsToInTime.trans radiusMarkerTailMachine.step _ _ _ _ _ hdrop hcopy + have hfull := EvalsToInTime.trans radiusMarkerTailMachine.step _ _ _ _ _ hfirst houtput + exact rebound hfull (by + simp only [List.length_reverse, List.length_cons] + omega) + +/-- GapCVP reduction support. -/ +noncomputable def radiusMarkerTailComputable : + Turing.TM2ComputableInPolyTime GapCVP.bitEncoding + GapCVP.bitEncoding (fun input : List Bool => input.tail) where + tm := radiusMarkerTailMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 2 * Polynomial.X + 3 + outputsFun input := { + steps := (radiusMarkerTail_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, radiusMarkerTailMachine_init, + List.map_tail, + Option.map_some] using (radiusMarkerTail_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (radiusMarkerTail_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +end SourceLatticeStructuralRadiusNumerator + +namespace SourceLatticeStructuralRationalRadius + +open GapCVP.BinaryEncoding + +private theorem sourceRationalNatCast_encode_pair (number : ℕ) : + Encodable.encode (number : ℚ) = + Nat.pair (2 * number) 1 := by + rfl + +private theorem sourceRationalNatCast_encode (number : ℕ) : + Encodable.encode (number : ℚ) = + 4 * number ^ 2 + 2 * number + 1 := by + rw [sourceRationalNatCast_encode_pair] + by_cases hzero : number = 0 + · subst number + norm_num [Nat.pair] + · have hcomparison : ¬ 2 * number < 1 := by omega + simp only [Nat.pair, hcomparison, ↓reduceIte, Nat.add_right_cancel_iff] + ring + +theorem sourceRationalNatCast_atomic (number : ℕ) : + encodeAtomic (number : ℚ) = + lengthPrefixedWord + (Computability.encodeNat + (4 * number ^ 2 + 2 * number + 1)) := by + simp only [encodeAtomic, sourceRationalNatCast_encode] + +end SourceLatticeStructuralRationalRadius + +namespace SourceLatticeStructuralRationalRadiusTM + +open Turing GapCVP.SourceLatticeNormalizedSectionSynthesis + +/-- Internal support shared across GapCVP continuation modules. -/ +def rationalRadiusFailureStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + normalizedRadiusFailureCheck 0 + (normalizedRadiusFailureCheck 1 + (normalizedRadiusFailureCheck 2 + (normalizedRadiusFailureCheck 3 + (normalizedRadiusFailureCheck 4 + (.push 4 (fun _ => false) + (.load (fun _ => none) .halt)))))) + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev rationalRadiusMachine : Turing.FinTM2 where + K := Fin 5 + k₀ := 0 + k₁ := 4 + Γ _ := Bool + Λ := Fin 7 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 7) then + normalizedRadiusPeek 0 + (.branch (fun symbol => symbol == some true) + (normalizedRadiusPop 0 + (normalizedRadiusPush 4 (normalizedRadiusGoto 1))) + (normalizedRadiusPop 0 (normalizedRadiusGoto 6))) + (normalizedRadiusGoto 6) + else if phase = (1 : Fin 7) then + normalizedRadiusPeek 0 + (.branch (fun symbol => symbol == some true) + (normalizedRadiusPop 0 + (normalizedRadiusPush 1 + (normalizedRadiusPush 1 + (normalizedRadiusPush 2 + (normalizedRadiusPush 2 + (normalizedRadiusPush 4 + (normalizedRadiusPush 4 + (normalizedRadiusGoto 1)))))))) + (normalizedRadiusPop 0 (normalizedRadiusGoto 6))) + (normalizedRadiusGoto 2) + else if phase = (2 : Fin 7) then + normalizedRadiusPeek 2 + (normalizedRadiusPop 2 (normalizedRadiusGoto 3)) + (normalizedRadiusGoto 5) + else if phase = (3 : Fin 7) then + normalizedRadiusPeek 1 + (normalizedRadiusPop 1 + (normalizedRadiusPush 3 + (normalizedRadiusPush 4 (normalizedRadiusGoto 3)))) + (normalizedRadiusGoto 4) + else if phase = (4 : Fin 7) then + normalizedRadiusPeek 3 + (normalizedRadiusPop 3 + (normalizedRadiusPush 1 (normalizedRadiusGoto 4))) + (normalizedRadiusGoto 2) + else if phase = (5 : Fin 7) then + normalizedRadiusPeek 1 + (normalizedRadiusPop 1 (normalizedRadiusGoto 5)) + (.push 4 (fun _ => true) + (.load (fun _ => none) .halt)) + else + rationalRadiusFailureStatement + +/-- Internal support shared across GapCVP continuation modules. -/ +def rationalRadiusConfiguration (phase : Fin 7) + (input base outer restore output : List Bool) : + rationalRadiusMachine.Cfg where + l := some phase + var := none + stk := ![input, base, outer, restore, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadiusMachine_init (input : List Bool) : + Turing.initList rationalRadiusMachine input = + rationalRadiusConfiguration 0 input [] [] [] [] := by + simp only [rationalRadiusMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + rationalRadiusConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `rationalRadiusStepTac` machine-step simplifier. -/ +macro "rationalRadiusStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [rationalRadiusMachine, + rationalRadiusConfiguration, + rationalRadiusFailureStatement, + normalizedRadiusPeek, normalizedRadiusPop, + normalizedRadiusPush, normalizedRadiusGoto, + normalizedRadiusFailureCheck, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_marker_true_step + (input base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 0 + (true :: input) base outer restore output) = + some (rationalRadiusConfiguration 1 + input base outer restore (true :: output)) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_marker_false_step + (input base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 0 + (false :: input) base outer restore output) = + some (rationalRadiusConfiguration 6 + input base outer restore output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_marker_missing_step + (base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 0 [] + base outer restore output) = + some (rationalRadiusConfiguration 6 [] + base outer restore output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_scan_true_step + (input base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 1 + (true :: input) base outer restore output) = + some (rationalRadiusConfiguration 1 input + (true :: true :: base) + (true :: true :: outer) + restore (true :: true :: output)) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_scan_false_step + (input base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 1 + (false :: input) base outer restore output) = + some (rationalRadiusConfiguration 6 + input base outer restore output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_scan_finish + (base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 1 [] + base outer restore output) = + some (rationalRadiusConfiguration 2 [] + base outer restore output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_outer_step + (base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 2 [] + base (true :: outer) restore output) = + some (rationalRadiusConfiguration 3 [] + base outer restore output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_outer_finish + (base restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 2 [] + base [] restore output) = + some (rationalRadiusConfiguration 5 [] + base [] restore output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_copy_step + (base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 3 [] + (true :: base) outer restore output) = + some (rationalRadiusConfiguration 3 [] + base outer (true :: restore) (true :: output)) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_copy_finish + (outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 3 [] + [] outer restore output) = + some (rationalRadiusConfiguration 4 [] + [] outer restore output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_restore_step + (base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 4 [] + base outer (true :: restore) output) = + some (rationalRadiusConfiguration 4 [] + (true :: base) outer restore output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_restore_finish + (base outer output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 4 [] + base outer [] output) = + some (rationalRadiusConfiguration 2 [] + base outer [] output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_cleanup_base_step + (base output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 5 [] + (true :: base) [] [] output) = + some (rationalRadiusConfiguration 5 [] + base [] [] output) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_cleanup_finish (output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 5 [] [] [] [] output) = + some (Turing.haltList rationalRadiusMachine + (true :: output)) := by + rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_failure_input_step + (bit : Bool) (input base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 6 + (bit :: input) base outer restore output) = + some (rationalRadiusConfiguration 6 + input base outer restore output) := by + cases bit <;> rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_failure_base_step + (bit : Bool) (base outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 6 [] + (bit :: base) outer restore output) = + some (rationalRadiusConfiguration 6 [] + base outer restore output) := by + cases bit <;> rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_failure_outer_step + (bit : Bool) (outer restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 6 [] [] + (bit :: outer) restore output) = + some (rationalRadiusConfiguration 6 [] [] + outer restore output) := by + cases bit <;> rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_failure_restore_step + (bit : Bool) (restore output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 6 [] [] [] + (bit :: restore) output) = + some (rationalRadiusConfiguration 6 [] [] [] + restore output) := by + cases bit <;> rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_failure_output_step + (bit : Bool) (output : List Bool) : + rationalRadiusMachine.step + (rationalRadiusConfiguration 6 [] [] [] [] + (bit :: output)) = + some (rationalRadiusConfiguration 6 [] [] [] [] output) := by + cases bit <;> rationalRadiusStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem rationalRadius_failure_finish : + rationalRadiusMachine.step + (rationalRadiusConfiguration 6 [] [] [] [] []) = + some (Turing.haltList rationalRadiusMachine [false]) := by + rationalRadiusStepTac + +end SourceLatticeStructuralRationalRadiusTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part05C.lean b/LeanPool/GapCVP/Part05C.lean new file mode 100644 index 000000000..c759b23e3 --- /dev/null +++ b/LeanPool/GapCVP/Part05C.lean @@ -0,0 +1,1821 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part05B + +/-! # GapCVP proof, part 05, continuation 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceLatticeStructuralRationalRadiusTM + +open Turing GapCVP.SourceLatticeNormalizedSectionSynthesis + +private def rationalRadiusFailureMeasure + (input base outer restore output : List Bool) : ℕ := + input.length + base.length + outer.length + + restore.length + output.length + +private def rationalRadius_failureTrace + (input base outer restore output : List Bool) : + EvalsToInTime rationalRadiusMachine.step (rationalRadiusConfiguration 6 + input base outer restore output) + (some (Turing.haltList rationalRadiusMachine [false])) + (rationalRadiusFailureMeasure + input base outer restore output + 1) := by + induction input generalizing base outer restore output with + | cons bit input ih => + have hfirst := oneStep _ _ (rationalRadius_failure_input_step + bit input base outer restore output) + have hrest := ih base outer restore output + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest + exact rebound hfull (by + simp only [rationalRadiusFailureMeasure, List.length_cons, add_le_add_iff_right, + Order.add_one_le_iff, + add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction base generalizing outer restore output with + | cons bit base ih => + have hfirst := oneStep _ _ (rationalRadius_failure_base_step + bit base outer restore output) + have hrest := ih outer restore output + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest + exact rebound hfull (by + simp only [rationalRadiusFailureMeasure, List.length_nil, zero_add, List.length_cons, + add_le_add_iff_right, + Order.add_one_le_iff, add_lt_add_iff_right, lt_add_iff_pos_right, + Order.lt_one_iff]) + | nil => + induction outer generalizing restore output with + | cons bit outer ih => + have hfirst := oneStep _ _ (rationalRadius_failure_outer_step + bit outer restore output) + have hrest := ih restore output + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest + exact rebound hfull (by + simp only [rationalRadiusFailureMeasure, List.length_nil, add_zero, zero_add, + List.length_cons, + add_le_add_iff_right, Order.add_one_le_iff, add_lt_add_iff_right, + lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction restore generalizing output with + | cons bit restore ih => + have hfirst := oneStep _ _ (rationalRadius_failure_restore_step + bit restore output) + have hrest := ih output + have hfull := EvalsToInTime.trans + rationalRadiusMachine.step _ _ _ _ _ hfirst hrest + exact rebound hfull (by + simp only [rationalRadiusFailureMeasure, List.length_nil, add_zero, zero_add, + List.length_cons, + add_le_add_iff_right, Order.add_one_le_iff, add_lt_add_iff_right, + lt_add_iff_pos_right, Order.lt_one_iff]) + | nil => + induction output with + | nil => + simpa only [FinTM2.step, Fin.isValue, rationalRadiusFailureMeasure, + List.length_nil, add_zero, zero_add] using + oneStep _ _ rationalRadius_failure_finish + | cons bit output ih => + have hfirst := oneStep _ _ (rationalRadius_failure_output_step bit output) + have hfull := EvalsToInTime.trans + rationalRadiusMachine.step _ _ _ _ _ hfirst ih + exact rebound hfull (by + simp only [rationalRadiusFailureMeasure, List.length_nil, add_zero, + zero_add, List.length_cons, Std.le_refl]) + +private def rationalRadius_copyTrace + (count : ℕ) (outer restore output : List Bool) : + EvalsToInTime rationalRadiusMachine.step (rationalRadiusConfiguration 3 [] + (List.replicate count true) outer restore output) + (some (rationalRadiusConfiguration 4 [] [] outer + (List.replicate count true ++ restore) + (List.replicate count true ++ output))) + (count + 1) := by + induction count generalizing restore output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (rationalRadius_copy_finish outer restore output) + | succ count ih => + have hfirst := oneStep _ _ (rationalRadius_copy_step + (List.replicate count true) outer restore output) + have hrest := ih (true :: restore) (true :: output) + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def rationalRadius_restoreTrace + (count : ℕ) (base outer output : List Bool) : + EvalsToInTime rationalRadiusMachine.step (rationalRadiusConfiguration 4 [] base outer + (List.replicate count true) output) + (some (rationalRadiusConfiguration 2 [] + (List.replicate count true ++ base) outer [] output)) + (count + 1) := by + induction count generalizing base with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (rationalRadius_restore_finish base outer output) + | succ count ih => + have hfirst := oneStep _ _ (rationalRadius_restore_step base outer + (List.replicate count true) output) + have hrest := ih (true :: base) + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def rationalRadius_baseCopyTrace + (baseSize : ℕ) (outer output : List Bool) : + EvalsToInTime rationalRadiusMachine.step (rationalRadiusConfiguration 3 [] + (List.replicate baseSize true) outer [] output) + (some (rationalRadiusConfiguration 2 [] + (List.replicate baseSize true) outer [] + (List.replicate baseSize true ++ output))) + (2 * baseSize + 2) := by + have hcopy := rationalRadius_copyTrace baseSize outer [] output + simp only [List.append_nil] at hcopy + have hrestore := rationalRadius_restoreTrace + baseSize [] outer (List.replicate baseSize true ++ output) + simp only [List.append_nil] at hrestore + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hcopy hrestore + exact rebound hfull (by omega) + +private def rationalRadius_cleanupTrace + (count : ℕ) (output : List Bool) : + EvalsToInTime rationalRadiusMachine.step (rationalRadiusConfiguration 5 [] + (List.replicate count true) [] [] output) + (some (Turing.haltList rationalRadiusMachine + (true :: output))) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ (rationalRadius_cleanup_finish output) + | succ count ih => + have hfirst := oneStep _ _ (rationalRadius_cleanup_base_step + (List.replicate count true) output) + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst ih + exact rebound hfull (by omega) + +private def rationalRadius_outerTrace + (baseSize count : ℕ) (output : List Bool) : + EvalsToInTime rationalRadiusMachine.step (rationalRadiusConfiguration 2 [] + (List.replicate baseSize true) + (List.replicate count true) [] output) + (some (Turing.haltList rationalRadiusMachine + (true :: + (List.replicate (count * baseSize) true ++ output)))) + (count * (2 * baseSize + 3) + baseSize + 2) := by + induction count generalizing output with + | zero => + have hfirst := oneStep _ _ (rationalRadius_outer_finish + (List.replicate baseSize true) [] output) + have hcleanup := rationalRadius_cleanupTrace baseSize output + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hcleanup + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_mul, List.nil_append, + zero_add] using hfull + | succ count ih => + have hdispatch := oneStep _ _ (rationalRadius_outer_step + (List.replicate baseSize true) + (List.replicate count true) [] output) + have hcopy := rationalRadius_baseCopyTrace + baseSize (List.replicate count true) output + have hprefix := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hdispatch hcopy + have hrest := ih (List.replicate baseSize true ++ output) + have hblocks : + List.replicate (count * baseSize) true ++ + (List.replicate baseSize true ++ output) = + List.replicate ((count + 1) * baseSize) + true ++ output := by + rw [Nat.add_mul, Nat.one_mul, + List.replicate_add, List.append_assoc] + rw [hblocks] at hrest + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hprefix hrest + have hbounded := rebound (newBudget := + (count + 1) * (2 * baseSize + 3) + baseSize + 2) + hfull (by + simp only [Nat.mul_add, Nat.add_mul, one_mul] + omega) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ] using hbounded + +private def rationalRadiusScanOutput + (input : List Bool) (count : ℕ) : List Bool := + if input.all (fun bit => bit) then + true :: List.replicate + (4 * (count + input.length) ^ 2 + + 2 * (count + input.length) + 1) true + else + [false] + +private def rationalRadiusScanBudget + (input : List Bool) (count : ℕ) : ℕ := + 64 * (count + input.length + 1) ^ 2 + + 32 * (input.length + 1) + 64 + +private def rationalRadius_scanTrace + (input : List Bool) (count : ℕ) : + EvalsToInTime rationalRadiusMachine.step (rationalRadiusConfiguration 1 input + (List.replicate (2 * count) true) + (List.replicate (2 * count) true) [] + (List.replicate (2 * count + 1) true)) + (some (Turing.haltList rationalRadiusMachine + (rationalRadiusScanOutput input count))) + (rationalRadiusScanBudget input count) := by + induction input generalizing count with + | nil => + have hfirst := oneStep _ _ (rationalRadius_scan_finish + (List.replicate (2 * count) true) + (List.replicate (2 * count) true) [] + (List.replicate (2 * count + 1) true)) + have houter := rationalRadius_outerTrace + (2 * count) (2 * count) + (List.replicate (2 * count + 1) true) + have hword : + List.replicate ((2 * count) * (2 * count)) true ++ + List.replicate (2 * count + 1) true = + List.replicate + (4 * count ^ 2 + 2 * count + 1) true := by + rw [← List.replicate_add] + congr 1 + ring + rw [hword] at houter + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst houter + have hbounded := rebound (newBudget := rationalRadiusScanBudget [] count) + hfull (by + simp only [rationalRadiusScanBudget, List.length_nil, add_zero, pow_two, zero_add, + mul_one, + add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, rationalRadiusScanOutput, List.all_nil, ↓reduceIte, + List.length_nil, + add_zero] using hbounded + | cons bit input ih => + cases bit with + | false => + have hfirst := oneStep _ _ (rationalRadius_scan_false_step input + (List.replicate (2 * count) true) + (List.replicate (2 * count) true) [] + (List.replicate (2 * count + 1) true)) + have hfailure := rationalRadius_failureTrace input + (List.replicate (2 * count) true) + (List.replicate (2 * count) true) [] + (List.replicate (2 * count + 1) true) + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hfailure + have hbounded := rebound (newBudget := rationalRadiusScanBudget + (false :: input) count) + hfull (by + simp only [rationalRadiusFailureMeasure, List.length_replicate, List.length_nil, + add_zero, + rationalRadiusScanBudget, List.length_cons, pow_two, add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, rationalRadiusScanOutput, List.all_cons, + Bool.false_and, + Bool.false_eq_true, ↓reduceIte] using hbounded + | true => + have hfirst := oneStep _ _ (rationalRadius_scan_true_step input + (List.replicate (2 * count) true) + (List.replicate (2 * count) true) [] + (List.replicate (2 * count + 1) true)) + have hrest := ih (count + 1) + have hbase : + List.replicate (2 * (count + 1)) true = + true :: true :: + List.replicate (2 * count) true := by + rw [show 2 * (count + 1) = + (2 * count + 1) + 1 by omega, + List.replicate_succ, List.replicate_succ] + have houtput : + List.replicate (2 * (count + 1) + 1) true = + true :: true :: + List.replicate (2 * count + 1) true := by + rw [show 2 * (count + 1) + 1 = + ((2 * count + 1) + 1) + 1 by omega, + List.replicate_succ, List.replicate_succ] + rw [hbase, houtput] at hrest + have htarget : + rationalRadiusScanOutput input (count + 1) = + rationalRadiusScanOutput + (true :: input) count := by + simp only [rationalRadiusScanOutput, List.all_eq_true, Bool.forall_bool, + Bool.false_eq_true, imp_false, + implies_true, and_true, Nat.add_comm, Nat.add_left_comm, ite_not, List.all_cons, + Bool.true_and, List.length_cons] + rw [htarget] at hrest + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest + have hbounded := rebound (newBudget := rationalRadiusScanBudget + (true :: input) count) + hfull (by + simp only [rationalRadiusScanBudget, pow_two, List.length_cons, add_le_add_iff_right, + Nat.reduceLeDiff, + Order.add_one_le_iff] + nlinarith) + exact hbounded + +/-- GapCVP reduction support. -/ +def rationalRadiusUnaryOutput : List Bool → List Bool + | [] => [false] + | false :: _ => [false] + | true :: input => rationalRadiusScanOutput input 0 + +private def rationalRadiusInputBudget (input : List Bool) : ℕ := + 128 * input.length ^ 2 + 128 * input.length + 256 + +private def rationalRadius_totalTrace (input : List Bool) : + EvalsToInTime rationalRadiusMachine.step (rationalRadiusConfiguration 0 input [] [] [] []) + (some (Turing.haltList rationalRadiusMachine + (rationalRadiusUnaryOutput input))) + (rationalRadiusInputBudget input) := by + cases input with + | nil => + have hfirst := oneStep _ _ (rationalRadius_marker_missing_step [] [] [] []) + have hfailure := rationalRadius_failureTrace [] [] [] [] [] + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hfailure + have hbounded := rebound (newBudget := rationalRadiusInputBudget []) + hfull (by + simp only [rationalRadiusFailureMeasure, List.length_nil, add_zero, zero_add, + Nat.reduceAdd, + rationalRadiusInputBudget, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, + mul_zero, Nat.reduceLeDiff]) + simpa only [FinTM2.step, Fin.isValue, rationalRadiusUnaryOutput] using hbounded + | cons bit input => + cases bit with + | false => + have hfirst := oneStep _ _ (rationalRadius_marker_false_step input [] [] [] []) + have hfailure := rationalRadius_failureTrace + input [] [] [] [] + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hfailure + have hbounded := rebound (newBudget := rationalRadiusInputBudget + (false :: input)) + hfull (by + simp only [rationalRadiusFailureMeasure, List.length_nil, add_zero, + rationalRadiusInputBudget, + List.length_cons, pow_two, add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, rationalRadiusUnaryOutput] using hbounded + | true => + have hfirst := oneStep _ _ (rationalRadius_marker_true_step input [] [] [] []) + have hscan : + EvalsToInTime rationalRadiusMachine.step + (rationalRadiusConfiguration 1 + input [] [] [] [true]) + (some (Turing.haltList rationalRadiusMachine + (rationalRadiusScanOutput input 0))) + (rationalRadiusScanBudget input 0) := by + simpa only [FinTM2.step, Fin.isValue, mul_zero, List.replicate_zero, zero_add, + List.replicate_one] using + rationalRadius_scanTrace input 0 + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hscan + have hbounded := rebound (newBudget := rationalRadiusInputBudget + (true :: input)) + hfull (by + simp only [rationalRadiusScanBudget, zero_add, pow_two, rationalRadiusInputBudget, + List.length_cons, + add_le_add_iff_right] + nlinarith) + simpa only [FinTM2.step, Fin.isValue, rationalRadiusUnaryOutput] using hbounded + +/-- GapCVP reduction support. -/ +noncomputable def rationalRadiusUnaryComputable : + BitTM + rationalRadiusUnaryOutput where + tm := rationalRadiusMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 128 * Polynomial.X ^ 2 + + 128 * Polynomial.X + 256 + outputsFun input := { + steps := (rationalRadius_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, rationalRadiusMachine_init, + Option.map_some] using + (rationalRadius_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (rationalRadius_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, rationalRadiusInputBudget, bitEncoding, id_eq, + Polynomial.eval_add, + Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X, + ge_iff_le] using hsteps + } + +theorem rationalRadiusUnaryOutput_marked + (number : ℕ) : + rationalRadiusUnaryOutput + (true :: List.replicate number true) = + true :: List.replicate + (4 * number ^ 2 + 2 * number + 1) true := by + simp only [rationalRadiusUnaryOutput, rationalRadiusScanOutput, List.all_replicate, ite_self, + ↓reduceIte, + List.length_replicate, zero_add] + +end SourceLatticeStructuralRationalRadiusTM + +namespace SourceInterpolationRowTM + +open GapCVP.BinaryEncoding + +theorem readUnaryPrefix_some_decompose + (input : List Bool) (count : ℕ) (suffix : List Bool) + (hread : readUnaryPrefix input = some (count, suffix)) : + input = List.replicate count true ++ false :: suffix := by + induction input generalizing count suffix with + | nil => simp only [readUnaryPrefix, reduceCtorEq] at hread + | cons bit rest ih => + cases bit with + | false => + simp only [readUnaryPrefix, Option.some.injEq, Prod.mk.injEq] at hread + rcases hread with ⟨rfl, rfl⟩ + rfl + | true => + cases hrest : readUnaryPrefix rest with + | none => simp only [readUnaryPrefix, hrest, reduceCtorEq] at hread + | some pair => + rcases pair with ⟨number, tail⟩ + simp only [readUnaryPrefix, hrest, Option.some.injEq, Prod.mk.injEq] at hread + rcases hread with ⟨rfl, rfl⟩ + have htail := ih number tail hrest + simp only [htail, List.replicate_succ, List.cons_append] + +theorem readUnaryPrefix_none_eq_replicate + (input : List Bool) + (hread : readUnaryPrefix input = none) : + input = List.replicate input.length true := by + induction input with + | nil => rfl + | cons bit rest ih => + cases bit with + | false => simp only [readUnaryPrefix, reduceCtorEq] at hread + | true => + cases hrest : readUnaryPrefix rest with + | none => + have htail := ih hrest + simpa only [List.length_cons, List.replicate_succ] + using congrArg (fun tail : List Bool => true :: tail) htail + | some pair => + simp only [readUnaryPrefix, hrest, reduceCtorEq] at hread + +end SourceInterpolationRowTM + +namespace SourceWholeOutputAssemblyTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceLatticeFormulaPreservation +open GapCVP.SourceLatticeDependentSectionComputation GapCVP.FormulaTotalCert +open GapCVP.OutputBoundedDependentRecordFold + +/-- GapCVP reduction support. -/ +def sourceVectorStructuralRecords + {α : Type*} [Encodable α] + (n : ℕ) (values : Fin n → α) : List (List Bool) := + List.ofFn (fun index => encodeAtomic (values index)) + +theorem sourceVectorStructuralRecords_flatten + {α : Type*} [Encodable α] + (n : ℕ) (values : Fin n → α) : + (sourceVectorStructuralRecords n values).flatten = + encodeFinValues n values := by + induction n with + | zero => + simp only [sourceVectorStructuralRecords, List.ofFn_zero, List.flatten_nil, encodeFinValues] + | succ n ih => + have htail := ih (fun index : Fin n => values index.succ) + have hfull := congrArg + (fun tail : List Bool => encodeAtomic (values 0) ++ tail) + htail + simpa only [sourceVectorStructuralRecords, List.ofFn_succ, List.flatten_cons, + encodeFinValues, + List.append_cancel_left_eq] using hfull + +/-- GapCVP reduction support. -/ +def sourceMatrixStructuralRecords + (m n : ℕ) (matrix : Fin m → Fin n → ℤ) : + List (List Bool) := + (List.ofFn (fun row => + sourceVectorStructuralRecords n (matrix row))).flatten + +theorem sourceMatrixStructuralRecords_flatten + (m n : ℕ) (matrix : Fin m → Fin n → ℤ) : + (sourceMatrixStructuralRecords m n matrix).flatten = + encodeMatrixRows m n matrix := by + induction m with + | zero => + simp only [sourceMatrixStructuralRecords, List.ofFn_zero, List.flatten_nil, encodeMatrixRows] + | succ m ih => + have htail := ih (fun index : Fin m => matrix index.succ) + have hfull := congrArg + (fun tail : List Bool => + encodeFinValues n (matrix 0) ++ tail) + htail + simpa only [sourceMatrixStructuralRecords, List.ofFn_succ, List.flatten_cons, + List.flatten_append, + sourceVectorStructuralRecords_flatten, encodeMatrixRows, List.append_cancel_left_eq] + using hfull + +@[simp] theorem sourceVectorStructuralRecords_length + {α : Type*} [Encodable α] + (n : ℕ) (values : Fin n → α) : + (sourceVectorStructuralRecords n values).length = n := by + simp only [sourceVectorStructuralRecords, List.length_ofFn] + +@[simp] theorem sourceMatrixStructuralRecords_length + (m n : ℕ) (matrix : Fin m → Fin n → ℤ) : + (sourceMatrixStructuralRecords m n matrix).length = m * n := by + induction m with + | zero => + simp only [sourceMatrixStructuralRecords, List.ofFn_zero, List.flatten_nil, List.length_nil, + zero_mul] + | succ m ih => + have htail := ih (fun index : Fin m => matrix index.succ) + have hfull := congrArg (fun length : ℕ => n + length) htail + simpa only [sourceMatrixStructuralRecords, List.ofFn_succ, List.flatten_cons, + List.length_append, + sourceVectorStructuralRecords_length, List.length_flatten, List.map_ofFn, Nat.succ_mul, + Nat.add_comm, + Nat.add_left_cancel_iff] using hfull + +/-- GapCVP reduction support. -/ +def sourceLatticeStructuralRecords + (lattice : GapCVPInstance) : List (List Bool) := + [encodeAtomic lattice.dimension, encodeAtomic lattice.radius] ++ + sourceVectorStructuralRecords lattice.dimension lattice.target ++ + sourceMatrixStructuralRecords lattice.dimension lattice.dimension + (Matrix.of.symm lattice.basis) + +theorem sourceLatticeStructuralRecords_flatten + (lattice : GapCVPInstance) : + (sourceLatticeStructuralRecords lattice).flatten = + encodeGapCVPInstance lattice := by + simp only [sourceLatticeStructuralRecords, List.cons_append, List.nil_append, List.flatten_cons, + List.flatten_append, sourceVectorStructuralRecords_flatten, + encodeGapCVPInstance, List.append_assoc] + rw [sourceMatrixStructuralRecords_flatten] + +@[simp] theorem sourceLatticeStructuralRecords_length + (lattice : GapCVPInstance) : + (sourceLatticeStructuralRecords lattice).length = + 2 + lattice.dimension + + lattice.dimension * lattice.dimension := by + simp only [sourceLatticeStructuralRecords, List.cons_append, List.nil_append, List.length_cons, + List.length_append, sourceVectorStructuralRecords_length] + rw [sourceMatrixStructuralRecords_length] + omega + +/-- GapCVP reduction support. -/ +def constructiveCanonicalSourceMarker (input : List Bool) : Bool := + match decodeThreeCNF input with + | none => false + | some formula => decide (encodeThreeCNF formula = input) + +private theorem validatedPreservedFormulaOutput_constructiveMarker + (input : List Bool) : + validatedPreservedFormulaOutput input = + constructiveCanonicalSourceMarker input :: input := by + unfold validatedPreservedFormulaOutput + rw [Function.comp_apply, formulaPreservedOutput_eq_expected] + cases hdecode : decodeThreeCNF input with + | none => + simp only [canonicalFormulaExpected, hdecode, sourceMarkerRotatedOutput_append_marker, + constructiveCanonicalSourceMarker] + | some formula => + by_cases hcanonical : encodeThreeCNF formula = input + · simp only [canonicalFormulaExpected, hdecode, hcanonical, ↓reduceIte, + sourceMarkerRotatedOutput_append_marker, + constructiveCanonicalSourceMarker, decide_true] + · simp only [canonicalFormulaExpected, hdecode, hcanonical, ↓reduceIte, + sourceMarkerRotatedOutput_append_marker, + constructiveCanonicalSourceMarker, decide_false] + +/-- GapCVP reduction support. -/ +noncomputable def constructiveCanonicalSourceMarkerComputable : + BitTM + (fun input => constructiveCanonicalSourceMarker input :: input) := by + have hfunctions : validatedPreservedFormulaOutput = + (fun input => constructiveCanonicalSourceMarker input :: input) := + funext validatedPreservedFormulaOutput_constructiveMarker + rw [← hfunctions] + exact validatedPreservedFormulaComputable + +theorem sourceAtomicFoldSeed_length_le + (input : List Bool) (count : ℕ) (seed : List Bool) + (hparse : parseUnaryBoundedFold input = some (count, seed)) : + seed.length ≤ input.length := by + exact GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse + +end SourceWholeOutputAssemblyTM + +namespace SourceWholeOutputValidBranchRecordTM + +open Turing GapCVP.BinaryEncoding GapCVP.FormulaSemanticCert +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceWholeOutputAssemblyTM + +/-- GapCVP reduction support. -/ +def sourceFlatAtomicDescriptor (record : List Bool) : List Bool := + lengthPrefixedWord record + +/-- GapCVP reduction support. -/ +def sourceFlatAtomicRecordStep (input : List Bool) : List Bool := + match readLengthPrefixedWord input with + | none => [] + | some (record, pending) => pending ++ record + +@[simp] theorem sourceFlatAtomicRecordStep_descriptor + (record pending : List Bool) : + sourceFlatAtomicRecordStep + (sourceFlatAtomicDescriptor record ++ pending) = + pending ++ record := by + simp only [sourceFlatAtomicRecordStep, sourceFlatAtomicDescriptor, readLengthPrefixedWord_append] + +/-- GapCVP reduction support. -/ +def sourceFlatAtomicDescriptorStream + (records : List (List Bool)) : List Bool := + records.flatMap sourceFlatAtomicDescriptor + +theorem sourceFlatAtomicRecordStep_iterate_descriptors + (records : List (List Bool)) (emitted : List Bool) : + ((sourceFlatAtomicRecordStep^[records.length]) + (sourceFlatAtomicDescriptorStream records ++ emitted)) = + emitted ++ records.flatten := by + induction records generalizing emitted with + | nil => + simp only [List.length_nil, sourceFlatAtomicDescriptorStream, List.flatMap_nil, + List.nil_append, + Function.iterate_zero, id_eq, List.flatten_nil, List.append_nil] + | cons record remaining ih => + rw [List.length_cons, Function.iterate_succ_apply] + simp only [sourceFlatAtomicDescriptorStream, + List.flatMap_cons, List.append_assoc] + rw [sourceFlatAtomicRecordStep_descriptor] + simpa only [List.append_assoc, List.flatten_cons, sourceFlatAtomicDescriptorStream] using + ih (emitted ++ record) + +private theorem sourceFlatAtomicRecordStep_length_le + (input : List Bool) : + (sourceFlatAtomicRecordStep input).length ≤ input.length := by + cases hread : readLengthPrefixedWord input with + | none => + simp only [sourceFlatAtomicRecordStep, hread, List.length_nil, zero_le] + | some parsed => + obtain ⟨record, pending⟩ := parsed + have hinput := readLengthPrefixedWord_some_reconstruct + input record pending hread + simp only [sourceFlatAtomicRecordStep, hread] + rw [hinput] + simp only [List.length_append, + lengthPrefixedWord_length] + omega + +private theorem sourceFlatAtomicRecordStep_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + sourceFlatAtomicRecordStep Polynomial.X := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + have hiterate : ∀ number : ℕ, + ((sourceFlatAtomicRecordStep^[number]) seed).length ≤ + seed.length := by + intro number + induction number with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ number ih => + rw [Function.iterate_succ_apply'] + exact (sourceFlatAtomicRecordStep_length_le _).trans ih + simpa only [Polynomial.eval_X, ge_iff_le] using (hiterate stage).trans hseed + +private def sourceFlatAtomicPeek (stack : Fin 5) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def sourceFlatAtomicPop (stack : Fin 5) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + .pop stack (fun state _ => state) continuation + +private def sourceFlatAtomicPushBit (stack : Fin 5) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + .push stack (fun state => state.getD false) continuation + +private def sourceFlatAtomicPushConstant (stack : Fin 5) (bit : Bool) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + .push stack (fun _ => bit) continuation + +private def sourceFlatAtomicGoto (phase : Fin 6) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +private def sourceFlatAtomicPrefixStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + sourceFlatAtomicPeek 0 + (.branch (fun state => state.getD false) + (sourceFlatAtomicPop 0 + (sourceFlatAtomicPushConstant 1 true + (sourceFlatAtomicGoto 0))) + (sourceFlatAtomicPop 0 (sourceFlatAtomicGoto 1))) + (sourceFlatAtomicGoto 5) + +private def sourceFlatAtomicPayloadStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + sourceFlatAtomicPeek 1 + (sourceFlatAtomicPop 1 + (sourceFlatAtomicPeek 0 + (sourceFlatAtomicPop 0 + (sourceFlatAtomicPushBit 2 + (sourceFlatAtomicGoto 1))) + (sourceFlatAtomicGoto 5))) + (sourceFlatAtomicGoto 2) + +private def sourceFlatAtomicPayloadOutputStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + sourceFlatAtomicPeek 2 + (sourceFlatAtomicPop 2 + (sourceFlatAtomicPushBit 4 + (sourceFlatAtomicGoto 2))) + (sourceFlatAtomicGoto 3) + +private def sourceFlatAtomicPendingStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + sourceFlatAtomicPeek 0 + (sourceFlatAtomicPop 0 + (sourceFlatAtomicPushBit 3 + (sourceFlatAtomicGoto 3))) + (sourceFlatAtomicGoto 4) + +private def sourceFlatAtomicRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + sourceFlatAtomicPeek 3 + (sourceFlatAtomicPop 3 + (sourceFlatAtomicPushBit 4 + (sourceFlatAtomicGoto 4))) + .halt + +private def sourceFlatAtomicFailureStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 6) (Option Bool) := + sourceFlatAtomicPeek 0 + (sourceFlatAtomicPop 0 (sourceFlatAtomicGoto 5)) + (sourceFlatAtomicPeek 1 + (sourceFlatAtomicPop 1 (sourceFlatAtomicGoto 5)) + (sourceFlatAtomicPeek 2 + (sourceFlatAtomicPop 2 (sourceFlatAtomicGoto 5)) + (sourceFlatAtomicPeek 3 + (sourceFlatAtomicPop 3 (sourceFlatAtomicGoto 5)) + (sourceFlatAtomicPeek 4 + (sourceFlatAtomicPop 4 (sourceFlatAtomicGoto 5)) + .halt)))) + +private abbrev sourceFlatAtomicRecordMachine : Turing.FinTM2 where + K := Fin 5 + k₀ := 0 + k₁ := 4 + Γ _ := Bool + Λ := Fin 6 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 6) then sourceFlatAtomicPrefixStatement + else if phase = (1 : Fin 6) then sourceFlatAtomicPayloadStatement + else if phase = (2 : Fin 6) then + sourceFlatAtomicPayloadOutputStatement + else if phase = (3 : Fin 6) then sourceFlatAtomicPendingStatement + else if phase = (4 : Fin 6) then sourceFlatAtomicRestoreStatement + else sourceFlatAtomicFailureStatement + +private def sourceFlatAtomicConfiguration (phase : Fin 6) + (input counter payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.Cfg where + l := some phase + var := none + stk := ![input, counter, payload, pending, output] + +private theorem sourceFlatAtomicRecordMachine_init (input : List Bool) : + Turing.initList sourceFlatAtomicRecordMachine input = + sourceFlatAtomicConfiguration 0 input [] [] [] [] := by + simp only [sourceFlatAtomicRecordMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + sourceFlatAtomicConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `sourceFlatAtomicStepTac` machine-step simplifier. -/ +macro "sourceFlatAtomicStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [sourceFlatAtomicRecordMachine, + sourceFlatAtomicConfiguration, + sourceFlatAtomicPeek, sourceFlatAtomicPop, + sourceFlatAtomicPushBit, sourceFlatAtomicPushConstant, + sourceFlatAtomicGoto, sourceFlatAtomicPrefixStatement, + sourceFlatAtomicPayloadStatement, + sourceFlatAtomicPayloadOutputStatement, + sourceFlatAtomicPendingStatement, + sourceFlatAtomicRestoreStatement, + sourceFlatAtomicFailureStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem sourceFlatAtomic_prefix_true + (input counter payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 0 + (true :: input) counter payload pending output) = + some (sourceFlatAtomicConfiguration 0 + input (true :: counter) payload pending output) := by + sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_prefix_delimiter + (input counter payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 0 + (false :: input) counter payload pending output) = + some (sourceFlatAtomicConfiguration 1 + input counter payload pending output) := by + sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_prefix_missing + (counter payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 0 + [] counter payload pending output) = + some (sourceFlatAtomicConfiguration 5 + [] counter payload pending output) := by + sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_payload_step + (bit : Bool) (input counter payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 1 + (bit :: input) (true :: counter) + payload pending output) = + some (sourceFlatAtomicConfiguration 1 + input counter (bit :: payload) pending output) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_payload_missing + (counter payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 1 + [] (true :: counter) payload pending output) = + some (sourceFlatAtomicConfiguration 5 + [] counter payload pending output) := by + sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_payload_finish + (input payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 1 + input [] payload pending output) = + some (sourceFlatAtomicConfiguration 2 + input [] payload pending output) := by + sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_payload_output_step + (bit : Bool) (input payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 2 + input [] (bit :: payload) pending output) = + some (sourceFlatAtomicConfiguration 2 + input [] payload pending (bit :: output)) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_payload_output_finish + (input pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 2 + input [] [] pending output) = + some (sourceFlatAtomicConfiguration 3 + input [] [] pending output) := by + sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_pending_step + (bit : Bool) (input pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 3 + (bit :: input) [] [] pending output) = + some (sourceFlatAtomicConfiguration 3 + input [] [] (bit :: pending) output) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_pending_finish + (pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 3 + [] [] [] pending output) = + some (sourceFlatAtomicConfiguration 4 + [] [] [] pending output) := by + sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_restore_step + (bit : Bool) (pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 4 + [] [] [] (bit :: pending) output) = + some (sourceFlatAtomicConfiguration 4 + [] [] [] pending (bit :: output)) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_restore_finish (output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 4 [] [] [] [] output) = + some (Turing.haltList sourceFlatAtomicRecordMachine output) := by + sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_failure_input_step + (bit : Bool) (input counter payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 5 + (bit :: input) counter payload pending output) = + some (sourceFlatAtomicConfiguration 5 + input counter payload pending output) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_failure_counter_step + (bit : Bool) (counter payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 5 + [] (bit :: counter) payload pending output) = + some (sourceFlatAtomicConfiguration 5 + [] counter payload pending output) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_failure_payload_step + (bit : Bool) (payload pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 5 + [] [] (bit :: payload) pending output) = + some (sourceFlatAtomicConfiguration 5 + [] [] payload pending output) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_failure_pending_step + (bit : Bool) (pending output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 5 + [] [] [] (bit :: pending) output) = + some (sourceFlatAtomicConfiguration 5 + [] [] [] pending output) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_failure_output_step + (bit : Bool) (output : List Bool) : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 5 + [] [] [] [] (bit :: output)) = + some (sourceFlatAtomicConfiguration 5 + [] [] [] [] output) := by + cases bit <;> sourceFlatAtomicStepTac + +private theorem sourceFlatAtomic_failure_finish : + sourceFlatAtomicRecordMachine.step + (sourceFlatAtomicConfiguration 5 [] [] [] [] []) = + some (Turing.haltList sourceFlatAtomicRecordMachine []) := by + sourceFlatAtomicStepTac + +private def sourceFlatAtomicSweepTrace + {Configuration : Type*} + (step : Configuration → Option Configuration) + (configuration : List Bool → Configuration) + (hstep : ∀ (bit : Bool) (remaining : List Bool), + step (configuration (bit :: remaining)) = + some (configuration remaining)) + (symbols : List Bool) : + EvalsToInTime step (configuration symbols) + (some (configuration [])) + symbols.length := by + induction symbols with + | nil => + simpa only [List.length_nil] using EvalsToInTime.refl step (configuration []) + | cons bit symbols ih => + have hfirst : EvalsToInTime step + (configuration (bit :: symbols)) + (some (configuration symbols)) 1 := { + steps := 1 + evals_in_steps := hstep bit symbols + steps_le_m := Nat.le_refl 1 + } + have hfull := EvalsToInTime.trans step _ _ _ _ _ hfirst ih + simpa only [List.length_cons] using hfull + +private def sourceFlatAtomicFailureBudget + (input counter payload pending output : List Bool) : ℕ := + input.length + counter.length + payload.length + + pending.length + output.length + 1 + +private def sourceFlatAtomic_failureTrace + (input counter payload pending output : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 5 + input counter payload pending output) + (some (Turing.haltList sourceFlatAtomicRecordMachine [])) + (sourceFlatAtomicFailureBudget + input counter payload pending output) := by + have hinput := sourceFlatAtomicSweepTrace + sourceFlatAtomicRecordMachine.step + (fun current => sourceFlatAtomicConfiguration 5 + current counter payload pending output) + (fun bit remaining => sourceFlatAtomic_failure_input_step + bit remaining counter payload pending output) + input + have hcounter := sourceFlatAtomicSweepTrace + sourceFlatAtomicRecordMachine.step + (fun current => sourceFlatAtomicConfiguration 5 + [] current payload pending output) + (fun bit remaining => sourceFlatAtomic_failure_counter_step + bit remaining payload pending output) + counter + have hpayload := sourceFlatAtomicSweepTrace + sourceFlatAtomicRecordMachine.step + (fun current => sourceFlatAtomicConfiguration 5 + [] [] current pending output) + (fun bit remaining => sourceFlatAtomic_failure_payload_step + bit remaining pending output) + payload + have hpending := sourceFlatAtomicSweepTrace + sourceFlatAtomicRecordMachine.step + (fun current => sourceFlatAtomicConfiguration 5 + [] [] [] current output) + (fun bit remaining => sourceFlatAtomic_failure_pending_step + bit remaining output) + pending + have houtput := sourceFlatAtomicSweepTrace + sourceFlatAtomicRecordMachine.step + (fun current => sourceFlatAtomicConfiguration 5 + [] [] [] [] current) + (fun bit remaining => sourceFlatAtomic_failure_output_step + bit remaining) + output + have hfinish := oneStep _ _ sourceFlatAtomic_failure_finish + have hfirst := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hinput hcounter + have hsecond := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hfirst hpayload + have hthird := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hsecond hpending + have hfourth := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hthird houtput + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hfourth hfinish + exact rebound hfull (by + simp only [sourceFlatAtomicFailureBudget] + omega) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceFlatAtomic_trueCounter_append + (count : ℕ) (counter : List Bool) : + List.replicate count true ++ true :: counter = + List.replicate (count + 1) true ++ counter := by + exact GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count counter + +private def sourceFlatAtomic_prefixTrace + (count : ℕ) + (tail counter payload pending output : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 0 + (List.replicate count true ++ false :: tail) + counter payload pending output) + (some (sourceFlatAtomicConfiguration 1 + tail (List.replicate count true ++ counter) + payload pending output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceFlatAtomic_prefix_delimiter tail counter payload pending output) + | succ count ih => + have hfirst := oneStep _ _ (sourceFlatAtomic_prefix_true + (List.replicate count true ++ false :: tail) + counter payload pending output) + have hrest := ih (true :: counter) + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + 1 (count + 1) _ _ _ hfirst hrest + rw [sourceFlatAtomic_trueCounter_append count counter] at hfull + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.reduceAdd] using hfull + +private def sourceFlatAtomic_payloadTrace + (record tail payload pending output : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 1 + (record ++ tail) + (List.replicate record.length true) + payload pending output) + (some (sourceFlatAtomicConfiguration 2 + tail [] (record.reverse ++ payload) pending output)) + (record.length + 1) := by + induction record generalizing payload with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil, + zero_add] using oneStep _ _ (sourceFlatAtomic_payload_finish tail payload pending output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (sourceFlatAtomic_payload_step bit + (remaining ++ tail) + (List.replicate remaining.length true) + payload pending output) + have hrest := ih (bit :: payload) + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd] using hfull + +private def sourceFlatAtomic_payloadOutputTrace + (input payload pending output : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 2 + input [] payload pending output) + (some (sourceFlatAtomicConfiguration 3 + input [] [] pending (payload.reverse ++ output))) + (payload.length + 1) := by + induction payload generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (sourceFlatAtomic_payload_output_finish input pending output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (sourceFlatAtomic_payload_output_step + bit input remaining pending output) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def sourceFlatAtomic_pendingTrace + (input pending output : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 3 + input [] [] pending output) + (some (sourceFlatAtomicConfiguration 4 + [] [] [] (input.reverse ++ pending) output)) + (input.length + 1) := by + induction input generalizing pending with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (sourceFlatAtomic_pending_finish pending output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (sourceFlatAtomic_pending_step + bit remaining pending output) + have hrest := ih (bit :: pending) + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def sourceFlatAtomic_restoreTrace + (pending output : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 4 + [] [] [] pending output) + (some (Turing.haltList sourceFlatAtomicRecordMachine + (pending.reverse ++ output))) + (pending.length + 1) := by + induction pending generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (sourceFlatAtomic_restore_finish output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (sourceFlatAtomic_restore_step bit remaining output) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def sourceFlatAtomic_validTrace + (record pending : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (Turing.initList sourceFlatAtomicRecordMachine + (sourceFlatAtomicDescriptor record ++ pending)) + (some (Turing.haltList sourceFlatAtomicRecordMachine + (pending ++ record))) + (4 * (sourceFlatAtomicDescriptor record ++ pending).length + 8) := by + have hprefix := sourceFlatAtomic_prefixTrace + record.length (record ++ pending) [] [] [] [] + simp only [List.append_nil] at hprefix + rw [← sourceFlatAtomicRecordMachine_init] at hprefix + have hpayload := sourceFlatAtomic_payloadTrace + record pending [] [] [] + simp only [List.append_nil] at hpayload + have hemit := sourceFlatAtomic_payloadOutputTrace + pending record.reverse [] [] + simp only [List.reverse_reverse, List.append_nil] at hemit + have hpending := sourceFlatAtomic_pendingTrace + pending [] record + simp only [List.append_nil] at hpending + have hrestore := sourceFlatAtomic_restoreTrace + pending.reverse record + simp only [List.reverse_reverse] at hrestore + have hfirst := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hprefix hpayload + have hsecond := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hfirst hemit + have hthird := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hsecond hpending + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hthird hrestore + have hinput : + List.replicate record.length true ++ + false :: (record ++ pending) = + sourceFlatAtomicDescriptor record ++ pending := by + simp only [sourceFlatAtomicDescriptor, lengthPrefixedWord, List.append_assoc, List.cons_append] + rw [hinput] at hfull + exact rebound hfull (by + simp only [List.length_reverse, sourceFlatAtomicDescriptor, lengthPrefixedWord, + List.append_assoc, + List.cons_append, List.length_append, List.length_replicate, List.length_cons] + omega) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceFlatAtomic_readUnaryPrefix_some + (input : List Bool) (count : ℕ) (tail : List Bool) + (hread : readUnaryPrefix input = some (count, tail)) : + input = List.replicate count true ++ false :: tail := by + exact GapCVP.SourceInterpolationRowTM.readUnaryPrefix_some_decompose input count tail hread + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceFlatAtomic_readUnaryPrefix_none + (input : List Bool) + (hread : readUnaryPrefix input = none) : + input = List.replicate input.length true := by + exact GapCVP.SourceInterpolationRowTM.readUnaryPrefix_none_eq_replicate input hread + +private def sourceFlatAtomic_missingPrefixTrace + (count : ℕ) (counter payload pending output : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 0 + (List.replicate count true) counter payload pending output) + (some (sourceFlatAtomicConfiguration 5 + [] (List.replicate count true ++ counter) + payload pending output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceFlatAtomic_prefix_missing counter payload pending output) + | succ count ih => + have hfirst := oneStep _ _ (sourceFlatAtomic_prefix_true + (List.replicate count true) + counter payload pending output) + have hrest := ih (true :: counter) + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + 1 (count + 1) _ _ _ hfirst hrest + rw [sourceFlatAtomic_trueCounter_append count counter] at hfull + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.reduceAdd] using hfull + +private def sourceFlatAtomic_truncatedPayloadTrace + (payload : List Bool) (missing : ℕ) + (copied pending output : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 1 + payload + (List.replicate (payload.length + missing + 1) true) + copied pending output) + (some (sourceFlatAtomicConfiguration 5 + [] (List.replicate missing true) + (payload.reverse ++ copied) pending output)) + (payload.length + 1) := by + induction payload generalizing copied with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add, List.replicate_succ, + List.reverse_nil, + List.nil_append] using + oneStep _ _ (sourceFlatAtomic_payload_missing (List.replicate missing true) copied + pending output) + | cons bit remaining ih => + have hcounter : + List.replicate + ((bit :: remaining).length + missing + 1) true = + true :: List.replicate + (remaining.length + missing + 1) true := by + have hexponent : + (bit :: remaining).length + missing + 1 = + (remaining.length + missing + 1) + 1 := by + simp only [List.length_cons] + omega + rw [hexponent, List.replicate_succ] + rw [hcounter] + have hfirst := oneStep _ _ (sourceFlatAtomic_payload_step bit remaining + (List.replicate + (remaining.length + missing + 1) true) + copied pending output) + have hrest := ih (bit :: copied) + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, Nat.add_comm, Nat.add_assoc, List.reverse_cons, + List.append_assoc, + List.cons_append, List.nil_append, List.length_cons, Nat.add_left_comm, Nat.reduceAdd] + using hfull + +private noncomputable def sourceFlatAtomicTimePolynomial : Polynomial ℕ := + 8 * Polynomial.X + 16 + +private noncomputable def sourceFlatAtomic_totalTrace (input : List Bool) : + EvalsToInTime sourceFlatAtomicRecordMachine.step + (Turing.initList sourceFlatAtomicRecordMachine input) + (some (Turing.haltList sourceFlatAtomicRecordMachine + (sourceFlatAtomicRecordStep input))) + (sourceFlatAtomicTimePolynomial.eval input.length) := by + cases hprefix : readUnaryPrefix input with + | none => + have hshape := sourceFlatAtomic_readUnaryPrefix_none + input hprefix + have hscan := sourceFlatAtomic_missingPrefixTrace + input.length [] [] [] [] + simp only [List.append_nil] at hscan + rw [← hshape, ← sourceFlatAtomicRecordMachine_init] at hscan + have hfailure := sourceFlatAtomic_failureTrace + [] input [] [] [] + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + _ _ _ _ _ hscan hfailure + have houtput : sourceFlatAtomicRecordStep input = [] := by + simp only [sourceFlatAtomicRecordStep, readLengthPrefixedWord, hprefix] + rw [houtput] + exact rebound hfull (by + simp only [sourceFlatAtomicFailureBudget, List.length_nil, zero_add, add_zero, + sourceFlatAtomicTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X] + omega) + | some parsed => + obtain ⟨count, tail⟩ := parsed + have hshape := sourceFlatAtomic_readUnaryPrefix_some + input count tail hprefix + by_cases hcomplete : count ≤ tail.length + · have hread : + readLengthPrefixedWord input = + some (tail.take count, tail.drop count) := by + simp only [readLengthPrefixedWord, hprefix, hcomplete, ↓reduceIte] + have hdescriptor := readLengthPrefixedWord_some_reconstruct + input (tail.take count) (tail.drop count) hread + have hphysical := sourceFlatAtomic_validTrace + (tail.take count) (tail.drop count) + simp only [sourceFlatAtomicDescriptor] at hphysical + rw [← hdescriptor] at hphysical + have houtput : + sourceFlatAtomicRecordStep input = + tail.drop count ++ tail.take count := by + simp only [sourceFlatAtomicRecordStep, hread] + rw [houtput] + exact rebound hphysical (by + simp only [sourceFlatAtomicTimePolynomial, Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, + Polynomial.eval_X, Nat.reduceLeDiff] + omega) + · have hshort : tail.length < count := by omega + let missing : ℕ := count - tail.length - 1 + have hcount : count = tail.length + missing + 1 := by + dsimp [missing] + omega + have hscan := sourceFlatAtomic_prefixTrace + count tail [] [] [] [] + simp only [List.append_nil] at hscan + rw [← hshape, ← sourceFlatAtomicRecordMachine_init] at hscan + have hcopy := sourceFlatAtomic_truncatedPayloadTrace + tail missing [] [] [] + simp only [List.append_nil] at hcopy + rw [← hcount] at hcopy + have hfailure := sourceFlatAtomic_failureTrace + [] (List.replicate missing true) tail.reverse [] [] + have hfirst := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + _ _ _ _ _ hscan hcopy + have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step + _ _ _ _ _ hfirst hfailure + have houtput : sourceFlatAtomicRecordStep input = [] := by + simp only [sourceFlatAtomicRecordStep, readLengthPrefixedWord, hprefix, hcomplete, + ↓reduceIte] + rw [houtput] + exact rebound hfull (by + simp only [sourceFlatAtomicFailureBudget, List.length_nil, List.length_replicate, + zero_add, + List.length_reverse, add_zero, sourceFlatAtomicTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + have hlength := congrArg List.length hshape + simp only [List.length_append, + List.length_replicate, List.length_cons] at hlength + omega) + +/-- GapCVP reduction support. -/ +noncomputable def sourceFlatAtomicRecordComputable : + BitTM + sourceFlatAtomicRecordStep where + tm := sourceFlatAtomicRecordMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := sourceFlatAtomicTimePolynomial + outputsFun input := { + steps := (sourceFlatAtomic_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, Option.map_some] using + (sourceFlatAtomic_totalTrace input).evals_in_steps + steps_le_m := by + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq] using (sourceFlatAtomic_totalTrace + input).steps_le_m + } + +/-- GapCVP reduction support. -/ +noncomputable def sourceFlatAtomicRecordFoldComputable : + BitTM + (boundedRecordFoldOutput sourceFlatAtomicRecordStep) := + boundedDependentRecordFoldComputable + sourceFlatAtomicRecordComputable Polynomial.X + sourceFlatAtomicRecordStep_polynomiallyBoundedFoldStates + +theorem boundedRecordFoldOutput_sourceFlatAtomicDescriptors + (records : List (List Bool)) : + boundedRecordFoldOutput sourceFlatAtomicRecordStep + (unaryBoundedFoldWord records.length + (sourceFlatAtomicDescriptorStream records)) = + records.flatten := by + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + simpa only [List.append_nil, List.nil_append] + using sourceFlatAtomicRecordStep_iterate_descriptors records [] + +end SourceWholeOutputValidBranchRecordTM + +namespace SourceCanonicalUnaryGridIndexTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceWholeOutputValidBranchRecordTM + +/-- GapCVP reduction support. -/ +def sourceCanonicalUnaryGridIndexDescriptor + (index : ℕ) : List Bool := + lengthPrefixedWord (List.replicate index true) + +/-- GapCVP reduction support. -/ +def sourceCanonicalUnaryGridIndexDescriptors + (count : ℕ) : List Bool := + (List.range count).flatMap sourceCanonicalUnaryGridIndexDescriptor + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceCanonicalUnaryGridIndexDescriptors_succ + (count : ℕ) : + sourceCanonicalUnaryGridIndexDescriptors (count + 1) = + sourceCanonicalUnaryGridIndexDescriptors count ++ + sourceCanonicalUnaryGridIndexDescriptor count := by + simp only [sourceCanonicalUnaryGridIndexDescriptors, List.range_succ, List.flatMap_append, + List.flatMap_cons, + List.flatMap_nil, List.append_nil] + +/-- GapCVP reduction support. -/ +def sourceCanonicalUnaryGridIndexOutput + (input : List Bool) : List Bool := + match readUnaryPrefix input with + | none => [] + | some (count, source) => + sourceCanonicalUnaryGridIndexDescriptors count ++ source + +@[simp] theorem sourceCanonicalUnaryGridIndexOutput_valid + (count : ℕ) (source : List Bool) : + sourceCanonicalUnaryGridIndexOutput + (List.replicate count true ++ false :: source) = + sourceCanonicalUnaryGridIndexDescriptors count ++ source := by + simp only [sourceCanonicalUnaryGridIndexOutput, readUnaryPrefix_replicate] + +private def sourceGridIndexPeek (stack : Fin 5) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def sourceGridIndexPop (stack : Fin 5) + (next : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .pop stack (fun state _ => state) next + +private def sourceGridIndexPushBit (stack : Fin 5) + (next : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .push stack (fun state => state.getD false) next + +private def sourceGridIndexPushConstant (stack : Fin 5) (bit : Bool) + (next : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .push stack (fun _ => bit) next + +private def sourceGridIndexGoto (phase : Fin 7) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceGridIndexPrefixStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + sourceGridIndexPeek 0 + (.branch (fun state => state.getD false) + (sourceGridIndexPop 0 + (sourceGridIndexPushConstant 1 true + (sourceGridIndexGoto 0))) + (sourceGridIndexPop 0 (sourceGridIndexGoto 1))) + (sourceGridIndexGoto 6) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceGridIndexArchiveStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + sourceGridIndexPeek 0 + (sourceGridIndexPop 0 + (sourceGridIndexPushBit 3 (sourceGridIndexGoto 1))) + (sourceGridIndexGoto 2) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceGridIndexSourceRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + sourceGridIndexPeek 3 + (sourceGridIndexPop 3 + (sourceGridIndexPushBit 4 (sourceGridIndexGoto 2))) + (sourceGridIndexGoto 3) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceGridIndexOuterStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + sourceGridIndexPeek 1 + (sourceGridIndexPop 1 (sourceGridIndexGoto 4)) + .halt + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceGridIndexCopyStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + sourceGridIndexPeek 1 + (sourceGridIndexPop 1 + (sourceGridIndexPushConstant 2 true + (sourceGridIndexPushConstant 4 true + (sourceGridIndexGoto 4)))) + (sourceGridIndexPushConstant 4 false + (sourceGridIndexGoto 5)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceGridIndexTemplateRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + sourceGridIndexPeek 2 + (sourceGridIndexPop 2 + (sourceGridIndexPushConstant 1 true + (sourceGridIndexPushConstant 4 true + (sourceGridIndexGoto 5)))) + (sourceGridIndexGoto 3) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceGridIndexFailureStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 7) (Option Bool) := + sourceGridIndexPeek 1 + (sourceGridIndexPop 1 (sourceGridIndexGoto 6)) + .halt + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev sourceCanonicalUnaryGridIndexMachine : Turing.FinTM2 where + K := Fin 5 + k₀ := 0 + k₁ := 4 + Γ _ := Bool + Λ := Fin 7 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 7) then sourceGridIndexPrefixStatement + else if phase = (1 : Fin 7) then sourceGridIndexArchiveStatement + else if phase = (2 : Fin 7) then + sourceGridIndexSourceRestoreStatement + else if phase = (3 : Fin 7) then sourceGridIndexOuterStatement + else if phase = (4 : Fin 7) then sourceGridIndexCopyStatement + else if phase = (5 : Fin 7) then + sourceGridIndexTemplateRestoreStatement + else sourceGridIndexFailureStatement + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceGridIndexConfiguration (phase : Fin 7) + (input counter scratch archive output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.Cfg where + l := some phase + var := none + stk := ![input, counter, scratch, archive, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceCanonicalUnaryGridIndexMachine_init + (input : List Bool) : + Turing.initList sourceCanonicalUnaryGridIndexMachine input = + sourceGridIndexConfiguration 0 input [] [] [] [] := by + simp only [sourceCanonicalUnaryGridIndexMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + sourceGridIndexConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `sourceGridIndexStepTac` machine-step simplifier. -/ +macro "sourceGridIndexStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [sourceCanonicalUnaryGridIndexMachine, + sourceGridIndexConfiguration, + sourceGridIndexPeek, sourceGridIndexPop, + sourceGridIndexPushBit, sourceGridIndexPushConstant, + sourceGridIndexGoto, + sourceGridIndexPrefixStatement, + sourceGridIndexArchiveStatement, + sourceGridIndexSourceRestoreStatement, + sourceGridIndexOuterStatement, + sourceGridIndexCopyStatement, + sourceGridIndexTemplateRestoreStatement, + sourceGridIndexFailureStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_prefix_true + (input counter scratch archive output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 0 + (true :: input) counter scratch archive output) = + some (sourceGridIndexConfiguration 0 + input (true :: counter) scratch archive output) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_prefix_false + (input counter scratch archive output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 0 + (false :: input) counter scratch archive output) = + some (sourceGridIndexConfiguration 1 + input counter scratch archive output) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_prefix_missing + (counter scratch archive output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 0 + [] counter scratch archive output) = + some (sourceGridIndexConfiguration 6 + [] counter scratch archive output) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_archive_step + (bit : Bool) (input counter scratch archive output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 1 + (bit :: input) counter scratch archive output) = + some (sourceGridIndexConfiguration 1 + input counter scratch (bit :: archive) output) := by + cases bit <;> sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_archive_finish + (counter scratch archive output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 1 + [] counter scratch archive output) = + some (sourceGridIndexConfiguration 2 + [] counter scratch archive output) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_source_restore_step + (bit : Bool) (counter scratch archive output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 2 + [] counter scratch (bit :: archive) output) = + some (sourceGridIndexConfiguration 2 + [] counter scratch archive (bit :: output)) := by + cases bit <;> sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_source_restore_finish + (counter scratch output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 2 + [] counter scratch [] output) = + some (sourceGridIndexConfiguration 3 + [] counter scratch [] output) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_outer_step + (counter output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 3 + [] (true :: counter) [] [] output) = + some (sourceGridIndexConfiguration 4 + [] counter [] [] output) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_outer_finish (output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 3 [] [] [] [] output) = + some (Turing.haltList + sourceCanonicalUnaryGridIndexMachine output) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_copy_step + (counter scratch output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 4 + [] (true :: counter) scratch [] output) = + some (sourceGridIndexConfiguration 4 + [] counter (true :: scratch) [] (true :: output)) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_copy_finish + (scratch output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 4 + [] [] scratch [] output) = + some (sourceGridIndexConfiguration 5 + [] [] scratch [] (false :: output)) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_template_restore_step + (counter scratch output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 5 + [] counter (true :: scratch) [] output) = + some (sourceGridIndexConfiguration 5 + [] (true :: counter) scratch [] (true :: output)) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_template_restore_finish + (counter output : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 5 + [] counter [] [] output) = + some (sourceGridIndexConfiguration 3 + [] counter [] [] output) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_failure_step + (counter : List Bool) : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 6 + [] (true :: counter) [] [] []) = + some (sourceGridIndexConfiguration 6 + [] counter [] [] []) := by + sourceGridIndexStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceGridIndex_failure_finish : + sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 6 [] [] [] [] []) = + some (Turing.haltList + sourceCanonicalUnaryGridIndexMachine []) := by + sourceGridIndexStepTac + +end SourceCanonicalUnaryGridIndexTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part05D.lean b/LeanPool/GapCVP/Part05D.lean new file mode 100644 index 000000000..217121adf --- /dev/null +++ b/LeanPool/GapCVP/Part05D.lean @@ -0,0 +1,1844 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part05C + +/-! # GapCVP proof, part 05, continuation 04 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceCanonicalUnaryGridIndexTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceWholeOutputValidBranchRecordTM + +private def sourceGridIndex_prefixTrace + (count : ℕ) + (source counter scratch archive output : List Bool) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 0 + (List.replicate count true ++ false :: source) + counter scratch archive output) + (some (sourceGridIndexConfiguration 1 + source (List.replicate count true ++ counter) + scratch archive output)) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceGridIndex_prefix_false source counter scratch archive output) + | succ count ih => + have hfirst := oneStep _ _ (sourceGridIndex_prefix_true + (List.replicate count true ++ false :: source) + counter scratch archive output) + have hrest := ih (true :: counter) + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + 1 (count + 1) _ _ _ hfirst hrest + rw [sourceFlatAtomic_trueCounter_append count counter] at hfull + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.reduceAdd] using hfull + +private def sourceGridIndex_archiveTrace + (source counter scratch archive output : List Bool) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 1 + source counter scratch archive output) + (some (sourceGridIndexConfiguration 2 + [] counter scratch (source.reverse ++ archive) output)) + (source.length + 1) := by + induction source generalizing archive with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (sourceGridIndex_archive_finish counter scratch archive output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (sourceGridIndex_archive_step + bit remaining counter scratch archive output) + have hrest := ih (bit :: archive) + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def sourceGridIndex_sourceRestoreTrace + (archive counter scratch output : List Bool) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 2 + [] counter scratch archive output) + (some (sourceGridIndexConfiguration 3 + [] counter scratch [] (archive.reverse ++ output))) + (archive.length + 1) := by + induction archive generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (sourceGridIndex_source_restore_finish counter scratch output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (sourceGridIndex_source_restore_step + bit counter scratch remaining output) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def sourceGridIndex_copyTrace + (count : ℕ) (scratch output : List Bool) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 4 + [] (List.replicate count true) scratch [] output) + (some (sourceGridIndexConfiguration 5 + [] [] (List.replicate count true ++ scratch) [] + (false :: (List.replicate count true ++ output)))) + (count + 1) := by + induction count generalizing scratch output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceGridIndex_copy_finish scratch output) + | succ count ih => + have hfirst := oneStep _ _ (sourceGridIndex_copy_step + (List.replicate count true) scratch output) + have hrest := ih (true :: scratch) (true :: output) + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + 1 (count + 1) _ _ _ hfirst hrest + rw [sourceFlatAtomic_trueCounter_append count scratch, + sourceFlatAtomic_trueCounter_append count output] at hfull + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.reduceAdd] using hfull + +private def sourceGridIndex_templateRestoreTrace + (count : ℕ) (counter output : List Bool) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 5 + [] counter (List.replicate count true) [] output) + (some (sourceGridIndexConfiguration 3 + [] (List.replicate count true ++ counter) [] [] + (List.replicate count true ++ output))) + (count + 1) := by + induction count generalizing counter output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceGridIndex_template_restore_finish counter output) + | succ count ih => + have hfirst := oneStep _ _ (sourceGridIndex_template_restore_step + counter (List.replicate count true) output) + have hrest := ih (true :: counter) (true :: output) + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + 1 (count + 1) _ _ _ hfirst hrest + rw [sourceFlatAtomic_trueCounter_append count counter, + sourceFlatAtomic_trueCounter_append count output] at hfull + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.reduceAdd] using hfull + +private def sourceGridIndex_enumerationTrace + (count : ℕ) (output : List Bool) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 3 + [] (List.replicate count true) [] [] output) + (some (Turing.haltList + sourceCanonicalUnaryGridIndexMachine + (sourceCanonicalUnaryGridIndexDescriptors count ++ output))) + (count * count + 2 * count + 1) := by + induction count generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, + sourceCanonicalUnaryGridIndexDescriptors, + List.range_zero, List.flatMap_nil, List.nil_append, mul_zero, add_zero, zero_add] using + oneStep _ _ (sourceGridIndex_outer_finish output) + | succ count ih => + have houter := oneStep _ _ (sourceGridIndex_outer_step + (List.replicate count true) output) + have hcopy := sourceGridIndex_copyTrace count [] output + simp only [List.append_nil] at hcopy + have hrestore := sourceGridIndex_templateRestoreTrace + count [] (false :: (List.replicate count true ++ output)) + simp only [List.append_nil] at hrestore + have hfirst := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + _ _ _ _ _ houter hcopy + have hsecond := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + _ _ _ _ _ hfirst hrestore + have htail := ih + (sourceCanonicalUnaryGridIndexDescriptor count ++ output) + have hdescriptor : + List.replicate count true ++ + false :: (List.replicate count true ++ output) = + sourceCanonicalUnaryGridIndexDescriptor count ++ output := by + simp only [sourceCanonicalUnaryGridIndexDescriptor, lengthPrefixedWord, + List.length_replicate, + List.append_assoc, List.cons_append] + rw [hdescriptor] at hsecond + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + _ _ _ _ _ hsecond htail + rw [sourceCanonicalUnaryGridIndexDescriptors_succ] + have hbudget : + count * count + 2 * count + 1 + + (count + 1 + (count + 1 + 1)) ≤ + (count + 1) * (count + 1) + + 2 * (count + 1) + 1 := by + simp only [Nat.succ_mul, one_mul, Nat.mul_succ] + omega + have hbounded := rebound hfull hbudget + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.append_assoc] using hbounded + +private def sourceGridIndex_missingPrefixTrace + (count : ℕ) (counter : List Bool) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 0 + (List.replicate count true) counter [] [] []) + (some (sourceGridIndexConfiguration 6 + [] (List.replicate count true ++ counter) [] [] [])) + (count + 1) := by + induction count generalizing counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceGridIndex_prefix_missing counter [] [] []) + | succ count ih => + have hfirst := oneStep _ _ (sourceGridIndex_prefix_true + (List.replicate count true) counter [] [] []) + have hrest := ih (true :: counter) + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + 1 (count + 1) _ _ _ hfirst hrest + rw [sourceFlatAtomic_trueCounter_append count counter] at hfull + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.reduceAdd] using hfull + +private def sourceGridIndex_failureTrace + (count : ℕ) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (sourceGridIndexConfiguration 6 + [] (List.replicate count true) [] [] []) + (some (Turing.haltList + sourceCanonicalUnaryGridIndexMachine [])) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ sourceGridIndex_failure_finish + | succ count ih => + have hfirst := oneStep _ _ (sourceGridIndex_failure_step + (List.replicate count true)) + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + 1 (count + 1) _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd] using hfull + +private noncomputable def sourceCanonicalUnaryGridIndexTimePolynomial : Polynomial ℕ := + 2 * Polynomial.X ^ 2 + 8 * Polynomial.X + 8 + +private noncomputable def sourceCanonicalUnaryGridIndex_totalTrace + (input : List Bool) : + EvalsToInTime sourceCanonicalUnaryGridIndexMachine.step + (Turing.initList sourceCanonicalUnaryGridIndexMachine input) + (some (Turing.haltList + sourceCanonicalUnaryGridIndexMachine + (sourceCanonicalUnaryGridIndexOutput input))) + (sourceCanonicalUnaryGridIndexTimePolynomial.eval input.length) := by + cases hread : readUnaryPrefix input with + | none => + have hshape := sourceFlatAtomic_readUnaryPrefix_none + input hread + have hprefix := sourceGridIndex_missingPrefixTrace + input.length [] + simp only [List.append_nil] at hprefix + rw [← hshape, ← sourceCanonicalUnaryGridIndexMachine_init] + at hprefix + have hclean := sourceGridIndex_failureTrace input.length + rw [← hshape] at hclean + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + _ _ _ _ _ hprefix hclean + have houtput : sourceCanonicalUnaryGridIndexOutput input = [] := by + simp only [sourceCanonicalUnaryGridIndexOutput, hread] + rw [houtput] + exact rebound hfull (by + simp only [sourceCanonicalUnaryGridIndexTimePolynomial, pow_two, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + omega) + | some parsed => + obtain ⟨count, source⟩ := parsed + have hshape := sourceFlatAtomic_readUnaryPrefix_some + input count source hread + have hprefix := sourceGridIndex_prefixTrace + count source [] [] [] [] + simp only [List.append_nil] at hprefix + rw [← hshape, ← sourceCanonicalUnaryGridIndexMachine_init] + at hprefix + have harchive := sourceGridIndex_archiveTrace + source (List.replicate count true) [] [] [] + simp only [List.append_nil] at harchive + have hrestore := sourceGridIndex_sourceRestoreTrace + source.reverse (List.replicate count true) [] [] + simp only [List.reverse_reverse, List.append_nil, + List.length_reverse] at hrestore + have hemit := sourceGridIndex_enumerationTrace count source + have hfirst := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + _ _ _ _ _ hprefix harchive + have hsecond := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + _ _ _ _ _ hfirst hrestore + have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step + _ _ _ _ _ hsecond hemit + have houtput : + sourceCanonicalUnaryGridIndexOutput input = + sourceCanonicalUnaryGridIndexDescriptors count ++ source := by + simp only [sourceCanonicalUnaryGridIndexOutput, hread] + rw [houtput] + exact rebound hfull (by + have hlength : count ≤ input.length := by + rw [hshape] + simp only [List.length_append, List.length_replicate, + List.length_cons] + omega + have hsquare : count * count ≤ input.length * input.length := + Nat.mul_le_mul hlength hlength + have hsource : source.length ≤ input.length := by + rw [hshape] + simp only [List.length_append, List.length_replicate, + List.length_cons] + omega + simp only [sourceCanonicalUnaryGridIndexTimePolynomial, pow_two, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] + omega) + +/-- GapCVP reduction support. -/ +noncomputable def sourceCanonicalUnaryGridIndexComputable : + BitTM + sourceCanonicalUnaryGridIndexOutput where + tm := sourceCanonicalUnaryGridIndexMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := sourceCanonicalUnaryGridIndexTimePolynomial + outputsFun input := { + steps := (sourceCanonicalUnaryGridIndex_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, Option.map_some] using + (sourceCanonicalUnaryGridIndex_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := + (sourceCanonicalUnaryGridIndex_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, ge_iff_le] using hsteps + } + +end SourceCanonicalUnaryGridIndexTM + +namespace SourceOriginalSourcePreservingTM + +section + +open Turing + +private abbrev OriginalSourcePreservingStack (tm : Turing.FinTM2) := + tm.K ⊕ Fin 3 + +private abbrev originalSourcePreservingAlphabet (tm : Turing.FinTM2) : + OriginalSourcePreservingStack tm → Type + | .inl stack => tm.Γ stack + | .inr _ => Bool + +private abbrev OriginalSourcePreservingLabel (tm : Turing.FinTM2) := + tm.Λ ⊕ Fin 5 + +private abbrev OriginalSourcePreservingState (tm : Turing.FinTM2) := + Option Bool × tm.σ + +private def liftOriginalSourcePreservingStatement (tm : Turing.FinTM2) : + Turing.TM2.Stmt tm.Γ tm.Λ tm.σ → + Turing.TM2.Stmt + (originalSourcePreservingAlphabet tm) + (OriginalSourcePreservingLabel tm) + (OriginalSourcePreservingState tm) + | .push stack value next => + .push (.inl stack) (fun state => value state.2) + (liftOriginalSourcePreservingStatement tm next) + | .peek stack inspect next => + .peek (.inl stack) + (fun state symbol => (state.1, inspect state.2 symbol)) + (liftOriginalSourcePreservingStatement tm next) + | .pop stack consume next => + .pop (.inl stack) + (fun state symbol => (state.1, consume state.2 symbol)) + (liftOriginalSourcePreservingStatement tm next) + | .load update next => + .load (fun state => (state.1, update state.2)) + (liftOriginalSourcePreservingStatement tm next) + | .branch decide yes no => + .branch (fun state => decide state.2) + (liftOriginalSourcePreservingStatement tm yes) + (liftOriginalSourcePreservingStatement tm no) + | .goto next => .goto (fun state => .inl (next state.2)) + | .halt => + .load (fun state => (none, state.2)) + (.goto (fun _ => .inr (2 : Fin 5))) + +private noncomputable def originalSourcePreservingMachine + {f : List Bool → List Bool} + (computer : BitTM f) : Turing.FinTM2 := by + classical + letI : DecidableEq computer.tm.K := computer.tm.kDecidableEq + letI : Fintype computer.tm.K := computer.tm.kFin + letI : Fintype computer.tm.Λ := computer.tm.ΛFin + letI : Fintype computer.tm.σ := computer.tm.σFin + letI : Fintype (computer.tm.Γ computer.tm.k₀) := + computer.tm.Γk₀Fin + exact { + K := OriginalSourcePreservingStack computer.tm + k₀ := .inl computer.tm.k₀ + k₁ := .inl computer.tm.k₁ + Γ := originalSourcePreservingAlphabet computer.tm + Λ := OriginalSourcePreservingLabel computer.tm + main := .inr (0 : Fin 5) + σ := OriginalSourcePreservingState computer.tm + initialState := (none, computer.tm.initialState) + m := fun + | .inl phase => + liftOriginalSourcePreservingStatement + computer.tm (computer.tm.m phase) + | .inr phase => + if phase = (0 : Fin 5) then + .pop (.inl computer.tm.k₀) + (fun state symbol => + (symbol.map computer.inputAlphabet, state.2)) + (.branch (fun state => state.1.isSome) + (.push (.inr (0 : Fin 3)) + (fun state => state.1.getD false) + (.push (.inr (1 : Fin 3)) + (fun state => state.1.getD false) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (0 : Fin 5)))))) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (1 : Fin 5))))) + else if phase = (1 : Fin 5) then + .pop (.inr (1 : Fin 3)) + (fun state symbol => (symbol, state.2)) + (.branch (fun state => state.1.isSome) + (.push (.inl computer.tm.k₀) + (fun state => + computer.inputAlphabet.invFun + (state.1.getD false)) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (1 : Fin 5))))) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inl computer.tm.main)))) + else if phase = (2 : Fin 5) then + .pop (.inl computer.tm.k₁) + (fun state symbol => + (symbol.map computer.outputAlphabet, state.2)) + (.branch (fun state => state.1.isSome) + (.push (.inr (2 : Fin 3)) + (fun state => state.1.getD false) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (2 : Fin 5))))) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (3 : Fin 5))))) + else if phase = (3 : Fin 5) then + .pop (.inr (0 : Fin 3)) + (fun state symbol => (symbol, state.2)) + (.branch (fun state => state.1.isSome) + (.push (.inl computer.tm.k₁) + (fun state => + computer.outputAlphabet.invFun + (state.1.getD false)) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (3 : Fin 5))))) + (.push (.inl computer.tm.k₁) + (fun _ => computer.outputAlphabet.invFun false) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (4 : Fin 5)))))) + else + .pop (.inr (2 : Fin 3)) + (fun state symbol => (symbol, state.2)) + (.branch (fun state => state.1.isSome) + (.push (.inl computer.tm.k₁) + (fun state => + computer.outputAlphabet.invFun + (state.1.getD false)) + (.load (fun state => (none, state.2)) + (.goto (fun _ => .inr (4 : Fin 5))))) + (.load (fun state => (none, state.2)) .halt)) + } + +private def originalSourcePreservingStacks (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result : List Bool) : + (stack : OriginalSourcePreservingStack tm) → + List (originalSourcePreservingAlphabet tm stack) + | .inl stack => source stack + | .inr stack => + if stack = (0 : Fin 3) then backup + else if stack = (1 : Fin 3) then scratch + else result + +@[simp] private theorem originalSourcePreservingStacks_apply_worker + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result : List Bool) + (stack : tm.K) : + originalSourcePreservingStacks tm + source backup scratch result (.inl stack) = + source stack := by + rfl + +@[simp] private theorem originalSourcePreservingStacks_apply_backup + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result : List Bool) : + originalSourcePreservingStacks tm + source backup scratch result (.inr (0 : Fin 3)) = backup := by + simp only [Fin.isValue, originalSourcePreservingStacks, ↓reduceIte] + +@[simp] private theorem originalSourcePreservingStacks_apply_scratch + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result : List Bool) : + originalSourcePreservingStacks tm + source backup scratch result (.inr (1 : Fin 3)) = scratch := by + simp only [Fin.isValue, originalSourcePreservingStacks, one_ne_zero, ↓reduceIte] + +@[simp] private theorem originalSourcePreservingStacks_apply_result + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result : List Bool) : + originalSourcePreservingStacks tm + source backup scratch result (.inr (2 : Fin 3)) = result := by + simp only [Fin.isValue, originalSourcePreservingStacks, Fin.reduceEq, ↓reduceIte] + +private theorem sourceStacks_update_worker + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result : List Bool) + (stack : tm.K) (value : List (tm.Γ stack)) : + originalSourcePreservingStacks tm + (Function.update source stack value) + backup scratch result = + Function.update + (originalSourcePreservingStacks tm + source backup scratch result) + (.inl stack) value := by + classical + funext current + cases current with + | inl current => + by_cases hequal : current = stack + · subst current + simp only [originalSourcePreservingStacks, Function.update_self] + · simp only [originalSourcePreservingStacks, Function.update, hequal, ↓reduceDIte, + Sum.inl.injEq] + | inr current => + simp only [originalSourcePreservingStacks, Fin.isValue, Function.update, reduceCtorEq, + ↓reduceDIte] + +private theorem originalSourcePreservingStacks_update_backup + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result value : List Bool) : + originalSourcePreservingStacks tm + source value scratch result = + Function.update + (originalSourcePreservingStacks tm + source backup scratch result) + (.inr (0 : Fin 3)) value := by + classical + funext current + cases current with + | inl current => + simp only [originalSourcePreservingStacks, Function.update, Fin.isValue, reduceCtorEq, + ↓reduceDIte] + | inr current => + fin_cases current <;> + simp [originalSourcePreservingStacks, Function.update] + +private theorem sourceStacks_update_scratch + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result value : List Bool) : + originalSourcePreservingStacks tm + source backup value result = + Function.update + (originalSourcePreservingStacks tm + source backup scratch result) + (.inr (1 : Fin 3)) value := by + classical + funext current + cases current with + | inl current => + simp only [originalSourcePreservingStacks, Function.update, Fin.isValue, reduceCtorEq, + ↓reduceDIte] + | inr current => + fin_cases current <;> + simp [originalSourcePreservingStacks, Function.update] + +private theorem sourceStacks_update_result + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result value : List Bool) : + originalSourcePreservingStacks tm + source backup scratch value = + Function.update + (originalSourcePreservingStacks tm + source backup scratch result) + (.inr (2 : Fin 3)) value := by + classical + funext current + cases current with + | inl current => + simp only [originalSourcePreservingStacks, Function.update, Fin.isValue, reduceCtorEq, + ↓reduceDIte] + | inr current => + fin_cases current <;> + simp [originalSourcePreservingStacks, Function.update] + +private noncomputable def sourcePhaseConfiguration + {f : List Bool → List Bool} + (computer : BitTM f) + (phase : Fin 5) + (source : (stack : computer.tm.K) → + List (computer.tm.Γ stack)) + (backup scratch result : List Bool) : + (originalSourcePreservingMachine computer).Cfg where + l := some (.inr phase) + var := (none, computer.tm.initialState) + stk := originalSourcePreservingStacks computer.tm + source backup scratch result + +private noncomputable def sourceWorkerConfiguration + {f : List Bool → List Bool} + (computer : BitTM f) + (backup scratch result : List Bool) + (configuration : computer.tm.Cfg) : + (originalSourcePreservingMachine computer).Cfg where + l := match configuration.l with + | some phase => some (.inl phase) + | none => some (.inr (2 : Fin 5)) + var := (none, configuration.var) + stk := originalSourcePreservingStacks computer.tm + configuration.stk backup scratch result + +private theorem liftOriginalSourcePreservingStatement_stepAux + {f : List Bool → List Bool} + (computer : BitTM f) + (backup scratch result : List Bool) + (statement : Turing.TM2.Stmt + computer.tm.Γ computer.tm.Λ computer.tm.σ) + (state : computer.tm.σ) + (source : (stack : computer.tm.K) → + List (computer.tm.Γ stack)) : + Turing.TM2.stepAux + (liftOriginalSourcePreservingStatement + computer.tm statement) + (none, state) + (originalSourcePreservingStacks computer.tm + source backup scratch result) = + sourceWorkerConfiguration + computer backup scratch result + (Turing.TM2.stepAux statement state source) := by + classical + induction statement generalizing state source with + | push stack value next ih => + change Turing.TM2.stepAux + (liftOriginalSourcePreservingStatement computer.tm next) + (none, state) + (Function.update + (originalSourcePreservingStacks computer.tm + source backup scratch result) + (.inl stack) (value state :: source stack)) = _ + rw [← sourceStacks_update_worker] + exact ih (state := state) + (source := Function.update source stack + (value state :: source stack)) + | peek stack inspect next ih => + exact ih (state := inspect state (source stack).head?) + (source := source) + | pop stack consume next ih => + change Turing.TM2.stepAux + (liftOriginalSourcePreservingStatement computer.tm next) + (none, consume state (source stack).head?) + (Function.update + (originalSourcePreservingStacks computer.tm + source backup scratch result) + (.inl stack) (source stack).tail) = _ + rw [← sourceStacks_update_worker] + exact ih (state := consume state (source stack).head?) + (source := Function.update source stack + (source stack).tail) + | load update next ih => + exact ih (state := update state) (source := source) + | branch decide yes no ihyes ihno => + cases hdecision : decide state with + | false => + simpa only [liftOriginalSourcePreservingStatement, TM2.stepAux, hdecision, + Bool.cond_false] + using + ihno (state := state) (source := source) + | true => + simpa only [liftOriginalSourcePreservingStatement, TM2.stepAux, hdecision, + Bool.cond_true] + using + ihyes (state := state) (source := source) + | goto next => rfl + | halt => rfl + +private theorem originalSourcePreservingWorkerConfiguration_step + {f : List Bool → List Bool} + (computer : BitTM f) + (backup scratch result : List Bool) + (configuration next : computer.tm.Cfg) + (hstep : computer.tm.step configuration = some next) : + (originalSourcePreservingMachine computer).step + (sourceWorkerConfiguration + computer backup scratch result configuration) = + some (sourceWorkerConfiguration + computer backup scratch result next) := by + rcases configuration with ⟨phase, state, source⟩ + cases phase with + | none => + simp only [FinTM2.step, TM2.step, reduceCtorEq] at hstep + | some phase => + change some (Turing.TM2.stepAux + (computer.tm.m phase) state source) = some next at hstep + have hnext := Option.some.inj hstep + subst next + change some (Turing.TM2.stepAux + (liftOriginalSourcePreservingStatement + computer.tm (computer.tm.m phase)) + (none, state) + (originalSourcePreservingStacks computer.tm + source backup scratch result)) = _ + rw [liftOriginalSourcePreservingStatement_stepAux] + rfl + +private noncomputable def originalSourcePreservingWorker_evalsToInTime + {f : List Bool → List Bool} + (computer : BitTM f) + (backup scratch result : List Bool) + {source target : computer.tm.Cfg} + {budget : ℕ} + (trace : EvalsToInTime + computer.tm.step source (some target) budget) : + EvalsToInTime (originalSourcePreservingMachine computer).step + (sourceWorkerConfiguration + computer backup scratch result source) + (some (sourceWorkerConfiguration + computer backup scratch result target)) budget := + GapCVP.TMComposition.evalsToInTimeMapOfStep + computer.tm.step + (originalSourcePreservingMachine computer).step + (fun state => sourceWorkerConfiguration + computer backup scratch result state) + (originalSourcePreservingWorkerConfiguration_step + computer backup scratch result) + trace + +/-- GapCVP reduction support. -/ +def originalSourcePreservingOutput + (f : List Bool → List Bool) (input : List Bool) : List Bool := + f input ++ false :: input + +private def sourceInputSymbols + {f : List Bool → List Bool} + (computer : BitTM f) + (input : List Bool) : + List (computer.tm.Γ computer.tm.k₀) := + List.map computer.inputAlphabet.invFun input + +private def sourceOutputSymbols + {f : List Bool → List Bool} + (computer : BitTM f) + (output : List Bool) : + List (computer.tm.Γ computer.tm.k₁) := + List.map computer.outputAlphabet.invFun output + +private def originalSourceCopyConfiguration + {f : List Bool → List Bool} + (computer : BitTM f) + (phase : Fin 5) (input backup scratch result : List Bool) : + (originalSourcePreservingMachine computer).Cfg := + sourcePhaseConfiguration computer phase + (Turing.initList computer.tm + (sourceInputSymbols computer input)).stk + backup scratch result + +private def originalSourceOutputConfiguration + {f : List Bool → List Bool} + (computer : BitTM f) + (phase : Fin 5) (output backup scratch result : List Bool) : + (originalSourcePreservingMachine computer).Cfg := + sourcePhaseConfiguration computer phase + (Turing.haltList computer.tm + (sourceOutputSymbols computer output)).stk + backup scratch result + +private theorem originalSourcePreservingMachine_init + {f : List Bool → List Bool} + (computer : BitTM f) + (input : List Bool) : + Turing.initList (originalSourcePreservingMachine computer) + (sourceInputSymbols computer input) = + originalSourceCopyConfiguration + computer 0 input [] [] [] := by + classical + simp only [originalSourcePreservingMachine, Fin.isValue, Equiv.invFun_as_coe, initList, + sourceInputSymbols, + eq_mpr_eq_cast, originalSourceCopyConfiguration, sourcePhaseConfiguration] + congr 1 + funext stack + cases stack with + | inl stack => + by_cases hequal : stack = computer.tm.k₀ + · subst stack + simp only [↓reduceDIte, cast_eq, originalSourcePreservingStacks] + rfl + · simp only [Sum.inl.injEq, hequal, ↓reduceDIte, originalSourcePreservingStacks] + | inr stack => + fin_cases stack <;> + simp [originalSourcePreservingStacks] + +@[simp] private theorem originalSourcePreserving_initialStacks_update + (tm : Turing.FinTM2) + (input value : List (tm.Γ tm.k₀)) : + Function.update + (Turing.initList tm input).stk tm.k₀ value = + (Turing.initList tm value).stk := by + classical + funext stack + by_cases hequal : stack = tm.k₀ + · subst stack + simp only [initList, eq_mpr_eq_cast, Function.update_self, ↓reduceDIte, cast_eq] + · simp only [Function.update, hequal, ↓reduceDIte, initList, eq_mpr_eq_cast] + +@[simp] private theorem originalSourcePreserving_haltStacks_update + (tm : Turing.FinTM2) + (output value : List (tm.Γ tm.k₁)) : + Function.update + (Turing.haltList tm output).stk tm.k₁ value = + (Turing.haltList tm value).stk := by + classical + funext stack + by_cases hequal : stack = tm.k₁ + · subst stack + simp only [haltList, eq_mpr_eq_cast, Function.update_self, ↓reduceDIte, cast_eq] + · simp only [Function.update, hequal, ↓reduceDIte, haltList, eq_mpr_eq_cast] + +@[simp] private theorem originalSourcePreserving_embedded_update_worker + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result : List Bool) + (stack : tm.K) (value : List (tm.Γ stack)) : + Function.update + (originalSourcePreservingStacks tm + source backup scratch result) + (.inl stack) value = + originalSourcePreservingStacks tm + (Function.update source stack value) + backup scratch result := + (sourceStacks_update_worker + tm source backup scratch result stack value).symm + +@[simp] private theorem originalSourcePreserving_embedded_update_backup + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result value : List Bool) : + Function.update + (originalSourcePreservingStacks tm + source backup scratch result) + (.inr (0 : Fin 3)) value = + originalSourcePreservingStacks tm + source value scratch result := + (originalSourcePreservingStacks_update_backup + tm source backup scratch result value).symm + +@[simp] private theorem originalSourcePreserving_embedded_update_scratch + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result value : List Bool) : + Function.update + (originalSourcePreservingStacks tm + source backup scratch result) + (.inr (1 : Fin 3)) value = + originalSourcePreservingStacks tm + source backup value result := + (sourceStacks_update_scratch + tm source backup scratch result value).symm + +@[simp] private theorem originalSourcePreserving_embedded_update_result + (tm : Turing.FinTM2) + (source : (stack : tm.K) → List (tm.Γ stack)) + (backup scratch result value : List Bool) : + Function.update + (originalSourcePreservingStacks tm + source backup scratch result) + (.inr (2 : Fin 3)) value = + originalSourcePreservingStacks tm + source backup scratch value := + (sourceStacks_update_result + tm source backup scratch result value).symm + +private theorem originalSourcePreserving_embedded_haltStacks + {f : List Bool → List Bool} + (computer : BitTM f) + (output : List (computer.tm.Γ computer.tm.k₁)) : + originalSourcePreservingStacks computer.tm + (Turing.haltList computer.tm output).stk [] [] [] = + (Turing.haltList + (originalSourcePreservingMachine computer) output).stk := by + classical + funext stack + cases stack with + | inl stack => + by_cases hequal : stack = computer.tm.k₁ + · subst stack + simp only [originalSourcePreservingStacks, haltList, eq_mpr_eq_cast, ↓reduceDIte, cast_eq, + originalSourcePreservingMachine, Fin.isValue, Equiv.invFun_as_coe] + rfl + · simp only [originalSourcePreservingStacks, haltList, eq_mpr_eq_cast, hequal, ↓reduceDIte, + originalSourcePreservingMachine, Fin.isValue, Equiv.invFun_as_coe, Sum.inl.injEq] + | inr stack => + fin_cases stack <;> + simp [originalSourcePreservingStacks, + originalSourcePreservingMachine, Turing.haltList] + +/-- Executes the `originalSourcePreservationStepTac` machine-step simplifier. -/ +macro "originalSourcePreservationStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp +instances [originalSourcePreservingMachine, + originalSourceCopyConfiguration, + originalSourceOutputConfiguration, + sourcePhaseConfiguration, + sourceInputSymbols, + sourceOutputSymbols, + Turing.FinTM2.step, Turing.TM2.step, + Turing.TM2.stepAux] <;> + first + | rfl + | (congr 2 + first + | exact originalSourcePreserving_embedded_haltStacks _ _ + | rw! (castMode := .all) + [← sourceStacks_update_worker, + ← originalSourcePreservingStacks_update_backup, + ← sourceStacks_update_scratch, + originalSourcePreserving_initialStacks_update] + | rw! (castMode := .all) + [← sourceStacks_update_worker, + originalSourcePreserving_initialStacks_update] + | rw! (castMode := .all) + [← sourceStacks_update_scratch, + ← sourceStacks_update_worker, + originalSourcePreserving_initialStacks_update] + | rw! (castMode := .all) + [← sourceStacks_update_scratch] + | rw! (castMode := .all) + [← sourceStacks_update_worker, + ← sourceStacks_update_result, + originalSourcePreserving_haltStacks_update] + | rw! (castMode := .all) + [← sourceStacks_update_worker, + originalSourcePreserving_haltStacks_update] + | rw! (castMode := .all) + [← originalSourcePreservingStacks_update_backup, + ← sourceStacks_update_worker, + originalSourcePreserving_haltStacks_update] + | rw! (castMode := .all) + [← sourceStacks_update_result, + ← sourceStacks_update_worker, + originalSourcePreserving_haltStacks_update] + | rw! (castMode := .all) + [← sourceStacks_update_result, + originalSourcePreserving_embedded_haltStacks])))) + +private theorem originalSourcePreserving_copy_step + {f : List Bool → List Bool} + (computer : BitTM f) + (bit : Bool) + (input backup scratch result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceCopyConfiguration + computer 0 (bit :: input) backup scratch result) = + some (originalSourceCopyConfiguration + computer 0 input + (bit :: backup) (bit :: scratch) result) := by + classical + cases bit <;> originalSourcePreservationStepTac + +private theorem originalSourcePreserving_copy_finish + {f : List Bool → List Bool} + (computer : BitTM f) + (backup scratch result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceCopyConfiguration + computer 0 [] backup scratch result) = + some (originalSourceCopyConfiguration + computer 1 [] backup scratch result) := by + classical + originalSourcePreservationStepTac + +private theorem originalSourcePreserving_input_restore_step + {f : List Bool → List Bool} + (computer : BitTM f) + (bit : Bool) + (input backup scratch result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceCopyConfiguration + computer 1 input backup (bit :: scratch) result) = + some (originalSourceCopyConfiguration + computer 1 (bit :: input) backup scratch result) := by + classical + cases bit <;> originalSourcePreservationStepTac + +private theorem originalSourcePreserving_input_restore_finish + {f : List Bool → List Bool} + (computer : BitTM f) + (input backup result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceCopyConfiguration + computer 1 input backup [] result) = + some (sourceWorkerConfiguration + computer backup [] result + (Turing.initList computer.tm + (sourceInputSymbols computer input))) := by + classical + originalSourcePreservationStepTac + +private theorem originalSourcePreserving_output_archive_step + {f : List Bool → List Bool} + (computer : BitTM f) + (bit : Bool) + (output backup scratch result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 2 (bit :: output) backup scratch result) = + some (originalSourceOutputConfiguration + computer 2 output backup scratch (bit :: result)) := by + classical + cases bit <;> originalSourcePreservationStepTac + +private theorem originalSourcePreserving_output_archive_finish + {f : List Bool → List Bool} + (computer : BitTM f) + (backup scratch result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 2 [] backup scratch result) = + some (originalSourceOutputConfiguration + computer 3 [] backup scratch result) := by + classical + originalSourcePreservationStepTac + +private theorem originalSourcePreserving_source_restore_step + {f : List Bool → List Bool} + (computer : BitTM f) + (bit : Bool) + (output backup result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 3 output (bit :: backup) [] result) = + some (originalSourceOutputConfiguration + computer 3 (bit :: output) backup [] result) := by + classical + cases bit <;> originalSourcePreservationStepTac + +private theorem originalSourcePreserving_source_restore_finish + {f : List Bool → List Bool} + (computer : BitTM f) + (output result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 3 output [] [] result) = + some (originalSourceOutputConfiguration + computer 4 (false :: output) [] [] result) := by + classical + originalSourcePreservationStepTac + +private theorem originalSourcePreserving_result_restore_step + {f : List Bool → List Bool} + (computer : BitTM f) + (bit : Bool) + (output result : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 4 output [] [] (bit :: result)) = + some (originalSourceOutputConfiguration + computer 4 (bit :: output) [] [] result) := by + classical + cases bit <;> originalSourcePreservationStepTac + +private theorem originalSourcePreserving_result_restore_finish + {f : List Bool → List Bool} + (computer : BitTM f) + (output : List Bool) : + (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 4 output [] [] []) = + some (Turing.haltList + (originalSourcePreservingMachine computer) + (sourceOutputSymbols computer output)) := by + classical + originalSourcePreservationStepTac + +private def originalSourcePreserving_copyTrace + {f : List Bool → List Bool} + (computer : BitTM f) + (input backup scratch result : List Bool) : + EvalsToInTime (originalSourcePreservingMachine computer).step + (originalSourceCopyConfiguration + computer 0 input backup scratch result) + (some (originalSourceCopyConfiguration + computer 1 [] + (input.reverse ++ backup) + (input.reverse ++ scratch) result)) + (input.length + 1) := by + induction input generalizing backup scratch with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (originalSourcePreserving_copy_finish computer backup scratch result) + | cons bit remaining ih => + have hfirst := oneStep _ _ (originalSourcePreserving_copy_step + computer bit remaining backup scratch result) + have hrest := ih (bit :: backup) (bit :: scratch) + have hfull := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def originalSourcePreserving_inputRestoreTrace + {f : List Bool → List Bool} + (computer : BitTM f) + (scratch input backup result : List Bool) : + EvalsToInTime (originalSourcePreservingMachine computer).step + (originalSourceCopyConfiguration + computer 1 input backup scratch result) + (some (sourceWorkerConfiguration + computer backup [] result + (Turing.initList computer.tm + (sourceInputSymbols computer + (scratch.reverse ++ input))))) + (scratch.length + 1) := by + induction scratch generalizing input with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (originalSourcePreserving_input_restore_finish computer input backup result) + | cons bit remaining ih => + have hfirst := oneStep _ _ (originalSourcePreserving_input_restore_step + computer bit input backup remaining result) + have hrest := ih (bit :: input) + have hfull := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private theorem originalSourcePreservingWorkerConfiguration_halt + {f : List Bool → List Bool} + (computer : BitTM f) + (output backup scratch result : List Bool) : + sourceWorkerConfiguration + computer backup scratch result + (Turing.haltList computer.tm + (sourceOutputSymbols + computer output)) = + originalSourceOutputConfiguration + computer 2 output backup scratch result := by + simp only [sourceWorkerConfiguration, haltList, eq_mpr_eq_cast, Fin.isValue, + originalSourceOutputConfiguration, sourcePhaseConfiguration] + rfl + +private def originalSourcePreserving_workerTrace + {f : List Bool → List Bool} + (computer : BitTM f) + (input backup scratch result : List Bool) : + EvalsToInTime (originalSourcePreservingMachine computer).step + (sourceWorkerConfiguration + computer backup scratch result + (Turing.initList computer.tm + (sourceInputSymbols computer input))) + (some (originalSourceOutputConfiguration + computer 2 (f input) backup scratch result)) + (computer.time.eval input.length) := by + have hworker := originalSourcePreservingWorker_evalsToInTime + computer backup scratch result (computer.outputsFun input) + simp only [bitEncoding] at hworker + change EvalsToInTime + (originalSourcePreservingMachine computer).step + (sourceWorkerConfiguration + computer backup scratch result + (Turing.initList computer.tm + (sourceInputSymbols computer input))) + (some (sourceWorkerConfiguration + computer backup scratch result + (Turing.haltList computer.tm + (sourceOutputSymbols + computer (f input))))) + (computer.time.eval input.length) at hworker + rw [originalSourcePreservingWorkerConfiguration_halt] at hworker + exact hworker + +private def originalSourcePreserving_outputArchiveTrace + {f : List Bool → List Bool} + (computer : BitTM f) + (output backup scratch result : List Bool) : + EvalsToInTime (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 2 output backup scratch result) + (some (originalSourceOutputConfiguration + computer 3 [] backup scratch + (output.reverse ++ result))) + (output.length + 1) := by + induction output generalizing result with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (originalSourcePreserving_output_archive_finish computer backup scratch + result) + | cons bit remaining ih => + have hfirst := oneStep _ _ (originalSourcePreserving_output_archive_step + computer bit remaining backup scratch result) + have hrest := ih (bit :: result) + have hfull := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def originalSourcePreserving_sourceRestoreTrace + {f : List Bool → List Bool} + (computer : BitTM f) + (backup output result : List Bool) : + EvalsToInTime (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 3 output backup [] result) + (some (originalSourceOutputConfiguration + computer 4 + (false :: (backup.reverse ++ output)) [] [] result)) + (backup.length + 1) := by + induction backup generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (originalSourcePreserving_source_restore_finish computer output result) + | cons bit remaining ih => + have hfirst := oneStep _ _ (originalSourcePreserving_source_restore_step + computer bit output remaining result) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def originalSourcePreserving_resultRestoreTrace + {f : List Bool → List Bool} + (computer : BitTM f) + (result output : List Bool) : + EvalsToInTime (originalSourcePreservingMachine computer).step + (originalSourceOutputConfiguration + computer 4 output [] [] result) + (some (Turing.haltList + (originalSourcePreservingMachine computer) + (sourceOutputSymbols computer + (result.reverse ++ output)))) + (result.length + 1) := by + induction result generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (originalSourcePreserving_result_restore_finish computer output) + | cons bit remaining ih => + have hfirst := oneStep _ _ (originalSourcePreserving_result_restore_step + computer bit output remaining) + have hrest := ih (bit :: output) + have hfull := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + 1 (remaining.length + 1) _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull + +private def sourceTimePolynomial + {f : List Bool → List Bool} + (computer : BitTM f) : Polynomial ℕ := + computer.time + 3 * Polynomial.X + + 2 * GapCVP.TMComposition.outputLengthPolynomial computer + 8 + +private def originalSourcePreserving_totalTrace + {f : List Bool → List Bool} + (computer : BitTM f) + (input : List Bool) : + EvalsToInTime (originalSourcePreservingMachine computer).step + (Turing.initList (originalSourcePreservingMachine computer) + (sourceInputSymbols computer input)) + (some (Turing.haltList + (originalSourcePreservingMachine computer) + (sourceOutputSymbols computer + (originalSourcePreservingOutput f input)))) + ((sourceTimePolynomial computer).eval + input.length) := by + have hcopy := originalSourcePreserving_copyTrace + computer input [] [] [] + simp only [List.append_nil] at hcopy + rw [← originalSourcePreservingMachine_init] at hcopy + have hrestore := originalSourcePreserving_inputRestoreTrace + computer input.reverse [] input.reverse [] + simp only [List.reverse_reverse, List.append_nil, + List.length_reverse] at hrestore + have hworker := originalSourcePreserving_workerTrace + computer input input.reverse [] [] + have harchive := originalSourcePreserving_outputArchiveTrace + computer (f input) input.reverse [] [] + simp only [List.append_nil] at harchive + have hsource := originalSourcePreserving_sourceRestoreTrace + computer input.reverse [] (f input).reverse + simp only [List.reverse_reverse, List.append_nil, + List.length_reverse] at hsource + have hresult := originalSourcePreserving_resultRestoreTrace + computer (f input).reverse (false :: input) + simp only [List.reverse_reverse, List.length_reverse] at hresult + have hfirst := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + _ _ _ _ _ hcopy hrestore + have hsecond := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + _ _ _ _ _ hfirst hworker + have hthird := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + _ _ _ _ _ hsecond harchive + have hfourth := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + _ _ _ _ _ hthird hsource + have hfull := EvalsToInTime.trans (originalSourcePreservingMachine computer).step + _ _ _ _ _ hfourth hresult + have hlength := + GapCVP.TMComposition.outputLengthPolynomial_bounds + computer input + apply rebound hfull + simp only [sourceTimePolynomial, Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X] + omega + +/-- GapCVP reduction support. -/ +noncomputable def originalSourcePreservingComputable + {f : List Bool → List Bool} + (computer : BitTM f) : + BitTM + (originalSourcePreservingOutput f) where + tm := originalSourcePreservingMachine computer + inputAlphabet := computer.inputAlphabet + outputAlphabet := computer.outputAlphabet + time := sourceTimePolynomial computer + outputsFun input := by + change EvalsToInTime + (originalSourcePreservingMachine computer).step + (Turing.initList (originalSourcePreservingMachine computer) + (sourceInputSymbols computer input)) + (some (Turing.haltList + (originalSourcePreservingMachine computer) + (sourceOutputSymbols computer + (originalSourcePreservingOutput f input)))) + ((sourceTimePolynomial computer).eval + input.length) + exact originalSourcePreserving_totalTrace computer input + +end + +end SourceOriginalSourcePreservingTM + +namespace CNFGuardedSourceDescriptorRotationBoundedFoldTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder + +theorem guardedRotation_readUnaryPrefix_some_reconstruct + (input : List Bool) (count : ℕ) (tail : List Bool) + (hread : readUnaryPrefix input = some (count, tail)) : + input = List.replicate count true ++ false :: tail := by + exact GapCVP.SourceWholeOutputValidBranchRecordTM.sourceFlatAtomic_readUnaryPrefix_some + input count tail hread + +theorem guardedRotation_readLengthPrefixedWord_some_reconstruct + (input payload suffix : List Bool) + (hread : readLengthPrefixedWord input = some (payload, suffix)) : + input = lengthPrefixedWord payload ++ suffix := by + exact GapCVP.FormulaSemanticCert.readLengthPrefixedWord_some_reconstruct + input payload suffix hread + +end CNFGuardedSourceDescriptorRotationBoundedFoldTM + +namespace CNFFlatAdjacentRecordSwapTM + +open Turing GapCVP.BinaryEncoding GapCVP.CNFGuardedSourceDescriptorRotationBoundedFoldTM + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordSwapOutput (input : List Bool) : List Bool := + match readLengthPrefixedWord input with + | none => [] + | some (first, rest) => + match readLengthPrefixedWord rest with + | none => [] + | some (second, suffix) => + lengthPrefixedWord second ++ + lengthPrefixedWord first ++ suffix + +theorem flatAdjacentRecordSwapOutput_records + (first second suffix : List Bool) : + flatAdjacentRecordSwapOutput + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) = + lengthPrefixedWord second ++ + lengthPrefixedWord first ++ suffix := by + simp only [flatAdjacentRecordSwapOutput, List.append_assoc, readLengthPrefixedWord_append] + +theorem flatAdjacentRecordSwapOutput_length_le + (input : List Bool) : + (flatAdjacentRecordSwapOutput input).length ≤ input.length := by + cases hfirst : readLengthPrefixedWord input with + | none => simp only [flatAdjacentRecordSwapOutput, hfirst, List.length_nil, zero_le] + | some parsed => + obtain ⟨first, rest⟩ := parsed + cases hsecond : readLengthPrefixedWord rest with + | none => simp only [flatAdjacentRecordSwapOutput, hfirst, hsecond, List.length_nil, zero_le] + | some parsed => + obtain ⟨second, suffix⟩ := parsed + have horiginal := + guardedRotation_readLengthPrefixedWord_some_reconstruct + input first rest hfirst + have hrest := + guardedRotation_readLengthPrefixedWord_some_reconstruct + rest second suffix hsecond + simp only [flatAdjacentRecordSwapOutput, hfirst, hsecond, + List.length_append] + rw [horiginal, hrest] + simp only [List.length_append] + omega + +private def flatAdjacentRecordPeek (stack : Fin 4) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def flatAdjacentRecordPop (stack : Fin 4) + (next : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + .pop stack (fun state _ => state) next + +private def flatAdjacentRecordPushBit (stack : Fin 4) + (next : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + .push stack (fun state => state.getD false) next + +private def flatAdjacentRecordPushConstant (stack : Fin 4) (bit : Bool) + (next : Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + .push stack (fun _ => bit) next + +private def flatAdjacentRecordGoto (phase : Fin 7) : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordFirstPrefixStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + flatAdjacentRecordPeek 0 + (.branch (fun state => state.getD false) + (flatAdjacentRecordPop 0 + (flatAdjacentRecordPushConstant 1 true + (flatAdjacentRecordPushConstant 3 true + (flatAdjacentRecordGoto 0)))) + (flatAdjacentRecordPop 0 + (flatAdjacentRecordPushConstant 1 false + (flatAdjacentRecordGoto 1)))) + (flatAdjacentRecordGoto 6) + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordFirstPayloadStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + flatAdjacentRecordPeek 3 + (flatAdjacentRecordPeek 0 + (flatAdjacentRecordPop 3 + (flatAdjacentRecordPop 0 + (flatAdjacentRecordPushBit 1 + (flatAdjacentRecordGoto 1)))) + (flatAdjacentRecordGoto 6)) + (flatAdjacentRecordGoto 2) + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordSecondPrefixStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + flatAdjacentRecordPeek 0 + (.branch (fun state => state.getD false) + (flatAdjacentRecordPop 0 + (flatAdjacentRecordPushConstant 2 true + (flatAdjacentRecordPushConstant 3 true + (flatAdjacentRecordGoto 2)))) + (flatAdjacentRecordPop 0 + (flatAdjacentRecordPushConstant 2 false + (flatAdjacentRecordGoto 3)))) + (flatAdjacentRecordGoto 6) + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordSecondPayloadStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + flatAdjacentRecordPeek 3 + (flatAdjacentRecordPeek 0 + (flatAdjacentRecordPop 3 + (flatAdjacentRecordPop 0 + (flatAdjacentRecordPushBit 2 + (flatAdjacentRecordGoto 3)))) + (flatAdjacentRecordGoto 6)) + (flatAdjacentRecordGoto 4) + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordRestoreFirstStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + flatAdjacentRecordPeek 1 + (flatAdjacentRecordPop 1 + (flatAdjacentRecordPushBit 0 + (flatAdjacentRecordGoto 4))) + (flatAdjacentRecordGoto 5) + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordRestoreSecondStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + flatAdjacentRecordPeek 2 + (flatAdjacentRecordPop 2 + (flatAdjacentRecordPushBit 0 + (flatAdjacentRecordGoto 5))) + .halt + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordFailureStatement : + Turing.TM2.Stmt + (fun _ : Fin 4 => Bool) (Fin 7) (Option Bool) := + flatAdjacentRecordPeek 0 + (flatAdjacentRecordPop 0 (flatAdjacentRecordGoto 6)) + (flatAdjacentRecordPeek 1 + (flatAdjacentRecordPop 1 (flatAdjacentRecordGoto 6)) + (flatAdjacentRecordPeek 2 + (flatAdjacentRecordPop 2 (flatAdjacentRecordGoto 6)) + (flatAdjacentRecordPeek 3 + (flatAdjacentRecordPop 3 (flatAdjacentRecordGoto 6)) + .halt))) + +/-- GapCVP reduction support. -/ +abbrev actualFlatAdjacentRecordSwapMachine : Turing.FinTM2 where + K := Fin 4 + k₀ := 0 + k₁ := 0 + Γ _ := Bool + Λ := Fin 7 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 7) then + flatAdjacentRecordFirstPrefixStatement + else if phase = (1 : Fin 7) then + flatAdjacentRecordFirstPayloadStatement + else if phase = (2 : Fin 7) then + flatAdjacentRecordSecondPrefixStatement + else if phase = (3 : Fin 7) then + flatAdjacentRecordSecondPayloadStatement + else if phase = (4 : Fin 7) then + flatAdjacentRecordRestoreFirstStatement + else if phase = (5 : Fin 7) then + flatAdjacentRecordRestoreSecondStatement + else + flatAdjacentRecordFailureStatement + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordConfiguration (phase : Fin 7) + (input first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.Cfg where + l := some phase + var := none + stk := ![input, first, second, counter] + +theorem actualFlatAdjacentRecordSwapMachine_init + (input : List Bool) : + Turing.initList actualFlatAdjacentRecordSwapMachine input = + flatAdjacentRecordConfiguration 0 input [] [] [] := by + simp only [actualFlatAdjacentRecordSwapMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + flatAdjacentRecordConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `flatAdjacentRecordStepTac` machine-step simplifier. -/ +macro "flatAdjacentRecordStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [actualFlatAdjacentRecordSwapMachine, + flatAdjacentRecordConfiguration, + flatAdjacentRecordPeek, flatAdjacentRecordPop, + flatAdjacentRecordPushBit, flatAdjacentRecordPushConstant, + flatAdjacentRecordGoto, + flatAdjacentRecordFirstPrefixStatement, + flatAdjacentRecordFirstPayloadStatement, + flatAdjacentRecordSecondPrefixStatement, + flatAdjacentRecordSecondPayloadStatement, + flatAdjacentRecordRestoreFirstStatement, + flatAdjacentRecordRestoreSecondStatement, + flatAdjacentRecordFailureStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_firstPrefix_true + (input first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (true :: input) first second counter) = + some (flatAdjacentRecordConfiguration 0 + input (true :: first) second (true :: counter)) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_firstPrefix_false + (input first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (false :: input) first second counter) = + some (flatAdjacentRecordConfiguration 1 + input (false :: first) second counter) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_firstPrefix_missing + (first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 [] first second counter) = + some (flatAdjacentRecordConfiguration 6 + [] first second counter) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_firstPayload_step + (bit : Bool) (input first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 1 + (bit :: input) first second (true :: counter)) = + some (flatAdjacentRecordConfiguration 1 + input (bit :: first) second counter) := by + cases bit <;> flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_firstPayload_missing + (first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 1 + [] first second (true :: counter)) = + some (flatAdjacentRecordConfiguration 6 + [] first second (true :: counter)) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_firstPayload_finish + (input first second : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 1 input first second []) = + some (flatAdjacentRecordConfiguration 2 input first second []) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_secondPrefix_true + (input first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 2 + (true :: input) first second counter) = + some (flatAdjacentRecordConfiguration 2 + input first (true :: second) (true :: counter)) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_secondPrefix_false + (input first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 2 + (false :: input) first second counter) = + some (flatAdjacentRecordConfiguration 3 + input first (false :: second) counter) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_secondPrefix_missing + (first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 2 [] first second counter) = + some (flatAdjacentRecordConfiguration 6 + [] first second counter) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_secondPayload_step + (bit : Bool) (input first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 3 + (bit :: input) first second (true :: counter)) = + some (flatAdjacentRecordConfiguration 3 + input first (bit :: second) counter) := by + cases bit <;> flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_secondPayload_missing + (first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 3 + [] first second (true :: counter)) = + some (flatAdjacentRecordConfiguration 6 + [] first second (true :: counter)) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_secondPayload_finish + (input first second : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 3 input first second []) = + some (flatAdjacentRecordConfiguration 4 input first second []) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_restoreFirst_step + (bit : Bool) (input first second : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 4 + input (bit :: first) second []) = + some (flatAdjacentRecordConfiguration 4 + (bit :: input) first second []) := by + cases bit <;> flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_restoreFirst_finish + (input second : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 4 input [] second []) = + some (flatAdjacentRecordConfiguration 5 input [] second []) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_restoreSecond_step + (bit : Bool) (input second : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 5 + input [] (bit :: second) []) = + some (flatAdjacentRecordConfiguration 5 + (bit :: input) [] second []) := by + cases bit <;> flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_restoreSecond_finish + (input : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 5 input [] [] []) = + some (Turing.haltList actualFlatAdjacentRecordSwapMachine input) := by + flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_failure_input + (bit : Bool) (input first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 6 + (bit :: input) first second counter) = + some (flatAdjacentRecordConfiguration 6 + input first second counter) := by + cases bit <;> flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_failure_first + (bit : Bool) (first second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 6 + [] (bit :: first) second counter) = + some (flatAdjacentRecordConfiguration 6 + [] first second counter) := by + cases bit <;> flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_failure_second + (bit : Bool) (second counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 6 + [] [] (bit :: second) counter) = + some (flatAdjacentRecordConfiguration 6 + [] [] second counter) := by + cases bit <;> flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_failure_counter + (bit : Bool) (counter : List Bool) : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 6 + [] [] [] (bit :: counter)) = + some (flatAdjacentRecordConfiguration 6 + [] [] [] counter) := by + cases bit <;> flatAdjacentRecordStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAdjacentRecord_failure_finish : + actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 6 [] [] [] []) = + some (Turing.haltList actualFlatAdjacentRecordSwapMachine []) := by + flatAdjacentRecordStepTac + +end CNFFlatAdjacentRecordSwapTM + +namespace CNFFlatAdjacentRecordSwapTotalCert + +open Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CNFFlatAdjacentRecordSwapTM + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatAdjacent_readLengthPrefixedWord_missing + (count : ℕ) : + readLengthPrefixedWord (List.replicate count true) = none := by + simp only [readLengthPrefixedWord, readUnaryPrefix_missing] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatAdjacent_readLengthPrefixedWord_short + (payload : List Bool) (extra : ℕ) : + readLengthPrefixedWord + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) = none := by + have hshort : ¬ payload.length + extra + 1 ≤ payload.length := by + omega + simp only [readLengthPrefixedWord, readUnaryPrefix_replicate, hshort, ↓reduceIte] + +end CNFFlatAdjacentRecordSwapTotalCert + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part05E.lean b/LeanPool/GapCVP/Part05E.lean new file mode 100644 index 000000000..5786d410c --- /dev/null +++ b/LeanPool/GapCVP/Part05E.lean @@ -0,0 +1,1146 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part05D + +/-! # GapCVP proof, part 05, continuation 05 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFlatAdjacentRecordSwapTotalCert + +open Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder + +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CNFFlatAdjacentRecordSwapTM + +private def flatAdjacentRecord_failureTrace + (input first second counter : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 6 input first second counter) + (some (Turing.haltList actualFlatAdjacentRecordSwapMachine [])) + (input.length + first.length + second.length + counter.length + 1) := by + induction input generalizing first second counter with + | cons bit input ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_failure_input + bit input first second counter) + have hrest := ih first second counter + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ + _ hfirst hrest + | nil => + induction first generalizing second counter with + | cons bit first ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_failure_first + bit first second counter) + have hrest := ih second counter + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + | nil => + induction second generalizing counter with + | cons bit second ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_failure_second bit second counter) + have hrest := ih counter + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, + zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst + hrest + | nil => + induction counter with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using + oneStep _ _ flatAdjacentRecord_failure_finish + | cons bit counter ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_failure_counter bit counter) + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, + List.length_cons, zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst + ih + +private def flatAdjacentRecord_firstPrefixTrace + (count : ℕ) (tail first second counter : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (List.replicate count true ++ false :: tail) + first second counter) + (some (flatAdjacentRecordConfiguration 1 tail + (false :: (List.replicate count true ++ first)) + second (List.replicate count true ++ counter))) + (count + 1) := by + induction count generalizing first counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (flatAdjacentRecord_firstPrefix_false tail first second counter) + | succ count ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_firstPrefix_true + (List.replicate count true ++ false :: tail) + first second counter) + have hrest := ih (true :: first) (true :: counter) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_missingFirstPrefixTrace + (count : ℕ) (first second counter : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (List.replicate count true) first second counter) + (some (flatAdjacentRecordConfiguration 6 [] + (List.replicate count true ++ first) second + (List.replicate count true ++ counter))) + (count + 1) := by + induction count generalizing first counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (flatAdjacentRecord_firstPrefix_missing first second counter) + | succ count ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_firstPrefix_true + (List.replicate count true) first second counter) + have hrest := ih (true :: first) (true :: counter) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_firstPayloadTrace + (payload tail first second : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 1 + (payload ++ tail) first second + (List.replicate payload.length true)) + (some (flatAdjacentRecordConfiguration 2 tail + (payload.reverse ++ first) second [])) + (payload.length + 1) := by + induction payload generalizing first with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil, + zero_add] using oneStep _ _ (flatAdjacentRecord_firstPayload_finish tail first second) + | cons bit payload ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_firstPayload_step bit + (payload ++ tail) first second + (List.replicate payload.length true)) + have hrest := ih (bit :: first) + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd] + using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_shortFirstPayloadTrace + (payload : List Bool) (extra : ℕ) + (first second : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 1 + payload first second + (List.replicate (payload.length + extra + 1) true)) + (some (flatAdjacentRecordConfiguration 6 [] + (payload.reverse ++ first) second + (List.replicate (extra + 1) true))) + (payload.length + 1) := by + induction payload generalizing first with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add, List.replicate_succ, + List.reverse_nil, + List.nil_append] using + oneStep _ _ (flatAdjacentRecord_firstPayload_missing first second (List.replicate extra + true)) + | cons bit payload ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_firstPayload_step + bit payload first second + (List.replicate (payload.length + extra + 1) true)) + have hrest := ih (bit :: first) + have hcount : + payload.length + 1 + extra + 1 = + (payload.length + extra + 1) + 1 := by + omega + simpa only [FinTM2.step, Fin.isValue, List.length_cons, hcount, List.replicate_succ, + List.reverse_cons, + List.append_assoc, List.cons_append, List.nil_append] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_secondPrefixTrace + (count : ℕ) (tail first second counter : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 2 + (List.replicate count true ++ false :: tail) + first second counter) + (some (flatAdjacentRecordConfiguration 3 tail first + (false :: (List.replicate count true ++ second)) + (List.replicate count true ++ counter))) + (count + 1) := by + induction count generalizing second counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (flatAdjacentRecord_secondPrefix_false tail first second counter) + | succ count ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_secondPrefix_true + (List.replicate count true ++ false :: tail) + first second counter) + have hrest := ih (true :: second) (true :: counter) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_missingSecondPrefixTrace + (count : ℕ) (first second counter : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 2 + (List.replicate count true) first second counter) + (some (flatAdjacentRecordConfiguration 6 [] + first (List.replicate count true ++ second) + (List.replicate count true ++ counter))) + (count + 1) := by + induction count generalizing second counter with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (flatAdjacentRecord_secondPrefix_missing first second counter) + | succ count ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_secondPrefix_true + (List.replicate count true) first second counter) + have hrest := ih (true :: second) (true :: counter) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_secondPayloadTrace + (payload tail first second : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 3 + (payload ++ tail) first second + (List.replicate payload.length true)) + (some (flatAdjacentRecordConfiguration 4 tail first + (payload.reverse ++ second) [])) + (payload.length + 1) := by + induction payload generalizing second with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, + List.reverse_nil, + zero_add] using oneStep _ _ (flatAdjacentRecord_secondPayload_finish tail first second) + | cons bit payload ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_secondPayload_step bit + (payload ++ tail) first second + (List.replicate payload.length true)) + have hrest := ih (bit :: second) + simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, + List.replicate_succ, + List.reverse_cons, List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd] + using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_shortSecondPayloadTrace + (payload : List Bool) (extra : ℕ) + (first second : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 3 + payload first second + (List.replicate (payload.length + extra + 1) true)) + (some (flatAdjacentRecordConfiguration 6 [] + first (payload.reverse ++ second) + (List.replicate (extra + 1) true))) + (payload.length + 1) := by + induction payload generalizing second with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add, List.replicate_succ, + List.reverse_nil, + List.nil_append] using + oneStep _ _ (flatAdjacentRecord_secondPayload_missing first second (List.replicate extra + true)) + | cons bit payload ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_secondPayload_step + bit payload first second + (List.replicate (payload.length + extra + 1) true)) + have hrest := ih (bit :: second) + have hcount : + payload.length + 1 + extra + 1 = + (payload.length + extra + 1) + 1 := by + omega + simpa only [FinTM2.step, Fin.isValue, List.length_cons, hcount, List.replicate_succ, + List.reverse_cons, + List.append_assoc, List.cons_append, List.nil_append] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_restoreFirstTrace + (input first second : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 4 input first second []) + (some (flatAdjacentRecordConfiguration 5 + (first.reverse ++ input) [] second [])) + (first.length + 1) := by + induction first generalizing input with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (flatAdjacentRecord_restoreFirst_finish input second) + | cons bit first ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_restoreFirst_step + bit input first second) + have hrest := ih (bit :: input) + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_restoreSecondTrace + (input second : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 5 input [] second []) + (some (Turing.haltList actualFlatAdjacentRecordSwapMachine + (second.reverse ++ input))) + (second.length + 1) := by + induction second generalizing input with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (flatAdjacentRecord_restoreSecond_finish input) + | cons bit second ih => + have hfirst := oneStep _ _ (flatAdjacentRecord_restoreSecond_step bit input second) + have hrest := ih (bit :: input) + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest + +private def flatAdjacentRecord_validTrace + (first second suffix : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix) [] [] []) + (some (Turing.haltList actualFlatAdjacentRecordSwapMachine + (lengthPrefixedWord second ++ + lengthPrefixedWord first ++ suffix))) + (4 * first.length + 4 * second.length + 8) := by + have hfirstPrefix := flatAdjacentRecord_firstPrefixTrace + first.length + (first ++ lengthPrefixedWord second ++ suffix) [] [] [] + have hfirstPayload := flatAdjacentRecord_firstPayloadTrace + first (lengthPrefixedWord second ++ suffix) + (false :: List.replicate first.length true) [] + have hsecondPrefix := flatAdjacentRecord_secondPrefixTrace + second.length (second ++ suffix) + (first.reverse ++ false :: List.replicate first.length true) + [] [] + have hsecondPayload := flatAdjacentRecord_secondPayloadTrace + second suffix + (first.reverse ++ false :: List.replicate first.length true) + (false :: List.replicate second.length true) + have hrestoreFirst := flatAdjacentRecord_restoreFirstTrace + suffix (first.reverse ++ false :: + List.replicate first.length true) + (second.reverse ++ false :: + List.replicate second.length true) + have hrestoreSecond := flatAdjacentRecord_restoreSecondTrace + ((first.reverse ++ false :: + List.replicate first.length true).reverse ++ suffix) + (second.reverse ++ false :: + List.replicate second.length true) + simp only [lengthPrefixedWord, List.append_nil, List.append_assoc] + at hfirstPrefix hfirstPayload hsecondPrefix hsecondPayload + have h01 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ hfirstPrefix hfirstPayload + have h012 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ h01 hsecondPrefix + have h0123 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ h012 hsecondPayload + have h01234 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ h0123 hrestoreFirst + have hfull := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ h01234 hrestoreSecond + have hbounded := rebound (newBudget := 4 * first.length + 4 * second.length + 8) + hfull (by + simp only [List.length_append, List.length_reverse, + List.length_cons, List.length_replicate] + omega) + simpa only [FinTM2.step, Fin.isValue, lengthPrefixedWord, List.append_assoc, List.cons_append, + List.reverse_append, List.reverse_cons, List.reverse_replicate, List.reverse_reverse, + List.nil_append] using + hbounded + +/-- GapCVP reduction support. -/ +def flatAdjacentRecordSwapTimePolynomial : Polynomial ℕ := + 16 * Polynomial.X + 32 + +private def flatAdjacentRecord_missingFirstTotalTrace + (count : ℕ) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (List.replicate count true) [] [] []) + (some (Turing.haltList actualFlatAdjacentRecordSwapMachine [])) + (flatAdjacentRecordSwapTimePolynomial.eval + (List.replicate count true).length) := by + have hscan := flatAdjacentRecord_missingFirstPrefixTrace + count [] [] [] + simp only [List.append_nil] at hscan + have hclean := flatAdjacentRecord_failureTrace [] + (List.replicate count true) [] + (List.replicate count true) + have hfull := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ hscan hclean + exact rebound hfull (by + simp only [List.length_nil, List.length_replicate, zero_add, add_zero, + flatAdjacentRecordSwapTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X] + omega) + +private def flatAdjacentRecord_shortFirstTotalTrace + (payload : List Bool) (extra : ℕ) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) [] [] []) + (some (Turing.haltList actualFlatAdjacentRecordSwapMachine [])) + (flatAdjacentRecordSwapTimePolynomial.eval + (List.replicate (payload.length + extra + 1) true ++ + false :: payload).length) := by + have hprefix := flatAdjacentRecord_firstPrefixTrace + (payload.length + extra + 1) payload [] [] [] + have hshort := flatAdjacentRecord_shortFirstPayloadTrace + payload extra + (false :: List.replicate (payload.length + extra + 1) true) + [] + simp only [List.append_nil] at hprefix + have hscan := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ hprefix hshort + have hclean := flatAdjacentRecord_failureTrace [] + (payload.reverse ++ false :: + List.replicate (payload.length + extra + 1) true) + [] (List.replicate (extra + 1) true) + have hfull := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ hscan hclean + exact rebound hfull (by + simp only [List.length_nil, List.length_append, List.length_reverse, List.length_cons, + List.length_replicate, + zero_add, add_zero, flatAdjacentRecordSwapTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + omega) + +private def flatAdjacentRecord_missingSecondTotalTrace + (first : List Bool) (count : ℕ) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (lengthPrefixedWord first ++ + List.replicate count true) [] [] []) + (some (Turing.haltList actualFlatAdjacentRecordSwapMachine [])) + (flatAdjacentRecordSwapTimePolynomial.eval + (lengthPrefixedWord first ++ + List.replicate count true).length) := by + have hfirstPrefix := flatAdjacentRecord_firstPrefixTrace + first.length (first ++ List.replicate count true) [] [] [] + have hfirstPayload := flatAdjacentRecord_firstPayloadTrace + first (List.replicate count true) + (false :: List.replicate first.length true) [] + have hsecond := flatAdjacentRecord_missingSecondPrefixTrace + count (first.reverse ++ false :: + List.replicate first.length true) [] [] + simp only [List.append_nil] + at hfirstPrefix hfirstPayload hsecond + have h01 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ hfirstPrefix hfirstPayload + have hscan := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ h01 hsecond + have hclean := flatAdjacentRecord_failureTrace [] + (first.reverse ++ false :: List.replicate first.length true) + (List.replicate count true) + (List.replicate count true) + have hfull := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ hscan hclean + have hbounded := rebound (newBudget := flatAdjacentRecordSwapTimePolynomial.eval + (lengthPrefixedWord first ++ + List.replicate count true).length) + hfull (by + simp only [List.length_nil, List.length_append, List.length_reverse, List.length_cons, + List.length_replicate, + zero_add, lengthPrefixedWord_length, flatAdjacentRecordSwapTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + omega) + simpa only [FinTM2.step, Fin.isValue, lengthPrefixedWord, List.append_assoc, List.cons_append, + List.length_append, List.length_replicate, List.length_cons] using hbounded + +private def flatAdjacentRecord_shortSecondTotalTrace + (first payload : List Bool) (extra : ℕ) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 + (lengthPrefixedWord first ++ + (List.replicate (payload.length + extra + 1) true ++ + false :: payload)) [] [] []) + (some (Turing.haltList actualFlatAdjacentRecordSwapMachine [])) + (flatAdjacentRecordSwapTimePolynomial.eval + (lengthPrefixedWord first ++ + (List.replicate (payload.length + extra + 1) true ++ + false :: payload)).length) := by + have hfirstPrefix := flatAdjacentRecord_firstPrefixTrace + first.length + (first ++ (List.replicate (payload.length + extra + 1) true ++ + false :: payload)) [] [] [] + have hfirstPayload := flatAdjacentRecord_firstPayloadTrace + first + (List.replicate (payload.length + extra + 1) true ++ + false :: payload) + (false :: List.replicate first.length true) [] + have hsecondPrefix := flatAdjacentRecord_secondPrefixTrace + (payload.length + extra + 1) payload + (first.reverse ++ false :: List.replicate first.length true) + [] [] + have hsecondShort := flatAdjacentRecord_shortSecondPayloadTrace + payload extra + (first.reverse ++ false :: List.replicate first.length true) + (false :: List.replicate (payload.length + extra + 1) true) + simp only [List.append_nil] + at hfirstPrefix hfirstPayload hsecondPrefix + have h01 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ hfirstPrefix hfirstPayload + have h012 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ h01 hsecondPrefix + have hscan := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ h012 hsecondShort + have hclean := flatAdjacentRecord_failureTrace [] + (first.reverse ++ false :: List.replicate first.length true) + (payload.reverse ++ false :: + List.replicate (payload.length + extra + 1) true) + (List.replicate (extra + 1) true) + have hfull := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step + _ _ _ _ _ hscan hclean + have hbounded := rebound (newBudget := flatAdjacentRecordSwapTimePolynomial.eval + (lengthPrefixedWord first ++ + (List.replicate (payload.length + extra + 1) true ++ + false :: payload)).length) + hfull (by + simp only [List.length_nil, List.length_append, List.length_reverse, List.length_cons, + List.length_replicate, + zero_add, lengthPrefixedWord_length, flatAdjacentRecordSwapTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + omega) + simpa only [FinTM2.step, Fin.isValue, lengthPrefixedWord, List.append_assoc, List.cons_append, + List.length_append, List.length_replicate, List.length_cons] using hbounded + +/-- GapCVP reduction support. -/ +noncomputable def flatAdjacentRecordTotalTrace + (input : List Bool) : + EvalsToInTime actualFlatAdjacentRecordSwapMachine.step + (flatAdjacentRecordConfiguration 0 input [] [] []) + (some (Turing.haltList actualFlatAdjacentRecordSwapMachine + (flatAdjacentRecordSwapOutput input))) + (flatAdjacentRecordSwapTimePolynomial.eval input.length) := by + cases unaryInputSplit input with + | inl missing => + obtain ⟨count, hshape⟩ := missing + subst input + have hphysical := flatAdjacentRecord_missingFirstTotalTrace count + simpa only [FinTM2.step, Fin.isValue, flatAdjacentRecordSwapOutput, + flatAdjacent_readLengthPrefixedWord_missing, List.length_replicate] using hphysical + | inr firstInput => + obtain ⟨count, tail, hshape⟩ := firstInput + subst input + by_cases hfirst : count ≤ tail.length + · have hreconstruct := validInput_reconstruct count tail hfirst + cases unaryInputSplit (tail.drop count) with + | inl missingSecond => + obtain ⟨secondCount, hsecondShape⟩ := missingSecond + have hinput : + List.replicate count true ++ false :: tail = + lengthPrefixedWord (tail.take count) ++ + List.replicate secondCount true := by + rw [hreconstruct, hsecondShape] + rw [hinput] + have hphysical := flatAdjacentRecord_missingSecondTotalTrace + (tail.take count) secondCount + simpa only [FinTM2.step, Fin.isValue, flatAdjacentRecordSwapOutput, + readLengthPrefixedWord_append, + flatAdjacent_readLengthPrefixedWord_missing, List.length_append, + lengthPrefixedWord_length, List.length_take, + List.length_replicate] using hphysical + | inr secondInput => + obtain ⟨secondCount, secondTail, hsecondShape⟩ := secondInput + by_cases hsecond : secondCount ≤ secondTail.length + · have hsecondReconstruct := + validInput_reconstruct secondCount secondTail hsecond + have hinput : + List.replicate count true ++ false :: tail = + lengthPrefixedWord (tail.take count) ++ + lengthPrefixedWord + (secondTail.take secondCount) ++ + secondTail.drop secondCount := by + rw [hreconstruct, hsecondShape, + hsecondReconstruct, List.append_assoc] + rw [hinput] + have hphysical := flatAdjacentRecord_validTrace + (tail.take count) + (secondTail.take secondCount) + (secondTail.drop secondCount) + have hbounded := rebound (newBudget := flatAdjacentRecordSwapTimePolynomial.eval + (lengthPrefixedWord (tail.take count) ++ + lengthPrefixedWord + (secondTail.take secondCount) ++ + secondTail.drop secondCount).length) + hphysical (by + simp only [List.length_take, List.append_assoc, List.length_append, + lengthPrefixedWord_length, + List.length_drop, flatAdjacentRecordSwapTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, Nat.reduceLeDiff] + omega) + simpa only [FinTM2.step, Fin.isValue, List.append_assoc, + flatAdjacentRecordSwapOutput, + readLengthPrefixedWord_append, List.length_append, lengthPrefixedWord_length, + List.length_take, + List.length_drop] using hbounded + · have hshort : secondTail.length < secondCount := + Nat.lt_of_not_ge hsecond + let extra := secondCount - secondTail.length - 1 + have hcount : + secondCount = secondTail.length + extra + 1 := by + dsimp [extra] + omega + have hinput : + List.replicate count true ++ false :: tail = + lengthPrefixedWord (tail.take count) ++ + (List.replicate + (secondTail.length + extra + 1) true ++ + false :: secondTail) := by + rw [hreconstruct, hsecondShape, hcount] + rw [hinput] + have hphysical := flatAdjacentRecord_shortSecondTotalTrace + (tail.take count) secondTail extra + simpa only [FinTM2.step, Fin.isValue, flatAdjacentRecordSwapOutput, + readLengthPrefixedWord_append, + flatAdjacent_readLengthPrefixedWord_short, List.length_append, + lengthPrefixedWord_length, List.length_take, + List.length_replicate, List.length_cons] using hphysical + · have hshort : tail.length < count := + Nat.lt_of_not_ge hfirst + let extra := count - tail.length - 1 + have hcount : count = tail.length + extra + 1 := by + dsimp [extra] + omega + rw [hcount] + have hphysical := flatAdjacentRecord_shortFirstTotalTrace + tail extra + simpa only [FinTM2.step, Fin.isValue, flatAdjacentRecordSwapOutput, + flatAdjacent_readLengthPrefixedWord_short, + List.length_append, List.length_replicate, List.length_cons] using hphysical + +/-- GapCVP reduction support. -/ +noncomputable abbrev flatAdjacentRecordSwapComputable : + BitTM + flatAdjacentRecordSwapOutput where + tm := actualFlatAdjacentRecordSwapMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := flatAdjacentRecordSwapTimePolynomial + outputsFun input := { + steps := (flatAdjacentRecordTotalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, + actualFlatAdjacentRecordSwapMachine_init, + Option.map_some] using (flatAdjacentRecordTotalTrace input).evals_in_steps + steps_le_m := by + change (flatAdjacentRecordTotalTrace input).steps ≤ + flatAdjacentRecordSwapTimePolynomial.eval input.length + exact (flatAdjacentRecordTotalTrace input).steps_le_m + } + +private def flatFieldSeparatorDropOutput (input : List Bool) : List Bool := + (flatAdjacentRecordSwapOutput input).tail + +private noncomputable def flatFieldSeparatorDropComputable : + BitTM + flatFieldSeparatorDropOutput := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + flatAdjacentRecordSwapComputable dropHeadComputable + change BitTM + (fun input => (flatAdjacentRecordSwapOutput input).tail) + simpa only [Function.comp_def] using hphysical + +@[simp] private theorem flatFieldSeparatorDropOutput_valid + (payload original : List Bool) : + flatFieldSeparatorDropOutput + (lengthPrefixedWord payload ++ false :: original) = + lengthPrefixedWord payload ++ original := by + change + (flatAdjacentRecordSwapOutput + (lengthPrefixedWord payload ++ false :: original)).tail = + lengthPrefixedWord payload ++ original + have hswap := flatAdjacentRecordSwapOutput_records + payload [] original + simpa only [lengthPrefixedWord, List.append_assoc, List.cons_append, List.length_nil, + List.replicate_zero, + List.nil_append, List.tail_cons] using congrArg List.tail hswap + +end CNFFlatAdjacentRecordSwapTotalCert + +namespace CNFFlatPhysicalBinaryAppendTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CLStructuralPrefixWriter GapCVP.SourceOriginalSourcePreservingTM +open GapCVP.SourceWholeOutputValidBranchRecordTM GapCVP.CNFFlatAdjacentRecordSwapTotalCert + +/-- GapCVP reduction support. -/ +def flatPhysicalPrependComputedRecordOutput + (worker : List Bool → List Bool) + (input : List Bool) : List Bool := + flatFieldSeparatorDropOutput + (originalSourcePreservingOutput + (fun source => lengthPrefixedWord (worker source)) input) + +/-- GapCVP reduction support. -/ +noncomputable def flatPhysicalPrependComputedRecordComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (flatPhysicalPrependComputedRecordOutput worker) := by + have hrecord := GapCVP.TMComposition.computableInPolyTime + computer structuralPrefixWriterComputable + have hpreserved := originalSourcePreservingComputable hrecord + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved flatFieldSeparatorDropComputable + change BitTM + (fun input : List Bool => flatFieldSeparatorDropOutput + (originalSourcePreservingOutput + (fun source => lengthPrefixedWord (worker source)) input)) + simpa only [Function.comp_def] using hphysical + +@[simp] theorem flatPhysicalPrependComputedRecordOutput_eq + (worker : List Bool → List Bool) (input : List Bool) : + flatPhysicalPrependComputedRecordOutput worker input = + lengthPrefixedWord (worker input) ++ input := by + unfold flatPhysicalPrependComputedRecordOutput + originalSourcePreservingOutput + exact flatFieldSeparatorDropOutput_valid (worker input) input + +private def flatPhysicalFirstFieldWorker + (worker : List Bool → List Bool) + (input : List Bool) : List Bool := + worker (firstFieldContents input) + +private noncomputable def flatPhysicalFirstFieldWorkerComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (flatPhysicalFirstFieldWorker worker) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable computer + change BitTM + (fun input : List Bool => worker (firstFieldContents input)) + simpa only [Function.comp_def] using hphysical + +private def flatPhysicalSecondFieldWorker + (worker : List Bool → List Bool) + (input : List Bool) : List Bool := + worker (firstFieldContents (firstFieldSuffix input)) + +private noncomputable def flatPhysicalSecondFieldWorkerComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (flatPhysicalSecondFieldWorker worker) := by + have hcontents := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hcontents computer + change BitTM + (fun input : List Bool => + worker (firstFieldContents (firstFieldSuffix input))) + simpa only [Function.comp_def] using hphysical + +private def flatPhysicalBinaryAppendOutput + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldSuffix + (sourceFlatAtomicRecordStep + (sourceFlatAtomicRecordStep + (flatPhysicalPrependComputedRecordOutput + (flatPhysicalSecondFieldWorker first) + (flatPhysicalPrependComputedRecordOutput + (flatPhysicalFirstFieldWorker second) + (lengthPrefixedWord input))))) + +private noncomputable def flatPhysicalBinaryAppendComputable + {first second : List Bool → List Bool} + (firstComputer : BitTM first) + (secondComputer : BitTM second) : + BitTM + (flatPhysicalBinaryAppendOutput first second) := by + have hsecond := flatPhysicalPrependComputedRecordComputable + (flatPhysicalFirstFieldWorkerComputable secondComputer) + have hfirst := flatPhysicalPrependComputedRecordComputable + (flatPhysicalSecondFieldWorkerComputable firstComputer) + have hprefix := GapCVP.TMComposition.computableInPolyTime + structuralPrefixWriterComputable hsecond + have hboth := GapCVP.TMComposition.computableInPolyTime + hprefix hfirst + have hrotateFirst := GapCVP.TMComposition.computableInPolyTime + hboth sourceFlatAtomicRecordComputable + have hrotateSecond := GapCVP.TMComposition.computableInPolyTime + hrotateFirst sourceFlatAtomicRecordComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hrotateSecond firstFieldSuffixComputable + change BitTM + (fun input : List Bool => + firstFieldSuffix + (sourceFlatAtomicRecordStep + (sourceFlatAtomicRecordStep + (flatPhysicalPrependComputedRecordOutput + (flatPhysicalSecondFieldWorker first) + (flatPhysicalPrependComputedRecordOutput + (flatPhysicalFirstFieldWorker second) + (lengthPrefixedWord input)))))) + simpa only [flatPhysicalPrependComputedRecordOutput_eq, Function.comp_def] using hphysical + +@[simp] private theorem flatPhysicalBinaryAppendOutput_eq + (first second : List Bool → List Bool) + (input : List Bool) : + flatPhysicalBinaryAppendOutput first second input = + first input ++ second input := by + have hcontents : firstFieldContents (lengthPrefixedWord input) = + input := by + simpa only [List.append_nil] using firstFieldContents_valid input [] + unfold flatPhysicalBinaryAppendOutput + simp only [sourceFlatAtomicRecordStep, flatPhysicalPrependComputedRecordOutput_eq, + flatPhysicalFirstFieldWorker, hcontents, flatPhysicalSecondFieldWorker, + firstFieldSuffix_valid, + readLengthPrefixedWord_append, List.append_assoc] + +/-- GapCVP reduction support. -/ +noncomputable def pointwiseAppendComputable + {first second : List Bool → List Bool} + (firstComputer : BitTM first) + (secondComputer : BitTM second) : + BitTM + (fun input => first input ++ second input) := by + have hphysical := flatPhysicalBinaryAppendComputable + firstComputer secondComputer + have heq : + flatPhysicalBinaryAppendOutput first second = + (fun input => first input ++ second input) := by + funext input + exact flatPhysicalBinaryAppendOutput_eq first second input + rwa [heq] at hphysical + +end CNFFlatPhysicalBinaryAppendTM + +namespace CNFCappedUnaryMinimumTM + +open Turing GapCVP.BinaryEncoding GapCVP.CNFUnaryPairIndexTM + +/-- GapCVP reduction support. -/ +def cappedUnaryMinimumOutput (input : List Bool) : List Bool := + match readUnaryPrefix input with + | none => [] + | some (first, remaining) => + match readUnaryPrefix remaining with + | none => [] + | some (second, _) => + List.replicate (min first second) true + +@[simp] theorem cappedUnaryMinimumOutput_pair + (first second : ℕ) (suffix : List Bool) : + cappedUnaryMinimumOutput + (unarySourcePairWord first second ++ suffix) = + List.replicate (min first second) true := by + simp only [cappedUnaryMinimumOutput, unarySourcePairWord, List.append_assoc, List.cons_append, + List.nil_append, readUnaryPrefix_replicate] + +private def cappedUnaryMinimumPeek (stack : Fin 3) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .peek stack (fun _ inspected => inspected) + (.branch (fun inspected => inspected.isSome) present absent) + +private def cappedUnaryMinimumPop (stack : Fin 3) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .pop stack (fun inspected _ => inspected) continuation + +private def cappedUnaryMinimumPush (stack : Fin 3) (bit : Bool) + (continuation : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .push stack (fun _ => bit) continuation + +private def cappedUnaryMinimumGoto (phase : Fin 4) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def cappedUnaryMinimumFirstStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + cappedUnaryMinimumPeek 0 + (.branch (fun inspected => inspected.getD false) + (cappedUnaryMinimumPop 0 + (cappedUnaryMinimumPush 1 true + (cappedUnaryMinimumGoto 0))) + (cappedUnaryMinimumPop 0 + (cappedUnaryMinimumGoto 1))) + (cappedUnaryMinimumGoto 3) + +/-- Internal support shared across GapCVP continuation modules. -/ +def cappedUnaryMinimumSecondStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + cappedUnaryMinimumPeek 0 + (.branch (fun inspected => inspected.getD false) + (cappedUnaryMinimumPeek 1 + (cappedUnaryMinimumPop 0 + (cappedUnaryMinimumPop 1 + (cappedUnaryMinimumPush 2 true + (cappedUnaryMinimumGoto 1)))) + (cappedUnaryMinimumPop 0 + (cappedUnaryMinimumGoto 1))) + (cappedUnaryMinimumPop 0 + (cappedUnaryMinimumGoto 2))) + (cappedUnaryMinimumGoto 3) + +/-- Internal support shared across GapCVP continuation modules. -/ +def cappedUnaryMinimumSuccessStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + cappedUnaryMinimumPeek 0 + (cappedUnaryMinimumPop 0 (cappedUnaryMinimumGoto 2)) + (cappedUnaryMinimumPeek 1 + (cappedUnaryMinimumPop 1 (cappedUnaryMinimumGoto 2)) + .halt) + +/-- Internal support shared across GapCVP continuation modules. -/ +def cappedUnaryMinimumFailureStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + cappedUnaryMinimumPeek 0 + (cappedUnaryMinimumPop 0 (cappedUnaryMinimumGoto 3)) + (cappedUnaryMinimumPeek 1 + (cappedUnaryMinimumPop 1 (cappedUnaryMinimumGoto 3)) + (cappedUnaryMinimumPeek 2 + (cappedUnaryMinimumPop 2 (cappedUnaryMinimumGoto 3)) + .halt)) + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev actualCappedUnaryMinimumMachine : Turing.FinTM2 where + K := Fin 3 + k₀ := 0 + k₁ := 2 + Γ _ := Bool + Λ := Fin 4 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 4) then + cappedUnaryMinimumFirstStatement + else if phase = (1 : Fin 4) then + cappedUnaryMinimumSecondStatement + else if phase = (2 : Fin 4) then + cappedUnaryMinimumSuccessStatement + else + cappedUnaryMinimumFailureStatement + +/-- Internal support shared across GapCVP continuation modules. -/ +def cappedUnaryMinimumConfiguration + (phase : Fin 4) (input first output : List Bool) : + actualCappedUnaryMinimumMachine.Cfg where + l := some phase + var := none + stk := ![input, first, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem actualCappedUnaryMinimumMachine_init + (input : List Bool) : + Turing.initList actualCappedUnaryMinimumMachine input = + cappedUnaryMinimumConfiguration 0 input [] [] := by + simp only [actualCappedUnaryMinimumMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + cappedUnaryMinimumConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `cappedUnaryMinimumStepTac` machine-step simplifier. -/ +macro "cappedUnaryMinimumStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [actualCappedUnaryMinimumMachine, + cappedUnaryMinimumConfiguration, + cappedUnaryMinimumPeek, + cappedUnaryMinimumPop, + cappedUnaryMinimumPush, + cappedUnaryMinimumGoto, + cappedUnaryMinimumFirstStatement, + cappedUnaryMinimumSecondStatement, + cappedUnaryMinimumSuccessStatement, + cappedUnaryMinimumFailureStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_first_true + (input first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 0 + (true :: input) first output) = + some (cappedUnaryMinimumConfiguration 0 + input (true :: first) output) := by + cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_first_false + (input first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 0 + (false :: input) first output) = + some (cappedUnaryMinimumConfiguration 1 + input first output) := by + cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_first_missing + (first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 0 [] first output) = + some (cappedUnaryMinimumConfiguration 3 + [] first output) := by + cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_second_true_counter + (input first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 1 + (true :: input) (true :: first) output) = + some (cappedUnaryMinimumConfiguration 1 + input first (true :: output)) := by + cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_second_true_empty + (input output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 1 + (true :: input) [] output) = + some (cappedUnaryMinimumConfiguration 1 + input [] output) := by + cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_second_false + (input first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 1 + (false :: input) first output) = + some (cappedUnaryMinimumConfiguration 2 + input first output) := by + cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_second_missing + (first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 1 [] first output) = + some (cappedUnaryMinimumConfiguration 3 + [] first output) := by + cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_success_input + (bit : Bool) (input first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 2 + (bit :: input) first output) = + some (cappedUnaryMinimumConfiguration 2 + input first output) := by + cases bit <;> cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_success_first + (bit : Bool) (first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 2 + [] (bit :: first) output) = + some (cappedUnaryMinimumConfiguration 2 + [] first output) := by + cases bit <;> cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_success_finish + (output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 2 [] [] output) = + some (Turing.haltList actualCappedUnaryMinimumMachine + output) := by + cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_failure_input + (bit : Bool) (input first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 3 + (bit :: input) first output) = + some (cappedUnaryMinimumConfiguration 3 + input first output) := by + cases bit <;> cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_failure_first + (bit : Bool) (first output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 3 + [] (bit :: first) output) = + some (cappedUnaryMinimumConfiguration 3 + [] first output) := by + cases bit <;> cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_failure_output + (bit : Bool) (output : List Bool) : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 3 + [] [] (bit :: output)) = + some (cappedUnaryMinimumConfiguration 3 + [] [] output) := by + cases bit <;> cappedUnaryMinimumStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem cappedUnaryMinimum_failure_finish : + actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 3 [] [] []) = + some (Turing.haltList actualCappedUnaryMinimumMachine + []) := by + cappedUnaryMinimumStepTac + +end CNFCappedUnaryMinimumTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part05F.lean b/LeanPool/GapCVP/Part05F.lean new file mode 100644 index 000000000..3876afa72 --- /dev/null +++ b/LeanPool/GapCVP/Part05F.lean @@ -0,0 +1,943 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part05E + +/-! # GapCVP proof, part 05, continuation 06 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFCappedUnaryMinimumTM + +open Turing GapCVP.BinaryEncoding GapCVP.CNFUnaryPairIndexTM + +end CNFCappedUnaryMinimumTM + +namespace CNFCappedUnaryMinimumTotalCert + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.CNFUnaryPairIndexTM GapCVP.CNFCappedUnaryMinimumTM + +private def cappedUnaryMinimum_successTrace + (input first output : List Bool) : + EvalsToInTime actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 2 input first output) + (some (Turing.haltList actualCappedUnaryMinimumMachine + output)) + (input.length + first.length + 1) := by + induction input generalizing first with + | cons bit input ih => + have hfirst := oneStep _ _ (cappedUnaryMinimum_success_input bit input first output) + have hrest := ih first + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ + hfirst hrest + | nil => + induction first with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using + oneStep _ _ (cappedUnaryMinimum_success_finish output) + | cons bit first ih => + have hfirst := oneStep _ _ (cappedUnaryMinimum_success_first bit first output) + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using EvalsToInTime.trans + actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst ih + +private def cappedUnaryMinimum_failureTrace + (input first output : List Bool) : + EvalsToInTime actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 3 input first output) + (some (Turing.haltList actualCappedUnaryMinimumMachine [])) + (input.length + first.length + output.length + 1) := by + induction input generalizing first output with + | cons bit input ih => + have hfirst := oneStep _ _ (cappedUnaryMinimum_failure_input bit input first output) + have hrest := ih first output + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, + Nat.reduceAdd, + Nat.add_assoc] using EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ + hfirst hrest + | nil => + induction first generalizing output with + | cons bit first ih => + have hfirst := oneStep _ _ (cappedUnaryMinimum_failure_first bit first output) + have hrest := ih output + simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, + Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using + EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst hrest + | nil => + induction output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using + oneStep _ _ cappedUnaryMinimum_failure_finish + | cons bit output ih => + have hfirst := oneStep _ _ (cappedUnaryMinimum_failure_output bit output) + simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, + zero_add, Nat.add_comm, + Nat.add_left_comm, Nat.reduceAdd] using EvalsToInTime.trans + actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst ih + +private def cappedUnaryMinimum_firstTrace + (count : ℕ) (tail first output : List Bool) : + EvalsToInTime actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 0 + (List.replicate count true ++ false :: tail) + first output) + (some (cappedUnaryMinimumConfiguration 1 tail + (List.replicate count true ++ first) output)) + (count + 1) := by + induction count generalizing first with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (cappedUnaryMinimum_first_false tail first output) + | succ count ih => + have hfirst := oneStep _ _ (cappedUnaryMinimum_first_true + (List.replicate count true ++ false :: tail) + first output) + have hrest := ih (true :: first) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst hrest + +private def cappedUnaryMinimum_missingFirstTrace + (count : ℕ) (first output : List Bool) : + EvalsToInTime actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 0 + (List.replicate count true) first output) + (some (cappedUnaryMinimumConfiguration 3 [] + (List.replicate count true ++ first) output)) + (count + 1) := by + induction count generalizing first with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (cappedUnaryMinimum_first_missing first output) + | succ count ih => + have hfirst := oneStep _ _ (cappedUnaryMinimum_first_true + (List.replicate count true) first output) + have hrest := ih (true :: first) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst hrest + +private def cappedUnaryMinimum_secondTrace + (first second : ℕ) (suffix output : List Bool) : + EvalsToInTime actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 1 + (List.replicate second true ++ false :: suffix) + (List.replicate first true) output) + (some (cappedUnaryMinimumConfiguration 2 suffix + (List.replicate (first - second) true) + (List.replicate (min first second) true ++ output))) + (second + 1) := by + induction second generalizing first output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, tsub_zero, + zero_le, + inf_of_le_right, zero_add] using + oneStep _ _ (cappedUnaryMinimum_second_false suffix (List.replicate first true) output) + | succ second ih => + cases first with + | zero => + have hfirst := oneStep _ _ (cappedUnaryMinimum_second_true_empty + (List.replicate second true ++ false :: suffix) + output) + have hrest := ih 0 output + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, + List.replicate_zero, zero_tsub, + le_add_iff_nonneg_left, zero_le, inf_of_le_left, List.nil_append, Nat.add_assoc, + Nat.reduceAdd] using + EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst hrest + | succ first => + have hfirst := oneStep _ _ (cappedUnaryMinimum_second_true_counter + (List.replicate second true ++ false :: suffix) + (List.replicate first true) output) + have hrest := ih first (true :: output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, + Nat.succ_sub_succ, + Nat.succ_min_succ, Nat.succ_eq_add_one, Nat.add_assoc, Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst hrest + +private def cappedUnaryMinimum_missingSecondTrace + (first second : ℕ) (output : List Bool) : + EvalsToInTime actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 1 + (List.replicate second true) + (List.replicate first true) output) + (some (cappedUnaryMinimumConfiguration 3 [] + (List.replicate (first - second) true) + (List.replicate (min first second) true ++ output))) + (second + 1) := by + induction second generalizing first output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, tsub_zero, zero_le, + inf_of_le_right, + List.nil_append, zero_add] using oneStep _ _ (cappedUnaryMinimum_second_missing + (List.replicate first true) output) + | succ second ih => + cases first with + | zero => + have hfirst := oneStep _ _ (cappedUnaryMinimum_second_true_empty + (List.replicate second true) output) + have hrest := ih 0 output + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.replicate_zero, + zero_tsub, + le_add_iff_nonneg_left, zero_le, inf_of_le_left, List.nil_append, Nat.add_assoc, + Nat.reduceAdd] using + EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst hrest + | succ first => + have hfirst := oneStep _ _ (cappedUnaryMinimum_second_true_counter + (List.replicate second true) + (List.replicate first true) output) + have hrest := ih first (true :: output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.succ_sub_succ, + Nat.succ_min_succ, + Nat.succ_eq_add_one, List.cons_append, Nat.add_assoc, Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst hrest + +private def cappedUnaryMinimum_validTrace + (first second : ℕ) (suffix : List Bool) : + EvalsToInTime actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 0 + (unarySourcePairWord first second ++ suffix) [] []) + (some (Turing.haltList actualCappedUnaryMinimumMachine + (List.replicate (min first second) true))) + (first + second + suffix.length + + (first - second) + 3) := by + have hfirst := cappedUnaryMinimum_firstTrace first + (List.replicate second true ++ false :: suffix) [] [] + simp only [List.append_nil] at hfirst + have hsecond := cappedUnaryMinimum_secondTrace + first second suffix [] + simp only [List.append_nil] at hsecond + have hscan := EvalsToInTime.trans actualCappedUnaryMinimumMachine.step + _ _ _ _ _ hfirst hsecond + have hclean := cappedUnaryMinimum_successTrace + suffix (List.replicate (first - second) true) + (List.replicate (min first second) true) + have hfull := EvalsToInTime.trans actualCappedUnaryMinimumMachine.step + _ _ _ _ _ hscan hclean + have hbudget := rebound (newBudget := first + second + suffix.length + + (first - second) + 3) hfull (by + simp only [List.length_replicate] + omega) + simpa only [FinTM2.step, Fin.isValue, unarySourcePairWord, List.append_assoc, List.cons_append, + List.nil_append] using hbudget + +private def cappedUnaryMinimumTimePolynomial : Polynomial ℕ := + 8 * Polynomial.X + 16 + +private def cappedUnaryMinimum_totalTrace (input : List Bool) : + EvalsToInTime actualCappedUnaryMinimumMachine.step + (cappedUnaryMinimumConfiguration 0 input [] []) + (some (Turing.haltList actualCappedUnaryMinimumMachine + (cappedUnaryMinimumOutput input))) + (cappedUnaryMinimumTimePolynomial.eval input.length) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨first, hinput⟩ := witness + subst input + have hfirst := cappedUnaryMinimum_missingFirstTrace + first [] [] + simp only [List.append_nil] at hfirst + have hclean := cappedUnaryMinimum_failureTrace + [] (List.replicate first true) [] + have hfull := EvalsToInTime.trans actualCappedUnaryMinimumMachine.step + _ _ _ _ _ hfirst hclean + have hbounded := rebound (newBudget := cappedUnaryMinimumTimePolynomial.eval + (List.replicate first true).length) hfull (by + simp only [List.length_nil, List.length_replicate, zero_add, add_zero, + cappedUnaryMinimumTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X] + at * + omega) + simpa only [FinTM2.step, Fin.isValue, cappedUnaryMinimumOutput, readUnaryPrefix_missing, + List.length_replicate] using hbounded + | inr witness => + obtain ⟨first, tail, hinput⟩ := witness + subst input + cases unaryInputSplit tail with + | inl missing => + obtain ⟨second, htail⟩ := missing + subst tail + have hfirst := cappedUnaryMinimum_firstTrace + first (List.replicate second true) [] [] + simp only [List.append_nil] at hfirst + have hsecond := cappedUnaryMinimum_missingSecondTrace + first second [] + simp only [List.append_nil] at hsecond + have hscan := EvalsToInTime.trans actualCappedUnaryMinimumMachine.step + _ _ _ _ _ hfirst hsecond + have hclean := cappedUnaryMinimum_failureTrace + [] (List.replicate (first - second) true) + (List.replicate (min first second) true) + have hfull := EvalsToInTime.trans actualCappedUnaryMinimumMachine.step + _ _ _ _ _ hscan hclean + have hbounded := rebound (newBudget := cappedUnaryMinimumTimePolynomial.eval + (List.replicate first true ++ + false :: List.replicate second true).length) + hfull (by + simp only [List.length_nil, List.length_replicate, zero_add, Nat.sub_add_min_cancel, + List.length_append, + List.length_cons, cappedUnaryMinimumTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X] at * + have hmin : min first second ≤ first := + Nat.min_le_left first second + omega) + simpa only [FinTM2.step, Fin.isValue, cappedUnaryMinimumOutput, + readUnaryPrefix_replicate, + readUnaryPrefix_missing, List.length_append, List.length_replicate, List.length_cons] + using hbounded + | inr present => + obtain ⟨second, suffix, htail⟩ := present + subst tail + have hvalid := cappedUnaryMinimum_validTrace + first second suffix + have hbounded := rebound (newBudget := cappedUnaryMinimumTimePolynomial.eval + (List.replicate first true ++ false :: + (List.replicate second true ++ false :: suffix)).length) + hvalid (by + simp only [List.length_append, List.length_replicate, List.length_cons, + cappedUnaryMinimumTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X, Nat.reduceLeDiff] at * + omega) + simpa only [FinTM2.step, Fin.isValue, cappedUnaryMinimumOutput, + readUnaryPrefix_replicate, List.length_append, + List.length_replicate, List.length_cons, unarySourcePairWord, List.append_assoc, + List.cons_append, + List.nil_append] using hbounded + +/-- GapCVP reduction support. -/ +noncomputable def actualCappedUnaryMinimumComputable : + BitTM + cappedUnaryMinimumOutput where + tm := actualCappedUnaryMinimumMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := cappedUnaryMinimumTimePolynomial + outputsFun input := { + steps := (cappedUnaryMinimum_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, + actualCappedUnaryMinimumMachine_init, Option.map_some] using + (cappedUnaryMinimum_totalTrace input).evals_in_steps + steps_le_m := by + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq] using + (cappedUnaryMinimum_totalTrace input).steps_le_m + } + +end CNFCappedUnaryMinimumTotalCert + +namespace CNFCappedUnaryPairArithmeticTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.SourceMachineCert GapCVP.SourceOriginalSourcePreservingTM GapCVP.CNFUnaryPairIndexTM +open GapCVP.CNFUnaryPairIndexTotalRuntimeCert GapCVP.CNFSourcePairPrefixWorkerTM +open GapCVP.CNFSourcePairPrefixWorkerTotalCert GapCVP.CNFCappedUnaryMinimumTM +open GapCVP.CNFCappedUnaryMinimumTotalCert + +/-- GapCVP reduction support. -/ +def unaryPrefixSuffixOutput (input : List Bool) : List Bool := + match readUnaryPrefix input with + | none => [] + | some (_, suffix) => suffix + +@[simp] theorem unaryPrefixSuffixOutput_valid + (count : ℕ) (suffix : List Bool) : + unaryPrefixSuffixOutput + (List.replicate count true ++ false :: suffix) = suffix := by + simp only [unaryPrefixSuffixOutput, readUnaryPrefix_replicate] + +private abbrev actualUnaryPrefixSuffixMachine : Turing.FinTM2 where + K := Unit + k₀ := () + k₁ := () + Γ _ := Bool + Λ := Unit + main := () + σ := Option Bool + initialState := none + m _ := + .peek () (fun _ inspected => inspected) + (.branch (fun inspected => inspected.isSome) + (.branch (fun inspected => inspected.getD false) + (.pop () (fun _ _ => none) + (.goto (fun _ => ()))) + (.pop () (fun _ _ => none) .halt)) + .halt) + +private def unaryPrefixSuffixConfiguration (input : List Bool) : + actualUnaryPrefixSuffixMachine.Cfg where + l := some () + var := none + stk := fun _ => input + +private theorem actualUnaryPrefixSuffixMachine_init + (input : List Bool) : + Turing.initList actualUnaryPrefixSuffixMachine input = + unaryPrefixSuffixConfiguration input := by + simp only [actualUnaryPrefixSuffixMachine, initList, ↓reduceDIte, eq_mpr_eq_cast, cast_eq, + unaryPrefixSuffixConfiguration] + rfl + +private theorem unaryPrefixSuffix_true_step (input : List Bool) : + actualUnaryPrefixSuffixMachine.step + (unaryPrefixSuffixConfiguration (true :: input)) = + some (unaryPrefixSuffixConfiguration input) := by + compactMachineStepTac [actualUnaryPrefixSuffixMachine, unaryPrefixSuffixConfiguration] + +private theorem unaryPrefixSuffix_false_step (input : List Bool) : + actualUnaryPrefixSuffixMachine.step + (unaryPrefixSuffixConfiguration (false :: input)) = + some (Turing.haltList actualUnaryPrefixSuffixMachine input) := by + compactMachineStepTac [actualUnaryPrefixSuffixMachine, unaryPrefixSuffixConfiguration] + +private theorem unaryPrefixSuffix_missing_step : + actualUnaryPrefixSuffixMachine.step + (unaryPrefixSuffixConfiguration []) = + some (Turing.haltList actualUnaryPrefixSuffixMachine []) := by + compactMachineStepTac [actualUnaryPrefixSuffixMachine, unaryPrefixSuffixConfiguration] + +private def unaryPrefixSuffix_validTrace + (count : ℕ) (suffix : List Bool) : + EvalsToInTime actualUnaryPrefixSuffixMachine.step + (unaryPrefixSuffixConfiguration + (List.replicate count true ++ false :: suffix)) + (some (Turing.haltList actualUnaryPrefixSuffixMachine suffix)) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (unaryPrefixSuffix_false_step suffix) + | succ count ih => + have hfirst := oneStep _ _ (unaryPrefixSuffix_true_step + (List.replicate count true ++ false :: suffix)) + simpa only [FinTM2.step, List.replicate_succ, List.cons_append, Nat.add_assoc, Nat.reduceAdd] + using + EvalsToInTime.trans actualUnaryPrefixSuffixMachine.step _ _ _ _ _ hfirst ih + +private def unaryPrefixSuffix_missingTrace + (count : ℕ) : + EvalsToInTime actualUnaryPrefixSuffixMachine.step + (unaryPrefixSuffixConfiguration + (List.replicate count true)) + (some (Turing.haltList actualUnaryPrefixSuffixMachine [])) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, List.replicate_zero, zero_add] using oneStep _ _ + unaryPrefixSuffix_missing_step + | succ count ih => + have hfirst := oneStep _ _ (unaryPrefixSuffix_true_step + (List.replicate count true)) + simpa only [FinTM2.step, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans actualUnaryPrefixSuffixMachine.step _ _ _ _ _ hfirst ih + +private def unaryPrefixSuffix_totalTrace (input : List Bool) : + EvalsToInTime actualUnaryPrefixSuffixMachine.step + (unaryPrefixSuffixConfiguration input) + (some (Turing.haltList actualUnaryPrefixSuffixMachine + (unaryPrefixSuffixOutput input))) + ((Polynomial.X + 1 : Polynomial ℕ).eval input.length) := by + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + have htrace := unaryPrefixSuffix_missingTrace count + simpa only [FinTM2.step, unaryPrefixSuffixOutput, readUnaryPrefix_missing, + List.length_replicate, + Polynomial.eval_add, Polynomial.eval_X, Polynomial.eval_one] using htrace + | inr witness => + obtain ⟨count, suffix, hinput⟩ := witness + subst input + have htrace := unaryPrefixSuffix_validTrace count suffix + refine { + steps := htrace.steps + evals_in_steps := ?_ + steps_le_m := ?_ + } + · simpa only [Option.bind_eq_bind, FinTM2.step, unaryPrefixSuffixOutput, + readUnaryPrefix_replicate] using + htrace.evals_in_steps + · have hsteps := htrace.steps_le_m + simp only [FinTM2.step, List.length_append, List.length_replicate, List.length_cons, + Polynomial.eval_add, + Polynomial.eval_X, Polynomial.eval_one, ge_iff_le] + omega + +/-- GapCVP reduction support. -/ +noncomputable def actualUnaryPrefixSuffixComputable : + BitTM + unaryPrefixSuffixOutput where + tm := actualUnaryPrefixSuffixMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := Polynomial.X + 1 + outputsFun input := { + steps := (unaryPrefixSuffix_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Equiv.invFun_as_coe, Equiv.refl_symm, + Equiv.coe_refl, + bitEncoding, id_eq, List.map_id_fun, actualUnaryPrefixSuffixMachine_init, + Option.map_some] using + (unaryPrefixSuffix_totalTrace input).evals_in_steps + steps_le_m := by + simpa only [FinTM2.step, bitEncoding, id_eq, Polynomial.eval_add, Polynomial.eval_X, + Polynomial.eval_one] using (unaryPrefixSuffix_totalTrace input).steps_le_m + } + +private def unaryCappedTailPairWord (input : List Bool) : List Bool := + unarySourcePairOutput + (sourcePairPrefixOutput (unaryPrefixSuffixOutput input)) + +private noncomputable def actualUnaryCappedTailPairComputable : + BitTM + unaryCappedTailPairWord := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + actualUnaryPrefixSuffixComputable + actualSourcePairPrefixComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hprefix actualUnaryPairIndexComputable + change BitTM + (fun input : List Bool => + unarySourcePairOutput + (sourcePairPrefixOutput (unaryPrefixSuffixOutput input))) + simpa only [Function.comp_def] using hphysical + +private def unaryCappedSuccessorPairWord (input : List Bool) : List Bool := + true :: unaryCappedTailPairWord input + +private noncomputable def actualUnaryCappedSuccessorPairComputable : + BitTM + unaryCappedSuccessorPairWord := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + actualUnaryCappedTailPairComputable + (prependBitComputable true) + change BitTM + (fun input : List Bool => true :: unaryCappedTailPairWord input) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def cappedUnarySourcePairRecurrenceWord + (input : List Bool) : List Bool := + cappedUnaryMinimumOutput + (originalSourcePreservingOutput + unaryCappedSuccessorPairWord input) + +private noncomputable def actualCappedUnarySourcePairRecurrenceComputable : + BitTM + cappedUnarySourcePairRecurrenceWord := by + have hpreserved := originalSourcePreservingComputable + actualUnaryCappedSuccessorPairComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved actualCappedUnaryMinimumComputable + change BitTM + (fun input : List Bool => + cappedUnaryMinimumOutput + (originalSourcePreservingOutput + unaryCappedSuccessorPairWord input)) + simpa only [Function.comp_def] using hphysical + +@[simp] theorem cappedUnarySourcePairRecurrenceWord_valid + (cap head tail : ℕ) (suffix : List Bool) : + cappedUnarySourcePairRecurrenceWord + (List.replicate cap true ++ false :: + (unarySourcePairWord head tail ++ suffix)) = + List.replicate + (min cap (Nat.succ (Nat.pair head tail))) true := by + let source := List.replicate cap true ++ false :: + (unarySourcePairWord head tail ++ suffix) + have hpair : + unaryCappedTailPairWord source = + List.replicate (Nat.pair head tail) true := by + simp only [unaryCappedTailPairWord, unaryPrefixSuffixOutput_valid, sourcePairPrefixOutput_pair, + unarySourcePairOutput_word, source] + change + cappedUnaryMinimumOutput + (unaryCappedSuccessorPairWord source ++ false :: source) = _ + simp only [unaryCappedSuccessorPairWord, hpair] + rw [show true :: List.replicate (Nat.pair head tail) true = + List.replicate (Nat.succ (Nat.pair head tail)) true by + simp only [Nat.succ_eq_add_one, List.replicate_succ]] + simp only [cappedUnaryMinimumOutput, Nat.succ_eq_add_one, readUnaryPrefix_replicate, + Nat.min_comm, source] + +end CNFCappedUnaryPairArithmeticTM + +namespace CNFCappedFlatSourceListFoldTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert +open GapCVP.SourceUniformTuringTM GapCVP.CNFUnaryPairIndexTM GapCVP.CNFSourcePairPrefixWorkerTM +open GapCVP.CNFSourcePairPrefixWorkerTotalCert GapCVP.CNFCappedUnaryMinimumTM +open GapCVP.CNFCappedUnaryMinimumTotalCert GapCVP.CNFCappedUnaryPairArithmeticTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +def flatUnaryDropFields (count : ℕ) (input : List Bool) : List Bool := + (unaryPrefixSuffixOutput^[count]) input + +/-- GapCVP reduction support. -/ +noncomputable def flatUnaryDropFieldsComputable : + (count : ℕ) → + BitTM + (flatUnaryDropFields count) + | 0 => by + have hidentity := prependWordComputable [] + change BitTM + (fun input : List Bool => + (unaryPrefixSuffixOutput^[0]) input) + simpa only [Function.iterate_zero, id_eq, List.nil_append] using hidentity + | count + 1 => by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (flatUnaryDropFieldsComputable count) + actualUnaryPrefixSuffixComputable + change BitTM + (fun input : List Bool => + (unaryPrefixSuffixOutput^[count + 1]) input) + simpa only [Function.iterate_succ_apply', Function.comp_def, flatUnaryDropFields] + using hphysical + +/-- GapCVP reduction support. -/ +def flatDuplicatedUnaryValueWord (input : List Bool) : List Bool := + cappedUnaryMinimumOutput input + +/-- GapCVP reduction support. -/ +noncomputable def flatDuplicatedUnaryValueComputable : + BitTM + flatDuplicatedUnaryValueWord := + actualCappedUnaryMinimumComputable + +/-- GapCVP reduction support. -/ +def flatDuplicatedUnaryFieldWord (input : List Bool) : List Bool := + flatDuplicatedUnaryValueWord input ++ [false] + +private noncomputable def flatDuplicatedUnaryFieldComputable : + BitTM + flatDuplicatedUnaryFieldWord := by + have hphysical := pointwiseAppendComputable + flatDuplicatedUnaryValueComputable + (constantWordComputable [false]) + exact hphysical + +/-- GapCVP reduction support. -/ +def flatDuplicatedUnaryFieldAt + (offset : ℕ) (input : List Bool) : List Bool := + flatDuplicatedUnaryFieldWord (flatUnaryDropFields offset input) + +private noncomputable def flatDuplicatedUnaryFieldAtComputable + (offset : ℕ) : + BitTM + (flatDuplicatedUnaryFieldAt offset) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (flatUnaryDropFieldsComputable offset) + flatDuplicatedUnaryFieldComputable + change BitTM + (fun input : List Bool => + flatDuplicatedUnaryFieldWord (flatUnaryDropFields offset input)) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def flatCappedUnarySourceListQuery + (input : List Bool) : List Bool := + flatDuplicatedUnaryFieldAt 0 input ++ + flatDuplicatedUnaryFieldAt 2 input ++ + flatDuplicatedUnaryFieldAt 4 input + +private noncomputable def flatCappedUnarySourceListQueryComputable : + BitTM + flatCappedUnarySourceListQuery := by + have htail := pointwiseAppendComputable + (flatDuplicatedUnaryFieldAtComputable 2) + (flatDuplicatedUnaryFieldAtComputable 4) + have hphysical := pointwiseAppendComputable + (flatDuplicatedUnaryFieldAtComputable 0) htail + have heq : + (fun input : List Bool => + flatDuplicatedUnaryFieldAt 0 input ++ + (flatDuplicatedUnaryFieldAt 2 input ++ + flatDuplicatedUnaryFieldAt 4 input)) = + flatCappedUnarySourceListQuery := by + funext input + simp only [flatCappedUnarySourceListQuery, List.append_assoc] + rw [← heq] + exact hphysical + +/-- GapCVP reduction support. -/ +def flatCappedUnarySourceListNextField + (input : List Bool) : List Bool := + cappedUnarySourcePairRecurrenceWord + (flatCappedUnarySourceListQuery input) ++ [false] + +private noncomputable def flatCappedUnarySourceListNextFieldComputable : + BitTM + flatCappedUnarySourceListNextField := by + have hrecurrence := GapCVP.TMComposition.computableInPolyTime + flatCappedUnarySourceListQueryComputable + actualCappedUnarySourcePairRecurrenceComputable + have hphysical := pointwiseAppendComputable hrecurrence + (constantWordComputable [false]) + change BitTM + (fun input : List Bool => + cappedUnarySourcePairRecurrenceWord + (flatCappedUnarySourceListQuery input) ++ [false]) + simpa only [Function.comp_apply] using hphysical + +/-- GapCVP reduction support. -/ +def flatCappedUnaryPendingPair + (input : List Bool) : List Bool := + sourcePairPrefixOutput (flatUnaryDropFields 6 input) + +private noncomputable def flatCappedUnaryPendingPairComputable : + BitTM + flatCappedUnaryPendingPair := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (flatUnaryDropFieldsComputable 6) + actualSourcePairPrefixComputable + change BitTM + (fun input : List Bool => + sourcePairPrefixOutput (flatUnaryDropFields 6 input)) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def flatCappedUnaryPendingRemainder + (input : List Bool) : List Bool := + flatUnaryDropFields 2 (flatUnaryDropFields 6 input) + +private noncomputable def flatCappedUnaryPendingRemainderComputable : + BitTM + flatCappedUnaryPendingRemainder := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (flatUnaryDropFieldsComputable 6) + (flatUnaryDropFieldsComputable 2) + change BitTM + (fun input : List Bool => + flatUnaryDropFields 2 (flatUnaryDropFields 6 input)) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def flatCappedUnarySourceListStep + (input : List Bool) : List Bool := + flatDuplicatedUnaryFieldAt 0 input ++ + flatDuplicatedUnaryFieldAt 0 input ++ + flatCappedUnaryPendingPair input ++ + flatCappedUnarySourceListNextField input ++ + flatCappedUnarySourceListNextField input ++ + flatCappedUnaryPendingRemainder input + +/-- GapCVP reduction support. -/ +noncomputable def flatCappedUnarySourceListStepComputable : + BitTM + flatCappedUnarySourceListStep := by + have hlast := pointwiseAppendComputable + flatCappedUnarySourceListNextFieldComputable + flatCappedUnaryPendingRemainderComputable + have hsecond := pointwiseAppendComputable + flatCappedUnarySourceListNextFieldComputable hlast + have hpending := pointwiseAppendComputable + flatCappedUnaryPendingPairComputable hsecond + have hcapSecond := pointwiseAppendComputable + (flatDuplicatedUnaryFieldAtComputable 0) hpending + have hphysical := pointwiseAppendComputable + (flatDuplicatedUnaryFieldAtComputable 0) hcapSecond + have heq : + (fun input : List Bool => + flatDuplicatedUnaryFieldAt 0 input ++ + (flatDuplicatedUnaryFieldAt 0 input ++ + (flatCappedUnaryPendingPair input ++ + (flatCappedUnarySourceListNextField input ++ + (flatCappedUnarySourceListNextField input ++ + flatCappedUnaryPendingRemainder input))))) = + flatCappedUnarySourceListStep := by + funext input + simp only [flatCappedUnarySourceListStep, List.append_assoc] + rw [← heq] + exact hphysical + +/-- GapCVP reduction support. -/ +def flatDuplicatedUnaryField (value : ℕ) : List Bool := + unarySourcePairWord value value + +/-- GapCVP reduction support. -/ +def flatDuplicatedUnarySourceStream + (records : List ℕ) : List Bool := + records.flatMap flatDuplicatedUnaryField + +/-- GapCVP reduction support. -/ +def flatCappedUnarySourceListState + (cap accumulator : ℕ) : List ℕ → List Bool + | [] => + flatDuplicatedUnaryField cap ++ + flatDuplicatedUnaryField accumulator + | head :: remaining => + flatDuplicatedUnaryField cap ++ + flatDuplicatedUnaryField head ++ + flatDuplicatedUnaryField accumulator ++ + flatDuplicatedUnarySourceStream remaining + +@[simp] theorem flatUnaryDropFields_two_unaryPair + (first second : ℕ) (suffix : List Bool) : + flatUnaryDropFields 2 + (unarySourcePairWord first second ++ suffix) = suffix := by + simp [flatUnaryDropFields, Function.iterate_succ_apply', + unarySourcePairWord, unaryPrefixSuffixOutput_valid, + List.append_assoc] + +theorem flatUnaryDropFields_four_unaryPairs + (first second third fourth : ℕ) (suffix : List Bool) : + flatUnaryDropFields 4 + (unarySourcePairWord first second ++ + unarySourcePairWord third fourth ++ suffix) = suffix := by + simp [flatUnaryDropFields, Function.iterate_succ_apply', + unarySourcePairWord, unaryPrefixSuffixOutput_valid, + List.append_assoc] + +theorem flatUnaryDropFields_six_unaryPairs + (first second third fourth fifth sixth : ℕ) + (suffix : List Bool) : + flatUnaryDropFields 6 + (unarySourcePairWord first second ++ + unarySourcePairWord third fourth ++ + unarySourcePairWord fifth sixth ++ suffix) = suffix := by + simp [flatUnaryDropFields, Function.iterate_succ_apply', + unarySourcePairWord, unaryPrefixSuffixOutput_valid, + List.append_assoc] + +@[simp] private theorem flatDuplicatedUnaryFieldWord_pair + (value : ℕ) (suffix : List Bool) : + flatDuplicatedUnaryFieldWord + (flatDuplicatedUnaryField value ++ suffix) = + List.replicate value true ++ [false] := by + simp only [flatDuplicatedUnaryFieldWord, flatDuplicatedUnaryValueWord, flatDuplicatedUnaryField, + cappedUnaryMinimumOutput_pair, min_self] + +@[simp] private theorem sourcePairPrefixOutput_flatDuplicatedUnaryStream_cons + (head : ℕ) (remaining : List ℕ) : + sourcePairPrefixOutput + (flatDuplicatedUnarySourceStream (head :: remaining)) = + flatDuplicatedUnaryField head := by + simp only [flatDuplicatedUnarySourceStream, List.flatMap_cons, flatDuplicatedUnaryField, + sourcePairPrefixOutput_pair] + +@[simp] private theorem flatUnaryDropFields_flatDuplicatedUnaryStream_cons + (head : ℕ) (remaining : List ℕ) : + flatUnaryDropFields 2 + (flatDuplicatedUnarySourceStream (head :: remaining)) = + flatDuplicatedUnarySourceStream remaining := by + simp only [flatDuplicatedUnarySourceStream, List.flatMap_cons, flatDuplicatedUnaryField, + flatUnaryDropFields_two_unaryPair] + +@[simp] theorem flatCappedUnarySourceListStep_state + (cap head accumulator : ℕ) (remaining : List ℕ) : + flatCappedUnarySourceListStep + (flatCappedUnarySourceListState + cap accumulator (head :: remaining)) = + flatCappedUnarySourceListState + cap + (min cap (Nat.succ (Nat.pair head accumulator))) + remaining := by + let source := flatCappedUnarySourceListState + cap accumulator (head :: remaining) + have hcap : flatDuplicatedUnaryFieldAt 0 source = + List.replicate cap true ++ [false] := by + dsimp [source, flatCappedUnarySourceListState, + flatDuplicatedUnaryFieldAt, flatUnaryDropFields] + simpa [flatDuplicatedUnaryField, List.append_assoc] using + flatDuplicatedUnaryFieldWord_pair cap + (flatDuplicatedUnaryField head ++ + flatDuplicatedUnaryField accumulator ++ + flatDuplicatedUnarySourceStream remaining) + have hhead : flatDuplicatedUnaryFieldAt 2 source = + List.replicate head true ++ [false] := by + dsimp [source, flatCappedUnarySourceListState, + flatDuplicatedUnaryFieldAt] + simp only [flatDuplicatedUnaryField, List.append_assoc] + rw [flatUnaryDropFields_two_unaryPair] + simpa [flatDuplicatedUnaryField, List.append_assoc] using + flatDuplicatedUnaryFieldWord_pair head + (flatDuplicatedUnaryField accumulator ++ + flatDuplicatedUnarySourceStream remaining) + have haccumulator : flatDuplicatedUnaryFieldAt 4 source = + List.replicate accumulator true ++ [false] := by + dsimp [source, flatCappedUnarySourceListState, + flatDuplicatedUnaryFieldAt] + simp only [flatDuplicatedUnaryField, List.append_assoc] + have hdrop := flatUnaryDropFields_four_unaryPairs + cap cap head head + (unarySourcePairWord accumulator accumulator ++ + flatDuplicatedUnarySourceStream remaining) + simp only [List.append_assoc] at hdrop + rw [hdrop] + simpa [flatDuplicatedUnaryField] using + flatDuplicatedUnaryFieldWord_pair accumulator + (flatDuplicatedUnarySourceStream remaining) + have hpending : flatUnaryDropFields 6 source = + flatDuplicatedUnarySourceStream remaining := by + dsimp [source, flatCappedUnarySourceListState] + exact flatUnaryDropFields_six_unaryPairs + cap cap head head accumulator accumulator + (flatDuplicatedUnarySourceStream remaining) + have hquery : flatCappedUnarySourceListQuery source = + List.replicate cap true ++ false :: + unarySourcePairWord head accumulator := by + unfold flatCappedUnarySourceListQuery + rw [hcap, hhead, haccumulator] + simp [unarySourcePairWord, List.append_assoc] + have hnext : flatCappedUnarySourceListNextField source = + List.replicate + (min cap (Nat.succ (Nat.pair head accumulator))) true ++ + [false] := by + unfold flatCappedUnarySourceListNextField + rw [hquery] + simpa using congrArg + (fun output : List Bool => output ++ [false]) + (cappedUnarySourcePairRecurrenceWord_valid + cap head accumulator []) + change flatCappedUnarySourceListStep source = _ + unfold flatCappedUnarySourceListStep + flatCappedUnaryPendingPair flatCappedUnaryPendingRemainder + rw [hcap, hnext, hpending] + cases remaining with + | nil => + simp [flatCappedUnarySourceListState, + flatDuplicatedUnarySourceStream, + flatDuplicatedUnaryField, + sourcePairPrefixOutput, + readUnaryPrefix, + flatUnaryDropFields, + unarySourcePairWord, + unaryPrefixSuffixOutput, + List.append_assoc] + | cons next tail => + rw [sourcePairPrefixOutput_flatDuplicatedUnaryStream_cons, + flatUnaryDropFields_flatDuplicatedUnaryStream_cons] + simp [flatCappedUnarySourceListState, + flatDuplicatedUnaryField, + unarySourcePairWord, List.append_assoc] + +end CNFCappedFlatSourceListFoldTM + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part06.lean b/LeanPool/GapCVP/Part06.lean new file mode 100644 index 000000000..a32a7e524 --- /dev/null +++ b/LeanPool/GapCVP/Part06.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part06D + +/-! # GapCVP proof, part 06 -/ diff --git a/LeanPool/GapCVP/Part06A.lean b/LeanPool/GapCVP/Part06A.lean new file mode 100644 index 000000000..8fe0d7051 --- /dev/null +++ b/LeanPool/GapCVP/Part06A.lean @@ -0,0 +1,2466 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part05 + +/-! # GapCVP proof, part 06 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFCappedFlatSourceListFoldTotalCert + +open Computability Turing GapCVP.BinaryEncoding GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CNFTypedRecordWorkerTM GapCVP.CNFUnaryPairIndexTM GapCVP.CNFSourcePairPrefixWorkerTM +open GapCVP.CNFCappedUnaryMinimumTM GapCVP.CNFCappedUnaryPairArithmeticTM +open GapCVP.CNFFlatSourceOrder GapCVP.CNFCappedFlatSourceListFoldTM +open GapCVP.CNFGuardedSourceDescriptorRotationBoundedFoldTM + +private theorem flatCappedUnarySourceListStep_iterate + (cap accumulator : ℕ) (records : List ℕ) : + ((flatCappedUnarySourceListStep^[records.length]) + (flatCappedUnarySourceListState cap accumulator records)) = + flatCappedUnarySourceListState cap + (records.foldl + (fun value head => + min cap (Nat.succ (Nat.pair head value))) + accumulator) + [] := by + induction records generalizing accumulator with + | nil => + simp only [List.length_nil, Function.iterate_zero, id_eq, Nat.succ_eq_add_one, + List.foldl_nil] + | cons head remaining ih => + rw [List.length_cons, Function.iterate_succ_apply, + flatCappedUnarySourceListStep_state] + simpa only [Nat.succ_eq_add_one, List.foldl_cons] using ih (min cap (Nat.succ (Nat.pair head + accumulator))) + +private theorem flatCappedUnaryReverseFold_eq_source + (cap : ℕ) (records : List ℕ) : + records.reverse.foldl + (fun value head => + min cap (Nat.succ (Nat.pair head value))) 0 = + cappedFlatSourceListValue cap records := by + induction records with + | nil => + rfl + | cons head remaining ih => + simp only [Nat.succ_eq_add_one, List.reverse_cons, List.foldl_append, ih, List.foldl_cons, + List.foldl_nil, + cappedFlatSourceListValue] + +private theorem boundedRecordFoldOutput_flatCappedUnarySourceList + (cap : ℕ) (records : List ℕ) : + boundedRecordFoldOutput flatCappedUnarySourceListStep + (unaryBoundedFoldWord records.length + (flatCappedUnarySourceListState cap 0 records.reverse)) = + flatCappedUnarySourceListState cap + (cappedFlatSourceListValue cap records) [] := by + simp only [boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + have hphysical := flatCappedUnarySourceListStep_iterate + cap 0 records.reverse + rw [flatCappedUnaryReverseFold_eq_source cap records] at hphysical + simpa only [List.length_reverse] using hphysical + +private def flatCappedUnaryCurrentCap (input : List Bool) : ℕ := + (cappedUnaryMinimumOutput input).length + +private theorem cappedUnaryMinimumOutput_eq_replicate_length + (input : List Bool) : + cappedUnaryMinimumOutput input = + List.replicate (cappedUnaryMinimumOutput input).length true := by + cases hfirst : readUnaryPrefix input with + | none => + simp only [cappedUnaryMinimumOutput, hfirst, List.length_nil, List.replicate_zero] + | some firstParsed => + obtain ⟨first, remaining⟩ := firstParsed + cases hsecond : readUnaryPrefix remaining with + | none => + simp only [cappedUnaryMinimumOutput, hfirst, hsecond, List.length_nil, + List.replicate_zero] + | some secondParsed => + obtain ⟨second, suffix⟩ := secondParsed + simp only [cappedUnaryMinimumOutput, hfirst, hsecond, List.length_replicate] + +private theorem flatDuplicatedUnaryFieldAt_eq_replicate + (offset : ℕ) (input : List Bool) : + flatDuplicatedUnaryFieldAt offset input = + List.replicate + (cappedUnaryMinimumOutput + (flatUnaryDropFields offset input)).length true ++ + [false] := by + unfold flatDuplicatedUnaryFieldAt + flatDuplicatedUnaryFieldWord flatDuplicatedUnaryValueWord + exact congrArg + (fun output : List Bool => output ++ [false]) + (cappedUnaryMinimumOutput_eq_replicate_length + (flatUnaryDropFields offset input)) + +private theorem flatCappedUnarySourceListNextField_eq + (input : List Bool) : + flatCappedUnarySourceListNextField input = + List.replicate + (min (flatCappedUnaryCurrentCap input) + (Nat.succ (Nat.pair + (cappedUnaryMinimumOutput + (flatUnaryDropFields 2 input)).length + (cappedUnaryMinimumOutput + (flatUnaryDropFields 4 input)).length))) true ++ + [false] := by + unfold flatCappedUnarySourceListNextField + flatCappedUnarySourceListQuery + rw [flatDuplicatedUnaryFieldAt_eq_replicate, + flatDuplicatedUnaryFieldAt_eq_replicate, + flatDuplicatedUnaryFieldAt_eq_replicate] + have hquery : + (List.replicate + (cappedUnaryMinimumOutput + (flatUnaryDropFields 0 input)).length true ++ + [false]) ++ + (List.replicate + (cappedUnaryMinimumOutput + (flatUnaryDropFields 2 input)).length true ++ + [false]) ++ + (List.replicate + (cappedUnaryMinimumOutput + (flatUnaryDropFields 4 input)).length true ++ + [false]) = + List.replicate (flatCappedUnaryCurrentCap input) true ++ + false :: + (unarySourcePairWord + (cappedUnaryMinimumOutput + (flatUnaryDropFields 2 input)).length + (cappedUnaryMinimumOutput + (flatUnaryDropFields 4 input)).length ++ []) := by + simp only [flatUnaryDropFields, Function.iterate_zero, id_eq, Function.iterate_succ, + Function.comp_apply, + List.append_assoc, List.cons_append, List.nil_append, flatCappedUnaryCurrentCap, + unarySourcePairWord, List.append_nil] + rw [hquery] + rw [cappedUnarySourcePairRecurrenceWord_valid] + +private def flatCappedUnaryNextValue (input : List Bool) : ℕ := + min (flatCappedUnaryCurrentCap input) + (Nat.succ (Nat.pair + (cappedUnaryMinimumOutput + (flatUnaryDropFields 2 input)).length + (cappedUnaryMinimumOutput + (flatUnaryDropFields 4 input)).length)) + +private theorem flatCappedUnarySourceListStep_normalized + (input : List Bool) : + flatCappedUnarySourceListStep input = + unarySourcePairWord + (flatCappedUnaryCurrentCap input) + (flatCappedUnaryCurrentCap input) ++ + sourcePairPrefixOutput (flatUnaryDropFields 6 input) ++ + unarySourcePairWord + (flatCappedUnaryNextValue input) + (flatCappedUnaryNextValue input) ++ + flatUnaryDropFields 2 (flatUnaryDropFields 6 input) := by + unfold flatCappedUnarySourceListStep + flatCappedUnaryPendingPair flatCappedUnaryPendingRemainder + simp only [flatDuplicatedUnaryFieldAt_eq_replicate, + flatCappedUnarySourceListNextField_eq] + simp only [flatUnaryDropFields, Function.iterate_zero, id_eq, List.append_assoc, + List.cons_append, + List.nil_append, Function.iterate_succ, Function.comp_apply, flatCappedUnaryCurrentCap, + Nat.succ_eq_add_one, unarySourcePairWord, flatCappedUnaryNextValue] + +@[simp] private theorem flatCappedUnaryCurrentCap_step + (input : List Bool) : + flatCappedUnaryCurrentCap + (flatCappedUnarySourceListStep input) = + flatCappedUnaryCurrentCap input := by + rw [flatCappedUnarySourceListStep_normalized] + unfold flatCappedUnaryCurrentCap + simp only [List.append_assoc, cappedUnaryMinimumOutput_pair, min_self, List.length_replicate] + +private theorem flatUnaryPrefix_reconstruct + (input : List Bool) (count : ℕ) (suffix : List Bool) + (hread : readUnaryPrefix input = some (count, suffix)) : + input = List.replicate count true ++ false :: suffix := + guardedRotation_readUnaryPrefix_some_reconstruct + input count suffix hread + +private theorem unaryPrefixSuffixOutput_length_le + (input : List Bool) : + (unaryPrefixSuffixOutput input).length ≤ input.length := by + cases hread : readUnaryPrefix input with + | none => + simp only [unaryPrefixSuffixOutput, hread, List.length_nil, zero_le] + | some parsed => + obtain ⟨count, suffix⟩ := parsed + have hshape := flatUnaryPrefix_reconstruct + input count suffix hread + simp only [unaryPrefixSuffixOutput, hread] + rw [hshape] + simp only [List.length_append, List.length_replicate, List.length_cons, ge_iff_le] + omega + +theorem flatUnaryDropFields_length_le + (count : ℕ) (input : List Bool) : + (flatUnaryDropFields count input).length ≤ input.length := by + induction count with + | zero => + simp only [flatUnaryDropFields, Function.iterate_zero, id_eq, Std.le_refl] + | succ count ih => + unfold flatUnaryDropFields at ih ⊢ + rw [Function.iterate_succ_apply'] + exact (unaryPrefixSuffixOutput_length_le + ((unaryPrefixSuffixOutput^[count]) input)).trans ih + +private theorem cappedUnaryMinimumOutput_length_le + (input : List Bool) : + (cappedUnaryMinimumOutput input).length ≤ input.length := by + cases hfirst : readUnaryPrefix input with + | none => + simp only [cappedUnaryMinimumOutput, hfirst, List.length_nil, zero_le] + | some firstParsed => + obtain ⟨first, remaining⟩ := firstParsed + cases hsecond : readUnaryPrefix remaining with + | none => + simp only [cappedUnaryMinimumOutput, hfirst, hsecond, List.length_nil, zero_le] + | some secondParsed => + obtain ⟨second, suffix⟩ := secondParsed + have hfirstShape := flatUnaryPrefix_reconstruct + input first remaining hfirst + have hsecondShape := flatUnaryPrefix_reconstruct + remaining second suffix hsecond + simp only [cappedUnaryMinimumOutput, + hfirst, hsecond, List.length_replicate] + rw [hfirstShape, hsecondShape] + simp only [List.length_append, + List.length_replicate, List.length_cons] + omega + +theorem sourcePairPrefixOutput_drop_length_le + (pending : List Bool) : + (sourcePairPrefixOutput pending).length + + (flatUnaryDropFields 2 pending).length ≤ pending.length := by + cases hfirst : readUnaryPrefix pending with + | none => + simp [sourcePairPrefixOutput, hfirst, + flatUnaryDropFields, Function.iterate_succ_apply', + unaryPrefixSuffixOutput, readUnaryPrefix] + | some firstParsed => + obtain ⟨first, remaining⟩ := firstParsed + cases hsecond : readUnaryPrefix remaining with + | none => + simp [sourcePairPrefixOutput, hfirst, hsecond, + flatUnaryDropFields, Function.iterate_succ_apply', + unaryPrefixSuffixOutput] + | some secondParsed => + obtain ⟨second, suffix⟩ := secondParsed + have hfirstShape := flatUnaryPrefix_reconstruct + pending first remaining hfirst + have hsecondShape := flatUnaryPrefix_reconstruct + remaining second suffix hsecond + have hshape : + pending = unarySourcePairWord first second ++ suffix := by + rw [hfirstShape, hsecondShape] + simp [unarySourcePairWord, List.append_assoc] + rw [hshape] + simp [sourcePairPrefixOutput_pair, + flatUnaryDropFields_two_unaryPair, + List.length_append] + +private theorem flatCappedUnarySourceListStep_length_le_cap_pending + (input : List Bool) : + (flatCappedUnarySourceListStep input).length ≤ + 4 * flatCappedUnaryCurrentCap input + + (flatUnaryDropFields 6 input).length + 4 := by + rw [flatCappedUnarySourceListStep_normalized] + have hpending := sourcePairPrefixOutput_drop_length_le + (flatUnaryDropFields 6 input) + have hnext : flatCappedUnaryNextValue input ≤ + flatCappedUnaryCurrentCap input := + Nat.min_le_left _ _ + simp only [List.length_append, unarySourcePairWord, + List.length_replicate, List.length_cons, List.length_nil] + omega + +private theorem flatCappedUnarySourceListStep_pending + (input : List Bool) : + flatUnaryDropFields 6 + (flatCappedUnarySourceListStep input) = + flatUnaryDropFields 2 (flatUnaryDropFields 6 input) := by + rw [flatCappedUnarySourceListStep_normalized] + generalize hpending : flatUnaryDropFields 6 input = pending + generalize hcap : flatCappedUnaryCurrentCap input = cap + generalize hnext : flatCappedUnaryNextValue input = next + cases hfirst : readUnaryPrefix pending with + | none => + have hdrop : flatUnaryDropFields 2 pending = [] := by + simp [flatUnaryDropFields, + Function.iterate_succ_apply', + unaryPrefixSuffixOutput, hfirst, readUnaryPrefix] + have hprefix : sourcePairPrefixOutput pending = [] := by + simp [sourcePairPrefixOutput, hfirst] + rw [hdrop, hprefix] + simp [flatUnaryDropFields, + Function.iterate_succ_apply', + unarySourcePairWord, + unaryPrefixSuffixOutput, + readUnaryPrefix, List.append_assoc] + | some firstParsed => + obtain ⟨first, remaining⟩ := firstParsed + cases hsecond : readUnaryPrefix remaining with + | none => + have hdrop : flatUnaryDropFields 2 pending = [] := by + simp [flatUnaryDropFields, + Function.iterate_succ_apply', + unaryPrefixSuffixOutput, hfirst, hsecond] + have hprefix : sourcePairPrefixOutput pending = [] := by + simp [sourcePairPrefixOutput, hfirst, hsecond] + rw [hdrop, hprefix] + simp [flatUnaryDropFields, + Function.iterate_succ_apply', + unarySourcePairWord, + unaryPrefixSuffixOutput, + readUnaryPrefix, List.append_assoc] + | some secondParsed => + obtain ⟨second, suffix⟩ := secondParsed + have hfirstShape := flatUnaryPrefix_reconstruct + pending first remaining hfirst + have hsecondShape := flatUnaryPrefix_reconstruct + remaining second suffix hsecond + have hshape : + pending = unarySourcePairWord first second ++ suffix := by + rw [hfirstShape, hsecondShape] + simp [unarySourcePairWord, List.append_assoc] + rw [hshape] + simp only [sourcePairPrefixOutput_pair, + flatUnaryDropFields_two_unaryPair] + simpa [List.append_assoc] using + flatUnaryDropFields_six_unaryPairs + cap cap first second next next suffix + +private theorem flatCappedUnaryCurrentCap_iterate + (input : List Bool) (stage : ℕ) : + flatCappedUnaryCurrentCap + ((flatCappedUnarySourceListStep^[stage]) input) = + flatCappedUnaryCurrentCap input := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq] + | succ stage ih => + rw [Function.iterate_succ_apply', + flatCappedUnaryCurrentCap_step, ih] + +private theorem flatCappedUnaryPending_iterate_length_le + (input : List Bool) (stage : ℕ) : + (flatUnaryDropFields 6 + ((flatCappedUnarySourceListStep^[stage]) input)).length ≤ + (flatUnaryDropFields 6 input).length := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply', + flatCappedUnarySourceListStep_pending] + exact (flatUnaryDropFields_length_le 2 + (flatUnaryDropFields 6 + ((flatCappedUnarySourceListStep^[stage]) input))).trans ih + +private theorem flatCappedUnarySourceListStep_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + flatCappedUnarySourceListStep + (5 * Polynomial.X + 4) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage _ + have hseed := parsedUnaryFold_seed_length_le + input count seed hparse + cases stage with + | zero => + simp only [Function.iterate_zero, id_eq, Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, + Polynomial.eval_X, ge_iff_le] + omega + | succ stage => + rw [Function.iterate_succ_apply'] + have hstep := flatCappedUnarySourceListStep_length_le_cap_pending + ((flatCappedUnarySourceListStep^[stage]) seed) + rw [flatCappedUnaryCurrentCap_iterate] at hstep + have hpending := flatCappedUnaryPending_iterate_length_le + seed stage + have htail := flatUnaryDropFields_length_le 6 seed + have hcap := cappedUnaryMinimumOutput_length_le seed + unfold flatCappedUnaryCurrentCap at hstep + simp only [Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X, ge_iff_le] + omega + +private noncomputable def actualCappedFlatSourceListFoldComputable : + BitTM + (boundedRecordFoldOutput flatCappedUnarySourceListStep) := + boundedDependentRecordFoldComputable + flatCappedUnarySourceListStepComputable + (5 * Polynomial.X + 4) + flatCappedUnarySourceListStep_polynomiallyBoundedFoldStates + +end CNFCappedFlatSourceListFoldTotalCert + +namespace CNFFiveFamilyFlatCandidateGenerationTM + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLNondeterminism +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLCellRowBounds GapCVP.BinaryEncoding +open GapCVP.ThreeCNFReduction GapCVP.SourceMachineCert GapCVP.SourceUniformTuringTM +open GapCVP.CLStructuralCNFVariableBounds GapCVP.CLStructuralWholeCNFOutputTM +open GapCVP.CNFFlatSourceOrder GapCVP.CNFFlatSourceOrderPolynomialBounds +open GapCVP.CNFFlatStructuralRecordWorkerTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFUnaryPairIndexTM GapCVP.CNFUnaryPairIndexTotalRuntimeCert +open GapCVP.CNFCappedFlatSourceListFoldTM + +private def unarySignedLiteralCodePairInput (sign : Bool) + (input : List Bool) : List Bool := + input ++ [false] ++ + List.replicate (Encodable.encode sign) true ++ [false] + +private noncomputable def unarySignedLiteralCodePairInputComputable + (sign : Bool) : + BitTM + (unarySignedLiteralCodePairInput sign) := by + have hidentity := prependWordComputable [] + have hsuffix := constantWordComputable + ([false] ++ List.replicate (Encodable.encode sign) true ++ [false]) + have hphysical := pointwiseAppendComputable hidentity hsuffix + change BitTM + (fun input : List Bool => + input ++ [false] ++ + List.replicate (Encodable.encode sign) true ++ [false]) + simpa only [List.append_assoc, List.cons_append, List.nil_append] using hphysical + +private def unarySignedLiteralCodeWord (sign : Bool) + (input : List Bool) : List Bool := + unarySourcePairOutput (unarySignedLiteralCodePairInput sign input) + +private noncomputable def unarySignedLiteralCodeComputable (sign : Bool) : + BitTM + (unarySignedLiteralCodeWord sign) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (unarySignedLiteralCodePairInputComputable sign) + actualUnaryPairIndexComputable + change BitTM + (fun input : List Bool => + unarySourcePairOutput (unarySignedLiteralCodePairInput sign input)) + simpa only [Function.comp_def] using hphysical + +@[simp] private theorem unarySignedLiteralCodeWord_sourceVariable + {T S : ℕ} (atom : Variable T S) (sign : Bool) : + unarySignedLiteralCodeWord sign + (List.replicate (Encodable.encode atom) true) = + List.replicate + (Encodable.encode ((atom, sign) : SignedLiteral T S)) true := by + unfold unarySignedLiteralCodeWord unarySignedLiteralCodePairInput + have hinput : + List.replicate (Encodable.encode atom) true ++ [false] ++ + List.replicate (Encodable.encode sign) true ++ [false] = + unarySourcePairWord + (Encodable.encode atom) (Encodable.encode sign) := by + simp only [List.append_assoc, List.cons_append, List.nil_append, unarySourcePairWord] + rw [hinput, unarySourcePairOutput_word] + rfl + +private def duplicateUnarySourceCodeWord (input : List Bool) : List Bool := + input ++ [false] ++ input ++ [false] + +private noncomputable def duplicateUnarySourceCodeComputable : + BitTM + duplicateUnarySourceCodeWord := by + have hidentity := prependWordComputable [] + have hone := pointwiseAppendComputable + hidentity (constantWordComputable [false]) + have hphysical := pointwiseAppendComputable hone hone + change BitTM + (fun input : List Bool => input ++ [false] ++ input ++ [false]) + simpa only [List.append_assoc, List.cons_append, List.nil_append] using hphysical + +/-- GapCVP reduction support. -/ +def duplicatedUnarySignedLiteralCodeWord (sign : Bool) + (input : List Bool) : List Bool := + duplicateUnarySourceCodeWord (unarySignedLiteralCodeWord sign input) + +/-- GapCVP reduction support. -/ +noncomputable def duplicatedUnarySignedLiteralCodeComputable + (sign : Bool) : + BitTM + (duplicatedUnarySignedLiteralCodeWord sign) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (unarySignedLiteralCodeComputable sign) + duplicateUnarySourceCodeComputable + change BitTM + (fun input : List Bool => + duplicateUnarySourceCodeWord (unarySignedLiteralCodeWord sign input)) + simpa only [Function.comp_def] using hphysical + +@[simp] theorem duplicatedUnarySignedLiteralCodeWord_sourceVariable + {T S : ℕ} (atom : Variable T S) (sign : Bool) : + duplicatedUnarySignedLiteralCodeWord sign + (List.replicate (Encodable.encode atom) true) = + flatDuplicatedUnaryField + (Encodable.encode ((atom, sign) : SignedLiteral T S)) := by + simp only [duplicatedUnarySignedLiteralCodeWord, duplicateUnarySourceCodeWord, + unarySignedLiteralCodeWord_sourceVariable, Encodable.encode_prod_val, List.append_assoc, + List.cons_append, + List.nil_append, flatDuplicatedUnaryField, unarySourcePairWord] + +/-- GapCVP reduction support. -/ +def flatSourceClauseDescriptorPayload {T S : ℕ} + (clause : Clause T S) : List Bool := + flatSignedLiteralDescriptorStream + ((sortedElements clause).map sourceLiteral) + +/-- GapCVP reduction support. -/ +def flatSourceClauseDuplicatedCodePayload {T S : ℕ} + (clause : Clause T S) : List Bool := + flatDuplicatedUnarySourceStream (flatSourceFinsetCodes clause) + +/-- GapCVP reduction support. -/ +def flatSourceClauseUnaryCountPayload {T S : ℕ} + (clause : Clause T S) : List Bool := + List.replicate clause.card true + +/-- GapCVP reduction support. -/ +def flatSourceClauseAnnotatedRecord {T S : ℕ} + (clause : Clause T S) : List Bool := + lengthPrefixedWord (flatSourceClauseDescriptorPayload clause) ++ + lengthPrefixedWord (flatSourceClauseDuplicatedCodePayload clause) ++ + lengthPrefixedWord (flatSourceClauseUnaryCountPayload clause) + +@[simp] theorem flatSourceClauseUnaryCountPayload_length + {T S : ℕ} (clause : Clause T S) : + (flatSourceClauseUnaryCountPayload clause).length = + (flatSourceFinsetCodes clause).length := by + simp only [flatSourceClauseUnaryCountPayload, List.length_replicate, flatSourceFinsetCodes, + List.length_map, + sortedElements_length] + +@[simp] private theorem flatDuplicatedUnaryField_length (value : ℕ) : + (flatDuplicatedUnaryField value).length = 2 * value + 2 := by + simp only [flatDuplicatedUnaryField, unarySourcePairWord, List.length_append, + List.length_replicate, + List.length_cons, List.length_nil, zero_add] + omega + +private theorem flatDuplicatedUnarySourceStream_length_le + (records : List ℕ) (bound : ℕ) + (hbound : ∀ code ∈ records, code < bound) : + (flatDuplicatedUnarySourceStream records).length ≤ + records.length * (2 * bound + 2) := by + induction records with + | nil => simp only [flatDuplicatedUnarySourceStream, List.flatMap_nil, List.length_nil, zero_mul, + Std.le_refl] + | cons code remaining ih => + have hcode : code < bound := hbound code (by simp only [List.mem_cons, true_or]) + have hrest := ih (fun next hnext => + hbound next (by simp only [List.mem_cons, hnext, or_true])) + simp only [flatDuplicatedUnarySourceStream, + List.flatMap_cons, List.length_append, + flatDuplicatedUnaryField_length, List.length_cons, + Nat.succ_mul] at hrest ⊢ + omega + +private theorem flatSourceSignedLiteralDescriptor_length_le + {T S : ℕ} (literal : SignedLiteral T S) : + (flatSignedLiteralDescriptor (sourceLiteral literal)).length ≤ + 8 * tableauFiniteVariableCodeBound T S + 3 := by + have hvariable := sourceVariable_lt_tableauFiniteBound literal.1 + have hsize := structuralNatSize_le_self + (sourceVariable literal.1) + simp only [flatSignedLiteralDescriptor, sourceLiteral, + lengthPrefixedWord_length, List.length_cons, + encodeNat_length_eq_size] + omega + +private theorem flatSourceClauseDescriptorPayload_length_le + {T S : ℕ} (clause : Clause T S) : + (flatSourceClauseDescriptorPayload clause).length ≤ + clause.card * (8 * tableauFiniteVariableCodeBound T S + 3) := by + have hgeneral : ∀ (literals : List (SignedLiteral T S)), + (flatSignedLiteralDescriptorStream + (literals.map sourceLiteral)).length ≤ + literals.length * + (8 * tableauFiniteVariableCodeBound T S + 3) := by + intro literals + induction literals with + | nil => simp only [flatSignedLiteralDescriptorStream, List.map_nil, List.flatMap_nil, + List.length_nil, zero_mul, + Std.le_refl] + | cons literal remaining ih => + have hhead := flatSourceSignedLiteralDescriptor_length_le literal + simp only [List.map_cons, flatSignedLiteralDescriptorStream, + List.flatMap_cons, List.length_append, + List.length_cons, Nat.succ_mul] at ih ⊢ + omega + simpa only [flatSourceClauseDescriptorPayload, ge_iff_le, sortedElements_length] using + hgeneral (sortedElements clause) + +private theorem flatSourceClauseDuplicatedCodePayload_length_le + {T S : ℕ} (clause : Clause T S) : + (flatSourceClauseDuplicatedCodePayload clause).length ≤ + clause.card * (2 * tableauSignedLiteralCodeBound T S + 2) := by + have hbound := flatDuplicatedUnarySourceStream_length_le + (flatSourceFinsetCodes clause) + (tableauSignedLiteralCodeBound T S) + (fun code hcode => flatSourceClauseLiteralCode_lt clause code hcode) + simpa only [flatSourceClauseDuplicatedCodePayload, flatSourceFinsetCodes, ge_iff_le, + List.length_map, + sortedElements_length] using hbound + +/-- GapCVP reduction support. -/ +def flatSourceAnnotatedClauseLengthBound (T S : ℕ) : ℕ := + (2 * ((T + 1) ^ 2 * (S + 1))) * + (16 * tableauFiniteVariableCodeBound T S + + 4 * tableauSignedLiteralCodeBound T S + 12) + 3 + +theorem flatSourceClauseAnnotatedRecord_length_le + {T S : ℕ} (clause : Clause T S) : + (flatSourceClauseAnnotatedRecord clause).length ≤ + flatSourceAnnotatedClauseLengthBound T S := by + have hdescriptors := flatSourceClauseDescriptorPayload_length_le clause + have hcodes := flatSourceClauseDuplicatedCodePayload_length_le clause + have hcard : clause.card ≤ 2 * ((T + 1) ^ 2 * (S + 1)) := by + calc + clause.card ≤ Fintype.card (SignedLiteral T S) := + Finset.card_le_univ clause + _ = 2 * ((T + 1) ^ 2 * (S + 1)) := signedLiteral_card T S + have hproduct := Nat.mul_le_mul_right + (16 * tableauFiniteVariableCodeBound T S + + 4 * tableauSignedLiteralCodeBound T S + 12) hcard + have hexpand : + clause.card * + (16 * tableauFiniteVariableCodeBound T S + + 4 * tableauSignedLiteralCodeBound T S + 12) = + 2 * (clause.card * + (8 * tableauFiniteVariableCodeBound T S + 3)) + + 2 * (clause.card * + (2 * tableauSignedLiteralCodeBound T S + 2)) + + 2 * clause.card := by + ring + rw [hexpand] at hproduct + simp only [flatSourceClauseAnnotatedRecord, + flatSourceClauseUnaryCountPayload, + List.length_append, lengthPrefixedWord_length, + List.length_replicate, + flatSourceAnnotatedClauseLengthBound] at hproduct ⊢ + omega + +/-- GapCVP reduction support. -/ +def flatSourceAnnotatedClauseLengthPolynomial + (time : Polynomial ℕ) (symbols : ℕ) : Polynomial ℕ := + let finite := ((time + Polynomial.C (symbols + 2)) ^ 2 + 1) ^ 2 + let signed := (finite + 2) ^ 2 + let literalCount := + 2 * ((time + 1) ^ 2 * Polynomial.C (symbols + 1)) + literalCount * (16 * finite + 4 * signed + 12) + 3 + +theorem flatSourceAnnotatedClauseLengthBound_eq_polynomial + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : + flatSourceAnnotatedClauseLengthBound + (rowWidth bound machine input) + (completePhaseSymbolCount machine.tm) = + (flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval input.length := by + simp only [flatSourceAnnotatedClauseLengthBound, + flatSourceAnnotatedClauseLengthPolynomial, + tableauSignedLiteralCodeBound, tableauFiniteVariableCodeBound, + rowWidth, Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_pow, Polynomial.eval_C, + Polynomial.eval_one, Polynomial.eval_ofNat] + ring + +end CNFFiveFamilyFlatCandidateGenerationTM + +namespace CNFCappedFlatSourceListComparatorTM + +open Computability Turing GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralNaturalBinaryWriter GapCVP.CNFCappedUnaryMinimumTM +open GapCVP.CNFCappedUnaryMinimumTotalCert GapCVP.CNFFlatSourceOrder +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFCappedFlatSourceListFoldTotalCert + +private def fullCappedFlatSourceListUnaryWord + (input : List Bool) : List Bool := + cappedUnaryMinimumOutput + (flatUnaryDropFields 2 + (boundedRecordFoldOutput flatCappedUnarySourceListStep input)) + +private noncomputable def fullCappedFlatSourceListUnaryComputable : + BitTM + fullCappedFlatSourceListUnaryWord := by + have hdrop := GapCVP.TMComposition.computableInPolyTime + actualCappedFlatSourceListFoldComputable + (flatUnaryDropFieldsComputable 2) + have hphysical := GapCVP.TMComposition.computableInPolyTime + hdrop actualCappedUnaryMinimumComputable + change BitTM + (fun input : List Bool => + cappedUnaryMinimumOutput + (flatUnaryDropFields 2 + (boundedRecordFoldOutput flatCappedUnarySourceListStep input))) + simpa only [Function.comp_def] using hphysical + +@[simp] private theorem fullCappedFlatSourceListUnaryWord_valid + (cap : ℕ) (records : List ℕ) : + fullCappedFlatSourceListUnaryWord + (unaryBoundedFoldWord records.length + (flatCappedUnarySourceListState cap 0 records.reverse)) = + List.replicate (cappedFlatSourceListValue cap records) true := by + unfold fullCappedFlatSourceListUnaryWord + rw [boundedRecordFoldOutput_flatCappedUnarySourceList] + simp only [flatCappedUnarySourceListState, + flatDuplicatedUnaryField, + flatUnaryDropFields_two_unaryPair] + simpa only [List.append_nil, min_self] using + cappedUnaryMinimumOutput_pair (cappedFlatSourceListValue cap records) + (cappedFlatSourceListValue cap records) [] + +/-- GapCVP reduction support. -/ +def fullCappedFlatSourceListBinaryWord + (input : List Bool) : List Bool := + Computability.encodeNat + (fullCappedFlatSourceListUnaryWord input).length + +/-- GapCVP reduction support. -/ +noncomputable def fullCappedFlatSourceListBinaryComputable : + BitTM + fullCappedFlatSourceListBinaryWord := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + fullCappedFlatSourceListUnaryComputable + structuralNaturalBinaryWriterComputable + change BitTM + (fun input : List Bool => + Computability.encodeNat + (fullCappedFlatSourceListUnaryWord input).length) + simpa only [Function.comp_def] using hphysical + +@[simp] theorem fullCappedFlatSourceListBinaryWord_valid + (cap : ℕ) (records : List ℕ) : + fullCappedFlatSourceListBinaryWord + (unaryBoundedFoldWord records.length + (flatCappedUnarySourceListState cap 0 records.reverse)) = + Computability.encodeNat (cappedFlatSourceListValue cap records) := by + simp only [fullCappedFlatSourceListBinaryWord, fullCappedFlatSourceListUnaryWord_valid, + List.length_replicate] + +end CNFCappedFlatSourceListComparatorTM + +namespace SourceCanonicalFixedWordTuringTM + +open Turing GapCVP.SourceMachineCert + +private abbrev sourceInputEraseMachine : Turing.FinTM2 where + K := Unit + k₀ := () + k₁ := () + Γ _ := Bool + Λ := Unit + main := () + σ := Option Bool + initialState := none + m _ := + .peek () (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) + (.pop () (fun _ _ => none) + (.goto (fun _ => ()))) + (.load (fun _ => none) .halt)) + +private def sourceInputEraseConfiguration (input : List Bool) : + sourceInputEraseMachine.Cfg where + l := some () + var := none + stk := fun _ => input + +private theorem sourceInputEraseMachine_init (input : List Bool) : + Turing.initList sourceInputEraseMachine input = + sourceInputEraseConfiguration input := by + simp only [sourceInputEraseMachine, initList, ↓reduceDIte, eq_mpr_eq_cast, cast_eq, + sourceInputEraseConfiguration] + rfl + +private theorem sourceInputErase_scan_step + (bit : Bool) (input : List Bool) : + sourceInputEraseMachine.step + (sourceInputEraseConfiguration (bit :: input)) = + some (sourceInputEraseConfiguration input) := by + cases bit <;> compactMachineStepTac [sourceInputEraseMachine, sourceInputEraseConfiguration] + +private theorem sourceInputErase_finish : + sourceInputEraseMachine.step + (sourceInputEraseConfiguration []) = + some (Turing.haltList sourceInputEraseMachine []) := by + compactMachineStepTac [sourceInputEraseMachine, sourceInputEraseConfiguration] + +private def sourceInputErase_totalTrace (input : List Bool) : + EvalsToInTime sourceInputEraseMachine.step (sourceInputEraseConfiguration input) + (some (Turing.haltList sourceInputEraseMachine [])) + (input.length + 1) := by + induction input with + | nil => + simpa only [FinTM2.step, List.length_nil, zero_add] using oneStep _ _ sourceInputErase_finish + | cons bit input ih => + have first := oneStep _ _ (sourceInputErase_scan_step bit input) + have full := EvalsToInTime.trans sourceInputEraseMachine.step _ _ _ _ _ first ih + simpa only [FinTM2.step, List.length_cons, Nat.add_assoc, Nat.reduceAdd] using full + +private noncomputable def sourceInputEraseComputable : + BitTM + (fun _ : List Bool => []) where + tm := sourceInputEraseMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := Polynomial.X + 1 + outputsFun input := { + steps := (sourceInputErase_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Equiv.invFun_as_coe, Equiv.refl_symm, + Equiv.coe_refl, + bitEncoding, id_eq, List.map_id_fun, sourceInputEraseMachine_init, List.map_nil, + Option.map_some] using + (sourceInputErase_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (sourceInputErase_totalTrace input).steps_le_m + simpa only [FinTM2.step, bitEncoding, id_eq, Polynomial.eval_add, Polynomial.eval_X, + Polynomial.eval_one, + ge_iff_le] using hsteps + } + +/-- GapCVP reduction support. -/ +noncomputable def sourceFixedWordComputable (word : List Bool) : + BitTM + (fun _ : List Bool => word) := by + have machine := GapCVP.TMComposition.computableInPolyTime + sourceInputEraseComputable (prependWordComputable word) + simpa only [Function.comp_def, List.append_nil] using machine + +end SourceCanonicalFixedWordTuringTM + +namespace CNFAnnotatedSourceClausePairPreparationTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFCappedUnaryMinimumTM GapCVP.CNFCappedUnaryMinimumTotalCert +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +def flatAnnotatedSourceFieldTail + (offset : ℕ) (input : List Bool) : List Bool := + (firstFieldSuffix^[offset]) input + +/-- GapCVP reduction support. -/ +noncomputable def annotatedSourceFieldTailComputable : + (offset : ℕ) → + BitTM + (flatAnnotatedSourceFieldTail offset) + | 0 => by + change BitTM + (fun input : List Bool => input) + exact Turing.idComputableInPolyTime bitEncoding + | offset + 1 => by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldTailComputable offset) + firstFieldSuffixComputable + change BitTM + (fun input : List Bool => + (firstFieldSuffix^[offset + 1]) input) + simpa only [Function.iterate_succ_apply', Function.comp_def, flatAnnotatedSourceFieldTail] + using physical + +/-- GapCVP reduction support. -/ +def flatAnnotatedSourceFieldAt + (offset : ℕ) (input : List Bool) : List Bool := + firstFieldContents (flatAnnotatedSourceFieldTail offset input) + +/-- GapCVP reduction support. -/ +noncomputable def annotatedSourceFieldAtComputable + (offset : ℕ) : + BitTM + (flatAnnotatedSourceFieldAt offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldTailComputable offset) + firstFieldContentsComputable + change BitTM + (fun input : List Bool => + firstFieldContents (flatAnnotatedSourceFieldTail offset input)) + exact physical + +/-- GapCVP reduction support. -/ +def annotatedSourceAdjacentClauseWord + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : List Bool := + lengthPrefixedWord firstClause ++ + lengthPrefixedWord firstCodes ++ + lengthPrefixedWord (List.replicate firstCount true) ++ + lengthPrefixedWord secondClause ++ + lengthPrefixedWord secondCodes ++ + lengthPrefixedWord (List.replicate secondCount true) ++ + suffix + +@[simp] theorem flatAnnotatedSourceFieldAt_firstCodes + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + flatAnnotatedSourceFieldAt 1 + (annotatedSourceAdjacentClauseWord firstClause firstCodes + firstCount secondClause secondCodes secondCount suffix) = + firstCodes := by + simp only [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + annotatedSourceAdjacentClauseWord, + List.append_assoc, Function.iterate_one, firstFieldSuffix_valid, firstFieldContents_valid] + +@[simp] theorem flatAnnotatedSourceFieldAt_firstCount + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + flatAnnotatedSourceFieldAt 2 + (annotatedSourceAdjacentClauseWord firstClause firstCodes + firstCount secondClause secondCodes secondCount suffix) = + List.replicate firstCount true := by + simp [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + annotatedSourceAdjacentClauseWord, + Function.iterate_succ_apply', List.append_assoc] + +@[simp] theorem flatAnnotatedSourceFieldAt_secondCodes + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + flatAnnotatedSourceFieldAt 4 + (annotatedSourceAdjacentClauseWord firstClause firstCodes + firstCount secondClause secondCodes secondCount suffix) = + secondCodes := by + simp [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + annotatedSourceAdjacentClauseWord, + Function.iterate_succ_apply', List.append_assoc] + +@[simp] theorem flatAnnotatedSourceFieldAt_secondCount + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + flatAnnotatedSourceFieldAt 5 + (annotatedSourceAdjacentClauseWord firstClause firstCodes + firstCount secondClause secondCodes secondCount suffix) = + List.replicate secondCount true := by + simp [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + annotatedSourceAdjacentClauseWord, + Function.iterate_succ_apply', List.append_assoc] + +private def flatAnnotatedSourceUnaryCountField + (offset : ℕ) (input : List Bool) : List Bool := + flatAnnotatedSourceFieldAt offset input ++ [false] + +private noncomputable def flatAnnotatedSourceUnaryCountFieldComputable + (offset : ℕ) : + BitTM + (flatAnnotatedSourceUnaryCountField offset) := by + have physical := pointwiseAppendComputable + (annotatedSourceFieldAtComputable offset) + (sourceFixedWordComputable [false]) + change BitTM + (fun input : List Bool => + flatAnnotatedSourceFieldAt offset input ++ [false]) + exact physical + +private def flatAnnotatedSourcePairCountQuery + (input : List Bool) : List Bool := + flatAnnotatedSourceUnaryCountField 2 input ++ + flatAnnotatedSourceUnaryCountField 5 input + +private noncomputable def flatAnnotatedSourcePairCountQueryComputable : + BitTM + flatAnnotatedSourcePairCountQuery := by + have physical := pointwiseAppendComputable + (flatAnnotatedSourceUnaryCountFieldComputable 2) + (flatAnnotatedSourceUnaryCountFieldComputable 5) + change BitTM + (fun input : List Bool => + flatAnnotatedSourceUnaryCountField 2 input ++ + flatAnnotatedSourceUnaryCountField 5 input) + exact physical + +private def flatAnnotatedSourceMinimumCountWord + (input : List Bool) : List Bool := + cappedUnaryMinimumOutput (flatAnnotatedSourcePairCountQuery input) + +private noncomputable def flatAnnotatedSourceMinimumCountComputable : + BitTM + flatAnnotatedSourceMinimumCountWord := by + have physical := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSourcePairCountQueryComputable + actualCappedUnaryMinimumComputable + change BitTM + (fun input : List Bool => + cappedUnaryMinimumOutput (flatAnnotatedSourcePairCountQuery input)) + exact physical + +@[simp] private theorem flatAnnotatedSourceMinimumCountWord_valid + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + flatAnnotatedSourceMinimumCountWord + (annotatedSourceAdjacentClauseWord firstClause firstCodes + firstCount secondClause secondCodes secondCount suffix) = + List.replicate (min firstCount secondCount) true := by + simp only [flatAnnotatedSourceMinimumCountWord, cappedUnaryMinimumOutput, + flatAnnotatedSourcePairCountQuery, + flatAnnotatedSourceUnaryCountField, flatAnnotatedSourceFieldAt_firstCount, + flatAnnotatedSourceFieldAt_secondCount, + List.append_assoc, List.cons_append, List.nil_append, readUnaryPrefix_replicate] + +/-- GapCVP reduction support. -/ +def flatAnnotatedSourceZipCountWord + (input : List Bool) : List Bool := + List.tail (flatAnnotatedSourceMinimumCountWord input) + +/-- GapCVP reduction support. -/ +noncomputable def flatAnnotatedSourceZipCountComputable : + BitTM + flatAnnotatedSourceZipCountWord := by + have physical := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSourceMinimumCountComputable dropHeadComputable + change BitTM + (fun input : List Bool => + List.tail (flatAnnotatedSourceMinimumCountWord input)) + exact physical + +@[simp] theorem flatAnnotatedSourceZipCountWord_valid + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + flatAnnotatedSourceZipCountWord + (annotatedSourceAdjacentClauseWord firstClause firstCodes + firstCount secondClause secondCodes secondCount suffix) = + List.replicate (min firstCount secondCount - 1) true := by + unfold flatAnnotatedSourceZipCountWord + rw [flatAnnotatedSourceMinimumCountWord_valid] + cases hminimum : min firstCount secondCount with + | zero => simp only [List.replicate_zero, List.tail_nil, zero_tsub] + | succ minimum => + simp only [List.replicate_succ, List.tail_cons, add_tsub_cancel_right] + +/-- GapCVP reduction support. -/ +def flatAnnotatedSourcePrefixedField + (offset : ℕ) (input : List Bool) : List Bool := + lengthPrefixedWord (flatAnnotatedSourceFieldAt offset input) + +/-- GapCVP reduction support. -/ +noncomputable def annotatedSourcePrefixedFieldComputable + (offset : ℕ) : + BitTM + (flatAnnotatedSourcePrefixedField offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable offset) + structuralPrefixWriterComputable + change BitTM + (fun input : List Bool => + lengthPrefixedWord (flatAnnotatedSourceFieldAt offset input)) + exact physical + +end CNFAnnotatedSourceClausePairPreparationTM + +namespace CNFFlatAdjacentConditionalSwapTM + +open Turing GapCVP.OutputPolynomialCompositionClosure GapCVP.CNFFlatAdjacentRecordSwapTM +open GapCVP.CNFFlatAdjacentRecordSwapTotalCert + +/-- GapCVP reduction support. -/ +def flatAdjacentConditionalSwapOutput : List Bool → List Bool + | true :: input => flatAdjacentRecordSwapOutput input + | false :: input => input + | [] => [] + +private abbrev actualFlatAdjacentConditionalSwapMachine : Turing.FinTM2 where + K := actualFlatAdjacentRecordSwapMachine.K + k₀ := actualFlatAdjacentRecordSwapMachine.k₀ + k₁ := actualFlatAdjacentRecordSwapMachine.k₀ + Γ := actualFlatAdjacentRecordSwapMachine.Γ + Λ := ConditionalLabel actualFlatAdjacentRecordSwapMachine + main := .inr false + σ := ConditionalState actualFlatAdjacentRecordSwapMachine + initialState := (none, none) + m + | .inl phase => + liftValidStatement actualFlatAdjacentRecordSwapMachine + (actualFlatAdjacentRecordSwapMachine.m phase) + | .inr false => + .pop 0 (fun state symbol => (symbol, state.2)) + (.branch (fun state => state.1.getD false) + (.goto (fun _ => .inl (0 : Fin 7))) + (.load (fun _ => (none, none)) .halt)) + | .inr true => + .load (fun _ => (none, none)) .halt + +private def flatAdjacentConditionalSwapEmbedded + (configuration : actualFlatAdjacentRecordSwapMachine.Cfg) : + actualFlatAdjacentConditionalSwapMachine.Cfg where + l := configuration.l.map Sum.inl + var := + (if configuration.l.isSome then some true else none, + configuration.var) + stk := configuration.stk + +private theorem flatAdjacentConditionalSwapEmbedded_step + (configuration next : actualFlatAdjacentRecordSwapMachine.Cfg) + (hstep : actualFlatAdjacentRecordSwapMachine.step configuration = + some next) : + actualFlatAdjacentConditionalSwapMachine.step + (flatAdjacentConditionalSwapEmbedded configuration) = + some (flatAdjacentConditionalSwapEmbedded next) := by + rcases configuration with ⟨label, state, sourceStacks⟩ + cases label with + | none => + simp only [FinTM2.step, TM2.step, reduceCtorEq] at hstep + | some label => + change some + (Turing.TM2.stepAux + (actualFlatAdjacentRecordSwapMachine.m label) + state sourceStacks) = some next at hstep + have hnext := Option.some.inj hstep + subst next + change some + (Turing.TM2.stepAux + (liftValidStatement flatAdjacentRecordSwapComputable.tm + (flatAdjacentRecordSwapComputable.tm.m label)) + (some true, state) sourceStacks) = + some (validConfiguration flatAdjacentRecordSwapComputable [] + (Turing.TM2.stepAux + (flatAdjacentRecordSwapComputable.tm.m label) + state sourceStacks)) + rw [liftValidStatement_stepAux + flatAdjacentRecordSwapComputable []] + rfl + +private theorem flatAdjacentConditionalSwap_start_true + (input : List Bool) : + actualFlatAdjacentConditionalSwapMachine.step + (Turing.initList actualFlatAdjacentConditionalSwapMachine + (true :: input)) = + some (flatAdjacentConditionalSwapEmbedded + (Turing.initList actualFlatAdjacentRecordSwapMachine input)) := by + compactMachineStepTac [actualFlatAdjacentConditionalSwapMachine, + flatAdjacentConditionalSwapEmbedded, actualFlatAdjacentRecordSwapMachine, Turing.initList] + +private theorem flatAdjacentConditionalSwap_start_false + (input : List Bool) : + actualFlatAdjacentConditionalSwapMachine.step + (Turing.initList actualFlatAdjacentConditionalSwapMachine + (false :: input)) = + some (Turing.haltList + actualFlatAdjacentConditionalSwapMachine input) := by + compactMachineStepTac [actualFlatAdjacentConditionalSwapMachine, Turing.initList] + +private theorem flatAdjacentConditionalSwap_start_missing : + actualFlatAdjacentConditionalSwapMachine.step + (Turing.initList actualFlatAdjacentConditionalSwapMachine []) = + some (Turing.haltList + actualFlatAdjacentConditionalSwapMachine []) := by + compactMachineStepTac [actualFlatAdjacentConditionalSwapMachine, Turing.initList] + +private theorem flatAdjacentConditionalSwapEmbedded_halt + (output : List Bool) : + flatAdjacentConditionalSwapEmbedded + (Turing.haltList actualFlatAdjacentRecordSwapMachine output) = + Turing.haltList actualFlatAdjacentConditionalSwapMachine output := by + rfl + +private def flatAdjacentConditionalSwapTimePolynomial : Polynomial ℕ := + flatAdjacentRecordSwapTimePolynomial + 1 + +private noncomputable def flatAdjacentConditionalSwap_totalTrace + (input : List Bool) : + EvalsToInTime actualFlatAdjacentConditionalSwapMachine.step + (Turing.initList actualFlatAdjacentConditionalSwapMachine input) + (some (Turing.haltList actualFlatAdjacentConditionalSwapMachine + (flatAdjacentConditionalSwapOutput input))) + (flatAdjacentConditionalSwapTimePolynomial.eval input.length) := by + cases input with + | nil => + have hphysical := oneStep _ _ flatAdjacentConditionalSwap_start_missing + refine { + steps := hphysical.steps + evals_in_steps := ?_ + steps_le_m := ?_ + } + · simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, + flatAdjacentConditionalSwapOutput] using + hphysical.evals_in_steps + · simp [flatAdjacentConditionalSwapTimePolynomial, + flatAdjacentRecordSwapTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_X, Polynomial.eval_ofNat] + at hphysical ⊢ + have hsteps := hphysical.steps_le_m + omega + | cons marker remaining => + cases marker with + | false => + have hphysical := oneStep _ _ (flatAdjacentConditionalSwap_start_false remaining) + refine { + steps := hphysical.steps + evals_in_steps := ?_ + steps_le_m := ?_ + } + · simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, + flatAdjacentConditionalSwapOutput] using + hphysical.evals_in_steps + · simp [flatAdjacentConditionalSwapTimePolynomial, + flatAdjacentRecordSwapTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_X, Polynomial.eval_ofNat] + at hphysical ⊢ + have hsteps := hphysical.steps_le_m + omega + | true => + have hstart := oneStep _ _ (flatAdjacentConditionalSwap_start_true remaining) + have horiginal := flatAdjacentRecordTotalTrace remaining + rw [← actualFlatAdjacentRecordSwapMachine_init] at horiginal + have hvalid := + GapCVP.TMComposition.evalsToInTimeMapOfStep + actualFlatAdjacentRecordSwapMachine.step + actualFlatAdjacentConditionalSwapMachine.step + flatAdjacentConditionalSwapEmbedded + flatAdjacentConditionalSwapEmbedded_step horiginal + rw [flatAdjacentConditionalSwapEmbedded_halt] at hvalid + have hfull := EvalsToInTime.trans actualFlatAdjacentConditionalSwapMachine.step + _ _ _ _ _ hstart hvalid + refine { + steps := hfull.steps + evals_in_steps := ?_ + steps_le_m := ?_ + } + · simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, + flatAdjacentConditionalSwapOutput] using + hfull.evals_in_steps + · have hsteps := hfull.steps_le_m + simp [flatAdjacentConditionalSwapTimePolynomial, + flatAdjacentRecordSwapTimePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_X, Polynomial.eval_ofNat] + at hsteps ⊢ + omega + +/-- GapCVP reduction support. -/ +noncomputable def flatAdjacentConditionalSwapComputable : + BitTM + flatAdjacentConditionalSwapOutput where + tm := actualFlatAdjacentConditionalSwapMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := flatAdjacentConditionalSwapTimePolynomial + outputsFun input := { + steps := (flatAdjacentConditionalSwap_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, Option.map_some] using + (flatAdjacentConditionalSwap_totalTrace input).evals_in_steps + steps_le_m := by + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq] using + (flatAdjacentConditionalSwap_totalTrace input).steps_le_m + } + +end CNFFlatAdjacentConditionalSwapTM + +namespace CNFGuardedFiveFamilyTagDispatchTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert +open GapCVP.SourceFormulaStructuralDecoder GapCVP.OutputPolynomialCompositionClosure +open GapCVP.SourceOriginalSourcePreservingTM GapCVP.CNFEncodedClauseSort + +/-- GapCVP reduction support. -/ +def keepFirstDropSecondWord : List Bool → List Bool + | [] => [] + | bit :: remaining => bit :: remaining.tail + +private abbrev keepFirstDropSecondMachine : Turing.FinTM2 where + K := Unit + k₀ := () + k₁ := () + Γ _ := Bool + Λ := Unit + main := () + σ := Option Bool + initialState := none + m _ := + .peek () (fun _ inspected => inspected) + (.pop () (fun state _ => state) + (.pop () (fun state _ => state) + (.branch (fun state => state.isSome) + (.push () (fun state => state.getD false) + (.load (fun _ => none) .halt)) + (.load (fun _ => none) .halt)))) + +private theorem keepFirstDropSecondMachine_step + (input : List Bool) : + keepFirstDropSecondMachine.step + (Turing.initList keepFirstDropSecondMachine input) = + some (Turing.haltList keepFirstDropSecondMachine + (keepFirstDropSecondWord input)) := by + cases input with + | nil => + simp only [keepFirstDropSecondMachine, FinTM2.step, TM2.step, initList, ↓reduceDIte, + eq_mpr_eq_cast, cast_eq, + TM2.stepAux, List.head?_nil, Option.isSome_none, List.tail_nil, Function.update_eq_self, + Function.update_self, + Option.getD_none, Bool.cond_false, haltList, keepFirstDropSecondWord] + rfl + | cons bit remaining => + cases remaining with + | nil => + simp only [keepFirstDropSecondMachine, FinTM2.step, TM2.step, initList, ↓reduceDIte, + eq_mpr_eq_cast, cast_eq, + TM2.stepAux, List.head?_cons, Option.isSome_some, List.tail_cons, + Function.update_self, List.tail_nil, + Function.update_idem, Option.getD_some, Function.update_eq_self, Bool.cond_true, + haltList, + keepFirstDropSecondWord] + rfl + | cons next remaining => + simp only [keepFirstDropSecondMachine, FinTM2.step, TM2.step, initList, ↓reduceDIte, + eq_mpr_eq_cast, cast_eq, + TM2.stepAux, List.head?_cons, Option.isSome_some, List.tail_cons, + Function.update_self, Function.update_idem, + Option.getD_some, Bool.cond_true, haltList, keepFirstDropSecondWord] + congr 2 + +/-- GapCVP reduction support. -/ +noncomputable def keepFirstDropSecondComputable : + BitTM + keepFirstDropSecondWord where + tm := keepFirstDropSecondMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 1 + outputsFun input := { + steps := 1 + evals_in_steps := by + rw [Function.iterate_one] + rw [Option.bind_eq_bind] + simp only [flip] + rw [Option.bind_some] + simpa only [FinTM2.step, + Equiv.invFun_as_coe, Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, + Option.map_some] using keepFirstDropSecondMachine_step input + steps_le_m := by simp only [id_eq, Polynomial.eval_one, Std.le_refl] + } + +/-- GapCVP reduction support. -/ +def encodedOrderingEqualityBitWord : List Bool → List Bool := + markerConditionalOutput + (markerConditionalOutput (fun bits => false :: bits) [true]) + [false] + +/-- GapCVP reduction support. -/ +noncomputable def encodedOrderingEqualityBitComputable : + BitTM + encodedOrderingEqualityBitWord := + markerConditionalComputable + (markerConditionalComputable + (prependBitComputable false) [true]) [false] + +@[simp] theorem encodedOrderingEqualityBitWord_ordering + (outcome : EncodedWordOrdering) : + encodedOrderingEqualityBitWord + (encodedWordOrderingWord outcome) = + [decide (outcome = .equal)] := by + cases outcome <;> + rfl + +private def fixedDelimitedWordOrderingWord + (expected : List Bool) (input : List Bool) : List Bool := + firstFieldSuffix + (sourcePreservingDelimitedPairComparisonWord + (lengthPrefixedWord expected ++ input)) + +private noncomputable def fixedDelimitedWordOrderingComputable + (expected : List Bool) : + BitTM + (fixedDelimitedWordOrderingWord expected) := by + have hcompare := GapCVP.TMComposition.computableInPolyTime + (prependWordComputable (lengthPrefixedWord expected)) + sourcePreservingDelimitedPairComparisonComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hcompare firstFieldSuffixComputable + change BitTM + (fun input : List Bool => + firstFieldSuffix + (sourcePreservingDelimitedPairComparisonWord + (lengthPrefixedWord expected ++ input))) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def fixedDelimitedWordEqualityBitWord + (expected : List Bool) (input : List Bool) : List Bool := + encodedOrderingEqualityBitWord + (fixedDelimitedWordOrderingWord expected input) + +/-- GapCVP reduction support. -/ +noncomputable def fixedDelimitedWordEqualityBitComputable + (expected : List Bool) : + BitTM + (fixedDelimitedWordEqualityBitWord expected) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (fixedDelimitedWordOrderingComputable expected) + encodedOrderingEqualityBitComputable + change BitTM + (fun input : List Bool => + encodedOrderingEqualityBitWord + (fixedDelimitedWordOrderingWord expected input)) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def fixedDelimitedWordEqualitySelector + (expected : List Bool) (input : List Bool) : Bool := + decide + (delimitedPairWordOrdering + (lengthPrefixedWord expected ++ input) = .equal) + +@[simp] theorem fixedDelimitedWordEqualityBitWord_eq + (expected input : List Bool) : + fixedDelimitedWordEqualityBitWord expected input = + [fixedDelimitedWordEqualitySelector expected input] := by + unfold fixedDelimitedWordEqualityBitWord + fixedDelimitedWordOrderingWord + fixedDelimitedWordEqualitySelector + simp only [sourcePreservingDelimitedPairComparisonWord, + firstFieldSuffix_valid] + exact encodedOrderingEqualityBitWord_ordering _ + +@[simp] theorem fixedDelimitedWordEqualitySelector_valid + (expected actual suffix : List Bool) : + fixedDelimitedWordEqualitySelector expected + (lengthPrefixedWord actual ++ suffix) = + decide (expected = actual) := by + unfold fixedDelimitedWordEqualitySelector + simp only [delimitedPairWordOrdering, + readLengthPrefixedWord_append] + simp only [lexicographicEncodedWordOrdering_eq_equal_iff] + +private def fixedDelimitedWordEqualitySelectionWord + (expected : List Bool) (input : List Bool) : List Bool := + fixedDelimitedWordEqualitySelector expected input :: input + +private noncomputable def fixedDelimitedWordEqualitySelectionComputable + (expected : List Bool) : + BitTM + (fixedDelimitedWordEqualitySelectionWord expected) := by + have hpreserved := originalSourcePreservingComputable + (fixedDelimitedWordEqualityBitComputable expected) + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved keepFirstDropSecondComputable + have hequality : + (fun input : List Bool => + keepFirstDropSecondWord + (originalSourcePreservingOutput + (fixedDelimitedWordEqualityBitWord expected) input)) = + fixedDelimitedWordEqualitySelectionWord expected := by + funext input + simp only [keepFirstDropSecondWord, originalSourcePreservingOutput, + fixedDelimitedWordEqualityBitWord_eq, + List.cons_append, List.nil_append, List.tail_cons, fixedDelimitedWordEqualitySelectionWord] + rw [← hequality] + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def fixedDelimitedGuardedWorkerWord + (expected : List Bool) (worker : List Bool → List Bool) + (input : List Bool) : List Bool := + if fixedDelimitedWordEqualitySelector expected input + then worker input + else [] + +/-- GapCVP reduction support. -/ +noncomputable def fixedDelimitedGuardedWorkerComputable + (expected : List Bool) + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (fixedDelimitedGuardedWorkerWord expected worker) := by + exact sourcePreservingConditionalComputable + (fixedDelimitedWordEqualitySelectionComputable expected) + computer [] + +end CNFGuardedFiveFamilyTagDispatchTM + +namespace CNFFlatCappedComparisonControlledSwapTM + +open Turing GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.OutputPolynomialCompositionClosure GapCVP.SourceOriginalSourcePreservingTM +open GapCVP.CNFGuardedFiveFamilyTagDispatchTM GapCVP.CNFFlatAdjacentRecordSwapTM +open GapCVP.CNFFlatAdjacentConditionalSwapTM + +private def flatEncodedOrderingGreaterBitWord : List Bool → List Bool := + markerConditionalOutput + (markerConditionalOutput (fun _ => [true]) [false]) + [false] + +private noncomputable def flatEncodedOrderingGreaterBitComputable : + BitTM + flatEncodedOrderingGreaterBitWord := + markerConditionalComputable + (markerConditionalComputable + (sourceFixedWordComputable [true]) [false]) + [false] + +@[simp] private theorem flatEncodedOrderingGreaterBitWord_eq + (input : List Bool) : + flatEncodedOrderingGreaterBitWord input = + [input.headD false && input.tail.headD false] := by + cases input with + | nil => rfl + | cons first remaining => + cases first with + | false => rfl + | true => + cases remaining with + | nil => rfl + | cons second suffix => + cases second <;> rfl + +/-- GapCVP reduction support. -/ +def flatComparisonGreaterMarker + (comparison : List Bool → List Bool) + (input : List Bool) : Bool := + let outcome := firstFieldSuffix (comparison input) + outcome.headD false && outcome.tail.headD false + +private def flatComparisonGreaterSelectionWord + (comparison : List Bool → List Bool) + (input : List Bool) : List Bool := + flatComparisonGreaterMarker comparison input :: input + +private noncomputable def flatComparisonGreaterSelectionComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (flatComparisonGreaterSelectionWord comparison) := by + have houtcome := GapCVP.TMComposition.computableInPolyTime + computer firstFieldSuffixComputable + have hmarker := GapCVP.TMComposition.computableInPolyTime + houtcome flatEncodedOrderingGreaterBitComputable + have hpreserved := originalSourcePreservingComputable hmarker + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved keepFirstDropSecondComputable + change BitTM + (fun input => flatComparisonGreaterMarker comparison input :: input) + have hequality : + (fun input : List Bool => + keepFirstDropSecondWord + (originalSourcePreservingOutput + (fun source => flatEncodedOrderingGreaterBitWord + (firstFieldSuffix (comparison source))) input)) = + (fun input => + flatComparisonGreaterMarker comparison input :: input) := by + funext input + simp only [keepFirstDropSecondWord, originalSourcePreservingOutput, + flatEncodedOrderingGreaterBitWord_eq, + List.headD_eq_head?_getD, List.head?_tail, List.cons_append, List.nil_append, + List.tail_cons, + flatComparisonGreaterMarker] + rw [← hequality] + simpa only [flatEncodedOrderingGreaterBitWord_eq, List.headD_eq_head?_getD, List.head?_tail, + Function.comp_def] using hphysical + +private def flatAdjacentComparisonControlledSwapWord + (comparison : List Bool → List Bool) + (input : List Bool) : List Bool := + flatAdjacentConditionalSwapOutput + (flatComparisonGreaterSelectionWord comparison input) + +private noncomputable def flatAdjacentComparisonControlledSwapComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (flatAdjacentComparisonControlledSwapWord comparison) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (flatComparisonGreaterSelectionComputable computer) + flatAdjacentConditionalSwapComputable + change BitTM + (fun input => flatAdjacentConditionalSwapOutput + (flatComparisonGreaterSelectionWord comparison input)) + simpa only [Function.comp_def] using hphysical + +private theorem flatAdjacentComparisonControlledSwapWord_eq + (comparison : List Bool → List Bool) (input : List Bool) : + flatAdjacentComparisonControlledSwapWord comparison input = + if flatComparisonGreaterMarker comparison input then + flatAdjacentRecordSwapOutput input + else input := by + unfold flatAdjacentComparisonControlledSwapWord + flatComparisonGreaterSelectionWord + cases flatComparisonGreaterMarker comparison input <;> rfl + +private theorem flatAdjacentComparisonControlledSwapWord_length_le + (comparison : List Bool → List Bool) (input : List Bool) : + (flatAdjacentComparisonControlledSwapWord + comparison input).length ≤ input.length := by + rw [flatAdjacentComparisonControlledSwapWord_eq] + split + · exact flatAdjacentRecordSwapOutput_length_le input + · exact Nat.le_refl _ + +end CNFFlatCappedComparisonControlledSwapTM + +namespace CNFAnnotatedSourceClauseBubblePassTM + +open Turing GapCVP.CL GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.SourceFormulaStructuralDecoder GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFGuardedSourceDescriptorRotationBoundedFoldTM +open GapCVP.CNFTypedRecordWorkerTM GapCVP.CNFFlatAdjacentRecordSwapTM +open GapCVP.CNFFlatCappedComparisonControlledSwapTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM + +/-- GapCVP reduction support. -/ +def flatAnnotatedBundledClauseRecord {T S : ℕ} + (clause : Clause T S) : List Bool := + lengthPrefixedWord (flatSourceClauseAnnotatedRecord clause) + +/-- GapCVP reduction support. -/ +def flatAnnotatedBundledClauseStream {T S : ℕ} + (clauses : List (Clause T S)) : List Bool := + clauses.flatMap flatAnnotatedBundledClauseRecord + +/-- GapCVP reduction support. -/ +def annotatedBundledPairComparisonInput + (input : List Bool) : List Bool := + firstFieldContents input ++ + firstFieldContents (firstFieldSuffix input) + +private noncomputable def flatAnnotatedBundledPairComparisonInputComputable : + BitTM + annotatedBundledPairComparisonInput := by + have hsecond := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + have physical := pointwiseAppendComputable + firstFieldContentsComputable hsecond + change BitTM + (fun input : List Bool => + firstFieldContents input ++ + firstFieldContents (firstFieldSuffix input)) + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def annotatedBundledPairComparisonWord + (comparison : List Bool → List Bool) (input : List Bool) : List Bool := + comparison (annotatedBundledPairComparisonInput input) + +/-- GapCVP reduction support. -/ +noncomputable def flatAnnotatedBundledPairComparisonComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (annotatedBundledPairComparisonWord comparison) := by + have physical := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedBundledPairComparisonInputComputable computer + change BitTM + (fun input : List Bool => + comparison (annotatedBundledPairComparisonInput input)) + simpa only [Function.comp_def] using physical + +theorem flatAnnotatedBundledPairComparisonInput_records + {T S : ℕ} (first second : Clause T S) (suffix : List Bool) : + annotatedBundledPairComparisonInput + (flatAnnotatedBundledClauseRecord first ++ + flatAnnotatedBundledClauseRecord second ++ suffix) = + flatSourceClauseAnnotatedRecord first ++ + flatSourceClauseAnnotatedRecord second := by + simp only [annotatedBundledPairComparisonInput, flatAnnotatedBundledClauseRecord, + List.append_assoc, + firstFieldContents_valid, firstFieldSuffix_valid] + +/-- GapCVP reduction support. -/ +def flatAnnotatedBubblePassState + (active emitted : List Bool) : List Bool := + lengthPrefixedWord active ++ lengthPrefixedWord emitted + +private def flatAnnotatedBubbleActiveSwap + (comparison : List Bool → List Bool) (input : List Bool) : List Bool := + flatAdjacentComparisonControlledSwapWord + (annotatedBundledPairComparisonWord comparison) + (firstFieldContents input) + +private noncomputable def flatAnnotatedBubbleActiveSwapComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (flatAnnotatedBubbleActiveSwap comparison) := by + have hswap := flatAdjacentComparisonControlledSwapComputable + (flatAnnotatedBundledPairComparisonComputable computer) + have physical := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable hswap + change BitTM + (fun input : List Bool => + flatAdjacentComparisonControlledSwapWord + (annotatedBundledPairComparisonWord comparison) + (firstFieldContents input)) + simpa only [Function.comp_def] using physical + +private def flatAnnotatedBubbleRemaining + (comparison : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldSuffix (flatAnnotatedBubbleActiveSwap comparison input) + +private noncomputable def flatAnnotatedBubbleRemainingComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (flatAnnotatedBubbleRemaining comparison) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedBubbleActiveSwapComputable computer) + firstFieldSuffixComputable + change BitTM + (fun input : List Bool => + firstFieldSuffix (flatAnnotatedBubbleActiveSwap comparison input)) + simpa only [Function.comp_def] using physical + +private def flatAnnotatedBubbleSelected + (comparison : List Bool → List Bool) + (input : List Bool) : List Bool := + lengthPrefixedWord + (firstFieldContents (flatAnnotatedBubbleActiveSwap comparison input)) + +private noncomputable def flatAnnotatedBubbleSelectedComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (flatAnnotatedBubbleSelected comparison) := by + have hcontents := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedBubbleActiveSwapComputable computer) + firstFieldContentsComputable + have physical := GapCVP.TMComposition.computableInPolyTime + hcontents structuralPrefixWriterComputable + change BitTM + (fun input : List Bool => + lengthPrefixedWord + (firstFieldContents + (flatAnnotatedBubbleActiveSwap comparison input))) + simpa only [Function.comp_def] using physical + +private def flatAnnotatedBubbleNextArchive + (comparison : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldContents (firstFieldSuffix input) ++ + flatAnnotatedBubbleSelected comparison input + +private noncomputable def flatAnnotatedBubbleNextArchiveComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (flatAnnotatedBubbleNextArchive comparison) := by + have harchive := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + have physical := pointwiseAppendComputable harchive + (flatAnnotatedBubbleSelectedComputable computer) + change BitTM + (fun input : List Bool => + firstFieldContents (firstFieldSuffix input) ++ + flatAnnotatedBubbleSelected comparison input) + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def flatAnnotatedBubblePassStep + (comparison : List Bool → List Bool) + (input : List Bool) : List Bool := + lengthPrefixedWord (flatAnnotatedBubbleRemaining comparison input) ++ + lengthPrefixedWord (flatAnnotatedBubbleNextArchive comparison input) + +private noncomputable def flatAnnotatedBubblePassStepComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (flatAnnotatedBubblePassStep comparison) := by + have hremaining := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedBubbleRemainingComputable computer) + structuralPrefixWriterComputable + have harchive := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedBubbleNextArchiveComputable computer) + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable hremaining harchive + change BitTM + (fun input : List Bool => + lengthPrefixedWord + (flatAnnotatedBubbleRemaining comparison input) ++ + lengthPrefixedWord + (flatAnnotatedBubbleNextArchive comparison input)) + simpa only [Function.comp_def] using physical + +theorem annotatedStructuralFieldAccounting + (input : List Bool) : + 2 * (firstFieldContents input).length + + (firstFieldSuffix input).length ≤ input.length := by + cases hread : readLengthPrefixedWord input with + | none => + simp only [firstFieldContents, payloadDecodeOutput, hread, List.tail_cons, List.length_nil, + mul_zero, + firstFieldSuffix, add_zero, zero_le] + | some parsed => + obtain ⟨payload, suffix⟩ := parsed + have hshape := + guardedRotation_readLengthPrefixedWord_some_reconstruct + input payload suffix hread + simp only [firstFieldContents, payloadDecodeOutput, + firstFieldSuffix, hread, List.tail_cons] + rw [hshape] + simp only [List.length_append, lengthPrefixedWord_length, add_le_add_iff_right, + le_add_iff_nonneg_right, + zero_le] + +theorem annotatedStructuralTwoFieldAccounting + (input : List Bool) : + 2 * (firstFieldContents input).length + + 2 * (firstFieldContents (firstFieldSuffix input)).length ≤ + input.length := by + have hfirst := annotatedStructuralFieldAccounting input + have hsecond := + annotatedStructuralFieldAccounting (firstFieldSuffix input) + omega + +private theorem flatAnnotatedBubblePassStep_length_le + (comparison : List Bool → List Bool) + (input : List Bool) : + (flatAnnotatedBubblePassStep comparison input).length ≤ + input.length + 4 := by + have hswap := flatAdjacentComparisonControlledSwapWord_length_le + (annotatedBundledPairComparisonWord comparison) + (firstFieldContents input) + have hswapFields := annotatedStructuralFieldAccounting + (flatAnnotatedBubbleActiveSwap comparison input) + have hsourceFields := annotatedStructuralTwoFieldAccounting input + change + (lengthPrefixedWord + (firstFieldSuffix + (flatAnnotatedBubbleActiveSwap comparison input)) ++ + lengthPrefixedWord + (firstFieldContents (firstFieldSuffix input) ++ + lengthPrefixedWord + (firstFieldContents + (flatAnnotatedBubbleActiveSwap comparison input)))).length ≤ + input.length + 4 + simp only [List.length_append, lengthPrefixedWord_length] + change + (flatAnnotatedBubbleActiveSwap comparison input).length ≤ + (firstFieldContents input).length at hswap + omega + +theorem flatAnnotatedBubblePassStep_iterate_length_le + (comparison : List Bool → List Bool) + (input : List Bool) (count : ℕ) : + (((flatAnnotatedBubblePassStep comparison)^[count]) input).length ≤ + input.length + 4 * count := by + induction count with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, Std.le_refl] + | succ count ih => + rw [Function.iterate_succ_apply'] + have hstep := flatAnnotatedBubblePassStep_length_le comparison + (((flatAnnotatedBubblePassStep comparison)^[count]) input) + simp only [Nat.mul_succ] + omega + +private theorem flatAnnotatedBubblePass_polynomiallyBoundedFoldStates + (comparison : List Bool → List Bool) : + PolynomiallyBoundedFoldStates + (flatAnnotatedBubblePassStep comparison) + (5 * Polynomial.X) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := parsedUnaryFold_seed_length_le input count seed hparse + have hcount := parsedUnaryFold_count_le_length input count seed hparse + have hiterate := flatAnnotatedBubblePassStep_iterate_length_le + comparison seed stage + have hstage' : stage ≤ input.length := hstage.trans hcount + simp only [Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X] + omega + +/-- GapCVP reduction support. -/ +noncomputable def flatAnnotatedBubblePassFoldComputable + {comparison : List Bool → List Bool} + (computer : BitTM comparison) : + BitTM + (boundedRecordFoldOutput + (flatAnnotatedBubblePassStep comparison)) := + boundedDependentRecordFoldComputable + (flatAnnotatedBubblePassStepComputable computer) + (5 * Polynomial.X) + (flatAnnotatedBubblePass_polynomiallyBoundedFoldStates comparison) + +/-- GapCVP reduction support. -/ +def flatAnnotatedBubbleClauseState {T S : ℕ} + (active emitted : List (Clause T S)) : List Bool := + flatAnnotatedBubblePassState + (flatAnnotatedBundledClauseStream active) + (flatAnnotatedBundledClauseStream emitted) + +/-- GapCVP reduction support. -/ +noncomputable def CorrectFlatAnnotatedBundledSourceComparison + (comparison : List Bool → List Bool) : Bool := + @decide ( + ∀ {T S : ℕ} (first second : Clause T S) (suffix : List Bool), + flatComparisonGreaterMarker + (annotatedBundledPairComparisonWord comparison) + (flatAnnotatedBundledClauseRecord first ++ + flatAnnotatedBundledClauseRecord second ++ suffix) = + decide (Encodable.encode second < Encodable.encode first) + ) (Classical.propDecidable _) +@[simp] theorem flatAnnotatedBubblePassStep_clauseState + {comparison : List Bool → List Bool} + (hcomparison : CorrectFlatAnnotatedBundledSourceComparison comparison) + {T S : ℕ} (first second : Clause T S) + (remaining emitted : List (Clause T S)) : + flatAnnotatedBubblePassStep comparison + (flatAnnotatedBubbleClauseState + (first :: second :: remaining) emitted) = + if Encodable.encode second < Encodable.encode first then + flatAnnotatedBubbleClauseState + (first :: remaining) (emitted ++ [second]) + else + flatAnnotatedBubbleClauseState + (second :: remaining) (emitted ++ [first]) := by + have comparison := hcomparison + simp only [CorrectFlatAnnotatedBundledSourceComparison, + decide_eq_true_eq] at comparison + have hmarker := comparison first second + (flatAnnotatedBundledClauseStream remaining) + have hemit : + firstFieldContents + (lengthPrefixedWord + (emitted.flatMap flatAnnotatedBundledClauseRecord)) = + emitted.flatMap flatAnnotatedBundledClauseRecord := by + simpa only [List.append_nil] using + firstFieldContents_valid (emitted.flatMap flatAnnotatedBundledClauseRecord) [] + simp only [flatAnnotatedBundledClauseStream, + flatAnnotatedBundledClauseRecord, List.append_assoc] + at hmarker + unfold flatAnnotatedBubblePassStep + flatAnnotatedBubbleRemaining flatAnnotatedBubbleNextArchive + flatAnnotatedBubbleSelected flatAnnotatedBubbleActiveSwap + flatAnnotatedBubbleClauseState flatAnnotatedBubblePassState + simp only [flatAnnotatedBundledClauseStream, List.flatMap_cons, + firstFieldContents_valid, firstFieldSuffix_valid, + flatAdjacentComparisonControlledSwapWord_eq] + by_cases horder : Encodable.encode second < Encodable.encode first + · simp only [flatAnnotatedBundledClauseRecord, hmarker, horder, decide_true, ↓reduceIte, + flatAdjacentRecordSwapOutput, readLengthPrefixedWord_append, List.append_assoc, + firstFieldSuffix_valid, hemit, + firstFieldContents_valid, List.flatMap_append, List.flatMap_cons, List.flatMap_nil, + List.append_nil] + · simp only [flatAnnotatedBundledClauseRecord, hmarker, horder, decide_false, Bool.false_eq_true, + ↓reduceIte, + firstFieldSuffix_valid, hemit, firstFieldContents_valid, List.flatMap_append, + List.flatMap_cons, List.flatMap_nil, + List.append_nil] + +end CNFAnnotatedSourceClauseBubblePassTM + +namespace SourceUnaryIntegerMultiplicationTM + +section + +open Turing GapCVP.BinaryEncoding + +/-- GapCVP reduction support. -/ +def sourceUnaryIntegerMultiplicationQuery + (left right : ℕ) : List Bool := + List.replicate left true ++ false :: List.replicate right true + +/-- GapCVP reduction support. -/ +def sourceUnaryIntegerMultiplicationOutput + (input : List Bool) : List Bool := + match readUnaryPrefix input with + | none => [] + | some (left, right) => + if right.all (fun bit => bit) then + List.replicate (left * right.length) true + else [] + +@[simp] theorem sourceUnaryIntegerMultiplicationOutput_query + (left right : ℕ) : + sourceUnaryIntegerMultiplicationOutput + (sourceUnaryIntegerMultiplicationQuery left right) = + List.replicate (left * right) true := by + simp only [sourceUnaryIntegerMultiplicationOutput, sourceUnaryIntegerMultiplicationQuery, + readUnaryPrefix_replicate, List.all_replicate, ite_self, ↓reduceIte, List.length_replicate] + +private def sourceIntegerMultiplicationPeek (stack : Fin 5) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def sourceIntegerMultiplicationPop (stack : Fin 5) + (next : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + .pop stack (fun current _ => current) next + +private def sourceIntegerMultiplicationPush (stack : Fin 5) + (next : Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + .push stack (fun _ => true) next + +private def sourceIntegerMultiplicationGoto (phase : Fin 11) : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationLeftStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 0 + (.branch (fun symbol => symbol.getD false) + (sourceIntegerMultiplicationPop 0 + (sourceIntegerMultiplicationPush 1 + (sourceIntegerMultiplicationGoto 0))) + (sourceIntegerMultiplicationPop 0 + (sourceIntegerMultiplicationGoto 1))) + (sourceIntegerMultiplicationGoto 6) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationRightStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 0 + (.branch (fun symbol => symbol.getD false) + (sourceIntegerMultiplicationPop 0 + (sourceIntegerMultiplicationPush 2 + (sourceIntegerMultiplicationGoto 1))) + (sourceIntegerMultiplicationPop 0 + (sourceIntegerMultiplicationGoto 6))) + (sourceIntegerMultiplicationGoto 2) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationOuterStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 1 + (sourceIntegerMultiplicationPop 1 + (sourceIntegerMultiplicationGoto 3)) + (sourceIntegerMultiplicationGoto 5) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationCopyStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 2 + (sourceIntegerMultiplicationPop 2 + (sourceIntegerMultiplicationPush 3 + (sourceIntegerMultiplicationPush 4 + (sourceIntegerMultiplicationGoto 3)))) + (sourceIntegerMultiplicationGoto 4) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 3 + (sourceIntegerMultiplicationPop 3 + (sourceIntegerMultiplicationPush 2 + (sourceIntegerMultiplicationGoto 4))) + (sourceIntegerMultiplicationGoto 2) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationSuccessCleanupStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 2 + (sourceIntegerMultiplicationPop 2 + (sourceIntegerMultiplicationGoto 5)) + (.load (fun _ => none) .halt) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationFailureInputStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 0 + (sourceIntegerMultiplicationPop 0 + (sourceIntegerMultiplicationGoto 6)) + (sourceIntegerMultiplicationGoto 7) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationFailureLeftStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 1 + (sourceIntegerMultiplicationPop 1 + (sourceIntegerMultiplicationGoto 7)) + (sourceIntegerMultiplicationGoto 8) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationFailureRightStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 2 + (sourceIntegerMultiplicationPop 2 + (sourceIntegerMultiplicationGoto 8)) + (sourceIntegerMultiplicationGoto 9) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationFailureRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 3 + (sourceIntegerMultiplicationPop 3 + (sourceIntegerMultiplicationGoto 9)) + (sourceIntegerMultiplicationGoto 10) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationFailureOutputStatement : + Turing.TM2.Stmt + (fun _ : Fin 5 => Bool) (Fin 11) (Option Bool) := + sourceIntegerMultiplicationPeek 4 + (sourceIntegerMultiplicationPop 4 + (sourceIntegerMultiplicationGoto 10)) + (.load (fun _ => none) .halt) + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev sourceUnaryIntegerMultiplicationMachine : Turing.FinTM2 where + K := Fin 5 + k₀ := 0 + k₁ := 4 + Γ _ := Bool + Λ := Fin 11 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 11) then + sourceIntegerMultiplicationLeftStatement + else if phase = (1 : Fin 11) then + sourceIntegerMultiplicationRightStatement + else if phase = (2 : Fin 11) then + sourceIntegerMultiplicationOuterStatement + else if phase = (3 : Fin 11) then + sourceIntegerMultiplicationCopyStatement + else if phase = (4 : Fin 11) then + sourceIntegerMultiplicationRestoreStatement + else if phase = (5 : Fin 11) then + sourceIntegerMultiplicationSuccessCleanupStatement + else if phase = (6 : Fin 11) then + sourceIntegerMultiplicationFailureInputStatement + else if phase = (7 : Fin 11) then + sourceIntegerMultiplicationFailureLeftStatement + else if phase = (8 : Fin 11) then + sourceIntegerMultiplicationFailureRightStatement + else if phase = (9 : Fin 11) then + sourceIntegerMultiplicationFailureRestoreStatement + else + sourceIntegerMultiplicationFailureOutputStatement + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIntegerMultiplicationConfiguration + (phase : Fin 11) + (input left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.Cfg where + l := some phase + var := none + stk := ![input, left, right, restore, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryIntegerMultiplicationMachine_init + (input : List Bool) : + Turing.initList sourceUnaryIntegerMultiplicationMachine input = + sourceIntegerMultiplicationConfiguration + 0 input [] [] [] [] := by + simp only [sourceUnaryIntegerMultiplicationMachine, Fin.isValue, initList, eq_mpr_eq_cast, + cast_eq, + dite_eq_ite, sourceIntegerMultiplicationConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `sourceIntegerMultiplicationStepTac` machine-step simplifier. -/ +macro "sourceIntegerMultiplicationStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [sourceUnaryIntegerMultiplicationMachine, + sourceIntegerMultiplicationConfiguration, + sourceIntegerMultiplicationPeek, + sourceIntegerMultiplicationPop, + sourceIntegerMultiplicationPush, + sourceIntegerMultiplicationGoto, + sourceIntegerMultiplicationLeftStatement, + sourceIntegerMultiplicationRightStatement, + sourceIntegerMultiplicationOuterStatement, + sourceIntegerMultiplicationCopyStatement, + sourceIntegerMultiplicationRestoreStatement, + sourceIntegerMultiplicationSuccessCleanupStatement, + sourceIntegerMultiplicationFailureInputStatement, + sourceIntegerMultiplicationFailureLeftStatement, + sourceIntegerMultiplicationFailureRightStatement, + sourceIntegerMultiplicationFailureRestoreStatement, + sourceIntegerMultiplicationFailureOutputStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_left_true + (input left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 0 + (true :: input) left right restore output) = + some (sourceIntegerMultiplicationConfiguration 0 + input (true :: left) right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_left_delimiter + (input left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 0 + (false :: input) left right restore output) = + some (sourceIntegerMultiplicationConfiguration 1 + input left right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_left_missing + (left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 0 + [] left right restore output) = + some (sourceIntegerMultiplicationConfiguration 6 + [] left right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_right_true + (input left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 1 + (true :: input) left right restore output) = + some (sourceIntegerMultiplicationConfiguration 1 + input left (true :: right) restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_right_false + (input left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 1 + (false :: input) left right restore output) = + some (sourceIntegerMultiplicationConfiguration 6 + input left right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_right_finish + (left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 1 + [] left right restore output) = + some (sourceIntegerMultiplicationConfiguration 2 + [] left right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_outer_step + (left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 2 + [] (true :: left) right restore output) = + some (sourceIntegerMultiplicationConfiguration 3 + [] left right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_outer_finish + (right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 2 + [] [] right restore output) = + some (sourceIntegerMultiplicationConfiguration 5 + [] [] right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_copy_step + (left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 3 + [] left (true :: right) restore output) = + some (sourceIntegerMultiplicationConfiguration 3 + [] left right (true :: restore) (true :: output)) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_copy_finish + (left restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 3 + [] left [] restore output) = + some (sourceIntegerMultiplicationConfiguration 4 + [] left [] restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_restore_step + (left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 4 + [] left right (true :: restore) output) = + some (sourceIntegerMultiplicationConfiguration 4 + [] left (true :: right) restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_restore_finish + (left right output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 4 + [] left right [] output) = + some (sourceIntegerMultiplicationConfiguration 2 + [] left right [] output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_success_step + (right output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 5 + [] [] (true :: right) [] output) = + some (sourceIntegerMultiplicationConfiguration 5 + [] [] right [] output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_success_finish + (output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 5 + [] [] [] [] output) = + some (Turing.haltList + sourceUnaryIntegerMultiplicationMachine output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_input_step + (bit : Bool) (input left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 6 + (bit :: input) left right restore output) = + some (sourceIntegerMultiplicationConfiguration 6 + input left right restore output) := by + cases bit <;> sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_input_finish + (left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 6 + [] left right restore output) = + some (sourceIntegerMultiplicationConfiguration 7 + [] left right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_left_step + (bit : Bool) (left right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 7 + [] (bit :: left) right restore output) = + some (sourceIntegerMultiplicationConfiguration 7 + [] left right restore output) := by + cases bit <;> sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_left_finish + (right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 7 + [] [] right restore output) = + some (sourceIntegerMultiplicationConfiguration 8 + [] [] right restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_right_step + (bit : Bool) (right restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 8 + [] [] (bit :: right) restore output) = + some (sourceIntegerMultiplicationConfiguration 8 + [] [] right restore output) := by + cases bit <;> sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_right_finish + (restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 8 + [] [] [] restore output) = + some (sourceIntegerMultiplicationConfiguration 9 + [] [] [] restore output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_restore_step + (bit : Bool) (restore output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 9 + [] [] [] (bit :: restore) output) = + some (sourceIntegerMultiplicationConfiguration 9 + [] [] [] restore output) := by + cases bit <;> sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_restore_finish + (output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 9 + [] [] [] [] output) = + some (sourceIntegerMultiplicationConfiguration 10 + [] [] [] [] output) := by + sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_output_step + (bit : Bool) (output : List Bool) : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 10 + [] [] [] [] (bit :: output)) = + some (sourceIntegerMultiplicationConfiguration 10 + [] [] [] [] output) := by + cases bit <;> sourceIntegerMultiplicationStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIntegerMultiplication_failure_finish : + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 10 + [] [] [] [] []) = + some (Turing.haltList + sourceUnaryIntegerMultiplicationMachine []) := by + sourceIntegerMultiplicationStepTac + +end + +end SourceUnaryIntegerMultiplicationTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part06B.lean b/LeanPool/GapCVP/Part06B.lean new file mode 100644 index 000000000..95d2dc2cb --- /dev/null +++ b/LeanPool/GapCVP/Part06B.lean @@ -0,0 +1,1307 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part06A + +/-! # GapCVP proof, part 06, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceUnaryIntegerMultiplicationTM + +section + +open Turing GapCVP.BinaryEncoding + +end + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder + +private def sourceIntegerMultiplication_leftTrace + (count : ℕ) (remaining left right restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 0 + (List.replicate count true ++ false :: remaining) + left right restore output) + (some (sourceIntegerMultiplicationConfiguration 1 + remaining (List.replicate count true ++ left) + right restore output)) + (count + 1) := by + induction count generalizing left with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_left_delimiter remaining left right restore + output) + | succ count ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_left_true + (List.replicate count true ++ false :: remaining) + left right restore output) + have hrest := ih (true :: left) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceIntegerMultiplication_leftMissingTrace + (count : ℕ) (left right restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 0 + (List.replicate count true) left right restore output) + (some (sourceIntegerMultiplicationConfiguration 6 + [] (List.replicate count true ++ left) + right restore output)) + (count + 1) := by + induction count generalizing left with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_left_missing left right restore output) + | succ count ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_left_true + (List.replicate count true) + left right restore output) + have hrest := ih (true :: left) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceIntegerMultiplication_rightTrace + (count : ℕ) (left right restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 1 + (List.replicate count true) left right restore output) + (some (sourceIntegerMultiplicationConfiguration 2 + [] left (List.replicate count true ++ right) + restore output)) + (count + 1) := by + induction count generalizing right with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_right_finish left right restore output) + | succ count ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_right_true + (List.replicate count true) + left right restore output) + have hrest := ih (true :: right) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceIntegerMultiplication_rightInvalidTrace + (count : ℕ) (remaining left right restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 1 + (List.replicate count true ++ false :: remaining) + left right restore output) + (some (sourceIntegerMultiplicationConfiguration 6 + remaining left (List.replicate count true ++ right) + restore output)) + (count + 1) := by + induction count generalizing right with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_right_false remaining left right restore output) + | succ count ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_right_true + (List.replicate count true ++ false :: remaining) + left right restore output) + have hrest := ih (true :: right) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceIntegerMultiplication_copyTrace + (count : ℕ) (left restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 3 + [] left (List.replicate count true) restore output) + (some (sourceIntegerMultiplicationConfiguration 4 + [] left [] (List.replicate count true ++ restore) + (List.replicate count true ++ output))) + (count + 1) := by + induction count generalizing restore output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_copy_finish left restore output) + | succ count ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_copy_step left + (List.replicate count true) restore output) + have hrest := ih (true :: restore) (true :: output) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceIntegerMultiplication_restoreTrace + (count : ℕ) (left right output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 4 + [] left right (List.replicate count true) output) + (some (sourceIntegerMultiplicationConfiguration 2 + [] left (List.replicate count true ++ right) [] output)) + (count + 1) := by + induction count generalizing right with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_restore_finish left right output) + | succ count ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_restore_step + left right (List.replicate count true) output) + have hrest := ih (true :: right) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hrest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceIntegerMultiplication_baseCopyTrace + (rightSize : ℕ) (left output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 3 + [] left (List.replicate rightSize true) [] output) + (some (sourceIntegerMultiplicationConfiguration 2 + [] left (List.replicate rightSize true) [] + (List.replicate rightSize true ++ output))) + (2 * rightSize + 2) := by + have hcopy := sourceIntegerMultiplication_copyTrace + rightSize left [] output + simp only [List.append_nil] at hcopy + have hrestore := sourceIntegerMultiplication_restoreTrace + rightSize left [] + (List.replicate rightSize true ++ output) + simp only [List.append_nil] at hrestore + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hcopy hrestore + exact rebound hfull (by omega) + +private def sourceIntegerMultiplication_productTrace + (leftSize rightSize : ℕ) (output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 2 + [] (List.replicate leftSize true) + (List.replicate rightSize true) [] output) + (some (sourceIntegerMultiplicationConfiguration 5 + [] [] (List.replicate rightSize true) [] + (List.replicate (leftSize * rightSize) true ++ output))) + (leftSize * (2 * rightSize + 3) + 1) := by + induction leftSize generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_mul, List.nil_append, + zero_add] using + oneStep _ _ (sourceIntegerMultiplication_outer_finish (List.replicate rightSize true) [] + output) + | succ leftSize ih => + have houter := oneStep _ _ (sourceIntegerMultiplication_outer_step + (List.replicate leftSize true) + (List.replicate rightSize true) [] output) + have hcopy := sourceIntegerMultiplication_baseCopyTrace + rightSize (List.replicate leftSize true) output + have hready := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ houter hcopy + have hrest := ih (List.replicate rightSize true ++ output) + have hblocks : + List.replicate (leftSize * rightSize) true ++ + (List.replicate rightSize true ++ output) = + List.replicate ((leftSize + 1) * rightSize) true ++ + output := by + rw [Nat.add_mul, Nat.one_mul, + List.replicate_add, List.append_assoc] + rw [hblocks] at hrest + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hready hrest + have hnormalized : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 2 + [] (List.replicate (leftSize + 1) true) + (List.replicate rightSize true) [] output) + (some (sourceIntegerMultiplicationConfiguration 5 + [] [] (List.replicate rightSize true) [] + (List.replicate ((leftSize + 1) * rightSize) true ++ + output))) + ((leftSize * (2 * rightSize + 3) + 1) + + ((2 * rightSize + 2) + 1)) := by + simpa only [List.replicate_succ, Nat.add_assoc] + using hfull + exact rebound hnormalized (by + simp only [Nat.mul_add, Nat.add_mul, one_mul] + omega) + +private def sourceIntegerMultiplication_successTrace + (count : ℕ) (output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 5 + [] [] (List.replicate count true) [] output) + (some (Turing.haltList + sourceUnaryIntegerMultiplicationMachine output)) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_success_finish output) + | succ count ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_success_step + (List.replicate count true) output) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd] + using hfull + +private def sourceIntegerMultiplication_failureInputTrace + (input left right restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 6 + input left right restore output) + (some (sourceIntegerMultiplicationConfiguration 7 + [] left right restore output)) + (input.length + 1) := by + induction input with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_failure_input_finish left right restore output) + | cons bit input ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_input_step + bit input left right restore output) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hfull + +private def sourceIntegerMultiplication_failureLeftTrace + (left right restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 7 + [] left right restore output) + (some (sourceIntegerMultiplicationConfiguration 8 + [] [] right restore output)) + (left.length + 1) := by + induction left with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_failure_left_finish right restore output) + | cons bit left ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_left_step + bit left right restore output) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hfull + +private def sourceIntegerMultiplication_failureRightTrace + (right restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 8 + [] [] right restore output) + (some (sourceIntegerMultiplicationConfiguration 9 + [] [] [] restore output)) + (right.length + 1) := by + induction right with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_failure_right_finish restore output) + | cons bit right ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_right_step + bit right restore output) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hfull + +private def sourceIntegerMultiplication_failureRestoreTrace + (restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 9 + [] [] [] restore output) + (some (sourceIntegerMultiplicationConfiguration 10 + [] [] [] [] output)) + (restore.length + 1) := by + induction restore with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (sourceIntegerMultiplication_failure_restore_finish output) + | cons bit restore ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_restore_step + bit restore output) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hfull + +private def sourceIntegerMultiplication_failureOutputTrace + (output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 10 + [] [] [] [] output) + (some (Turing.haltList + sourceUnaryIntegerMultiplicationMachine [])) + (output.length + 1) := by + induction output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ sourceIntegerMultiplication_failure_finish + | cons bit output ih => + have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_output_step + bit output) + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using hfull + +private def sourceIntegerMultiplication_failureTrace + (input left right restore output : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 6 + input left right restore output) + (some (Turing.haltList + sourceUnaryIntegerMultiplicationMachine [])) + (input.length + left.length + right.length + + restore.length + output.length + 5) := by + have hinput := sourceIntegerMultiplication_failureInputTrace + input left right restore output + have hleft := sourceIntegerMultiplication_failureLeftTrace + left right restore output + have hright := sourceIntegerMultiplication_failureRightTrace + right restore output + have hrestore := sourceIntegerMultiplication_failureRestoreTrace + restore output + have houtput := sourceIntegerMultiplication_failureOutputTrace + output + have hfirst := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hinput hleft + have hsecond := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hright + have hthird := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hsecond hrestore + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hthird houtput + exact rebound hfull (by omega) + +private def sourceIntegerMultiplicationValidBudget + (left right : ℕ) : ℕ := + left * (2 * right + 3) + left + 2 * right + 4 + +private def sourceIntegerMultiplication_validTrace + (left right : ℕ) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 0 + (sourceUnaryIntegerMultiplicationQuery left right) + [] [] [] []) + (some (Turing.haltList + sourceUnaryIntegerMultiplicationMachine + (List.replicate (left * right) true))) + (sourceIntegerMultiplicationValidBudget left right) := by + have hleft := sourceIntegerMultiplication_leftTrace + left (List.replicate right true) [] [] [] [] + simp only [List.append_nil] at hleft + have hright := sourceIntegerMultiplication_rightTrace + right (List.replicate left true) [] [] [] + simp only [List.append_nil] at hright + have hproduct := sourceIntegerMultiplication_productTrace + left right [] + simp only [List.append_nil] at hproduct + have hcleanup := sourceIntegerMultiplication_successTrace + right (List.replicate (left * right) true) + have hfirst := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hleft hright + have hsecond := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hproduct + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hsecond hcleanup + change EvalsToInTime + sourceUnaryIntegerMultiplicationMachine.step + (sourceIntegerMultiplicationConfiguration 0 + (List.replicate left true ++ + false :: List.replicate right true) + [] [] [] []) + (some (Turing.haltList + sourceUnaryIntegerMultiplicationMachine + (List.replicate (left * right) true))) + (sourceIntegerMultiplicationValidBudget left right) + exact rebound hfull (by + simp only [sourceIntegerMultiplicationValidBudget] + omega) + +private def sourceIntegerMultiplicationInputBudget + (input : List Bool) : ℕ := + 16 * (input.length + 1) ^ 2 + 32 + +private theorem sourceIntegerMultiplication_validBudget_le + (left right : ℕ) : + sourceIntegerMultiplicationValidBudget left right ≤ + sourceIntegerMultiplicationInputBudget + (sourceUnaryIntegerMultiplicationQuery left right) := by + simp only [sourceIntegerMultiplicationValidBudget, sourceIntegerMultiplicationInputBudget, + sourceUnaryIntegerMultiplicationQuery, List.length_append, List.length_replicate, + List.length_cons, + add_le_add_iff_right] + nlinarith [Nat.zero_le (left * left), + Nat.zero_le (right * right)] + +private noncomputable def sourceIntegerMultiplication_totalTrace + (input : List Bool) : + EvalsToInTime sourceUnaryIntegerMultiplicationMachine.step + (Turing.initList sourceUnaryIntegerMultiplicationMachine input) + (some (Turing.haltList sourceUnaryIntegerMultiplicationMachine + (sourceUnaryIntegerMultiplicationOutput input))) + (sourceIntegerMultiplicationInputBudget input) := by + rw [sourceUnaryIntegerMultiplicationMachine_init] + cases unaryInputSplit input with + | inl witness => + obtain ⟨count, hinput⟩ := witness + subst input + have hscan := sourceIntegerMultiplication_leftMissingTrace + count [] [] [] [] + simp only [List.append_nil] at hscan + have hcleanup := sourceIntegerMultiplication_failureTrace + [] (List.replicate count true) [] [] [] + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hscan hcleanup + have hbounded := rebound (newBudget := sourceIntegerMultiplicationInputBudget + (List.replicate count true)) + hfull (by + simp only [List.length_nil, List.length_replicate, zero_add, add_zero, + sourceIntegerMultiplicationInputBudget] + nlinarith [Nat.zero_le (count * count)]) + simpa only [FinTM2.step, Fin.isValue, sourceUnaryIntegerMultiplicationOutput, + readUnaryPrefix_missing] using + hbounded + | inr witness => + obtain ⟨left, remaining, hinput⟩ := witness + subst input + cases unaryInputSplit remaining with + | inl second => + obtain ⟨right, hremaining⟩ := second + subst remaining + have hvalid := sourceIntegerMultiplication_validTrace + left right + have hbounded := rebound hvalid + (sourceIntegerMultiplication_validBudget_le left right) + simpa only [FinTM2.step, Fin.isValue, sourceUnaryIntegerMultiplicationOutput, + readUnaryPrefix_replicate, + List.all_replicate, ite_self, ↓reduceIte, List.length_replicate, + sourceUnaryIntegerMultiplicationQuery] using + hbounded + | inr excess => + obtain ⟨right, suffix, hremaining⟩ := excess + subst remaining + have hleft := sourceIntegerMultiplication_leftTrace + left + (List.replicate right true ++ false :: suffix) + [] [] [] [] + simp only [List.append_nil] at hleft + have hright := sourceIntegerMultiplication_rightInvalidTrace + right suffix (List.replicate left true) [] [] [] + simp only [List.append_nil] at hright + have hcleanup := sourceIntegerMultiplication_failureTrace + suffix (List.replicate left true) + (List.replicate right true) [] [] + have hfirst := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hleft hright + have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step + _ _ _ _ _ hfirst hcleanup + have hbounded := rebound (newBudget := sourceIntegerMultiplicationInputBudget + (List.replicate left true ++ + false :: (List.replicate right true ++ + false :: suffix))) + hfull (by + simp only [List.length_replicate, List.length_nil, add_zero, + sourceIntegerMultiplicationInputBudget, + List.length_append, List.length_cons] + nlinarith [Nat.zero_le (left * left), + Nat.zero_le (right * right), + Nat.zero_le (suffix.length * suffix.length)]) + simpa only [FinTM2.step, Fin.isValue, sourceUnaryIntegerMultiplicationOutput, + readUnaryPrefix_replicate, + List.all_append, List.all_replicate, ite_self, List.all_cons, Bool.false_and, + Bool.and_false, Bool.false_eq_true, + ↓reduceIte] using hbounded + +private noncomputable def sourceIntegerMultiplicationTimePolynomial : + Polynomial ℕ := + 16 * (Polynomial.X + 1) ^ 2 + 32 + +private theorem sourceIntegerMultiplicationTimePolynomial_eval + (input : List Bool) : + sourceIntegerMultiplicationTimePolynomial.eval + (bitEncoding input).length = + sourceIntegerMultiplicationInputBudget input := by + simp only [bitEncoding, id_eq, sourceIntegerMultiplicationTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X, + Polynomial.eval_one, sourceIntegerMultiplicationInputBudget] + +/-- GapCVP reduction support. -/ +noncomputable def sourceUnaryIntegerMultiplicationComputable : + BitTM + sourceUnaryIntegerMultiplicationOutput where + tm := sourceUnaryIntegerMultiplicationMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := sourceIntegerMultiplicationTimePolynomial + outputsFun input := { + steps := (sourceIntegerMultiplication_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, Option.map_some] using + (sourceIntegerMultiplication_totalTrace input).evals_in_steps + steps_le_m := by + rw [sourceIntegerMultiplicationTimePolynomial_eval] + exact (sourceIntegerMultiplication_totalTrace input).steps_le_m + } + +end + +end SourceUnaryIntegerMultiplicationTM + +namespace SourceMixedRadixPreservedFourFamilyRecordTM + +open Turing GapCVP.BinaryEncoding +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceWholeOutputValidBranchRecordTM +open GapCVP.SourceOriginalSourcePreservingTM GapCVP.CLStructuralPrefixWriter + +private def sourcePhysicalAtomicDescriptorOutput + (atom : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceFlatAtomicDescriptor (atom input) + +private noncomputable def sourcePhysicalAtomicDescriptorComputable + {atom : List Bool → List Bool} + (computer : BitTM atom) : + BitTM (sourcePhysicalAtomicDescriptorOutput atom) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + computer structuralPrefixWriterComputable + change BitTM + (fun input => lengthPrefixedWord (atom input)) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def sourcePreservedPhysicalAtomicDescriptorOutput + (atom : List Bool → List Bool) : List Bool → List Bool := + originalSourcePreservingOutput + (sourcePhysicalAtomicDescriptorOutput atom) + +/-- GapCVP reduction support. -/ +noncomputable def sourcePreservedPhysicalAtomicDescriptorComputable + {atom : List Bool → List Bool} + (computer : BitTM atom) : + BitTM + (sourcePreservedPhysicalAtomicDescriptorOutput atom) := + originalSourcePreservingComputable + (sourcePhysicalAtomicDescriptorComputable computer) + +@[simp] theorem sourcePreservedPhysicalAtomicDescriptorOutput_eq + (atom : List Bool → List Bool) (input : List Bool) : + sourcePreservedPhysicalAtomicDescriptorOutput atom input = + sourceFlatAtomicDescriptor (atom input) ++ false :: input := by + rfl + +end SourceMixedRadixPreservedFourFamilyRecordTM + +namespace SourceMixedRadixUnaryQuotientRemainderTM + +section + +open Turing + +/-- Internal support shared across GapCVP continuation modules. -/ +structure SourceUnaryDivisionState where + /-- Whether the encoded division input is valid. -/ + valid : Bool + /-- The current scanned bit, when present. -/ + current : Option Bool + deriving Fintype + +private def sourceUnaryDivisionControl (valid : Bool) : SourceUnaryDivisionState := + ⟨valid, none⟩ + +private def sourceUnaryDivisionPeek (stack : Fin 8) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState) : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + .peek stack (fun state symbol => { state with current := symbol }) + (.branch (fun state => state.current.isSome) present absent) + +private def sourceUnaryDivisionPop (stack : Fin 8) + (next : Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState) : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + .pop stack (fun state _ => state) next + +private def sourceUnaryDivisionGoto (phase : Fin 13) : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + .load (fun state => sourceUnaryDivisionControl state.valid) + (.goto (fun _ => phase)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionDividendStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 0 + (sourceUnaryDivisionPop 0 + (.push 1 (fun state => state.current.getD false) + (.branch (fun state => state.current.getD false) + (.push 2 (fun _ => true) (sourceUnaryDivisionGoto 0)) + (sourceUnaryDivisionGoto 1)))) + (.load (fun _ => sourceUnaryDivisionControl false) + (.goto (fun _ => (2 : Fin 13)))) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionModulusStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 0 + (sourceUnaryDivisionPop 0 + (.push 1 (fun state => state.current.getD false) + (.branch (fun state => state.current.getD false) + (.push 3 (fun _ => true) (sourceUnaryDivisionGoto 1)) + (sourceUnaryDivisionGoto 2)))) + (.load (fun _ => sourceUnaryDivisionControl false) + (.goto (fun _ => (2 : Fin 13)))) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionArchiveSuffixStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 0 + (sourceUnaryDivisionPop 0 + (.push 1 (fun state => state.current.getD false) + (sourceUnaryDivisionGoto 2))) + (sourceUnaryDivisionGoto 3) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionRestoreSourceStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 1 + (sourceUnaryDivisionPop 1 + (.push 7 (fun state => state.current.getD false) + (sourceUnaryDivisionGoto 3))) + (.push 7 (fun _ => false) (sourceUnaryDivisionGoto 4)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionDispatchStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + .branch (fun state => state.valid) + (sourceUnaryDivisionPeek 3 + (sourceUnaryDivisionGoto 5) + (.push 7 (fun _ => false) (sourceUnaryDivisionGoto 9))) + (.push 7 (fun _ => false) (sourceUnaryDivisionGoto 9)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionMatchStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 3 + (sourceUnaryDivisionPeek 2 + (sourceUnaryDivisionPop 2 + (sourceUnaryDivisionPop 3 + (.push 4 (fun _ => true) + (.push 6 (fun _ => true) + (sourceUnaryDivisionGoto 5))))) + (sourceUnaryDivisionGoto 7)) + (sourceUnaryDivisionGoto 6) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionRestoreModulusStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 4 + (sourceUnaryDivisionPop 4 + (sourceUnaryDivisionPop 6 + (.push 3 (fun _ => true) + (sourceUnaryDivisionGoto 6)))) + (.push 5 (fun _ => true) (sourceUnaryDivisionGoto 5)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionEmitRemainderStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 6 + (sourceUnaryDivisionPop 6 + (.push 7 (fun _ => true) (sourceUnaryDivisionGoto 7))) + (.push 7 (fun _ => false) (sourceUnaryDivisionGoto 8)) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionEmitQuotientStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 5 + (sourceUnaryDivisionPop 5 + (.push 7 (fun _ => true) (sourceUnaryDivisionGoto 8))) + (sourceUnaryDivisionGoto 9) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionCleanupModulusStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 3 + (sourceUnaryDivisionPop 3 (sourceUnaryDivisionGoto 9)) + (sourceUnaryDivisionGoto 10) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionCleanupScratchStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 4 + (sourceUnaryDivisionPop 4 (sourceUnaryDivisionGoto 10)) + (sourceUnaryDivisionGoto 11) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionCleanupDividendStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 2 + (sourceUnaryDivisionPop 2 (sourceUnaryDivisionGoto 11)) + (sourceUnaryDivisionGoto 12) + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionCleanupPartialStatement : + Turing.TM2.Stmt + (fun _ : Fin 8 => Bool) (Fin 13) SourceUnaryDivisionState := + sourceUnaryDivisionPeek 6 + (sourceUnaryDivisionPop 6 (sourceUnaryDivisionGoto 12)) + (.load (fun _ => sourceUnaryDivisionControl true) .halt) + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev sourceUnaryDivisionMachine : Turing.FinTM2 where + K := Fin 8 + k₀ := 0 + k₁ := 7 + Γ _ := Bool + Λ := Fin 13 + main := 0 + σ := SourceUnaryDivisionState + initialState := sourceUnaryDivisionControl true + m phase := + if phase = (0 : Fin 13) then + sourceUnaryDivisionDividendStatement + else if phase = (1 : Fin 13) then + sourceUnaryDivisionModulusStatement + else if phase = (2 : Fin 13) then + sourceUnaryDivisionArchiveSuffixStatement + else if phase = (3 : Fin 13) then + sourceUnaryDivisionRestoreSourceStatement + else if phase = (4 : Fin 13) then + sourceUnaryDivisionDispatchStatement + else if phase = (5 : Fin 13) then + sourceUnaryDivisionMatchStatement + else if phase = (6 : Fin 13) then + sourceUnaryDivisionRestoreModulusStatement + else if phase = (7 : Fin 13) then + sourceUnaryDivisionEmitRemainderStatement + else if phase = (8 : Fin 13) then + sourceUnaryDivisionEmitQuotientStatement + else if phase = (9 : Fin 13) then + sourceUnaryDivisionCleanupModulusStatement + else if phase = (10 : Fin 13) then + sourceUnaryDivisionCleanupScratchStatement + else if phase = (11 : Fin 13) then + sourceUnaryDivisionCleanupDividendStatement + else sourceUnaryDivisionCleanupPartialStatement + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionConfiguration + (phase : Fin 13) (valid : Bool) + (input archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.Cfg where + l := some phase + var := sourceUnaryDivisionControl valid + stk := ![input, archive, dividend, modulus, modulusScratch, + quotient, residueStack, output] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivisionMachine_init (input : List Bool) : + Turing.initList sourceUnaryDivisionMachine input = + sourceUnaryDivisionConfiguration 0 true + input [] [] [] [] [] [] [] := by + simp only [sourceUnaryDivisionMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + sourceUnaryDivisionConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `sourceUnaryDivisionStepTac` machine-step simplifier. -/ +macro "sourceUnaryDivisionStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [sourceUnaryDivisionMachine, + sourceUnaryDivisionConfiguration, + sourceUnaryDivisionControl, + sourceUnaryDivisionPeek, sourceUnaryDivisionPop, + sourceUnaryDivisionGoto, + sourceUnaryDivisionDividendStatement, + sourceUnaryDivisionModulusStatement, + sourceUnaryDivisionArchiveSuffixStatement, + sourceUnaryDivisionRestoreSourceStatement, + sourceUnaryDivisionDispatchStatement, + sourceUnaryDivisionMatchStatement, + sourceUnaryDivisionRestoreModulusStatement, + sourceUnaryDivisionEmitRemainderStatement, + sourceUnaryDivisionEmitQuotientStatement, + sourceUnaryDivisionCleanupModulusStatement, + sourceUnaryDivisionCleanupScratchStatement, + sourceUnaryDivisionCleanupDividendStatement, + sourceUnaryDivisionCleanupPartialStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_dividend_true + (valid : Bool) + (input archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 0 valid + (true :: input) archive dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 0 valid + input (true :: archive) (true :: dividend) modulus + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_dividend_false + (valid : Bool) + (input archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 0 valid + (false :: input) archive dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 1 valid + input (false :: archive) dividend modulus + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_dividend_missing + (valid : Bool) + (archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 0 valid + [] archive dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 2 false + [] archive dividend modulus + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_modulus_true + (valid : Bool) + (input archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 1 valid + (true :: input) archive dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 1 valid + input (true :: archive) dividend (true :: modulus) + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_modulus_false + (valid : Bool) + (input archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 1 valid + (false :: input) archive dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 2 valid + input (false :: archive) dividend modulus + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_modulus_missing + (valid : Bool) + (archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 1 valid + [] archive dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 2 false + [] archive dividend modulus + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_suffix_step + (valid bit : Bool) + (input archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 2 valid + (bit :: input) archive dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 2 valid + input (bit :: archive) dividend modulus + modulusScratch quotient residueStack output) := by + cases bit <;> sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_suffix_finish + (valid : Bool) + (archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 2 valid + [] archive dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 3 valid + [] archive dividend modulus + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_restoreSource_step + (valid bit : Bool) + (archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 3 valid + [] (bit :: archive) dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 3 valid + [] archive dividend modulus + modulusScratch quotient residueStack (bit :: output)) := by + cases bit <;> sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_restoreSource_finish + (valid : Bool) + (dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 3 valid + [] [] dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 4 valid + [] [] dividend modulus + modulusScratch quotient residueStack (false :: output)) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_dispatch_valid + (modulusTail dividend modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 4 true + [] [] dividend (true :: modulusTail) + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 5 true + [] [] dividend (true :: modulusTail) + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_dispatch_zero + (dividend modulusScratch quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 4 true + [] [] dividend [] + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 9 true + [] [] dividend [] + modulusScratch quotient residueStack (false :: output)) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_dispatch_invalid + (dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 4 false + [] [] dividend modulus + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 9 false + [] [] dividend modulus + modulusScratch quotient residueStack (false :: output)) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_match_step + (valid : Bool) + (dividend modulus modulusScratch + quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 5 valid + [] [] (true :: dividend) (true :: modulus) + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 5 valid + [] [] dividend modulus + (true :: modulusScratch) quotient + (true :: residueStack) output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_match_full + (valid : Bool) + (dividend modulusScratch quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 5 valid + [] [] dividend [] + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 6 valid + [] [] dividend [] + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_match_partial + (valid : Bool) + (modulus modulusScratch quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 5 valid + [] [] [] (true :: modulus) + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 7 valid + [] [] [] (true :: modulus) + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_restoreModulus_step + (valid : Bool) + (dividend modulus modulusScratch quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 6 valid + [] [] dividend modulus + (true :: modulusScratch) quotient (true :: residueStack) output) = + some (sourceUnaryDivisionConfiguration 6 valid + [] [] dividend (true :: modulus) + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_restoreModulus_finish + (valid : Bool) + (dividend modulus quotient output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 6 valid + [] [] dividend modulus [] quotient [] output) = + some (sourceUnaryDivisionConfiguration 5 valid + [] [] dividend modulus [] (true :: quotient) [] output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_emitRemainder_step + (valid : Bool) + (modulus modulusScratch quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 7 valid + [] [] [] modulus + modulusScratch quotient (true :: residueStack) output) = + some (sourceUnaryDivisionConfiguration 7 valid + [] [] [] modulus + modulusScratch quotient residueStack (true :: output)) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_emitRemainder_finish + (valid : Bool) + (modulus modulusScratch quotient output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 7 valid + [] [] [] modulus + modulusScratch quotient [] output) = + some (sourceUnaryDivisionConfiguration 8 valid + [] [] [] modulus + modulusScratch quotient [] (false :: output)) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_emitQuotient_step + (valid : Bool) + (modulus modulusScratch quotient output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 8 valid + [] [] [] modulus + modulusScratch (true :: quotient) [] output) = + some (sourceUnaryDivisionConfiguration 8 valid + [] [] [] modulus + modulusScratch quotient [] (true :: output)) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_emitQuotient_finish + (valid : Bool) + (modulus modulusScratch output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 8 valid + [] [] [] modulus + modulusScratch [] [] output) = + some (sourceUnaryDivisionConfiguration 9 valid + [] [] [] modulus + modulusScratch [] [] output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_cleanupModulus_step + (valid : Bool) + (modulus modulusScratch dividend quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 9 valid + [] [] dividend (true :: modulus) + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 9 valid + [] [] dividend modulus + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_cleanupModulus_finish + (valid : Bool) + (modulusScratch dividend quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 9 valid + [] [] dividend [] + modulusScratch quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 10 valid + [] [] dividend [] + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_cleanupScratch_step + (valid : Bool) + (modulusScratch dividend quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 10 valid + [] [] dividend [] + (true :: modulusScratch) quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 10 valid + [] [] dividend [] + modulusScratch quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_cleanupScratch_finish + (valid : Bool) + (dividend quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 10 valid + [] [] dividend [] [] quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 11 valid + [] [] dividend [] [] quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_cleanupDividend_step + (valid : Bool) + (dividend quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 11 valid + [] [] (true :: dividend) [] [] quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 11 valid + [] [] dividend [] [] quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_cleanupDividend_finish + (valid : Bool) + (quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 11 valid + [] [] [] [] [] quotient residueStack output) = + some (sourceUnaryDivisionConfiguration 12 valid + [] [] [] [] [] quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_cleanupPartial_step + (valid : Bool) + (quotient residueStack output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 12 valid + [] [] [] [] [] quotient (true :: residueStack) output) = + some (sourceUnaryDivisionConfiguration 12 valid + [] [] [] [] [] quotient residueStack output) := by + sourceUnaryDivisionStepTac + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivision_cleanupPartial_finish + (valid : Bool) (output : List Bool) : + sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 12 valid + [] [] [] [] [] [] [] output) = + some (Turing.haltList sourceUnaryDivisionMachine output) := by + sourceUnaryDivisionStepTac + +end + +section + +open Turing GapCVP.BinaryEncoding + +/-- GapCVP reduction support. -/ +def sourceUnaryDivisionQuery + (dividend modulus : ℕ) (source : List Bool) : List Bool := + List.replicate dividend true ++ + false :: (List.replicate modulus true ++ false :: source) + +/-- GapCVP reduction support. -/ +def sourceUnaryDivisionOutput (input : List Bool) : List Bool := + match readUnaryPrefix input with + | none => false :: false :: input + | some (dividend, remaining) => + match readUnaryPrefix remaining with + | none => false :: false :: input + | some (modulus, _) => + if modulus = 0 then false :: false :: input + else + List.replicate (dividend / modulus) true ++ + false :: (List.replicate (dividend % modulus) true ++ + false :: input) + +@[simp] theorem sourceUnaryDivisionOutput_valid + (dividend modulus : ℕ) (source : List Bool) + (hmodulus : 0 < modulus) : + sourceUnaryDivisionOutput + (sourceUnaryDivisionQuery dividend modulus source) = + List.replicate (dividend / modulus) true ++ + false :: (List.replicate (dividend % modulus) true ++ + false :: sourceUnaryDivisionQuery dividend modulus source) := by + simp only [sourceUnaryDivisionOutput, sourceUnaryDivisionQuery, readUnaryPrefix_replicate, + Nat.ne_of_gt hmodulus, ↓reduceIte] + +end + +end SourceMixedRadixUnaryQuotientRemainderTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part06C.lean b/LeanPool/GapCVP/Part06C.lean new file mode 100644 index 000000000..cd39accf2 --- /dev/null +++ b/LeanPool/GapCVP/Part06C.lean @@ -0,0 +1,584 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part06B + +/-! # GapCVP proof, part 06, continuation 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceMixedRadixUnaryQuotientRemainderTM + +section + +open Turing GapCVP.BinaryEncoding + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionDividendPrefixTrace + (count : ℕ) (valid : Bool) + (remaining archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 0 valid + (List.replicate count true ++ false :: remaining) + archive dividend modulus modulusScratch + quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 1 valid + remaining (false :: (List.replicate count true ++ archive)) + (List.replicate count true ++ dividend) modulus + modulusScratch quotient residueStack output)) + (count + 1) := by + induction count generalizing archive dividend with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ + (sourceUnaryDivision_dividend_false valid remaining archive dividend modulus + modulusScratch quotient residueStack + output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_dividend_true valid + (List.replicate count true ++ false :: remaining) + archive dividend modulus modulusScratch + quotient residueStack output) + have hremaining := ih (true :: archive) (true :: dividend) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionDividendMissingTrace + (count : ℕ) (valid : Bool) + (archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 0 valid + (List.replicate count true) + archive dividend modulus modulusScratch + quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 2 false + [] (List.replicate count true ++ archive) + (List.replicate count true ++ dividend) + modulus modulusScratch quotient residueStack output)) + (count + 1) := by + induction count generalizing archive dividend with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ + (sourceUnaryDivision_dividend_missing valid archive dividend modulus modulusScratch + quotient residueStack output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_dividend_true valid + (List.replicate count true) archive dividend modulus + modulusScratch quotient residueStack output) + have hremaining := ih (true :: archive) (true :: dividend) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionModulusPrefixTrace + (count : ℕ) (valid : Bool) + (remaining archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 1 valid + (List.replicate count true ++ false :: remaining) + archive dividend modulus modulusScratch + quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 2 valid + remaining (false :: (List.replicate count true ++ archive)) + dividend (List.replicate count true ++ modulus) + modulusScratch quotient residueStack output)) + (count + 1) := by + induction count generalizing archive modulus with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ + (sourceUnaryDivision_modulus_false valid remaining archive dividend modulus + modulusScratch quotient residueStack + output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_modulus_true valid + (List.replicate count true ++ false :: remaining) + archive dividend modulus modulusScratch + quotient residueStack output) + have hremaining := ih (true :: archive) (true :: modulus) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionModulusMissingTrace + (count : ℕ) (valid : Bool) + (archive dividend modulus modulusScratch + quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 1 valid + (List.replicate count true) + archive dividend modulus modulusScratch + quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 2 false + [] (List.replicate count true ++ archive) + dividend (List.replicate count true ++ modulus) + modulusScratch quotient residueStack output)) + (count + 1) := by + induction count generalizing archive modulus with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ + (sourceUnaryDivision_modulus_missing valid archive dividend modulus modulusScratch + quotient residueStack output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_modulus_true valid + (List.replicate count true) archive dividend modulus + modulusScratch quotient residueStack output) + have hremaining := ih (true :: archive) (true :: modulus) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionSuffixTrace + (source archive dividend modulus modulusScratch + quotient residueStack output : List Bool) + (valid : Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 2 valid + source archive dividend modulus + modulusScratch quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 3 valid + [] (source.reverse ++ archive) dividend modulus + modulusScratch quotient residueStack output)) + (source.length + 1) := by + induction source generalizing archive with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ + (sourceUnaryDivision_suffix_finish valid archive dividend modulus modulusScratch + quotient residueStack output) + | cons bit source ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_suffix_step valid bit source archive + dividend modulus modulusScratch quotient residueStack output) + have hremaining := ih (bit :: archive) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionRestoreSourceTrace + (archive dividend modulus modulusScratch + quotient residueStack output : List Bool) + (valid : Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 3 valid + [] archive dividend modulus + modulusScratch quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 4 valid + [] [] dividend modulus + modulusScratch quotient residueStack + (false :: (archive.reverse ++ output)))) + (archive.length + 1) := by + induction archive generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ + (sourceUnaryDivision_restoreSource_finish valid dividend modulus modulusScratch + quotient residueStack output) + | cons bit archive ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_restoreSource_step valid bit archive + dividend modulus modulusScratch quotient residueStack output) + have hremaining := ih (bit :: output) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + +private def sourceUnaryDivision_cleanupModulusTrace + (count : ℕ) (valid : Bool) + (modulusScratch dividend quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 9 valid + [] [] dividend (List.replicate count true) + modulusScratch quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 10 valid + [] [] dividend [] + modulusScratch quotient residueStack output)) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ (sourceUnaryDivision_cleanupModulus_finish valid modulusScratch dividend + quotient residueStack output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_cleanupModulus_step valid + (List.replicate count true) modulusScratch dividend + quotient residueStack output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd] + using + EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst ih + +private def sourceUnaryDivision_cleanupScratchTrace + (count : ℕ) (valid : Bool) + (dividend quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 10 valid + [] [] dividend [] (List.replicate count true) + quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 11 valid + [] [] dividend [] [] quotient residueStack output)) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ (sourceUnaryDivision_cleanupScratch_finish valid dividend quotient + residueStack output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_cleanupScratch_step valid + (List.replicate count true) dividend + quotient residueStack output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd] + using + EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst ih + +private def sourceUnaryDivision_cleanupDividendTrace + (count : ℕ) (valid : Bool) + (quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 11 valid + [] [] (List.replicate count true) [] [] + quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 12 valid + [] [] [] [] [] quotient residueStack output)) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ (sourceUnaryDivision_cleanupDividend_finish valid quotient residueStack + output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_cleanupDividend_step valid + (List.replicate count true) quotient residueStack output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd] + using + EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst ih + +private def sourceUnaryDivision_cleanupPartialTrace + (count : ℕ) (valid : Bool) (output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 12 valid + [] [] [] [] [] [] (List.replicate count true) output) + (some (Turing.haltList sourceUnaryDivisionMachine output)) + (count + 1) := by + induction count with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, zero_add] using + oneStep _ _ (sourceUnaryDivision_cleanupPartial_finish valid output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_cleanupPartial_step valid [] + (List.replicate count true) output) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd] + using + EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst ih + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionCleanupTrace + (modulusCount scratchCount dividendCount residueCount : ℕ) + (valid : Bool) (output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 9 valid + [] [] (List.replicate dividendCount true) + (List.replicate modulusCount true) + (List.replicate scratchCount true) [] + (List.replicate residueCount true) output) + (some (Turing.haltList sourceUnaryDivisionMachine output)) + (modulusCount + scratchCount + dividendCount + residueCount + 4) := by + have hmodulus := sourceUnaryDivision_cleanupModulusTrace + modulusCount valid (List.replicate scratchCount true) + (List.replicate dividendCount true) [] + (List.replicate residueCount true) output + have hscratch := sourceUnaryDivision_cleanupScratchTrace + scratchCount valid (List.replicate dividendCount true) [] + (List.replicate residueCount true) output + have hdividend := sourceUnaryDivision_cleanupDividendTrace + dividendCount valid [] (List.replicate residueCount true) output + have hresidue := sourceUnaryDivision_cleanupPartialTrace + residueCount valid output + have hfirst := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hmodulus hscratch + have hsecond := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hdividend + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hsecond hresidue + exact rebound hfull (by omega) + +private def sourceUnaryDivision_matchFullTrace + (count : ℕ) (valid : Bool) + (remaining modulusScratch quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 5 valid + [] [] (List.replicate count true ++ remaining) + (List.replicate count true) + modulusScratch quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 6 valid + [] [] remaining [] + (List.replicate count true ++ modulusScratch) + quotient + (List.replicate count true ++ residueStack) output)) + (count + 1) := by + induction count generalizing modulusScratch residueStack with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceUnaryDivision_match_full valid remaining modulusScratch quotient + residueStack output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_match_step valid + (List.replicate count true ++ remaining) + (List.replicate count true) + modulusScratch quotient residueStack output) + have hremaining := ih + (true :: modulusScratch) (true :: residueStack) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceUnaryDivision_matchPartialTrace + (count : ℕ) (valid : Bool) + (modulusTail modulusScratch quotient residueStack output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 5 valid + [] [] (List.replicate count true) + (List.replicate count true ++ true :: modulusTail) + modulusScratch quotient residueStack output) + (some (sourceUnaryDivisionConfiguration 7 valid + [] [] [] (true :: modulusTail) + (List.replicate count true ++ modulusScratch) + quotient + (List.replicate count true ++ residueStack) output)) + (count + 1) := by + induction count generalizing modulusScratch residueStack with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceUnaryDivision_match_partial valid modulusTail modulusScratch quotient + residueStack output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_match_step valid + (List.replicate count true) + (List.replicate count true ++ true :: modulusTail) + modulusScratch quotient residueStack output) + have hremaining := ih + (true :: modulusScratch) (true :: residueStack) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, + SourceStructuralDecoder.replicate_true_append_cons, Nat.add_assoc, Nat.reduceAdd] + using hfull + +private def sourceUnaryDivision_restoreModulusTrace + (count : ℕ) (valid : Bool) + (dividend modulus quotient output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 6 valid + [] [] dividend modulus + (List.replicate count true) + quotient (List.replicate count true) output) + (some (sourceUnaryDivisionConfiguration 5 valid + [] [] dividend (List.replicate count true ++ modulus) + [] (true :: quotient) [] output)) + (count + 1) := by + induction count generalizing modulus with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceUnaryDivision_restoreModulus_finish valid dividend modulus quotient + output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_restoreModulus_step valid dividend modulus + (List.replicate count true) quotient + (List.replicate count true) output) + have hremaining := ih (true :: modulus) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceUnaryDivision_emitRemainderTrace + (count : ℕ) (valid : Bool) + (modulus modulusScratch quotient output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 7 valid + [] [] [] modulus modulusScratch + quotient (List.replicate count true) output) + (some (sourceUnaryDivisionConfiguration 8 valid + [] [] [] modulus modulusScratch + quotient [] + (false :: (List.replicate count true ++ output)))) + (count + 1) := by + induction count generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceUnaryDivision_emitRemainder_finish valid modulus modulusScratch + quotient output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_emitRemainder_step valid modulus + modulusScratch quotient (List.replicate count true) output) + have hremaining := ih (true :: output) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +private def sourceUnaryDivision_emitQuotientTrace + (count : ℕ) (valid : Bool) + (modulus modulusScratch output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 8 valid + [] [] [] modulus modulusScratch + (List.replicate count true) [] output) + (some (sourceUnaryDivisionConfiguration 9 valid + [] [] [] modulus modulusScratch [] [] + (List.replicate count true ++ output))) + (count + 1) := by + induction count generalizing output with + | zero => + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using + oneStep _ _ (sourceUnaryDivision_emitQuotient_finish valid modulus modulusScratch output) + | succ count ih => + have hfirst := oneStep _ _ (sourceUnaryDivision_emitQuotient_step valid modulus + modulusScratch (List.replicate count true) output) + have hremaining := ih (true :: output) + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, + SourceStructuralDecoder.replicate_true_append_cons] using hfull + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceUnaryDivisionModuloTrace + (modulus quotientCount remainder previous : ℕ) + (hremainder : remainder < modulus) + (output : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (sourceUnaryDivisionConfiguration 5 true + [] [] + (List.replicate (modulus * quotientCount + remainder) true) + (List.replicate modulus true) [] + (List.replicate previous true) [] output) + (some (Turing.haltList sourceUnaryDivisionMachine + (List.replicate (quotientCount + previous) true ++ + false :: (List.replicate remainder true ++ output)))) + (quotientCount * (2 * modulus + 3) + + 4 * modulus + previous + 12) := by + induction quotientCount generalizing previous with + | zero => + have hsplit : + modulus = remainder + + ((modulus - remainder - 1) + 1) := by omega + have hmodulus : + List.replicate modulus true = + List.replicate remainder true ++ + true :: List.replicate + (modulus - remainder - 1) true := by + conv_lhs => + rw [hsplit, List.replicate_add, List.replicate_succ] + have htail : + true :: List.replicate (modulus - remainder - 1) true = + List.replicate (modulus - remainder) true := by + have hdifference : + modulus - remainder = + (modulus - remainder - 1) + 1 := by omega + conv_rhs => + rw [hdifference, List.replicate_succ] + have hpartial := sourceUnaryDivision_matchPartialTrace + remainder true + (List.replicate (modulus - remainder - 1) true) + [] (List.replicate previous true) [] output + simp only [List.append_nil] at hpartial + rw [← hmodulus] at hpartial + have hemitRemainder := sourceUnaryDivision_emitRemainderTrace + remainder true + (true :: List.replicate (modulus - remainder - 1) true) + (List.replicate remainder true) + (List.replicate previous true) output + have hemitQuotient := sourceUnaryDivision_emitQuotientTrace + previous true + (true :: List.replicate (modulus - remainder - 1) true) + (List.replicate remainder true) + (false :: (List.replicate remainder true ++ output)) + have hcleanup := sourceUnaryDivisionCleanupTrace + (modulus - remainder) remainder 0 0 true + (List.replicate previous true ++ + false :: (List.replicate remainder true ++ output)) + rw [← htail] at hcleanup + have hfirst := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ + hpartial hemitRemainder + have hsecond := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ + hfirst hemitQuotient + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hsecond hcleanup + have hbounded := rebound (newBudget := 0 * (2 * modulus + 3) + + 4 * modulus + previous + 12) + hfull (by omega) + simpa only [FinTM2.step, Fin.isValue, mul_zero, zero_add, zero_mul] using hbounded + | succ quotientCount ih => + have hmatch := sourceUnaryDivision_matchFullTrace + modulus true + (List.replicate + (modulus * quotientCount + remainder) true) + [] (List.replicate previous true) [] output + simp only [List.append_nil] at hmatch + have hrestore := sourceUnaryDivision_restoreModulusTrace + modulus true + (List.replicate + (modulus * quotientCount + remainder) true) + [] (List.replicate previous true) output + simp only [List.append_nil] at hrestore + have hremaining := ih (previous + 1) + have hquotient : + List.replicate (previous + 1) true = + true :: List.replicate previous true := by + simp only [List.replicate_succ] + rw [hquotient] at hremaining + have hfirst := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hmatch hrestore + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hremaining + have hbudget : + (quotientCount * (2 * modulus + 3) + + 4 * modulus + (previous + 1) + 12) + + ((modulus + 1) + (modulus + 1)) ≤ + (quotientCount + 1) * (2 * modulus + 3) + + 4 * modulus + previous + 12 := by + simp only [Nat.add_mul, one_mul] + omega + have hbounded := rebound (newBudget := + (quotientCount + 1) * (2 * modulus + 3) + + 4 * modulus + previous + 12) + hfull hbudget + have hdividend : + modulus * (quotientCount + 1) + remainder = + modulus + (modulus * quotientCount + remainder) := by + simp only [Nat.mul_add, mul_one] + omega + have hresult : + quotientCount + (previous + 1) = + (quotientCount + 1) + previous := by omega + simpa only [Nat.succ_eq_add_one, hdividend, + List.replicate_add, hresult] using hbounded + +end + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceInterpolationRowTM + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceUnaryDivisionQuery_reverse + (dividend modulus : ℕ) (source : List Bool) : + (sourceUnaryDivisionQuery dividend modulus source).reverse = + source.reverse ++ + false :: (List.replicate modulus true ++ + false :: List.replicate dividend true) := by + simp only [sourceUnaryDivisionQuery, List.reverse_append, List.reverse_cons, + List.reverse_replicate, + List.append_assoc, List.cons_append, List.nil_append] + +end + +end SourceMixedRadixUnaryQuotientRemainderTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part06D.lean b/LeanPool/GapCVP/Part06D.lean new file mode 100644 index 000000000..b829950a9 --- /dev/null +++ b/LeanPool/GapCVP/Part06D.lean @@ -0,0 +1,3800 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part06C + +/-! # GapCVP proof, part 06, continuation 04 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceMixedRadixUnaryQuotientRemainderTM + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceInterpolationRowTM + +private def sourceUnaryDivision_delimitedPrefixTrace + (dividend modulus : ℕ) (source : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (Turing.initList sourceUnaryDivisionMachine + (sourceUnaryDivisionQuery dividend modulus source)) + (some (sourceUnaryDivisionConfiguration 4 true + [] [] (List.replicate dividend true) + (List.replicate modulus true) [] [] [] + (false :: sourceUnaryDivisionQuery dividend modulus source))) + (2 * (sourceUnaryDivisionQuery dividend modulus source).length + 2) := by + rw [sourceUnaryDivisionMachine_init] + have hfirst := sourceUnaryDivisionDividendPrefixTrace + dividend true + (List.replicate modulus true ++ false :: source) + [] [] [] [] [] [] [] + have hsecond := sourceUnaryDivisionModulusPrefixTrace + modulus true source + (false :: List.replicate dividend true) + (List.replicate dividend true) [] [] [] [] [] + have hsuffix := sourceUnaryDivisionSuffixTrace + source + (false :: (List.replicate modulus true ++ + false :: List.replicate dividend true)) + (List.replicate dividend true) + (List.replicate modulus true) [] [] [] [] true + have harchive : + source.reverse ++ + (false :: (List.replicate modulus true ++ + false :: List.replicate dividend true)) = + (sourceUnaryDivisionQuery dividend modulus source).reverse := by + symm + exact sourceUnaryDivisionQuery_reverse dividend modulus source + rw [harchive] at hsuffix + have hrestore := sourceUnaryDivisionRestoreSourceTrace + (sourceUnaryDivisionQuery dividend modulus source).reverse + (List.replicate dividend true) + (List.replicate modulus true) [] [] [] [] true + simp only [List.append_nil] at hfirst hsecond hsuffix + simp only [List.append_nil, List.reverse_reverse, + List.length_reverse] at hrestore + have hparsed := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hsecond + have harchived := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hparsed hsuffix + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ harchived hrestore + have hlength : + (sourceUnaryDivisionQuery dividend modulus source).length = + dividend + modulus + source.length + 2 := by + simp only [sourceUnaryDivisionQuery, List.length_append, List.length_replicate, + List.length_cons] + omega + have hbounded := rebound (newBudget := + 2 * (sourceUnaryDivisionQuery dividend modulus source).length + 2) + hfull (by + simp only [hlength] + omega) + simpa only [sourceUnaryDivisionQuery] using hbounded + +private noncomputable def sourceUnaryDivisionTimePolynomial : Polynomial ℕ := + 4 * Polynomial.X ^ 2 + 20 * Polynomial.X + 30 + +private noncomputable def sourceUnaryDivision_validOriginalTrace + (dividend modulus : ℕ) (source : List Bool) + (hmodulus : 0 < modulus) : + EvalsToInTime sourceUnaryDivisionMachine.step (Turing.initList sourceUnaryDivisionMachine + (sourceUnaryDivisionQuery dividend modulus source)) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput + (sourceUnaryDivisionQuery dividend modulus source)))) + (sourceUnaryDivisionTimePolynomial.eval + (sourceUnaryDivisionQuery dividend modulus source).length) := by + let input := sourceUnaryDivisionQuery dividend modulus source + have hprefix := sourceUnaryDivision_delimitedPrefixTrace + dividend modulus source + have hmodulusWord : + List.replicate modulus true = + true :: List.replicate (modulus - 1) true := by + have hdecompose : modulus = (modulus - 1) + 1 := by omega + conv_lhs => rw [hdecompose, List.replicate_succ] + have hdispatch := oneStep _ _ (sourceUnaryDivision_dispatch_valid + (List.replicate (modulus - 1) true) + (List.replicate dividend true) [] [] [] + (false :: input)) + rw [← hmodulusWord] at hdispatch + have hremaining : dividend % modulus < modulus := + Nat.mod_lt dividend hmodulus + have harithmetic : + modulus * (dividend / modulus) + dividend % modulus = + dividend := by + have h := Nat.mod_add_div dividend modulus + omega + have hmodulo := sourceUnaryDivisionModuloTrace + modulus (dividend / modulus) (dividend % modulus) + 0 hremaining (false :: input) + simp only [Nat.add_zero, List.replicate_zero] at hmodulo + rw [harithmetic] at hmodulo + change EvalsToInTime sourceUnaryDivisionMachine.step + (Turing.initList sourceUnaryDivisionMachine input) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput input))) + (sourceUnaryDivisionTimePolynomial.eval input.length) + have hfirst := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hprefix hdispatch + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hmodulo + have hinputLength : + input.length = dividend + modulus + source.length + 2 := by + simp only [sourceUnaryDivisionQuery, List.length_append, List.length_replicate, + List.length_cons, input] + omega + have hdividend : dividend ≤ input.length := by + rw [hinputLength] + omega + have hwidth : modulus ≤ input.length := by + rw [hinputLength] + omega + have hquotient : dividend / modulus ≤ input.length := + (Nat.div_le_self dividend modulus).trans hdividend + have hproduct : + (dividend / modulus) * (2 * modulus + 3) ≤ + input.length * (2 * input.length + 3) := + Nat.mul_le_mul hquotient (by omega) + have hbound : + ((dividend / modulus) * (2 * modulus + 3) + + 4 * modulus + 0 + 12) + + (1 + (2 * input.length + 2)) ≤ + sourceUnaryDivisionTimePolynomial.eval input.length := by + simp only [add_zero, sourceUnaryDivisionTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X] + nlinarith + have hbounded := rebound hfull hbound + have houtput := sourceUnaryDivisionOutput_valid + dividend modulus source hmodulus + change sourceUnaryDivisionOutput input = _ at houtput + rw [houtput] + exact hbounded + +private noncomputable def sourceUnaryDivision_zeroModulusTrace + (dividend : ℕ) (source : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (Turing.initList sourceUnaryDivisionMachine + (sourceUnaryDivisionQuery dividend 0 source)) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput + (sourceUnaryDivisionQuery dividend 0 source)))) + (sourceUnaryDivisionTimePolynomial.eval + (sourceUnaryDivisionQuery dividend 0 source).length) := by + let input := sourceUnaryDivisionQuery dividend 0 source + have hprefix := sourceUnaryDivision_delimitedPrefixTrace + dividend 0 source + have hdispatch := oneStep _ _ (sourceUnaryDivision_dispatch_zero + (List.replicate dividend true) [] [] [] + (false :: input)) + have hcleanup := sourceUnaryDivisionCleanupTrace + 0 0 dividend 0 true (false :: false :: input) + have hfirst := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hprefix hdispatch + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hcleanup + have hlength : dividend ≤ input.length := by + simp only [sourceUnaryDivisionQuery, List.replicate_zero, List.nil_append, List.length_append, + List.length_replicate, List.length_cons, le_add_iff_nonneg_right, zero_le, input] + have hbound : + (0 + 0 + dividend + 0 + 4) + + (1 + (2 * input.length + 2)) ≤ + sourceUnaryDivisionTimePolynomial.eval input.length := by + simp only [add_zero, zero_add, sourceUnaryDivisionTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X] + nlinarith + have hbounded := rebound hfull hbound + change EvalsToInTime sourceUnaryDivisionMachine.step + (Turing.initList sourceUnaryDivisionMachine input) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput input))) + (sourceUnaryDivisionTimePolynomial.eval input.length) + have houtput : sourceUnaryDivisionOutput input = + false :: false :: input := by + simp only [sourceUnaryDivisionOutput, sourceUnaryDivisionQuery, List.replicate_zero, + List.nil_append, + readUnaryPrefix_replicate, readUnaryPrefix, ↓reduceIte, input] + rw [houtput] + exact hbounded + +private noncomputable def sourceUnaryDivision_missingFirstTrace + (count : ℕ) : + EvalsToInTime sourceUnaryDivisionMachine.step (Turing.initList sourceUnaryDivisionMachine + (List.replicate count true)) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput + (List.replicate count true)))) + (sourceUnaryDivisionTimePolynomial.eval count) := by + rw [sourceUnaryDivisionMachine_init] + let input := List.replicate count true + have hfirst := sourceUnaryDivisionDividendMissingTrace + count true [] [] [] [] [] [] [] + simp only [List.append_nil] at hfirst + have hsuffix := sourceUnaryDivisionSuffixTrace + [] (List.replicate count true) + (List.replicate count true) [] [] [] [] [] false + simp only [List.reverse_nil, List.nil_append] at hsuffix + have hrestore := sourceUnaryDivisionRestoreSourceTrace + (List.replicate count true) + (List.replicate count true) [] [] [] [] [] false + simp only [List.reverse_replicate, List.append_nil] at hrestore + have hdispatch := oneStep _ _ (sourceUnaryDivision_dispatch_invalid + (List.replicate count true) [] [] [] [] + (false :: input)) + have hcleanup := sourceUnaryDivisionCleanupTrace + 0 0 count 0 false (false :: false :: input) + have harchived := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hsuffix + have hrestored := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ harchived + hrestore + have hfailed := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hrestored hdispatch + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfailed hcleanup + simp only [List.length_replicate, List.length_nil] at hfull + have hbound : + (0 + 0 + count + 0 + 4) + + (1 + ((count + 1) + (1 + (count + 1)))) ≤ + sourceUnaryDivisionTimePolynomial.eval count := by + simp only [add_zero, zero_add, sourceUnaryDivisionTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X] + nlinarith + have hbounded := rebound hfull hbound + have houtput : sourceUnaryDivisionOutput input = + false :: false :: input := by + simp only [sourceUnaryDivisionOutput, SourceTotalStructuralDecoder.readUnaryPrefix_missing, + input] + change EvalsToInTime sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 0 true + input [] [] [] [] [] [] []) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput input))) + (sourceUnaryDivisionTimePolynomial.eval count) + rw [houtput] + exact hbounded + +private def sourceUnaryDivisionMissingModulusQuery + (dividend markerCount : ℕ) : List Bool := + List.replicate dividend true ++ + false :: List.replicate markerCount true + +private theorem sourceUnaryDivisionMissingModulusQuery_reverse + (dividend markerCount : ℕ) : + (sourceUnaryDivisionMissingModulusQuery + dividend markerCount).reverse = + List.replicate markerCount true ++ + false :: List.replicate dividend true := by + simp only [sourceUnaryDivisionMissingModulusQuery, List.reverse_append, List.reverse_cons, + List.reverse_replicate, List.append_assoc, List.cons_append, List.nil_append] + +private noncomputable def sourceUnaryDivision_missingSecondTrace + (dividend markerCount : ℕ) : + EvalsToInTime sourceUnaryDivisionMachine.step (Turing.initList sourceUnaryDivisionMachine + (sourceUnaryDivisionMissingModulusQuery + dividend markerCount)) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput + (sourceUnaryDivisionMissingModulusQuery + dividend markerCount)))) + (sourceUnaryDivisionTimePolynomial.eval + (sourceUnaryDivisionMissingModulusQuery + dividend markerCount).length) := by + rw [sourceUnaryDivisionMachine_init] + let input := sourceUnaryDivisionMissingModulusQuery + dividend markerCount + have hfirst := sourceUnaryDivisionDividendPrefixTrace + dividend true (List.replicate markerCount true) + [] [] [] [] [] [] [] + have hsecond := sourceUnaryDivisionModulusMissingTrace + markerCount true + (false :: List.replicate dividend true) + (List.replicate dividend true) [] [] [] [] [] + simp only [List.append_nil] at hfirst hsecond + have hreverse : + List.replicate markerCount true ++ + false :: List.replicate dividend true = input.reverse := by + simpa only using (sourceUnaryDivisionMissingModulusQuery_reverse dividend markerCount).symm + rw [hreverse] at hsecond + have hsuffix := sourceUnaryDivisionSuffixTrace + [] input.reverse + (List.replicate dividend true) + (List.replicate markerCount true) [] [] [] [] false + simp only [List.reverse_nil, List.nil_append] at hsuffix + have hrestore := sourceUnaryDivisionRestoreSourceTrace + input.reverse (List.replicate dividend true) + (List.replicate markerCount true) [] [] [] [] false + simp only [List.reverse_reverse, List.append_nil, + List.length_reverse] at hrestore + have hdispatch := oneStep _ _ (sourceUnaryDivision_dispatch_invalid + (List.replicate dividend true) + (List.replicate markerCount true) [] [] [] + (false :: input)) + have hcleanup := sourceUnaryDivisionCleanupTrace + markerCount 0 dividend 0 false + (false :: false :: input) + have hfirstPair := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirst hsecond + have harchived := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfirstPair + hsuffix + have hrestored := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ harchived + hrestore + have hfailed := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hrestored hdispatch + have hfull := EvalsToInTime.trans sourceUnaryDivisionMachine.step _ _ _ _ _ hfailed hcleanup + have hlength : input.length = dividend + markerCount + 1 := by + simp only [sourceUnaryDivisionMissingModulusQuery, List.length_append, List.length_replicate, + List.length_cons, input] + omega + have hbound : + (markerCount + 0 + dividend + 0 + 4) + + (1 + ((input.length + 1) + + (1 + ((markerCount + 1) + (dividend + 1))))) ≤ + sourceUnaryDivisionTimePolynomial.eval input.length := by + simp only [add_zero, sourceUnaryDivisionTimePolynomial, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X] + nlinarith + have hbounded := rebound hfull hbound + have houtput : sourceUnaryDivisionOutput input = + false :: false :: input := by + simp only [sourceUnaryDivisionOutput, sourceUnaryDivisionMissingModulusQuery, + readUnaryPrefix_replicate, + SourceTotalStructuralDecoder.readUnaryPrefix_missing, input] + change EvalsToInTime sourceUnaryDivisionMachine.step + (sourceUnaryDivisionConfiguration 0 true + input [] [] [] [] [] [] []) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput input))) + (sourceUnaryDivisionTimePolynomial.eval input.length) + rw [houtput] + exact hbounded + +private noncomputable def sourceUnaryDivision_totalTrace + (input : List Bool) : + EvalsToInTime sourceUnaryDivisionMachine.step (Turing.initList sourceUnaryDivisionMachine + input) + (some (Turing.haltList sourceUnaryDivisionMachine + (sourceUnaryDivisionOutput input))) + (sourceUnaryDivisionTimePolynomial.eval input.length) := by + cases hfirst : readUnaryPrefix input with + | none => + have hshape := readUnaryPrefix_none_eq_replicate input hfirst + have htrace := sourceUnaryDivision_missingFirstTrace input.length + rw [← hshape] at htrace + exact htrace + | some first => + obtain ⟨dividend, remaining⟩ := first + have hinput := readUnaryPrefix_some_decompose + input dividend remaining hfirst + cases hsecond : readUnaryPrefix remaining with + | none => + have hremaining := + readUnaryPrefix_none_eq_replicate remaining hsecond + have hquery : + input = sourceUnaryDivisionMissingModulusQuery + dividend remaining.length := by + calc + input = + List.replicate dividend true ++ false :: remaining := + hinput + _ = List.replicate dividend true ++ + false :: List.replicate remaining.length true := + congrArg + (fun tail : List Bool => + List.replicate dividend true ++ false :: tail) + hremaining + _ = sourceUnaryDivisionMissingModulusQuery + dividend remaining.length := rfl + simpa only [hquery] using + sourceUnaryDivision_missingSecondTrace + dividend remaining.length + | some second => + obtain ⟨modulus, source⟩ := second + have hremaining := readUnaryPrefix_some_decompose + remaining modulus source hsecond + have hquery : + input = sourceUnaryDivisionQuery + dividend modulus source := by + rw [hinput, hremaining] + rfl + cases modulus with + | zero => + simpa only [hquery] using + sourceUnaryDivision_zeroModulusTrace dividend source + | succ modulus => + simpa only [hquery] using + sourceUnaryDivision_validOriginalTrace + dividend (modulus + 1) source + (Nat.zero_lt_succ modulus) + +/-- GapCVP reduction support. -/ +noncomputable def sourceUnaryDivisionComputable : + BitTM sourceUnaryDivisionOutput where + tm := sourceUnaryDivisionMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := sourceUnaryDivisionTimePolynomial + outputsFun input := { + steps := (sourceUnaryDivision_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, Option.map_some] using + (sourceUnaryDivision_totalTrace input).evals_in_steps + steps_le_m := by + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq] using + (sourceUnaryDivision_totalTrace input).steps_le_m + } + +end + +end SourceMixedRadixUnaryQuotientRemainderTM + +namespace SourceMixedRadixDimensionRowMajorIndexTM + +open Turing GapCVP.SourceStructuralTuringTM GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceMixedRadixUnaryQuotientRemainderTM + +private def sourceMixedRadixBlockDimensionPrefixOutput + (input : List Bool) : List Bool := + (unaryPrefixOutput input).tail + +private noncomputable def sourceMixedRadixBlockDimensionPrefixComputable : + BitTM + sourceMixedRadixBlockDimensionPrefixOutput := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + unaryPrefixComputable dropHeadComputable + change BitTM + (fun input => (unaryPrefixOutput input).tail) + simpa only [Function.comp_def] using hphysical + +@[simp] private theorem sourceMixedRadixBlockDimensionPrefixOutput_valid + (dimension : ℕ) (source : List Bool) : + sourceMixedRadixBlockDimensionPrefixOutput + (List.replicate dimension true ++ false :: source) = + List.replicate dimension true := by + unfold sourceMixedRadixBlockDimensionPrefixOutput + rw [unaryPrefixOutput_replicate_delimiter] + rfl + +/-- GapCVP reduction support. -/ +def sourceMixedRadixRowMajorPairOutput : List Bool → List Bool := + sourceUnaryDivisionOutput + +/-- GapCVP reduction support. -/ +noncomputable def sourceMixedRadixRowMajorPairComputable : + BitTM + sourceMixedRadixRowMajorPairOutput := + sourceUnaryDivisionComputable + +@[simp] theorem sourceMixedRadixRowMajorPairOutput_valid + (rank dimension : ℕ) (source : List Bool) + (hdimension : 0 < dimension) : + sourceMixedRadixRowMajorPairOutput + (sourceUnaryDivisionQuery rank dimension source) = + List.replicate (rank / dimension) true ++ + false :: (List.replicate (rank % dimension) true ++ + false :: sourceUnaryDivisionQuery rank dimension source) := by + exact sourceUnaryDivisionOutput_valid + rank dimension source hdimension + +end SourceMixedRadixDimensionRowMajorIndexTM + +namespace SourceMixedRadixOriginalSourceDescriptorRotationTM + +open Turing GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder + +/-- GapCVP reduction support. -/ +def sourceMixedRadixGuardedOriginalAtomOutput + (atom : List Bool → List Bool) : List Bool → List Bool := + atom ∘ firstFieldContents + +/-- GapCVP reduction support. -/ +noncomputable def sourceMixedRadixGuardedOriginalAtomComputable + {atom : List Bool → List Bool} + (computer : BitTM atom) : + BitTM + (sourceMixedRadixGuardedOriginalAtomOutput atom) := + GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable computer + +/-- GapCVP reduction support. -/ +def sourceMixedRadixOriginalSourceQueryStream + (queries : List (List Bool)) : List Bool := + queries.flatMap lengthPrefixedWord + +end SourceMixedRadixOriginalSourceDescriptorRotationTM + +namespace SourceMixedRadixPolynomialPaddedDescriptorFoldTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.FormulaSemanticCert +open GapCVP.SourceTotalStructuralDecoder GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceWholeOutputAssemblyTM + +theorem sourceMixedRadixPhysicalFirstFieldContents_length_le + (input : List Bool) : + (firstFieldContents input).length ≤ input.length := by + cases hread : readLengthPrefixedWord input with + | none => + simp only [firstFieldContents, payloadDecodeOutput, hread, List.tail_cons, List.length_nil, + zero_le] + | some parsed => + obtain ⟨payload, suffix⟩ := parsed + have hreconstruct := readLengthPrefixedWord_some_reconstruct + input payload suffix hread + simp only [firstFieldContents, payloadDecodeOutput, hread, + List.tail_cons] + rw [hreconstruct] + simp only [List.length_append, lengthPrefixedWord_length] + omega + +theorem sourceMixedRadixPhysicalFirstFieldSuffix_length_le + (input : List Bool) : + (firstFieldSuffix input).length ≤ input.length := by + cases hread : readLengthPrefixedWord input with + | none => + simp only [firstFieldSuffix, hread, List.length_nil, zero_le] + | some parsed => + obtain ⟨payload, suffix⟩ := parsed + have hreconstruct := readLengthPrefixedWord_some_reconstruct + input payload suffix hread + simp only [firstFieldSuffix, hread] + rw [hreconstruct] + simp only [List.length_append, lengthPrefixedWord_length] + omega + +end SourceMixedRadixPolynomialPaddedDescriptorFoldTM + +namespace SourceIndexedClauseLookupTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceMixedRadixDimensionRowMajorIndexTM +open GapCVP.SourceMixedRadixPolynomialPaddedDescriptorFoldTM +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFCappedUnaryPairArithmeticTM GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +def sourceOriginalIndexedClauseQuery + (index : ℕ) (formula : ThreeCNF) : List Bool := + List.replicate index true ++ false :: encodeThreeCNF formula + +private def sourceOriginalIndexedClauseCounterWord + (input : List Bool) : List Bool := + sourceMixedRadixBlockDimensionPrefixOutput input ++ [false] + +private noncomputable def sourceOriginalIndexedClauseCounterComputable : + BitTM + sourceOriginalIndexedClauseCounterWord := by + have hphysical := pointwiseAppendComputable + sourceMixedRadixBlockDimensionPrefixComputable + (sourceFixedWordComputable [false]) + exact hphysical + +private def sourceOriginalIndexedClauseBodyWord + (input : List Bool) : List Bool := + firstFieldSuffix (unaryPrefixSuffixOutput input) + +private noncomputable def sourceOriginalIndexedClauseBodyComputable : + BitTM + sourceOriginalIndexedClauseBodyWord := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + actualUnaryPrefixSuffixComputable firstFieldSuffixComputable + change BitTM + (fun input => firstFieldSuffix (unaryPrefixSuffixOutput input)) + simpa only [Function.comp_def] using hphysical + +private def sourceOriginalIndexedClauseSkipPreparation + (input : List Bool) : List Bool := + sourceOriginalIndexedClauseCounterWord input ++ + sourceOriginalIndexedClauseBodyWord input + +private noncomputable def sourceOriginalIndexedClauseSkipPreparationComputable : + BitTM + sourceOriginalIndexedClauseSkipPreparation := + pointwiseAppendComputable + sourceOriginalIndexedClauseCounterComputable + sourceOriginalIndexedClauseBodyComputable + +@[simp] private theorem sourceOriginalIndexedClauseSkipPreparation_valid + (index : ℕ) (formula : ThreeCNF) : + sourceOriginalIndexedClauseSkipPreparation + (sourceOriginalIndexedClauseQuery index formula) = + unaryBoundedFoldWord index + (formula.flatMap encodeThreeClause) := by + simp only [sourceOriginalIndexedClauseSkipPreparation, sourceOriginalIndexedClauseCounterWord, + sourceOriginalIndexedClauseQuery, sourceMixedRadixBlockDimensionPrefixOutput_valid, + sourceOriginalIndexedClauseBodyWord, unaryPrefixSuffixOutput_valid, + firstFieldSuffix_encodeThreeCNF, + List.append_assoc, List.cons_append, List.nil_append, unaryBoundedFoldWord] + +theorem sourceOriginalIndexedLiteralSuffix_length_le + (input : List Bool) : + (literalSuffix input).length ≤ input.length := by + have hsuffix := sourceMixedRadixPhysicalFirstFieldSuffix_length_le input + unfold literalSuffix + change (firstFieldSuffix input).tail.length ≤ input.length + cases hfield : firstFieldSuffix input with + | nil => simp only [List.tail_nil, List.length_nil, zero_le] + | cons bit remaining => + simp only [hfield, List.tail_cons] at hsuffix ⊢ + simp only [List.length_cons] at hsuffix + omega + +theorem sourceOriginalIndexedClauseSuffix_length_le + (input : List Bool) : + (clauseSuffix input).length ≤ input.length := by + change + (literalSuffix (literalSuffix (literalSuffix input))).length ≤ + input.length + exact + (sourceOriginalIndexedLiteralSuffix_length_le _).trans + ((sourceOriginalIndexedLiteralSuffix_length_le _).trans + (sourceOriginalIndexedLiteralSuffix_length_le input)) + +private theorem sourceOriginalIndexedClauseSuffix_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates clauseSuffix Polynomial.X := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage _ + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + have hiterate : ∀ number : ℕ, + ((clauseSuffix^[number]) seed).length ≤ seed.length := by + intro number + induction number with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ number ih => + rw [Function.iterate_succ_apply'] + exact (sourceOriginalIndexedClauseSuffix_length_le _).trans ih + simpa only [Polynomial.eval_X, ge_iff_le] using (hiterate stage).trans hseed + +private noncomputable def sourceOriginalIndexedClauseSkipFoldComputable : + BitTM + (boundedRecordFoldOutput clauseSuffix) := + boundedDependentRecordFoldComputable clauseSuffixComputable + Polynomial.X + sourceOriginalIndexedClauseSuffix_polynomiallyBoundedFoldStates + +private def sourceOriginalIndexedClauseTailOutput : List Bool → List Bool := + boundedRecordFoldOutput clauseSuffix ∘ + sourceOriginalIndexedClauseSkipPreparation + +private noncomputable def sourceOriginalIndexedClauseTailComputable : + BitTM + sourceOriginalIndexedClauseTailOutput := + GapCVP.TMComposition.computableInPolyTime + sourceOriginalIndexedClauseSkipPreparationComputable + sourceOriginalIndexedClauseSkipFoldComputable + +private theorem sourceOriginalIndexedClauseSuffix_iterate_body + (formula : ThreeCNF) (index : ℕ) : + ((clauseSuffix^[index]) + (formula.flatMap encodeThreeClause)) = + (formula.drop index).flatMap encodeThreeClause := by + induction index generalizing formula with + | zero => simp only [Function.iterate_zero, id_eq, List.drop_zero] + | succ index ih => + cases formula with + | nil => + rw [Function.iterate_succ_apply] + change ((clauseSuffix^[index]) []) = [] + simpa only [List.flatMap_nil, List.drop_nil] using ih [] + | cons clause remaining => + rw [Function.iterate_succ_apply] + simp only [List.flatMap_cons] + rw [clauseSuffix_valid] + simpa only [List.drop_succ_cons] using ih remaining + +@[simp] private theorem sourceOriginalIndexedClauseTailOutput_valid + (index : ℕ) (formula : ThreeCNF) : + sourceOriginalIndexedClauseTailOutput + (sourceOriginalIndexedClauseQuery index formula) = + (formula.drop index).flatMap encodeThreeClause := by + unfold sourceOriginalIndexedClauseTailOutput + rw [Function.comp_apply, + sourceOriginalIndexedClauseSkipPreparation_valid] + simp only [boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + exact sourceOriginalIndexedClauseSuffix_iterate_body + formula index + +/-- GapCVP reduction support. -/ +def sourceOriginalIndexedLiteralSignOutput + (input : List Bool) : List Bool := + markerConditionalOutput + (fun _ : List Bool => [true]) [false] + (firstFieldSuffix input) + +/-- GapCVP reduction support. -/ +noncomputable def sourceOriginalIndexedLiteralSignComputable : + BitTM + sourceOriginalIndexedLiteralSignOutput := by + have hsign := markerConditionalComputable + (sourceFixedWordComputable [true]) [false] + have hphysical := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable hsign + change BitTM + (fun input => markerConditionalOutput + (fun _ : List Bool => [true]) [false] + (firstFieldSuffix input)) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def sourceOriginalIndexedLiteralVariableOutput + (input : List Bool) : List Bool := + lengthPrefixedWord (firstFieldContents input) + +private noncomputable def sourceOriginalIndexedLiteralVariableComputable : + BitTM + sourceOriginalIndexedLiteralVariableOutput := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable structuralPrefixWriterComputable + change BitTM + (fun input => lengthPrefixedWord (firstFieldContents input)) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def sourceOriginalIndexedPhysicalLiteralOutput + (input : List Bool) : List Bool := + sourceOriginalIndexedLiteralVariableOutput input ++ + sourceOriginalIndexedLiteralSignOutput input + +/-- GapCVP reduction support. -/ +noncomputable def sourceOriginalIndexedPhysicalLiteralComputable : + BitTM + sourceOriginalIndexedPhysicalLiteralOutput := + pointwiseAppendComputable + sourceOriginalIndexedLiteralVariableComputable + sourceOriginalIndexedLiteralSignComputable + +@[simp] theorem sourceOriginalIndexedPhysicalLiteralOutput_valid + (literal : Literal) (suffix : List Bool) : + sourceOriginalIndexedPhysicalLiteralOutput + (encodeLiteral literal ++ suffix) = + encodeLiteral literal := by + rcases literal with ⟨variableIndex, sign⟩ + cases sign <;> + simp [sourceOriginalIndexedPhysicalLiteralOutput, + sourceOriginalIndexedLiteralVariableOutput, + sourceOriginalIndexedLiteralSignOutput, + encodeLiteral, markerConditionalOutput, + firstFieldContents_valid, firstFieldSuffix_valid, + List.append_assoc] + +/-- GapCVP reduction support. -/ +def sourceOriginalIndexedSecondLiteralOutput : List Bool → List Bool := + sourceOriginalIndexedPhysicalLiteralOutput ∘ literalSuffix + +private noncomputable def sourceOriginalIndexedSecondLiteralComputable : + BitTM + sourceOriginalIndexedSecondLiteralOutput := + GapCVP.TMComposition.computableInPolyTime + literalSuffixComputable + sourceOriginalIndexedPhysicalLiteralComputable + +/-- GapCVP reduction support. -/ +def sourceOriginalIndexedThirdLiteralOutput : List Bool → List Bool := + sourceOriginalIndexedPhysicalLiteralOutput ∘ + (literalSuffix ∘ literalSuffix) + +private noncomputable def sourceOriginalIndexedThirdLiteralComputable : + BitTM + sourceOriginalIndexedThirdLiteralOutput := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + literalSuffixComputable literalSuffixComputable) + sourceOriginalIndexedPhysicalLiteralComputable + +/-- GapCVP reduction support. -/ +def sourceOriginalIndexedPhysicalThreeClauseOutput + (input : List Bool) : List Bool := + sourceOriginalIndexedPhysicalLiteralOutput input ++ + (sourceOriginalIndexedSecondLiteralOutput input ++ + sourceOriginalIndexedThirdLiteralOutput input) + +/-- GapCVP reduction support. -/ +noncomputable def sourceOriginalIndexedPhysicalThreeClauseComputable : + BitTM + sourceOriginalIndexedPhysicalThreeClauseOutput := + pointwiseAppendComputable + sourceOriginalIndexedPhysicalLiteralComputable + (pointwiseAppendComputable + sourceOriginalIndexedSecondLiteralComputable + sourceOriginalIndexedThirdLiteralComputable) + +@[simp] theorem sourceOriginalIndexedPhysicalThreeClauseOutput_valid + (clause : ThreeClause) (suffix : List Bool) : + sourceOriginalIndexedPhysicalThreeClauseOutput + (encodeThreeClause clause ++ suffix) = + encodeThreeClause clause := by + simp only [sourceOriginalIndexedPhysicalThreeClauseOutput, encodeThreeClause, Fin.isValue, + List.append_assoc, + sourceOriginalIndexedPhysicalLiteralOutput_valid, sourceOriginalIndexedSecondLiteralOutput, + Function.comp_apply, + literalSuffix_valid, sourceOriginalIndexedThirdLiteralOutput] + +/-- GapCVP reduction support. -/ +def sourceOriginalIndexedClauseOutput : List Bool → List Bool := + sourceOriginalIndexedPhysicalThreeClauseOutput ∘ + sourceOriginalIndexedClauseTailOutput + +/-- GapCVP reduction support. -/ +noncomputable def sourceOriginalIndexedClauseComputable : + BitTM + sourceOriginalIndexedClauseOutput := + GapCVP.TMComposition.computableInPolyTime + sourceOriginalIndexedClauseTailComputable + sourceOriginalIndexedPhysicalThreeClauseComputable + +theorem sourceOriginalIndexedClauseOutput_valid + (index : ℕ) (formula : ThreeCNF) + (hindex : index < formula.length) : + sourceOriginalIndexedClauseOutput + (sourceOriginalIndexedClauseQuery index formula) = + encodeThreeClause (formula.get ⟨index, hindex⟩) := by + unfold sourceOriginalIndexedClauseOutput + rw [Function.comp_apply, + sourceOriginalIndexedClauseTailOutput_valid] + have hdrop := List.drop_eq_getElem_cons hindex + rw [hdrop] + simp only [List.flatMap_cons] + rw [sourceOriginalIndexedPhysicalThreeClauseOutput_valid] + simp only [List.get_eq_getElem] + +end SourceIndexedClauseLookupTM + +namespace SourceIndexedClauseSignTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputPolynomialCompositionClosure GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceIndexedClauseLookupTM + +@[simp] theorem sourceOriginalIndexedLiteralSignOutput_valid + (literal : Literal) (suffix : List Bool) : + sourceOriginalIndexedLiteralSignOutput + (encodeLiteral literal ++ suffix) = [literal.2] := by + rcases literal with ⟨variableIndex, sign⟩ + cases sign <;> + simp [sourceOriginalIndexedLiteralSignOutput, + encodeLiteral, markerConditionalOutput, + firstFieldSuffix_valid, List.append_assoc] + +/-- GapCVP reduction support. -/ +def sourceOriginalClauseBooleanUnaryOutput : List Bool → List Bool := + markerConditionalOutput + (fun _ : List Bool => [true]) [] + +/-- GapCVP reduction support. -/ +noncomputable def sourceOriginalClauseBooleanUnaryComputable : + BitTM + sourceOriginalClauseBooleanUnaryOutput := + markerConditionalComputable + (sourceFixedWordComputable [true]) [] + +@[simp] theorem sourceOriginalClauseBooleanUnaryOutput_bit + (sign : Bool) : + sourceOriginalClauseBooleanUnaryOutput [sign] = + List.replicate (if sign then 1 else 0) true := by + cases sign <;> rfl + +end SourceIndexedClauseSignTM + +namespace SourceAnchoredGridRecordFoldTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.FormulaSemanticCert +open GapCVP.SourceFormulaStructuralDecoder GapCVP.OutputPolynomialCompositionClosure +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceOriginalSourcePreservingTM +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceMixedRadixPolynomialPaddedDescriptorFoldTM +open GapCVP.CLStructuralAtomicNaturalWriter GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFEncodedClauseSort GapCVP.CNFNaturalOrderComparator +open GapCVP.CNFNaturalOrderCertifiedComparator GapCVP.CNFGuardedFiveFamilyTagDispatchTM +open GapCVP.CNFFlatAdjacentRecordSwapTM GapCVP.CNFFlatAdjacentRecordSwapTotalCert +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +def sourceAnchoredGridRankSourcePair (input : List Bool) : List Bool := + lengthPrefixedWord (firstFieldContents (firstFieldSuffix input)) ++ + firstFieldContents input + +private noncomputable def sourceAnchoredGridRankSourcePairComputable : + BitTM + sourceAnchoredGridRankSourcePair := by + have hrank := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + have hprefix := GapCVP.TMComposition.computableInPolyTime + hrank structuralPrefixWriterComputable + exact pointwiseAppendComputable hprefix firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def sourceAnchoredGridRawCandidate + (candidate : List Bool → List Bool) + (input : List Bool) : List Bool := + candidate (sourceAnchoredGridRankSourcePair input) + +private noncomputable def sourceAnchoredGridRawCandidateComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceAnchoredGridRawCandidate candidate) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + sourceAnchoredGridRankSourcePairComputable computer + change BitTM + (fun input => candidate (sourceAnchoredGridRankSourcePair input)) + simpa only [Function.comp_def] using hphysical + +private def sourceAnchoredGridAvailableRecord (input : List Bool) : List Bool := + structuralAtomicNaturalWord (firstFieldContents input) + +private noncomputable def sourceAnchoredGridAvailableRecordComputable : + BitTM + sourceAnchoredGridAvailableRecord := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable structuralAtomicNaturalWriterComputable + change BitTM + (fun input => structuralAtomicNaturalWord (firstFieldContents input)) + simpa only [Function.comp_def] using hphysical + +private def sourceAnchoredGridRequiredRecord + (candidate : List Bool → List Bool) + (input : List Bool) : List Bool := + structuralAtomicNaturalWord (sourceAnchoredGridRawCandidate candidate input) + +private noncomputable def sourceAnchoredGridRequiredRecordComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceAnchoredGridRequiredRecord candidate) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (sourceAnchoredGridRawCandidateComputable computer) + structuralAtomicNaturalWriterComputable + change BitTM + (fun input => structuralAtomicNaturalWord + (sourceAnchoredGridRawCandidate candidate input)) + simpa only [Function.comp_def] using hphysical + +private def sourceAnchoredGridComparisonInput + (candidate : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceAnchoredGridAvailableRecord input ++ + sourceAnchoredGridRequiredRecord candidate input + +private noncomputable def sourceAnchoredGridComparisonInputComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceAnchoredGridComparisonInput candidate) := + pointwiseAppendComputable + sourceAnchoredGridAvailableRecordComputable + (sourceAnchoredGridRequiredRecordComputable computer) + +/-- GapCVP reduction support. -/ +def sourceAnchoredGridCandidateSelector + (candidate : List Bool → List Bool) + (input : List Bool) : Bool := + encodedWordOrderingFirst + (delimitedNaturalPairOrdering + (sourceAnchoredGridComparisonInput candidate input)) + +theorem sourceAnchoredGridCandidateSelector_eq + (candidate : List Bool → List Bool) + (input : List Bool) : + sourceAnchoredGridCandidateSelector candidate input = + decide ((sourceAnchoredGridRawCandidate candidate input).length ≤ + (firstFieldContents input).length) := by + unfold sourceAnchoredGridCandidateSelector + sourceAnchoredGridComparisonInput sourceAnchoredGridAvailableRecord + sourceAnchoredGridRequiredRecord + rw [structuralAtomicNaturalWord_eq_prefix, + structuralAtomicNaturalWord_eq_prefix] + rw [show + lengthPrefixedWord + (Computability.encodeNat (firstFieldContents input).length) ++ + lengthPrefixedWord + (Computability.encodeNat + (sourceAnchoredGridRawCandidate candidate input).length) = + lengthPrefixedWord + (Computability.encodeNat (firstFieldContents input).length) ++ + lengthPrefixedWord + (Computability.encodeNat + (sourceAnchoredGridRawCandidate candidate input).length) ++ [] by + simp only [List.append_nil]] + rw [delimitedNaturalPairOrdering_encodeNat] + split <;> rename_i hfirst + · simp only [encodedWordOrderingFirst, false_eq_decide_iff, not_le] + omega + · split <;> rename_i hsecond + · simp only [encodedWordOrderingFirst, true_eq_decide_iff] + omega + · simp only [encodedWordOrderingFirst, true_eq_decide_iff] + omega + +private def sourceAnchoredGridCandidateMarkerWord + (candidate : List Bool → List Bool) + (input : List Bool) : List Bool := + keepFirstDropSecondWord + (firstFieldSuffix + (sourcePreservingDelimitedNaturalComparisonWord + (sourceAnchoredGridComparisonInput candidate input))) + +private noncomputable def sourceAnchoredGridCandidateMarkerComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceAnchoredGridCandidateMarkerWord candidate) := by + have hcomparison := GapCVP.TMComposition.computableInPolyTime + (sourceAnchoredGridComparisonInputComputable computer) + sourcePreservingDelimitedNaturalComparisonComputable + have hsuffix := GapCVP.TMComposition.computableInPolyTime + hcomparison firstFieldSuffixComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hsuffix keepFirstDropSecondComputable + change BitTM + (fun input => keepFirstDropSecondWord + (firstFieldSuffix + (sourcePreservingDelimitedNaturalComparisonWord + (sourceAnchoredGridComparisonInput candidate input)))) + simpa only [Function.comp_def] using hphysical + +@[simp] private theorem sourceAnchoredGridCandidateMarkerWord_eq + (candidate : List Bool → List Bool) + (input : List Bool) : + sourceAnchoredGridCandidateMarkerWord candidate input = + [sourceAnchoredGridCandidateSelector candidate input] := by + simp only [sourceAnchoredGridCandidateMarkerWord, keepFirstDropSecondWord, + sourcePreservingDelimitedNaturalComparisonWord, encodedWordOrderingWord, + firstFieldSuffix_valid, List.tail_cons, + sourceAnchoredGridCandidateSelector] + +private def sourceAnchoredGridCandidateSelectionWord + (candidate : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceAnchoredGridCandidateSelector candidate input :: input + +private noncomputable def sourceAnchoredGridCandidateSelectionComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceAnchoredGridCandidateSelectionWord candidate) := by + have hpreserved := originalSourcePreservingComputable + (sourceAnchoredGridCandidateMarkerComputable computer) + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved keepFirstDropSecondComputable + have heq : + (fun input => keepFirstDropSecondWord + (originalSourcePreservingOutput + (sourceAnchoredGridCandidateMarkerWord candidate) input)) = + sourceAnchoredGridCandidateSelectionWord candidate := by + funext input + simp only [keepFirstDropSecondWord, originalSourcePreservingOutput, + sourceAnchoredGridCandidateMarkerWord_eq, + List.cons_append, List.nil_append, List.tail_cons, + sourceAnchoredGridCandidateSelectionWord] + rw [← heq] + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def sourceAnchoredGridGuardedCandidate + (candidate : List Bool → List Bool) + (input : List Bool) : List Bool := + if sourceAnchoredGridCandidateSelector candidate input + then sourceAnchoredGridRawCandidate candidate input + else [] + +private noncomputable def sourceAnchoredGridGuardedCandidateComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceAnchoredGridGuardedCandidate candidate) := by + have hconditional := sourcePreservingConditionalComputable + (sourceAnchoredGridCandidateSelectionComputable computer) + (sourceAnchoredGridRawCandidateComputable computer) [] + change BitTM + (fun input => if sourceAnchoredGridCandidateSelector candidate input + then sourceAnchoredGridRawCandidate candidate input else []) + simpa only using hconditional + +private theorem sourceAnchoredGridGuardedCandidate_length_le + (candidate : List Bool → List Bool) + (input : List Bool) : + (sourceAnchoredGridGuardedCandidate candidate input).length ≤ + (firstFieldContents input).length := by + unfold sourceAnchoredGridGuardedCandidate + split <;> rename_i hselection + · have hbit := sourceAnchoredGridCandidateSelector_eq candidate input + rw [hselection] at hbit + exact of_decide_eq_true hbit.symm + · simp only [List.length_nil, zero_le] + +/-- GapCVP reduction support. -/ +def sourceAnchoredGridRecordRotationOutput + (candidate : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldSuffix + (flatAdjacentRecordSwapOutput input ++ + lengthPrefixedWord (sourceAnchoredGridGuardedCandidate + candidate input)) + +private noncomputable def sourceAnchoredGridRecordRotationComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceAnchoredGridRecordRotationOutput candidate) := by + have hrecord := GapCVP.TMComposition.computableInPolyTime + (sourceAnchoredGridGuardedCandidateComputable computer) + structuralPrefixWriterComputable + have hboth := pointwiseAppendComputable + flatAdjacentRecordSwapComputable hrecord + have hphysical := GapCVP.TMComposition.computableInPolyTime + hboth firstFieldSuffixComputable + change BitTM + (fun input => firstFieldSuffix + (flatAdjacentRecordSwapOutput input ++ + lengthPrefixedWord + (sourceAnchoredGridGuardedCandidate candidate input))) + simpa only [Function.comp_apply, Function.comp_def] using hphysical + +theorem sourceAnchoredGridRecordRotationOutput_records + (candidate : List Bool → List Bool) + (anchor rank pending : List Bool) : + sourceAnchoredGridRecordRotationOutput candidate + (lengthPrefixedWord anchor ++ + lengthPrefixedWord rank ++ pending) = + lengthPrefixedWord anchor ++ pending ++ + lengthPrefixedWord + (sourceAnchoredGridGuardedCandidate candidate + (lengthPrefixedWord anchor ++ + lengthPrefixedWord rank ++ pending)) := by + unfold sourceAnchoredGridRecordRotationOutput + rw [flatAdjacentRecordSwapOutput_records anchor rank pending] + simp only [List.append_assoc, firstFieldSuffix_valid] + +private theorem sourceAnchoredGridRecordRotation_anchor_length_le + (candidate : List Bool → List Bool) + (input : List Bool) : + (firstFieldContents + (sourceAnchoredGridRecordRotationOutput + candidate input)).length ≤ + (firstFieldContents input).length := by + cases hfirst : readLengthPrefixedWord input with + | none => + have hswap : flatAdjacentRecordSwapOutput input = [] := by + simp only [flatAdjacentRecordSwapOutput, hfirst] + have hdrop : firstFieldSuffix + (lengthPrefixedWord + (sourceAnchoredGridGuardedCandidate candidate input)) = [] := by + simpa only [List.append_nil] using + firstFieldSuffix_valid (sourceAnchoredGridGuardedCandidate candidate input) [] + rw [sourceAnchoredGridRecordRotationOutput, hswap, + List.nil_append, hdrop] + change 0 ≤ (firstFieldContents input).length + exact Nat.zero_le _ + | some parsed => + obtain ⟨anchor, rest⟩ := parsed + cases hsecond : readLengthPrefixedWord rest with + | none => + have hswap : flatAdjacentRecordSwapOutput input = [] := by + simp only [flatAdjacentRecordSwapOutput, hfirst, hsecond] + have hdrop : firstFieldSuffix + (lengthPrefixedWord + (sourceAnchoredGridGuardedCandidate candidate input)) = [] := by + simpa only [List.append_nil] using + firstFieldSuffix_valid (sourceAnchoredGridGuardedCandidate candidate input) [] + rw [sourceAnchoredGridRecordRotationOutput, hswap, + List.nil_append, hdrop] + change 0 ≤ (firstFieldContents input).length + exact Nat.zero_le _ + | some parsed => + obtain ⟨rank, pending⟩ := parsed + have hinput := readLengthPrefixedWord_some_reconstruct + input anchor rest hfirst + have hrest := readLengthPrefixedWord_some_reconstruct + rest rank pending hsecond + subst rest + subst input + have hrotation := + sourceAnchoredGridRecordRotationOutput_records + candidate anchor rank pending + simp only [List.append_assoc] at hrotation + rw [hrotation] + simp only [firstFieldContents_valid, Std.le_refl] + +private theorem sourceAnchoredGridRecordRotation_length_le + (candidate : List Bool → List Bool) + (input : List Bool) : + (sourceAnchoredGridRecordRotationOutput + candidate input).length ≤ + input.length + (2 * (firstFieldContents input).length + 1) := by + have hsuffix := sourceMixedRadixPhysicalFirstFieldSuffix_length_le + (flatAdjacentRecordSwapOutput input ++ + lengthPrefixedWord + (sourceAnchoredGridGuardedCandidate candidate input)) + have hswap := flatAdjacentRecordSwapOutput_length_le input + have hguard := sourceAnchoredGridGuardedCandidate_length_le + candidate input + simp only [List.length_append, lengthPrefixedWord_length] at hsuffix + unfold sourceAnchoredGridRecordRotationOutput + omega + +private theorem sourceAnchoredGridRecordRotation_iterate_anchor_length_le + (candidate : List Bool → List Bool) + (seed : List Bool) (stage : ℕ) : + (firstFieldContents + (((sourceAnchoredGridRecordRotationOutput candidate)^[stage]) + seed)).length ≤ (firstFieldContents seed).length := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + exact (sourceAnchoredGridRecordRotation_anchor_length_le + candidate _).trans ih + +private theorem sourceAnchoredGridRecordRotation_iterate_length_le + (candidate : List Bool → List Bool) + (seed : List Bool) (stage : ℕ) : + (((sourceAnchoredGridRecordRotationOutput + candidate)^[stage]) seed).length ≤ + seed.length + stage * (2 * seed.length + 1) := by + have hanchor := sourceMixedRadixPhysicalFirstFieldContents_length_le seed + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, zero_mul, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have hstep := sourceAnchoredGridRecordRotation_length_le + candidate + (((sourceAnchoredGridRecordRotationOutput + candidate)^[stage]) seed) + have hfixed := sourceAnchoredGridRecordRotation_iterate_anchor_length_le + candidate seed stage + calc + (sourceAnchoredGridRecordRotationOutput candidate + (((sourceAnchoredGridRecordRotationOutput + candidate)^[stage]) seed)).length + ≤ (((sourceAnchoredGridRecordRotationOutput + candidate)^[stage]) seed).length + + (2 * (firstFieldContents + (((sourceAnchoredGridRecordRotationOutput + candidate)^[stage]) seed)).length + 1) := hstep + _ ≤ seed.length + stage * (2 * seed.length + 1) + + (2 * seed.length + 1) := by omega + _ = seed.length + (stage + 1) * + (2 * seed.length + 1) := by + simp only [Nat.succ_mul, one_mul, Nat.add_assoc] + +private def sourceAnchoredGridRecordStatePolynomial : Polynomial ℕ := + Polynomial.X + Polynomial.X * + (2 * Polynomial.X + 1) + +private theorem sourceAnchoredGridRecord_polynomiallyBoundedFoldStates + (candidate : List Bool → List Bool) : + PolynomiallyBoundedFoldStates + (sourceAnchoredGridRecordRotationOutput candidate) + sourceAnchoredGridRecordStatePolynomial := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate := sourceAnchoredGridRecordRotation_iterate_length_le + candidate seed stage + simp only [sourceAnchoredGridRecordStatePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_X, Polynomial.eval_ofNat, + Polynomial.eval_one] + have hstageInput : stage ≤ input.length := hstage.trans hcount + have hfactor : 2 * seed.length + 1 ≤ 2 * input.length + 1 := by + omega + have hmul : stage * (2 * seed.length + 1) ≤ + input.length * (2 * input.length + 1) := + Nat.mul_le_mul hstageInput hfactor + omega + +/-- GapCVP reduction support. -/ +noncomputable def sourceAnchoredGridRecordFoldComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput candidate)) := + boundedDependentRecordFoldComputable + (sourceAnchoredGridRecordRotationComputable computer) + sourceAnchoredGridRecordStatePolynomial + (sourceAnchoredGridRecord_polynomiallyBoundedFoldStates candidate) + +private theorem sourceAnchoredGridGuardedCandidate_records + (candidate : List Bool → List Bool) + (anchor rank pending : List Bool) + (hfit : (candidate + (lengthPrefixedWord rank ++ anchor)).length ≤ anchor.length) : + sourceAnchoredGridGuardedCandidate candidate + (lengthPrefixedWord anchor ++ + lengthPrefixedWord rank ++ pending) = + candidate (lengthPrefixedWord rank ++ anchor) := by + unfold sourceAnchoredGridGuardedCandidate + have hselector : sourceAnchoredGridCandidateSelector candidate + (lengthPrefixedWord anchor ++ + lengthPrefixedWord rank ++ pending) = true := by + rw [sourceAnchoredGridCandidateSelector_eq] + simp only [sourceAnchoredGridRawCandidate, sourceAnchoredGridRankSourcePair, List.append_assoc, + firstFieldSuffix_valid, firstFieldContents_valid, hfit, decide_true] + rw [hselector] + simp only [↓reduceIte, sourceAnchoredGridRawCandidate, sourceAnchoredGridRankSourcePair, + List.append_assoc, + firstFieldSuffix_valid, firstFieldContents_valid] + +private theorem sourceAnchoredGridRecordRotation_iterate_ranks + (candidate : List Bool → List Bool) + (anchor : List Bool) (ranks : List (List Bool)) + (suffix : List Bool) + (hfit : ∀ rank ∈ ranks, + (candidate (lengthPrefixedWord rank ++ anchor)).length ≤ + anchor.length) : + ((sourceAnchoredGridRecordRotationOutput candidate)^[ranks.length]) + (lengthPrefixedWord anchor ++ + ranks.flatMap lengthPrefixedWord ++ suffix) = + lengthPrefixedWord anchor ++ suffix ++ + ranks.flatMap + (fun rank => lengthPrefixedWord + (candidate (lengthPrefixedWord rank ++ anchor))) := by + induction ranks generalizing suffix with + | nil => + simp only [List.length_nil, List.flatMap_nil, List.append_nil, Function.iterate_zero, id_eq] + | cons rank remaining ih => + have hhead : + (candidate (lengthPrefixedWord rank ++ anchor)).length ≤ + anchor.length := hfit rank (by simp only [List.mem_cons, true_or]) + have htail : ∀ item ∈ remaining, + (candidate (lengthPrefixedWord item ++ anchor)).length ≤ + anchor.length := by + intro item hitem + exact hfit item (by simp only [List.mem_cons, hitem, or_true]) + rw [List.length_cons, Function.iterate_succ_apply] + simp only [List.flatMap_cons, List.append_assoc] + have hrotation := sourceAnchoredGridRecordRotationOutput_records + candidate anchor rank + (remaining.flatMap lengthPrefixedWord ++ suffix) + simp only [List.append_assoc] at hrotation + rw [hrotation] + have hguard := sourceAnchoredGridGuardedCandidate_records + candidate anchor rank + (remaining.flatMap lengthPrefixedWord ++ suffix) hhead + simp only [List.append_assoc] at hguard + rw [hguard] + simpa only [List.append_assoc] using + ih (suffix ++ lengthPrefixedWord (candidate (lengthPrefixedWord rank ++ anchor))) htail + +theorem boundedRecordFoldOutput_sourceAnchoredGridRecordRanks + (candidate : List Bool → List Bool) + (anchor : List Bool) (ranks : List (List Bool)) + (suffix : List Bool) + (hfit : ∀ rank ∈ ranks, + (candidate (lengthPrefixedWord rank ++ anchor)).length ≤ + anchor.length) : + boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput candidate) + (unaryBoundedFoldWord ranks.length + (lengthPrefixedWord anchor ++ + ranks.flatMap lengthPrefixedWord ++ suffix)) = + lengthPrefixedWord anchor ++ suffix ++ + ranks.flatMap + (fun rank => lengthPrefixedWord + (candidate (lengthPrefixedWord rank ++ anchor))) := by + simp only [boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + exact sourceAnchoredGridRecordRotation_iterate_ranks + candidate anchor ranks suffix hfit + +end SourceAnchoredGridRecordFoldTM + +namespace CNFFiveFamilyFlatIndexedCatalogueTM + +open Computability Turing GapCVP.CLNondeterminism GapCVP.CLCompleteVerifierSimulation +open GapCVP.BinaryEncoding GapCVP.CLStructuralPrefixWriter GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFiveFamilyFlatCandidateGenerationTM + +/-- GapCVP reduction support. -/ +def fiveFlatOriginalSourceAnchorWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + lengthPrefixedWord input ++ + List.replicate + ((flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval input.length) true + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyFlatOriginalSourceAnchorComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveFlatOriginalSourceAnchorWord bound machine) := by + exact pointwiseAppendComputable + structuralPrefixWriterComputable + (polynomialValueUnaryComputable + (flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm))) + +end CNFFiveFamilyFlatIndexedCatalogueTM + +namespace CNFFiveFamilyFlatIndexedRankArithmeticTM + +open Computability Turing GapCVP.CLNondeterminism GapCVP.CLCellRowBounds GapCVP.BinaryEncoding +open GapCVP.SourceMachineCert GapCVP.SourceUniformTuringTM GapCVP.SourceStructuralTuringTM +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFUnaryPairIndexTM +open GapCVP.CNFUnaryPairIndexTotalRuntimeCert GapCVP.CNFCappedUnaryPairArithmeticTM +open GapCVP.SourceMixedRadixUnaryQuotientRemainderTM + +/-- GapCVP reduction support. -/ +def fiveFamilyFlatIndexedPhysicalRank (input : List Bool) : List Bool := + firstFieldContents input + +/-- GapCVP reduction support. -/ +noncomputable def fiveFlatIndexedPhysicalRankComputable : + BitTM + fiveFamilyFlatIndexedPhysicalRank := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def fiveFlatIndexedPhysicalOriginal (input : List Bool) : List Bool := + firstFieldContents (firstFieldSuffix input) + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyFlatIndexedPhysicalOriginalComputable : + BitTM + fiveFlatIndexedPhysicalOriginal := by + have physical := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + change BitTM + (fun input => firstFieldContents (firstFieldSuffix input)) + simpa only [Function.comp_def] using physical + +theorem fiveFamilyFlatIndexedPhysicalRank_valid + (rank : ℕ) (original suffix : List Bool) : + fiveFamilyFlatIndexedPhysicalRank + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate rank true := by + simp only [fiveFamilyFlatIndexedPhysicalRank, List.append_assoc, firstFieldContents_valid] + +theorem fiveFamilyFlatIndexedPhysicalOriginal_valid + (rank : ℕ) (original suffix : List Bool) : + fiveFlatIndexedPhysicalOriginal + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = original := by + simp only [fiveFlatIndexedPhysicalOriginal, List.append_assoc, firstFieldSuffix_valid, + firstFieldContents_valid] + +/-- GapCVP reduction support. -/ +def fiveFlatIndexedOriginalPolynomialUnary + (polynomial : Polynomial ℕ) (input : List Bool) : List Bool := + List.replicate + (polynomial.eval + (fiveFlatIndexedPhysicalOriginal input).length) true + +/-- GapCVP reduction support. -/ +noncomputable def fiveFlatIndexedOriginalPolynomialUnaryComputable + (polynomial : Polynomial ℕ) : + BitTM + (fiveFlatIndexedOriginalPolynomialUnary polynomial) := by + have physical := GapCVP.TMComposition.computableInPolyTime + fiveFamilyFlatIndexedPhysicalOriginalComputable + (polynomialValueUnaryComputable polynomial) + change BitTM + (fun input => List.replicate + (polynomial.eval + (fiveFlatIndexedPhysicalOriginal input).length) true) + simpa only [Function.comp_def] using physical + +theorem fiveFamilyFlatIndexedOriginalPolynomialUnary_valid + (polynomial : Polynomial ℕ) + (rank : ℕ) (original suffix : List Bool) : + fiveFlatIndexedOriginalPolynomialUnary polynomial + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (polynomial.eval original.length) true := by + simp only [fiveFlatIndexedOriginalPolynomialUnary, fiveFlatIndexedPhysicalOriginal, + List.append_assoc, + firstFieldSuffix_valid, firstFieldContents_valid] + +/-- GapCVP reduction support. -/ +def fiveFamilyFlatIndexedGridPolynomial + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + Polynomial ℕ := + nondeterministicTableauDimensionPolynomial bound machine + 1 + +@[simp] theorem fiveFamilyFlatIndexedGridPolynomial_eval + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + (fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length = rowWidth bound machine original + 1 := by + simp only [fiveFamilyFlatIndexedGridPolynomial, Polynomial.eval_add, Polynomial.eval_one, + rowWidth] + +private def fiveFlatIndexedOriginalDivisionQuery + (polynomial : Polynomial ℕ) (input : List Bool) : List Bool := + fiveFamilyFlatIndexedPhysicalRank input ++ false :: + (fiveFlatIndexedOriginalPolynomialUnary polynomial input ++ + false :: fiveFlatIndexedPhysicalOriginal input) + +private noncomputable def fiveFamilyFlatIndexedOriginalDivisionQueryComputable + (polynomial : Polynomial ℕ) : + BitTM + (fiveFlatIndexedOriginalDivisionQuery polynomial) := by + have sourceDelimiter := + GapCVP.TMComposition.computableInPolyTime + fiveFamilyFlatIndexedPhysicalOriginalComputable + (prependBitComputable false) + have modulusAndSource := pointwiseAppendComputable + (fiveFlatIndexedOriginalPolynomialUnaryComputable polynomial) + sourceDelimiter + have modulusDelimiter := + GapCVP.TMComposition.computableInPolyTime + modulusAndSource (prependBitComputable false) + have physical := pointwiseAppendComputable + fiveFlatIndexedPhysicalRankComputable modulusDelimiter + change BitTM + (fun input => + fiveFamilyFlatIndexedPhysicalRank input ++ false :: + (fiveFlatIndexedOriginalPolynomialUnary polynomial input ++ + false :: fiveFlatIndexedPhysicalOriginal input)) + simpa only [Function.comp_apply] using physical + +private theorem fiveFamilyFlatIndexedOriginalDivisionQuery_valid + (polynomial : Polynomial ℕ) + (rank : ℕ) (original suffix : List Bool) : + fiveFlatIndexedOriginalDivisionQuery polynomial + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + sourceUnaryDivisionQuery rank + (polynomial.eval original.length) original := by + simp only [fiveFlatIndexedOriginalDivisionQuery, fiveFamilyFlatIndexedPhysicalRank, + List.append_assoc, + firstFieldContents_valid, fiveFlatIndexedOriginalPolynomialUnary, + fiveFlatIndexedPhysicalOriginal, + firstFieldSuffix_valid, sourceUnaryDivisionQuery] + +private def fiveFlatIndexedOriginalDivisionOutput + (polynomial : Polynomial ℕ) (input : List Bool) : List Bool := + sourceUnaryDivisionOutput + (fiveFlatIndexedOriginalDivisionQuery polynomial input) + +private noncomputable def fiveFamilyFlatIndexedOriginalDivisionComputable + (polynomial : Polynomial ℕ) : + BitTM + (fiveFlatIndexedOriginalDivisionOutput polynomial) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatIndexedOriginalDivisionQueryComputable polynomial) + sourceUnaryDivisionComputable + change BitTM + (fun input => sourceUnaryDivisionOutput + (fiveFlatIndexedOriginalDivisionQuery polynomial input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyFlatIndexedOriginalDivisionOutput_valid + (polynomial : Polynomial ℕ) + (rank : ℕ) (original suffix : List Bool) + (hpositive : 0 < polynomial.eval original.length) : + fiveFlatIndexedOriginalDivisionOutput polynomial + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (rank / polynomial.eval original.length) true ++ + false :: + (List.replicate (rank % polynomial.eval original.length) true ++ + false :: sourceUnaryDivisionQuery rank + (polynomial.eval original.length) original) := by + unfold fiveFlatIndexedOriginalDivisionOutput + rw [fiveFamilyFlatIndexedOriginalDivisionQuery_valid] + exact sourceUnaryDivisionOutput_valid + rank (polynomial.eval original.length) original hpositive + +/-- GapCVP reduction support. -/ +def fiveFlatIndexedOriginalQuotientUnary + (polynomial : Polynomial ℕ) (input : List Bool) : List Bool := + (unaryPrefixOutput + (fiveFlatIndexedOriginalDivisionOutput polynomial input)).tail + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyFlatIndexedOriginalQuotientUnaryComputable + (polynomial : Polynomial ℕ) : + BitTM + (fiveFlatIndexedOriginalQuotientUnary polynomial) := by + have scanned := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatIndexedOriginalDivisionComputable polynomial) + unaryPrefixComputable + have physical := GapCVP.TMComposition.computableInPolyTime + scanned dropHeadComputable + change BitTM + (fun input => (unaryPrefixOutput + (fiveFlatIndexedOriginalDivisionOutput + polynomial input)).tail) + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def fiveFlatIndexedOriginalRemainderUnary + (polynomial : Polynomial ℕ) (input : List Bool) : List Bool := + (unaryPrefixOutput + (unaryPrefixSuffixOutput + (fiveFlatIndexedOriginalDivisionOutput + polynomial input))).tail + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyFlatIndexedOriginalRemainderUnaryComputable + (polynomial : Polynomial ℕ) : + BitTM + (fiveFlatIndexedOriginalRemainderUnary polynomial) := by + have suffix := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatIndexedOriginalDivisionComputable polynomial) + actualUnaryPrefixSuffixComputable + have scanned := GapCVP.TMComposition.computableInPolyTime + suffix unaryPrefixComputable + have physical := GapCVP.TMComposition.computableInPolyTime + scanned dropHeadComputable + change BitTM + (fun input => (unaryPrefixOutput + (unaryPrefixSuffixOutput + (fiveFlatIndexedOriginalDivisionOutput + polynomial input))).tail) + simpa only [Function.comp_def] using physical + +theorem fiveFamilyFlatIndexedOriginalQuotientUnary_valid + (polynomial : Polynomial ℕ) + (rank : ℕ) (original suffix : List Bool) + (hpositive : 0 < polynomial.eval original.length) : + fiveFlatIndexedOriginalQuotientUnary polynomial + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (rank / polynomial.eval original.length) true := by + unfold fiveFlatIndexedOriginalQuotientUnary + rw [fiveFamilyFlatIndexedOriginalDivisionOutput_valid + polynomial rank original suffix hpositive, + unaryPrefixOutput_replicate_delimiter] + rfl + +theorem fiveFamilyFlatIndexedOriginalRemainderUnary_valid + (polynomial : Polynomial ℕ) + (rank : ℕ) (original suffix : List Bool) + (hpositive : 0 < polynomial.eval original.length) : + fiveFlatIndexedOriginalRemainderUnary polynomial + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (rank % polynomial.eval original.length) true := by + unfold fiveFlatIndexedOriginalRemainderUnary + rw [fiveFamilyFlatIndexedOriginalDivisionOutput_valid + polynomial rank original suffix hpositive, + unaryPrefixSuffixOutput_valid, + unaryPrefixOutput_replicate_delimiter] + rfl + +private def fiveFlatIndexedPositionSymbolPairInput + (polynomial : Polynomial ℕ) (symbol : ℕ) + (input : List Bool) : List Bool := + fiveFlatIndexedOriginalRemainderUnary polynomial input ++ + false :: (List.replicate symbol true ++ [false]) + +private noncomputable def fiveFamilyFlatIndexedPositionSymbolPairInputComputable + (polynomial : Polynomial ℕ) (symbol : ℕ) : + BitTM + (fiveFlatIndexedPositionSymbolPairInput + polynomial symbol) := by + have physical := pointwiseAppendComputable + (fiveFamilyFlatIndexedOriginalRemainderUnaryComputable polynomial) + (constantWordComputable + (false :: (List.replicate symbol true ++ [false]))) + change BitTM + (fun input => + fiveFlatIndexedOriginalRemainderUnary polynomial input ++ + false :: (List.replicate symbol true ++ [false])) + exact physical + +private def fiveFlatIndexedPositionSymbolCode + (polynomial : Polynomial ℕ) (symbol : ℕ) + (input : List Bool) : List Bool := + unarySourcePairOutput + (fiveFlatIndexedPositionSymbolPairInput + polynomial symbol input) + +private noncomputable def fiveFamilyFlatIndexedPositionSymbolCodeComputable + (polynomial : Polynomial ℕ) (symbol : ℕ) : + BitTM + (fiveFlatIndexedPositionSymbolCode polynomial symbol) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatIndexedPositionSymbolPairInputComputable + polynomial symbol) + actualUnaryPairIndexComputable + change BitTM + (fun input => unarySourcePairOutput + (fiveFlatIndexedPositionSymbolPairInput + polynomial symbol input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyFlatIndexedPositionSymbolCode_valid + (polynomial : Polynomial ℕ) (symbol rank : ℕ) + (original suffix : List Bool) + (hpositive : 0 < polynomial.eval original.length) : + fiveFlatIndexedPositionSymbolCode polynomial symbol + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (Nat.pair (rank % polynomial.eval original.length) symbol) + true := by + unfold fiveFlatIndexedPositionSymbolCode + fiveFlatIndexedPositionSymbolPairInput + rw [fiveFamilyFlatIndexedOriginalRemainderUnary_valid + polynomial rank original suffix hpositive] + change unarySourcePairOutput + (unarySourcePairWord + (rank % polynomial.eval original.length) symbol) = _ + exact unarySourcePairOutput_word + (rank % polynomial.eval original.length) symbol + +private def fiveFlatIndexedVariablePairInput + (polynomial : Polynomial ℕ) (symbol : ℕ) + (input : List Bool) : List Bool := + fiveFlatIndexedOriginalQuotientUnary polynomial input ++ + false :: (fiveFlatIndexedPositionSymbolCode + polynomial symbol input ++ [false]) + +private noncomputable def fiveFamilyFlatIndexedVariablePairInputComputable + (polynomial : Polynomial ℕ) (symbol : ℕ) : + BitTM + (fiveFlatIndexedVariablePairInput polynomial symbol) := by + have inner := pointwiseAppendComputable + (fiveFamilyFlatIndexedPositionSymbolCodeComputable + polynomial symbol) + (constantWordComputable [false]) + have delimiter := GapCVP.TMComposition.computableInPolyTime + inner (prependBitComputable false) + have physical := pointwiseAppendComputable + (fiveFamilyFlatIndexedOriginalQuotientUnaryComputable polynomial) + delimiter + change BitTM + (fun input => + fiveFlatIndexedOriginalQuotientUnary polynomial input ++ + false :: (fiveFlatIndexedPositionSymbolCode + polynomial symbol input ++ [false])) + simpa only [Function.comp_apply] using physical + +/-- GapCVP reduction support. -/ +def fiveFamilyFlatIndexedVariableCode + (polynomial : Polynomial ℕ) (symbol : ℕ) + (input : List Bool) : List Bool := + unarySourcePairOutput + (fiveFlatIndexedVariablePairInput polynomial symbol input) + +private noncomputable def fiveFamilyFlatIndexedVariableCodeComputable + (polynomial : Polynomial ℕ) (symbol : ℕ) : + BitTM + (fiveFamilyFlatIndexedVariableCode polynomial symbol) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatIndexedVariablePairInputComputable + polynomial symbol) + actualUnaryPairIndexComputable + change BitTM + (fun input => unarySourcePairOutput + (fiveFlatIndexedVariablePairInput + polynomial symbol input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyFlatIndexedVariableCode_valid + (polynomial : Polynomial ℕ) (symbol rank : ℕ) + (original suffix : List Bool) + (hpositive : 0 < polynomial.eval original.length) : + fiveFamilyFlatIndexedVariableCode polynomial symbol + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (Nat.pair + (rank / polynomial.eval original.length) + (Nat.pair (rank % polynomial.eval original.length) symbol)) + true := by + unfold fiveFamilyFlatIndexedVariableCode + fiveFlatIndexedVariablePairInput + rw [fiveFamilyFlatIndexedOriginalQuotientUnary_valid + polynomial rank original suffix hpositive, + fiveFamilyFlatIndexedPositionSymbolCode_valid + polynomial symbol rank original suffix hpositive] + change unarySourcePairOutput + (unarySourcePairWord + (rank / polynomial.eval original.length) + (Nat.pair (rank % polynomial.eval original.length) symbol)) = _ + exact unarySourcePairOutput_word + (rank / polynomial.eval original.length) + (Nat.pair (rank % polynomial.eval original.length) symbol) + +theorem fiveFamilyFlatIndexedGridQuotient_lt + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) (rank : ℕ) + (hrank : rank < (rowWidth bound machine original + 1) ^ 2) : + rank / (rowWidth bound machine original + 1) < + rowWidth bound machine original + 1 := by + apply (Nat.div_lt_iff_lt_mul (by omega)).2 + simpa only [pow_two] using hrank + +theorem fiveFamilyFlatIndexedGridRemainder_lt + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) (rank : ℕ) : + rank % (rowWidth bound machine original + 1) < + rowWidth bound machine original + 1 := by + apply Nat.mod_lt + omega + +end CNFFiveFamilyFlatIndexedRankArithmeticTM + +namespace CNFFiveFamilyFlatRowMajorCatalogueTM + +open Computability Turing GapCVP.CL GapCVP.CNFDependentFiveFamilyRecordTM +open GapCVP.CNFBoundedRecordFoldTM + +private def fiveFamilyRowMajorFinitePairs (first second : ℕ) : + List (Fin first × Fin second) := + (List.finRange first).flatMap fun row => + (List.finRange second).map fun column => (row, column) + +@[simp] private theorem mem_fiveFamilyRowMajorFinitePairs + (first second : ℕ) (row : Fin first) (column : Fin second) : + (row, column) ∈ fiveFamilyRowMajorFinitePairs first second := by + simp only [fiveFamilyRowMajorFinitePairs, List.mem_flatMap, List.mem_finRange, List.mem_map, + Prod.mk.injEq, + true_and, exists_eq_right, exists_eq] + +@[simp] private theorem fiveFamilyRowMajorFinitePairs_length + (first second : ℕ) : + (fiveFamilyRowMajorFinitePairs first second).length = + first * second := by + simp only [fiveFamilyRowMajorFinitePairs, List.length_flatMap, List.length_map, + List.length_finRange, + List.map_const', List.sum_replicate, smul_eq_mul] + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorTimePositionSlots (T : ℕ) : + List (Time T × Position T) := + fiveFamilyRowMajorFinitePairs (T + 1) (T + 1) + +@[simp] theorem mem_fiveFamilyRowMajorTimePositionSlots + {T : ℕ} (time : Time T) (position : Position T) : + (time, position) ∈ fiveFamilyRowMajorTimePositionSlots T := by + exact mem_fiveFamilyRowMajorFinitePairs + (T + 1) (T + 1) time position + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorSymbolPairs (S : ℕ) : + List (Symbol S × Symbol S) := + fiveFamilyRowMajorFinitePairs (S + 1) (S + 1) + +@[simp] private theorem mem_fiveFamilyRowMajorSymbolPairs + {S : ℕ} (first second : Symbol S) : + (first, second) ∈ fiveFamilyRowMajorSymbolPairs S := by + exact mem_fiveFamilyRowMajorFinitePairs + (S + 1) (S + 1) first second + +@[simp] theorem fiveFamilyRowMajorSymbolPairs_length (S : ℕ) : + (fiveFamilyRowMajorSymbolPairs S).length = (S + 1) ^ 2 := by + simp only [fiveFamilyRowMajorSymbolPairs, fiveFamilyRowMajorFinitePairs_length, pow_two] + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorWindowSymbols (S : ℕ) : + List (WindowSymbols S) := + (List.finRange (S + 1)).flatMap fun first => + (List.finRange (S + 1)).flatMap fun second => + (List.finRange (S + 1)).flatMap fun third => + (List.finRange (S + 1)).map fun fourth => + (first, second, third, fourth) + +@[simp] private theorem mem_fiveFamilyRowMajorWindowSymbols + {S : ℕ} (symbols : WindowSymbols S) : + symbols ∈ fiveFamilyRowMajorWindowSymbols S := by + rcases symbols with ⟨first, second, third, fourth⟩ + simp only [fiveFamilyRowMajorWindowSymbols, List.mem_flatMap, List.mem_finRange, List.mem_map, + Prod.mk.injEq, true_and, exists_and_left, ↓existsAndEq, and_true, exists_eq] + +@[simp] theorem fiveFamilyRowMajorWindowSymbols_length (S : ℕ) : + (fiveFamilyRowMajorWindowSymbols S).length = (S + 1) ^ 4 := by + simp only [fiveFamilyRowMajorWindowSymbols, List.length_flatMap, List.length_map, + List.length_finRange, + List.map_const', List.sum_replicate, smul_eq_mul] + ring + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorWindows (T : ℕ) : List (Window T) := + (List.finRange T).flatMap fun time => + (List.finRange (T + 1)).map fun position => + windowAt time position + +@[simp] theorem mem_fiveFamilyRowMajorWindows + {T : ℕ} (window : Window T) : + window ∈ fiveFamilyRowMajorWindows T := by + let index := actualWindowIndexEquiv T window + have reconstruct : windowAt index.1 index.2 = window := + (actualWindowIndexEquiv T).left_inv window + unfold fiveFamilyRowMajorWindows + apply List.mem_flatMap.mpr + refine ⟨index.1, by simp only [List.mem_finRange], ?_⟩ + apply List.mem_map.mpr + exact ⟨index.2, by simp only [List.mem_finRange], reconstruct⟩ + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorAtLeastClauses (T S : ℕ) : + List (Clause T S) := + (fiveFamilyRowMajorTimePositionSlots T).map fun position => + atLeastOneClause (S := S) position.1 position.2 + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorAtMostClauses (T S : ℕ) : + List (Clause T S) := + (fiveFamilyRowMajorTimePositionSlots T).flatMap fun position => + (fiveFamilyRowMajorSymbolPairs S).map fun symbols => + if symbols.1 < symbols.2 then + atMostOneClause position.1 position.2 symbols.1 symbols.2 + else + atLeastOneClause position.1 position.2 + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorInitialClauses {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + (List.finRange (T + 1)).map + (initialClause specification.input) + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorAcceptanceClauses {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + [acceptanceClause specification.accept] + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorForbiddenClauses {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + (fiveFamilyRowMajorWindows T).flatMap fun window => + (fiveFamilyRowMajorWindowSymbols S).map fun symbols => + if specification.allowed symbols = false then + transitionClause window symbols + else + atLeastOneClause window.1.1 window.1.2 + +/-- GapCVP reduction support. -/ +def fiveFamilyRowMajorSourceClauses {T S : ℕ} + (specification : Specification T S) : List (Clause T S) := + fiveFamilyRowMajorAtLeastClauses T S ++ + fiveFamilyRowMajorAtMostClauses T S ++ + fiveFamilyRowMajorInitialClauses specification ++ + fiveFamilyRowMajorAcceptanceClauses specification ++ + fiveFamilyRowMajorForbiddenClauses specification + +private theorem fiveFamilyRowMajorAtLeast_mem_tableauFormula + {T S : ℕ} (specification : Specification T S) + (clause : Clause T S) + (hclause : clause ∈ fiveFamilyRowMajorAtLeastClauses T S) : + clause ∈ tableauFormula specification := by + obtain ⟨position, _, rfl⟩ := List.mem_map.mp hclause + exact atLeastOneClause_mem_tableauFormula + specification position.1 position.2 + +private theorem fiveFamilyRowMajorAtMost_mem_tableauFormula + {T S : ℕ} (specification : Specification T S) + (clause : Clause T S) + (hclause : clause ∈ fiveFamilyRowMajorAtMostClauses T S) : + clause ∈ tableauFormula specification := by + obtain ⟨position, _, hslot⟩ := List.mem_flatMap.mp hclause + obtain ⟨symbols, _, hvalue⟩ := List.mem_map.mp hslot + by_cases hvalid : symbols.1 < symbols.2 + · simp only [hvalid, ↓reduceIte] at hvalue + subst clause + exact atMostOneClause_mem_tableauFormula specification + position.1 position.2 symbols.1 symbols.2 hvalid + · simp only [hvalid, ↓reduceIte] at hvalue + subst clause + exact atLeastOneClause_mem_tableauFormula specification + position.1 position.2 + +private theorem fiveFamilyRowMajorForbidden_mem_tableauFormula + {T S : ℕ} (specification : Specification T S) + (clause : Clause T S) + (hclause : clause ∈ + fiveFamilyRowMajorForbiddenClauses specification) : + clause ∈ tableauFormula specification := by + obtain ⟨window, _, hslot⟩ := List.mem_flatMap.mp hclause + obtain ⟨symbols, _, hvalue⟩ := List.mem_map.mp hslot + by_cases hvalid : specification.allowed symbols = false + · simp only [hvalid, ↓reduceIte] at hvalue + subst clause + exact transitionClause_mem_tableauFormula + specification window symbols hvalid + · simp only [hvalid, Bool.true_eq_false, ↓reduceIte] at hvalue + subst clause + exact atLeastOneClause_mem_tableauFormula + specification window.1.1 window.1.2 + +theorem fiveFamilyRowMajorSourceClauses_toFinset + {T S : ℕ} (specification : Specification T S) : + (fiveFamilyRowMajorSourceClauses specification).toFinset = + tableauFormula specification := by + ext clause + simp only [List.mem_toFinset] + constructor + · intro hclause + simp only [fiveFamilyRowMajorSourceClauses, + List.mem_append] at hclause + rcases hclause with hremaining | hforbidden + · rcases hremaining with hremaining | haccept + · rcases hremaining with hremaining | hinitial + · rcases hremaining with hleast | hmost + · exact fiveFamilyRowMajorAtLeast_mem_tableauFormula + specification clause hleast + · exact fiveFamilyRowMajorAtMost_mem_tableauFormula + specification clause hmost + · obtain ⟨position, _, rfl⟩ := List.mem_map.mp hinitial + exact initialClause_mem_tableauFormula + specification position + · have haccept' : clause = + acceptanceClause specification.accept := by + simpa only [fiveFamilyRowMajorAcceptanceClauses, List.mem_cons, List.not_mem_nil, + or_false] using haccept + subst clause + exact acceptanceClause_mem_tableauFormula specification + · exact fiveFamilyRowMajorForbidden_mem_tableauFormula + specification clause hforbidden + · intro hclause + have htotalFinset : clause ∈ + (totalFiveFamilySourceClauseCandidates + specification).toFinset := by + rw [totalFiveFamilySourceClauseCandidates_toFinset] + exact hclause + have htotal : clause ∈ + totalFiveFamilySourceClauseCandidates specification := by + simpa only [List.mem_toFinset] using htotalFinset + simp only [totalFiveFamilySourceClauseCandidates, + List.mem_append] at htotal + simp only [fiveFamilyRowMajorSourceClauses, List.mem_append] + rcases htotal with hremaining | hforbidden + · rcases hremaining with hremaining | haccept + · rcases hremaining with hremaining | hinitial + · rcases hremaining with hleast | hmost + · left + left + left + left + obtain ⟨position, _, hvalue⟩ := List.mem_map.mp hleast + apply List.mem_map.mpr + exact ⟨position, + mem_fiveFamilyRowMajorTimePositionSlots + position.1 position.2, hvalue⟩ + · left + left + left + right + obtain ⟨candidate, _, hvalue⟩ := List.mem_map.mp hmost + apply List.mem_flatMap.mpr + refine ⟨candidate.1, + mem_fiveFamilyRowMajorTimePositionSlots + candidate.1.1 candidate.1.2, ?_⟩ + apply List.mem_map.mpr + exact ⟨candidate.2, + mem_fiveFamilyRowMajorSymbolPairs + candidate.2.1 candidate.2.2, hvalue⟩ + · left + left + right + obtain ⟨position, _, hvalue⟩ := List.mem_map.mp hinitial + apply List.mem_map.mpr + exact ⟨position, by simp only [List.mem_finRange], hvalue⟩ + · left + right + simpa only [fiveFamilyRowMajorAcceptanceClauses, List.mem_cons, List.not_mem_nil, or_false, + executableAcceptanceFamilyClauses] using haccept + · right + obtain ⟨candidate, _, hvalue⟩ := List.mem_map.mp hforbidden + apply List.mem_flatMap.mpr + refine ⟨candidate.1, + mem_fiveFamilyRowMajorWindows candidate.1, ?_⟩ + apply List.mem_map.mpr + exact ⟨candidate.2, + mem_fiveFamilyRowMajorWindowSymbols candidate.2, hvalue⟩ + +end CNFFiveFamilyFlatRowMajorCatalogueTM + +namespace CNFFiveFamilyOriginalIndexedBitTM + +open Computability Turing GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputPolynomialCompositionClosure +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +private theorem fiveFamilyOriginalBitTail_iterate_length_le + (source : List Bool) (count : ℕ) : + (((List.tail : List Bool → List Bool)^[count]) source).length ≤ + source.length := by + induction count with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ count ih => + rw [Function.iterate_succ_apply'] + have htail : + (((List.tail : List Bool → List Bool) + (((List.tail : List Bool → List Bool)^[count]) source))).length ≤ + (((List.tail : List Bool → List Bool)^[count]) source).length := by + cases ((List.tail : List Bool → List Bool)^[count]) source <;> simp + exact htail.trans ih + +private theorem fiveFamilyOriginalBitTail_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + (List.tail : List Bool → List Bool) Polynomial.X := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage _ + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + simpa only [Polynomial.eval_X, ge_iff_le] using + (fiveFamilyOriginalBitTail_iterate_length_le seed stage).trans hseed + +private noncomputable def fiveFamilyOriginalBitTailFoldComputable : + BitTM + (boundedRecordFoldOutput (List.tail : List Bool → List Bool)) := + boundedDependentRecordFoldComputable dropHeadComputable Polynomial.X + fiveFamilyOriginalBitTail_polynomiallyBoundedFoldStates + +private theorem fiveFamilyOriginalBitTail_iterate_eq_drop + (source : List Bool) (count : ℕ) : + ((List.tail : List Bool → List Bool)^[count]) source = + source.drop count := by + induction count generalizing source with + | zero => simp only [Function.iterate_zero, id_eq, List.drop_zero] + | succ count ih => + rw [Function.iterate_succ_apply] + rw [ih] + simp only [List.drop_tail] + +private def fiveOriginalDynamicBitFoldInput + (index source : List Bool → List Bool) + (input : List Bool) : List Bool := + index input ++ false :: source input + +private noncomputable def fiveFamilyOriginalDynamicBitFoldInputComputable + {index source : List Bool → List Bool} + (indexComputer : BitTM index) + (sourceComputer : BitTM source) : + BitTM + (fiveOriginalDynamicBitFoldInput index source) := by + have sourceDelimiter := + GapCVP.TMComposition.computableInPolyTime + sourceComputer (prependBitComputable false) + have physical := pointwiseAppendComputable + indexComputer sourceDelimiter + change BitTM + (fun input => index input ++ false :: source input) + simpa only [Function.comp_apply] using physical + +/-- GapCVP reduction support. -/ +def fiveFamilyOriginalDynamicBitTail + (index source : List Bool → List Bool) + (input : List Bool) : List Bool := + boundedRecordFoldOutput (List.tail : List Bool → List Bool) + (fiveOriginalDynamicBitFoldInput index source input) + +private noncomputable def fiveFamilyOriginalDynamicBitTailComputable + {index source : List Bool → List Bool} + (indexComputer : BitTM index) + (sourceComputer : BitTM source) : + BitTM + (fiveFamilyOriginalDynamicBitTail index source) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyOriginalDynamicBitFoldInputComputable + indexComputer sourceComputer) + fiveFamilyOriginalBitTailFoldComputable + change BitTM + (fun input => boundedRecordFoldOutput + (List.tail : List Bool → List Bool) + (fiveOriginalDynamicBitFoldInput index source input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyOriginalDynamicBitTail_valid + (index source : List Bool → List Bool) + (input : List Bool) (position : ℕ) + (hindex : index input = List.replicate position true) : + fiveFamilyOriginalDynamicBitTail index source input = + (source input).drop position := by + unfold fiveFamilyOriginalDynamicBitTail + fiveOriginalDynamicBitFoldInput + rw [hindex] + change boundedRecordFoldOutput + (List.tail : List Bool → List Bool) + (unaryBoundedFoldWord position (source input)) = _ + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word, + fiveFamilyOriginalBitTail_iterate_eq_drop] + +/-- GapCVP reduction support. -/ +def fiveFamilyOriginalHeadBitWord : List Bool → List Bool := + markerConditionalOutput (fun _ : List Bool => [true]) [false] + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyOriginalHeadBitComputable : + BitTM + fiveFamilyOriginalHeadBitWord := + markerConditionalComputable (sourceFixedWordComputable [true]) [false] + +@[simp] theorem fiveFamilyOriginalHeadBitWord_eq + (input : List Bool) : + fiveFamilyOriginalHeadBitWord input = + [input.headD false] := by + cases input with + | nil => rfl + | cons head remaining => + cases head <;> rfl + +/-- GapCVP reduction support. -/ +def fiveFamilyOriginalDynamicBitWord + (index source : List Bool → List Bool) + (input : List Bool) : List Bool := + fiveFamilyOriginalHeadBitWord + (fiveFamilyOriginalDynamicBitTail index source input) + +/-- GapCVP reduction support. -/ +noncomputable def fiveOriginalDynamicBitComputable + {index source : List Bool → List Bool} + (indexComputer : BitTM index) + (sourceComputer : BitTM source) : + BitTM + (fiveFamilyOriginalDynamicBitWord index source) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyOriginalDynamicBitTailComputable + indexComputer sourceComputer) + fiveFamilyOriginalHeadBitComputable + change BitTM + (fun input => fiveFamilyOriginalHeadBitWord + (fiveFamilyOriginalDynamicBitTail index source input)) + simpa only [fiveFamilyOriginalHeadBitWord_eq, List.headD_eq_head?_getD, Function.comp_def] + using physical + +theorem fiveOriginalDynamicBitWord_valid + (index source : List Bool → List Bool) + (input : List Bool) (position : ℕ) + (hindex : index input = List.replicate position true) : + fiveFamilyOriginalDynamicBitWord index source input = + [((source input).drop position).headD false] := by + simp only [fiveFamilyOriginalDynamicBitWord, + fiveFamilyOriginalDynamicBitTail_valid index source input position hindex, + fiveFamilyOriginalHeadBitWord_eq, + List.headD_eq_head?_getD, List.head?_drop] + +end CNFFiveFamilyOriginalIndexedBitTM + +namespace CNFFiveFamilyFlatSortedLiteralFamilies + +open GapCVP.CL GapCVP.ThreeCNFReduction GapCVP.CNFFiniteRecordSort +open GapCVP.CNFInputDependentRecordSort + +theorem sortedElements_eq_of_nodup_source_pairwise + {α : Type} [Encodable α] + (records : Finset α) (candidate : List α) + (hmembership : ∀ record : α, + record ∈ candidate ↔ record ∈ records) + (hnodup : candidate.Nodup) + (hpairwise : candidate.Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second)) : + sortedElements records = candidate := by + classical + have hequality := sourceOrderedDistinctRecords_eq_of_nodup_pairwise + (sortedElements records) candidate + (fun record => by simpa only [mem_sortedElements] using hmembership record) + hnodup hpairwise + simpa only [sourceOrderedDistinctRecords_sortedElements] using hequality + +private def fiveSourceCellPositiveLiteralList + {T S : ℕ} (time : Time T) (position : Position T) : + List (SignedLiteral T S) := + (List.finRange (S + 1)).map fun symbol => + positive (time, position, symbol) + +@[simp] private theorem mem_fiveFamilySourceCellPositiveLiteralList + {T S : ℕ} (time : Time T) (position : Position T) + (literal : SignedLiteral T S) : + literal ∈ fiveSourceCellPositiveLiteralList time position ↔ + literal ∈ atLeastOneClause time position := by + simp only [fiveSourceCellPositiveLiteralList, List.mem_map, List.mem_finRange, true_and, + atLeastOneClause, + Finset.mem_image, Finset.mem_univ] + +private theorem fiveFamilySourceCellPositiveLiteralList_nodup + {T S : ℕ} (time : Time T) (position : Position T) : + (fiveSourceCellPositiveLiteralList + (S := S) time position).Nodup := by + unfold fiveSourceCellPositiveLiteralList + apply (List.nodup_finRange (S + 1)).map + intro first second hequal + have hsymbol := congrArg + (fun literal : SignedLiteral T S => literal.1.2.2) hequal + simpa only [positive] using hsymbol + +private theorem fiveFamilySourceCellPositiveLiteralList_pairwise + {T S : ℕ} (time : Time T) (position : Position T) : + (fiveSourceCellPositiveLiteralList + (S := S) time position).Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second) := by + unfold fiveSourceCellPositiveLiteralList + rw [List.pairwise_map] + apply (List.pairwise_lt_finRange (S + 1)).imp + intro first second hlt + change + Nat.pair + (Nat.pair time.val + (Nat.pair position.val first.val)) + (Encodable.encode true) ≤ + Nat.pair + (Nat.pair time.val + (Nat.pair position.val second.val)) + (Encodable.encode true) + apply Nat.le_of_lt + apply Nat.pair_lt_pair_left + apply Nat.pair_lt_pair_right + apply Nat.pair_lt_pair_right + exact hlt + +private theorem sortedElements_atLeastOneClause_eq_finRange + {T S : ℕ} (time : Time T) (position : Position T) : + sortedElements (atLeastOneClause (S := S) time position) = + fiveSourceCellPositiveLiteralList time position := by + apply sortedElements_eq_of_nodup_source_pairwise + · exact mem_fiveFamilySourceCellPositiveLiteralList time position + · exact fiveFamilySourceCellPositiveLiteralList_nodup time position + · exact fiveFamilySourceCellPositiveLiteralList_pairwise + time position + +private def fiveSourceAcceptancePositiveLiteralList + {T S : ℕ} (accept : Symbol S) : + List (SignedLiteral T S) := + (List.finRange (T + 1)).map fun position => + positive ((Fin.last T : Time T), position, accept) + +@[simp] private theorem mem_fiveFamilySourceAcceptancePositiveLiteralList + {T S : ℕ} (accept : Symbol S) + (literal : SignedLiteral T S) : + literal ∈ fiveSourceAcceptancePositiveLiteralList + (T := T) accept ↔ + literal ∈ acceptanceClause (T := T) accept := by + simp only [fiveSourceAcceptancePositiveLiteralList, List.mem_map, List.mem_finRange, true_and, + acceptanceClause, Finset.mem_image, Finset.mem_univ] + +private theorem fiveFamilySourceAcceptancePositiveLiteralList_nodup + {T S : ℕ} (accept : Symbol S) : + (fiveSourceAcceptancePositiveLiteralList + (T := T) accept).Nodup := by + unfold fiveSourceAcceptancePositiveLiteralList + apply (List.nodup_finRange (T + 1)).map + intro first second hequal + have hposition := congrArg + (fun literal : SignedLiteral T S => literal.1.2.1) hequal + simpa only [positive] using hposition + +private theorem fiveFamilySourceAcceptancePositiveLiteralList_pairwise + {T S : ℕ} (accept : Symbol S) : + (fiveSourceAcceptancePositiveLiteralList + (T := T) accept).Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second) := by + unfold fiveSourceAcceptancePositiveLiteralList + rw [List.pairwise_map] + apply (List.pairwise_lt_finRange (T + 1)).imp + intro first second hlt + change + Nat.pair + (Nat.pair T + (Nat.pair first.val accept.val)) + (Encodable.encode true) ≤ + Nat.pair + (Nat.pair T + (Nat.pair second.val accept.val)) + (Encodable.encode true) + apply Nat.le_of_lt + apply Nat.pair_lt_pair_left + apply Nat.pair_lt_pair_right + apply Nat.pair_lt_pair_left + exact hlt + +private theorem sortedElements_acceptanceClause_eq_finRange + {T S : ℕ} (accept : Symbol S) : + sortedElements (acceptanceClause (T := T) accept) = + fiveSourceAcceptancePositiveLiteralList + (T := T) accept := by + apply sortedElements_eq_of_nodup_source_pairwise + · exact mem_fiveFamilySourceAcceptancePositiveLiteralList accept + · exact fiveFamilySourceAcceptancePositiveLiteralList_nodup accept + · exact fiveFamilySourceAcceptancePositiveLiteralList_pairwise accept + +@[simp] private theorem fiveFamilySourceCellPositiveLiteralList_length + {T S : ℕ} (time : Time T) (position : Position T) : + (fiveSourceCellPositiveLiteralList + (S := S) time position).length = S + 1 := by + simp only [fiveSourceCellPositiveLiteralList, List.length_map, List.length_finRange] + +end CNFFiveFamilyFlatSortedLiteralFamilies + +namespace CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM + +open Computability Turing GapCVP.CL GapCVP.CLCompleteVerifierSimulation GapCVP.CLCellRowBounds +open GapCVP.BinaryEncoding GapCVP.SourceUniformTuringTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatSourceOrder GapCVP.CNFFlatStructuralRecordWorkerTM +open GapCVP.CNFFlatSourceGridDescriptorTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFFiveFamilyFlatCandidateGenerationTM +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM +open GapCVP.CNFFiveFamilyFlatSortedLiteralFamilies + +/-- GapCVP reduction support. -/ +def fiveFamilyFlatRankedSourceDescriptorWord + (grid : Polynomial ℕ) (symbol : ℕ) (sign : Bool) + (input : List Bool) : List Bool := + tableauSourceSignedLiteralDescriptorWord sign + (fiveFamilyFlatIndexedVariableCode grid symbol input) + +private noncomputable def fiveFamilyFlatRankedSourceDescriptorComputable + (grid : Polynomial ℕ) (symbol : ℕ) (sign : Bool) : + BitTM + (fiveFamilyFlatRankedSourceDescriptorWord grid symbol sign) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatIndexedVariableCodeComputable grid symbol) + (tableauSourceSignedLiteralDescriptorComputable sign) + change BitTM + (fun input => tableauSourceSignedLiteralDescriptorWord sign + (fiveFamilyFlatIndexedVariableCode grid symbol input)) + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def fiveFamilyFlatRankedSourceDuplicatedCodeWord + (grid : Polynomial ℕ) (symbol : ℕ) (sign : Bool) + (input : List Bool) : List Bool := + duplicatedUnarySignedLiteralCodeWord sign + (fiveFamilyFlatIndexedVariableCode grid symbol input) + +private noncomputable def fiveFamilyFlatRankedSourceDuplicatedCodeComputable + (grid : Polynomial ℕ) (symbol : ℕ) (sign : Bool) : + BitTM + (fiveFamilyFlatRankedSourceDuplicatedCodeWord + grid symbol sign) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatIndexedVariableCodeComputable grid symbol) + (duplicatedUnarySignedLiteralCodeComputable sign) + change BitTM + (fun input => duplicatedUnarySignedLiteralCodeWord sign + (fiveFamilyFlatIndexedVariableCode grid symbol input)) + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def fiveFlatRankedSourceDescriptorStream + (grid : Polynomial ℕ) (sign : Bool) (symbols : List ℕ) + (input : List Bool) : List Bool := + symbols.flatMap fun symbol => + fiveFamilyFlatRankedSourceDescriptorWord grid symbol sign input + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyFlatRankedSourceDescriptorStreamComputable + (grid : Polynomial ℕ) (sign : Bool) (symbols : List ℕ) : + BitTM + (fiveFlatRankedSourceDescriptorStream grid sign symbols) := by + induction symbols with + | nil => exact constantWordComputable [] + | cons symbol remaining ih => + exact pointwiseAppendComputable + (fiveFamilyFlatRankedSourceDescriptorComputable + grid symbol sign) ih + +/-- GapCVP reduction support. -/ +def fiveFlatRankedSourceDuplicatedCodeStream + (grid : Polynomial ℕ) (sign : Bool) (symbols : List ℕ) + (input : List Bool) : List Bool := + symbols.flatMap fun symbol => + fiveFamilyFlatRankedSourceDuplicatedCodeWord + grid symbol sign input + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyFlatRankedSourceDuplicatedCodeStreamComputable + (grid : Polynomial ℕ) (sign : Bool) (symbols : List ℕ) : + BitTM + (fiveFlatRankedSourceDuplicatedCodeStream + grid sign symbols) := by + induction symbols with + | nil => exact constantWordComputable [] + | cons symbol remaining ih => + exact pointwiseAppendComputable + (fiveFamilyFlatRankedSourceDuplicatedCodeComputable + grid symbol sign) ih + +private def fiveFlatRankedAtLeastDescriptorPayload + (grid : Polynomial ℕ) (alphabet : ℕ) + (input : List Bool) : List Bool := + fiveFlatRankedSourceDescriptorStream grid true + ((List.finRange alphabet).map Fin.val) input + +private noncomputable def fiveFamilyFlatRankedAtLeastDescriptorPayloadComputable + (grid : Polynomial ℕ) (alphabet : ℕ) : + BitTM + (fiveFlatRankedAtLeastDescriptorPayload grid alphabet) := + fiveFamilyFlatRankedSourceDescriptorStreamComputable grid true + ((List.finRange alphabet).map Fin.val) + +private def fiveFlatRankedAtLeastDuplicatedCodePayload + (grid : Polynomial ℕ) (alphabet : ℕ) + (input : List Bool) : List Bool := + fiveFlatRankedSourceDuplicatedCodeStream grid true + ((List.finRange alphabet).map Fin.val) input + +private noncomputable def fiveFamilyFlatRankedAtLeastDuplicatedCodePayloadComputable + (grid : Polynomial ℕ) (alphabet : ℕ) : + BitTM + (fiveFlatRankedAtLeastDuplicatedCodePayload grid alphabet) := + fiveFamilyFlatRankedSourceDuplicatedCodeStreamComputable + grid true ((List.finRange alphabet).map Fin.val) + +/-- GapCVP reduction support. -/ +def fiveFlatRowMajorAtLeastClauseRecordWord + (grid : Polynomial ℕ) (alphabet : ℕ) + (input : List Bool) : List Bool := + lengthPrefixedWord + (fiveFlatRankedAtLeastDescriptorPayload + grid alphabet input) ++ + lengthPrefixedWord + (fiveFlatRankedAtLeastDuplicatedCodePayload + grid alphabet input) ++ + lengthPrefixedWord (List.replicate alphabet true) + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyFlatRowMajorAtLeastClauseRecordComputable + (grid : Polynomial ℕ) (alphabet : ℕ) : + BitTM + (fiveFlatRowMajorAtLeastClauseRecordWord grid alphabet) := by + have descriptor := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatRankedAtLeastDescriptorPayloadComputable + grid alphabet) + structuralPrefixWriterComputable + have duplicate := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatRankedAtLeastDuplicatedCodePayloadComputable + grid alphabet) + structuralPrefixWriterComputable + have counter := constantWordComputable + (lengthPrefixedWord (List.replicate alphabet true)) + have ending := pointwiseAppendComputable duplicate counter + have physical := pointwiseAppendComputable descriptor ending + have hequality : + (fun input : List Bool => + lengthPrefixedWord + (fiveFlatRankedAtLeastDescriptorPayload + grid alphabet input) ++ + (lengthPrefixedWord + (fiveFlatRankedAtLeastDuplicatedCodePayload + grid alphabet input) ++ + lengthPrefixedWord (List.replicate alphabet true))) = + fiveFlatRowMajorAtLeastClauseRecordWord + grid alphabet := by + funext input + simp only [fiveFlatRowMajorAtLeastClauseRecordWord, List.append_assoc] + rw [← hequality] + exact physical + +/-- GapCVP reduction support. -/ +def fiveFamilyFlatSourceRowMajorIndex + {T : ℕ} (time : Time T) (position : Position T) : ℕ := + time.val * (T + 1) + position.val + +@[simp] theorem fiveFamilyFlatSourceRowMajorIndex_div + {T : ℕ} (time : Time T) (position : Position T) : + fiveFamilyFlatSourceRowMajorIndex time position / (T + 1) = + time.val := by + unfold fiveFamilyFlatSourceRowMajorIndex + have hgrid : 0 < T + 1 := by omega + have hposition : position.val < T + 1 := position.isLt + simpa only [Nat.mul_comm, Nat.div_eq_of_lt hposition, add_zero] using + (Nat.mul_add_div hgrid time.val position.val) + +@[simp] theorem fiveFamilyFlatSourceRowMajorIndex_mod + {T : ℕ} (time : Time T) (position : Position T) : + fiveFamilyFlatSourceRowMajorIndex time position % (T + 1) = + position.val := by + unfold fiveFamilyFlatSourceRowMajorIndex + simp only [Nat.mul_add_mod_of_lt position.isLt] + +theorem fiveFlatIndexedVariableCode_rowMajor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (time : Time (rowWidth bound machine original)) + (position : Position (rowWidth bound machine original)) + (symbol : Symbol (completePhaseSymbolCount machine.tm)) : + fiveFamilyFlatIndexedVariableCode + (fiveFamilyFlatIndexedGridPolynomial bound machine) symbol.val + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (Encodable.encode + ((time, position, symbol) : Variable + (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm))) true := by + have hpositive : + 0 < (fiveFamilyFlatIndexedGridPolynomial + bound machine).eval original.length := by + simp only [fiveFamilyFlatIndexedGridPolynomial_eval, lt_add_iff_pos_left, Order.lt_add_one_iff, + zero_le] + rw [fiveFamilyFlatIndexedVariableCode_valid + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbol.val (fiveFamilyFlatSourceRowMajorIndex time position) + original suffix hpositive, + fiveFamilyFlatIndexedGridPolynomial_eval, + fiveFamilyFlatSourceRowMajorIndex_div, + fiveFamilyFlatSourceRowMajorIndex_mod] + rfl + +private theorem fiveFamilyFlatRankedAtLeastDescriptorPayload_rowMajor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (time : Time (rowWidth bound machine original)) + (position : Position (rowWidth bound machine original)) : + fiveFlatRankedAtLeastDescriptorPayload + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseDescriptorPayload + (atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + time position) := by + unfold fiveFlatRankedAtLeastDescriptorPayload + fiveFlatRankedSourceDescriptorStream + rw [List.flatMap_map] + unfold flatSourceClauseDescriptorPayload + rw [sortedElements_atLeastOneClause_eq_finRange] + simp only [fiveSourceCellPositiveLiteralList, + List.map_map, flatSignedLiteralDescriptorStream, + List.flatMap_map, Function.comp_def] + apply List.flatMap_congr + intro symbol _ + change + tableauSourceSignedLiteralDescriptorWord true + (fiveFamilyFlatIndexedVariableCode + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbol.val + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix)) = _ + rw [fiveFlatIndexedVariableCode_rowMajor + bound machine original suffix time position symbol] + rw [tableauSourceSignedLiteralDescriptorWord_variable] + rfl + +private theorem fiveFamilyFlatRankedAtLeastDuplicatedCodePayload_rowMajor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (time : Time (rowWidth bound machine original)) + (position : Position (rowWidth bound machine original)) : + fiveFlatRankedAtLeastDuplicatedCodePayload + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseDuplicatedCodePayload + (atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + time position) := by + unfold fiveFlatRankedAtLeastDuplicatedCodePayload + fiveFlatRankedSourceDuplicatedCodeStream + rw [List.flatMap_map] + unfold flatSourceClauseDuplicatedCodePayload + flatSourceFinsetCodes + rw [sortedElements_atLeastOneClause_eq_finRange] + simp only [fiveSourceCellPositiveLiteralList, + List.map_map, flatDuplicatedUnarySourceStream, + List.flatMap_map, Function.comp_def] + apply List.flatMap_congr + intro symbol _ + change + duplicatedUnarySignedLiteralCodeWord true + (fiveFamilyFlatIndexedVariableCode + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbol.val + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix)) = _ + rw [fiveFlatIndexedVariableCode_rowMajor + bound machine original suffix time position symbol] + rw [duplicatedUnarySignedLiteralCodeWord_sourceVariable] + rfl + +private theorem fiveFamilyFlatAtLeastClause_exact_card + {T S : ℕ} (time : Time T) (position : Position T) : + (atLeastOneClause (S := S) time position).card = S + 1 := by + have hsort := congrArg List.length + (sortedElements_atLeastOneClause_eq_finRange + (S := S) time position) + simpa only [ThreeCNFReduction.sortedElements_length, + fiveFamilySourceCellPositiveLiteralList_length] using + hsort + +theorem fiveFamilyFlatRowMajorAtLeastClauseRecordWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (time : Time (rowWidth bound machine original)) + (position : Position (rowWidth bound machine original)) : + fiveFlatRowMajorAtLeastClauseRecordWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseAnnotatedRecord + (atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + time position) := by + unfold fiveFlatRowMajorAtLeastClauseRecordWord + flatSourceClauseAnnotatedRecord + rw [fiveFamilyFlatRankedAtLeastDescriptorPayload_rowMajor + bound machine original suffix time position, + fiveFamilyFlatRankedAtLeastDuplicatedCodePayload_rowMajor + bound machine original suffix time position] + unfold flatSourceClauseUnaryCountPayload + rw [fiveFamilyFlatAtLeastClause_exact_card] + +end CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM + +namespace CNFFiveFamilyFlatAcceptanceVariableTM + +open Computability Turing GapCVP.CL GapCVP.CLCompleteVerifierSimulation GapCVP.CLCellRowBounds +open GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceUniformTuringTM +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CNFFlatSourceGridDescriptorTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFUnaryPairIndexTM +open GapCVP.CNFUnaryPairIndexTotalRuntimeCert GapCVP.CNFFiveFamilyFlatCandidateGenerationTM +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM + +/-- GapCVP reduction support. -/ +def fiveFamilyVerifierAcceptingSymbol + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + Symbol (completePhaseSymbolCount machine.tm) := + completePhaseSymbolEquiv machine.tm + (acceptingPhaseCell machine.tm) + +private def fiveFamilyAcceptanceFinalTimeUnary + (grid : Polynomial ℕ) (input : List Bool) : List Bool := + (fiveFlatIndexedOriginalPolynomialUnary grid input).tail + +private noncomputable def fiveFamilyAcceptanceFinalTimeUnaryComputable + (grid : Polynomial ℕ) : + BitTM + (fiveFamilyAcceptanceFinalTimeUnary grid) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFlatIndexedOriginalPolynomialUnaryComputable grid) + dropHeadComputable + change BitTM + (fun input => + (fiveFlatIndexedOriginalPolynomialUnary grid input).tail) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyAcceptanceFinalTimeUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (position : ℕ) (original suffix : List Bool) : + fiveFamilyAcceptanceFinalTimeUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (lengthPrefixedWord (List.replicate position true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (rowWidth bound machine original) true := by + unfold fiveFamilyAcceptanceFinalTimeUnary + rw [fiveFamilyFlatIndexedOriginalPolynomialUnary_valid + (fiveFamilyFlatIndexedGridPolynomial bound machine) + position original suffix, + fiveFamilyFlatIndexedGridPolynomial_eval] + simp only [List.replicate_succ, List.tail_cons] + +private def fiveAcceptancePositionSymbolPairInput + (symbol : ℕ) (input : List Bool) : List Bool := + fiveFamilyFlatIndexedPhysicalRank input ++ + false :: (List.replicate symbol true ++ [false]) + +private noncomputable def fiveFamilyAcceptancePositionSymbolPairInputComputable + (symbol : ℕ) : + BitTM + (fiveAcceptancePositionSymbolPairInput symbol) := by + have physical := pointwiseAppendComputable + fiveFlatIndexedPhysicalRankComputable + (constantWordComputable + (false :: (List.replicate symbol true ++ [false]))) + exact physical + +private def fiveAcceptancePositionSymbolCode + (symbol : ℕ) (input : List Bool) : List Bool := + unarySourcePairOutput + (fiveAcceptancePositionSymbolPairInput symbol input) + +private noncomputable def fiveFamilyAcceptancePositionSymbolCodeComputable + (symbol : ℕ) : + BitTM + (fiveAcceptancePositionSymbolCode symbol) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptancePositionSymbolPairInputComputable symbol) + actualUnaryPairIndexComputable + change BitTM + (fun input => unarySourcePairOutput + (fiveAcceptancePositionSymbolPairInput symbol input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyAcceptancePositionSymbolCode_valid + (symbol position : ℕ) (original suffix : List Bool) : + fiveAcceptancePositionSymbolCode symbol + (lengthPrefixedWord (List.replicate position true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (Nat.pair position symbol) true := by + unfold fiveAcceptancePositionSymbolCode + fiveAcceptancePositionSymbolPairInput + rw [fiveFamilyFlatIndexedPhysicalRank_valid] + change unarySourcePairOutput + (unarySourcePairWord position symbol) = _ + exact unarySourcePairOutput_word position symbol + +private def fiveAcceptanceVariablePairInput + (grid : Polynomial ℕ) (symbol : ℕ) + (input : List Bool) : List Bool := + fiveFamilyAcceptanceFinalTimeUnary grid input ++ + false :: (fiveAcceptancePositionSymbolCode + symbol input ++ [false]) + +private noncomputable def fiveFamilyAcceptanceVariablePairInputComputable + (grid : Polynomial ℕ) (symbol : ℕ) : + BitTM + (fiveAcceptanceVariablePairInput grid symbol) := by + have inner := pointwiseAppendComputable + (fiveFamilyAcceptancePositionSymbolCodeComputable symbol) + (constantWordComputable [false]) + have separator := GapCVP.TMComposition.computableInPolyTime + inner (prependBitComputable false) + have physical := pointwiseAppendComputable + (fiveFamilyAcceptanceFinalTimeUnaryComputable grid) separator + change BitTM + (fun input => fiveFamilyAcceptanceFinalTimeUnary grid input ++ + false :: (fiveAcceptancePositionSymbolCode + symbol input ++ [false])) + simpa only [Function.comp_apply] using physical + +private def fiveFamilyAcceptanceVariableCode + (grid : Polynomial ℕ) (symbol : ℕ) + (input : List Bool) : List Bool := + unarySourcePairOutput + (fiveAcceptanceVariablePairInput grid symbol input) + +private noncomputable def fiveFamilyAcceptanceVariableCodeComputable + (grid : Polynomial ℕ) (symbol : ℕ) : + BitTM + (fiveFamilyAcceptanceVariableCode grid symbol) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceVariablePairInputComputable grid symbol) + actualUnaryPairIndexComputable + change BitTM + (fun input => unarySourcePairOutput + (fiveAcceptanceVariablePairInput grid symbol input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyAcceptanceVariableCode_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (position : Position (rowWidth bound machine original)) : + fiveFamilyAcceptanceVariableCode + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val + (lengthPrefixedWord + (List.replicate position.val true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (Encodable.encode + (((Fin.last (rowWidth bound machine original) : + Time (rowWidth bound machine original)), + position, fiveFamilyVerifierAcceptingSymbol machine) : + Variable (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm))) true := by + unfold fiveFamilyAcceptanceVariableCode + fiveAcceptanceVariablePairInput + rw [fiveFamilyAcceptanceFinalTimeUnary_valid + bound machine position.val original suffix, + fiveFamilyAcceptancePositionSymbolCode_valid + (fiveFamilyVerifierAcceptingSymbol machine).val + position.val original suffix] + change unarySourcePairOutput + (unarySourcePairWord + (rowWidth bound machine original) + (Nat.pair position.val + (fiveFamilyVerifierAcceptingSymbol machine).val)) = _ + rw [unarySourcePairOutput_word] + rfl + +private def fiveAcceptanceSourceDescriptorWord + (grid : Polynomial ℕ) (symbol : ℕ) + (input : List Bool) : List Bool := + tableauSourceSignedLiteralDescriptorWord true + (fiveFamilyAcceptanceVariableCode grid symbol input) + +private noncomputable def fiveFamilyAcceptanceSourceDescriptorComputable + (grid : Polynomial ℕ) (symbol : ℕ) : + BitTM + (fiveAcceptanceSourceDescriptorWord grid symbol) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceVariableCodeComputable grid symbol) + (tableauSourceSignedLiteralDescriptorComputable true) + change BitTM + (fun input => tableauSourceSignedLiteralDescriptorWord true + (fiveFamilyAcceptanceVariableCode grid symbol input)) + simpa only [Function.comp_def] using physical + +private def fiveAcceptanceSourceDuplicatedCodeWord + (grid : Polynomial ℕ) (symbol : ℕ) + (input : List Bool) : List Bool := + duplicatedUnarySignedLiteralCodeWord true + (fiveFamilyAcceptanceVariableCode grid symbol input) + +private noncomputable def fiveFamilyAcceptanceSourceDuplicatedCodeComputable + (grid : Polynomial ℕ) (symbol : ℕ) : + BitTM + (fiveAcceptanceSourceDuplicatedCodeWord grid symbol) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceVariableCodeComputable grid symbol) + (duplicatedUnarySignedLiteralCodeComputable true) + change BitTM + (fun input => duplicatedUnarySignedLiteralCodeWord true + (fiveFamilyAcceptanceVariableCode grid symbol input)) + simpa only [Function.comp_def] using physical + +end CNFFiveFamilyFlatAcceptanceVariableTM + +namespace CNFFiveFamilyFlatAcceptanceClauseFoldTM + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLCellRowBounds GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction +open GapCVP.SourceMachineCert GapCVP.SourceUniformTuringTM GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceWholeOutputValidBranchRecordTM +open GapCVP.SourceCanonicalUnaryGridIndexTM GapCVP.SourceAnchoredGridRecordFoldTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFBoundedRecordFoldTM GapCVP.CNFFlatSourceOrder +open GapCVP.CNFFlatStructuralRecordWorkerTM GapCVP.CNFFlatSourceGridDescriptorTM +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM GapCVP.CNFFiveFamilyFlatIndexedCatalogueTM +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM GapCVP.CNFTypedRecordWorkerTM +open GapCVP.CNFFiveFamilyFlatSortedLiteralFamilies GapCVP.CNFFiveFamilyFlatAcceptanceVariableTM + +private def fiveAcceptancePositionCountWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + List.replicate + ((fiveFamilyFlatIndexedGridPolynomial + bound machine).eval original.length) true + +private noncomputable def fiveAcceptancePositionCountComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptancePositionCountWord bound machine) := + polynomialValueUnaryComputable + (fiveFamilyFlatIndexedGridPolynomial bound machine) + +private def fiveAcceptancePositionEnumerationInput + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + fiveAcceptancePositionCountWord bound machine original ++ + [false] + +private noncomputable def fiveFamilyAcceptancePositionEnumerationInputComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptancePositionEnumerationInput bound machine) := + pointwiseAppendComputable + (fiveAcceptancePositionCountComputable bound machine) + (constantWordComputable [false]) + +private def fiveAcceptancePositionDescriptorWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + sourceCanonicalUnaryGridIndexOutput + (fiveAcceptancePositionEnumerationInput + bound machine original) + +private noncomputable def fiveFamilyAcceptancePositionDescriptorComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptancePositionDescriptorWord bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptancePositionEnumerationInputComputable + bound machine) + sourceCanonicalUnaryGridIndexComputable + change BitTM + (fun original => sourceCanonicalUnaryGridIndexOutput + (fiveAcceptancePositionEnumerationInput + bound machine original)) + simpa only [Function.comp_def] using physical + +@[simp] private theorem fiveFamilyAcceptancePositionDescriptorWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveAcceptancePositionDescriptorWord + bound machine original = + sourceCanonicalUnaryGridIndexDescriptors + (rowWidth bound machine original + 1) := by + simp only [fiveAcceptancePositionDescriptorWord, fiveAcceptancePositionEnumerationInput, + fiveAcceptancePositionCountWord, fiveFamilyFlatIndexedGridPolynomial_eval, + sourceCanonicalUnaryGridIndexOutput_valid, List.append_nil] + +private def fiveAcceptancePositionAnchoredFoldInput + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + fiveAcceptancePositionCountWord bound machine original ++ + false :: + (lengthPrefixedWord + (fiveFlatOriginalSourceAnchorWord + bound machine original) ++ + fiveAcceptancePositionDescriptorWord + bound machine original) + +private noncomputable def fiveFamilyAcceptancePositionAnchoredFoldInputComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptancePositionAnchoredFoldInput bound machine) := by + have anchor := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatOriginalSourceAnchorComputable bound machine) + structuralPrefixWriterComputable + have seed := pointwiseAppendComputable anchor + (fiveFamilyAcceptancePositionDescriptorComputable bound machine) + have delimiter := GapCVP.TMComposition.computableInPolyTime + seed (prependBitComputable false) + have physical := pointwiseAppendComputable + (fiveAcceptancePositionCountComputable bound machine) + delimiter + change BitTM + (fun original => + fiveAcceptancePositionCountWord bound machine original ++ + false :: + (lengthPrefixedWord + (fiveFlatOriginalSourceAnchorWord + bound machine original) ++ + fiveAcceptancePositionDescriptorWord + bound machine original)) + simpa only [fiveFamilyAcceptancePositionDescriptorWord_valid, Function.comp_apply] using physical + +private noncomputable def fiveFamilyAcceptancePositionAnchoredCatalogueComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (fun original => + boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput candidate) + (fiveAcceptancePositionAnchoredFoldInput + bound machine original)) := by + have fold := sourceAnchoredGridRecordFoldComputable computer + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptancePositionAnchoredFoldInputComputable + bound machine) fold + simpa only [Function.comp_def] using physical + +private def fiveAcceptancePositionRankWords + (count : ℕ) : List (List Bool) := + (List.range count).map fun position => + List.replicate position true + +@[simp] private theorem fiveFamilyAcceptancePositionRankWords_descriptors + (count : ℕ) : + (fiveAcceptancePositionRankWords count).flatMap + lengthPrefixedWord = + sourceCanonicalUnaryGridIndexDescriptors count := by + simp only [fiveAcceptancePositionRankWords, + sourceCanonicalUnaryGridIndexDescriptors, List.flatMap_map] + rfl + +private theorem fiveFamilyAcceptancePositionAnchoredCatalogueOutput_eq + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (candidate : List Bool → List Bool) + (original : List Bool) + (hfit : ∀ position : Fin (rowWidth bound machine original + 1), + (candidate + (lengthPrefixedWord (List.replicate position.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length) : + boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput candidate) + (fiveAcceptancePositionAnchoredFoldInput + bound machine original) = + lengthPrefixedWord + (fiveFlatOriginalSourceAnchorWord + bound machine original) ++ + (fiveAcceptancePositionRankWords + (rowWidth bound machine original + 1)).flatMap + (fun rank => lengthPrefixedWord + (candidate (lengthPrefixedWord rank ++ + fiveFlatOriginalSourceAnchorWord + bound machine original))) := by + let count := rowWidth bound machine original + 1 + let ranks := fiveAcceptancePositionRankWords count + have hranks : ranks.length = count := by + simp only [fiveAcceptancePositionRankWords, List.length_map, List.length_range, ranks] + have hfit' : ∀ rank ∈ ranks, + (candidate + (lengthPrefixedWord rank ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length := by + intro rank hrank + obtain ⟨position, hposition, rfl⟩ := List.mem_map.mp hrank + have hp : position < count := by + simpa only [List.mem_range] using hposition + exact hfit ⟨position, hp⟩ + have hseed : + fiveAcceptancePositionAnchoredFoldInput + bound machine original = + unaryBoundedFoldWord ranks.length + (lengthPrefixedWord + (fiveFlatOriginalSourceAnchorWord + bound machine original) ++ + ranks.flatMap lengthPrefixedWord ++ []) := by + simp only [fiveAcceptancePositionAnchoredFoldInput, fiveAcceptancePositionCountWord, + fiveFamilyFlatIndexedGridPolynomial_eval, fiveFamilyAcceptancePositionDescriptorWord_valid, + unaryBoundedFoldWord, + hranks, fiveFamilyAcceptancePositionRankWords_descriptors, List.append_nil, ranks, count] + rw [hseed, + boundedRecordFoldOutput_sourceAnchoredGridRecordRanks + candidate + (fiveFlatOriginalSourceAnchorWord + bound machine original) + ranks [] hfit'] + simp only [List.append_nil, ranks, count] + +@[simp] theorem fiveFamilyFlatSingletonDescriptorPayload + {T S : ℕ} (literal : SignedLiteral T S) : + flatSourceClauseDescriptorPayload ({literal} : Clause T S) = + flatSignedLiteralDescriptor (sourceLiteral literal) := by + simp only [flatSourceClauseDescriptorPayload, flatSignedLiteralDescriptorStream, sortedElements, + Finset.sort_singleton, List.map_cons, List.map_nil, List.flatMap_cons, List.flatMap_nil, + List.append_nil] + +@[simp] theorem fiveFamilyFlatSingletonDuplicatedCodePayload + {T S : ℕ} (literal : SignedLiteral T S) : + flatSourceClauseDuplicatedCodePayload ({literal} : Clause T S) = + flatDuplicatedUnaryField (Encodable.encode literal) := by + simp only [flatSourceClauseDuplicatedCodePayload, flatDuplicatedUnarySourceStream, + flatSourceFinsetCodes, + sortedElements, Finset.sort_singleton, List.map_cons, List.map_nil, List.flatMap_cons, + List.flatMap_nil, + List.append_nil] + +private theorem fiveFamilyFlatSingletonDescriptor_length_le + {T S : ℕ} (literal : SignedLiteral T S) : + (flatSignedLiteralDescriptor (sourceLiteral literal)).length ≤ + flatSourceAnnotatedClauseLengthBound T S := by + have hrecord := flatSourceClauseAnnotatedRecord_length_le + ({literal} : Clause T S) + have hcontained : + (flatSignedLiteralDescriptor (sourceLiteral literal)).length ≤ + (flatSourceClauseAnnotatedRecord + ({literal} : Clause T S)).length := by + unfold flatSourceClauseAnnotatedRecord + simp only [List.length_append, lengthPrefixedWord_length, + fiveFamilyFlatSingletonDescriptorPayload] + omega + exact hcontained.trans hrecord + +private theorem fiveFamilyFlatSingletonDuplicatedCode_length_le + {T S : ℕ} (literal : SignedLiteral T S) : + (flatDuplicatedUnaryField (Encodable.encode literal)).length ≤ + flatSourceAnnotatedClauseLengthBound T S := by + have hrecord := flatSourceClauseAnnotatedRecord_length_le + ({literal} : Clause T S) + have hcontained : + (flatDuplicatedUnaryField (Encodable.encode literal)).length ≤ + (flatSourceClauseAnnotatedRecord + ({literal} : Clause T S)).length := by + unfold flatSourceClauseAnnotatedRecord + simp only [List.length_append, lengthPrefixedWord_length, + fiveFamilyFlatSingletonDuplicatedCodePayload] + omega + exact hcontained.trans hrecord + +private theorem fiveFamilyAcceptanceSourceDescriptorWord_anchor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) : + fiveAcceptanceSourceDescriptorWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val + (lengthPrefixedWord (List.replicate position.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original) = + flatSignedLiteralDescriptor + (sourceLiteral + (positive + ((Fin.last (rowWidth bound machine original) : + Time (rowWidth bound machine original)), + position, fiveFamilyVerifierAcceptingSymbol machine))) := by + unfold fiveAcceptanceSourceDescriptorWord + unfold fiveFlatOriginalSourceAnchorWord + simp only [← List.append_assoc] + rw [fiveFamilyAcceptanceVariableCode_valid + bound machine original + (List.replicate + ((flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval + original.length) true) + position] + rw [tableauSourceSignedLiteralDescriptorWord_variable] + rfl + +private theorem fiveFamilyAcceptanceSourceDuplicatedCodeWord_anchor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) : + fiveAcceptanceSourceDuplicatedCodeWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val + (lengthPrefixedWord (List.replicate position.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original) = + flatDuplicatedUnaryField + (Encodable.encode + (positive + ((Fin.last (rowWidth bound machine original) : + Time (rowWidth bound machine original)), + position, fiveFamilyVerifierAcceptingSymbol machine))) := by + unfold fiveAcceptanceSourceDuplicatedCodeWord + unfold fiveFlatOriginalSourceAnchorWord + simp only [← List.append_assoc] + rw [fiveFamilyAcceptanceVariableCode_valid + bound machine original + (List.replicate + ((flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval + original.length) true) + position] + rw [duplicatedUnarySignedLiteralCodeWord_sourceVariable] + rfl + +private theorem fiveFamilyAcceptanceSourceDescriptor_fits_anchor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) : + (fiveAcceptanceSourceDescriptorWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val + (lengthPrefixedWord (List.replicate position.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length := by + rw [fiveFamilyAcceptanceSourceDescriptorWord_anchor] + have hbound := fiveFamilyFlatSingletonDescriptor_length_le + (positive + ((Fin.last (rowWidth bound machine original) : + Time (rowWidth bound machine original)), + position, fiveFamilyVerifierAcceptingSymbol machine)) + rw [flatSourceAnnotatedClauseLengthBound_eq_polynomial + bound machine original] at hbound + simp only [fiveFlatOriginalSourceAnchorWord, + List.length_append, List.length_replicate] + omega + +private theorem fiveFamilyAcceptanceSourceDuplicatedCode_fits_anchor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) : + (fiveAcceptanceSourceDuplicatedCodeWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val + (lengthPrefixedWord (List.replicate position.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length := by + rw [fiveFamilyAcceptanceSourceDuplicatedCodeWord_anchor] + have hbound := fiveFamilyFlatSingletonDuplicatedCode_length_le + (positive + ((Fin.last (rowWidth bound machine original) : + Time (rowWidth bound machine original)), + position, fiveFamilyVerifierAcceptingSymbol machine)) + rw [flatSourceAnnotatedClauseLengthBound_eq_polynomial + bound machine original] at hbound + simp only [fiveFlatOriginalSourceAnchorWord, + List.length_append, List.length_replicate] + omega + +private theorem fiveFamilyAcceptancePositionRankWords_eq_finRange + (count : ℕ) : + fiveAcceptancePositionRankWords count = + (List.finRange count).map fun position => + List.replicate position.val true := by + unfold fiveAcceptancePositionRankWords + rw [← List.map_coe_finRange_eq_range (n := count)] + simp only [List.map_map, Function.comp_def] + +private def fiveAcceptanceDescriptorRecords + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List (List Bool) := + (List.finRange (rowWidth bound machine original + 1)).map + fun position => + flatSignedLiteralDescriptor + (sourceLiteral + (positive + ((Fin.last (rowWidth bound machine original) : + Time (rowWidth bound machine original)), + position, fiveFamilyVerifierAcceptingSymbol machine))) + +private def fiveAcceptanceDuplicatedCodeRecords + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List (List Bool) := + (List.finRange (rowWidth bound machine original + 1)).map + fun position => + flatDuplicatedUnaryField + (Encodable.encode + (positive + ((Fin.last (rowWidth bound machine original) : + Time (rowWidth bound machine original)), + position, fiveFamilyVerifierAcceptingSymbol machine))) + +private def fiveAcceptanceBundledDescriptorWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (fiveAcceptanceSourceDescriptorWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val)) + (fiveAcceptancePositionAnchoredFoldInput + bound machine original)) + +private noncomputable def fiveFamilyAcceptanceBundledDescriptorComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptanceBundledDescriptorWord bound machine) := by + have catalogue := + fiveFamilyAcceptancePositionAnchoredCatalogueComputable + bound machine + (fiveFamilyAcceptanceSourceDescriptorComputable + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val) + have physical := GapCVP.TMComposition.computableInPolyTime + catalogue firstFieldSuffixComputable + change BitTM + (fun original => firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (fiveAcceptanceSourceDescriptorWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val)) + (fiveAcceptancePositionAnchoredFoldInput + bound machine original))) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyAcceptanceBundledDescriptorWord_eq + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveAcceptanceBundledDescriptorWord + bound machine original = + sourceFlatAtomicDescriptorStream + (fiveAcceptanceDescriptorRecords + bound machine original) := by + unfold fiveAcceptanceBundledDescriptorWord + rw [fiveFamilyAcceptancePositionAnchoredCatalogueOutput_eq + bound machine + (fiveAcceptanceSourceDescriptorWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val) + original + (fiveFamilyAcceptanceSourceDescriptor_fits_anchor + bound machine original)] + simp only [firstFieldSuffix_valid] + rw [fiveFamilyAcceptancePositionRankWords_eq_finRange] + unfold fiveAcceptanceDescriptorRecords + sourceFlatAtomicDescriptorStream + simp only [List.flatMap_map] + apply List.flatMap_congr + intro position _ + rw [fiveFamilyAcceptanceSourceDescriptorWord_anchor + bound machine original position] + rfl + +private def fiveAcceptanceBundledDuplicatedCodeWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (fiveAcceptanceSourceDuplicatedCodeWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val)) + (fiveAcceptancePositionAnchoredFoldInput + bound machine original)) + +private noncomputable def fiveFamilyAcceptanceBundledDuplicatedCodeComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptanceBundledDuplicatedCodeWord bound machine) := by + have catalogue := + fiveFamilyAcceptancePositionAnchoredCatalogueComputable + bound machine + (fiveFamilyAcceptanceSourceDuplicatedCodeComputable + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val) + have physical := GapCVP.TMComposition.computableInPolyTime + catalogue firstFieldSuffixComputable + change BitTM + (fun original => firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (fiveAcceptanceSourceDuplicatedCodeWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val)) + (fiveAcceptancePositionAnchoredFoldInput + bound machine original))) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyAcceptanceBundledDuplicatedCodeWord_eq + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveAcceptanceBundledDuplicatedCodeWord + bound machine original = + sourceFlatAtomicDescriptorStream + (fiveAcceptanceDuplicatedCodeRecords + bound machine original) := by + unfold fiveAcceptanceBundledDuplicatedCodeWord + rw [fiveFamilyAcceptancePositionAnchoredCatalogueOutput_eq + bound machine + (fiveAcceptanceSourceDuplicatedCodeWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyVerifierAcceptingSymbol machine).val) + original + (fiveFamilyAcceptanceSourceDuplicatedCode_fits_anchor + bound machine original)] + simp only [firstFieldSuffix_valid] + rw [fiveFamilyAcceptancePositionRankWords_eq_finRange] + unfold fiveAcceptanceDuplicatedCodeRecords + sourceFlatAtomicDescriptorStream + simp only [List.flatMap_map] + apply List.flatMap_congr + intro position _ + rw [fiveFamilyAcceptanceSourceDuplicatedCodeWord_anchor + bound machine original position] + rfl + +private def fiveAcceptanceDescriptorUnwrappingInput + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + fiveAcceptancePositionCountWord bound machine original ++ + false :: fiveAcceptanceBundledDescriptorWord + bound machine original + +private noncomputable def fiveFamilyAcceptanceDescriptorUnwrappingInputComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptanceDescriptorUnwrappingInput bound machine) := by + have delimited := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceBundledDescriptorComputable bound machine) + (prependBitComputable false) + have physical := pointwiseAppendComputable + (fiveAcceptancePositionCountComputable bound machine) + delimited + change BitTM + (fun original => + fiveAcceptancePositionCountWord bound machine original ++ + false :: fiveAcceptanceBundledDescriptorWord + bound machine original) + simpa only [Function.comp_apply] using physical + +private def fiveAcceptanceDescriptorPayloadWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + boundedRecordFoldOutput sourceFlatAtomicRecordStep + (fiveAcceptanceDescriptorUnwrappingInput + bound machine original) + +private noncomputable def fiveFamilyAcceptanceDescriptorPayloadComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptanceDescriptorPayloadWord bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceDescriptorUnwrappingInputComputable + bound machine) + sourceFlatAtomicRecordFoldComputable + change BitTM + (fun original => boundedRecordFoldOutput + sourceFlatAtomicRecordStep + (fiveAcceptanceDescriptorUnwrappingInput + bound machine original)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyAcceptanceDescriptorPayloadWord_eq + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveAcceptanceDescriptorPayloadWord + bound machine original = + flatSourceClauseDescriptorPayload + (acceptanceClause + (T := rowWidth bound machine original) + (fiveFamilyVerifierAcceptingSymbol machine)) := by + unfold fiveAcceptanceDescriptorPayloadWord + fiveAcceptanceDescriptorUnwrappingInput + rw [fiveFamilyAcceptanceBundledDescriptorWord_eq] + have hlength : + (fiveAcceptanceDescriptorRecords + bound machine original).length = + rowWidth bound machine original + 1 := by + simp only [fiveAcceptanceDescriptorRecords, List.length_map, List.length_finRange] + simp only [fiveAcceptancePositionCountWord, + fiveFamilyFlatIndexedGridPolynomial_eval] + rw [← hlength] + change + boundedRecordFoldOutput sourceFlatAtomicRecordStep + (unaryBoundedFoldWord + (fiveAcceptanceDescriptorRecords + bound machine original).length + (sourceFlatAtomicDescriptorStream + (fiveAcceptanceDescriptorRecords + bound machine original))) = _ + rw [boundedRecordFoldOutput_sourceFlatAtomicDescriptors] + unfold fiveAcceptanceDescriptorRecords + flatSourceClauseDescriptorPayload + rw [sortedElements_acceptanceClause_eq_finRange] + simp only [fiveSourceAcceptancePositiveLiteralList, + flatSignedLiteralDescriptorStream, List.flatten_eq_flatMap, + List.flatMap_map, List.map_map, Function.comp_def, id_eq] + +private def fiveAcceptanceDuplicatedCodeUnwrappingInput + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + fiveAcceptancePositionCountWord bound machine original ++ + false :: fiveAcceptanceBundledDuplicatedCodeWord + bound machine original + +private noncomputable def fiveFamilyAcceptanceDuplicatedCodeUnwrappingInputComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptanceDuplicatedCodeUnwrappingInput + bound machine) := by + have delimited := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceBundledDuplicatedCodeComputable + bound machine) + (prependBitComputable false) + have physical := pointwiseAppendComputable + (fiveAcceptancePositionCountComputable bound machine) + delimited + change BitTM + (fun original => + fiveAcceptancePositionCountWord bound machine original ++ + false :: fiveAcceptanceBundledDuplicatedCodeWord + bound machine original) + simpa only [Function.comp_apply] using physical + +private def fiveAcceptanceDuplicatedCodePayloadWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + boundedRecordFoldOutput sourceFlatAtomicRecordStep + (fiveAcceptanceDuplicatedCodeUnwrappingInput + bound machine original) + +private noncomputable def fiveFamilyAcceptanceDuplicatedCodePayloadComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveAcceptanceDuplicatedCodePayloadWord + bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceDuplicatedCodeUnwrappingInputComputable + bound machine) + sourceFlatAtomicRecordFoldComputable + change BitTM + (fun original => boundedRecordFoldOutput + sourceFlatAtomicRecordStep + (fiveAcceptanceDuplicatedCodeUnwrappingInput + bound machine original)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyAcceptanceDuplicatedCodePayloadWord_eq + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveAcceptanceDuplicatedCodePayloadWord + bound machine original = + flatSourceClauseDuplicatedCodePayload + (acceptanceClause + (T := rowWidth bound machine original) + (fiveFamilyVerifierAcceptingSymbol machine)) := by + unfold fiveAcceptanceDuplicatedCodePayloadWord + fiveAcceptanceDuplicatedCodeUnwrappingInput + rw [fiveFamilyAcceptanceBundledDuplicatedCodeWord_eq] + have hlength : + (fiveAcceptanceDuplicatedCodeRecords + bound machine original).length = + rowWidth bound machine original + 1 := by + simp only [fiveAcceptanceDuplicatedCodeRecords, List.length_map, List.length_finRange] + simp only [fiveAcceptancePositionCountWord, + fiveFamilyFlatIndexedGridPolynomial_eval] + rw [← hlength] + change + boundedRecordFoldOutput sourceFlatAtomicRecordStep + (unaryBoundedFoldWord + (fiveAcceptanceDuplicatedCodeRecords + bound machine original).length + (sourceFlatAtomicDescriptorStream + (fiveAcceptanceDuplicatedCodeRecords + bound machine original))) = _ + rw [boundedRecordFoldOutput_sourceFlatAtomicDescriptors] + unfold fiveAcceptanceDuplicatedCodeRecords + flatSourceClauseDuplicatedCodePayload flatSourceFinsetCodes + rw [sortedElements_acceptanceClause_eq_finRange] + simp only [fiveSourceAcceptancePositiveLiteralList, + flatDuplicatedUnarySourceStream, List.flatten_eq_flatMap, + List.flatMap_map, List.map_map, Function.comp_def, id_eq] + +/-- GapCVP reduction support. -/ +def fiveFlatWholeAcceptanceClauseRecordWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + lengthPrefixedWord + (fiveAcceptanceDescriptorPayloadWord + bound machine original) ++ + lengthPrefixedWord + (fiveAcceptanceDuplicatedCodePayloadWord + bound machine original) ++ + lengthPrefixedWord + (fiveAcceptancePositionCountWord + bound machine original) + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyFlatWholeAcceptanceClauseRecordComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveFlatWholeAcceptanceClauseRecordWord + bound machine) := by + have descriptors := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceDescriptorPayloadComputable + bound machine) + structuralPrefixWriterComputable + have codes := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyAcceptanceDuplicatedCodePayloadComputable + bound machine) + structuralPrefixWriterComputable + have count := GapCVP.TMComposition.computableInPolyTime + (fiveAcceptancePositionCountComputable + bound machine) + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable + descriptors (pointwiseAppendComputable codes count) + change BitTM + (fun original => + lengthPrefixedWord + (fiveAcceptanceDescriptorPayloadWord + bound machine original) ++ + lengthPrefixedWord + (fiveAcceptanceDuplicatedCodePayloadWord + bound machine original) ++ + lengthPrefixedWord + (fiveAcceptancePositionCountWord + bound machine original)) + simpa only [List.append_assoc, Function.comp_apply] using physical + +theorem fiveFamilyFlatWholeAcceptanceClauseRecordWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveFlatWholeAcceptanceClauseRecordWord + bound machine original = + flatSourceClauseAnnotatedRecord + (acceptanceClause + (T := rowWidth bound machine original) + (fiveFamilyVerifierAcceptingSymbol machine)) := by + unfold fiveFlatWholeAcceptanceClauseRecordWord + flatSourceClauseAnnotatedRecord + rw [fiveFamilyAcceptanceDescriptorPayloadWord_eq, + fiveFamilyAcceptanceDuplicatedCodePayloadWord_eq] + congr 2 + unfold flatSourceClauseUnaryCountPayload + fiveAcceptancePositionCountWord + rw [acceptanceClause_exact_card, + fiveFamilyFlatIndexedGridPolynomial_eval] + +end CNFFiveFamilyFlatAcceptanceClauseFoldTM + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part07.lean b/LeanPool/GapCVP/Part07.lean new file mode 100644 index 000000000..d6d9c46d2 --- /dev/null +++ b/LeanPool/GapCVP/Part07.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part07G + +/-! # GapCVP proof, part 07 -/ diff --git a/LeanPool/GapCVP/Part07A.lean b/LeanPool/GapCVP/Part07A.lean new file mode 100644 index 000000000..21f3b61d8 --- /dev/null +++ b/LeanPool/GapCVP/Part07A.lean @@ -0,0 +1,1976 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part06 + +/-! # GapCVP proof, part 07 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiveFamilyFlatRowMajorAtMostClauseWorkerTM + +open Computability Turing GapCVP.CL GapCVP.CLCompleteVerifierSimulation GapCVP.CLCellRowBounds +open GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction GapCVP.SourceUniformTuringTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatSourceOrder +open GapCVP.CNFFlatStructuralRecordWorkerTM GapCVP.CNFFlatSourceGridDescriptorTM +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM +open GapCVP.CNFFiveFamilyFlatSortedLiteralFamilies +open GapCVP.CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM +open GapCVP.CNFFiveFamilyFlatAcceptanceClauseFoldTM + +private def fiveSourceCellNegativePairLiteralList + {T S : ℕ} (time : Time T) (position : Position T) + (first second : Symbol S) : List (SignedLiteral T S) := + [negative (time, position, first), + negative (time, position, second)] + +private theorem sortedElements_atMostOneClause_eq_pair + {T S : ℕ} (time : Time T) (position : Position T) + (first second : Symbol S) (hpair : first < second) : + sortedElements (atMostOneClause time position first second) = + fiveSourceCellNegativePairLiteralList + time position first second := by + apply sortedElements_eq_of_nodup_source_pairwise + · intro literal + simp only [fiveSourceCellNegativePairLiteralList, List.mem_cons, List.not_mem_nil, or_false, + atMostOneClause, + Finset.mem_insert, Finset.mem_singleton] + · simp only [fiveSourceCellNegativePairLiteralList, negative, List.nodup_cons, List.mem_cons, + Prod.mk.injEq, + ne_of_lt hpair, and_false, and_true, List.not_mem_nil, or_self, not_false_eq_true, + List.nodup_nil, and_self] + · have hcode : + Encodable.encode (negative (time, position, first)) ≤ + Encodable.encode (negative (time, position, second)) := by + change + Nat.pair + (Nat.pair time.val + (Nat.pair position.val first.val)) + (Encodable.encode false) ≤ + Nat.pair + (Nat.pair time.val + (Nat.pair position.val second.val)) + (Encodable.encode false) + apply Nat.le_of_lt + apply Nat.pair_lt_pair_left + apply Nat.pair_lt_pair_right + apply Nat.pair_lt_pair_right + exact hpair + simpa only [fiveSourceCellNegativePairLiteralList, List.pairwise_cons, List.mem_cons, + List.not_mem_nil, + or_false, forall_eq, IsEmpty.forall_iff, implies_true, List.Pairwise.nil, and_self, + and_true, ge_iff_le] using hcode + +private def fiveFlatRankedAtMostDescriptorPayload + (grid : Polynomial ℕ) (first second : ℕ) + (input : List Bool) : List Bool := + fiveFlatRankedSourceDescriptorStream grid false + [first, second] input + +private noncomputable def fiveFamilyFlatRankedAtMostDescriptorPayloadComputable + (grid : Polynomial ℕ) (first second : ℕ) : + BitTM + (fiveFlatRankedAtMostDescriptorPayload + grid first second) := + fiveFamilyFlatRankedSourceDescriptorStreamComputable + grid false [first, second] + +private def fiveFlatRankedAtMostDuplicatedCodePayload + (grid : Polynomial ℕ) (first second : ℕ) + (input : List Bool) : List Bool := + fiveFlatRankedSourceDuplicatedCodeStream grid false + [first, second] input + +private noncomputable def fiveFamilyFlatRankedAtMostDuplicatedCodePayloadComputable + (grid : Polynomial ℕ) (first second : ℕ) : + BitTM + (fiveFlatRankedAtMostDuplicatedCodePayload + grid first second) := + fiveFamilyFlatRankedSourceDuplicatedCodeStreamComputable + grid false [first, second] + +/-- GapCVP reduction support. -/ +def fiveFlatRowMajorAtMostClauseRecordWord + (grid : Polynomial ℕ) (first second : ℕ) + (input : List Bool) : List Bool := + lengthPrefixedWord + (fiveFlatRankedAtMostDescriptorPayload + grid first second input) ++ + lengthPrefixedWord + (fiveFlatRankedAtMostDuplicatedCodePayload + grid first second input) ++ + lengthPrefixedWord [true, true] + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveFamilyFlatRowMajorAtMostClauseRecordComputable + (grid : Polynomial ℕ) (first second : ℕ) : + BitTM + (fiveFlatRowMajorAtMostClauseRecordWord + grid first second) := by + have descriptors := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatRankedAtMostDescriptorPayloadComputable + grid first second) + structuralPrefixWriterComputable + have codes := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatRankedAtMostDuplicatedCodePayloadComputable + grid first second) + structuralPrefixWriterComputable + have count := constantWordComputable + (lengthPrefixedWord [true, true]) + have physical := pointwiseAppendComputable + descriptors (pointwiseAppendComputable codes count) + change BitTM + (fun input => + lengthPrefixedWord + (fiveFlatRankedAtMostDescriptorPayload + grid first second input) ++ + lengthPrefixedWord + (fiveFlatRankedAtMostDuplicatedCodePayload + grid first second input) ++ + lengthPrefixedWord [true, true]) + simpa only [List.append_assoc, Function.comp_apply] using physical + +private theorem fiveFamilyFlatRankedAtMostDescriptorPayload_rowMajor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (time : Time (rowWidth bound machine original)) + (position : Position (rowWidth bound machine original)) + (first second : Symbol (completePhaseSymbolCount machine.tm)) + (hpair : first < second) : + fiveFlatRankedAtMostDescriptorPayload + (fiveFamilyFlatIndexedGridPolynomial bound machine) + first.val second.val + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseDescriptorPayload + (atMostOneClause time position first second) := by + unfold fiveFlatRankedAtMostDescriptorPayload + fiveFlatRankedSourceDescriptorStream + flatSourceClauseDescriptorPayload + rw [sortedElements_atMostOneClause_eq_pair + time position first second hpair] + simp only [fiveSourceCellNegativePairLiteralList, + flatSignedLiteralDescriptorStream, List.map_cons, + List.map_nil, List.flatMap_cons, List.flatMap_nil, + List.append_nil] + unfold fiveFamilyFlatRankedSourceDescriptorWord + rw [fiveFlatIndexedVariableCode_rowMajor + bound machine original suffix time position first, + fiveFlatIndexedVariableCode_rowMajor + bound machine original suffix time position second, + tableauSourceSignedLiteralDescriptorWord_variable, + tableauSourceSignedLiteralDescriptorWord_variable] + rfl + +private theorem fiveFamilyFlatRankedAtMostDuplicatedCodePayload_rowMajor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (time : Time (rowWidth bound machine original)) + (position : Position (rowWidth bound machine original)) + (first second : Symbol (completePhaseSymbolCount machine.tm)) + (hpair : first < second) : + fiveFlatRankedAtMostDuplicatedCodePayload + (fiveFamilyFlatIndexedGridPolynomial bound machine) + first.val second.val + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseDuplicatedCodePayload + (atMostOneClause time position first second) := by + unfold fiveFlatRankedAtMostDuplicatedCodePayload + fiveFlatRankedSourceDuplicatedCodeStream + flatSourceClauseDuplicatedCodePayload flatSourceFinsetCodes + rw [sortedElements_atMostOneClause_eq_pair + time position first second hpair] + simp only [fiveSourceCellNegativePairLiteralList, + flatDuplicatedUnarySourceStream, List.map_cons, + List.map_nil, List.flatMap_cons, List.flatMap_nil, + List.append_nil] + unfold fiveFamilyFlatRankedSourceDuplicatedCodeWord + rw [fiveFlatIndexedVariableCode_rowMajor + bound machine original suffix time position first, + fiveFlatIndexedVariableCode_rowMajor + bound machine original suffix time position second, + duplicatedUnarySignedLiteralCodeWord_sourceVariable, + duplicatedUnarySignedLiteralCodeWord_sourceVariable] + rfl + +private theorem fiveFamilyFlatAtMostClause_exact_card + {T S : ℕ} (time : Time T) (position : Position T) + (first second : Symbol S) (hpair : first < second) : + (atMostOneClause time position first second).card = 2 := by + have hsort := congrArg List.length + (sortedElements_atMostOneClause_eq_pair + time position first second hpair) + simpa only [sortedElements_length, fiveSourceCellNegativePairLiteralList, List.length_cons, + List.length_nil, + zero_add, Nat.reduceAdd] using hsort + +theorem fiveFamilyFlatRowMajorAtMostClauseRecordWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (time : Time (rowWidth bound machine original)) + (position : Position (rowWidth bound machine original)) + (first second : Symbol (completePhaseSymbolCount machine.tm)) + (hpair : first < second) : + fiveFlatRowMajorAtMostClauseRecordWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + first.val second.val + (lengthPrefixedWord + (List.replicate + (fiveFamilyFlatSourceRowMajorIndex time position) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseAnnotatedRecord + (atMostOneClause time position first second) := by + unfold fiveFlatRowMajorAtMostClauseRecordWord + flatSourceClauseAnnotatedRecord + rw [fiveFamilyFlatRankedAtMostDescriptorPayload_rowMajor + bound machine original suffix time position first second hpair, + fiveFamilyFlatRankedAtMostDuplicatedCodePayload_rowMajor + bound machine original suffix time position first second hpair] + unfold flatSourceClauseUnaryCountPayload + rw [fiveFamilyFlatAtMostClause_exact_card + time position first second hpair] + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveFlatSourceVariableSingletonRecordWord + (sign : Bool) (input : List Bool) : List Bool := + lengthPrefixedWord + (tableauSourceSignedLiteralDescriptorWord sign input) ++ + lengthPrefixedWord + (duplicatedUnarySignedLiteralCodeWord sign input) ++ + lengthPrefixedWord [true] + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveFamilyFlatSourceVariableSingletonRecordComputable + (sign : Bool) : + BitTM + (fiveFlatSourceVariableSingletonRecordWord sign) := by + have descriptors := GapCVP.TMComposition.computableInPolyTime + (tableauSourceSignedLiteralDescriptorComputable sign) + structuralPrefixWriterComputable + have codes := GapCVP.TMComposition.computableInPolyTime + (duplicatedUnarySignedLiteralCodeComputable sign) + structuralPrefixWriterComputable + have count := constantWordComputable + (lengthPrefixedWord [true]) + have physical := pointwiseAppendComputable + descriptors (pointwiseAppendComputable codes count) + change BitTM + (fun input => + lengthPrefixedWord + (tableauSourceSignedLiteralDescriptorWord sign input) ++ + lengthPrefixedWord + (duplicatedUnarySignedLiteralCodeWord sign input) ++ + lengthPrefixedWord [true]) + simpa only [List.append_assoc, Function.comp_apply] using physical + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyFlatSourceVariableSingletonRecordWord_valid + {T S : ℕ} (atom : Variable T S) (sign : Bool) : + fiveFlatSourceVariableSingletonRecordWord sign + (List.replicate (Encodable.encode atom) true) = + flatSourceClauseAnnotatedRecord + ({(atom, sign)} : Clause T S) := by + unfold fiveFlatSourceVariableSingletonRecordWord + flatSourceClauseAnnotatedRecord + rw [tableauSourceSignedLiteralDescriptorWord_variable, + duplicatedUnarySignedLiteralCodeWord_sourceVariable, + fiveFamilyFlatSingletonDescriptorPayload, + fiveFamilyFlatSingletonDuplicatedCodePayload] + unfold flatSourceClauseUnaryCountPayload + simp only [Encodable.encode_prod_val, List.append_assoc, sourceLiteral, Finset.card_singleton, + List.replicate_one] + +end CNFFiveFamilyFlatRowMajorAtMostClauseWorkerTM + +namespace SourceFourFamilyMarkerRotationTM + +open Turing GapCVP.BinaryEncoding GapCVP.FormulaSemanticCert +open GapCVP.SourceFormulaStructuralDecoder GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceWholeOutputValidBranchRecordTM +open GapCVP.SourceMixedRadixPreservedFourFamilyRecordTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM +open GapCVP.SourceMixedRadixPolynomialPaddedDescriptorFoldTM + +/-- GapCVP reduction support. -/ +def fourFamilyOriginalMarkerRotationOutput + (marker : List Bool → List Bool) (input : List Bool) : List Bool := + firstFieldSuffix + (sourceFlatAtomicRecordStep + (sourcePreservedPhysicalAtomicDescriptorOutput + (sourceMixedRadixGuardedOriginalAtomOutput marker) + input)).tail + +/-- GapCVP reduction support. -/ +noncomputable def sourceFourFamilyOriginalMarkerRotationComputable + {marker : List Bool → List Bool} + (computer : BitTM marker) : + BitTM + (fourFamilyOriginalMarkerRotationOutput marker) := by + have hguard := sourceMixedRadixGuardedOriginalAtomComputable + computer + have hpreserved := sourcePreservedPhysicalAtomicDescriptorComputable + hguard + have hrecord := GapCVP.TMComposition.computableInPolyTime + hpreserved sourceFlatAtomicRecordComputable + have htail := GapCVP.TMComposition.computableInPolyTime + hrecord dropHeadComputable + have hsuffix := GapCVP.TMComposition.computableInPolyTime + htail firstFieldSuffixComputable + change BitTM + (fun input => firstFieldSuffix + (sourceFlatAtomicRecordStep + (sourcePreservedPhysicalAtomicDescriptorOutput + (sourceMixedRadixGuardedOriginalAtomOutput marker) + input)).tail) + simpa only [sourcePreservedPhysicalAtomicDescriptorOutput_eq, + sourceFlatAtomicRecordStep_descriptor, + List.cons_append, List.tail_cons, Function.comp_def] using hsuffix + +theorem sourceFourFamilyOriginalMarkerRotationOutput_eq + (marker : List Bool → List Bool) (input : List Bool) : + fourFamilyOriginalMarkerRotationOutput marker input = + firstFieldSuffix + (input ++ marker (firstFieldContents input)) := by + unfold fourFamilyOriginalMarkerRotationOutput + rw [sourcePreservedPhysicalAtomicDescriptorOutput_eq] + rw [sourceFlatAtomicRecordStep_descriptor] + simp only [sourceMixedRadixGuardedOriginalAtomOutput, Function.comp_apply, List.cons_append, + List.tail_cons] + +@[simp] private theorem sourceFourFamilyOriginalMarkerRotationOutput_query + (marker : List Bool → List Bool) + (query suffix : List Bool) : + fourFamilyOriginalMarkerRotationOutput marker + (lengthPrefixedWord query ++ suffix) = + suffix ++ marker query := by + rw [sourceFourFamilyOriginalMarkerRotationOutput_eq] + simp only [firstFieldContents_valid, List.append_assoc, firstFieldSuffix_valid] + +/-- GapCVP reduction support. -/ +def fourFamilyOriginalMarkerStream + (marker : List Bool → List Bool) + (queries : List (List Bool)) : List Bool := + queries.flatMap marker + +private theorem sourceFourFamilyOriginalMarkerRotation_iterate_queries + (marker : List Bool → List Bool) + (queries : List (List Bool)) (suffix : List Bool) : + ((fourFamilyOriginalMarkerRotationOutput marker)^[ + queries.length]) + (sourceMixedRadixOriginalSourceQueryStream queries ++ suffix) = + suffix ++ fourFamilyOriginalMarkerStream + marker queries := by + induction queries generalizing suffix with + | nil => + simp only [List.length_nil, sourceMixedRadixOriginalSourceQueryStream, List.flatMap_nil, + List.nil_append, + Function.iterate_zero, id_eq, fourFamilyOriginalMarkerStream, List.append_nil] + | cons query remaining ih => + rw [List.length_cons, Function.iterate_succ_apply] + simp only [sourceMixedRadixOriginalSourceQueryStream, + fourFamilyOriginalMarkerStream, + List.flatMap_cons, List.append_assoc] + rw [sourceFourFamilyOriginalMarkerRotationOutput_query] + simpa only [List.append_assoc, sourceMixedRadixOriginalSourceQueryStream, + fourFamilyOriginalMarkerStream] using ih (suffix ++ marker query) + +theorem sourceFourFamilyFirstFieldSuffix_length_le + (input : List Bool) : + (firstFieldSuffix input).length ≤ input.length := by + exact + sourceMixedRadixPhysicalFirstFieldSuffix_length_le + input + +private theorem sourceFourFamilyOriginalMarkerRotation_length_le + (marker : List Bool → List Bool) + (hmarker : ∀ input : List Bool, (marker input).length ≤ 1) + (input : List Bool) : + (fourFamilyOriginalMarkerRotationOutput + marker input).length ≤ input.length + 1 := by + rw [sourceFourFamilyOriginalMarkerRotationOutput_eq] + have hfield := sourceFourFamilyFirstFieldSuffix_length_le + (input ++ marker (firstFieldContents input)) + have hbit := hmarker (firstFieldContents input) + simp only [List.length_append] at hfield + omega + +private theorem sourceFourFamilyOriginalMarkerRotation_iterate_length_le + (marker : List Bool → List Bool) + (hmarker : ∀ input : List Bool, (marker input).length ≤ 1) + (seed : List Bool) (stage : ℕ) : + (((fourFamilyOriginalMarkerRotationOutput + marker)^[stage]) seed).length ≤ seed.length + stage := by + induction stage with + | zero => + simp only [Function.iterate_zero, id_eq, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have hstep := sourceFourFamilyOriginalMarkerRotation_length_le + marker hmarker + (((fourFamilyOriginalMarkerRotationOutput + marker)^[stage]) seed) + omega + +private theorem sourceFourFamilyOriginalMarkerRotation_polynomiallyBoundedFoldStates + (marker : List Bool → List Bool) + (hmarker : ∀ input : List Bool, (marker input).length ≤ 1) : + PolynomiallyBoundedFoldStates + (fourFamilyOriginalMarkerRotationOutput marker) + (Polynomial.X + Polynomial.X) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate := + sourceFourFamilyOriginalMarkerRotation_iterate_length_le + marker hmarker seed stage + simp only [Polynomial.eval_add, Polynomial.eval_X] + omega + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyOriginalMarkerFoldComputable + {marker : List Bool → List Bool} + (computer : BitTM marker) + (hmarker : ∀ input : List Bool, (marker input).length ≤ 1) : + BitTM + (boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput marker)) := + boundedDependentRecordFoldComputable + (sourceFourFamilyOriginalMarkerRotationComputable computer) + (Polynomial.X + Polynomial.X) + (sourceFourFamilyOriginalMarkerRotation_polynomiallyBoundedFoldStates + marker hmarker) + +theorem boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries + (marker : List Bool → List Bool) + (queries : List (List Bool)) (suffix : List Bool) : + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput marker) + (unaryBoundedFoldWord queries.length + (sourceMixedRadixOriginalSourceQueryStream queries ++ suffix)) = + suffix ++ fourFamilyOriginalMarkerStream marker queries := by + unfold boundedRecordFoldOutput + rw [parseUnaryBoundedFold_word] + exact sourceFourFamilyOriginalMarkerRotation_iterate_queries + marker queries suffix + +end SourceFourFamilyMarkerRotationTM + +namespace SourceFourFamilyBooleanPredicateTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputPolynomialCompositionClosure +open GapCVP.CLStructuralAtomicNaturalWriter GapCVP.CNFEncodedClauseSort +open GapCVP.CNFNaturalOrderComparator GapCVP.CNFNaturalOrderTotalComparator +open GapCVP.CNFNaturalOrderCertifiedComparator GapCVP.CNFGuardedFiveFamilyTagDispatchTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +def sourceFourFamilyBooleanNotWord : List Bool → List Bool := + markerConditionalOutput + (fun _ : List Bool => [false]) [true] + +/-- GapCVP reduction support. -/ +noncomputable def sourceFourFamilyBooleanNotComputable : + BitTM + sourceFourFamilyBooleanNotWord := + markerConditionalComputable + (sourceFixedWordComputable [false]) [true] + +@[simp] theorem sourceFourFamilyBooleanNotWord_bit + (bit : Bool) : + sourceFourFamilyBooleanNotWord [bit] = [!bit] := by + cases bit <;> rfl + +/-- GapCVP reduction support. -/ +def sourceFourFamilyBooleanAndPairWord : List Bool → List Bool := + markerConditionalOutput + (markerConditionalOutput + (fun _ : List Bool => [true]) [false]) + [false] + +/-- GapCVP reduction support. -/ +noncomputable def sourceFourFamilyBooleanAndPairComputable : + BitTM + sourceFourFamilyBooleanAndPairWord := + markerConditionalComputable + (markerConditionalComputable + (sourceFixedWordComputable [true]) [false]) + [false] + +@[simp] theorem sourceFourFamilyBooleanAndPairWord_bits + (first second : Bool) : + sourceFourFamilyBooleanAndPairWord [first, second] = + [first && second] := by + cases first <;> cases second <;> rfl + +/-- GapCVP reduction support. -/ +def sourceFourFamilyBooleanAndOutput + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceFourFamilyBooleanAndPairWord + (first input ++ second input) + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyBooleanAndComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (sourceFourFamilyBooleanAndOutput first second) := by + have hpair := pointwiseAppendComputable + hfirst hsecond + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpair sourceFourFamilyBooleanAndPairComputable + change BitTM + (fun input => sourceFourFamilyBooleanAndPairWord + (first input ++ second input)) + simpa only [Function.comp_def] using hphysical + +theorem fourFamilyBooleanAndOutput_bits + (first second : List Bool → List Bool) + (input : List Bool) (firstBit secondBit : Bool) + (hfirst : first input = [firstBit]) + (hsecond : second input = [secondBit]) : + sourceFourFamilyBooleanAndOutput first second input = + [firstBit && secondBit] := by + simp only [sourceFourFamilyBooleanAndOutput, hfirst, hsecond, List.cons_append, List.nil_append, + sourceFourFamilyBooleanAndPairWord_bits] + +/-- GapCVP reduction support. -/ +def sourceFourFamilyBooleanNotOutput + (marker : List Bool → List Bool) : List Bool → List Bool := + sourceFourFamilyBooleanNotWord ∘ marker + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyBooleanNotOutputComputable + {marker : List Bool → List Bool} + (computer : BitTM marker) : + BitTM + (sourceFourFamilyBooleanNotOutput marker) := + GapCVP.TMComposition.computableInPolyTime + computer sourceFourFamilyBooleanNotComputable + +theorem fourFamilyBooleanNotOutput_bit + (marker : List Bool → List Bool) + (input : List Bool) (bit : Bool) + (hmarker : marker input = [bit]) : + sourceFourFamilyBooleanNotOutput marker input = + [!bit] := by + simp only [sourceFourFamilyBooleanNotOutput, Function.comp_apply, hmarker, + sourceFourFamilyBooleanNotWord_bit] + +private def sourceFourFamilyFirstUnaryNaturalRecordOutput + (input : List Bool) : List Bool := + structuralAtomicNaturalWord (firstFieldContents input) + +private noncomputable def sourceFourFamilyFirstUnaryNaturalRecordComputable : + BitTM + sourceFourFamilyFirstUnaryNaturalRecordOutput := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable + structuralAtomicNaturalWriterComputable + change BitTM + (fun input => structuralAtomicNaturalWord + (firstFieldContents input)) + simpa only [Function.comp_def] using hphysical + +private def sourceFourFamilySecondUnaryNaturalRecordOutput + (input : List Bool) : List Bool := + structuralAtomicNaturalWord + (firstFieldContents (firstFieldSuffix input)) + +private noncomputable def sourceFourFamilySecondUnaryNaturalRecordComputable : + BitTM + sourceFourFamilySecondUnaryNaturalRecordOutput := by + have hfirst := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hfirst structuralAtomicNaturalWriterComputable + change BitTM + (fun input => structuralAtomicNaturalWord + (firstFieldContents (firstFieldSuffix input))) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def fourFamilyDelimitedUnaryComparisonInput + (input : List Bool) : List Bool := + sourceFourFamilyFirstUnaryNaturalRecordOutput input ++ + sourceFourFamilySecondUnaryNaturalRecordOutput input + +/-- GapCVP reduction support. -/ +noncomputable def sourceFourFamilyDelimitedUnaryComparisonInputComputable : + BitTM + fourFamilyDelimitedUnaryComparisonInput := + pointwiseAppendComputable + sourceFourFamilyFirstUnaryNaturalRecordComputable + sourceFourFamilySecondUnaryNaturalRecordComputable + +theorem sourceFourFamilyDelimitedUnaryComparisonInput_valid + (first second : ℕ) (suffix : List Bool) : + fourFamilyDelimitedUnaryComparisonInput + (lengthPrefixedWord (List.replicate first true) ++ + lengthPrefixedWord (List.replicate second true) ++ suffix) = + lengthPrefixedWord (Computability.encodeNat first) ++ + lengthPrefixedWord (Computability.encodeNat second) := by + simp only [fourFamilyDelimitedUnaryComparisonInput, + sourceFourFamilyFirstUnaryNaturalRecordOutput, + List.append_assoc, firstFieldContents_valid, structuralAtomicNaturalWord_eq_prefix, + List.length_replicate, + sourceFourFamilySecondUnaryNaturalRecordOutput, firstFieldSuffix_valid] + +/-- GapCVP reduction support. -/ +def fourFamilyNaturalOrderingBitsOutput + (input : List Bool) : List Bool := + firstFieldSuffix + (sourcePreservingDelimitedNaturalComparisonWord input) + +/-- GapCVP reduction support. -/ +noncomputable def sourceFourFamilyNaturalOrderingBitsComputable : + BitTM + fourFamilyNaturalOrderingBitsOutput := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + sourcePreservingDelimitedNaturalComparisonComputable + firstFieldSuffixComputable + change BitTM + (fun input => firstFieldSuffix + (sourcePreservingDelimitedNaturalComparisonWord input)) + simpa only [Function.comp_def] using hphysical + +private def sourceFourFamilyOrderingLessBitWord + (input : List Bool) : List Bool := + fixedDelimitedWordEqualityBitWord [false, true] + (lengthPrefixedWord input) + +private noncomputable def sourceFourFamilyOrderingLessBitComputable : + BitTM + sourceFourFamilyOrderingLessBitWord := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + GapCVP.CLStructuralPrefixWriter.structuralPrefixWriterComputable + (fixedDelimitedWordEqualityBitComputable [false, true]) + change BitTM + (fun input => fixedDelimitedWordEqualityBitWord [false, true] + (lengthPrefixedWord input)) + simpa only [fixedDelimitedWordEqualityBitWord_eq, Function.comp_def] using hphysical + +@[simp] private theorem sourceFourFamilyOrderingLessBitWord_ordering + (outcome : EncodedWordOrdering) : + sourceFourFamilyOrderingLessBitWord + (encodedWordOrderingWord outcome) = + [decide (outcome = .less)] := by + unfold sourceFourFamilyOrderingLessBitWord + rw [fixedDelimitedWordEqualityBitWord_eq] + have hselector := fixedDelimitedWordEqualitySelector_valid + [false, true] (encodedWordOrderingWord outcome) [] + simp only [List.append_nil] at hselector + rw [hselector] + cases outcome <;> rfl + +private def sourceFourFamilyUnaryLessBitOutput : List Bool → List Bool := + sourceFourFamilyOrderingLessBitWord ∘ + (fourFamilyNaturalOrderingBitsOutput ∘ + fourFamilyDelimitedUnaryComparisonInput) + +private noncomputable def sourceFourFamilyUnaryLessBitComputable : + BitTM + sourceFourFamilyUnaryLessBitOutput := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + sourceFourFamilyDelimitedUnaryComparisonInputComputable + sourceFourFamilyNaturalOrderingBitsComputable) + sourceFourFamilyOrderingLessBitComputable + +private theorem sourceFourFamilyUnaryLessBitOutput_valid + (first second : ℕ) (suffix : List Bool) : + sourceFourFamilyUnaryLessBitOutput + (lengthPrefixedWord (List.replicate first true) ++ + lengthPrefixedWord (List.replicate second true) ++ suffix) = + [decide (first < second)] := by + unfold sourceFourFamilyUnaryLessBitOutput + simp only [Function.comp_apply, + sourceFourFamilyDelimitedUnaryComparisonInput_valid, + fourFamilyNaturalOrderingBitsOutput] + have hcomparison := sourcePreservingNaturalComparison_valid + (Computability.encodeNat first) + (Computability.encodeNat second) [] + simp only [List.append_nil] at hcomparison + rw [hcomparison, firstFieldSuffix_valid] + rw [sourceFourFamilyOrderingLessBitWord_ordering] + rw [littleEndianNaturalOrdering_eq_value_order] + simp only [littleEndianNaturalValue_encodeNat] + by_cases hfirst : first < second + · simp only [hfirst, ↓reduceIte, decide_true] + · by_cases hsecond : second < first <;> + simp [hfirst, hsecond] + +private theorem sourceFourFamilyUnaryLessBitOutput_length + (input : List Bool) : + (sourceFourFamilyUnaryLessBitOutput input).length = 1 := by + unfold sourceFourFamilyUnaryLessBitOutput + sourceFourFamilyOrderingLessBitWord + simp only [fixedDelimitedWordEqualityBitWord_eq, Function.comp_apply, List.length_cons, + List.length_nil, + zero_add] + +end SourceFourFamilyBooleanPredicateTM + +namespace SourceFourFamilyInterpolationMembershipPredicateTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.SourceUnaryIntegerMultiplicationTM +open GapCVP.SourceFourFamilyBooleanPredicateTM + +/-- GapCVP reduction support. -/ +def fourFamilyComputedUnarySumOutput + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + first input ++ second input + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyComputedUnarySumComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (fourFamilyComputedUnarySumOutput first second) := + pointwiseAppendComputable hfirst hsecond + +theorem fourFamilyComputedUnarySumOutput_valid + (first second : List Bool → List Bool) + (input : List Bool) (left right : ℕ) + (hfirst : first input = List.replicate left true) + (hsecond : second input = List.replicate right true) : + fourFamilyComputedUnarySumOutput first second input = + List.replicate (left + right) true := by + simp only [fourFamilyComputedUnarySumOutput, hfirst, hsecond, List.replicate_append_replicate] + +private def fourFamilyComputedUnaryProductQuery + (left right : List Bool → List Bool) + (input : List Bool) : List Bool := + left input ++ false :: right input + +private noncomputable def sourceFourFamilyComputedUnaryProductQueryComputable + {left right : List Bool → List Bool} + (hleft : BitTM left) + (hright : BitTM right) : + BitTM + (fourFamilyComputedUnaryProductQuery left right) := by + have hdelimited := GapCVP.TMComposition.computableInPolyTime + hright (prependBitComputable false) + have hpair := pointwiseAppendComputable + hleft hdelimited + change BitTM + (fun input => left input ++ false :: right input) + simpa only [Function.comp_apply] using hpair + +/-- GapCVP reduction support. -/ +def fourFamilyComputedUnaryProductOutput + (left right : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceUnaryIntegerMultiplicationOutput + (fourFamilyComputedUnaryProductQuery left right input) + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyComputedUnaryProductComputable + {left right : List Bool → List Bool} + (hleft : BitTM left) + (hright : BitTM right) : + BitTM + (fourFamilyComputedUnaryProductOutput left right) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (sourceFourFamilyComputedUnaryProductQueryComputable + hleft hright) + sourceUnaryIntegerMultiplicationComputable + change BitTM + (fun input => sourceUnaryIntegerMultiplicationOutput + (fourFamilyComputedUnaryProductQuery left right input)) + simpa only [Function.comp_def] using hphysical + +theorem fourFamilyComputedUnaryProductOutput_valid + (left right : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hfirst : left input = List.replicate first true) + (hsecond : right input = List.replicate second true) : + fourFamilyComputedUnaryProductOutput left right input = + List.replicate (first * second) true := by + unfold fourFamilyComputedUnaryProductOutput + fourFamilyComputedUnaryProductQuery + rw [hfirst, hsecond] + change sourceUnaryIntegerMultiplicationOutput + (sourceUnaryIntegerMultiplicationQuery first second) = _ + exact sourceUnaryIntegerMultiplicationOutput_query + first second + +/-- GapCVP reduction support. -/ +def fourFamilyComputedUnaryLessBitOutput + (left right : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceFourFamilyUnaryLessBitOutput + (lengthPrefixedWord (left input) ++ + lengthPrefixedWord (right input)) + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyComputedUnaryLessBitComputable + {left right : List Bool → List Bool} + (hleft : BitTM left) + (hright : BitTM right) : + BitTM + (fourFamilyComputedUnaryLessBitOutput left right) := by + have hleftRecord := GapCVP.TMComposition.computableInPolyTime + hleft structuralPrefixWriterComputable + have hrightRecord := GapCVP.TMComposition.computableInPolyTime + hright structuralPrefixWriterComputable + have hpair := pointwiseAppendComputable + hleftRecord hrightRecord + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpair sourceFourFamilyUnaryLessBitComputable + change BitTM + (fun input => sourceFourFamilyUnaryLessBitOutput + (lengthPrefixedWord (left input) ++ + lengthPrefixedWord (right input))) + simpa only [Function.comp_apply, Function.comp_def] using hphysical + +theorem fourFamilyComputedUnaryLessBitOutput_valid + (left right : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hfirst : left input = List.replicate first true) + (hsecond : right input = List.replicate second true) : + fourFamilyComputedUnaryLessBitOutput left right input = + [decide (first < second)] := by + unfold fourFamilyComputedUnaryLessBitOutput + rw [hfirst, hsecond] + simpa only [List.append_nil] using + sourceFourFamilyUnaryLessBitOutput_valid + first second [] + +theorem fourFamilyComputedUnaryLessBitOutput_length + (left right : List Bool → List Bool) (input : List Bool) : + (fourFamilyComputedUnaryLessBitOutput + left right input).length = 1 := by + exact sourceFourFamilyUnaryLessBitOutput_length _ + +/-- GapCVP reduction support. -/ +def sourceFourFamilyBooleanOrOutput + (first second : List Bool → List Bool) : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput first) + (sourceFourFamilyBooleanNotOutput second)) + +/-- GapCVP reduction support. -/ +noncomputable def sourceFourFamilyBooleanOrComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (sourceFourFamilyBooleanOrOutput first second) := + fourFamilyBooleanNotOutputComputable + (fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable hfirst) + (fourFamilyBooleanNotOutputComputable hsecond)) + +theorem fourFamilyBooleanOrOutput_bits + (first second : List Bool → List Bool) + (input : List Bool) (firstBit secondBit : Bool) + (hfirst : first input = [firstBit]) + (hsecond : second input = [secondBit]) : + sourceFourFamilyBooleanOrOutput first second input = + [firstBit || secondBit] := by + cases firstBit <;> cases secondBit <;> + simp [sourceFourFamilyBooleanOrOutput, + sourceFourFamilyBooleanNotOutput, + sourceFourFamilyBooleanAndOutput, + Function.comp_apply, hfirst, hsecond] + +end SourceFourFamilyInterpolationMembershipPredicateTM + +namespace SourceFourFamilyDiagonalMembershipPredicateTM + +open Turing GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM + +private def sourceFourFamilyFixedUnaryOutput + (value : ℕ) (_input : List Bool) : List Bool := + List.replicate value true + +private noncomputable def fourFamilyFixedUnaryComputable + (value : ℕ) : + BitTM + (sourceFourFamilyFixedUnaryOutput value) := + sourceFixedWordComputable (List.replicate value true) + +private def fourFamilyComputedUnaryNeBitOutput + (first second : List Bool → List Bool) : List Bool → List Bool := + sourceFourFamilyBooleanOrOutput + (fourFamilyComputedUnaryLessBitOutput first second) + (fourFamilyComputedUnaryLessBitOutput second first) + +private noncomputable def sourceFourFamilyComputedUnaryNeBitComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (fourFamilyComputedUnaryNeBitOutput first second) := + sourceFourFamilyBooleanOrComputable + (fourFamilyComputedUnaryLessBitComputable + hfirst hsecond) + (fourFamilyComputedUnaryLessBitComputable + hsecond hfirst) + +private theorem sourceFourFamilyComputedUnaryNeBitOutput_valid + (first second : List Bool → List Bool) + (input : List Bool) (left right : ℕ) + (hleft : first input = List.replicate left true) + (hright : second input = List.replicate right true) : + fourFamilyComputedUnaryNeBitOutput first second input = + [decide (left ≠ right)] := by + have hforward := fourFamilyComputedUnaryLessBitOutput_valid + first second input left right hleft hright + have hbackward := fourFamilyComputedUnaryLessBitOutput_valid + second first input right left hright hleft + have hpair := fourFamilyBooleanOrOutput_bits + (fourFamilyComputedUnaryLessBitOutput first second) + (fourFamilyComputedUnaryLessBitOutput second first) + input (decide (left < right)) (decide (right < left)) + hforward hbackward + change sourceFourFamilyBooleanOrOutput + (fourFamilyComputedUnaryLessBitOutput first second) + (fourFamilyComputedUnaryLessBitOutput second first) + input = _ + by_cases hlt : left < right + · have hne : left ≠ right := by omega + simpa only [ne_eq, hne, not_false_eq_true, decide_true, hlt, Bool.true_or] using hpair + · by_cases hgt : right < left + · have hne : left ≠ right := by omega + simpa only [ne_eq, hne, not_false_eq_true, decide_true, hlt, decide_false, hgt, Bool.or_true] + using hpair + · have heq : left = right := by omega + simpa only [heq, ne_eq, not_true_eq_false, decide_false, lt_self_iff_false, Bool.or_self] + using hpair + +/-- GapCVP reduction support. -/ +def fourFamilyComputedUnaryEqBitOutput + (first second : List Bool → List Bool) : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + (fourFamilyComputedUnaryNeBitOutput first second) + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyComputedUnaryEqBitComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (fourFamilyComputedUnaryEqBitOutput first second) := + fourFamilyBooleanNotOutputComputable + (sourceFourFamilyComputedUnaryNeBitComputable + hfirst hsecond) + +theorem fourFamilyComputedUnaryEqBitOutput_valid + (first second : List Bool → List Bool) + (input : List Bool) (left right : ℕ) + (hleft : first input = List.replicate left true) + (hright : second input = List.replicate right true) : + fourFamilyComputedUnaryEqBitOutput first second input = + [decide (left = right)] := by + have hne := sourceFourFamilyComputedUnaryNeBitOutput_valid + first second input left right hleft hright + have hnot := fourFamilyBooleanNotOutput_bit + (fourFamilyComputedUnaryNeBitOutput first second) + input (decide (left ≠ right)) hne + change sourceFourFamilyBooleanNotOutput + (fourFamilyComputedUnaryNeBitOutput first second) + input = _ + by_cases heq : left = right <;> + simpa [heq] using hnot + +end SourceFourFamilyDiagonalMembershipPredicateTM + +namespace CNFFiveFamilyPackedInitialOffsetFeatureTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceUniformTuringTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceFourFamilyDiagonalMembershipPredicateTM + +private def fiveFamilyPackedOffsetIndexWord + (position : List Bool → List Bool) + (block offset : ℕ) : List Bool → List Bool := + fourFamilyComputedUnarySumOutput + (fourFamilyComputedUnaryProductOutput + position (sourceFourFamilyFixedUnaryOutput block)) + (sourceFourFamilyFixedUnaryOutput offset) + +private noncomputable def fivePackedOffsetIndexComputable + {position : List Bool → List Bool} + (computer : BitTM position) + (block offset : ℕ) : + BitTM + (fiveFamilyPackedOffsetIndexWord position block offset) := + fourFamilyComputedUnarySumComputable + (fourFamilyComputedUnaryProductComputable + computer (fourFamilyFixedUnaryComputable block)) + (fourFamilyFixedUnaryComputable offset) + +private theorem fiveFamilyPackedOffsetIndexWord_valid + (position : List Bool → List Bool) + (input : List Bool) (value block offset : ℕ) + (hposition : position input = List.replicate value true) : + fiveFamilyPackedOffsetIndexWord position block offset input = + List.replicate (value * block + offset) true := by + unfold fiveFamilyPackedOffsetIndexWord + apply fourFamilyComputedUnarySumOutput_valid + (fourFamilyComputedUnaryProductOutput + position (sourceFourFamilyFixedUnaryOutput block)) + (sourceFourFamilyFixedUnaryOutput offset) + input (value * block) offset + · apply fourFamilyComputedUnaryProductOutput_valid + position (sourceFourFamilyFixedUnaryOutput block) + input value block hposition + rfl + · rfl + +private def fiveFamilyPackedOffsetWithinBitWord + (grid : Polynomial ℕ) + (position : List Bool → List Bool) + (block offset : ℕ) : List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + (fiveFamilyPackedOffsetIndexWord position block offset) + (fiveFlatIndexedOriginalPolynomialUnary grid) + +private noncomputable def fiveFamilyPackedOffsetWithinBitComputable + (grid : Polynomial ℕ) + {position : List Bool → List Bool} + (computer : BitTM position) + (block offset : ℕ) : + BitTM + (fiveFamilyPackedOffsetWithinBitWord + grid position block offset) := + fourFamilyComputedUnaryLessBitComputable + (fivePackedOffsetIndexComputable computer block offset) + (fiveFlatIndexedOriginalPolynomialUnaryComputable grid) + +private def fivePackedOffsetBeforeInputBitWord + (position : List Bool → List Bool) + (block offset : ℕ) : List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + (fiveFamilyPackedOffsetIndexWord position block offset) + (fiveFlatIndexedOriginalPolynomialUnary Polynomial.X) + +private noncomputable def fiveFamilyPackedOffsetBeforeInputBitComputable + {position : List Bool → List Bool} + (computer : BitTM position) + (block offset : ℕ) : + BitTM + (fivePackedOffsetBeforeInputBitWord + position block offset) := + fourFamilyComputedUnaryLessBitComputable + (fivePackedOffsetIndexComputable computer block offset) + (fiveFlatIndexedOriginalPolynomialUnaryComputable + Polynomial.X) + +private def fivePackedOffsetInputMarkerBitWord + (position : List Bool → List Bool) + (block offset : ℕ) : List Bool → List Bool := + fourFamilyComputedUnaryEqBitOutput + (fiveFamilyPackedOffsetIndexWord position block offset) + (fiveFlatIndexedOriginalPolynomialUnary Polynomial.X) + +private noncomputable def fiveFamilyPackedOffsetInputMarkerBitComputable + {position : List Bool → List Bool} + (computer : BitTM position) + (block offset : ℕ) : + BitTM + (fivePackedOffsetInputMarkerBitWord + position block offset) := + fourFamilyComputedUnaryEqBitComputable + (fivePackedOffsetIndexComputable computer block offset) + (fiveFlatIndexedOriginalPolynomialUnaryComputable + Polynomial.X) + +private def fiveFamilyPackedOffsetSourceBitWord + (position : List Bool → List Bool) + (block offset : ℕ) : List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + (fiveFamilyPackedOffsetIndexWord position block offset) + fiveFlatIndexedPhysicalOriginal + +private noncomputable def fiveFamilyPackedOffsetSourceBitComputable + {position : List Bool → List Bool} + (computer : BitTM position) + (block offset : ℕ) : + BitTM + (fiveFamilyPackedOffsetSourceBitWord + position block offset) := + fiveOriginalDynamicBitComputable + (fivePackedOffsetIndexComputable computer block offset) + fiveFamilyFlatIndexedPhysicalOriginalComputable + +private def fiveFamilyPackedOffsetZeroBitWord + (position : List Bool → List Bool) + (block offset : ℕ) : List Bool → List Bool := + fourFamilyComputedUnaryEqBitOutput + (fiveFamilyPackedOffsetIndexWord position block offset) + (sourceFourFamilyFixedUnaryOutput 0) + +private noncomputable def fiveFamilyPackedOffsetZeroBitComputable + {position : List Bool → List Bool} + (computer : BitTM position) + (block offset : ℕ) : + BitTM + (fiveFamilyPackedOffsetZeroBitWord + position block offset) := + fourFamilyComputedUnaryEqBitComputable + (fivePackedOffsetIndexComputable computer block offset) + (fourFamilyFixedUnaryComputable 0) + +private def fiveFamilyPackedOffsetBudgetBitWord + (bound : Polynomial ℕ) + (position : List Bool → List Bool) + (block offset : ℕ) : List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + (fiveFamilyPackedOffsetIndexWord position block offset) + (fiveFlatIndexedOriginalPolynomialUnary + (Polynomial.X + bound)) + +private noncomputable def fiveFamilyPackedOffsetBudgetBitComputable + (bound : Polynomial ℕ) + {position : List Bool → List Bool} + (computer : BitTM position) + (block offset : ℕ) : + BitTM + (fiveFamilyPackedOffsetBudgetBitWord + bound position block offset) := + fourFamilyComputedUnaryLessBitComputable + (fivePackedOffsetIndexComputable computer block offset) + (fiveFlatIndexedOriginalPolynomialUnaryComputable + (Polynomial.X + bound)) + +private def fiveFamilyPackedOffsetFeatureWord + (bound grid : Polynomial ℕ) + (position : List Bool → List Bool) + (block offset : ℕ) (input : List Bool) : List Bool := + fiveFamilyPackedOffsetWithinBitWord + grid position block offset input ++ + fivePackedOffsetBeforeInputBitWord + position block offset input ++ + fivePackedOffsetInputMarkerBitWord + position block offset input ++ + fiveFamilyPackedOffsetSourceBitWord + position block offset input ++ + fiveFamilyPackedOffsetZeroBitWord + position block offset input ++ + fiveFamilyPackedOffsetBudgetBitWord + bound position block offset input + +private noncomputable def fiveFamilyPackedOffsetFeatureComputable + (bound grid : Polynomial ℕ) + {position : List Bool → List Bool} + (computer : BitTM position) + (block offset : ℕ) : + BitTM + (fiveFamilyPackedOffsetFeatureWord + bound grid position block offset) := by + have withinBefore := pointwiseAppendComputable + (fiveFamilyPackedOffsetWithinBitComputable + grid computer block offset) + (fiveFamilyPackedOffsetBeforeInputBitComputable + computer block offset) + have markerSource := pointwiseAppendComputable + (fiveFamilyPackedOffsetInputMarkerBitComputable + computer block offset) + (fiveFamilyPackedOffsetSourceBitComputable + computer block offset) + have zeroBudget := pointwiseAppendComputable + (fiveFamilyPackedOffsetZeroBitComputable + computer block offset) + (fiveFamilyPackedOffsetBudgetBitComputable + bound computer block offset) + have markerSourceZeroBudget := pointwiseAppendComputable + markerSource zeroBudget + have physical := pointwiseAppendComputable + withinBefore markerSourceZeroBudget + have hequality : + (fun input => + (fiveFamilyPackedOffsetWithinBitWord + grid position block offset input ++ + fivePackedOffsetBeforeInputBitWord + position block offset input) ++ + ((fivePackedOffsetInputMarkerBitWord + position block offset input ++ + fiveFamilyPackedOffsetSourceBitWord + position block offset input) ++ + (fiveFamilyPackedOffsetZeroBitWord + position block offset input ++ + fiveFamilyPackedOffsetBudgetBitWord + bound position block offset input))) = + fiveFamilyPackedOffsetFeatureWord + bound grid position block offset := by + funext input + simp only [List.append_assoc, fiveFamilyPackedOffsetFeatureWord] + rw [← hequality] + exact physical + +private theorem fiveFamilyPackedOffsetFeatureWord_valid + (bound grid : Polynomial ℕ) + (position : List Bool → List Bool) + (block offset rank value : ℕ) + (original suffix : List Bool) + (hposition : position + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate value true) : + fiveFamilyPackedOffsetFeatureWord + bound grid position block offset + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + [decide (value * block + offset < + grid.eval original.length), + decide (value * block + offset < original.length), + decide (value * block + offset = original.length), + (original.drop (value * block + offset)).headD false, + decide (value * block + offset = 0), + decide (value * block + offset < + original.length + bound.eval original.length)] := by + let query := lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix + let coordinate := value * block + offset + have hindex : + fiveFamilyPackedOffsetIndexWord + position block offset query = + List.replicate coordinate true := by + exact fiveFamilyPackedOffsetIndexWord_valid + position query value block offset hposition + have hgrid : + fiveFlatIndexedOriginalPolynomialUnary grid query = + List.replicate (grid.eval original.length) true := + fiveFamilyFlatIndexedOriginalPolynomialUnary_valid + grid rank original suffix + have hlength : + fiveFlatIndexedOriginalPolynomialUnary + Polynomial.X query = + List.replicate original.length true := by + simpa [query, List.append_assoc] using + fiveFamilyFlatIndexedOriginalPolynomialUnary_valid + Polynomial.X rank original suffix + have hbudget : + fiveFlatIndexedOriginalPolynomialUnary + (Polynomial.X + bound) query = + List.replicate + (original.length + bound.eval original.length) true := by + have hpolynomial : + (Polynomial.X + bound).eval original.length = + original.length + bound.eval original.length := by + simp + have hevaluated := + fiveFamilyFlatIndexedOriginalPolynomialUnary_valid + (Polynomial.X + bound) rank original suffix + rw [hpolynomial] at hevaluated + exact hevaluated + have hbit : + fiveFamilyOriginalDynamicBitWord + (fiveFamilyPackedOffsetIndexWord + position block offset) + fiveFlatIndexedPhysicalOriginal query = + [(original.drop coordinate).headD false] := by + rw [fiveOriginalDynamicBitWord_valid + (fiveFamilyPackedOffsetIndexWord + position block offset) + fiveFlatIndexedPhysicalOriginal + query coordinate hindex] + rw [fiveFamilyFlatIndexedPhysicalOriginal_valid + rank original suffix] + unfold fiveFamilyPackedOffsetFeatureWord + fiveFamilyPackedOffsetWithinBitWord + fivePackedOffsetBeforeInputBitWord + fivePackedOffsetInputMarkerBitWord + fiveFamilyPackedOffsetSourceBitWord + fiveFamilyPackedOffsetZeroBitWord + fiveFamilyPackedOffsetBudgetBitWord + change + fourFamilyComputedUnaryLessBitOutput + (fiveFamilyPackedOffsetIndexWord + position block offset) + (fiveFlatIndexedOriginalPolynomialUnary grid) + query ++ + fourFamilyComputedUnaryLessBitOutput + (fiveFamilyPackedOffsetIndexWord + position block offset) + (fiveFlatIndexedOriginalPolynomialUnary + Polynomial.X) + query ++ + fourFamilyComputedUnaryEqBitOutput + (fiveFamilyPackedOffsetIndexWord + position block offset) + (fiveFlatIndexedOriginalPolynomialUnary + Polynomial.X) + query ++ + fiveFamilyOriginalDynamicBitWord + (fiveFamilyPackedOffsetIndexWord + position block offset) + fiveFlatIndexedPhysicalOriginal query ++ + fourFamilyComputedUnaryEqBitOutput + (fiveFamilyPackedOffsetIndexWord + position block offset) + (sourceFourFamilyFixedUnaryOutput 0) + query ++ + fourFamilyComputedUnaryLessBitOutput + (fiveFamilyPackedOffsetIndexWord + position block offset) + (fiveFlatIndexedOriginalPolynomialUnary + (Polynomial.X + bound)) query = _ + rw [fourFamilyComputedUnaryLessBitOutput_valid + (fiveFamilyPackedOffsetIndexWord position block offset) + (fiveFlatIndexedOriginalPolynomialUnary grid) + query coordinate (grid.eval original.length) hindex hgrid, + fourFamilyComputedUnaryLessBitOutput_valid + (fiveFamilyPackedOffsetIndexWord position block offset) + (fiveFlatIndexedOriginalPolynomialUnary Polynomial.X) + query coordinate original.length hindex hlength, + fourFamilyComputedUnaryEqBitOutput_valid + (fiveFamilyPackedOffsetIndexWord position block offset) + (fiveFlatIndexedOriginalPolynomialUnary Polynomial.X) + query coordinate original.length hindex hlength, + hbit, + fourFamilyComputedUnaryEqBitOutput_valid + (fiveFamilyPackedOffsetIndexWord position block offset) + (sourceFourFamilyFixedUnaryOutput 0) + query coordinate 0 hindex rfl, + fourFamilyComputedUnaryLessBitOutput_valid + (fiveFamilyPackedOffsetIndexWord position block offset) + (fiveFlatIndexedOriginalPolynomialUnary + (Polynomial.X + bound)) + query coordinate + (original.length + bound.eval original.length) + hindex hbudget] + simp [coordinate] + +private def fiveFamilyPackedOffsetFeatureStream + (bound grid : Polynomial ℕ) + (position : List Bool → List Bool) + (block : ℕ) (offsets : List ℕ) + (input : List Bool) : List Bool := + offsets.flatMap fun offset => + fiveFamilyPackedOffsetFeatureWord + bound grid position block offset input + +private noncomputable def fiveFamilyPackedOffsetFeatureStreamComputable + (bound grid : Polynomial ℕ) + {position : List Bool → List Bool} + (computer : BitTM position) + (block : ℕ) (offsets : List ℕ) : + BitTM + (fiveFamilyPackedOffsetFeatureStream + bound grid position block offsets) := by + induction offsets with + | nil => exact constantWordComputable [] + | cons offset remaining ih => + exact pointwiseAppendComputable + (fiveFamilyPackedOffsetFeatureComputable + bound grid computer block offset) ih + +private theorem fiveFamilyPackedOffsetFeatureStream_valid + (bound grid : Polynomial ℕ) + (position : List Bool → List Bool) + (block rank value : ℕ) + (offsets : List ℕ) + (original suffix : List Bool) + (hposition : position + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate value true) : + fiveFamilyPackedOffsetFeatureStream + bound grid position block offsets + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord original ++ suffix) = + offsets.flatMap fun offset => + [decide (value * block + offset < + grid.eval original.length), + decide (value * block + offset < original.length), + decide (value * block + offset = original.length), + (original.drop (value * block + offset)).headD false, + decide (value * block + offset = 0), + decide (value * block + offset < + original.length + bound.eval original.length)] := by + unfold fiveFamilyPackedOffsetFeatureStream + apply List.flatMap_congr + intro offset _ + exact fiveFamilyPackedOffsetFeatureWord_valid + bound grid position block offset rank value + original suffix hposition + +end CNFFiveFamilyPackedInitialOffsetFeatureTM + +namespace CNFFiveFamilyPackedInitialCellDecoderTM + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLBoundedStates GapCVP.CLCellRows +open GapCVP.CLLocalWindows GapCVP.CLCellRowBounds GapCVP.CLFullTableauEmitter +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPaddedAcceptanceCompiler GapCVP.BinaryEncoding +open GapCVP.SourceUniformTuringTM GapCVP.SourceMachineCert +open GapCVP.OutputPolynomialCompositionClosure GapCVP.CLEmittedCNFTM GapCVP.CLWindowTruthTable +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFUnaryPairIndexTM +open GapCVP.CNFUnaryPairIndexTotalRuntimeCert GapCVP.CNFFiveFamilyFlatCandidateGenerationTM +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM +open GapCVP.CNFFiveFamilyFlatRowMajorAtMostClauseWorkerTM +open GapCVP.CNFFiveFamilyPackedInitialOffsetFeatureTM +open GapCVP.SourceFourFamilyDiagonalMembershipPredicateTM + +private def fiveFamilyPackedSixTrackChunk + (features : List Bool) (offset : ℕ) : List Bool := + (features.drop (6 * offset)).take 6 + +private theorem fiveFamilyPackedSixTrackChunk_flatMap + {α : Type} (records : List α) (observation : α → List Bool) + (hlength : ∀ record : α, (observation record).length = 6) + (index : ℕ) (hindex : index < records.length) : + fiveFamilyPackedSixTrackChunk + (records.flatMap observation) index = + observation records[index] := by + have hfront : + ((records.take index).flatMap observation).length = + 6 * index := by + simp only [List.length_flatMap, hlength, List.map_take, List.map_const', List.take_replicate, + Nat.min_eq_left (Nat.le_of_lt hindex), List.sum_replicate, smul_eq_mul, Nat.mul_comm] + unfold fiveFamilyPackedSixTrackChunk + calc + ((records.flatMap observation).drop (6 * index)).take 6 = + ((((records.take index).flatMap observation ++ + (records.drop index).flatMap observation).drop + (6 * index))).take 6 := by + rw [← List.flatMap_append, + List.take_append_drop] + _ = ((records.drop index).flatMap observation).take 6 := by + rw [← hfront, List.drop_append_length] + _ = observation records[index] := by + rw [List.drop_eq_getElem_cons hindex, + List.flatMap_cons, + List.take_append_of_le_length (by + rw [hlength])] + exact List.take_of_length_le (by rw [hlength]) + +/-- Internal support shared across GapCVP continuation modules. -/ +def fivePackedActualOffsetObservation + (bound grid : Polynomial ℕ) + (original : List Bool) (position block offset : ℕ) : List Bool := + [decide (position * block + offset < + grid.eval original.length), + decide (position * block + offset < original.length), + decide (position * block + offset = original.length), + (original.drop (position * block + offset)).headD false, + decide (position * block + offset = 0), + decide (position * block + offset < + original.length + bound.eval original.length)] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem fiveFamilyPackedActualOffsetObservation_length + (bound grid : Polynomial ℕ) + (original : List Bool) (position block offset : ℕ) : + (fivePackedActualOffsetObservation + bound grid original position block offset).length = 6 := by + simp only [fivePackedActualOffsetObservation, List.headD_eq_head?_getD, List.head?_drop, + Nat.add_eq_zero_iff, + mul_eq_zero, Bool.decide_and, Bool.decide_or, List.length_cons, List.length_nil, zero_add, + Nat.reduceAdd] + +/-- Internal support shared across GapCVP continuation modules. -/ +def fivePackedInitialWholeFeatureWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + fiveFamilyPackedOffsetFeatureStream + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + fiveFamilyFlatIndexedPhysicalRank + (blockSize machine.tm) + (List.range (blockSize machine.tm)) input ++ + fiveFamilyPackedOffsetFeatureStream + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + (sourceFourFamilyFixedUnaryOutput 0) + (blockSize machine.tm) + (List.range (blockSize machine.tm)) input + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveFamilyPackedInitialWholeFeatureComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fivePackedInitialWholeFeatureWord bound machine) := by + have center := fiveFamilyPackedOffsetFeatureStreamComputable + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + fiveFlatIndexedPhysicalRankComputable + (blockSize machine.tm) (List.range (blockSize machine.tm)) + have head := fiveFamilyPackedOffsetFeatureStreamComputable + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fourFamilyFixedUnaryComputable 0) + (blockSize machine.tm) (List.range (blockSize machine.tm)) + exact pointwiseAppendComputable center head + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyPackedInitialWholeFeatureWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (position : Position (rowWidth bound machine original)) : + fivePackedInitialWholeFeatureWord bound machine + (lengthPrefixedWord (List.replicate position.val true) ++ + lengthPrefixedWord original ++ suffix) = + (List.range (blockSize machine.tm)).flatMap + (fivePackedActualOffsetObservation + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + original position.val (blockSize machine.tm)) ++ + (List.range (blockSize machine.tm)).flatMap + (fivePackedActualOffsetObservation + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + original 0 (blockSize machine.tm)) := by + unfold fivePackedInitialWholeFeatureWord + rw [fiveFamilyPackedOffsetFeatureStream_valid + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + fiveFamilyFlatIndexedPhysicalRank + (blockSize machine.tm) position.val position.val + (List.range (blockSize machine.tm)) original suffix + (fiveFamilyFlatIndexedPhysicalRank_valid + position.val original suffix)] + rw [fiveFamilyPackedOffsetFeatureStream_valid + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + (sourceFourFamilyFixedUnaryOutput 0) + (blockSize machine.tm) position.val 0 + (List.range (blockSize machine.tm)) original suffix rfl] + rfl + +private def fiveFamilyPackedObservationPayload + (observation : List Bool) : PairedInputTag := + if observation.getD 0 false then + if observation.getD 1 false then + .bit (.inl (observation.getD 3 false)) + else if observation.getD 2 false then + .marker + else + .blank + else + .blank + +private def fiveFamilyPackedObservationRange + (observation : List Bool) : Bool := + observation.getD 0 false + +private def fiveFamilyPackedObservationZero + (observation : List Bool) : Bool := + observation.getD 4 false + +private def fiveFamilyPackedObservationBudget + (observation : List Bool) : Bool := + observation.getD 5 false + +private def fivePackedObservationScriptCell + (tm : Turing.FinTM2) (observation : List Bool) : + LocalCellSymbol tm := + if fiveFamilyPackedObservationRange observation then + (if fiveFamilyPackedObservationZero observation then + .accepting else .guessing, + none, fun _ => none, false) + else + blankCell tm + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveFamilyPackedInitialDecodedCell + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (features : List Bool) : CompletePhaseCell machine.tm := + let block := blockSize machine.tm + let center := features.take (6 * block) + let head := features.drop (6 * block) + { mode := .guessing + script := + ((fun offset => + fivePackedObservationScriptCell machine.tm + (fiveFamilyPackedSixTrackChunk center offset.val), + fun offset => + fivePackedObservationScriptCell machine.tm + (fiveFamilyPackedSixTrackChunk head offset.val)), + defaultVerifierHint machine.tm, + fiveFamilyPackedObservationZero + (fiveFamilyPackedSixTrackChunk center 0)) + payload := fun offset => + fiveFamilyPackedObservationPayload + (fiveFamilyPackedSixTrackChunk center offset.val) + payloadHead := fun offset => + fiveFamilyPackedObservationPayload + (fiveFamilyPackedSixTrackChunk head offset.val) + range := fun offset => + fiveFamilyPackedObservationRange + (fiveFamilyPackedSixTrackChunk center offset.val) + rangeHead := fun offset => + fiveFamilyPackedObservationRange + (fiveFamilyPackedSixTrackChunk head offset.val) + budget := fun offset => + fiveFamilyPackedObservationBudget + (fiveFamilyPackedSixTrackChunk center offset.val) + guessBit := false } + +private theorem fivePackedActualOffsetObservation_chunk + (bound grid : Polynomial ℕ) + (original : List Bool) (position block : ℕ) + (offset : Fin block) : + fiveFamilyPackedSixTrackChunk + ((List.range block).flatMap + (fivePackedActualOffsetObservation + bound grid original position block)) offset.val = + fivePackedActualOffsetObservation + bound grid original position block offset.val := by + have recovered := fiveFamilyPackedSixTrackChunk_flatMap + (List.range block) + (fivePackedActualOffsetObservation + bound grid original position block) + (fun index => + fiveFamilyPackedActualOffsetObservation_length + bound grid original position block index) + offset.val (by + simpa only [List.length_range] using offset.isLt) + simpa only [List.getElem_range] using recovered + +private theorem fiveFamilyPairedInputTagAt_empty + (original : List Bool) (index : ℕ) : + pairedInputTagAt original [] index = + if index < original.length then + .bit (.inl ((original.drop index).headD false)) + else if index = original.length then + .marker + else + .blank := by + unfold pairedInputTagAt + simp only [pairBitEncoding_apply, List.map_nil, + List.append_nil, List.length_map, List.getElem?_map] + by_cases hindex : index < original.length <;> + simp [hindex] + +private theorem fiveFamilyPackedObservationPayload_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) + (offset : Fin (blockSize machine.tm)) : + fiveFamilyPackedObservationPayload + (fivePackedActualOffsetObservation + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + original position.val (blockSize machine.tm) offset.val) = + pairedInputBlockAt machine.tm + (rowWidth bound machine original) original [] + position offset := by + simp only [fiveFamilyPackedObservationPayload, fivePackedActualOffsetObservation, + fiveFamilyFlatIndexedGridPolynomial_eval, Order.lt_add_one_iff, List.headD_eq_head?_getD, + List.head?_drop, + Nat.add_eq_zero_iff, mul_eq_zero, Fin.val_eq_zero_iff, Bool.decide_and, Bool.decide_or, + List.getD_eq_getElem?_getD, + List.length_cons, List.length_nil, zero_add, Nat.reduceAdd, Nat.ofNat_pos, getElem?_pos, + List.getElem_cons_zero, + Option.getD_some, decide_eq_true_eq, Nat.one_lt_ofNat, List.getElem_cons_succ, Nat.reduceLT, + pairedInputBlockAt, + fiveFamilyPairedInputTagAt_empty] + +private theorem fiveFamilyPackedObservationRange_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) + (offset : Fin (blockSize machine.tm)) : + fiveFamilyPackedObservationRange + (fivePackedActualOffsetObservation + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + original position.val (blockSize machine.tm) offset.val) = + phaseRangeBlockAt machine.tm + (rowWidth bound machine original) position offset := by + simp only [fiveFamilyPackedObservationRange, fivePackedActualOffsetObservation, + fiveFamilyFlatIndexedGridPolynomial_eval, Order.lt_add_one_iff, List.headD_eq_head?_getD, + List.head?_drop, + Nat.add_eq_zero_iff, mul_eq_zero, Fin.val_eq_zero_iff, Bool.decide_and, Bool.decide_or, + List.getD_eq_getElem?_getD, + List.length_cons, List.length_nil, zero_add, Nat.reduceAdd, Nat.ofNat_pos, getElem?_pos, + List.getElem_cons_zero, + Option.getD_some, phaseRangeBlockAt] + +private theorem fiveFamilyPackedObservationBudget_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) + (offset : Fin (blockSize machine.tm)) : + fiveFamilyPackedObservationBudget + (fivePackedActualOffsetObservation + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + original position.val (blockSize machine.tm) offset.val) = + phaseBudgetBlockAt bound machine original position offset := by + simp only [fiveFamilyPackedObservationBudget, fivePackedActualOffsetObservation, + fiveFamilyFlatIndexedGridPolynomial_eval, Order.lt_add_one_iff, List.headD_eq_head?_getD, + List.head?_drop, + Nat.add_eq_zero_iff, mul_eq_zero, Fin.val_eq_zero_iff, Bool.decide_and, Bool.decide_or, + List.getD_eq_getElem?_getD, + List.length_cons, List.length_nil, zero_add, Nat.reduceAdd, Nat.lt_add_one, getElem?_pos, + List.getElem_cons_succ, + List.getElem_cons_zero, Option.getD_some, phaseBudgetBlockAt] + +private theorem fiveFamilyPackedObservationScriptCell_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) + (offset : Fin (blockSize machine.tm)) : + fivePackedObservationScriptCell machine.tm + (fivePackedActualOffsetObservation + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + original position.val (blockSize machine.tm) offset.val) = + packRow machine.tm + (rowWidth bound machine original) + (guessingRow machine.tm + (rowWidth bound machine original) []) + position offset := by + unfold fivePackedObservationScriptCell + fiveFamilyPackedObservationRange + fiveFamilyPackedObservationZero + fivePackedActualOffsetObservation + packRow guessingRow certificatePhase + simp only [fiveFamilyFlatIndexedGridPolynomial_eval, Order.lt_add_one_iff, + List.headD_eq_head?_getD, + List.head?_drop, Nat.add_eq_zero_iff, mul_eq_zero, Fin.val_eq_zero_iff, Bool.decide_and, + Bool.decide_or, + List.getD_eq_getElem?_getD, List.length_cons, List.length_nil, zero_add, Nat.reduceAdd, + Nat.ofNat_pos, getElem?_pos, + List.getElem_cons_zero, Option.getD_some, decide_eq_true_eq, Nat.reduceLT, + List.getElem_cons_succ, Bool.and_eq_true, + Bool.or_eq_true, not_lt_zero, ↓reduceDIte, dite_eq_ite] + +private theorem fiveFamilyPackedObservationFirstBlock_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) : + fiveFamilyPackedObservationZero + (fivePackedActualOffsetObservation + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + original position.val (blockSize machine.tm) 0) = + decide (position.val = 0) := by + simp only [fiveFamilyPackedObservationZero, fivePackedActualOffsetObservation, add_zero, + fiveFamilyFlatIndexedGridPolynomial_eval, Order.lt_add_one_iff, List.headD_eq_head?_getD, + List.head?_drop, + mul_eq_zero, Fin.val_eq_zero_iff, ne_of_gt (blockSize_pos machine.tm), or_false, + List.getD_eq_getElem?_getD, + List.length_cons, List.length_nil, zero_add, Nat.reduceAdd, Nat.reduceLT, getElem?_pos, + List.getElem_cons_succ, + List.getElem_cons_zero, Option.getD_some] + +private theorem fiveFamilyCompletePhaseCell_ext + (tm : Turing.FinTM2) + (first second : CompletePhaseCell tm) + (hmode : first.mode = second.mode) + (hscript : first.script = second.script) + (hpayload : first.payload = second.payload) + (hhead : first.payloadHead = second.payloadHead) + (hrange : first.range = second.range) + (hrangeHead : first.rangeHead = second.rangeHead) + (hbudget : first.budget = second.budget) + (hguess : first.guessBit = second.guessBit) : + first = second := by + cases first + cases second + simp_all + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyPackedInitialDecodedCell_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (position : Position (rowWidth bound machine original)) : + fiveFamilyPackedInitialDecodedCell machine + (fivePackedInitialWholeFeatureWord bound machine + (lengthPrefixedWord (List.replicate position.val true) ++ + lengthPrefixedWord original ++ suffix)) = + initialPhaseCell bound machine original position := by + rw [fiveFamilyPackedInitialWholeFeatureWord_valid + bound machine original suffix position] + let block := blockSize machine.tm + let grid := fiveFamilyFlatIndexedGridPolynomial bound machine + let center := (List.range block).flatMap + (fivePackedActualOffsetObservation + bound grid original position.val block) + let head := (List.range block).flatMap + (fivePackedActualOffsetObservation + bound grid original 0 block) + have hcenterLength : center.length = 6 * block := by + simp only [List.length_flatMap, fiveFamilyPackedActualOffsetObservation_length, + List.map_const', + List.length_range, List.sum_replicate, smul_eq_mul, Nat.mul_comm, center] + have htake : (center ++ head).take (6 * block) = center := by + rw [← hcenterLength, List.take_append_of_le_length + (Nat.le_refl center.length)] + simp only [List.take_length] + have hdrop : (center ++ head).drop (6 * block) = head := by + rw [← hcenterLength, List.drop_append_length] + have htake' : + (center ++ head).take (6 * blockSize machine.tm) = center := by + simpa only [block] using htake + have hdrop' : + (center ++ head).drop (6 * blockSize machine.tm) = head := by + simpa only [block] using hdrop + change fiveFamilyPackedInitialDecodedCell machine + (center ++ head) = initialPhaseCell bound machine original position + unfold fiveFamilyPackedInitialDecodedCell + simp only [htake', hdrop'] + apply fiveFamilyCompletePhaseCell_ext machine.tm + · rfl + · unfold initialPhaseCell canonicalGuessingScriptRow + apply Prod.ext + · apply Prod.ext + · funext offset + change + fivePackedObservationScriptCell machine.tm + (fiveFamilyPackedSixTrackChunk center offset.val) = + packRow machine.tm + (rowWidth bound machine original) + (guessingRow machine.tm + (rowWidth bound machine original) []) + position offset + rw [show fiveFamilyPackedSixTrackChunk center offset.val = + fivePackedActualOffsetObservation + bound grid original position.val block offset.val from + fivePackedActualOffsetObservation_chunk + bound grid original position.val block offset] + exact fiveFamilyPackedObservationScriptCell_valid + bound machine original position offset + · funext offset + change + fivePackedObservationScriptCell machine.tm + (fiveFamilyPackedSixTrackChunk head offset.val) = + packRow machine.tm + (rowWidth bound machine original) + (guessingRow machine.tm + (rowWidth bound machine original) []) + (0 : Position (rowWidth bound machine original)) + offset + rw [show fiveFamilyPackedSixTrackChunk head offset.val = + fivePackedActualOffsetObservation + bound grid original 0 block offset.val from + fivePackedActualOffsetObservation_chunk + bound grid original 0 block offset] + exact fiveFamilyPackedObservationScriptCell_valid + bound machine original (0 : Position + (rowWidth bound machine original)) offset + · apply Prod.ext + · rfl + · rw [show fiveFamilyPackedSixTrackChunk center 0 = + fivePackedActualOffsetObservation + bound grid original position.val block 0 from + fivePackedActualOffsetObservation_chunk + bound grid original position.val block + ⟨0, blockSize_pos machine.tm⟩] + exact fiveFamilyPackedObservationFirstBlock_valid + bound machine original position + · funext offset + change + fiveFamilyPackedObservationPayload + (fiveFamilyPackedSixTrackChunk center offset.val) = + pairedInputBlockAt machine.tm + (rowWidth bound machine original) original [] + position offset + rw [show fiveFamilyPackedSixTrackChunk center offset.val = + fivePackedActualOffsetObservation + bound grid original position.val block offset.val from + fivePackedActualOffsetObservation_chunk + bound grid original position.val block offset] + exact fiveFamilyPackedObservationPayload_valid + bound machine original position offset + · funext offset + change + fiveFamilyPackedObservationPayload + (fiveFamilyPackedSixTrackChunk head offset.val) = + pairedInputBlockAt machine.tm + (rowWidth bound machine original) original [] + (0 : Position (rowWidth bound machine original)) offset + rw [show fiveFamilyPackedSixTrackChunk head offset.val = + fivePackedActualOffsetObservation + bound grid original 0 block offset.val from + fivePackedActualOffsetObservation_chunk + bound grid original 0 block offset] + exact fiveFamilyPackedObservationPayload_valid + bound machine original (0 : Position + (rowWidth bound machine original)) offset + · funext offset + change + fiveFamilyPackedObservationRange + (fiveFamilyPackedSixTrackChunk center offset.val) = + phaseRangeBlockAt machine.tm + (rowWidth bound machine original) position offset + rw [show fiveFamilyPackedSixTrackChunk center offset.val = + fivePackedActualOffsetObservation + bound grid original position.val block offset.val from + fivePackedActualOffsetObservation_chunk + bound grid original position.val block offset] + exact fiveFamilyPackedObservationRange_valid + bound machine original position offset + · funext offset + change + fiveFamilyPackedObservationRange + (fiveFamilyPackedSixTrackChunk head offset.val) = + phaseRangeBlockAt machine.tm + (rowWidth bound machine original) + (0 : Position (rowWidth bound machine original)) offset + rw [show fiveFamilyPackedSixTrackChunk head offset.val = + fivePackedActualOffsetObservation + bound grid original 0 block offset.val from + fivePackedActualOffsetObservation_chunk + bound grid original 0 block offset] + exact fiveFamilyPackedObservationRange_valid + bound machine original (0 : Position + (rowWidth bound machine original)) offset + · funext offset + change + fiveFamilyPackedObservationBudget + (fiveFamilyPackedSixTrackChunk center offset.val) = + phaseBudgetBlockAt bound machine original position offset + rw [show fiveFamilyPackedSixTrackChunk center offset.val = + fivePackedActualOffsetObservation + bound grid original position.val block offset.val from + fivePackedActualOffsetObservation_chunk + bound grid original position.val block offset] + exact fiveFamilyPackedObservationBudget_valid + bound machine original position offset + · rfl + +end CNFFiveFamilyPackedInitialCellDecoderTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part07B.lean b/LeanPool/GapCVP/Part07B.lean new file mode 100644 index 000000000..6feb20c71 --- /dev/null +++ b/LeanPool/GapCVP/Part07B.lean @@ -0,0 +1,1088 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part07A + +/-! # GapCVP proof, part 07, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiveFamilyPackedInitialCellDecoderTM + +open Computability Turing GapCVP.CL GapCVP.CLVerifier GapCVP.CLBoundedStates GapCVP.CLCellRows + +open GapCVP.CLLocalWindows GapCVP.CLCellRowBounds GapCVP.CLFullTableauEmitter + +open GapCVP.CLCompleteVerifierSimulation GapCVP.CLPaddedAcceptanceCompiler GapCVP.BinaryEncoding + +open GapCVP.SourceUniformTuringTM GapCVP.SourceMachineCert + +open GapCVP.OutputPolynomialCompositionClosure GapCVP.CLEmittedCNFTM GapCVP.CLWindowTruthTable + +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFUnaryPairIndexTM + +open GapCVP.CNFUnaryPairIndexTotalRuntimeCert GapCVP.CNFFiveFamilyFlatCandidateGenerationTM + +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM + +open GapCVP.CNFFiveFamilyFlatRowMajorAtMostClauseWorkerTM + +open GapCVP.CNFFiveFamilyPackedInitialOffsetFeatureTM + +open GapCVP.SourceFourFamilyDiagonalMembershipPredicateTM + +private def fiveFamilyPackedInitialFeatureLimit + (tm : Turing.FinTM2) : ℕ := + 12 * blockSize tm + +private def fivePackedInitialDecodedSymbolValue + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (features : List Bool) : ℕ := + (completePhaseSymbolEquiv machine.tm + (fiveFamilyPackedInitialDecodedCell machine features)).val + +private def fivePackedInitialThresholdBitWord + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (index : ℕ) (features : List Bool) : List Bool := + [boundedLookupOutput + (fiveFamilyPackedInitialFeatureLimit machine.tm) + (fun bits => decide + (index < fivePackedInitialDecodedSymbolValue + machine bits)) features] + +private noncomputable def fiveFamilyPackedInitialThresholdBitComputable + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (index : ℕ) : + BitTM + (fivePackedInitialThresholdBitWord machine index) := + boundedLookupComputable + (fiveFamilyPackedInitialFeatureLimit machine.tm) + (fun bits => decide + (index < fivePackedInitialDecodedSymbolValue + machine bits)) + +private def fivePackedInitialThresholdMarkerWord + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (index : ℕ) (features : List Bool) : List Bool := + markerConditionalOutput (fun _ => [true]) [] + (fivePackedInitialThresholdBitWord + machine index features) + +private noncomputable def fiveFamilyPackedInitialThresholdMarkerComputable + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (index : ℕ) : + BitTM + (fivePackedInitialThresholdMarkerWord machine index) := by + have branch := markerConditionalComputable + (constantWordComputable [true]) [] + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyPackedInitialThresholdBitComputable machine index) + branch + change BitTM + (fun features => + markerConditionalOutput (fun _ => [true]) [] + (fivePackedInitialThresholdBitWord + machine index features)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyPackedInitialThresholdMarkerWord_valid + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (index : ℕ) (features : List Bool) + (hfeatures : features.length ≤ + fiveFamilyPackedInitialFeatureLimit machine.tm) : + fivePackedInitialThresholdMarkerWord + machine index features = + if index < fivePackedInitialDecodedSymbolValue + machine features then [true] else [] := by + unfold fivePackedInitialThresholdMarkerWord + fivePackedInitialThresholdBitWord + rw [boundedLookupOutput_of_length_le + (fiveFamilyPackedInitialFeatureLimit machine.tm) + (fun bits => decide + (index < fivePackedInitialDecodedSymbolValue + machine bits)) features hfeatures] + by_cases hindex : index < + fivePackedInitialDecodedSymbolValue machine features <;> + simp [hindex, markerConditionalOutput] + +private def fivePackedInitialThresholdStreamWord + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (indices : List ℕ) (features : List Bool) : List Bool := + indices.flatMap fun index => + fivePackedInitialThresholdMarkerWord + machine index features + +private noncomputable def fiveFamilyPackedInitialThresholdStreamComputable + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (indices : List ℕ) : + BitTM + (fivePackedInitialThresholdStreamWord machine indices) := by + induction indices with + | nil => exact constantWordComputable [] + | cons index remaining ih => + exact pointwiseAppendComputable + (fiveFamilyPackedInitialThresholdMarkerComputable + machine index) ih + +private theorem fiveFamilyPackedInitialWholeFeatureWord_length_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (position : Position (rowWidth bound machine original)) : + (fivePackedInitialWholeFeatureWord bound machine + (lengthPrefixedWord (List.replicate position.val true) ++ + lengthPrefixedWord original ++ suffix)).length = + fiveFamilyPackedInitialFeatureLimit machine.tm := by + rw [fiveFamilyPackedInitialWholeFeatureWord_valid + bound machine original suffix position] + simp only [List.length_append, List.length_flatMap, + fiveFamilyPackedActualOffsetObservation_length, + List.map_const', List.length_range, List.sum_replicate, smul_eq_mul, + fiveFamilyPackedInitialFeatureLimit] + ring + +private theorem fiveFamilyPackedInitialThresholdMarkers_eq_replicate + (alphabet value : ℕ) (hvalue : value ≤ alphabet) : + (List.range alphabet).flatMap + (fun index => if index < value then [true] else []) = + List.replicate value true := by + induction alphabet generalizing value with + | zero => + have hzero : value = 0 := by omega + simp only [hzero, not_lt_zero, ↓reduceIte, List.range_zero, List.flatMap_nil, + List.replicate_zero] + | succ alphabet ih => + rw [List.range_succ, List.flatMap_append] + simp only [List.flatMap_singleton] + by_cases hlast : alphabet < value + · have hvalue' : value = alphabet + 1 := by omega + subst value + have hprefix : + (List.range alphabet).flatMap + (fun index => + if index < alphabet + 1 then [true] else []) = + (List.range alphabet).flatMap + (fun index => + if index < alphabet then [true] else []) := by + apply List.flatMap_congr + intro index hindex + have hlt : index < alphabet := by + simpa only [List.mem_range] using hindex + simp only [Nat.lt_succ_of_lt hlt, ↓reduceIte, hlt] + rw [hprefix, ih alphabet (Nat.le_refl alphabet)] + simp only [lt_add_iff_pos_right, Order.lt_one_iff, ↓reduceIte, + SourceStructuralDecoder.replicate_true_append_cons, List.append_nil, + List.replicate_succ] + · rw [ih value (by omega)] + simp only [hlast, ↓reduceIte, List.append_nil] + +private def fivePackedInitialSourceSymbolUnary + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + fivePackedInitialThresholdStreamWord machine + (List.range (completePhaseSymbolCount machine.tm)) + (fivePackedInitialWholeFeatureWord bound machine input) + +private noncomputable def fiveFamilyPackedInitialSourceSymbolUnaryComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fivePackedInitialSourceSymbolUnary bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyPackedInitialWholeFeatureComputable bound machine) + (fiveFamilyPackedInitialThresholdStreamComputable machine + (List.range (completePhaseSymbolCount machine.tm))) + change BitTM + (fun input => + fivePackedInitialThresholdStreamWord machine + (List.range (completePhaseSymbolCount machine.tm)) + (fivePackedInitialWholeFeatureWord + bound machine input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyPackedInitialSourceSymbolUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (position : Position (rowWidth bound machine original)) : + fivePackedInitialSourceSymbolUnary bound machine + (lengthPrefixedWord (List.replicate position.val true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (completePhaseSymbolEquiv machine.tm + (initialPhaseCell bound machine original position)).val + true := by + let query := lengthPrefixedWord (List.replicate position.val true) ++ + lengthPrefixedWord original ++ suffix + let features := fivePackedInitialWholeFeatureWord + bound machine query + let symbol := completePhaseSymbolEquiv machine.tm + (initialPhaseCell bound machine original position) + have hfeatures : + features.length ≤ fiveFamilyPackedInitialFeatureLimit machine.tm := + Nat.le_of_eq (fiveFamilyPackedInitialWholeFeatureWord_length_valid + bound machine original suffix position) + have hdecoded : + fivePackedInitialDecodedSymbolValue machine features = + symbol.val := by + unfold fivePackedInitialDecodedSymbolValue + rw [fiveFamilyPackedInitialDecodedCell_valid + bound machine original suffix position] + unfold fivePackedInitialSourceSymbolUnary + fivePackedInitialThresholdStreamWord + change + (List.range (completePhaseSymbolCount machine.tm)).flatMap + (fun index => fivePackedInitialThresholdMarkerWord + machine index features) = + List.replicate symbol.val true + calc + (List.range (completePhaseSymbolCount machine.tm)).flatMap + (fun index => fivePackedInitialThresholdMarkerWord + machine index features) = + (List.range (completePhaseSymbolCount machine.tm)).flatMap + (fun index => if index < symbol.val then [true] else []) := by + apply List.flatMap_congr + intro index _ + rw [fiveFamilyPackedInitialThresholdMarkerWord_valid + machine index features hfeatures, hdecoded] + _ = List.replicate symbol.val true := + fiveFamilyPackedInitialThresholdMarkers_eq_replicate + (completePhaseSymbolCount machine.tm) symbol.val + (by have hlt := symbol.isLt; omega) + +private def fivePackedInitialPositionSymbolPairInput + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + fiveFamilyFlatIndexedPhysicalRank input ++ + false :: (fivePackedInitialSourceSymbolUnary + bound machine input ++ [false]) + +private noncomputable def fiveFamilyPackedInitialPositionSymbolPairInputComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fivePackedInitialPositionSymbolPairInput + bound machine) := by + have symbolSuffix := pointwiseAppendComputable + (fiveFamilyPackedInitialSourceSymbolUnaryComputable + bound machine) + (constantWordComputable [false]) + have delimiter := GapCVP.TMComposition.computableInPolyTime + symbolSuffix (prependBitComputable false) + have physical := pointwiseAppendComputable + fiveFlatIndexedPhysicalRankComputable delimiter + change BitTM + (fun input => + fiveFamilyFlatIndexedPhysicalRank input ++ + false :: (fivePackedInitialSourceSymbolUnary + bound machine input ++ [false])) + simpa only [Function.comp_apply] using physical + +private def fivePackedInitialPositionSymbolCode + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + unarySourcePairOutput + (fivePackedInitialPositionSymbolPairInput + bound machine input) + +private noncomputable def fiveFamilyPackedInitialPositionSymbolCodeComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fivePackedInitialPositionSymbolCode bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyPackedInitialPositionSymbolPairInputComputable + bound machine) + actualUnaryPairIndexComputable + change BitTM + (fun input => unarySourcePairOutput + (fivePackedInitialPositionSymbolPairInput + bound machine input)) + simpa only [Function.comp_def] using physical + +private def fivePackedInitialSourceVariablePairInput + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + false :: (fivePackedInitialPositionSymbolCode + bound machine input ++ [false]) + +private noncomputable def fiveFamilyPackedInitialSourceVariablePairInputComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fivePackedInitialSourceVariablePairInput bound machine) := by + have field := pointwiseAppendComputable + (fiveFamilyPackedInitialPositionSymbolCodeComputable + bound machine) + (constantWordComputable [false]) + have physical := GapCVP.TMComposition.computableInPolyTime + field (prependBitComputable false) + change BitTM + (fun input => false :: + (fivePackedInitialPositionSymbolCode + bound machine input ++ [false])) + simpa only [Function.comp_def] using physical + +private def fivePackedInitialSourceVariableCode + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + unarySourcePairOutput + (fivePackedInitialSourceVariablePairInput + bound machine input) + +private noncomputable def fiveFamilyPackedInitialSourceVariableCodeComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fivePackedInitialSourceVariableCode bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyPackedInitialSourceVariablePairInputComputable + bound machine) + actualUnaryPairIndexComputable + change BitTM + (fun input => unarySourcePairOutput + (fivePackedInitialSourceVariablePairInput + bound machine input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyPackedInitialSourceVariableCode_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (position : Position (rowWidth bound machine original)) : + fivePackedInitialSourceVariableCode bound machine + (lengthPrefixedWord (List.replicate position.val true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (Encodable.encode + (((0 : Time (rowWidth bound machine original)), + position, + completePhaseSymbolEquiv machine.tm + (initialPhaseCell bound machine original position)) : + Variable (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm))) true := by + unfold fivePackedInitialSourceVariableCode + fivePackedInitialSourceVariablePairInput + fivePackedInitialPositionSymbolCode + fivePackedInitialPositionSymbolPairInput + rw [fiveFamilyFlatIndexedPhysicalRank_valid, + fiveFamilyPackedInitialSourceSymbolUnary_valid + bound machine original suffix position] + let symbol := completePhaseSymbolEquiv machine.tm + (initialPhaseCell bound machine original position) + have hinner : + unarySourcePairOutput + (List.replicate position.val true ++ + false :: (List.replicate symbol.val true ++ [false])) = + List.replicate (Nat.pair position.val symbol.val) true := by + exact unarySourcePairOutput_word position.val symbol.val + change + unarySourcePairOutput + (false :: (unarySourcePairOutput + (List.replicate position.val true ++ + false :: (List.replicate symbol.val true ++ [false])) ++ + [false])) = _ + rw [hinner] + change + unarySourcePairOutput + (unarySourcePairWord 0 + (Nat.pair position.val symbol.val)) = _ + rw [unarySourcePairOutput_word] + rfl + +/-- GapCVP reduction support. -/ +def fiveFlatWholePackedInitialClauseRecordWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : List Bool := + fiveFlatSourceVariableSingletonRecordWord true + (fivePackedInitialSourceVariableCode + bound machine input) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveFamilyFlatWholePackedInitialClauseRecordComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveFlatWholePackedInitialClauseRecordWord + bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyPackedInitialSourceVariableCodeComputable + bound machine) + (fiveFamilyFlatSourceVariableSingletonRecordComputable true) + change BitTM + (fun input => fiveFlatSourceVariableSingletonRecordWord true + (fivePackedInitialSourceVariableCode + bound machine input)) + simpa only [Function.comp_def] using physical + +theorem fiveFamilyFlatWholePackedInitialClauseRecordWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (position : Position (rowWidth bound machine original)) : + fiveFlatWholePackedInitialClauseRecordWord + bound machine + (lengthPrefixedWord (List.replicate position.val true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseAnnotatedRecord + (initialClause + (paddedAcceptancePhaseSpecification + bound machine original).input position) := by + unfold fiveFlatWholePackedInitialClauseRecordWord + rw [fiveFamilyPackedInitialSourceVariableCode_valid + bound machine original suffix position, + fiveFamilyFlatSourceVariableSingletonRecordWord_valid] + rfl + +end CNFFiveFamilyPackedInitialCellDecoderTM + +namespace CNFFiveFamilyForbiddenWindowCoordinateTM + +open Computability Turing GapCVP.CL GapCVP.CLCompleteVerifierSimulation GapCVP.CLCellRowBounds +open GapCVP.BinaryEncoding GapCVP.SourceUniformTuringTM GapCVP.SourceMachineCert +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFUnaryPairIndexTM GapCVP.CNFUnaryPairIndexTotalRuntimeCert +open GapCVP.CNFCappedUnaryMinimumTM GapCVP.CNFCappedUnaryMinimumTotalCert +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM +open GapCVP.CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM + +/-- GapCVP reduction support. -/ +inductive FiveFamilyForbiddenWindowCoordinate where + | left + | center + | right + | next + +/-- GapCVP reduction support. -/ +def fiveForbiddenUnarySuccessorWord + (source : List Bool → List Bool) + (input : List Bool) : List Bool := + true :: source input + +/-- GapCVP reduction support. -/ +noncomputable def fiveForbiddenUnarySuccessorComputable + {source : List Bool → List Bool} + (computer : BitTM source) : + BitTM + (fiveForbiddenUnarySuccessorWord source) := by + have physical := GapCVP.TMComposition.computableInPolyTime + computer (prependBitComputable true) + change BitTM + (fun input => true :: source input) + simpa only [Function.comp_def] using physical + +private def fiveForbiddenComputedUnaryPairInput + (left right : List Bool → List Bool) + (input : List Bool) : List Bool := + left input ++ false :: (right input ++ [false]) + +private noncomputable def fiveFamilyForbiddenComputedUnaryPairInputComputable + {left right : List Bool → List Bool} + (hleft : BitTM left) + (hright : BitTM right) : + BitTM + (fiveForbiddenComputedUnaryPairInput left right) := by + have suffix := pointwiseAppendComputable + hright (constantWordComputable [false]) + have delimiter := GapCVP.TMComposition.computableInPolyTime + suffix (prependBitComputable false) + have physical := pointwiseAppendComputable + hleft delimiter + change BitTM + (fun input => left input ++ false :: (right input ++ [false])) + simpa only [Function.comp_apply] using physical + +private def fiveForbiddenComputedUnaryMinimumWord + (left right : List Bool → List Bool) + (input : List Bool) : List Bool := + cappedUnaryMinimumOutput + (fiveForbiddenComputedUnaryPairInput left right input) + +private noncomputable def fiveFamilyForbiddenComputedUnaryMinimumComputable + {left right : List Bool → List Bool} + (hleft : BitTM left) + (hright : BitTM right) : + BitTM + (fiveForbiddenComputedUnaryMinimumWord left right) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyForbiddenComputedUnaryPairInputComputable + hleft hright) + actualCappedUnaryMinimumComputable + change BitTM + (fun input => cappedUnaryMinimumOutput + (fiveForbiddenComputedUnaryPairInput + left right input)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyForbiddenComputedUnaryMinimumWord_valid + (left right : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hfirst : left input = List.replicate first true) + (hsecond : right input = List.replicate second true) : + fiveForbiddenComputedUnaryMinimumWord + left right input = List.replicate (min first second) true := by + unfold fiveForbiddenComputedUnaryMinimumWord + fiveForbiddenComputedUnaryPairInput + rw [hfirst, hsecond] + simpa only [unarySourcePairWord, List.append_nil] using cappedUnaryMinimumOutput_pair first + second [] + +/-- GapCVP reduction support. -/ +def fiveFamilyForbiddenWindowSourceRank + {T : ℕ} (window : Window T) : ℕ := + fiveFamilyFlatSourceRowMajorIndex window.1.1 window.1.2 + +private def fiveFamilyForbiddenCurrentTimeUnary + (grid : Polynomial ℕ) : List Bool → List Bool := + fiveFlatIndexedOriginalQuotientUnary grid + +private noncomputable def fiveFamilyForbiddenCurrentTimeUnaryComputable + (grid : Polynomial ℕ) : + BitTM + (fiveFamilyForbiddenCurrentTimeUnary grid) := + fiveFamilyFlatIndexedOriginalQuotientUnaryComputable grid + +private def fiveForbiddenCenterPositionUnary + (grid : Polynomial ℕ) : List Bool → List Bool := + fiveFlatIndexedOriginalRemainderUnary grid + +private noncomputable def fiveFamilyForbiddenCenterPositionUnaryComputable + (grid : Polynomial ℕ) : + BitTM + (fiveForbiddenCenterPositionUnary grid) := + fiveFamilyFlatIndexedOriginalRemainderUnaryComputable grid + +private def fiveForbiddenLeftPositionUnary + (grid : Polynomial ℕ) (input : List Bool) : List Bool := + (fiveForbiddenCenterPositionUnary grid input).tail + +private noncomputable def fiveFamilyForbiddenLeftPositionUnaryComputable + (grid : Polynomial ℕ) : + BitTM + (fiveForbiddenLeftPositionUnary grid) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyForbiddenCenterPositionUnaryComputable grid) + dropHeadComputable + change BitTM + (fun input => + (fiveForbiddenCenterPositionUnary grid input).tail) + simpa only [Function.comp_def] using physical + +private def fiveForbiddenLastPositionUnary + (grid : Polynomial ℕ) (input : List Bool) : List Bool := + (fiveFlatIndexedOriginalPolynomialUnary grid input).tail + +private noncomputable def fiveFamilyForbiddenLastPositionUnaryComputable + (grid : Polynomial ℕ) : + BitTM + (fiveForbiddenLastPositionUnary grid) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFlatIndexedOriginalPolynomialUnaryComputable grid) + dropHeadComputable + change BitTM + (fun input => + (fiveFlatIndexedOriginalPolynomialUnary grid input).tail) + simpa only [Function.comp_def] using physical + +private def fiveForbiddenRightCandidateUnary + (grid : Polynomial ℕ) : List Bool → List Bool := + fiveForbiddenUnarySuccessorWord + (fiveForbiddenCenterPositionUnary grid) + +private noncomputable def fiveFamilyForbiddenRightCandidateUnaryComputable + (grid : Polynomial ℕ) : + BitTM + (fiveForbiddenRightCandidateUnary grid) := + fiveForbiddenUnarySuccessorComputable + (fiveFamilyForbiddenCenterPositionUnaryComputable grid) + +private def fiveForbiddenRightPositionUnary + (grid : Polynomial ℕ) : List Bool → List Bool := + fiveForbiddenComputedUnaryMinimumWord + (fiveForbiddenRightCandidateUnary grid) + (fiveForbiddenLastPositionUnary grid) + +private noncomputable def fiveFamilyForbiddenRightPositionUnaryComputable + (grid : Polynomial ℕ) : + BitTM + (fiveForbiddenRightPositionUnary grid) := + fiveFamilyForbiddenComputedUnaryMinimumComputable + (fiveFamilyForbiddenRightCandidateUnaryComputable grid) + (fiveFamilyForbiddenLastPositionUnaryComputable grid) + +private def fiveFamilyForbiddenNextTimeUnary + (grid : Polynomial ℕ) : List Bool → List Bool := + fiveForbiddenUnarySuccessorWord + (fiveFamilyForbiddenCurrentTimeUnary grid) + +private noncomputable def fiveFamilyForbiddenNextTimeUnaryComputable + (grid : Polynomial ℕ) : + BitTM + (fiveFamilyForbiddenNextTimeUnary grid) := + fiveForbiddenUnarySuccessorComputable + (fiveFamilyForbiddenCurrentTimeUnaryComputable grid) + +private theorem fiveFamilyForbiddenCurrentTimeUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) : + fiveFamilyForbiddenCurrentTimeUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate window.1.1.val true := by + have hgrid : + 0 < (fiveFamilyFlatIndexedGridPolynomial + bound machine).eval original.length := by simp only + [fiveFamilyFlatIndexedGridPolynomial_eval, lt_add_iff_pos_left, Order.lt_add_one_iff, + zero_le] + unfold fiveFamilyForbiddenCurrentTimeUnary + fiveFamilyForbiddenWindowSourceRank + rw [fiveFamilyFlatIndexedOriginalQuotientUnary_valid + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyFlatSourceRowMajorIndex + window.1.1 window.1.2) + original suffix hgrid, + fiveFamilyFlatIndexedGridPolynomial_eval, + fiveFamilyFlatSourceRowMajorIndex_div] + +private theorem fiveFamilyForbiddenCenterPositionUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) : + fiveForbiddenCenterPositionUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate window.1.2.val true := by + have hgrid : + 0 < (fiveFamilyFlatIndexedGridPolynomial + bound machine).eval original.length := by simp only + [fiveFamilyFlatIndexedGridPolynomial_eval, lt_add_iff_pos_left, Order.lt_add_one_iff, + zero_le] + unfold fiveForbiddenCenterPositionUnary + fiveFamilyForbiddenWindowSourceRank + rw [fiveFamilyFlatIndexedOriginalRemainderUnary_valid + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyFlatSourceRowMajorIndex + window.1.1 window.1.2) + original suffix hgrid, + fiveFamilyFlatIndexedGridPolynomial_eval, + fiveFamilyFlatSourceRowMajorIndex_mod] + +private theorem fiveFamilyForbiddenLeftPositionUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) : + fiveForbiddenLeftPositionUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (leftPosition window).val true := by + unfold fiveForbiddenLeftPositionUnary + rw [fiveFamilyForbiddenCenterPositionUnary_valid + bound machine original suffix window] + change (List.replicate window.1.2.val true).tail = + List.replicate (window.1.2.val - 1) true + cases window.1.2.val with + | zero => rfl + | succ position => + simp only [List.replicate_succ, List.tail_cons, add_tsub_cancel_right] + +private theorem fiveFamilyForbiddenLastPositionUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) : + fiveForbiddenLastPositionUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (rowWidth bound machine original) true := by + unfold fiveForbiddenLastPositionUnary + rw [fiveFamilyFlatIndexedOriginalPolynomialUnary_valid + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (fiveFamilyForbiddenWindowSourceRank window) + original suffix, + fiveFamilyFlatIndexedGridPolynomial_eval] + simp only [List.replicate_succ, List.tail_cons] + +private theorem fiveFamilyForbiddenRightCandidateUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) : + fiveForbiddenRightCandidateUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (window.1.2.val + 1) true := by + unfold fiveForbiddenRightCandidateUnary + fiveForbiddenUnarySuccessorWord + rw [fiveFamilyForbiddenCenterPositionUnary_valid + bound machine original suffix window] + simp only [List.replicate_succ] + +private theorem fiveFamilyForbiddenRightPositionUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) : + fiveForbiddenRightPositionUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (rightPosition window).val true := by + unfold fiveForbiddenRightPositionUnary + rw [fiveFamilyForbiddenComputedUnaryMinimumWord_valid + (fiveForbiddenRightCandidateUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine)) + (fiveForbiddenLastPositionUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine)) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) + (window.1.2.val + 1) (rowWidth bound machine original) + (fiveFamilyForbiddenRightCandidateUnary_valid + bound machine original suffix window) + (fiveFamilyForbiddenLastPositionUnary_valid + bound machine original suffix window)] + rfl + +private theorem fiveFamilyForbiddenNextTimeUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) : + fiveFamilyForbiddenNextTimeUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate (nextTime window).val true := by + unfold fiveFamilyForbiddenNextTimeUnary + fiveForbiddenUnarySuccessorWord + rw [fiveFamilyForbiddenCurrentTimeUnary_valid + bound machine original suffix window] + simp only [nextTime, List.replicate_succ] + +private def fiveForbiddenCoordinateTimeUnary + (grid : Polynomial ℕ) : + FiveFamilyForbiddenWindowCoordinate → List Bool → List Bool + | .left | .center | .right => + fiveFamilyForbiddenCurrentTimeUnary grid + | .next => fiveFamilyForbiddenNextTimeUnary grid + +private noncomputable def fiveFamilyForbiddenCoordinateTimeUnaryComputable + (grid : Polynomial ℕ) + (coordinate : FiveFamilyForbiddenWindowCoordinate) : + BitTM + (fiveForbiddenCoordinateTimeUnary grid coordinate) := by + cases coordinate with + | left | center | right => + exact fiveFamilyForbiddenCurrentTimeUnaryComputable grid + | next => exact fiveFamilyForbiddenNextTimeUnaryComputable grid + +private def fiveForbiddenCoordinatePositionUnary + (grid : Polynomial ℕ) : + FiveFamilyForbiddenWindowCoordinate → List Bool → List Bool + | .left => fiveForbiddenLeftPositionUnary grid + | .center | .next => fiveForbiddenCenterPositionUnary grid + | .right => fiveForbiddenRightPositionUnary grid + +private noncomputable def fiveFamilyForbiddenCoordinatePositionUnaryComputable + (grid : Polynomial ℕ) + (coordinate : FiveFamilyForbiddenWindowCoordinate) : + BitTM + (fiveForbiddenCoordinatePositionUnary grid coordinate) := by + cases coordinate with + | left => exact fiveFamilyForbiddenLeftPositionUnaryComputable grid + | center | next => + exact fiveFamilyForbiddenCenterPositionUnaryComputable grid + | right => exact fiveFamilyForbiddenRightPositionUnaryComputable grid + +private def fiveForbiddenCoordinatePositionSymbolCode + (grid : Polynomial ℕ) + (coordinate : FiveFamilyForbiddenWindowCoordinate) + (symbol : ℕ) (input : List Bool) : List Bool := + unarySourcePairOutput + (fiveForbiddenComputedUnaryPairInput + (fiveForbiddenCoordinatePositionUnary grid coordinate) + (fun _ => List.replicate symbol true) input) + +private noncomputable def fiveFamilyForbiddenCoordinatePositionSymbolCodeComputable + (grid : Polynomial ℕ) + (coordinate : FiveFamilyForbiddenWindowCoordinate) + (symbol : ℕ) : + BitTM + (fiveForbiddenCoordinatePositionSymbolCode + grid coordinate symbol) := by + have query := fiveFamilyForbiddenComputedUnaryPairInputComputable + (fiveFamilyForbiddenCoordinatePositionUnaryComputable + grid coordinate) + (constantWordComputable (List.replicate symbol true)) + have physical := GapCVP.TMComposition.computableInPolyTime + query actualUnaryPairIndexComputable + change BitTM + (fun input => unarySourcePairOutput + (fiveForbiddenComputedUnaryPairInput + (fiveForbiddenCoordinatePositionUnary grid coordinate) + (fun _ => List.replicate symbol true) input)) + simpa only [Function.comp_def] using physical + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveForbiddenCoordinateSourceVariableCode + (grid : Polynomial ℕ) + (coordinate : FiveFamilyForbiddenWindowCoordinate) + (symbol : ℕ) (input : List Bool) : List Bool := + unarySourcePairOutput + (fiveForbiddenComputedUnaryPairInput + (fiveForbiddenCoordinateTimeUnary grid coordinate) + (fiveForbiddenCoordinatePositionSymbolCode + grid coordinate symbol) input) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveFamilyForbiddenCoordinateSourceVariableCodeComputable + (grid : Polynomial ℕ) + (coordinate : FiveFamilyForbiddenWindowCoordinate) + (symbol : ℕ) : + BitTM + (fiveForbiddenCoordinateSourceVariableCode + grid coordinate symbol) := by + have query := fiveFamilyForbiddenComputedUnaryPairInputComputable + (fiveFamilyForbiddenCoordinateTimeUnaryComputable + grid coordinate) + (fiveFamilyForbiddenCoordinatePositionSymbolCodeComputable + grid coordinate symbol) + have physical := GapCVP.TMComposition.computableInPolyTime + query actualUnaryPairIndexComputable + change BitTM + (fun input => unarySourcePairOutput + (fiveForbiddenComputedUnaryPairInput + (fiveForbiddenCoordinateTimeUnary grid coordinate) + (fiveForbiddenCoordinatePositionSymbolCode + grid coordinate symbol) input)) + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def fiveForbiddenWindowSourceVariable + {T S : ℕ} + (window : Window T) + (symbols : WindowSymbols S) : + FiveFamilyForbiddenWindowCoordinate → Variable T S + | .left => (window.1.1, leftPosition window, symbols.1) + | .center => (window.1.1, window.1.2, symbols.2.1) + | .right => (window.1.1, rightPosition window, symbols.2.2.1) + | .next => (nextTime window, window.1.2, symbols.2.2.2) + +/-- GapCVP reduction support. -/ +def fiveFamilyForbiddenWindowSlotSymbol + {S : ℕ} (symbols : WindowSymbols S) : + FiveFamilyForbiddenWindowCoordinate → Symbol S + | .left => symbols.1 + | .center => symbols.2.1 + | .right => symbols.2.2.1 + | .next => symbols.2.2.2 + +private theorem fiveFamilyForbiddenCoordinateTimeUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) + (coordinate : FiveFamilyForbiddenWindowCoordinate) : + fiveForbiddenCoordinateTimeUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) coordinate + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (fiveForbiddenWindowSourceVariable + window symbols coordinate).1.val true := by + cases coordinate with + | left | center | right => + exact fiveFamilyForbiddenCurrentTimeUnary_valid + bound machine original suffix window + | next => + exact fiveFamilyForbiddenNextTimeUnary_valid + bound machine original suffix window + +private theorem fiveFamilyForbiddenCoordinatePositionUnary_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) + (coordinate : FiveFamilyForbiddenWindowCoordinate) : + fiveForbiddenCoordinatePositionUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) coordinate + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (fiveForbiddenWindowSourceVariable + window symbols coordinate).2.1.val true := by + cases coordinate with + | left => + exact fiveFamilyForbiddenLeftPositionUnary_valid + bound machine original suffix window + | center | next => + exact fiveFamilyForbiddenCenterPositionUnary_valid + bound machine original suffix window + | right => + exact fiveFamilyForbiddenRightPositionUnary_valid + bound machine original suffix window + +theorem fiveFamilyForbiddenCoordinateSourceVariableCode_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) + (coordinate : FiveFamilyForbiddenWindowCoordinate) : + fiveForbiddenCoordinateSourceVariableCode + (fiveFamilyFlatIndexedGridPolynomial bound machine) + coordinate (fiveFamilyForbiddenWindowSlotSymbol + symbols coordinate).val + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowSourceVariable + window symbols coordinate)) true := by + let query := lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix + let atom := fiveForbiddenWindowSourceVariable + window symbols coordinate + have htime : + fiveForbiddenCoordinateTimeUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + coordinate query = + List.replicate atom.1.val true := + fiveFamilyForbiddenCoordinateTimeUnary_valid + bound machine original suffix window symbols coordinate + have hposition : + fiveForbiddenCoordinatePositionUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + coordinate query = + List.replicate atom.2.1.val true := + fiveFamilyForbiddenCoordinatePositionUnary_valid + bound machine original suffix window symbols coordinate + have hsymbol : + (fiveFamilyForbiddenWindowSlotSymbol + symbols coordinate).val = atom.2.2.val := by + cases coordinate <;> rfl + unfold fiveForbiddenCoordinateSourceVariableCode + fiveForbiddenCoordinatePositionSymbolCode + fiveForbiddenComputedUnaryPairInput + change + unarySourcePairOutput + (fiveForbiddenCoordinateTimeUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + coordinate query ++ + false :: + (unarySourcePairOutput + (fiveForbiddenCoordinatePositionUnary + (fiveFamilyFlatIndexedGridPolynomial bound machine) + coordinate query ++ + false :: + (List.replicate + (fiveFamilyForbiddenWindowSlotSymbol + symbols coordinate).val true ++ [false])) ++ + [false])) = + List.replicate (Encodable.encode atom) true + rw [htime, hposition, hsymbol] + have hinner : + unarySourcePairOutput + (List.replicate atom.2.1.val true ++ + false :: + (List.replicate atom.2.2.val true ++ [false])) = + List.replicate + (Nat.pair atom.2.1.val atom.2.2.val) true := + unarySourcePairOutput_word atom.2.1.val atom.2.2.val + rw [hinner] + change unarySourcePairOutput + (unarySourcePairWord atom.1.val + (Nat.pair atom.2.1.val atom.2.2.val)) = _ + rw [unarySourcePairOutput_word] + rfl + +end CNFFiveFamilyForbiddenWindowCoordinateTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part07C.lean b/LeanPool/GapCVP/Part07C.lean new file mode 100644 index 000000000..a8bdc453c --- /dev/null +++ b/LeanPool/GapCVP/Part07C.lean @@ -0,0 +1,2055 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part07B + +/-! # GapCVP proof, part 07, continuation 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiveFamilyForbiddenWindowCoordinateTM + +open Computability Turing GapCVP.CL GapCVP.CLCompleteVerifierSimulation GapCVP.CLCellRowBounds + +open GapCVP.BinaryEncoding GapCVP.SourceUniformTuringTM GapCVP.SourceMachineCert + +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CNFFlatPhysicalBinaryAppendTM + +open GapCVP.CNFUnaryPairIndexTM GapCVP.CNFUnaryPairIndexTotalRuntimeCert + +open GapCVP.CNFCappedUnaryMinimumTM GapCVP.CNFCappedUnaryMinimumTotalCert + +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM + +open GapCVP.CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM + +end CNFFiveFamilyForbiddenWindowCoordinateTM + +namespace CNFAnnotatedSourceClausePairZipTM + +open Turing GapCVP.CNFSourcePairPrefixWorkerTM GapCVP.CNFSourcePairPrefixWorkerTotalCert +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatAnnotatedSourceZipArchivedPair + (pair : ℕ × ℕ) : List Bool := + flatDuplicatedUnaryField pair.1 ++ + flatDuplicatedUnaryField pair.2 + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatAnnotatedSourceZipHeadPair + (offset : ℕ) (input : List Bool) : List Bool := + sourcePairPrefixOutput (flatAnnotatedSourceFieldAt offset input) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def annotatedSourceZipHeadPairComputable + (offset : ℕ) : + BitTM + (flatAnnotatedSourceZipHeadPair offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable offset) + actualSourcePairPrefixComputable + change BitTM + (fun input : List Bool => + sourcePairPrefixOutput (flatAnnotatedSourceFieldAt offset input)) + exact physical + +private def flatAnnotatedSourceZipPendingTail + (offset : ℕ) (input : List Bool) : List Bool := + flatUnaryDropFields 2 (flatAnnotatedSourceFieldAt offset input) + +private noncomputable def flatAnnotatedSourceZipPendingTailComputable + (offset : ℕ) : + BitTM + (flatAnnotatedSourceZipPendingTail offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable offset) + (flatUnaryDropFieldsComputable 2) + change BitTM + (fun input : List Bool => + flatUnaryDropFields 2 + (flatAnnotatedSourceFieldAt offset input)) + exact physical + +private def flatAnnotatedSourceZipNextArchive + (input : List Bool) : List Bool := + flatAnnotatedSourceZipHeadPair 0 input ++ + flatAnnotatedSourceZipHeadPair 1 input ++ + flatAnnotatedSourceFieldAt 2 input + +private noncomputable def flatAnnotatedSourceZipNextArchiveComputable : + BitTM + flatAnnotatedSourceZipNextArchive := by + have htail := pointwiseAppendComputable + (annotatedSourceZipHeadPairComputable 1) + (annotatedSourceFieldAtComputable 2) + have physical := pointwiseAppendComputable + (annotatedSourceZipHeadPairComputable 0) htail + have hequality : + (fun input : List Bool => + flatAnnotatedSourceZipHeadPair 0 input ++ + (flatAnnotatedSourceZipHeadPair 1 input ++ + flatAnnotatedSourceFieldAt 2 input)) = + flatAnnotatedSourceZipNextArchive := by + funext input + simp only [flatAnnotatedSourceZipNextArchive, List.append_assoc] + rw [← hequality] + exact physical + +end CNFAnnotatedSourceClausePairZipTM + +namespace CNFAnnotatedSourceCountedClausePairZipTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFSourcePairPrefixWorkerTM +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFCappedFlatSourceListFoldTotalCert +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFTypedRecordWorkerTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM GapCVP.CNFAnnotatedSourceClausePairZipTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatAnnotatedCountedSourceZipState + (first second : List ℕ) + (archive suffix : List Bool) : List Bool := + lengthPrefixedWord (flatDuplicatedUnarySourceStream first) ++ + lengthPrefixedWord (flatDuplicatedUnarySourceStream second) ++ + lengthPrefixedWord archive ++ + lengthPrefixedWord (List.replicate first.length true) ++ + lengthPrefixedWord (List.replicate second.length true) ++ + suffix + +private def countedZipNextCount + (offset : ℕ) (input : List Bool) : List Bool := + List.tail (flatAnnotatedSourceFieldAt offset input) + +private noncomputable def flatAnnotatedCountedSourceZipNextCountComputable + (offset : ℕ) : + BitTM + (countedZipNextCount offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable offset) + dropHeadComputable + change BitTM + (fun input : List Bool => + List.tail (flatAnnotatedSourceFieldAt offset input)) + exact physical + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatAnnotatedCountedSourceZipStep + (input : List Bool) : List Bool := + lengthPrefixedWord (flatAnnotatedSourceZipPendingTail 0 input) ++ + lengthPrefixedWord (flatAnnotatedSourceZipPendingTail 1 input) ++ + lengthPrefixedWord (flatAnnotatedSourceZipNextArchive input) ++ + lengthPrefixedWord + (countedZipNextCount 3 input) ++ + lengthPrefixedWord + (countedZipNextCount 4 input) ++ + flatAnnotatedSourceFieldTail 5 input + +private noncomputable def countedZipPrefixedComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (fun input => lengthPrefixedWord (worker input)) := + GapCVP.TMComposition.computableInPolyTime + computer structuralPrefixWriterComputable + +private noncomputable def flatAnnotatedCountedSourceZipStepComputable : + BitTM + flatAnnotatedCountedSourceZipStep := by + have htail := pointwiseAppendComputable + (countedZipPrefixedComputable + (flatAnnotatedCountedSourceZipNextCountComputable 4)) + (annotatedSourceFieldTailComputable 5) + have hsecondCount := pointwiseAppendComputable + (countedZipPrefixedComputable + (flatAnnotatedCountedSourceZipNextCountComputable 3)) + htail + have harchive := pointwiseAppendComputable + (countedZipPrefixedComputable + flatAnnotatedSourceZipNextArchiveComputable) + hsecondCount + have hsecond := pointwiseAppendComputable + (countedZipPrefixedComputable + (flatAnnotatedSourceZipPendingTailComputable 1)) + harchive + have physical := pointwiseAppendComputable + (countedZipPrefixedComputable + (flatAnnotatedSourceZipPendingTailComputable 0)) + hsecond + have hequality : + (fun input : List Bool => + lengthPrefixedWord + (flatAnnotatedSourceZipPendingTail 0 input) ++ + (lengthPrefixedWord + (flatAnnotatedSourceZipPendingTail 1 input) ++ + (lengthPrefixedWord + (flatAnnotatedSourceZipNextArchive input) ++ + (lengthPrefixedWord + (countedZipNextCount 3 input) ++ + (lengthPrefixedWord + (countedZipNextCount 4 input) ++ + flatAnnotatedSourceFieldTail 5 input))))) = + flatAnnotatedCountedSourceZipStep := by + funext input + simp only [flatAnnotatedCountedSourceZipStep, List.append_assoc] + rw [← hequality] + exact physical + +private theorem flatAnnotatedCountedSourceZipStep_outer + (first second archive firstCount secondCount suffix : List Bool) : + flatAnnotatedCountedSourceZipStep + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ + lengthPrefixedWord archive ++ + lengthPrefixedWord firstCount ++ + lengthPrefixedWord secondCount ++ suffix) = + lengthPrefixedWord (flatUnaryDropFields 2 first) ++ + lengthPrefixedWord (flatUnaryDropFields 2 second) ++ + lengthPrefixedWord + (sourcePairPrefixOutput first ++ + sourcePairPrefixOutput second ++ archive) ++ + lengthPrefixedWord firstCount.tail ++ + lengthPrefixedWord secondCount.tail ++ suffix := by + simp only [flatAnnotatedCountedSourceZipStep, flatAnnotatedSourceZipPendingTail, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, List.append_assoc, + Function.iterate_zero, + id_eq, firstFieldContents_valid, firstFieldSuffix_valid, flatAnnotatedSourceZipNextArchive, + flatAnnotatedSourceZipHeadPair, Function.iterate_succ_apply', countedZipNextCount] + +@[simp] private theorem flatAnnotatedCountedSourceZipStep_state + (firstHead secondHead : ℕ) + (firstTail secondTail : List ℕ) + (archive suffix : List Bool) : + flatAnnotatedCountedSourceZipStep + (flatAnnotatedCountedSourceZipState + (firstHead :: firstTail) + (secondHead :: secondTail) archive suffix) = + flatAnnotatedCountedSourceZipState firstTail secondTail + (flatAnnotatedSourceZipArchivedPair + (firstHead, secondHead) ++ archive) + suffix := by + unfold flatAnnotatedCountedSourceZipState + rw [flatAnnotatedCountedSourceZipStep_outer] + simp only [flatDuplicatedUnarySourceStream, List.flatMap_cons, flatDuplicatedUnaryField, + flatUnaryDropFields_two_unaryPair, sourcePairPrefixOutput_pair, List.append_assoc, + List.length_cons, + List.replicate_succ, List.tail_cons, flatAnnotatedSourceZipArchivedPair] + +private theorem flatAnnotatedCountedSourceZipStep_iterate_pairs + (pairs : List (ℕ × ℕ)) + (firstRemaining secondRemaining : List ℕ) + (archive suffix : List Bool) : + ((flatAnnotatedCountedSourceZipStep^[pairs.length]) + (flatAnnotatedCountedSourceZipState + (pairs.map Prod.fst ++ firstRemaining) + (pairs.map Prod.snd ++ secondRemaining) + archive suffix)) = + flatAnnotatedCountedSourceZipState firstRemaining secondRemaining + (pairs.reverse.flatMap flatAnnotatedSourceZipArchivedPair ++ + archive) + suffix := by + induction pairs generalizing archive with + | nil => simp only [List.length_nil, List.map_nil, List.nil_append, Function.iterate_zero, id_eq, + List.reverse_nil, + List.flatMap_nil] + | cons pair remaining ih => + rw [List.length_cons, Function.iterate_succ_apply] + simp only [List.map_cons, List.cons_append] + rw [flatAnnotatedCountedSourceZipStep_state] + rw [ih] + simp only [Prod.mk.eta, List.reverse_cons, List.flatMap_append, List.flatMap_cons, + List.flatMap_nil, + List.append_nil, List.append_assoc] + +private theorem flatAnnotatedCountedSourceZipStep_outer_length_le + (first second archive firstCount secondCount suffix : List Bool) : + (flatAnnotatedCountedSourceZipStep + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ + lengthPrefixedWord archive ++ + lengthPrefixedWord firstCount ++ + lengthPrefixedWord secondCount ++ suffix)).length ≤ + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ + lengthPrefixedWord archive ++ + lengthPrefixedWord firstCount ++ + lengthPrefixedWord secondCount ++ suffix).length := by + rw [flatAnnotatedCountedSourceZipStep_outer] + have hfirst := sourcePairPrefixOutput_drop_length_le first + have hsecond := sourcePairPrefixOutput_drop_length_le second + have hfirstCount : firstCount.tail.length ≤ firstCount.length := by + simp only [List.length_tail, tsub_le_iff_right, le_add_iff_nonneg_right, zero_le] + have hsecondCount : secondCount.tail.length ≤ secondCount.length := by + simp only [List.length_tail, tsub_le_iff_right, le_add_iff_nonneg_right, zero_le] + simp only [List.length_append, lengthPrefixedWord_length] at * + omega + +private theorem flatAnnotatedCountedSourceFieldTail_length_le + (offset : ℕ) (input : List Bool) : + (flatAnnotatedSourceFieldTail offset input).length ≤ input.length := by + induction offset with + | zero => simp only [flatAnnotatedSourceFieldTail, Function.iterate_zero, id_eq, Std.le_refl] + | succ offset ih => + unfold flatAnnotatedSourceFieldTail + rw [Function.iterate_succ_apply'] + have hfield := annotatedStructuralFieldAccounting + ((firstFieldSuffix^[offset]) input) + change + (firstFieldSuffix ((firstFieldSuffix^[offset]) input)).length ≤ + input.length + have hprevious : + (((firstFieldSuffix^[offset]) input)).length ≤ input.length := by + simpa only [flatAnnotatedSourceFieldTail] using ih + omega + +private theorem countedFieldAt_length_le + (offset : ℕ) (input : List Bool) : + (flatAnnotatedSourceFieldAt offset input).length ≤ input.length := by + have hfield := annotatedStructuralFieldAccounting + (flatAnnotatedSourceFieldTail offset input) + have htail := flatAnnotatedCountedSourceFieldTail_length_le + offset input + change + (firstFieldContents + (flatAnnotatedSourceFieldTail offset input)).length ≤ + input.length + omega + +private theorem flatAnnotatedCountedSourceZipStep_length_le + (input : List Bool) : + (flatAnnotatedCountedSourceZipStep input).length ≤ + 15 * input.length + 5 := by + have hfirst := countedFieldAt_length_le 0 input + have hsecond := countedFieldAt_length_le 1 input + have harchive := countedFieldAt_length_le 2 input + have hfirstCount := countedFieldAt_length_le 3 input + have hsecondCount := countedFieldAt_length_le 4 input + have hsuffix := flatAnnotatedCountedSourceFieldTail_length_le 5 input + have hfirstPair := sourcePairPrefixOutput_drop_length_le + (flatAnnotatedSourceFieldAt 0 input) + have hsecondPair := sourcePairPrefixOutput_drop_length_le + (flatAnnotatedSourceFieldAt 1 input) + have hfirstTail : + (List.tail (flatAnnotatedSourceFieldAt 3 input)).length ≤ + (flatAnnotatedSourceFieldAt 3 input).length := by + simp only [List.length_tail, tsub_le_iff_right, le_add_iff_nonneg_right, zero_le] + have hsecondTail : + (List.tail (flatAnnotatedSourceFieldAt 4 input)).length ≤ + (flatAnnotatedSourceFieldAt 4 input).length := by + simp only [List.length_tail, tsub_le_iff_right, le_add_iff_nonneg_right, zero_le] + simp only [flatAnnotatedCountedSourceZipStep, + flatAnnotatedSourceZipPendingTail, + flatAnnotatedSourceZipNextArchive, + flatAnnotatedSourceZipHeadPair, + countedZipNextCount, + List.length_append, lengthPrefixedWord_length] + omega + +private theorem flatAnnotatedCountedSourceZipStep_output_length_le + (input : List Bool) : + (flatAnnotatedCountedSourceZipStep + (flatAnnotatedCountedSourceZipStep input)).length ≤ + (flatAnnotatedCountedSourceZipStep input).length := by + unfold flatAnnotatedCountedSourceZipStep at ⊢ + exact flatAnnotatedCountedSourceZipStep_outer_length_le + (flatAnnotatedSourceZipPendingTail 0 input) + (flatAnnotatedSourceZipPendingTail 1 input) + (flatAnnotatedSourceZipNextArchive input) + (countedZipNextCount 3 input) + (countedZipNextCount 4 input) + (flatAnnotatedSourceFieldTail 5 input) + +private theorem flatAnnotatedCountedSourceZipStep_iterate_length_le + (input : List Bool) (stage : ℕ) : + (((flatAnnotatedCountedSourceZipStep^[stage]) input).length) ≤ + 15 * input.length + 5 := by + induction stage with + | zero => + simp only [Function.iterate_zero, id_eq] + omega + | succ stage ih => + cases stage with + | zero => + simpa only [zero_add, Function.iterate_one] + using flatAnnotatedCountedSourceZipStep_length_le input + | succ previous => + rw [Function.iterate_succ_apply'] + have hstep := flatAnnotatedCountedSourceZipStep_output_length_le + ((flatAnnotatedCountedSourceZipStep^[previous]) input) + have hbounded : + (flatAnnotatedCountedSourceZipStep + ((flatAnnotatedCountedSourceZipStep^[previous + 1]) + input)).length ≤ + (((flatAnnotatedCountedSourceZipStep^[previous + 1]) + input).length) := by + simpa only [Function.iterate_succ_apply'] using hstep + exact hbounded.trans ih + +private theorem flatAnnotatedCountedSourceZip_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + flatAnnotatedCountedSourceZipStep + (15 * Polynomial.X + 5) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage _ + have hseed := parsedUnaryFold_seed_length_le + input count seed hparse + have hstage := flatAnnotatedCountedSourceZipStep_iterate_length_le + seed stage + simp only [Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, + ge_iff_le] + omega + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def flatAnnotatedCountedSourceZipFoldComputable : + BitTM + (boundedRecordFoldOutput flatAnnotatedCountedSourceZipStep) := + boundedDependentRecordFoldComputable + flatAnnotatedCountedSourceZipStepComputable + (15 * Polynomial.X + 5) + flatAnnotatedCountedSourceZip_polynomiallyBoundedFoldStates + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedRecordFoldOutput_flatAnnotatedCountedSourceZipPairs + (pairs : List (ℕ × ℕ)) + (firstRemaining secondRemaining : List ℕ) + (archive suffix : List Bool) : + boundedRecordFoldOutput flatAnnotatedCountedSourceZipStep + (unaryBoundedFoldWord pairs.length + (flatAnnotatedCountedSourceZipState + (pairs.map Prod.fst ++ firstRemaining) + (pairs.map Prod.snd ++ secondRemaining) + archive suffix)) = + flatAnnotatedCountedSourceZipState + firstRemaining secondRemaining + (pairs.reverse.flatMap flatAnnotatedSourceZipArchivedPair ++ + archive) + suffix := by + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word, + flatAnnotatedCountedSourceZipStep_iterate_pairs] + +private def countedPairZipSeed + (input : List Bool) : List Bool := + flatAnnotatedSourcePrefixedField 1 input ++ + flatAnnotatedSourcePrefixedField 4 input ++ + lengthPrefixedWord [] ++ + flatAnnotatedSourcePrefixedField 2 input ++ + flatAnnotatedSourcePrefixedField 5 input ++ input + +private noncomputable def flatAnnotatedCountedSourcePairZipSeedComputable : + BitTM + countedPairZipSeed := by + have hsource := Turing.idComputableInPolyTime bitEncoding + have hsecondCount := pointwiseAppendComputable + (annotatedSourcePrefixedFieldComputable 5) hsource + have hfirstCount := pointwiseAppendComputable + (annotatedSourcePrefixedFieldComputable 2) hsecondCount + have hempty := pointwiseAppendComputable + (sourceFixedWordComputable (lengthPrefixedWord [])) hfirstCount + have hsecond := pointwiseAppendComputable + (annotatedSourcePrefixedFieldComputable 4) hempty + have physical := pointwiseAppendComputable + (annotatedSourcePrefixedFieldComputable 1) hsecond + have hequality : + (fun input : List Bool => + flatAnnotatedSourcePrefixedField 1 input ++ + (flatAnnotatedSourcePrefixedField 4 input ++ + (lengthPrefixedWord [] ++ + (flatAnnotatedSourcePrefixedField 2 input ++ + (flatAnnotatedSourcePrefixedField 5 input ++ input))))) = + countedPairZipSeed := by + funext input + simp only [countedPairZipSeed, List.append_assoc] + rw [← hequality] + exact physical + +/-- Internal support shared across GapCVP continuation modules. -/ +def countedPairZipPreparationWord + (input : List Bool) : List Bool := + flatAnnotatedSourceZipCountWord input ++ + false :: countedPairZipSeed input + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def flatAnnotatedCountedSourcePairZipPreparationComputable : + BitTM + countedPairZipPreparationWord := by + have hdelimiter := pointwiseAppendComputable + (sourceFixedWordComputable [false]) + flatAnnotatedCountedSourcePairZipSeedComputable + have physical := pointwiseAppendComputable + flatAnnotatedSourceZipCountComputable hdelimiter + have hequality : + (fun input : List Bool => + flatAnnotatedSourceZipCountWord input ++ + ([false] ++ countedPairZipSeed input)) = + countedPairZipPreparationWord := by + funext input + simp only [List.cons_append, List.nil_append, countedPairZipPreparationWord] + rw [← hequality] + exact physical + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatAnnotatedCountedSourcePairZipPreparationWord_valid + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + countedPairZipPreparationWord + (annotatedSourceAdjacentClauseWord firstClause firstCodes + firstCount secondClause secondCodes secondCount suffix) = + unaryBoundedFoldWord (min firstCount secondCount - 1) + (lengthPrefixedWord firstCodes ++ + lengthPrefixedWord secondCodes ++ + lengthPrefixedWord [] ++ + lengthPrefixedWord (List.replicate firstCount true) ++ + lengthPrefixedWord (List.replicate secondCount true) ++ + annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix) := by + simp only [countedPairZipPreparationWord, flatAnnotatedSourceZipCountWord_valid, + countedPairZipSeed, + flatAnnotatedSourcePrefixedField, flatAnnotatedSourceFieldAt_firstCodes, + flatAnnotatedSourceFieldAt_secondCodes, + List.append_assoc, flatAnnotatedSourceFieldAt_firstCount, + flatAnnotatedSourceFieldAt_secondCount, + unaryBoundedFoldWord] + +end CNFAnnotatedSourceCountedClausePairZipTM + +namespace CNFAnnotatedSourceUnaryTailReversalTM + +open Turing GapCVP.BinaryEncoding GapCVP.FormulaSemanticCert +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceTotalStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFSourcePairPrefixWorkerTM GapCVP.CNFSourcePairPrefixWorkerTotalCert +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFCappedFlatSourceListFoldTotalCert +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFTypedRecordWorkerTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM + +private def annotatedUnarySourceReverseState + (records : List ℕ) (archive suffix : List Bool) : List Bool := + lengthPrefixedWord (flatDuplicatedUnarySourceStream records) ++ + lengthPrefixedWord archive ++ suffix + +private def annotatedUnarySourceReversePending + (input : List Bool) : List Bool := + flatUnaryDropFields 2 (flatAnnotatedSourceFieldAt 0 input) + +private noncomputable def flatAnnotatedUnarySourceReversePendingComputable : + BitTM + annotatedUnarySourceReversePending := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 0) + (flatUnaryDropFieldsComputable 2) + change BitTM + (fun input : List Bool => + flatUnaryDropFields 2 (flatAnnotatedSourceFieldAt 0 input)) + exact physical + +private def flatAnnotatedUnarySourceReverseHead + (input : List Bool) : List Bool := + sourcePairPrefixOutput (flatAnnotatedSourceFieldAt 0 input) + +private noncomputable def flatAnnotatedUnarySourceReverseHeadComputable : + BitTM + flatAnnotatedUnarySourceReverseHead := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 0) + actualSourcePairPrefixComputable + change BitTM + (fun input : List Bool => + sourcePairPrefixOutput (flatAnnotatedSourceFieldAt 0 input)) + exact physical + +private def annotatedUnarySourceReverseNextArchive + (input : List Bool) : List Bool := + flatAnnotatedUnarySourceReverseHead input ++ + flatAnnotatedSourceFieldAt 1 input + +private noncomputable def flatAnnotatedUnarySourceReverseNextArchiveComputable : + BitTM + annotatedUnarySourceReverseNextArchive := by + have physical := pointwiseAppendComputable + flatAnnotatedUnarySourceReverseHeadComputable + (annotatedSourceFieldAtComputable 1) + change BitTM + (fun input : List Bool => + flatAnnotatedUnarySourceReverseHead input ++ + flatAnnotatedSourceFieldAt 1 input) + exact physical + +private def flatAnnotatedUnarySourceReverseStep + (input : List Bool) : List Bool := + lengthPrefixedWord (annotatedUnarySourceReversePending input) ++ + lengthPrefixedWord + (annotatedUnarySourceReverseNextArchive input) ++ + flatAnnotatedSourceFieldTail 2 input + +private noncomputable def flatAnnotatedUnarySourceReverseStepComputable : + BitTM + flatAnnotatedUnarySourceReverseStep := by + have hpending := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedUnarySourceReversePendingComputable + structuralPrefixWriterComputable + have harchive := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedUnarySourceReverseNextArchiveComputable + structuralPrefixWriterComputable + have hrest := pointwiseAppendComputable harchive + (annotatedSourceFieldTailComputable 2) + have physical := pointwiseAppendComputable hpending hrest + have hequality : + (fun input : List Bool => + lengthPrefixedWord + (annotatedUnarySourceReversePending input) ++ + (lengthPrefixedWord + (annotatedUnarySourceReverseNextArchive input) ++ + flatAnnotatedSourceFieldTail 2 input)) = + flatAnnotatedUnarySourceReverseStep := by + funext input + simp only [flatAnnotatedUnarySourceReverseStep, List.append_assoc] + rw [← hequality] + exact physical + +private theorem flatAnnotatedUnarySourceReverseStep_outer + (pending archive suffix : List Bool) : + flatAnnotatedUnarySourceReverseStep + (lengthPrefixedWord pending ++ + lengthPrefixedWord archive ++ suffix) = + lengthPrefixedWord (flatUnaryDropFields 2 pending) ++ + lengthPrefixedWord (sourcePairPrefixOutput pending ++ archive) ++ + suffix := by + simp only [flatAnnotatedUnarySourceReverseStep, annotatedUnarySourceReversePending, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, List.append_assoc, + Function.iterate_zero, + id_eq, firstFieldContents_valid, annotatedUnarySourceReverseNextArchive, + flatAnnotatedUnarySourceReverseHead, firstFieldSuffix_valid, Function.iterate_succ_apply'] + +@[simp] private theorem flatAnnotatedUnarySourceReverseStep_state + (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + flatAnnotatedUnarySourceReverseStep + (annotatedUnarySourceReverseState + (head :: remaining) archive suffix) = + annotatedUnarySourceReverseState remaining + (flatDuplicatedUnaryField head ++ archive) suffix := by + unfold annotatedUnarySourceReverseState + rw [flatAnnotatedUnarySourceReverseStep_outer] + simp only [flatDuplicatedUnarySourceStream, List.flatMap_cons, flatDuplicatedUnaryField, + flatUnaryDropFields_two_unaryPair, sourcePairPrefixOutput_pair, List.append_assoc] + +private theorem flatAnnotatedUnarySourceReverseStep_iterate_records + (records : List ℕ) (archive suffix : List Bool) : + ((flatAnnotatedUnarySourceReverseStep^[records.length]) + (annotatedUnarySourceReverseState records archive suffix)) = + annotatedUnarySourceReverseState [] + (flatDuplicatedUnarySourceStream records.reverse ++ archive) + suffix := by + induction records generalizing archive with + | nil => + simp only [List.length_nil, Function.iterate_zero, id_eq, flatDuplicatedUnarySourceStream, + List.reverse_nil, + List.flatMap_nil, List.nil_append] + | cons head remaining ih => + rw [List.length_cons, Function.iterate_succ_apply] + rw [flatAnnotatedUnarySourceReverseStep_state] + rw [ih] + simp only [flatDuplicatedUnarySourceStream, List.reverse_cons, List.flatMap_append, + List.flatMap_cons, + List.flatMap_nil, List.append_nil, List.append_assoc] + +private theorem flatAnnotatedUnarySourceReverseStep_outer_length_le + (pending archive suffix : List Bool) : + (flatAnnotatedUnarySourceReverseStep + (lengthPrefixedWord pending ++ + lengthPrefixedWord archive ++ suffix)).length ≤ + (lengthPrefixedWord pending ++ + lengthPrefixedWord archive ++ suffix).length := by + rw [flatAnnotatedUnarySourceReverseStep_outer] + have hpending := sourcePairPrefixOutput_drop_length_le pending + simp only [List.length_append, lengthPrefixedWord_length] at * + omega + +private theorem flatAnnotatedUnarySourceReverseStep_length_le + (input : List Bool) : + (flatAnnotatedUnarySourceReverseStep input).length ≤ + input.length + 2 := by + have hemptyContents : firstFieldContents [] = [] := by rfl + have hemptySuffix : firstFieldSuffix [] = [] := by rfl + have hemptyDrop : flatUnaryDropFields 2 [] = [] := by rfl + have hemptyPair : sourcePairPrefixOutput [] = [] := by rfl + cases hfirst : readLengthPrefixedWord input with + | none => + have hcontents : firstFieldContents input = [] := by + simp only [firstFieldContents, payloadDecodeOutput, hfirst, List.tail_cons] + have hsuffix : firstFieldSuffix input = [] := by + simp only [firstFieldSuffix, hfirst] + simp only [flatAnnotatedUnarySourceReverseStep, annotatedUnarySourceReversePending, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, Function.iterate_zero, id_eq, + hcontents, hemptyDrop, annotatedUnarySourceReverseNextArchive, + flatAnnotatedUnarySourceReverseHead, hemptyPair, hsuffix, hemptyContents, List.append_nil, + Function.iterate_succ_apply', hemptySuffix, List.length_append, lengthPrefixedWord_length, + List.length_nil, mul_zero, zero_add, Nat.reduceAdd, le_add_iff_nonneg_left, zero_le] + | some firstParsed => + obtain ⟨pending, firstSuffix⟩ := firstParsed + have hfirstShape := readLengthPrefixedWord_some_reconstruct + input pending firstSuffix hfirst + cases hsecond : readLengthPrefixedWord firstSuffix with + | none => + have hcontents : firstFieldContents firstSuffix = [] := by + simp only [firstFieldContents, payloadDecodeOutput, hsecond, List.tail_cons] + have hsuffix : firstFieldSuffix firstSuffix = [] := by + simp only [firstFieldSuffix, hsecond] + have hpending := sourcePairPrefixOutput_drop_length_le pending + rw [hfirstShape] + simp only [hemptyContents, hemptySuffix, hemptyDrop, hemptyPair, hcontents, hsuffix, + flatAnnotatedUnarySourceReverseStep, annotatedUnarySourceReversePending, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, Function.iterate_zero, id_eq, + firstFieldContents_valid, annotatedUnarySourceReverseNextArchive, + flatAnnotatedUnarySourceReverseHead, firstFieldSuffix_valid, List.append_nil, + Function.iterate_succ_apply', List.length_append, lengthPrefixedWord_length, ge_iff_le] + at * + omega + | some secondParsed => + obtain ⟨archive, suffix⟩ := secondParsed + have hsecondShape := readLengthPrefixedWord_some_reconstruct + firstSuffix archive suffix hsecond + rw [hfirstShape, hsecondShape] + have hvalid := + flatAnnotatedUnarySourceReverseStep_outer_length_le + pending archive suffix + simp only [List.append_assoc] at hvalid ⊢ + omega + +private theorem flatAnnotatedUnarySourceReverseStep_iterate_length_le + (input : List Bool) (stage : ℕ) : + (((flatAnnotatedUnarySourceReverseStep^[stage]) input).length) ≤ + input.length + 2 * stage := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have hstep := flatAnnotatedUnarySourceReverseStep_length_le + ((flatAnnotatedUnarySourceReverseStep^[stage]) input) + omega + +private theorem flatAnnotatedUnarySourceReverse_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + flatAnnotatedUnarySourceReverseStep + (3 * Polynomial.X + 2) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := parsedUnaryFold_seed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate := flatAnnotatedUnarySourceReverseStep_iterate_length_le + seed stage + simp only [Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, + ge_iff_le] + omega + +private noncomputable def flatAnnotatedUnarySourceReverseFoldComputable : + BitTM + (boundedRecordFoldOutput flatAnnotatedUnarySourceReverseStep) := + boundedDependentRecordFoldComputable + flatAnnotatedUnarySourceReverseStepComputable + (3 * Polynomial.X + 2) + flatAnnotatedUnarySourceReverse_polynomiallyBoundedFoldStates + +private theorem boundedRecordFoldOutput_flatAnnotatedUnarySourceReverse + (records : List ℕ) (archive suffix : List Bool) : + boundedRecordFoldOutput flatAnnotatedUnarySourceReverseStep + (unaryBoundedFoldWord records.length + (annotatedUnarySourceReverseState records archive suffix)) = + annotatedUnarySourceReverseState [] + (flatDuplicatedUnarySourceStream records.reverse ++ archive) + suffix := by + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word, + flatAnnotatedUnarySourceReverseStep_iterate_records] + +end CNFAnnotatedSourceUnaryTailReversalTM + +namespace CNFAnnotatedSourceCountedResidualTailTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFUnaryPairIndexTM GapCVP.CNFCappedUnaryMinimumTM +open GapCVP.CNFCappedUnaryPairArithmeticTM GapCVP.CNFFlatSourceOrder +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFCappedFlatSourceListComparatorTM +open GapCVP.CNFSourcePairPrefixWorkerTM GapCVP.CNFSourcePairPrefixWorkerTotalCert +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFAnnotatedSourceCountedClausePairZipTM +open GapCVP.CNFAnnotatedSourceUnaryTailReversalTM + +/-- Internal support shared across GapCVP continuation modules. -/ +def annotatedCountedResidualTailCount + (offset : ℕ) (input : List Bool) : List Bool := + List.tail (flatAnnotatedSourceFieldAt (offset + 3) input) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def flatAnnotatedCountedResidualTailCountComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualTailCount offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable (offset + 3)) + dropHeadComputable + change BitTM + (fun input : List Bool => + List.tail (flatAnnotatedSourceFieldAt (offset + 3) input)) + exact physical + +private def annotatedCountedResidualTailStream + (offset : ℕ) (input : List Bool) : List Bool := + flatUnaryDropFields 2 (flatAnnotatedSourceFieldAt offset input) + +private noncomputable def flatAnnotatedCountedResidualTailStreamComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualTailStream offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable offset) + (flatUnaryDropFieldsComputable 2) + change BitTM + (fun input : List Bool => + flatUnaryDropFields 2 (flatAnnotatedSourceFieldAt offset input)) + exact physical + +private def annotatedCountedResidualTailReversePreparation + (offset : ℕ) (input : List Bool) : List Bool := + annotatedCountedResidualTailCount offset input ++ + false :: + (lengthPrefixedWord + (annotatedCountedResidualTailStream offset input) ++ + lengthPrefixedWord [] ++ input) + +private noncomputable def flatAnnotatedCountedResidualTailReversePreparationComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualTailReversePreparation offset) := by + have hpending := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualTailStreamComputable offset) + structuralPrefixWriterComputable + have hsource := pointwiseAppendComputable + (sourceFixedWordComputable (lengthPrefixedWord [])) + (Turing.idComputableInPolyTime bitEncoding) + have hseed := pointwiseAppendComputable hpending hsource + have hdelimiter := pointwiseAppendComputable + (sourceFixedWordComputable [false]) hseed + have physical := pointwiseAppendComputable + (flatAnnotatedCountedResidualTailCountComputable offset) + hdelimiter + have hequality : + (fun input : List Bool => + annotatedCountedResidualTailCount offset input ++ + ([false] ++ + (lengthPrefixedWord + (annotatedCountedResidualTailStream offset input) ++ + (lengthPrefixedWord [] ++ input)))) = + annotatedCountedResidualTailReversePreparation offset := by + funext input + simp only [List.cons_append, List.nil_append, annotatedCountedResidualTailReversePreparation, + List.append_assoc] + rw [← hequality] + exact physical + +private def annotatedCountedResidualTailReverseOutput + (offset : ℕ) : List Bool → List Bool := + boundedRecordFoldOutput flatAnnotatedUnarySourceReverseStep ∘ + annotatedCountedResidualTailReversePreparation offset + +private noncomputable def flatAnnotatedCountedResidualTailReverseComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualTailReverseOutput offset) := + GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualTailReversePreparationComputable offset) + flatAnnotatedUnarySourceReverseFoldComputable + +private def annotatedCountedResidualTailReversedStream + (offset : ℕ) (input : List Bool) : List Bool := + flatAnnotatedSourceFieldAt 1 + (annotatedCountedResidualTailReverseOutput offset input) + +private noncomputable def flatAnnotatedCountedResidualTailReversedStreamComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualTailReversedStream offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualTailReverseComputable offset) + (annotatedSourceFieldAtComputable 1) + change BitTM + (fun input : List Bool => + flatAnnotatedSourceFieldAt 1 + (annotatedCountedResidualTailReverseOutput offset input)) + exact physical + +@[simp] private theorem flatAnnotatedCountedResidualTailReverseOutput_first + (head : ℕ) (remaining second : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualTailReverseOutput 0 + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix) = + annotatedUnarySourceReverseState [] + (flatDuplicatedUnarySourceStream remaining.reverse) + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix) := by + unfold annotatedCountedResidualTailReverseOutput + rw [Function.comp_apply] + have hpreparation : + annotatedCountedResidualTailReversePreparation 0 + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix) = + unaryBoundedFoldWord remaining.length + (annotatedUnarySourceReverseState remaining [] + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix)) := by + simp only [annotatedCountedResidualTailReversePreparation, annotatedCountedResidualTailCount, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, zero_add, + flatAnnotatedCountedSourceZipState, flatDuplicatedUnarySourceStream, List.flatMap_cons, + flatDuplicatedUnaryField, List.append_assoc, List.length_cons, List.replicate_succ, + Function.iterate_succ_apply', firstFieldSuffix_valid, firstFieldContents_valid, + List.tail_cons, + annotatedCountedResidualTailStream, Function.iterate_zero, id_eq, + flatUnaryDropFields_two_unaryPair, unaryBoundedFoldWord, annotatedUnarySourceReverseState] + rw [hpreparation] + simpa only [List.append_nil] using + boundedRecordFoldOutput_flatAnnotatedUnarySourceReverse remaining [] + (flatAnnotatedCountedSourceZipState (head :: remaining) second archive suffix) + +@[simp] private theorem flatAnnotatedCountedResidualTailReverseOutput_second + (first : List ℕ) (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualTailReverseOutput 1 + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) = + annotatedUnarySourceReverseState [] + (flatDuplicatedUnarySourceStream remaining.reverse) + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) := by + unfold annotatedCountedResidualTailReverseOutput + rw [Function.comp_apply] + have hpreparation : + annotatedCountedResidualTailReversePreparation 1 + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) = + unaryBoundedFoldWord remaining.length + (annotatedUnarySourceReverseState remaining [] + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix)) := by + simp [annotatedCountedResidualTailReversePreparation, + annotatedCountedResidualTailCount, + annotatedCountedResidualTailStream, + flatAnnotatedCountedSourceZipState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + flatDuplicatedUnarySourceStream, flatDuplicatedUnaryField, + annotatedUnarySourceReverseState, + unaryBoundedFoldWord, + Function.iterate_succ_apply', + List.replicate_succ, List.append_assoc] + rw [hpreparation] + simpa using boundedRecordFoldOutput_flatAnnotatedUnarySourceReverse + remaining [] + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) + +@[simp] private theorem flatAnnotatedCountedResidualTailReversedStream_first + (head : ℕ) (remaining second : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualTailReversedStream 0 + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix) = + flatDuplicatedUnarySourceStream remaining.reverse := by + unfold annotatedCountedResidualTailReversedStream + rw [flatAnnotatedCountedResidualTailReverseOutput_first] + simp only [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + annotatedUnarySourceReverseState, + flatDuplicatedUnarySourceStream, List.flatMap_nil, List.append_assoc, Function.iterate_one, + firstFieldSuffix_valid, + firstFieldContents_valid] + +@[simp] private theorem flatAnnotatedCountedResidualTailReversedStream_second + (first : List ℕ) (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualTailReversedStream 1 + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) = + flatDuplicatedUnarySourceStream remaining.reverse := by + unfold annotatedCountedResidualTailReversedStream + rw [flatAnnotatedCountedResidualTailReverseOutput_second] + simp only [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + annotatedUnarySourceReverseState, + flatDuplicatedUnarySourceStream, List.flatMap_nil, List.append_assoc, Function.iterate_one, + firstFieldSuffix_valid, + firstFieldContents_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +def annotatedCountedResidualHeadUnary + (offset : ℕ) (input : List Bool) : List Bool := + flatDuplicatedUnaryValueWord (flatAnnotatedSourceFieldAt offset input) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def flatAnnotatedCountedResidualHeadUnaryComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualHeadUnary offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable offset) + flatDuplicatedUnaryValueComputable + change BitTM + (fun input : List Bool => + flatDuplicatedUnaryValueWord + (flatAnnotatedSourceFieldAt offset input)) + exact physical + +private def annotatedCountedResidualCapUnary + (offset : ℕ) (input : List Bool) : List Bool := + true :: annotatedCountedResidualHeadUnary offset input + +private noncomputable def flatAnnotatedCountedResidualCapUnaryComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualCapUnary offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualHeadUnaryComputable offset) + (prependBitComputable true) + change BitTM + (fun input : List Bool => + true :: annotatedCountedResidualHeadUnary offset input) + exact physical + +private def annotatedCountedResidualCapField + (offset : ℕ) (input : List Bool) : List Bool := + annotatedCountedResidualCapUnary offset input ++ [false] + +private noncomputable def flatAnnotatedCountedResidualCapFieldComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualCapField offset) := + pointwiseAppendComputable + (flatAnnotatedCountedResidualCapUnaryComputable offset) + (sourceFixedWordComputable [false]) + +private def flatAnnotatedCountedResidualCapPair + (offset : ℕ) (input : List Bool) : List Bool := + annotatedCountedResidualCapField offset input ++ + annotatedCountedResidualCapField offset input + +private noncomputable def flatAnnotatedCountedResidualCapPairComputable + (offset : ℕ) : + BitTM + (flatAnnotatedCountedResidualCapPair offset) := + pointwiseAppendComputable + (flatAnnotatedCountedResidualCapFieldComputable offset) + (flatAnnotatedCountedResidualCapFieldComputable offset) + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatAnnotatedCountedResidualHeadUnary_first + (head : ℕ) (remaining second : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualHeadUnary 0 + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix) = + List.replicate head true := by + simp only [annotatedCountedResidualHeadUnary, flatDuplicatedUnaryValueWord, + flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, flatAnnotatedCountedSourceZipState, + flatDuplicatedUnarySourceStream, + List.flatMap_cons, flatDuplicatedUnaryField, List.append_assoc, List.length_cons, + Function.iterate_zero, id_eq, + firstFieldContents_valid, cappedUnaryMinimumOutput_pair, min_self] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatAnnotatedCountedResidualHeadUnary_second + (first : List ℕ) (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualHeadUnary 1 + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) = + List.replicate head true := by + simp only [annotatedCountedResidualHeadUnary, flatDuplicatedUnaryValueWord, + flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, flatAnnotatedCountedSourceZipState, + flatDuplicatedUnarySourceStream, + List.flatMap_cons, flatDuplicatedUnaryField, List.append_assoc, List.length_cons, + Function.iterate_one, + firstFieldSuffix_valid, firstFieldContents_valid, cappedUnaryMinimumOutput_pair, min_self] + +@[simp] private theorem flatAnnotatedCountedResidualCapPair_first + (head : ℕ) (remaining second : List ℕ) + (archive suffix : List Bool) : + flatAnnotatedCountedResidualCapPair 0 + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix) = + flatDuplicatedUnaryField (head + 1) := by + simp only [flatAnnotatedCountedResidualCapPair, annotatedCountedResidualCapField, + annotatedCountedResidualCapUnary, flatAnnotatedCountedResidualHeadUnary_first, + List.cons_append, List.append_assoc, + List.nil_append, flatDuplicatedUnaryField, unarySourcePairWord, List.replicate_succ] + +@[simp] private theorem flatAnnotatedCountedResidualCapPair_second + (first : List ℕ) (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + flatAnnotatedCountedResidualCapPair 1 + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) = + flatDuplicatedUnaryField (head + 1) := by + simp only [flatAnnotatedCountedResidualCapPair, annotatedCountedResidualCapField, + annotatedCountedResidualCapUnary, flatAnnotatedCountedResidualHeadUnary_second, + List.cons_append, List.append_assoc, + List.nil_append, flatDuplicatedUnaryField, unarySourcePairWord, List.replicate_succ] + +private theorem flatAnnotatedCountedResidualCappedStateAssembly + (cap : ℕ) (records : List ℕ) : + flatDuplicatedUnaryField cap ++ + sourcePairPrefixOutput + (flatDuplicatedUnarySourceStream records) ++ + flatDuplicatedUnaryField 0 ++ + flatUnaryDropFields 2 + (flatDuplicatedUnarySourceStream records) = + flatCappedUnarySourceListState cap 0 records := by + cases records with + | nil => + simp [flatDuplicatedUnarySourceStream, + flatCappedUnarySourceListState, + flatDuplicatedUnaryField, + sourcePairPrefixOutput, flatUnaryDropFields, + unaryPrefixSuffixOutput, readUnaryPrefix] + | cons head remaining => + simp [flatDuplicatedUnarySourceStream, + flatDuplicatedUnaryField, + flatCappedUnarySourceListState, + sourcePairPrefixOutput_pair, + flatUnaryDropFields_two_unaryPair, + List.append_assoc] + +private def annotatedCountedResidualReverseHeadPair + (offset : ℕ) (input : List Bool) : List Bool := + sourcePairPrefixOutput + (annotatedCountedResidualTailReversedStream offset input) + +private noncomputable def flatAnnotatedCountedResidualReverseHeadPairComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualReverseHeadPair offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualTailReversedStreamComputable offset) + actualSourcePairPrefixComputable + change BitTM + (fun input : List Bool => + sourcePairPrefixOutput + (annotatedCountedResidualTailReversedStream offset input)) + exact physical + +private def annotatedCountedResidualReversePending + (offset : ℕ) (input : List Bool) : List Bool := + flatUnaryDropFields 2 + (annotatedCountedResidualTailReversedStream offset input) + +private noncomputable def flatAnnotatedCountedResidualReversePendingComputable + (offset : ℕ) : + BitTM + (annotatedCountedResidualReversePending offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualTailReversedStreamComputable offset) + (flatUnaryDropFieldsComputable 2) + change BitTM + (fun input : List Bool => + flatUnaryDropFields 2 + (annotatedCountedResidualTailReversedStream offset input)) + exact physical + +private def annotatedCountedResidualCappedStateWord + (offset capOffset : ℕ) (input : List Bool) : List Bool := + flatAnnotatedCountedResidualCapPair capOffset input ++ + annotatedCountedResidualReverseHeadPair offset input ++ + flatDuplicatedUnaryField 0 ++ + annotatedCountedResidualReversePending offset input + +private noncomputable def flatAnnotatedCountedResidualCappedStateComputable + (offset capOffset : ℕ) : + BitTM + (annotatedCountedResidualCappedStateWord offset capOffset) := by + have htail := pointwiseAppendComputable + (sourceFixedWordComputable (flatDuplicatedUnaryField 0)) + (flatAnnotatedCountedResidualReversePendingComputable offset) + have hhead := pointwiseAppendComputable + (flatAnnotatedCountedResidualReverseHeadPairComputable offset) + htail + have physical := pointwiseAppendComputable + (flatAnnotatedCountedResidualCapPairComputable capOffset) + hhead + have hequality : + (fun input : List Bool => + flatAnnotatedCountedResidualCapPair capOffset input ++ + (annotatedCountedResidualReverseHeadPair offset input ++ + (flatDuplicatedUnaryField 0 ++ + annotatedCountedResidualReversePending offset input))) = + annotatedCountedResidualCappedStateWord offset capOffset := by + funext input + simp only [annotatedCountedResidualCappedStateWord, List.append_assoc] + rw [← hequality] + exact physical + +@[simp] private theorem flatAnnotatedCountedResidualCappedStateWord_first + (head : ℕ) (remaining : List ℕ) + (opposite : ℕ) (secondRemaining : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualCappedStateWord 0 1 + (flatAnnotatedCountedSourceZipState + (head :: remaining) (opposite :: secondRemaining) + archive suffix) = + flatCappedUnarySourceListState + (opposite + 1) 0 remaining.reverse := by + unfold annotatedCountedResidualCappedStateWord + annotatedCountedResidualReverseHeadPair + annotatedCountedResidualReversePending + rw [flatAnnotatedCountedResidualCapPair_second, + flatAnnotatedCountedResidualTailReversedStream_first] + exact flatAnnotatedCountedResidualCappedStateAssembly + (opposite + 1) remaining.reverse + +@[simp] private theorem flatAnnotatedCountedResidualCappedStateWord_second + (opposite : ℕ) (firstRemaining : List ℕ) + (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualCappedStateWord 1 0 + (flatAnnotatedCountedSourceZipState + (opposite :: firstRemaining) (head :: remaining) + archive suffix) = + flatCappedUnarySourceListState + (opposite + 1) 0 remaining.reverse := by + unfold annotatedCountedResidualCappedStateWord + annotatedCountedResidualReverseHeadPair + annotatedCountedResidualReversePending + rw [flatAnnotatedCountedResidualCapPair_first, + flatAnnotatedCountedResidualTailReversedStream_second] + exact flatAnnotatedCountedResidualCappedStateAssembly + (opposite + 1) remaining.reverse + +private def annotatedCountedResidualCappedFoldPreparation + (offset capOffset : ℕ) (input : List Bool) : List Bool := + annotatedCountedResidualTailCount offset input ++ + false :: annotatedCountedResidualCappedStateWord + offset capOffset input + +private noncomputable def flatAnnotatedCountedResidualCappedFoldPreparationComputable + (offset capOffset : ℕ) : + BitTM + (annotatedCountedResidualCappedFoldPreparation + offset capOffset) := by + have htail := pointwiseAppendComputable + (sourceFixedWordComputable [false]) + (flatAnnotatedCountedResidualCappedStateComputable + offset capOffset) + have physical := pointwiseAppendComputable + (flatAnnotatedCountedResidualTailCountComputable offset) + htail + have hequality : + (fun input : List Bool => + annotatedCountedResidualTailCount offset input ++ + ([false] ++ + annotatedCountedResidualCappedStateWord + offset capOffset input)) = + annotatedCountedResidualCappedFoldPreparation + offset capOffset := by + funext input + simp only [List.cons_append, List.nil_append, annotatedCountedResidualCappedFoldPreparation] + rw [← hequality] + exact physical + +/-- Internal support shared across GapCVP continuation modules. -/ +def annotatedCountedResidualCappedBinaryWord + (offset capOffset : ℕ) : List Bool → List Bool := + fullCappedFlatSourceListBinaryWord ∘ + annotatedCountedResidualCappedFoldPreparation offset capOffset + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def flatAnnotatedCountedResidualCappedBinaryComputable + (offset capOffset : ℕ) : + BitTM + (annotatedCountedResidualCappedBinaryWord offset capOffset) := + GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualCappedFoldPreparationComputable + offset capOffset) + fullCappedFlatSourceListBinaryComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatAnnotatedCountedResidualCappedBinaryWord_first + (head : ℕ) (remaining : List ℕ) + (opposite : ℕ) (secondRemaining : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualCappedBinaryWord 0 1 + (flatAnnotatedCountedSourceZipState + (head :: remaining) (opposite :: secondRemaining) + archive suffix) = + Computability.encodeNat + (cappedFlatSourceListValue (opposite + 1) remaining) := by + unfold annotatedCountedResidualCappedBinaryWord + rw [Function.comp_apply] + have hprepare : + annotatedCountedResidualCappedFoldPreparation 0 1 + (flatAnnotatedCountedSourceZipState + (head :: remaining) (opposite :: secondRemaining) + archive suffix) = + unaryBoundedFoldWord remaining.length + (flatCappedUnarySourceListState + (opposite + 1) 0 remaining.reverse) := by + unfold annotatedCountedResidualCappedFoldPreparation + rw [flatAnnotatedCountedResidualCappedStateWord_first] + simp [ + annotatedCountedResidualTailCount, + flatAnnotatedCountedSourceZipState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', List.replicate_succ, + unaryBoundedFoldWord, List.append_assoc] + rw [hprepare] + exact fullCappedFlatSourceListBinaryWord_valid + (opposite + 1) remaining + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatAnnotatedCountedResidualCappedBinaryWord_second + (opposite : ℕ) (firstRemaining : List ℕ) + (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + annotatedCountedResidualCappedBinaryWord 1 0 + (flatAnnotatedCountedSourceZipState + (opposite :: firstRemaining) (head :: remaining) + archive suffix) = + Computability.encodeNat + (cappedFlatSourceListValue (opposite + 1) remaining) := by + unfold annotatedCountedResidualCappedBinaryWord + rw [Function.comp_apply] + have hprepare : + annotatedCountedResidualCappedFoldPreparation 1 0 + (flatAnnotatedCountedSourceZipState + (opposite :: firstRemaining) (head :: remaining) + archive suffix) = + unaryBoundedFoldWord remaining.length + (flatCappedUnarySourceListState + (opposite + 1) 0 remaining.reverse) := by + unfold annotatedCountedResidualCappedFoldPreparation + rw [flatAnnotatedCountedResidualCappedStateWord_second] + simp [ + annotatedCountedResidualTailCount, + flatAnnotatedCountedSourceZipState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', List.replicate_succ, + unaryBoundedFoldWord, List.append_assoc] + rw [hprepare] + exact fullCappedFlatSourceListBinaryWord_valid + (opposite + 1) remaining + +end CNFAnnotatedSourceCountedResidualTailTM + +namespace SourceFourFamilyTaggedPredicateDispatchTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CNFGuardedFiveFamilyTagDispatchTM GapCVP.CNFFlatPhysicalBinaryAppendTM + +private def sourceFourFamilyTagStrippedWorkerWord + (worker : List Bool → List Bool) + (input : List Bool) : List Bool := + worker (firstFieldSuffix input) + +private noncomputable def sourceFourFamilyTagStrippedWorkerComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (sourceFourFamilyTagStrippedWorkerWord worker) := by + have physical := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable computer + change BitTM + (fun input => worker (firstFieldSuffix input)) + exact physical + +/-- GapCVP reduction support. -/ +def fourFamilyTaggedGuardedWorkerWord + (tag : List Bool) (worker : List Bool → List Bool) + (input : List Bool) : List Bool := + fixedDelimitedGuardedWorkerWord tag + (sourceFourFamilyTagStrippedWorkerWord worker) input + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyTaggedGuardedWorkerComputable + (tag : List Bool) + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (fourFamilyTaggedGuardedWorkerWord tag worker) := by + exact fixedDelimitedGuardedWorkerComputable tag + (sourceFourFamilyTagStrippedWorkerComputable computer) + +@[simp] theorem sourceFourFamilyTaggedGuardedWorkerWord_valid + (expected actual payload : List Bool) + (worker : List Bool → List Bool) : + fourFamilyTaggedGuardedWorkerWord expected worker + (lengthPrefixedWord actual ++ payload) = + if expected = actual then worker payload else [] := by + simp only [fourFamilyTaggedGuardedWorkerWord, fixedDelimitedGuardedWorkerWord, + fixedDelimitedWordEqualitySelector_valid, decide_eq_true_eq, + sourceFourFamilyTagStrippedWorkerWord, + firstFieldSuffix_valid] + +/-- GapCVP reduction support. -/ +def fourFamilyTaggedPredicateMarker + (interpolation normalization diagonal clause : + List Bool → List Bool) + (input : List Bool) : List Bool := + fourFamilyTaggedGuardedWorkerWord + [false, false] interpolation input ++ + fourFamilyTaggedGuardedWorkerWord + [false, true] normalization input ++ + fourFamilyTaggedGuardedWorkerWord + [true, false] diagonal input ++ + fourFamilyTaggedGuardedWorkerWord + [true, true] clause input + +/-- GapCVP reduction support. -/ +noncomputable def fourFamilyTaggedPredicateMarkerComputable + {interpolation normalization diagonal clause : + List Bool → List Bool} + (hinterpolation : BitTM interpolation) + (hnormalization : BitTM normalization) + (hdiagonal : BitTM diagonal) + (hclause : BitTM clause) : + BitTM + (fourFamilyTaggedPredicateMarker + interpolation normalization diagonal clause) := by + have hlast := pointwiseAppendComputable + (fourFamilyTaggedGuardedWorkerComputable + [true, false] hdiagonal) + (fourFamilyTaggedGuardedWorkerComputable + [true, true] hclause) + have htail := pointwiseAppendComputable + (fourFamilyTaggedGuardedWorkerComputable + [false, true] hnormalization) + hlast + have physical := pointwiseAppendComputable + (fourFamilyTaggedGuardedWorkerComputable + [false, false] hinterpolation) + htail + have hequality : + (fun input => + fourFamilyTaggedGuardedWorkerWord + [false, false] interpolation input ++ + (fourFamilyTaggedGuardedWorkerWord + [false, true] normalization input ++ + (fourFamilyTaggedGuardedWorkerWord + [true, false] diagonal input ++ + fourFamilyTaggedGuardedWorkerWord + [true, true] clause input))) = + fourFamilyTaggedPredicateMarker + interpolation normalization diagonal clause := by + funext input + simp only [fourFamilyTaggedPredicateMarker, List.append_assoc] + rw [← hequality] + exact physical + +@[simp] theorem sourceFourFamilyTaggedPredicateMarker_interpolation + (interpolation normalization diagonal clause : + List Bool → List Bool) + (payload : List Bool) : + fourFamilyTaggedPredicateMarker + interpolation normalization diagonal clause + (lengthPrefixedWord [false, false] ++ payload) = + interpolation payload := by + simp only [fourFamilyTaggedPredicateMarker, + sourceFourFamilyTaggedGuardedWorkerWord_valid, ↓reduceIte, List.cons.injEq, + Bool.true_eq_false, and_true, and_false, List.append_nil, + and_self] + +@[simp] theorem sourceFourFamilyTaggedPredicateMarker_normalization + (interpolation normalization diagonal clause : + List Bool → List Bool) + (payload : List Bool) : + fourFamilyTaggedPredicateMarker + interpolation normalization diagonal clause + (lengthPrefixedWord [false, true] ++ payload) = + normalization payload := by + simp only [fourFamilyTaggedPredicateMarker, + sourceFourFamilyTaggedGuardedWorkerWord_valid, List.cons.injEq, + Bool.false_eq_true, and_true, and_false, ↓reduceIte, List.nil_append, + Bool.true_eq_false, and_self, List.append_nil] + +@[simp] theorem sourceFourFamilyTaggedPredicateMarker_diagonal + (interpolation normalization diagonal clause : + List Bool → List Bool) + (payload : List Bool) : + fourFamilyTaggedPredicateMarker + interpolation normalization diagonal clause + (lengthPrefixedWord [true, false] ++ payload) = + diagonal payload := by + simp only [fourFamilyTaggedPredicateMarker, + sourceFourFamilyTaggedGuardedWorkerWord_valid, List.cons.injEq, Bool.false_eq_true, and_true, + ↓reduceIte, + Bool.true_eq_false, and_self, List.append_nil, List.nil_append, + and_false] + +@[simp] theorem sourceFourFamilyTaggedPredicateMarker_clause + (interpolation normalization diagonal clause : + List Bool → List Bool) + (payload : List Bool) : + fourFamilyTaggedPredicateMarker + interpolation normalization diagonal clause + (lengthPrefixedWord [true, true] ++ payload) = + clause payload := by + simp only [fourFamilyTaggedPredicateMarker, + sourceFourFamilyTaggedGuardedWorkerWord_valid, List.cons.injEq, Bool.false_eq_true, and_true, + and_self, ↓reduceIte, + List.append_nil, and_false, List.nil_append] + +end SourceFourFamilyTaggedPredicateDispatchTM + +namespace CNFAnnotatedSourceSquareMajorResolutionTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.FormulaSemanticCert +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceTotalStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralPrefixWriter GapCVP.CLStructuralNaturalBinaryWriter +open GapCVP.CNFEncodedClauseSort GapCVP.CNFNaturalOrderComparator +open GapCVP.CNFNaturalOrderCertifiedComparator GapCVP.CNFCappedUnaryMinimumTM +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFCappedFlatSourceListFoldTotalCert +open GapCVP.CNFFlatSourceOrder GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFGuardedFiveFamilyTagDispatchTM GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFAnnotatedSourceClausePairZipTM GapCVP.CNFTypedRecordWorkerTM +open GapCVP.SourceFourFamilyTaggedPredicateDispatchTM + +private def flatAnnotatedSquareHeadUnaryWord + (offset : ℕ) (input : List Bool) : List Bool := + flatDuplicatedUnaryValueWord + (flatUnaryDropFields offset (firstFieldContents input)) + +private noncomputable def flatAnnotatedSquareHeadUnaryComputable + (offset : ℕ) : + BitTM + (flatAnnotatedSquareHeadUnaryWord offset) := by + have htail := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable + (flatUnaryDropFieldsComputable offset) + have physical := GapCVP.TMComposition.computableInPolyTime + htail flatDuplicatedUnaryValueComputable + change BitTM + (fun input : List Bool => + flatDuplicatedUnaryValueWord + (flatUnaryDropFields offset (firstFieldContents input))) + simpa only [Function.comp_def] using physical + +@[simp] private theorem flatAnnotatedSquareHeadUnaryWord_first + (first second : ℕ) (archive suffix : List Bool) : + flatAnnotatedSquareHeadUnaryWord 0 + (lengthPrefixedWord + (flatAnnotatedSourceZipArchivedPair (first, second) ++ + archive) ++ suffix) = + List.replicate first true := by + simp only [flatAnnotatedSquareHeadUnaryWord, flatDuplicatedUnaryValueWord, flatUnaryDropFields, + flatAnnotatedSourceZipArchivedPair, flatDuplicatedUnaryField, List.append_assoc, + firstFieldContents_valid, + Function.iterate_zero, id_eq, cappedUnaryMinimumOutput_pair, min_self] + +@[simp] private theorem flatAnnotatedSquareHeadUnaryWord_second + (first second : ℕ) (archive suffix : List Bool) : + flatAnnotatedSquareHeadUnaryWord 2 + (lengthPrefixedWord + (flatAnnotatedSourceZipArchivedPair (first, second) ++ + archive) ++ suffix) = + List.replicate second true := by + simp only [flatAnnotatedSquareHeadUnaryWord, flatDuplicatedUnaryValueWord, + flatAnnotatedSourceZipArchivedPair, + flatDuplicatedUnaryField, List.append_assoc, firstFieldContents_valid, + flatUnaryDropFields_two_unaryPair, + cappedUnaryMinimumOutput_pair, min_self] + +private def flatAnnotatedSquareHeadBinaryWord + (offset : ℕ) (input : List Bool) : List Bool := + Computability.encodeNat + (flatAnnotatedSquareHeadUnaryWord offset input).length + +private noncomputable def flatAnnotatedSquareHeadBinaryComputable + (offset : ℕ) : + BitTM + (flatAnnotatedSquareHeadBinaryWord offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedSquareHeadUnaryComputable offset) + structuralNaturalBinaryWriterComputable + change BitTM + (fun input : List Bool => + Computability.encodeNat + (flatAnnotatedSquareHeadUnaryWord offset input).length) + simpa only [Function.comp_def] using physical + +private def annotatedSquareHeadComparisonInput + (input : List Bool) : List Bool := + lengthPrefixedWord (flatAnnotatedSquareHeadBinaryWord 0 input) ++ + lengthPrefixedWord (flatAnnotatedSquareHeadBinaryWord 2 input) ++ + input + +private noncomputable def flatAnnotatedSquareHeadComparisonInputComputable : + BitTM + annotatedSquareHeadComparisonInput := by + have hfirst := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedSquareHeadBinaryComputable 0) + structuralPrefixWriterComputable + have hsecond := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedSquareHeadBinaryComputable 2) + structuralPrefixWriterComputable + have htail := pointwiseAppendComputable hsecond + (Turing.idComputableInPolyTime bitEncoding) + have physical := pointwiseAppendComputable hfirst htail + have hequality : + (fun input : List Bool => + lengthPrefixedWord + (flatAnnotatedSquareHeadBinaryWord 0 input) ++ + (lengthPrefixedWord + (flatAnnotatedSquareHeadBinaryWord 2 input) ++ input)) = + annotatedSquareHeadComparisonInput := by + funext input + simp only [annotatedSquareHeadComparisonInput, List.append_assoc] + rw [← hequality] + exact physical + +private def flatAnnotatedSquareHeadOrderingWord + (input : List Bool) : List Bool := + firstFieldSuffix + (sourcePreservingDelimitedNaturalComparisonWord + (annotatedSquareHeadComparisonInput input)) + +private noncomputable def flatAnnotatedSquareHeadOrderingComputable : + BitTM + flatAnnotatedSquareHeadOrderingWord := by + have hcomparison := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSquareHeadComparisonInputComputable + sourcePreservingDelimitedNaturalComparisonComputable + have physical := GapCVP.TMComposition.computableInPolyTime + hcomparison firstFieldSuffixComputable + change BitTM + (fun input : List Bool => + firstFieldSuffix + (sourcePreservingDelimitedNaturalComparisonWord + (annotatedSquareHeadComparisonInput input))) + simpa only [Function.comp_def] using physical + +@[simp] private theorem flatAnnotatedSquareHeadOrderingWord_valid + (first second : ℕ) (archive suffix : List Bool) : + flatAnnotatedSquareHeadOrderingWord + (lengthPrefixedWord + (flatAnnotatedSourceZipArchivedPair (first, second) ++ + archive) ++ suffix) = + encodedWordOrderingWord + (flatSourceNaturalOrdering first second) := by + simp only [flatAnnotatedSquareHeadOrderingWord, sourcePreservingDelimitedNaturalComparisonWord, + annotatedSquareHeadComparisonInput, flatAnnotatedSquareHeadBinaryWord, + flatAnnotatedSquareHeadUnaryWord_first, + List.length_replicate, flatAnnotatedSquareHeadUnaryWord_second, List.append_assoc, + firstFieldSuffix_valid, + flatSourceNaturalOrdering] + simpa only [List.append_assoc] using + congrArg encodedWordOrderingWord + (delimitedNaturalPairOrdering_encodeNat first second + (lengthPrefixedWord + (flatAnnotatedSourceZipArchivedPair (first, second) ++ + archive) ++ suffix)) + +private theorem flatAnnotatedSquareHeadOrderingWord_length + (input : List Bool) : + (flatAnnotatedSquareHeadOrderingWord input).length = 2 := by + simp only [flatAnnotatedSquareHeadOrderingWord, sourcePreservingDelimitedNaturalComparisonWord, + encodedWordOrderingWord, firstFieldSuffix_valid, List.length_cons, List.length_nil, zero_add, + Nat.reduceAdd] + +/-- Internal support shared across GapCVP continuation modules. -/ +def annotatedSquareResolvedOrderingWord + (input : List Bool) : List Bool := + fourFamilyTaggedPredicateMarker + (fun _ : List Bool => encodedWordOrderingWord .invalid) + (fun _ : List Bool => encodedWordOrderingWord .less) + flatAnnotatedSquareHeadOrderingWord + (fun _ : List Bool => encodedWordOrderingWord .greater) + input + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def flatAnnotatedSquareResolvedOrderingComputable : + BitTM + annotatedSquareResolvedOrderingWord := + fourFamilyTaggedPredicateMarkerComputable + (sourceFixedWordComputable (encodedWordOrderingWord .invalid)) + (sourceFixedWordComputable (encodedWordOrderingWord .less)) + flatAnnotatedSquareHeadOrderingComputable + (sourceFixedWordComputable (encodedWordOrderingWord .greater)) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAnnotatedSquareResolvedOrderingWord_valid + (major : EncodedWordOrdering) + (first second : ℕ) (archive suffix : List Bool) : + annotatedSquareResolvedOrderingWord + (lengthPrefixedWord (encodedWordOrderingWord major) ++ + lengthPrefixedWord + (flatAnnotatedSourceZipArchivedPair (first, second) ++ + archive) ++ suffix) = + encodedWordOrderingWord + (resolveFlatSourceOrder major first second) := by + let payload := lengthPrefixedWord + (flatAnnotatedSourceZipArchivedPair (first, second) ++ archive) ++ + suffix + cases major with + | invalid => + simpa only [annotatedSquareResolvedOrderingWord, encodedWordOrderingWord, + encodedWordOrderingFirst, + encodedWordOrderingSecond, List.append_assoc, resolveFlatSourceOrder, + payload] using + (sourceFourFamilyTaggedPredicateMarker_interpolation (fun _ : List Bool + => encodedWordOrderingWord .invalid) + (fun _ : List Bool => encodedWordOrderingWord .less) + flatAnnotatedSquareHeadOrderingWord + (fun _ : List Bool => encodedWordOrderingWord .greater) payload) + | less => + simpa only [annotatedSquareResolvedOrderingWord, encodedWordOrderingWord, + encodedWordOrderingFirst, + encodedWordOrderingSecond, List.append_assoc, resolveFlatSourceOrder, + payload] using + (sourceFourFamilyTaggedPredicateMarker_normalization (fun _ : List Bool + => encodedWordOrderingWord .invalid) + (fun _ : List Bool => encodedWordOrderingWord .less) + flatAnnotatedSquareHeadOrderingWord + (fun _ : List Bool => encodedWordOrderingWord .greater) payload) + | equal => + have hdispatch := + sourceFourFamilyTaggedPredicateMarker_diagonal + (fun _ : List Bool => encodedWordOrderingWord .invalid) + (fun _ : List Bool => encodedWordOrderingWord .less) + flatAnnotatedSquareHeadOrderingWord + (fun _ : List Bool => encodedWordOrderingWord .greater) + payload + have hhead := flatAnnotatedSquareHeadOrderingWord_valid + first second archive suffix + simpa only [annotatedSquareResolvedOrderingWord, encodedWordOrderingWord, + encodedWordOrderingFirst, + encodedWordOrderingSecond, List.append_assoc, resolveFlatSourceOrder, payload] using + hdispatch.trans hhead + | greater => + simpa only [annotatedSquareResolvedOrderingWord, encodedWordOrderingWord, + encodedWordOrderingFirst, + encodedWordOrderingSecond, List.append_assoc, resolveFlatSourceOrder, payload] using + (sourceFourFamilyTaggedPredicateMarker_clause (fun _ : List Bool + => encodedWordOrderingWord .invalid) + (fun _ : List Bool => encodedWordOrderingWord .less) + flatAnnotatedSquareHeadOrderingWord + (fun _ : List Bool => encodedWordOrderingWord .greater) payload) + +private theorem flatAnnotatedSquareResolvedOrderingWord_length_le + (input : List Bool) : + (annotatedSquareResolvedOrderingWord input).length ≤ 2 := by + let invalid : List Bool → List Bool := + fun _ => encodedWordOrderingWord .invalid + let less : List Bool → List Bool := + fun _ => encodedWordOrderingWord .less + let greater : List Bool → List Bool := + fun _ => encodedWordOrderingWord .greater + cases hread : readLengthPrefixedWord input with + | none => + simp only [annotatedSquareResolvedOrderingWord, fourFamilyTaggedPredicateMarker, + fourFamilyTaggedGuardedWorkerWord, fixedDelimitedGuardedWorkerWord, + fixedDelimitedWordEqualitySelector, + delimitedPairWordOrdering, readLengthPrefixedWord_append, hread, reduceCtorEq, + decide_false, Bool.false_eq_true, ↓reduceIte, List.append_nil, + List.length_nil, zero_le] + | some parsed => + obtain ⟨tag, suffix⟩ := parsed + have hshape := readLengthPrefixedWord_some_reconstruct + input tag suffix hread + rw [hshape] + change + (fourFamilyTaggedPredicateMarker + invalid less flatAnnotatedSquareHeadOrderingWord greater + (lengthPrefixedWord tag ++ suffix)).length ≤ 2 + by_cases hfirst : tag = [false, false] + · subst tag + rw [sourceFourFamilyTaggedPredicateMarker_interpolation] + simp only [encodedWordOrderingWord, List.length_cons, List.length_nil, zero_add, + Nat.reduceAdd, Std.le_refl, + invalid] + · by_cases hsecond : tag = [false, true] + · subst tag + rw [sourceFourFamilyTaggedPredicateMarker_normalization] + simp only [encodedWordOrderingWord, List.length_cons, List.length_nil, zero_add, + Nat.reduceAdd, Std.le_refl, + less] + · by_cases hthird : tag = [true, false] + · subst tag + rw [sourceFourFamilyTaggedPredicateMarker_diagonal] + simp only [flatAnnotatedSquareHeadOrderingWord_length, Std.le_refl] + · by_cases hfourth : tag = [true, true] + · subst tag + rw [sourceFourFamilyTaggedPredicateMarker_clause] + simp only [encodedWordOrderingWord, List.length_cons, List.length_nil, zero_add, + Nat.reduceAdd, Std.le_refl, + greater] + · simp only [fourFamilyTaggedPredicateMarker, fourFamilyTaggedGuardedWorkerWord, + fixedDelimitedGuardedWorkerWord, fixedDelimitedWordEqualitySelector_valid, + eq_comm, hfirst, decide_false, Bool.false_eq_true, ↓reduceIte, hsecond, + List.append_nil, hthird, hfourth, List.length_nil, zero_le] + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatAnnotatedSquareResolutionState + (major : EncodedWordOrdering) + (archive suffix : List Bool) : List Bool := + lengthPrefixedWord (encodedWordOrderingWord major) ++ + lengthPrefixedWord archive ++ suffix + +private def annotatedSquareResolutionPending + (input : List Bool) : List Bool := + flatUnaryDropFields 4 (flatAnnotatedSourceFieldAt 1 input) + +private noncomputable def flatAnnotatedSquareResolutionPendingComputable : + BitTM + annotatedSquareResolutionPending := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 1) + (flatUnaryDropFieldsComputable 4) + change BitTM + (fun input : List Bool => + flatUnaryDropFields 4 + (flatAnnotatedSourceFieldAt 1 input)) + exact physical + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatAnnotatedSquareResolutionStep + (input : List Bool) : List Bool := + lengthPrefixedWord (annotatedSquareResolvedOrderingWord input) ++ + lengthPrefixedWord (annotatedSquareResolutionPending input) ++ + flatAnnotatedSourceFieldTail 2 input + +private noncomputable def flatAnnotatedSquareResolutionStepComputable : + BitTM + flatAnnotatedSquareResolutionStep := by + have hmajor := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSquareResolvedOrderingComputable + structuralPrefixWriterComputable + have hpending := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSquareResolutionPendingComputable + structuralPrefixWriterComputable + have htail := pointwiseAppendComputable hpending + (annotatedSourceFieldTailComputable 2) + have physical := pointwiseAppendComputable hmajor htail + have hequality : + (fun input : List Bool => + lengthPrefixedWord + (annotatedSquareResolvedOrderingWord input) ++ + (lengthPrefixedWord + (annotatedSquareResolutionPending input) ++ + flatAnnotatedSourceFieldTail 2 input)) = + flatAnnotatedSquareResolutionStep := by + funext input + simp only [flatAnnotatedSquareResolutionStep, List.append_assoc] + rw [← hequality] + exact physical + +@[simp] private theorem flatAnnotatedSquareResolutionStep_state + (major : EncodedWordOrdering) + (first second : ℕ) (archive suffix : List Bool) : + flatAnnotatedSquareResolutionStep + (flatAnnotatedSquareResolutionState major + (flatAnnotatedSourceZipArchivedPair (first, second) ++ archive) + suffix) = + flatAnnotatedSquareResolutionState + (resolveFlatSourceOrder major first second) + archive suffix := by + unfold flatAnnotatedSquareResolutionState + flatAnnotatedSquareResolutionStep + rw [flatAnnotatedSquareResolvedOrderingWord_valid] + simp [annotatedSquareResolutionPending, + flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, + flatAnnotatedSourceZipArchivedPair, + flatDuplicatedUnaryField, + Function.iterate_succ_apply', List.append_assoc] + simpa only [List.append_assoc] using + congrArg lengthPrefixedWord + (flatUnaryDropFields_four_unaryPairs + first first second second archive) + +private theorem flatAnnotatedSquareResolutionStep_iterate_pairs + (major : EncodedWordOrdering) + (pairs : List (ℕ × ℕ)) + (archive suffix : List Bool) : + ((flatAnnotatedSquareResolutionStep^[pairs.length]) + (flatAnnotatedSquareResolutionState major + (pairs.flatMap flatAnnotatedSourceZipArchivedPair ++ archive) + suffix)) = + flatAnnotatedSquareResolutionState + (pairs.foldl + (fun current pair => + resolveFlatSourceOrder current pair.1 pair.2) + major) + archive suffix := by + induction pairs generalizing major with + | nil => simp only [List.length_nil, List.flatMap_nil, List.nil_append, Function.iterate_zero, + id_eq, List.foldl_nil] + | cons pair remaining ih => + rw [List.length_cons, Function.iterate_succ_apply] + simp only [List.flatMap_cons, List.append_assoc] + rw [flatAnnotatedSquareResolutionStep_state] + simpa only [List.foldl_cons] using ih (resolveFlatSourceOrder major pair.1 pair.2) + +private theorem flatAnnotatedSquareResolutionStep_outer + (major archive suffix : List Bool) : + flatAnnotatedSquareResolutionStep + (lengthPrefixedWord major ++ + lengthPrefixedWord archive ++ suffix) = + lengthPrefixedWord + (annotatedSquareResolvedOrderingWord + (lengthPrefixedWord major ++ + lengthPrefixedWord archive ++ suffix)) ++ + lengthPrefixedWord + (flatUnaryDropFields 4 archive) ++ suffix := by + simp [flatAnnotatedSquareResolutionStep, + annotatedSquareResolutionPending, + flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', List.append_assoc] + +private theorem flatAnnotatedSquareResolutionStep_outer_length_le + (major archive suffix : List Bool) : + (flatAnnotatedSquareResolutionStep + (lengthPrefixedWord major ++ + lengthPrefixedWord archive ++ suffix)).length ≤ + (lengthPrefixedWord major ++ + lengthPrefixedWord archive ++ suffix).length + 4 := by + rw [flatAnnotatedSquareResolutionStep_outer] + have houtcome := flatAnnotatedSquareResolvedOrderingWord_length_le + (lengthPrefixedWord major ++ + lengthPrefixedWord archive ++ suffix) + have hpending := flatUnaryDropFields_length_le 4 archive + simp only [List.length_append, lengthPrefixedWord_length] at * + omega + +private theorem flatAnnotatedSquareResolutionStep_length_le + (input : List Bool) : + (flatAnnotatedSquareResolutionStep input).length ≤ + input.length + 6 := by + have hemptyContents : firstFieldContents [] = [] := by rfl + have hemptySuffix : firstFieldSuffix [] = [] := by rfl + have hemptyDrop : flatUnaryDropFields 4 [] = [] := by rfl + cases hfirst : readLengthPrefixedWord input with + | none => + have hcontents : firstFieldContents input = [] := by + simp [firstFieldContents, payloadDecodeOutput, hfirst] + have hsuffix : firstFieldSuffix input = [] := by + simp [firstFieldSuffix, hfirst] + have houtcome := + flatAnnotatedSquareResolvedOrderingWord_length_le input + simp [flatAnnotatedSquareResolutionStep, + annotatedSquareResolutionPending, + flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, + hcontents, hsuffix, hemptyContents, hemptySuffix, + hemptyDrop, Function.iterate_succ_apply', + lengthPrefixedWord_length, List.length_append] at * + omega + | some firstParsed => + obtain ⟨major, firstSuffix⟩ := firstParsed + have hfirstShape := readLengthPrefixedWord_some_reconstruct + input major firstSuffix hfirst + cases hsecond : readLengthPrefixedWord firstSuffix with + | none => + have hcontents : firstFieldContents firstSuffix = [] := by + simp [firstFieldContents, payloadDecodeOutput, hsecond] + have hsuffix : firstFieldSuffix firstSuffix = [] := by + simp [firstFieldSuffix, hsecond] + have houtcome := + flatAnnotatedSquareResolvedOrderingWord_length_le input + rw [hfirstShape] at houtcome ⊢ + simp [flatAnnotatedSquareResolutionStep, + annotatedSquareResolutionPending, + flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, + hcontents, hsuffix, hemptyContents, hemptySuffix, + hemptyDrop, Function.iterate_succ_apply', + lengthPrefixedWord_length, List.length_append] at * + omega + | some secondParsed => + obtain ⟨archive, suffix⟩ := secondParsed + have hsecondShape := readLengthPrefixedWord_some_reconstruct + firstSuffix archive suffix hsecond + rw [hfirstShape, hsecondShape] + have hvalid := flatAnnotatedSquareResolutionStep_outer_length_le + major archive suffix + simp only [List.append_assoc] at hvalid ⊢ + omega + +private theorem flatAnnotatedSquareResolutionStep_iterate_length_le + (input : List Bool) (stage : ℕ) : + (((flatAnnotatedSquareResolutionStep^[stage]) input).length) ≤ + input.length + 6 * stage := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have hstep := flatAnnotatedSquareResolutionStep_length_le + ((flatAnnotatedSquareResolutionStep^[stage]) input) + omega + +private theorem flatAnnotatedSquareResolution_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + flatAnnotatedSquareResolutionStep + (7 * Polynomial.X + 6) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := parsedUnaryFold_seed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate := flatAnnotatedSquareResolutionStep_iterate_length_le + seed stage + simp only [Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, + ge_iff_le] + omega + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def flatAnnotatedSquareResolutionFoldComputable : + BitTM + (boundedRecordFoldOutput flatAnnotatedSquareResolutionStep) := + boundedDependentRecordFoldComputable + flatAnnotatedSquareResolutionStepComputable + (7 * Polynomial.X + 6) + flatAnnotatedSquareResolution_polynomiallyBoundedFoldStates + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem boundedRecordFoldOutput_flatAnnotatedSquareResolution + (major : EncodedWordOrdering) + (pairs : List (ℕ × ℕ)) + (archive suffix : List Bool) : + boundedRecordFoldOutput flatAnnotatedSquareResolutionStep + (unaryBoundedFoldWord pairs.length + (flatAnnotatedSquareResolutionState major + (pairs.flatMap flatAnnotatedSourceZipArchivedPair ++ archive) + suffix)) = + flatAnnotatedSquareResolutionState + (pairs.foldl + (fun current pair => + resolveFlatSourceOrder current pair.1 pair.2) + major) + archive suffix := by + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word, + flatAnnotatedSquareResolutionStep_iterate_pairs] + +end CNFAnnotatedSourceSquareMajorResolutionTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part07D.lean b/LeanPool/GapCVP/Part07D.lean new file mode 100644 index 000000000..53b20069a --- /dev/null +++ b/LeanPool/GapCVP/Part07D.lean @@ -0,0 +1,1550 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part07C + +/-! # GapCVP proof, part 07, continuation 04 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFAnnotatedSourceSquareMajorResolutionTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.FormulaSemanticCert + +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceTotalStructuralDecoder + +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold + +open GapCVP.CLStructuralPrefixWriter GapCVP.CLStructuralNaturalBinaryWriter + +open GapCVP.CNFEncodedClauseSort GapCVP.CNFNaturalOrderComparator + +open GapCVP.CNFNaturalOrderCertifiedComparator GapCVP.CNFCappedUnaryMinimumTM + +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFCappedFlatSourceListFoldTotalCert + +open GapCVP.CNFFlatSourceOrder GapCVP.CNFFlatPhysicalBinaryAppendTM + +open GapCVP.CNFGuardedFiveFamilyTagDispatchTM GapCVP.CNFAnnotatedSourceClausePairPreparationTM + +open GapCVP.CNFAnnotatedSourceClausePairZipTM GapCVP.CNFTypedRecordWorkerTM + +open GapCVP.SourceFourFamilyTaggedPredicateDispatchTM + +end CNFAnnotatedSourceSquareMajorResolutionTM + +namespace CNFAnnotatedSourceCompleteFiniteSetComparatorTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralPrefixWriter GapCVP.CLStructuralNaturalBinaryWriter +open GapCVP.CNFEncodedClauseSort GapCVP.CNFNaturalOrderComparator +open GapCVP.CNFNaturalOrderCertifiedComparator GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM GapCVP.CNFAnnotatedSourceClausePairZipTM +open GapCVP.CNFAnnotatedSourceCountedClausePairZipTM +open GapCVP.CNFAnnotatedSourceCountedResidualTailTM +open GapCVP.CNFAnnotatedSourceSquareMajorResolutionTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.SourceFourFamilyTaggedPredicateDispatchTM + +private def annotatedCompleteSourceZippedWord : List Bool → List Bool := + boundedRecordFoldOutput flatAnnotatedCountedSourceZipStep ∘ + countedPairZipPreparationWord + +private noncomputable def flatAnnotatedCompleteSourceZippedComputable : + BitTM + annotatedCompleteSourceZippedWord := + GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCountedSourcePairZipPreparationComputable + flatAnnotatedCountedSourceZipFoldComputable + +private def annotatedCompleteResidualHeadBinary + (offset : ℕ) (input : List Bool) : List Bool := + Computability.encodeNat + (annotatedCountedResidualHeadUnary offset input).length + +private noncomputable def annotatedCompleteResidualHeadBinaryComputable + (offset : ℕ) : + BitTM + (annotatedCompleteResidualHeadBinary offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualHeadUnaryComputable offset) + structuralNaturalBinaryWriterComputable + change BitTM + (fun input : List Bool => + Computability.encodeNat + (annotatedCountedResidualHeadUnary offset input).length) + exact physical + +private def annotatedCompleteNaturalComparisonInput + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + lengthPrefixedWord (first input) ++ + lengthPrefixedWord (second input) ++ input + +private noncomputable def flatAnnotatedCompleteNaturalComparisonInputComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (annotatedCompleteNaturalComparisonInput first second) := by + have hleft := GapCVP.TMComposition.computableInPolyTime + hfirst structuralPrefixWriterComputable + have hright := GapCVP.TMComposition.computableInPolyTime + hsecond structuralPrefixWriterComputable + have htail := pointwiseAppendComputable hright + (Turing.idComputableInPolyTime bitEncoding) + have physical := pointwiseAppendComputable hleft htail + have hequality : + (fun input : List Bool => + lengthPrefixedWord (first input) ++ + (lengthPrefixedWord (second input) ++ input)) = + annotatedCompleteNaturalComparisonInput first second := by + funext input + simp only [annotatedCompleteNaturalComparisonInput, List.append_assoc] + rw [← hequality] + exact physical + +private def annotatedCompleteNaturalOrderingWord + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldSuffix + (sourcePreservingDelimitedNaturalComparisonWord + (annotatedCompleteNaturalComparisonInput + first second input)) + +private noncomputable def flatAnnotatedCompleteNaturalOrderingComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (annotatedCompleteNaturalOrderingWord first second) := by + have hcomparison := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCompleteNaturalComparisonInputComputable + hfirst hsecond) + sourcePreservingDelimitedNaturalComparisonComputable + have physical := GapCVP.TMComposition.computableInPolyTime + hcomparison firstFieldSuffixComputable + change BitTM + (fun input : List Bool => + firstFieldSuffix + (sourcePreservingDelimitedNaturalComparisonWord + (annotatedCompleteNaturalComparisonInput + first second input))) + exact physical + +private def annotatedCompleteResidualHeadPair + (input : List Bool) : List Bool := + flatAnnotatedSourceZipHeadPair 0 input ++ + flatAnnotatedSourceZipHeadPair 1 input + +private noncomputable def flatAnnotatedCompleteResidualHeadPairComputable : + BitTM + annotatedCompleteResidualHeadPair := + pointwiseAppendComputable + (annotatedSourceZipHeadPairComputable 0) + (annotatedSourceZipHeadPairComputable 1) + +private def annotatedCompleteResidualResolutionInput + (major : List Bool → List Bool) + (input : List Bool) : List Bool := + lengthPrefixedWord (major input) ++ + lengthPrefixedWord (annotatedCompleteResidualHeadPair input) ++ + input + +private noncomputable def flatAnnotatedCompleteResidualResolutionInputComputable + {major : List Bool → List Bool} + (computer : BitTM major) : + BitTM + (annotatedCompleteResidualResolutionInput major) := by + have hmajor := GapCVP.TMComposition.computableInPolyTime + computer structuralPrefixWriterComputable + have hpair := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteResidualHeadPairComputable + structuralPrefixWriterComputable + have hrest := pointwiseAppendComputable hpair + (Turing.idComputableInPolyTime bitEncoding) + have physical := pointwiseAppendComputable hmajor hrest + have hequality : + (fun input : List Bool => + lengthPrefixedWord (major input) ++ + (lengthPrefixedWord + (annotatedCompleteResidualHeadPair input) ++ input)) = + annotatedCompleteResidualResolutionInput major := by + funext input + simp only [annotatedCompleteResidualResolutionInput, List.append_assoc] + rw [← hequality] + exact physical + +private def annotatedCompleteResidualResolvedOrdering + (major : List Bool → List Bool) : List Bool → List Bool := + annotatedSquareResolvedOrderingWord ∘ + annotatedCompleteResidualResolutionInput major + +private noncomputable def flatAnnotatedCompleteResidualResolvedOrderingComputable + {major : List Bool → List Bool} + (computer : BitTM major) : + BitTM + (annotatedCompleteResidualResolvedOrdering major) := + GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCompleteResidualResolutionInputComputable computer) + flatAnnotatedSquareResolvedOrderingComputable + +private def flatAnnotatedCompleteSingletonMajor : List Bool → List Bool := + annotatedCompleteNaturalOrderingWord + (annotatedCompleteResidualHeadBinary 0) + (annotatedCompleteResidualHeadBinary 1) + +private noncomputable def flatAnnotatedCompleteSingletonMajorComputable : + BitTM + flatAnnotatedCompleteSingletonMajor := + flatAnnotatedCompleteNaturalOrderingComputable + (annotatedCompleteResidualHeadBinaryComputable 0) + (annotatedCompleteResidualHeadBinaryComputable 1) + +private def flatAnnotatedCompleteRightTailMajor : List Bool → List Bool := + annotatedCompleteNaturalOrderingWord + (annotatedCompleteResidualHeadBinary 0) + (annotatedCountedResidualCappedBinaryWord 1 0) + +private noncomputable def flatAnnotatedCompleteRightTailMajorComputable : + BitTM + flatAnnotatedCompleteRightTailMajor := + flatAnnotatedCompleteNaturalOrderingComputable + (annotatedCompleteResidualHeadBinaryComputable 0) + (flatAnnotatedCountedResidualCappedBinaryComputable 1 0) + +private def flatAnnotatedCompleteLeftTailMajor : List Bool → List Bool := + annotatedCompleteNaturalOrderingWord + (annotatedCountedResidualCappedBinaryWord 0 1) + (annotatedCompleteResidualHeadBinary 1) + +private noncomputable def flatAnnotatedCompleteLeftTailMajorComputable : + BitTM + flatAnnotatedCompleteLeftTailMajor := + flatAnnotatedCompleteNaturalOrderingComputable + (flatAnnotatedCountedResidualCappedBinaryComputable 0 1) + (annotatedCompleteResidualHeadBinaryComputable 1) + +private def annotatedCompleteResidualTailPresence + (offset : ℕ) (input : List Bool) : List Bool := + fiveFamilyOriginalHeadBitWord + (annotatedCountedResidualTailCount offset input) + +private noncomputable def flatAnnotatedCompleteResidualTailPresenceComputable + (offset : ℕ) : + BitTM + (annotatedCompleteResidualTailPresence offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatAnnotatedCountedResidualTailCountComputable offset) + fiveFamilyOriginalHeadBitComputable + change BitTM + (fun input : List Bool => + fiveFamilyOriginalHeadBitWord + (annotatedCountedResidualTailCount offset input)) + exact physical + +private def annotatedCompleteResidualShapeTag + (input : List Bool) : List Bool := + annotatedCompleteResidualTailPresence 0 input ++ + annotatedCompleteResidualTailPresence 1 input + +private noncomputable def flatAnnotatedCompleteResidualShapeTagComputable : + BitTM + annotatedCompleteResidualShapeTag := + pointwiseAppendComputable + (flatAnnotatedCompleteResidualTailPresenceComputable 0) + (flatAnnotatedCompleteResidualTailPresenceComputable 1) + +private def annotatedCompleteResidualShapeDispatchInput + (input : List Bool) : List Bool := + lengthPrefixedWord + (annotatedCompleteResidualShapeTag input) ++ input + +private noncomputable def flatAnnotatedCompleteResidualShapeDispatchInputComputable : + BitTM + annotatedCompleteResidualShapeDispatchInput := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteResidualShapeTagComputable + structuralPrefixWriterComputable + exact pointwiseAppendComputable hprefix + (Turing.idComputableInPolyTime bitEncoding) + +private def annotatedCompleteResidualBaseOrdering : List Bool → List Bool := + fourFamilyTaggedPredicateMarker + (annotatedCompleteResidualResolvedOrdering + flatAnnotatedCompleteSingletonMajor) + (annotatedCompleteResidualResolvedOrdering + flatAnnotatedCompleteRightTailMajor) + (annotatedCompleteResidualResolvedOrdering + flatAnnotatedCompleteLeftTailMajor) + (fun _ => encodedWordOrderingWord .invalid) ∘ + annotatedCompleteResidualShapeDispatchInput + +private noncomputable def flatAnnotatedCompleteResidualBaseOrderingComputable : + BitTM + annotatedCompleteResidualBaseOrdering := by + have hdispatch := fourFamilyTaggedPredicateMarkerComputable + (flatAnnotatedCompleteResidualResolvedOrderingComputable + flatAnnotatedCompleteSingletonMajorComputable) + (flatAnnotatedCompleteResidualResolvedOrderingComputable + flatAnnotatedCompleteRightTailMajorComputable) + (flatAnnotatedCompleteResidualResolvedOrderingComputable + flatAnnotatedCompleteLeftTailMajorComputable) + (sourceFixedWordComputable (encodedWordOrderingWord .invalid)) + exact GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteResidualShapeDispatchInputComputable + hdispatch + +private def flatAnnotatedCompleteArchiveCount + (input : List Bool) : List Bool := + flatAnnotatedSourceZipCountWord + (flatAnnotatedSourceFieldTail 5 input) + +private noncomputable def flatAnnotatedCompleteArchiveCountComputable : + BitTM + flatAnnotatedCompleteArchiveCount := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldTailComputable 5) + flatAnnotatedSourceZipCountComputable + change BitTM + (fun input : List Bool => + flatAnnotatedSourceZipCountWord + (flatAnnotatedSourceFieldTail 5 input)) + exact physical + +private def annotatedCompleteArchiveResolutionPreparation + (input : List Bool) : List Bool := + flatAnnotatedCompleteArchiveCount input ++ + false :: + (lengthPrefixedWord + (annotatedCompleteResidualBaseOrdering input) ++ + lengthPrefixedWord (flatAnnotatedSourceFieldAt 2 input) ++ input) + +private noncomputable def flatAnnotatedCompleteArchiveResolutionPreparationComputable : + BitTM + annotatedCompleteArchiveResolutionPreparation := by + have hmajor := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteResidualBaseOrderingComputable + structuralPrefixWriterComputable + have harchive := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 2) + structuralPrefixWriterComputable + have hstate := pointwiseAppendComputable hmajor + (pointwiseAppendComputable harchive + (Turing.idComputableInPolyTime bitEncoding)) + have hdelimited := pointwiseAppendComputable + (sourceFixedWordComputable [false]) hstate + have physical := pointwiseAppendComputable + flatAnnotatedCompleteArchiveCountComputable hdelimited + have hequality : + (fun input : List Bool => + flatAnnotatedCompleteArchiveCount input ++ + ([false] ++ + (lengthPrefixedWord + (annotatedCompleteResidualBaseOrdering input) ++ + (lengthPrefixedWord + (flatAnnotatedSourceFieldAt 2 input) ++ input)))) = + annotatedCompleteArchiveResolutionPreparation := by + funext input + simp only [List.cons_append, List.nil_append, annotatedCompleteArchiveResolutionPreparation, + List.append_assoc] + rw [← hequality] + exact physical + +private def annotatedCompleteArchiveResolutionOutput : List Bool → List Bool := + boundedRecordFoldOutput flatAnnotatedSquareResolutionStep ∘ + annotatedCompleteArchiveResolutionPreparation + +private noncomputable def flatAnnotatedCompleteArchiveResolutionComputable : + BitTM + annotatedCompleteArchiveResolutionOutput := + GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteArchiveResolutionPreparationComputable + flatAnnotatedSquareResolutionFoldComputable + +private def flatAnnotatedCompleteArchiveAfterZipWord : List Bool → List Bool := + annotatedCompleteArchiveResolutionOutput ∘ + annotatedCompleteSourceZippedWord + +private noncomputable def flatAnnotatedCompleteArchiveAfterZipComputable : + BitTM + flatAnnotatedCompleteArchiveAfterZipWord := + GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteSourceZippedComputable + flatAnnotatedCompleteArchiveResolutionComputable + +private def annotatedCompleteFiniteSetOrderingWord : List Bool → List Bool := + firstFieldContents ∘ flatAnnotatedCompleteArchiveAfterZipWord + +private noncomputable def flatAnnotatedCompleteFiniteSetOrderingComputable : + BitTM + annotatedCompleteFiniteSetOrderingWord := + GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteArchiveAfterZipComputable + firstFieldContentsComputable + +end CNFAnnotatedSourceCompleteFiniteSetComparatorTM + +namespace CNFAnnotatedSourceCompleteFiniteSetComparatorSourceCert + +open Turing GapCVP.CL GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFEncodedClauseSort +open GapCVP.CNFNaturalOrderComparator GapCVP.CNFFlatSourceOrder +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFlatCappedComparisonControlledSwapTM +open GapCVP.CNFSourcePairPrefixWorkerTM GapCVP.CNFCappedFlatSourceListFoldTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM GapCVP.CNFAnnotatedSourceClausePairZipTM +open GapCVP.CNFAnnotatedSourceCountedClausePairZipTM +open GapCVP.CNFAnnotatedSourceCountedResidualTailTM +open GapCVP.CNFAnnotatedSourceSquareMajorResolutionTM +open GapCVP.CNFAnnotatedSourceCompleteFiniteSetComparatorTM +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.CNFFiveFamilyFlatCandidateGenerationTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM +open GapCVP.SourceFourFamilyTaggedPredicateDispatchTM + +@[simp] private theorem flatAnnotatedCompleteResidualHeadBinary_first + (head : ℕ) (remaining second : List ℕ) + (archive suffix : List Bool) : + annotatedCompleteResidualHeadBinary 0 + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix) = + Computability.encodeNat head := by + simp only [annotatedCompleteResidualHeadBinary, flatAnnotatedCountedResidualHeadUnary_first, + List.length_replicate] + +@[simp] private theorem flatAnnotatedCompleteResidualHeadBinary_second + (first : List ℕ) (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + annotatedCompleteResidualHeadBinary 1 + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) = + Computability.encodeNat head := by + simp only [annotatedCompleteResidualHeadBinary, flatAnnotatedCountedResidualHeadUnary_second, + List.length_replicate] + +private theorem flatAnnotatedCompleteNaturalOrderingWord_valid + (first second : List Bool → List Bool) + (input : List Bool) (firstValue secondValue : ℕ) + (hfirst : first input = Computability.encodeNat firstValue) + (hsecond : second input = Computability.encodeNat secondValue) : + annotatedCompleteNaturalOrderingWord first second input = + encodedWordOrderingWord + (flatSourceNaturalOrdering firstValue secondValue) := by + simp only [annotatedCompleteNaturalOrderingWord, + annotatedCompleteNaturalComparisonInput, + sourcePreservingDelimitedNaturalComparisonWord, + firstFieldSuffix_valid, hfirst, hsecond] + rw [delimitedNaturalPairOrdering_encodeNat] + rfl + +@[simp] private theorem flatAnnotatedCompleteResidualHeadPair_valid + (firstHead secondHead : ℕ) + (firstRemaining secondRemaining : List ℕ) + (archive suffix : List Bool) : + annotatedCompleteResidualHeadPair + (flatAnnotatedCountedSourceZipState + (firstHead :: firstRemaining) + (secondHead :: secondRemaining) archive suffix) = + flatAnnotatedSourceZipArchivedPair (firstHead, secondHead) := by + simp only [annotatedCompleteResidualHeadPair, flatAnnotatedSourceZipHeadPair, + flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, flatAnnotatedCountedSourceZipState, + flatDuplicatedUnarySourceStream, + List.flatMap_cons, flatDuplicatedUnaryField, List.append_assoc, List.length_cons, + Function.iterate_zero, id_eq, + firstFieldContents_valid, sourcePairPrefixOutput_pair, Function.iterate_one, + firstFieldSuffix_valid, + flatAnnotatedSourceZipArchivedPair] + +private theorem flatAnnotatedCompleteResidualResolvedOrdering_valid + (major : List Bool → List Bool) + (outcome : EncodedWordOrdering) + (firstHead secondHead : ℕ) + (firstRemaining secondRemaining : List ℕ) + (archive suffix : List Bool) + (hmajor : + major (flatAnnotatedCountedSourceZipState + (firstHead :: firstRemaining) + (secondHead :: secondRemaining) archive suffix) = + encodedWordOrderingWord outcome) : + annotatedCompleteResidualResolvedOrdering major + (flatAnnotatedCountedSourceZipState + (firstHead :: firstRemaining) + (secondHead :: secondRemaining) archive suffix) = + encodedWordOrderingWord + (resolveFlatSourceOrder outcome firstHead secondHead) := by + unfold annotatedCompleteResidualResolvedOrdering + rw [Function.comp_apply] + unfold annotatedCompleteResidualResolutionInput + rw [hmajor, flatAnnotatedCompleteResidualHeadPair_valid] + simpa only [List.append_assoc, List.append_nil] using + flatAnnotatedSquareResolvedOrderingWord_valid outcome firstHead secondHead [] + (flatAnnotatedCountedSourceZipState (firstHead :: firstRemaining) (secondHead :: + secondRemaining) archive suffix) + +@[simp] private theorem flatAnnotatedCompleteResidualTailPresence_first + (head : ℕ) (remaining second : List ℕ) + (archive suffix : List Bool) : + annotatedCompleteResidualTailPresence 0 + (flatAnnotatedCountedSourceZipState + (head :: remaining) second archive suffix) = + [decide (0 < remaining.length)] := by + cases remaining with + | nil => + simp [annotatedCompleteResidualTailPresence, + annotatedCountedResidualTailCount, + flatAnnotatedCountedSourceZipState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + fiveFamilyOriginalHeadBitWord_eq, + Function.iterate_succ_apply', List.append_assoc] + | cons next tail => + simp [annotatedCompleteResidualTailPresence, + annotatedCountedResidualTailCount, + flatAnnotatedCountedSourceZipState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + fiveFamilyOriginalHeadBitWord_eq, + List.replicate_succ, + Function.iterate_succ_apply', List.append_assoc] + +@[simp] private theorem flatAnnotatedCompleteResidualTailPresence_second + (first : List ℕ) (head : ℕ) (remaining : List ℕ) + (archive suffix : List Bool) : + annotatedCompleteResidualTailPresence 1 + (flatAnnotatedCountedSourceZipState + first (head :: remaining) archive suffix) = + [decide (0 < remaining.length)] := by + cases remaining with + | nil => + simp [annotatedCompleteResidualTailPresence, + annotatedCountedResidualTailCount, + flatAnnotatedCountedSourceZipState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + fiveFamilyOriginalHeadBitWord_eq, + Function.iterate_succ_apply', List.append_assoc] + | cons next tail => + simp [annotatedCompleteResidualTailPresence, + annotatedCountedResidualTailCount, + flatAnnotatedCountedSourceZipState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + fiveFamilyOriginalHeadBitWord_eq, + List.replicate_succ, + Function.iterate_succ_apply', List.append_assoc] + +private theorem flatAnnotatedCompleteResidualBaseOrdering_valid + (firstHead secondHead : ℕ) + (firstRemaining secondRemaining : List ℕ) + (archive suffix : List Bool) + (hshort : firstRemaining = [] ∨ secondRemaining = []) : + annotatedCompleteResidualBaseOrdering + (flatAnnotatedCountedSourceZipState + (firstHead :: firstRemaining) + (secondHead :: secondRemaining) archive suffix) = + encodedWordOrderingWord + (flatSortedSourceListOrdering + (firstHead :: firstRemaining) + (secondHead :: secondRemaining)) := by + cases firstRemaining with + | nil => + cases secondRemaining with + | nil => + have hmajor := flatAnnotatedCompleteNaturalOrderingWord_valid + (annotatedCompleteResidualHeadBinary 0) + (annotatedCompleteResidualHeadBinary 1) + (flatAnnotatedCountedSourceZipState + [firstHead] [secondHead] archive suffix) + firstHead secondHead + (flatAnnotatedCompleteResidualHeadBinary_first + firstHead [] [secondHead] archive suffix) + (flatAnnotatedCompleteResidualHeadBinary_second + [firstHead] secondHead [] archive suffix) + have hresolved := + flatAnnotatedCompleteResidualResolvedOrdering_valid + flatAnnotatedCompleteSingletonMajor + (flatSourceNaturalOrdering firstHead secondHead) + firstHead secondHead [] [] archive suffix hmajor + have htag : + annotatedCompleteResidualShapeTag + (flatAnnotatedCountedSourceZipState + [firstHead] [secondHead] archive suffix) = + [false, false] := by + unfold annotatedCompleteResidualShapeTag + rw [flatAnnotatedCompleteResidualTailPresence_first, + flatAnnotatedCompleteResidualTailPresence_second] + rfl + unfold annotatedCompleteResidualBaseOrdering + rw [Function.comp_apply] + unfold annotatedCompleteResidualShapeDispatchInput + rw [htag, sourceFourFamilyTaggedPredicateMarker_interpolation] + simpa only [flatSortedSourceListOrdering] using hresolved + | cons next remaining => + have hmajor := flatAnnotatedCompleteNaturalOrderingWord_valid + (annotatedCompleteResidualHeadBinary 0) + (annotatedCountedResidualCappedBinaryWord 1 0) + (flatAnnotatedCountedSourceZipState + [firstHead] (secondHead :: next :: remaining) + archive suffix) + firstHead + (cappedFlatSourceListValue + (firstHead + 1) (next :: remaining)) + (flatAnnotatedCompleteResidualHeadBinary_first + firstHead [] (secondHead :: next :: remaining) + archive suffix) + (flatAnnotatedCountedResidualCappedBinaryWord_second + firstHead [] secondHead (next :: remaining) + archive suffix) + have hresolved := + flatAnnotatedCompleteResidualResolvedOrdering_valid + flatAnnotatedCompleteRightTailMajor + (flatSourceNaturalOrdering firstHead + (cappedFlatSourceListValue + (firstHead + 1) (next :: remaining))) + firstHead secondHead [] (next :: remaining) + archive suffix hmajor + have htag : + annotatedCompleteResidualShapeTag + (flatAnnotatedCountedSourceZipState + [firstHead] (secondHead :: next :: remaining) + archive suffix) = + [false, true] := by + unfold annotatedCompleteResidualShapeTag + rw [flatAnnotatedCompleteResidualTailPresence_first, + flatAnnotatedCompleteResidualTailPresence_second] + rfl + unfold annotatedCompleteResidualBaseOrdering + rw [Function.comp_apply] + unfold annotatedCompleteResidualShapeDispatchInput + rw [htag, sourceFourFamilyTaggedPredicateMarker_normalization] + simpa only [flatSortedSourceListOrdering] using hresolved + | cons next remaining => + cases secondRemaining with + | nil => + have hmajor := flatAnnotatedCompleteNaturalOrderingWord_valid + (annotatedCountedResidualCappedBinaryWord 0 1) + (annotatedCompleteResidualHeadBinary 1) + (flatAnnotatedCountedSourceZipState + (firstHead :: next :: remaining) [secondHead] + archive suffix) + (cappedFlatSourceListValue + (secondHead + 1) (next :: remaining)) + secondHead + (flatAnnotatedCountedResidualCappedBinaryWord_first + firstHead (next :: remaining) + secondHead [] archive suffix) + (flatAnnotatedCompleteResidualHeadBinary_second + (firstHead :: next :: remaining) + secondHead [] archive suffix) + have hresolved := + flatAnnotatedCompleteResidualResolvedOrdering_valid + flatAnnotatedCompleteLeftTailMajor + (flatSourceNaturalOrdering + (cappedFlatSourceListValue + (secondHead + 1) (next :: remaining)) + secondHead) + firstHead secondHead (next :: remaining) [] + archive suffix hmajor + have htag : + annotatedCompleteResidualShapeTag + (flatAnnotatedCountedSourceZipState + (firstHead :: next :: remaining) [secondHead] + archive suffix) = + [true, false] := by + unfold annotatedCompleteResidualShapeTag + rw [flatAnnotatedCompleteResidualTailPresence_first, + flatAnnotatedCompleteResidualTailPresence_second] + rfl + unfold annotatedCompleteResidualBaseOrdering + rw [Function.comp_apply] + unfold annotatedCompleteResidualShapeDispatchInput + rw [htag, sourceFourFamilyTaggedPredicateMarker_diagonal] + simpa only [flatSortedSourceListOrdering] using hresolved + | cons other others => + simp only [reduceCtorEq, or_self] at hshort + +private theorem flatSortedSourceListOrdering_matchedPrefix + (pairs : List (ℕ × ℕ)) + (firstHead secondHead : ℕ) + (firstRemaining secondRemaining : List ℕ) : + flatSortedSourceListOrdering + (pairs.map Prod.fst ++ firstHead :: firstRemaining) + (pairs.map Prod.snd ++ secondHead :: secondRemaining) = + pairs.reverse.foldl + (fun major pair => + resolveFlatSourceOrder major pair.1 pair.2) + (flatSortedSourceListOrdering + (firstHead :: firstRemaining) + (secondHead :: secondRemaining)) := by + induction pairs with + | nil => simp only [List.map_nil, List.nil_append, List.reverse_nil, List.foldl_nil] + | cons pair remaining ih => + cases remaining with + | nil => + simp only [List.map_cons, List.map_nil, List.cons_append, List.nil_append, + flatSortedSourceListOrdering, + List.reverse_cons, List.reverse_nil, List.foldl_cons, List.foldl_nil] + | cons next tail => + simp only [List.map_cons, List.cons_append, + List.reverse_cons, List.foldl_append, + List.foldl_cons, List.foldl_nil] + rw [flatSortedSourceListOrdering] + simpa only [List.map_cons, List.cons_append, + List.reverse_cons, List.foldl_append, + List.foldl_cons, List.foldl_nil] using + congrArg + (fun outcome => + resolveFlatSourceOrder outcome pair.1 pair.2) + ih + +private theorem flatAnnotatedCompleteSourceZippedWord_valid + (pairs : List (ℕ × ℕ)) + (firstRemaining secondRemaining : List ℕ) + (firstClause secondClause suffix : List Bool) + (hcount : + min (pairs.map Prod.fst ++ firstRemaining).length + (pairs.map Prod.snd ++ secondRemaining).length - 1 = + pairs.length) : + annotatedCompleteSourceZippedWord + (annotatedSourceAdjacentClauseWord + firstClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.fst ++ firstRemaining)) + (pairs.map Prod.fst ++ firstRemaining).length + secondClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.snd ++ secondRemaining)) + (pairs.map Prod.snd ++ secondRemaining).length + suffix) = + flatAnnotatedCountedSourceZipState + firstRemaining secondRemaining + (pairs.reverse.flatMap flatAnnotatedSourceZipArchivedPair) + (annotatedSourceAdjacentClauseWord + firstClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.fst ++ firstRemaining)) + (pairs.map Prod.fst ++ firstRemaining).length + secondClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.snd ++ secondRemaining)) + (pairs.map Prod.snd ++ secondRemaining).length + suffix) := by + unfold annotatedCompleteSourceZippedWord + rw [Function.comp_apply, + flatAnnotatedCountedSourcePairZipPreparationWord_valid, + hcount] + simpa only [flatAnnotatedCountedSourceZipState, + List.append_nil, List.append_assoc] using + (boundedRecordFoldOutput_flatAnnotatedCountedSourceZipPairs + pairs firstRemaining secondRemaining [] + (annotatedSourceAdjacentClauseWord + firstClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.fst ++ firstRemaining)) + (pairs.map Prod.fst ++ firstRemaining).length + secondClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.snd ++ secondRemaining)) + (pairs.map Prod.snd ++ secondRemaining).length + suffix)) + +@[simp] private theorem flatAnnotatedCompleteZippedArchiveField_valid + (first second : List ℕ) + (archive suffix : List Bool) : + flatAnnotatedSourceFieldAt 2 + (flatAnnotatedCountedSourceZipState + first second archive suffix) = archive := by + simp [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + flatAnnotatedCountedSourceZipState, + Function.iterate_succ_apply', List.append_assoc] + +@[simp] private theorem flatAnnotatedCompleteZippedOriginalSource_valid + (first second : List ℕ) + (archive suffix : List Bool) : + flatAnnotatedSourceFieldTail 5 + (flatAnnotatedCountedSourceZipState + first second archive suffix) = suffix := by + simp [flatAnnotatedSourceFieldTail, + flatAnnotatedCountedSourceZipState, + Function.iterate_succ_apply', List.append_assoc] + +@[simp] private theorem flatAnnotatedCompleteArchiveCount_zipState_valid + (firstRemaining secondRemaining : List ℕ) + (archive : List Bool) + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + flatAnnotatedCompleteArchiveCount + (flatAnnotatedCountedSourceZipState + firstRemaining secondRemaining archive + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix)) = + List.replicate (min firstCount secondCount - 1) true := by + unfold flatAnnotatedCompleteArchiveCount + rw [flatAnnotatedCompleteZippedOriginalSource_valid, + flatAnnotatedSourceZipCountWord_valid] + +private theorem flatAnnotatedCompleteArchiveResolutionOutput_valid + (pairs : List (ℕ × ℕ)) + (firstHead secondHead : ℕ) + (firstRemaining secondRemaining : List ℕ) + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) + (hcount : min firstCount secondCount - 1 = pairs.length) + (hshort : firstRemaining = [] ∨ secondRemaining = []) : + annotatedCompleteArchiveResolutionOutput + (flatAnnotatedCountedSourceZipState + (firstHead :: firstRemaining) + (secondHead :: secondRemaining) + (pairs.reverse.flatMap flatAnnotatedSourceZipArchivedPair) + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix)) = + flatAnnotatedSquareResolutionState + (pairs.reverse.foldl + (fun major pair => + resolveFlatSourceOrder major pair.1 pair.2) + (flatSortedSourceListOrdering + (firstHead :: firstRemaining) + (secondHead :: secondRemaining))) + [] + (flatAnnotatedCountedSourceZipState + (firstHead :: firstRemaining) + (secondHead :: secondRemaining) + (pairs.reverse.flatMap flatAnnotatedSourceZipArchivedPair) + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix)) := by + unfold annotatedCompleteArchiveResolutionOutput + rw [Function.comp_apply] + unfold annotatedCompleteArchiveResolutionPreparation + rw [flatAnnotatedCompleteArchiveCount_zipState_valid, hcount, + flatAnnotatedCompleteResidualBaseOrdering_valid + firstHead secondHead firstRemaining secondRemaining + (pairs.reverse.flatMap flatAnnotatedSourceZipArchivedPair) + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix) hshort, + flatAnnotatedCompleteZippedArchiveField_valid] + simpa only [unaryBoundedFoldWord, + flatAnnotatedSquareResolutionState, + List.length_reverse, List.append_nil, List.append_assoc] using + (boundedRecordFoldOutput_flatAnnotatedSquareResolution + (flatSortedSourceListOrdering + (firstHead :: firstRemaining) + (secondHead :: secondRemaining)) + pairs.reverse [] + (flatAnnotatedCountedSourceZipState + (firstHead :: firstRemaining) + (secondHead :: secondRemaining) + (pairs.reverse.flatMap flatAnnotatedSourceZipArchivedPair) + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix))) + +private theorem flatAnnotatedCompleteFiniteSetOrderingWord_matched_valid + (pairs : List (ℕ × ℕ)) + (firstHead secondHead : ℕ) + (firstRemaining secondRemaining : List ℕ) + (firstClause secondClause suffix : List Bool) + (hcount : + min (pairs.map Prod.fst ++ firstHead :: firstRemaining).length + (pairs.map Prod.snd ++ secondHead :: secondRemaining).length - 1 = + pairs.length) + (hshort : firstRemaining = [] ∨ secondRemaining = []) : + annotatedCompleteFiniteSetOrderingWord + (annotatedSourceAdjacentClauseWord + firstClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.fst ++ firstHead :: firstRemaining)) + (pairs.map Prod.fst ++ firstHead :: firstRemaining).length + secondClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.snd ++ secondHead :: secondRemaining)) + (pairs.map Prod.snd ++ secondHead :: secondRemaining).length + suffix) = + encodedWordOrderingWord + (flatSortedSourceListOrdering + (pairs.map Prod.fst ++ firstHead :: firstRemaining) + (pairs.map Prod.snd ++ secondHead :: secondRemaining)) := by + unfold annotatedCompleteFiniteSetOrderingWord + rw [Function.comp_apply] + unfold flatAnnotatedCompleteArchiveAfterZipWord + rw [Function.comp_apply, + flatAnnotatedCompleteSourceZippedWord_valid + pairs (firstHead :: firstRemaining) + (secondHead :: secondRemaining) + firstClause secondClause suffix hcount, + flatAnnotatedCompleteArchiveResolutionOutput_valid + pairs firstHead secondHead firstRemaining secondRemaining + firstClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.fst ++ firstHead :: firstRemaining)) + (pairs.map Prod.fst ++ firstHead :: firstRemaining).length + secondClause + (flatDuplicatedUnarySourceStream + (pairs.map Prod.snd ++ secondHead :: secondRemaining)) + (pairs.map Prod.snd ++ secondHead :: secondRemaining).length + suffix hcount hshort] + simp only [flatAnnotatedSquareResolutionState, + List.append_assoc, firstFieldContents_valid] + rw [flatSortedSourceListOrdering_matchedPrefix] + +private def annotatedCompleteOriginalCountPresence + (offset : ℕ) (input : List Bool) : List Bool := + fiveFamilyOriginalHeadBitWord (flatAnnotatedSourceFieldAt offset input) + +private noncomputable def flatAnnotatedCompleteOriginalCountPresenceComputable + (offset : ℕ) : + BitTM + (annotatedCompleteOriginalCountPresence offset) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable offset) + fiveFamilyOriginalHeadBitComputable + change BitTM + (fun input : List Bool => + fiveFamilyOriginalHeadBitWord + (flatAnnotatedSourceFieldAt offset input)) + exact physical + +private def annotatedCompleteOriginalShapeTag (input : List Bool) : List Bool := + annotatedCompleteOriginalCountPresence 2 input ++ + annotatedCompleteOriginalCountPresence 5 input + +private noncomputable def flatAnnotatedCompleteOriginalShapeTagComputable : + BitTM + annotatedCompleteOriginalShapeTag := by + exact pointwiseAppendComputable + (flatAnnotatedCompleteOriginalCountPresenceComputable 2) + (flatAnnotatedCompleteOriginalCountPresenceComputable 5) + +private def flatAnnotatedCompleteOriginalShapeDispatchInput + (input : List Bool) : List Bool := + lengthPrefixedWord (annotatedCompleteOriginalShapeTag input) ++ input + +private noncomputable def flatAnnotatedCompleteOriginalShapeDispatchInputComputable : + BitTM + flatAnnotatedCompleteOriginalShapeDispatchInput := by + have htag := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteOriginalShapeTagComputable + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable htag + (Turing.idComputableInPolyTime bitEncoding) + change BitTM + (fun input : List Bool => + lengthPrefixedWord (annotatedCompleteOriginalShapeTag input) ++ + input) + simpa only [Function.comp_def, id_eq] using physical + +/-- GapCVP reduction support. -/ +def annotatedCompleteTotalOrderingWord : List Bool → List Bool := + fourFamilyTaggedPredicateMarker + (fun _ => encodedWordOrderingWord .equal) + (fun _ => encodedWordOrderingWord .less) + (fun _ => encodedWordOrderingWord .greater) + annotatedCompleteFiniteSetOrderingWord ∘ + flatAnnotatedCompleteOriginalShapeDispatchInput + +private noncomputable def flatAnnotatedCompleteTotalOrderingComputable : + BitTM + annotatedCompleteTotalOrderingWord := by + have hdispatch := fourFamilyTaggedPredicateMarkerComputable + (sourceFixedWordComputable (encodedWordOrderingWord .equal)) + (sourceFixedWordComputable (encodedWordOrderingWord .less)) + (sourceFixedWordComputable (encodedWordOrderingWord .greater)) + flatAnnotatedCompleteFiniteSetOrderingComputable + exact GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteOriginalShapeDispatchInputComputable hdispatch + +/-- GapCVP reduction support. -/ +def annotatedCompleteTotalSourceComparison + (input : List Bool) : List Bool := + lengthPrefixedWord input ++ annotatedCompleteTotalOrderingWord input + +/-- GapCVP reduction support. -/ +noncomputable def flatAnnotatedCompleteTotalSourceComparisonComputable : + BitTM + annotatedCompleteTotalSourceComparison := by + exact pointwiseAppendComputable structuralPrefixWriterComputable + flatAnnotatedCompleteTotalOrderingComputable + +@[simp] private theorem flatAnnotatedCompleteOriginalCountPresence_first + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + annotatedCompleteOriginalCountPresence 2 + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix) = + [decide (0 < firstCount)] := by + cases firstCount <;> + simp [annotatedCompleteOriginalCountPresence, + fiveFamilyOriginalHeadBitWord_eq, List.replicate_succ] + +@[simp] private theorem flatAnnotatedCompleteOriginalCountPresence_second + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + annotatedCompleteOriginalCountPresence 5 + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix) = + [decide (0 < secondCount)] := by + cases secondCount <;> + simp [annotatedCompleteOriginalCountPresence, + fiveFamilyOriginalHeadBitWord_eq, List.replicate_succ] + +@[simp] private theorem flatAnnotatedCompleteOriginalShapeTag_valid + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + annotatedCompleteOriginalShapeTag + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix) = + [decide (0 < firstCount), decide (0 < secondCount)] := by + simp only [annotatedCompleteOriginalShapeTag, flatAnnotatedCompleteOriginalCountPresence_first, + flatAnnotatedCompleteOriginalCountPresence_second, List.cons_append, List.nil_append] + +private theorem flatAnnotatedCompleteTotalOrderingWord_shape_valid + (firstClause firstCodes : List Bool) (firstCount : ℕ) + (secondClause secondCodes : List Bool) (secondCount : ℕ) + (suffix : List Bool) : + annotatedCompleteTotalOrderingWord + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix) = + if 0 < firstCount then + if 0 < secondCount then + annotatedCompleteFiniteSetOrderingWord + (annotatedSourceAdjacentClauseWord + firstClause firstCodes firstCount + secondClause secondCodes secondCount suffix) + else encodedWordOrderingWord .greater + else + if 0 < secondCount then encodedWordOrderingWord .less + else encodedWordOrderingWord .equal := by + unfold annotatedCompleteTotalOrderingWord + rw [Function.comp_apply] + unfold flatAnnotatedCompleteOriginalShapeDispatchInput + rw [flatAnnotatedCompleteOriginalShapeTag_valid] + cases firstCount with + | zero => + cases secondCount with + | zero => + change fourFamilyTaggedPredicateMarker _ _ _ _ + (lengthPrefixedWord [false, false] ++ _) = _ + rw [sourceFourFamilyTaggedPredicateMarker_interpolation] + simp only [lt_self_iff_false, ↓reduceIte] + | succ count => + change fourFamilyTaggedPredicateMarker _ _ _ _ + (lengthPrefixedWord [false, true] ++ _) = _ + rw [sourceFourFamilyTaggedPredicateMarker_normalization] + simp only [lt_self_iff_false, ↓reduceIte, lt_add_iff_pos_left, Order.lt_add_one_iff, + zero_le] + | succ count => + cases secondCount with + | zero => + change fourFamilyTaggedPredicateMarker _ _ _ _ + (lengthPrefixedWord [true, false] ++ _) = _ + rw [sourceFourFamilyTaggedPredicateMarker_diagonal] + simp only [lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le, ↓reduceIte, + lt_self_iff_false] + | succ count => + change fourFamilyTaggedPredicateMarker _ _ _ _ + (lengthPrefixedWord [true, true] ++ _) = _ + rw [sourceFourFamilyTaggedPredicateMarker_clause] + simp only [lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le, ↓reduceIte] + +private theorem flatAnnotatedCompleteNonemptyMatchedDecomposition + (first second : List ℕ) + (hfirst : first ≠ []) (hsecond : second ≠ []) : + ∃ (pairs : List (ℕ × ℕ)) + (firstHead secondHead : ℕ) + (firstRemaining secondRemaining : List ℕ), + first = pairs.map Prod.fst ++ firstHead :: firstRemaining ∧ + second = pairs.map Prod.snd ++ secondHead :: secondRemaining ∧ + min first.length second.length - 1 = pairs.length ∧ + (firstRemaining = [] ∨ secondRemaining = []) := by + induction first generalizing second with + | nil => exact False.elim (hfirst rfl) + | cons firstHead firstTail ih => + cases second with + | nil => exact False.elim (hsecond rfl) + | cons secondHead secondTail => + cases firstTail with + | nil => + refine ⟨[], firstHead, secondHead, [], secondTail, + ?_, ?_, ?_, Or.inl rfl⟩ + · simp only [List.map_nil, List.nil_append] + · simp only [List.map_nil, List.nil_append] + · simp only [List.length_cons, List.length_nil, zero_add, le_add_iff_nonneg_left, + zero_le, inf_of_le_left, + tsub_self] + | cons firstNext firstRest => + cases secondTail with + | nil => + refine ⟨[], firstHead, secondHead, + firstNext :: firstRest, [], + ?_, ?_, ?_, Or.inr rfl⟩ + · simp only [List.map_nil, List.nil_append] + · simp only [List.map_nil, List.nil_append] + · simp only [List.length_cons, List.length_nil, zero_add, le_add_iff_nonneg_left, + zero_le, inf_of_le_right, + tsub_self] + | cons secondNext secondRest => + obtain ⟨pairs, nextFirst, nextSecond, + firstRemaining, secondRemaining, + hfirstTail, hsecondTail, hcount, hshort⟩ := + ih (secondNext :: secondRest) + (by simp only [ne_eq, reduceCtorEq, not_false_eq_true]) (by simp only [ne_eq, + reduceCtorEq, not_false_eq_true]) + refine ⟨(firstHead, secondHead) :: pairs, + nextFirst, nextSecond, + firstRemaining, secondRemaining, + ?_, ?_, ?_, hshort⟩ + · simpa only [List.map_cons, List.cons_append] + using congrArg + (fun source : List ℕ => firstHead :: source) + hfirstTail + · simpa only [List.map_cons, List.cons_append] + using congrArg + (fun source : List ℕ => secondHead :: source) + hsecondTail + · simp only [List.length_cons] at hcount ⊢ + omega + +theorem flatAnnotatedCompleteTotalOrderingWord_valid + (first second : List ℕ) + (firstClause secondClause suffix : List Bool) : + annotatedCompleteTotalOrderingWord + (annotatedSourceAdjacentClauseWord + firstClause (flatDuplicatedUnarySourceStream first) first.length + secondClause (flatDuplicatedUnarySourceStream second) second.length + suffix) = + encodedWordOrderingWord + (flatSortedSourceListOrdering first second) := by + rw [flatAnnotatedCompleteTotalOrderingWord_shape_valid] + cases first with + | nil => + cases second with + | nil => simp only [List.length_nil, lt_self_iff_false, ↓reduceIte, + flatSortedSourceListOrdering] + | cons secondHead secondTail => + simp only [List.length_nil, lt_self_iff_false, ↓reduceIte, List.length_cons, + lt_add_iff_pos_left, + Order.lt_add_one_iff, zero_le, flatSortedSourceListOrdering] + | cons firstHead firstTail => + cases second with + | nil => simp only [List.length_cons, lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le, + ↓reduceIte, List.length_nil, + lt_self_iff_false, flatSortedSourceListOrdering] + | cons secondHead secondTail => + simp only [List.length_cons, Nat.zero_lt_succ, + ↓reduceIte] + obtain ⟨pairs, nextFirst, nextSecond, + firstRemaining, secondRemaining, + hfirst, hsecond, hcount, hshort⟩ := + flatAnnotatedCompleteNonemptyMatchedDecomposition + (firstHead :: firstTail) (secondHead :: secondTail) + (by simp only [ne_eq, reduceCtorEq, not_false_eq_true]) (by simp only [ne_eq, + reduceCtorEq, not_false_eq_true]) + have hpaircount : + min (pairs.map Prod.fst ++ + nextFirst :: firstRemaining).length + (pairs.map Prod.snd ++ + nextSecond :: secondRemaining).length - 1 = + pairs.length := by + rw [← hfirst, ← hsecond] + exact hcount + have hmatched := + flatAnnotatedCompleteFiniteSetOrderingWord_matched_valid + pairs nextFirst nextSecond + firstRemaining secondRemaining + firstClause secondClause suffix hpaircount hshort + rw [← hfirst, ← hsecond] at hmatched + exact hmatched + +@[simp] theorem flatAnnotatedCompleteOriginalClausePair_records + {T S : ℕ} (first second : Clause T S) : + flatSourceClauseAnnotatedRecord first ++ + flatSourceClauseAnnotatedRecord second = + annotatedSourceAdjacentClauseWord + (flatSourceClauseDescriptorPayload first) + (flatDuplicatedUnarySourceStream + (flatSourceFinsetCodes first)) + (flatSourceFinsetCodes first).length + (flatSourceClauseDescriptorPayload second) + (flatDuplicatedUnarySourceStream + (flatSourceFinsetCodes second)) + (flatSourceFinsetCodes second).length + [] := by + simp only [flatSourceClauseAnnotatedRecord, flatSourceClauseDuplicatedCodePayload, + flatSourceFinsetCodes, + flatSourceClauseUnaryCountPayload, List.append_assoc, annotatedSourceAdjacentClauseWord, + List.length_map, + ThreeCNFReduction.sortedElements_length, List.append_nil] + +theorem flatAnnotatedCompleteTotalSourceComparison_correct : + CorrectFlatAnnotatedBundledSourceComparison + annotatedCompleteTotalSourceComparison := by + simp only [CorrectFlatAnnotatedBundledSourceComparison, + decide_eq_true_eq] + intro T S first second suffix + simp only [flatComparisonGreaterMarker, + annotatedBundledPairComparisonWord, + flatAnnotatedBundledPairComparisonInput_records, + annotatedCompleteTotalSourceComparison, + firstFieldSuffix_valid] + rw [flatAnnotatedCompleteOriginalClausePair_records, + flatAnnotatedCompleteTotalOrderingWord_valid, + flatSourceFinsetOrdering_eq_godel] + by_cases hless : Encodable.encode first < Encodable.encode second + · have hreverse : + ¬ Encodable.encode second < Encodable.encode first := + Nat.not_lt_of_gt hless + simp only [encodedWordOrderingWord, encodedWordOrderingFirst, flatSourceNaturalOrdering, hless, + ↓reduceIte, + encodedWordOrderingSecond, List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, + List.tail_cons, + Bool.and_true, hreverse, decide_false] + · by_cases hreverse : + Encodable.encode second < Encodable.encode first + · simp only [encodedWordOrderingWord, encodedWordOrderingFirst, flatSourceNaturalOrdering, + hless, ↓reduceIte, + hreverse, encodedWordOrderingSecond, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some, List.tail_cons, + Bool.and_self, decide_true] + · simp only [encodedWordOrderingWord, encodedWordOrderingFirst, flatSourceNaturalOrdering, + hless, ↓reduceIte, + hreverse, encodedWordOrderingSecond, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some, List.tail_cons, + Bool.and_false, decide_false] + +end CNFAnnotatedSourceCompleteFiniteSetComparatorSourceCert + +namespace CNFFiveFamilyForbiddenWholeClauseWorkerTM + +open Computability Turing GapCVP.CL GapCVP.ThreeCNFReduction +open GapCVP.OutputPolynomialCompositionClosure GapCVP.SourceOriginalSourcePreservingTM +open GapCVP.CNFGuardedFiveFamilyTagDispatchTM GapCVP.CNFFiveFamilyFlatSortedLiteralFamilies +open GapCVP.CNFFiveFamilyForbiddenWindowCoordinateTM + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyForbiddenOneBit_exists + (marker : List Bool → List Bool) + (hmarker : ∀ input, (marker input).length = 1) + (input : List Bool) : + ∃ bit : Bool, marker input = [bit] := by + cases hbits : marker input with + | nil => + simpa only [List.ne_cons_self, exists_const, hbits, List.length_nil, zero_ne_one] + using hmarker input + | cons bit remaining => + have hremaining : remaining = [] := by + have hlength := hmarker input + simp only [hbits, List.length_cons, Nat.add_eq_right, List.length_eq_zero_iff] at hlength + exact hlength + exact ⟨bit, by simp only [hremaining]⟩ + +private def fiveFamilyForbiddenOneBitSelectionWord + (marker : List Bool → List Bool) + (input : List Bool) : List Bool := + (marker input).headD false :: input + +private noncomputable def fiveFamilyForbiddenOneBitSelectionComputable + {marker : List Bool → List Bool} + (computer : BitTM marker) + (hmarker : ∀ input, (marker input).length = 1) : + BitTM + (fiveFamilyForbiddenOneBitSelectionWord marker) := by + have preserved := originalSourcePreservingComputable computer + have physical := GapCVP.TMComposition.computableInPolyTime + preserved keepFirstDropSecondComputable + have hequality : + (fun input : List Bool => + keepFirstDropSecondWord + (originalSourcePreservingOutput marker input)) = + fiveFamilyForbiddenOneBitSelectionWord marker := by + funext input + obtain ⟨bit, hbit⟩ := + fiveFamilyForbiddenOneBit_exists marker hmarker input + simp only [keepFirstDropSecondWord, originalSourcePreservingOutput, hbit, List.cons_append, + List.nil_append, + List.tail_cons, fiveFamilyForbiddenOneBitSelectionWord, List.headD_eq_head?_getD, + List.head?_cons, Option.getD_some] + rw [← hequality] + simpa only [Function.comp_def] using physical + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveForbiddenOneBitGuardedWord + (marker worker : List Bool → List Bool) + (input : List Bool) : List Bool := + if (marker input).headD false then worker input else [] + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveForbiddenOneBitGuardedComputable + {marker worker : List Bool → List Bool} + (hmarker : BitTM marker) + (hunique : ∀ input, (marker input).length = 1) + (hworker : BitTM worker) : + BitTM + (fiveForbiddenOneBitGuardedWord marker worker) := by + exact sourcePreservingConditionalComputable + (fiveFamilyForbiddenOneBitSelectionComputable hmarker hunique) + hworker [] + +/-- GapCVP reduction support. -/ +def fiveFamilyForbiddenEncodedMinimum + {α : Type} [Encodable α] + (first second : α) : α := + if Encodable.encode first < Encodable.encode second + then first else second + +/-- GapCVP reduction support. -/ +def fiveFamilyForbiddenEncodedMaximum + {α : Type} [Encodable α] + (first second : α) : α := + if Encodable.encode first < Encodable.encode second + then second else first + +/-- GapCVP reduction support. -/ +def fiveForbiddenEncodedSortedAtoms + {α : Type} [Encodable α] + (first second third fourth : α) : α × α × α × α := + let firstLow := fiveFamilyForbiddenEncodedMinimum first second + let firstHigh := fiveFamilyForbiddenEncodedMaximum first second + let secondLow := fiveFamilyForbiddenEncodedMinimum third fourth + let secondHigh := fiveFamilyForbiddenEncodedMaximum third fourth + let outerLow := + fiveFamilyForbiddenEncodedMinimum firstLow secondLow + let middleLeft := + fiveFamilyForbiddenEncodedMaximum firstLow secondLow + let middleRight := + fiveFamilyForbiddenEncodedMinimum firstHigh secondHigh + let outerHigh := + fiveFamilyForbiddenEncodedMaximum firstHigh secondHigh + (outerLow, + fiveFamilyForbiddenEncodedMinimum middleLeft middleRight, + fiveFamilyForbiddenEncodedMaximum middleLeft middleRight, + outerHigh) + +/-- GapCVP reduction support. -/ +def fiveForbiddenEncodedSortedAtomList + {α : Type} [Encodable α] + (first second third fourth : α) : List α := + let sorted := fiveForbiddenEncodedSortedAtoms + first second third fourth + [sorted.1, sorted.2.1, sorted.2.2.1, sorted.2.2.2] + +private theorem fiveFamilyForbiddenEncodedSortedAtomList_mem + {α : Type} [Encodable α] + (first second third fourth atom : α) : + atom ∈ fiveForbiddenEncodedSortedAtomList + first second third fourth ↔ + atom = first ∨ atom = second ∨ + atom = third ∨ atom = fourth := by + simp only [fiveForbiddenEncodedSortedAtomList, + fiveForbiddenEncodedSortedAtoms, + fiveFamilyForbiddenEncodedMinimum, + fiveFamilyForbiddenEncodedMaximum] + split_ifs <;> simp_all <;> aesop + +theorem fiveFamilyForbiddenEncodedSortedAtomList_pairwise + {α : Type} [Encodable α] + (first second third fourth : α) : + (fiveForbiddenEncodedSortedAtomList + first second third fourth).Pairwise + (fun left right => + Encodable.encode left ≤ Encodable.encode right) := by + simp only [fiveForbiddenEncodedSortedAtomList, + fiveForbiddenEncodedSortedAtoms, + fiveFamilyForbiddenEncodedMinimum, + fiveFamilyForbiddenEncodedMaximum] + split_ifs <;> + simp_all [List.pairwise_cons] <;> + omega + +/-- GapCVP reduction support. -/ +def fiveForbiddenWindowSortedUniqueLiteralList + {T S : ℕ} + (window : Window T) (symbols : WindowSymbols S) : + List (SignedLiteral T S) := + (fiveForbiddenEncodedSortedAtomList + (fiveForbiddenWindowSourceVariable window symbols .left) + (fiveForbiddenWindowSourceVariable window symbols .center) + (fiveForbiddenWindowSourceVariable window symbols .right) + (fiveForbiddenWindowSourceVariable window symbols .next)).dedup.map + negative + +private theorem fiveFamilyForbiddenWindowSortedUniqueLiteralList_mem + {T S : ℕ} + (window : Window T) (symbols : WindowSymbols S) + (literal : SignedLiteral T S) : + literal ∈ + fiveForbiddenWindowSortedUniqueLiteralList window symbols ↔ + literal ∈ transitionClause window symbols := by + simp only [fiveForbiddenWindowSortedUniqueLiteralList, + List.mem_map, List.mem_dedup, + fiveFamilyForbiddenEncodedSortedAtomList_mem, + transitionClause, Finset.mem_insert, + Finset.mem_singleton] + constructor + · rintro ⟨atom, hatom, rfl⟩ + rcases hatom with h | h | h | h + · left + simpa only [fiveForbiddenWindowSourceVariable] using congrArg negative h + · right + left + simpa only [fiveForbiddenWindowSourceVariable] using congrArg negative h + · right + right + left + simpa only [fiveForbiddenWindowSourceVariable] using congrArg negative h + · right + right + right + simpa only [fiveForbiddenWindowSourceVariable] using congrArg negative h + · intro hmember + rcases hmember with h | h | h | h + · refine ⟨fiveForbiddenWindowSourceVariable + window symbols .left, Or.inl rfl, ?_⟩ + simpa only [fiveForbiddenWindowSourceVariable] using h.symm + · refine ⟨fiveForbiddenWindowSourceVariable + window symbols .center, Or.inr (Or.inl rfl), ?_⟩ + simpa only [fiveForbiddenWindowSourceVariable] using h.symm + · refine ⟨fiveForbiddenWindowSourceVariable + window symbols .right, Or.inr (Or.inr (Or.inl rfl)), ?_⟩ + simpa only [fiveForbiddenWindowSourceVariable] using h.symm + · refine ⟨fiveForbiddenWindowSourceVariable + window symbols .next, Or.inr (Or.inr (Or.inr rfl)), ?_⟩ + simpa only [fiveForbiddenWindowSourceVariable] using h.symm + +private theorem fiveFamilyForbiddenWindowSortedUniqueLiteralList_nodup + {T S : ℕ} + (window : Window T) (symbols : WindowSymbols S) : + (fiveForbiddenWindowSortedUniqueLiteralList + window symbols).Nodup := by + unfold fiveForbiddenWindowSortedUniqueLiteralList + apply (List.nodup_dedup _).map + intro first second hequal + exact congrArg Prod.fst hequal + +private theorem fiveFamilyForbiddenNegativeSourceCode_monotone + {T S : ℕ} (first second : Variable T S) + (horder : Encodable.encode first ≤ Encodable.encode second) : + Encodable.encode (negative first) ≤ + Encodable.encode (negative second) := by + rcases lt_or_eq_of_le horder with hless | hequal + · change Nat.pair (Encodable.encode first) + (Encodable.encode false) ≤ + Nat.pair (Encodable.encode second) + (Encodable.encode false) + apply Nat.le_of_lt + apply Nat.pair_lt_pair_left + exact hless + · have hatoms : first = second := + Encodable.encode_injective hequal + subst second + exact le_rfl + +private theorem fiveFamilyForbiddenWindowSortedUniqueLiteralList_pairwise + {T S : ℕ} + (window : Window T) (symbols : WindowSymbols S) : + (fiveForbiddenWindowSortedUniqueLiteralList + window symbols).Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second) := by + unfold fiveForbiddenWindowSortedUniqueLiteralList + rw [List.pairwise_map] + apply List.Pairwise.imp + (fun {first second} horder => + fiveFamilyForbiddenNegativeSourceCode_monotone + first second horder) + apply List.Pairwise.sublist + (List.dedup_sublist _) + exact fiveFamilyForbiddenEncodedSortedAtomList_pairwise + (fiveForbiddenWindowSourceVariable window symbols .left) + (fiveForbiddenWindowSourceVariable window symbols .center) + (fiveForbiddenWindowSourceVariable window symbols .right) + (fiveForbiddenWindowSourceVariable window symbols .next) + +theorem sortedElements_transitionClause_eq_sortedNetwork + {T S : ℕ} + (window : Window T) (symbols : WindowSymbols S) : + sortedElements (transitionClause window symbols) = + fiveForbiddenWindowSortedUniqueLiteralList + window symbols := by + apply sortedElements_eq_of_nodup_source_pairwise + · exact fiveFamilyForbiddenWindowSortedUniqueLiteralList_mem + window symbols + · exact fiveFamilyForbiddenWindowSortedUniqueLiteralList_nodup + window symbols + · exact fiveFamilyForbiddenWindowSortedUniqueLiteralList_pairwise + window symbols + +end CNFFiveFamilyForbiddenWholeClauseWorkerTM + +namespace CNFFiveFamilyForbiddenWholeClauseSourceCert + +open Computability Turing GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.CNFFiveFamilyForbiddenWindowCoordinateTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseWorkerTM + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveForbiddenRawSourceLessMarker + (first second : List Bool → List Bool) : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput first second + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveForbiddenRawSourceNotLessMarker + (first second : List Bool → List Bool) : + List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + (fiveForbiddenRawSourceLessMarker first second) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveForbiddenRawSourceLessMarker_length + (first second : List Bool → List Bool) + (input : List Bool) : + (fiveForbiddenRawSourceLessMarker + first second input).length = 1 := + fourFamilyComputedUnaryLessBitOutput_length + first second input + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyForbiddenRawSourceNotLessMarker_length + (first second : List Bool → List Bool) + (input : List Bool) : + (fiveForbiddenRawSourceNotLessMarker + first second input).length = 1 := by + obtain ⟨bit, hbit⟩ := fiveFamilyForbiddenOneBit_exists + (fiveForbiddenRawSourceLessMarker first second) + (fiveForbiddenRawSourceLessMarker_length + first second) + input + have hnot := fourFamilyBooleanNotOutput_bit + (fiveForbiddenRawSourceLessMarker first second) + input bit hbit + simpa only [fiveForbiddenRawSourceNotLessMarker, List.length_cons, List.length_nil, zero_add] + using + congrArg List.length hnot + +end CNFFiveFamilyForbiddenWholeClauseSourceCert + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part07E.lean b/LeanPool/GapCVP/Part07E.lean new file mode 100644 index 000000000..b537b0cb9 --- /dev/null +++ b/LeanPool/GapCVP/Part07E.lean @@ -0,0 +1,838 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part07D + +/-! # GapCVP proof, part 07, continuation 05 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiveFamilyForbiddenWholeClauseSourceCert + +open Computability Turing GapCVP.CNFFlatPhysicalBinaryAppendTM + +open GapCVP.SourceFourFamilyBooleanPredicateTM + +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM + +open GapCVP.CNFFiveFamilyForbiddenWindowCoordinateTM + +open GapCVP.CNFFiveFamilyForbiddenWholeClauseWorkerTM + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawSourceMinimumWord + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + if (fiveForbiddenRawSourceLessMarker + first second input).headD false + then first input else second input + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawSourceMaximumWord + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + if (fiveForbiddenRawSourceLessMarker + first second input).headD false + then second input else first input + +private noncomputable def fiveFamilyForbiddenRawSourceLessMarkerComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (fiveForbiddenRawSourceLessMarker first second) := + fourFamilyComputedUnaryLessBitComputable hfirst hsecond + +private noncomputable def fiveForbiddenRawSourceMinimumComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (fiveForbiddenRawSourceMinimumWord first second) := by + let marker := fiveForbiddenRawSourceLessMarker first second + let opposite := fiveForbiddenRawSourceNotLessMarker first second + have hmarker := fiveFamilyForbiddenRawSourceLessMarkerComputable + hfirst hsecond + have hopposite := fourFamilyBooleanNotOutputComputable hmarker + have lower := fiveForbiddenOneBitGuardedComputable + hmarker (fiveForbiddenRawSourceLessMarker_length + first second) hfirst + have upper := fiveForbiddenOneBitGuardedComputable + hopposite (fiveFamilyForbiddenRawSourceNotLessMarker_length + first second) hsecond + have physical := pointwiseAppendComputable lower upper + have hequality : + (fun input : List Bool => + fiveForbiddenOneBitGuardedWord marker first input ++ + fiveForbiddenOneBitGuardedWord + opposite second input) = + fiveForbiddenRawSourceMinimumWord first second := by + funext input + obtain ⟨bit, hbit⟩ := fiveFamilyForbiddenOneBit_exists + (fiveForbiddenRawSourceLessMarker first second) + (fiveForbiddenRawSourceLessMarker_length + first second) input + have hnot := fourFamilyBooleanNotOutput_bit + (fiveForbiddenRawSourceLessMarker first second) + input bit hbit + change opposite input = [!bit] at hnot + cases bit <;> + simp [fiveForbiddenOneBitGuardedWord, + fiveForbiddenRawSourceMinimumWord, + marker, hbit, hnot] + rw [← hequality] + exact physical + +private noncomputable def fiveForbiddenRawSourceMaximumComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (fiveForbiddenRawSourceMaximumWord first second) := by + let marker := fiveForbiddenRawSourceLessMarker first second + let opposite := fiveForbiddenRawSourceNotLessMarker first second + have hmarker := fiveFamilyForbiddenRawSourceLessMarkerComputable + hfirst hsecond + have hopposite := fourFamilyBooleanNotOutputComputable hmarker + have upper := fiveForbiddenOneBitGuardedComputable + hmarker (fiveForbiddenRawSourceLessMarker_length + first second) hsecond + have lower := fiveForbiddenOneBitGuardedComputable + hopposite (fiveFamilyForbiddenRawSourceNotLessMarker_length + first second) hfirst + have physical := pointwiseAppendComputable upper lower + have hequality : + (fun input : List Bool => + fiveForbiddenOneBitGuardedWord marker second input ++ + fiveForbiddenOneBitGuardedWord + opposite first input) = + fiveForbiddenRawSourceMaximumWord first second := by + funext input + obtain ⟨bit, hbit⟩ := fiveFamilyForbiddenOneBit_exists + (fiveForbiddenRawSourceLessMarker first second) + (fiveForbiddenRawSourceLessMarker_length + first second) input + have hnot := fourFamilyBooleanNotOutput_bit + (fiveForbiddenRawSourceLessMarker first second) + input bit hbit + change opposite input = [!bit] at hnot + cases bit <;> + simp [fiveForbiddenOneBitGuardedWord, + fiveForbiddenRawSourceMaximumWord, + marker, hbit, hnot] + rw [← hequality] + exact physical + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowSlotWord + (grid : Polynomial ℕ) + (coordinate : FiveFamilyForbiddenWindowCoordinate) + (symbol : ℕ) : List Bool → List Bool := + fiveForbiddenCoordinateSourceVariableCode + grid coordinate symbol + +private noncomputable def fiveForbiddenRawWindowSlotComputable + (grid : Polynomial ℕ) + (coordinate : FiveFamilyForbiddenWindowCoordinate) + (symbol : ℕ) : + BitTM + (fiveForbiddenRawWindowSlotWord + grid coordinate symbol) := + fiveFamilyForbiddenCoordinateSourceVariableCodeComputable + grid coordinate symbol + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowFirstLowWord + (grid : Polynomial ℕ) (leftSymbol centerSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMinimumWord + (fiveForbiddenRawWindowSlotWord grid .left leftSymbol) + (fiveForbiddenRawWindowSlotWord grid .center centerSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowFirstLowComputable + (grid : Polynomial ℕ) (leftSymbol centerSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowFirstLowWord + grid leftSymbol centerSymbol) := + fiveForbiddenRawSourceMinimumComputable + (fiveForbiddenRawWindowSlotComputable + grid .left leftSymbol) + (fiveForbiddenRawWindowSlotComputable + grid .center centerSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowFirstHighWord + (grid : Polynomial ℕ) (leftSymbol centerSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMaximumWord + (fiveForbiddenRawWindowSlotWord grid .left leftSymbol) + (fiveForbiddenRawWindowSlotWord grid .center centerSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowFirstHighComputable + (grid : Polynomial ℕ) (leftSymbol centerSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowFirstHighWord + grid leftSymbol centerSymbol) := + fiveForbiddenRawSourceMaximumComputable + (fiveForbiddenRawWindowSlotComputable + grid .left leftSymbol) + (fiveForbiddenRawWindowSlotComputable + grid .center centerSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowSecondLowWord + (grid : Polynomial ℕ) (rightSymbol nextSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMinimumWord + (fiveForbiddenRawWindowSlotWord grid .right rightSymbol) + (fiveForbiddenRawWindowSlotWord grid .next nextSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowSecondLowComputable + (grid : Polynomial ℕ) (rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowSecondLowWord + grid rightSymbol nextSymbol) := + fiveForbiddenRawSourceMinimumComputable + (fiveForbiddenRawWindowSlotComputable + grid .right rightSymbol) + (fiveForbiddenRawWindowSlotComputable + grid .next nextSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowSecondHighWord + (grid : Polynomial ℕ) (rightSymbol nextSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMaximumWord + (fiveForbiddenRawWindowSlotWord grid .right rightSymbol) + (fiveForbiddenRawWindowSlotWord grid .next nextSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowSecondHighComputable + (grid : Polynomial ℕ) (rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowSecondHighWord + grid rightSymbol nextSymbol) := + fiveForbiddenRawSourceMaximumComputable + (fiveForbiddenRawWindowSlotComputable + grid .right rightSymbol) + (fiveForbiddenRawWindowSlotComputable + grid .next nextSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowOuterLowWord + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMinimumWord + (fiveForbiddenRawWindowFirstLowWord + grid leftSymbol centerSymbol) + (fiveForbiddenRawWindowSecondLowWord + grid rightSymbol nextSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowOuterLowComputable + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowOuterLowWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) := + fiveForbiddenRawSourceMinimumComputable + (fiveFamilyForbiddenRawWindowFirstLowComputable + grid leftSymbol centerSymbol) + (fiveFamilyForbiddenRawWindowSecondLowComputable + grid rightSymbol nextSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowMiddleLeftWord + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMaximumWord + (fiveForbiddenRawWindowFirstLowWord + grid leftSymbol centerSymbol) + (fiveForbiddenRawWindowSecondLowWord + grid rightSymbol nextSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowMiddleLeftComputable + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowMiddleLeftWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) := + fiveForbiddenRawSourceMaximumComputable + (fiveFamilyForbiddenRawWindowFirstLowComputable + grid leftSymbol centerSymbol) + (fiveFamilyForbiddenRawWindowSecondLowComputable + grid rightSymbol nextSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowMiddleRightWord + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMinimumWord + (fiveForbiddenRawWindowFirstHighWord + grid leftSymbol centerSymbol) + (fiveForbiddenRawWindowSecondHighWord + grid rightSymbol nextSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowMiddleRightComputable + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowMiddleRightWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) := + fiveForbiddenRawSourceMinimumComputable + (fiveFamilyForbiddenRawWindowFirstHighComputable + grid leftSymbol centerSymbol) + (fiveFamilyForbiddenRawWindowSecondHighComputable + grid rightSymbol nextSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowOuterHighWord + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMaximumWord + (fiveForbiddenRawWindowFirstHighWord + grid leftSymbol centerSymbol) + (fiveForbiddenRawWindowSecondHighWord + grid rightSymbol nextSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowOuterHighComputable + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowOuterHighWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) := + fiveForbiddenRawSourceMaximumComputable + (fiveFamilyForbiddenRawWindowFirstHighComputable + grid leftSymbol centerSymbol) + (fiveFamilyForbiddenRawWindowSecondHighComputable + grid rightSymbol nextSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowMiddleLowWord + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMinimumWord + (fiveForbiddenRawWindowMiddleLeftWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveForbiddenRawWindowMiddleRightWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowMiddleLowComputable + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowMiddleLowWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) := + fiveForbiddenRawSourceMinimumComputable + (fiveFamilyForbiddenRawWindowMiddleLeftComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveFamilyForbiddenRawWindowMiddleRightComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol) + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawWindowMiddleHighWord + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + List Bool → List Bool := + fiveForbiddenRawSourceMaximumWord + (fiveForbiddenRawWindowMiddleLeftWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveForbiddenRawWindowMiddleRightWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) + +private noncomputable def fiveFamilyForbiddenRawWindowMiddleHighComputable + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenRawWindowMiddleHighWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) := + fiveForbiddenRawSourceMaximumComputable + (fiveFamilyForbiddenRawWindowMiddleLeftComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveFamilyForbiddenRawWindowMiddleRightComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol) + +end CNFFiveFamilyForbiddenWholeClauseSourceCert + +namespace CNFFiveFamilyForbiddenWholeClauseExactSourceTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceUniformTuringTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatSourceGridDescriptorTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseWorkerTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseSourceCert + +private def fiveForbiddenRawStrictPayloadWord + (previous current payload : List Bool → List Bool) + (input : List Bool) : List Bool := + fiveForbiddenOneBitGuardedWord + (fiveForbiddenRawSourceLessMarker previous current) + payload input + +private noncomputable def fiveFamilyForbiddenRawStrictPayloadComputable + {previous current payload : List Bool → List Bool} + (hprevious : BitTM previous) + (hcurrent : BitTM current) + (hpayload : BitTM payload) : + BitTM + (fiveForbiddenRawStrictPayloadWord + previous current payload) := + fiveForbiddenOneBitGuardedComputable + (fiveFamilyForbiddenRawSourceLessMarkerComputable + hprevious hcurrent) + (fiveForbiddenRawSourceLessMarker_length + previous current) + hpayload + +/-- GapCVP reduction support. -/ +def fiveForbiddenRawDistinctPayloadWord + (first second third fourth payload : List Bool → List Bool) + (input : List Bool) : List Bool := + payload (first input) ++ + fiveForbiddenRawStrictPayloadWord first second + (fun source => payload (second source)) input ++ + fiveForbiddenRawStrictPayloadWord second third + (fun source => payload (third source)) input ++ + fiveForbiddenRawStrictPayloadWord third fourth + (fun source => payload (fourth source)) input + +private noncomputable def fiveFamilyForbiddenRawDistinctPayloadComputable + {first second third fourth payload : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) + (hthird : BitTM third) + (hfourth : BitTM fourth) + (hpayload : BitTM payload) : + BitTM + (fiveForbiddenRawDistinctPayloadWord + first second third fourth payload) := by + have firstPayload := GapCVP.TMComposition.computableInPolyTime + hfirst hpayload + have secondPayload := GapCVP.TMComposition.computableInPolyTime + hsecond hpayload + have thirdPayload := GapCVP.TMComposition.computableInPolyTime + hthird hpayload + have fourthPayload := GapCVP.TMComposition.computableInPolyTime + hfourth hpayload + have secondGuard := fiveFamilyForbiddenRawStrictPayloadComputable + hfirst hsecond secondPayload + have thirdGuard := fiveFamilyForbiddenRawStrictPayloadComputable + hsecond hthird thirdPayload + have fourthGuard := fiveFamilyForbiddenRawStrictPayloadComputable + hthird hfourth fourthPayload + have left := pointwiseAppendComputable + firstPayload secondGuard + have right := pointwiseAppendComputable + thirdGuard fourthGuard + have physical := pointwiseAppendComputable left right + have hequality : + (fun input : List Bool => + (payload (first input) ++ + fiveForbiddenRawStrictPayloadWord first second + (fun source => payload (second source)) input) ++ + (fiveForbiddenRawStrictPayloadWord second third + (fun source => payload (third source)) input ++ + fiveForbiddenRawStrictPayloadWord third fourth + (fun source => payload (fourth source)) input)) = + fiveForbiddenRawDistinctPayloadWord + first second third fourth payload := by + funext input + simp only [List.append_assoc, fiveForbiddenRawDistinctPayloadWord] + rw [← hequality] + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def fiveForbiddenExactWindowDistinctPayloadWord + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) + (payload : List Bool → List Bool) : List Bool → List Bool := + fiveForbiddenRawDistinctPayloadWord + (fiveForbiddenRawWindowOuterLowWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveForbiddenRawWindowMiddleLowWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveForbiddenRawWindowMiddleHighWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveForbiddenRawWindowOuterHighWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) + payload + +private noncomputable def fiveFamilyForbiddenExactWindowDistinctPayloadComputable + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) + {payload : List Bool → List Bool} + (hpayload : BitTM payload) : + BitTM + (fiveForbiddenExactWindowDistinctPayloadWord + grid leftSymbol centerSymbol rightSymbol nextSymbol payload) := + fiveFamilyForbiddenRawDistinctPayloadComputable + (fiveFamilyForbiddenRawWindowOuterLowComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveFamilyForbiddenRawWindowMiddleLowComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveFamilyForbiddenRawWindowMiddleHighComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol) + (fiveFamilyForbiddenRawWindowOuterHighComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol) + hpayload + +/-- GapCVP reduction support. -/ +def fiveForbiddenExactWindowWholeClauseRecordWord + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) + (input : List Bool) : List Bool := + lengthPrefixedWord + (fiveForbiddenExactWindowDistinctPayloadWord + grid leftSymbol centerSymbol rightSymbol nextSymbol + (tableauSourceSignedLiteralDescriptorWord false) input) ++ + lengthPrefixedWord + (fiveForbiddenExactWindowDistinctPayloadWord + grid leftSymbol centerSymbol rightSymbol nextSymbol + (duplicatedUnarySignedLiteralCodeWord false) input) ++ + lengthPrefixedWord + (fiveForbiddenExactWindowDistinctPayloadWord + grid leftSymbol centerSymbol rightSymbol nextSymbol + (fun _ => [true]) input) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveFamilyForbiddenExactWindowWholeClauseRecordComputable + (grid : Polynomial ℕ) + (leftSymbol centerSymbol rightSymbol nextSymbol : ℕ) : + BitTM + (fiveForbiddenExactWindowWholeClauseRecordWord + grid leftSymbol centerSymbol rightSymbol nextSymbol) := by + have descriptors := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyForbiddenExactWindowDistinctPayloadComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol + (tableauSourceSignedLiteralDescriptorComputable false)) + structuralPrefixWriterComputable + have codes := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyForbiddenExactWindowDistinctPayloadComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol + (duplicatedUnarySignedLiteralCodeComputable false)) + structuralPrefixWriterComputable + have count := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyForbiddenExactWindowDistinctPayloadComputable + grid leftSymbol centerSymbol rightSymbol nextSymbol + (constantWordComputable [true])) + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable + descriptors (pointwiseAppendComputable codes count) + change BitTM + (fun input => + lengthPrefixedWord + (fiveForbiddenExactWindowDistinctPayloadWord + grid leftSymbol centerSymbol rightSymbol nextSymbol + (tableauSourceSignedLiteralDescriptorWord false) input) ++ + lengthPrefixedWord + (fiveForbiddenExactWindowDistinctPayloadWord + grid leftSymbol centerSymbol rightSymbol nextSymbol + (duplicatedUnarySignedLiteralCodeWord false) input) ++ + lengthPrefixedWord + (fiveForbiddenExactWindowDistinctPayloadWord + grid leftSymbol centerSymbol rightSymbol nextSymbol + (fun _ => [true]) input)) + simpa only [List.append_assoc, Function.comp_apply] using physical + +theorem fiveForbiddenRawSourceMinimumWord_valid + {α : Type} [Encodable α] + (first second : List Bool → List Bool) + (input : List Bool) (firstAtom secondAtom : α) + (hfirst : first input = + List.replicate (Encodable.encode firstAtom) true) + (hsecond : second input = + List.replicate (Encodable.encode secondAtom) true) : + fiveForbiddenRawSourceMinimumWord + first second input = + List.replicate + (Encodable.encode + (fiveFamilyForbiddenEncodedMinimum + firstAtom secondAtom)) true := by + have hmarker := fourFamilyComputedUnaryLessBitOutput_valid + first second input + (Encodable.encode firstAtom) + (Encodable.encode secondAtom) + hfirst hsecond + unfold fiveForbiddenRawSourceMinimumWord + fiveFamilyForbiddenEncodedMinimum + change fiveForbiddenRawSourceLessMarker + first second input = + [decide (Encodable.encode firstAtom < + Encodable.encode secondAtom)] at hmarker + rw [hmarker] + by_cases horder : + Encodable.encode firstAtom < Encodable.encode secondAtom <;> + simp [horder, hfirst, hsecond] + +theorem fiveForbiddenRawSourceMaximumWord_valid + {α : Type} [Encodable α] + (first second : List Bool → List Bool) + (input : List Bool) (firstAtom secondAtom : α) + (hfirst : first input = + List.replicate (Encodable.encode firstAtom) true) + (hsecond : second input = + List.replicate (Encodable.encode secondAtom) true) : + fiveForbiddenRawSourceMaximumWord + first second input = + List.replicate + (Encodable.encode + (fiveFamilyForbiddenEncodedMaximum + firstAtom secondAtom)) true := by + have hmarker := fourFamilyComputedUnaryLessBitOutput_valid + first second input + (Encodable.encode firstAtom) + (Encodable.encode secondAtom) + hfirst hsecond + unfold fiveForbiddenRawSourceMaximumWord + fiveFamilyForbiddenEncodedMaximum + change fiveForbiddenRawSourceLessMarker + first second input = + [decide (Encodable.encode firstAtom < + Encodable.encode secondAtom)] at hmarker + rw [hmarker] + by_cases horder : + Encodable.encode firstAtom < Encodable.encode secondAtom <;> + simp [horder, hfirst, hsecond] + +private theorem encodeLT_iff_ne_of_le + {α : Type} [Encodable α] {first second : α} + (ordered : Encodable.encode first ≤ Encodable.encode second) : + Encodable.encode first < Encodable.encode second ↔ first ≠ second := by + constructor + · exact fun less equal => by subst second; omega + · intro unequal + have codesUnequal : Encodable.encode first ≠ Encodable.encode second := + fun equal => unequal (Encodable.encode_injective equal) + omega + +theorem fiveFamilyForbiddenRawDistinctPayloadWord_valid + {α : Type} [Encodable α] [DecidableEq α] + (first second third fourth payload : List Bool → List Bool) + (input : List Bool) + (firstAtom secondAtom thirdAtom fourthAtom : α) + (output : α → List Bool) + (hfirst : first input = + List.replicate (Encodable.encode firstAtom) true) + (hsecond : second input = + List.replicate (Encodable.encode secondAtom) true) + (hthird : third input = + List.replicate (Encodable.encode thirdAtom) true) + (hfourth : fourth input = + List.replicate (Encodable.encode fourthAtom) true) + (hpayload : ∀ atom : α, + payload (List.replicate (Encodable.encode atom) true) = + output atom) + (hordered : + [firstAtom, secondAtom, thirdAtom, fourthAtom].Pairwise + (fun left right => + Encodable.encode left ≤ Encodable.encode right)) : + fiveForbiddenRawDistinctPayloadWord + first second third fourth payload input = + [firstAtom, secondAtom, thirdAtom, fourthAtom].dedup.flatMap + output := by + have hfirstSecond := fourFamilyComputedUnaryLessBitOutput_valid + first second input + (Encodable.encode firstAtom) (Encodable.encode secondAtom) + hfirst hsecond + have hsecondThird := fourFamilyComputedUnaryLessBitOutput_valid + second third input + (Encodable.encode secondAtom) (Encodable.encode thirdAtom) + hsecond hthird + have hthirdFourth := fourFamilyComputedUnaryLessBitOutput_valid + third fourth input + (Encodable.encode thirdAtom) (Encodable.encode fourthAtom) + hthird hfourth + change fiveForbiddenRawSourceLessMarker + first second input = + [decide (Encodable.encode firstAtom < + Encodable.encode secondAtom)] at hfirstSecond + change fiveForbiddenRawSourceLessMarker + second third input = + [decide (Encodable.encode secondAtom < + Encodable.encode thirdAtom)] at hsecondThird + change fiveForbiddenRawSourceLessMarker + third fourth input = + [decide (Encodable.encode thirdAtom < + Encodable.encode fourthAtom)] at hthirdFourth + have hfirstSecondLE : + Encodable.encode firstAtom ≤ Encodable.encode secondAtom := + (List.pairwise_cons.mp hordered).1 + secondAtom (by simp only [List.mem_cons, List.not_mem_nil, or_false, true_or]) + have hsecondThirdLE : + Encodable.encode secondAtom ≤ Encodable.encode thirdAtom := + (List.pairwise_cons.mp + (List.pairwise_cons.mp hordered).2).1 + thirdAtom (by simp only [List.mem_cons, List.not_mem_nil, or_false, true_or]) + have hthirdFourthLE : + Encodable.encode thirdAtom ≤ Encodable.encode fourthAtom := + (List.pairwise_cons.mp + (List.pairwise_cons.mp + (List.pairwise_cons.mp hordered).2).2).1 + fourthAtom (by simp only [List.mem_cons, List.not_mem_nil, or_false]) + have hfirstSecondLT : + (Encodable.encode firstAtom < + Encodable.encode secondAtom) ↔ + firstAtom ≠ secondAtom := + encodeLT_iff_ne_of_le hfirstSecondLE + have hsecondThirdLT : + (Encodable.encode secondAtom < + Encodable.encode thirdAtom) ↔ + secondAtom ≠ thirdAtom := + encodeLT_iff_ne_of_le hsecondThirdLE + have hthirdFourthLT : + (Encodable.encode thirdAtom < + Encodable.encode fourthAtom) ↔ + thirdAtom ≠ fourthAtom := + encodeLT_iff_ne_of_le hthirdFourthLE + have hfirstThirdEq : firstAtom = thirdAtom ↔ + firstAtom = secondAtom ∧ secondAtom = thirdAtom := by + constructor + · intro hequal + have hcodes := congrArg Encodable.encode hequal + have hfirst : Encodable.encode firstAtom = + Encodable.encode secondAtom := by omega + have hsecond : Encodable.encode secondAtom = + Encodable.encode thirdAtom := by omega + exact ⟨Encodable.encode_injective hfirst, + Encodable.encode_injective hsecond⟩ + · rintro ⟨rfl, rfl⟩ + rfl + have hsecondFourthEq : secondAtom = fourthAtom ↔ + secondAtom = thirdAtom ∧ thirdAtom = fourthAtom := by + constructor + · intro hequal + have hcodes := congrArg Encodable.encode hequal + have hsecond : Encodable.encode secondAtom = + Encodable.encode thirdAtom := by omega + have hthird : Encodable.encode thirdAtom = + Encodable.encode fourthAtom := by omega + exact ⟨Encodable.encode_injective hsecond, + Encodable.encode_injective hthird⟩ + · rintro ⟨rfl, rfl⟩ + rfl + have hfirstFourthEq : firstAtom = fourthAtom ↔ + firstAtom = secondAtom ∧ + secondAtom = thirdAtom ∧ thirdAtom = fourthAtom := by + constructor + · intro hequal + have hcodes := congrArg Encodable.encode hequal + have hfirst : Encodable.encode firstAtom = + Encodable.encode secondAtom := by omega + have hsecond : Encodable.encode secondAtom = + Encodable.encode thirdAtom := by omega + have hthird : Encodable.encode thirdAtom = + Encodable.encode fourthAtom := by omega + exact ⟨Encodable.encode_injective hfirst, + Encodable.encode_injective hsecond, + Encodable.encode_injective hthird⟩ + · rintro ⟨rfl, rfl, rfl⟩ + rfl + simp only [fiveForbiddenRawDistinctPayloadWord, + fiveForbiddenRawStrictPayloadWord, + fiveForbiddenOneBitGuardedWord, + hfirstSecond, hsecondThird, hthirdFourth, + List.headD_cons, decide_eq_true_eq, + hfirst, hsecond, hthird, hfourth, + hpayload] + simp only [hfirstSecondLT, hsecondThirdLT, + hthirdFourthLT] + by_cases hfirstSecondEqual : firstAtom = secondAtom + · subst secondAtom + by_cases hfirstThirdEqual : firstAtom = thirdAtom + · subst thirdAtom + by_cases hfirstFourthEqual : firstAtom = fourthAtom + · subst fourthAtom + simp only [ne_eq, not_true_eq_false, ↓reduceIte, List.append_nil, List.mem_cons, + List.not_mem_nil, or_false, + or_self, List.dedup_cons_of_mem, not_false_eq_true, List.dedup_cons_of_notMem, + List.dedup_nil, List.flatMap_cons, + List.flatMap_nil] + · simp only [ne_eq, not_true_eq_false, ↓reduceIte, List.append_nil, hfirstFourthEqual, + not_false_eq_true, + List.mem_cons, List.not_mem_nil, or_self, or_false, List.dedup_cons_of_mem, + List.dedup_cons_of_notMem, + List.dedup_nil, List.flatMap_cons, List.flatMap_nil] + · by_cases hthirdFourthEqual : thirdAtom = fourthAtom + · subst fourthAtom + simp only [ne_eq, not_true_eq_false, ↓reduceIte, List.append_nil, hfirstThirdEqual, + not_false_eq_true, + List.mem_cons, List.not_mem_nil, or_self, or_false, List.dedup_cons_of_mem, + List.dedup_cons_of_notMem, + List.dedup_nil, List.flatMap_cons, List.flatMap_nil] + · have hfirstFourthEqual : firstAtom ≠ fourthAtom := by + intro hequal + exact hfirstThirdEqual + ((hfirstFourthEq.mp hequal).2.1) + simp only [ne_eq, not_true_eq_false, ↓reduceIte, List.append_nil, hfirstThirdEqual, + not_false_eq_true, + hthirdFourthEqual, List.append_assoc, List.mem_cons, hfirstFourthEqual, + List.not_mem_nil, or_self, or_false, + List.dedup_cons_of_mem, List.dedup_cons_of_notMem, List.dedup_nil, List.flatMap_cons, + List.flatMap_nil] + · by_cases hsecondThirdEqual : secondAtom = thirdAtom + · subst thirdAtom + by_cases hsecondFourthEqual : secondAtom = fourthAtom + · subst fourthAtom + simp only [ne_eq, hfirstSecondEqual, not_false_eq_true, ↓reduceIte, not_true_eq_false, + List.append_nil, + List.mem_cons, List.not_mem_nil, or_self, List.dedup_cons_of_notMem, or_false, + List.dedup_cons_of_mem, + List.dedup_nil, List.flatMap_cons, List.flatMap_nil] + · have hfirstFourthEqual : firstAtom ≠ fourthAtom := by + intro hequal + exact hfirstSecondEqual + (hfirstFourthEq.mp hequal).1 + simp only [ne_eq, hfirstSecondEqual, not_false_eq_true, ↓reduceIte, not_true_eq_false, + List.append_nil, + hsecondFourthEqual, List.append_assoc, List.mem_cons, hfirstFourthEqual, + List.not_mem_nil, or_self, + List.dedup_cons_of_notMem, or_false, List.dedup_cons_of_mem, List.dedup_nil, + List.flatMap_cons, List.flatMap_nil] + · have hfirstThirdEqual : firstAtom ≠ thirdAtom := by + intro hequal + exact hfirstSecondEqual + (hfirstThirdEq.mp hequal).1 + by_cases hthirdFourthEqual : thirdAtom = fourthAtom + · subst fourthAtom + simp only [ne_eq, hfirstSecondEqual, not_false_eq_true, ↓reduceIte, hsecondThirdEqual, + List.append_assoc, + not_true_eq_false, List.append_nil, List.mem_cons, hfirstThirdEqual, List.not_mem_nil, + or_self, + List.dedup_cons_of_notMem, or_false, List.dedup_cons_of_mem, List.dedup_nil, + List.flatMap_cons, List.flatMap_nil] + · have hsecondFourthEqual : secondAtom ≠ fourthAtom := by + intro hequal + exact hsecondThirdEqual + (hsecondFourthEq.mp hequal).1 + have hfirstFourthEqual : firstAtom ≠ fourthAtom := by + intro hequal + exact hfirstSecondEqual + (hfirstFourthEq.mp hequal).1 + simp only [ne_eq, hfirstSecondEqual, not_false_eq_true, ↓reduceIte, hsecondThirdEqual, + List.append_assoc, + hthirdFourthEqual, List.mem_cons, hfirstThirdEqual, hfirstFourthEqual, + List.not_mem_nil, or_self, + List.dedup_cons_of_notMem, hsecondFourthEqual, List.dedup_nil, List.flatMap_cons, + List.flatMap_nil, List.append_nil] + +end CNFFiveFamilyForbiddenWholeClauseExactSourceTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part07F.lean b/LeanPool/GapCVP/Part07F.lean new file mode 100644 index 000000000..e5cf66021 --- /dev/null +++ b/LeanPool/GapCVP/Part07F.lean @@ -0,0 +1,344 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part07E + +/-! # GapCVP proof, part 07, continuation 06 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiveFamilyForbiddenWholeClauseExactSourceTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceUniformTuringTM + +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatSourceGridDescriptorTM + +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM + +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM + +open GapCVP.CNFFiveFamilyForbiddenWholeClauseWorkerTM + +open GapCVP.CNFFiveFamilyForbiddenWholeClauseSourceCert + +end CNFFiveFamilyForbiddenWholeClauseExactSourceTM + +namespace CNFFiveFamilyIndependentAnchoredFamilyStreamTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert +open GapCVP.SourceUniformTuringTM GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceCanonicalUnaryGridIndexTM +open GapCVP.SourceAnchoredGridRecordFoldTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFBoundedRecordFoldTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFFiveFamilyFlatIndexedCatalogueTM + +/-- GapCVP reduction support. -/ +def fiveIndependentSourceCountWord + (count : Polynomial ℕ) (original : List Bool) : List Bool := + List.replicate (count.eval original.length) true + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyIndependentSourceCountComputable + (count : Polynomial ℕ) : + BitTM + (fiveIndependentSourceCountWord count) := + polynomialValueUnaryComputable count + +private def fiveIndependentSourceRankDescriptorWord + (count : Polynomial ℕ) (original : List Bool) : List Bool := + sourceCanonicalUnaryGridIndexOutput + (fiveIndependentSourceCountWord count original ++ [false]) + +private noncomputable def fiveFamilyIndependentSourceRankDescriptorComputable + (count : Polynomial ℕ) : + BitTM + (fiveIndependentSourceRankDescriptorWord count) := by + have query := pointwiseAppendComputable + (fiveFamilyIndependentSourceCountComputable count) + (constantWordComputable [false]) + have physical := GapCVP.TMComposition.computableInPolyTime + query sourceCanonicalUnaryGridIndexComputable + change BitTM + (fun original => sourceCanonicalUnaryGridIndexOutput + (fiveIndependentSourceCountWord + count original ++ [false])) + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def fiveIndependentSourceRankWords + (count : ℕ) : List (List Bool) := + (List.range count).map fun rank => List.replicate rank true + +@[simp] private theorem fiveFamilyIndependentSourceRankWords_descriptors + (count : ℕ) : + (fiveIndependentSourceRankWords count).flatMap + lengthPrefixedWord = + sourceCanonicalUnaryGridIndexDescriptors count := by + simp only [fiveIndependentSourceRankWords, + sourceCanonicalUnaryGridIndexDescriptors, List.flatMap_map] + rfl + +@[simp] private theorem fiveFamilyIndependentSourceRankDescriptorWord_valid + (count : Polynomial ℕ) (original : List Bool) : + fiveIndependentSourceRankDescriptorWord + count original = + sourceCanonicalUnaryGridIndexDescriptors + (count.eval original.length) := by + simp only [fiveIndependentSourceRankDescriptorWord, fiveIndependentSourceCountWord, + sourceCanonicalUnaryGridIndexOutput_valid, List.append_nil] + +private def fiveIndependentAnchoredFamilyFoldInput + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + fiveIndependentSourceCountWord count original ++ + false :: + (lengthPrefixedWord + (fiveFlatOriginalSourceAnchorWord + bound machine original) ++ + fiveIndependentSourceRankDescriptorWord + count original) + +private noncomputable def fiveFamilyIndependentAnchoredFamilyFoldInputComputable + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentAnchoredFamilyFoldInput + bound count machine) := by + have anchor := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatOriginalSourceAnchorComputable bound machine) + structuralPrefixWriterComputable + have seed := pointwiseAppendComputable + anchor (fiveFamilyIndependentSourceRankDescriptorComputable count) + have delimiter := GapCVP.TMComposition.computableInPolyTime + seed (prependBitComputable false) + have physical := pointwiseAppendComputable + (fiveFamilyIndependentSourceCountComputable count) delimiter + change BitTM + (fun original => + fiveIndependentSourceCountWord count original ++ + false :: + (lengthPrefixedWord + (fiveFlatOriginalSourceAnchorWord + bound machine original) ++ + fiveIndependentSourceRankDescriptorWord + count original)) + simpa only [Function.comp_def] using physical + +private def fiveIndependentAnchoredFamilyCatalogueWord + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (candidate : List Bool → List Bool) + (original : List Bool) : List Bool := + boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput candidate) + (fiveIndependentAnchoredFamilyFoldInput + bound count machine original) + +private noncomputable def fiveFamilyIndependentAnchoredFamilyCatalogueComputable + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (fiveIndependentAnchoredFamilyCatalogueWord + bound count machine candidate) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyIndependentAnchoredFamilyFoldInputComputable + bound count machine) + (sourceAnchoredGridRecordFoldComputable computer) + change BitTM + (fun original => + boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput candidate) + (fiveIndependentAnchoredFamilyFoldInput + bound count machine original)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyIndependentAnchoredFamilyCatalogueWord_valid + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (candidate : List Bool → List Bool) + (original : List Bool) + (hfit : ∀ rank : Fin (count.eval original.length), + (candidate + (lengthPrefixedWord (List.replicate rank.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length) : + fiveIndependentAnchoredFamilyCatalogueWord + bound count machine candidate original = + lengthPrefixedWord + (fiveFlatOriginalSourceAnchorWord + bound machine original) ++ + (fiveIndependentSourceRankWords + (count.eval original.length)).flatMap + (fun rank => lengthPrefixedWord + (candidate (lengthPrefixedWord rank ++ + fiveFlatOriginalSourceAnchorWord + bound machine original))) := by + let size := count.eval original.length + let ranks := fiveIndependentSourceRankWords size + have hranks : ranks.length = size := by + simp only [fiveIndependentSourceRankWords, List.length_map, List.length_range, ranks] + have hfit' : ∀ rank ∈ ranks, + (candidate + (lengthPrefixedWord rank ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length := by + intro rank hrank + obtain ⟨index, hindex, rfl⟩ := List.mem_map.mp hrank + have hlt : index < size := by + simpa only [List.mem_range] using hindex + exact hfit ⟨index, hlt⟩ + have hseed : + fiveIndependentAnchoredFamilyFoldInput + bound count machine original = + unaryBoundedFoldWord ranks.length + (lengthPrefixedWord + (fiveFlatOriginalSourceAnchorWord + bound machine original) ++ + ranks.flatMap lengthPrefixedWord ++ []) := by + simp only [fiveIndependentAnchoredFamilyFoldInput, fiveIndependentSourceCountWord, + fiveFamilyIndependentSourceRankDescriptorWord_valid, unaryBoundedFoldWord, hranks, + fiveFamilyIndependentSourceRankWords_descriptors, List.append_nil, ranks, size] + unfold fiveIndependentAnchoredFamilyCatalogueWord + rw [hseed, + boundedRecordFoldOutput_sourceAnchoredGridRecordRanks + candidate + (fiveFlatOriginalSourceAnchorWord + bound machine original) + ranks [] hfit'] + simp only [List.append_nil, ranks, size] + +/-- GapCVP reduction support. -/ +def fiveIndependentAnchoredFamilyBundledStreamWord + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (candidate : List Bool → List Bool) + (original : List Bool) : List Bool := + firstFieldSuffix + (fiveIndependentAnchoredFamilyCatalogueWord + bound count machine candidate original) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveIndependentAnchoredFamilyBundledStreamComputable + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (fiveIndependentAnchoredFamilyBundledStreamWord + bound count machine candidate) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyIndependentAnchoredFamilyCatalogueComputable + bound count machine computer) + firstFieldSuffixComputable + change BitTM + (fun original => firstFieldSuffix + (fiveIndependentAnchoredFamilyCatalogueWord + bound count machine candidate original)) + simpa only [Function.comp_def] using physical + +theorem fiveFamilyIndependentAnchoredFamilyBundledStreamWord_valid + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (candidate : List Bool → List Bool) + (original : List Bool) + (hfit : ∀ rank : Fin (count.eval original.length), + (candidate + (lengthPrefixedWord (List.replicate rank.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length) : + fiveIndependentAnchoredFamilyBundledStreamWord + bound count machine candidate original = + (fiveIndependentSourceRankWords + (count.eval original.length)).flatMap + (fun rank => lengthPrefixedWord + (candidate (lengthPrefixedWord rank ++ + fiveFlatOriginalSourceAnchorWord + bound machine original))) := by + unfold fiveIndependentAnchoredFamilyBundledStreamWord + rw [fiveFamilyIndependentAnchoredFamilyCatalogueWord_valid + bound count machine candidate original hfit] + exact firstFieldSuffix_valid + (fiveFlatOriginalSourceAnchorWord bound machine original) + ((fiveIndependentSourceRankWords + (count.eval original.length)).flatMap + (fun rank => lengthPrefixedWord + (candidate (lengthPrefixedWord rank ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)))) + +end CNFFiveFamilyIndependentAnchoredFamilyStreamTM + +namespace CNFFiveFamilyIndependentFiveFamilyBundledCatalogueTM + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLCellRowBounds GapCVP.CLPaddedAcceptanceCompiler GapCVP.BinaryEncoding +open GapCVP.SourceUniformTuringTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFiveFamilyFlatCandidateGenerationTM +open GapCVP.CNFFiveFamilyFlatIndexedCatalogueTM GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM +open GapCVP.CNFFiveFamilyFlatRowMajorCatalogueTM +open GapCVP.CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM +open GapCVP.CNFFiveFamilyFlatRowMajorAtMostClauseWorkerTM +open GapCVP.CNFFiveFamilyFlatAcceptanceClauseFoldTM +open GapCVP.CNFFiveFamilyPackedInitialCellDecoderTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseExactSourceTM +open GapCVP.CNFFiveFamilyIndependentAnchoredFamilyStreamTM + +theorem fiveFamilyActualAnnotatedRecord_fits_originalAnchor + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (clause : Clause + (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) : + (flatSourceClauseAnnotatedRecord clause).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length := by + have hbound := flatSourceClauseAnnotatedRecord_length_le clause + have hpolynomial := flatSourceAnnotatedClauseLengthBound_eq_polynomial + bound machine original + change + (flatSourceClauseAnnotatedRecord clause).length ≤ + flatSourceAnnotatedClauseLengthBound + (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm) at hbound + rw [hpolynomial] at hbound + simp only [fiveFlatOriginalSourceAnchorWord, + List.length_append, List.length_replicate] + omega + +end CNFFiveFamilyIndependentFiveFamilyBundledCatalogueTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part07G.lean b/LeanPool/GapCVP/Part07G.lean new file mode 100644 index 000000000..8c8667ab8 --- /dev/null +++ b/LeanPool/GapCVP/Part07G.lean @@ -0,0 +1,398 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part07F + +/-! # GapCVP proof, part 07, continuation 07 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiveFamilyIndependentFiveFamilyBundledCatalogueTM + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLCompleteVerifierSimulation + +open GapCVP.CLCellRowBounds GapCVP.CLPaddedAcceptanceCompiler GapCVP.BinaryEncoding + +open GapCVP.SourceUniformTuringTM GapCVP.CLStructuralPrefixWriter + +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFiveFamilyFlatCandidateGenerationTM + +open GapCVP.CNFFiveFamilyFlatIndexedCatalogueTM GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM + +open GapCVP.CNFFiveFamilyFlatRowMajorCatalogueTM + +open GapCVP.CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM + +open GapCVP.CNFFiveFamilyFlatRowMajorAtMostClauseWorkerTM + +open GapCVP.CNFFiveFamilyFlatAcceptanceClauseFoldTM + +open GapCVP.CNFFiveFamilyPackedInitialCellDecoderTM + +open GapCVP.CNFFiveFamilyForbiddenWholeClauseExactSourceTM + +open GapCVP.CNFFiveFamilyIndependentAnchoredFamilyStreamTM + +/-- GapCVP reduction support. -/ +def fiveIndependentFixedFamilyStreamWord + {α : Type} (indices : List α) + (stream : α → List Bool → List Bool) + (original : List Bool) : List Bool := + indices.foldr (fun index output => stream index original ++ output) [] + +private noncomputable def fiveFamilyIndependentFixedFamilyStreamComputable + {α : Type} (indices : List α) + (stream : α → List Bool → List Bool) + (computers : ∀ index ∈ indices, + BitTM (stream index)) : + BitTM + (fiveIndependentFixedFamilyStreamWord indices stream) := by + induction indices with + | nil => + exact constantWordComputable [] + | cons index remaining ih => + have hfirst := computers index (by simp only [List.mem_cons, true_or]) + have hrest := ih (fun next hnext => + computers next (by simp only [List.mem_cons, hnext, or_true])) + have physical := pointwiseAppendComputable hfirst hrest + change BitTM + (fun original => stream index original ++ + fiveIndependentFixedFamilyStreamWord + remaining stream original) + exact physical + +/-- GapCVP reduction support. -/ +def fiveIndependentAtLeastBundledStreamWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + List Bool → List Bool := + fiveIndependentAnchoredFamilyBundledStreamWord + bound + (fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine + (fiveFlatRowMajorAtLeastClauseRecordWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1)) + +private noncomputable def fiveFamilyIndependentAtLeastBundledStreamComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentAtLeastBundledStreamWord bound machine) := + fiveIndependentAnchoredFamilyBundledStreamComputable + bound + (fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine + (fiveFamilyFlatRowMajorAtLeastClauseRecordComputable + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1)) + +/-- GapCVP reduction support. -/ +def fiveIndependentAtMostFixedPairWorker + (grid : Polynomial ℕ) + (alphabet first second : ℕ) : List Bool → List Bool := + if first < second then + fiveFlatRowMajorAtMostClauseRecordWord grid first second + else + fiveFlatRowMajorAtLeastClauseRecordWord grid alphabet + +private noncomputable def fiveFamilyIndependentAtMostFixedPairWorkerComputable + (grid : Polynomial ℕ) + (alphabet first second : ℕ) : + BitTM + (fiveIndependentAtMostFixedPairWorker + grid alphabet first second) := by + by_cases hpair : first < second + · simpa only [fiveIndependentAtMostFixedPairWorker, hpair, + ↓reduceIte] using + fiveFamilyFlatRowMajorAtMostClauseRecordComputable + grid first second + · simpa only [fiveIndependentAtMostFixedPairWorker, hpair, + ↓reduceIte] using + fiveFamilyFlatRowMajorAtLeastClauseRecordComputable + grid alphabet + +/-- GapCVP reduction support. -/ +def fiveIndependentAtMostFixedPairBundledStreamWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (pair : Symbol (completePhaseSymbolCount machine.tm) × + Symbol (completePhaseSymbolCount machine.tm)) : + List Bool → List Bool := + fiveIndependentAnchoredFamilyBundledStreamWord + bound + (fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine + (fiveIndependentAtMostFixedPairWorker + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + pair.1.val pair.2.val) + +private noncomputable def fiveFamilyIndependentAtMostFixedPairBundledStreamComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (pair : Symbol (completePhaseSymbolCount machine.tm) × + Symbol (completePhaseSymbolCount machine.tm)) : + BitTM + (fiveIndependentAtMostFixedPairBundledStreamWord + bound machine pair) := + fiveIndependentAnchoredFamilyBundledStreamComputable + bound + (fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine + (fiveFamilyIndependentAtMostFixedPairWorkerComputable + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + pair.1.val pair.2.val) + +/-- GapCVP reduction support. -/ +def fiveIndependentAtMostBundledStreamWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + List Bool → List Bool := + fiveIndependentFixedFamilyStreamWord + (fiveFamilyRowMajorSymbolPairs + (completePhaseSymbolCount machine.tm)) + (fiveIndependentAtMostFixedPairBundledStreamWord + bound machine) + +private noncomputable def fiveFamilyIndependentAtMostBundledStreamComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentAtMostBundledStreamWord bound machine) := + fiveFamilyIndependentFixedFamilyStreamComputable + (fiveFamilyRowMajorSymbolPairs + (completePhaseSymbolCount machine.tm)) + (fiveIndependentAtMostFixedPairBundledStreamWord + bound machine) + (fun pair _ => + fiveFamilyIndependentAtMostFixedPairBundledStreamComputable + bound machine pair) + +/-- GapCVP reduction support. -/ +def fiveIndependentInitialBundledStreamWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + List Bool → List Bool := + fiveIndependentAnchoredFamilyBundledStreamWord + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + machine (fiveFlatWholePackedInitialClauseRecordWord + bound machine) + +private noncomputable def fiveFamilyIndependentInitialBundledStreamComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentInitialBundledStreamWord bound machine) := + fiveIndependentAnchoredFamilyBundledStreamComputable + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + machine (fiveFamilyFlatWholePackedInitialClauseRecordComputable + bound machine) + +/-- GapCVP reduction support. -/ +def fiveIndependentAcceptanceBundledStreamWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + lengthPrefixedWord + (fiveFlatWholeAcceptanceClauseRecordWord + bound machine original) + +private noncomputable def fiveFamilyIndependentAcceptanceBundledStreamComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentAcceptanceBundledStreamWord + bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyFlatWholeAcceptanceClauseRecordComputable + bound machine) + structuralPrefixWriterComputable + change BitTM + (fun original => lengthPrefixedWord + (fiveFlatWholeAcceptanceClauseRecordWord + bound machine original)) + simpa only [Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def fiveIndependentForbiddenFixedTupleWorker + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + List Bool → List Bool := + if paddedAcceptancePhaseSymbolAllowed machine symbols = false then + fiveForbiddenExactWindowWholeClauseRecordWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + else + fiveFlatRowMajorAtLeastClauseRecordWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + +private noncomputable def fiveFamilyIndependentForbiddenFixedTupleWorkerComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + BitTM + (fiveIndependentForbiddenFixedTupleWorker + bound machine symbols) := by + by_cases hforbidden : + paddedAcceptancePhaseSymbolAllowed machine symbols = false + · simpa only [fiveIndependentForbiddenFixedTupleWorker, hforbidden, ↓reduceIte] using + fiveFamilyForbiddenExactWindowWholeClauseRecordComputable + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val symbols.2.2.1.val symbols.2.2.2.val + · simpa only [fiveIndependentForbiddenFixedTupleWorker, hforbidden, Bool.true_eq_false, + ↓reduceIte] using + fiveFamilyFlatRowMajorAtLeastClauseRecordComputable (fiveFamilyFlatIndexedGridPolynomial + bound machine) + (completePhaseSymbolCount machine.tm + 1) + +/-- GapCVP reduction support. -/ +def fiveIndependentForbiddenFixedTupleBundledStreamWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + List Bool → List Bool := + fiveIndependentAnchoredFamilyBundledStreamWord + bound + (nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine + (fiveIndependentForbiddenFixedTupleWorker + bound machine symbols) + +private noncomputable def fiveFamilyIndependentForbiddenFixedTupleBundledStreamComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + BitTM + (fiveIndependentForbiddenFixedTupleBundledStreamWord + bound machine symbols) := + fiveIndependentAnchoredFamilyBundledStreamComputable + bound + (nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine + (fiveFamilyIndependentForbiddenFixedTupleWorkerComputable + bound machine symbols) + +/-- GapCVP reduction support. -/ +def fiveIndependentForbiddenBundledStreamWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + List Bool → List Bool := + fiveIndependentFixedFamilyStreamWord + (fiveFamilyRowMajorWindowSymbols + (completePhaseSymbolCount machine.tm)) + (fiveIndependentForbiddenFixedTupleBundledStreamWord + bound machine) + +private noncomputable def fiveFamilyIndependentForbiddenBundledStreamComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentForbiddenBundledStreamWord + bound machine) := + fiveFamilyIndependentFixedFamilyStreamComputable + (fiveFamilyRowMajorWindowSymbols + (completePhaseSymbolCount machine.tm)) + (fiveIndependentForbiddenFixedTupleBundledStreamWord + bound machine) + (fun symbols _ => + fiveFamilyIndependentForbiddenFixedTupleBundledStreamComputable + bound machine symbols) + +/-- GapCVP reduction support. -/ +def fiveIndependentActualBundledCatalogueWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + fiveIndependentAtLeastBundledStreamWord + bound machine original ++ + (fiveIndependentAtMostBundledStreamWord + bound machine original ++ + (fiveIndependentInitialBundledStreamWord + bound machine original ++ + (fiveIndependentAcceptanceBundledStreamWord + bound machine original ++ + fiveIndependentForbiddenBundledStreamWord + bound machine original))) + +/-- GapCVP reduction support. -/ +noncomputable def fiveFamilyIndependentActualBundledCatalogueComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentActualBundledCatalogueWord + bound machine) := by + have hleast := fiveFamilyIndependentAtLeastBundledStreamComputable + bound machine + have hmost := fiveFamilyIndependentAtMostBundledStreamComputable + bound machine + have hinitial := fiveFamilyIndependentInitialBundledStreamComputable + bound machine + have haccept := fiveFamilyIndependentAcceptanceBundledStreamComputable + bound machine + have hforbidden := fiveFamilyIndependentForbiddenBundledStreamComputable + bound machine + have physical := pointwiseAppendComputable + hleast (pointwiseAppendComputable + hmost (pointwiseAppendComputable + hinitial (pointwiseAppendComputable + haccept hforbidden))) + change BitTM + (fun original => + fiveIndependentAtLeastBundledStreamWord + bound machine original ++ + (fiveIndependentAtMostBundledStreamWord + bound machine original ++ + (fiveIndependentInitialBundledStreamWord + bound machine original ++ + (fiveIndependentAcceptanceBundledStreamWord + bound machine original ++ + fiveIndependentForbiddenBundledStreamWord + bound machine original)))) + exact physical + +end CNFFiveFamilyIndependentFiveFamilyBundledCatalogueTM + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part08.lean b/LeanPool/GapCVP/Part08.lean new file mode 100644 index 000000000..5ac04084c --- /dev/null +++ b/LeanPool/GapCVP/Part08.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part08D + +/-! # GapCVP proof, part 08 -/ diff --git a/LeanPool/GapCVP/Part08A.lean b/LeanPool/GapCVP/Part08A.lean new file mode 100644 index 000000000..409724992 --- /dev/null +++ b/LeanPool/GapCVP/Part08A.lean @@ -0,0 +1,1500 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part07 +import Mathlib.FieldTheory.Finite.GaloisField +import Mathlib.FieldTheory.PrimitiveElement +import Mathlib.LinearAlgebra.Lagrange +import Mathlib.LinearAlgebra.Vandermonde + +/-! # GapCVP proof, part 08 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem ofClassicalDecide08 {proposition : Prop} + (proof : @decide proposition (Classical.propDecidable proposition) = true) : + proposition := + @of_decide_eq_true proposition (Classical.propDecidable proposition) proof + +namespace CNFFiveFamilyForbiddenWindowGateSourceValidity + +open Computability Turing GapCVP.CL GapCVP.CLCompleteVerifierSimulation GapCVP.CLCellRowBounds +open GapCVP.BinaryEncoding GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM +open GapCVP.CNFFiveFamilyForbiddenWindowCoordinateTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseWorkerTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseSourceCert +open GapCVP.CNFFiveFamilyForbiddenWholeClauseExactSourceTM + +private def fiveFamilyForbiddenValidWindowQuery + {T : ℕ} (window : Window T) + (original suffix : List Bool) : List Bool := + lengthPrefixedWord + (List.replicate (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix + +private def fiveForbiddenWindowFirstLowAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMinimum + (fiveForbiddenWindowSourceVariable window symbols .left) + (fiveForbiddenWindowSourceVariable window symbols .center) + +private def fiveForbiddenWindowFirstHighAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMaximum + (fiveForbiddenWindowSourceVariable window symbols .left) + (fiveForbiddenWindowSourceVariable window symbols .center) + +private def fiveForbiddenWindowSecondLowAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMinimum + (fiveForbiddenWindowSourceVariable window symbols .right) + (fiveForbiddenWindowSourceVariable window symbols .next) + +private def fiveForbiddenWindowSecondHighAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMaximum + (fiveForbiddenWindowSourceVariable window symbols .right) + (fiveForbiddenWindowSourceVariable window symbols .next) + +private def fiveForbiddenWindowOuterLowAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMinimum + (fiveForbiddenWindowFirstLowAtom window symbols) + (fiveForbiddenWindowSecondLowAtom window symbols) + +private def fiveForbiddenWindowMiddleLeftAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMaximum + (fiveForbiddenWindowFirstLowAtom window symbols) + (fiveForbiddenWindowSecondLowAtom window symbols) + +private def fiveForbiddenWindowMiddleRightAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMinimum + (fiveForbiddenWindowFirstHighAtom window symbols) + (fiveForbiddenWindowSecondHighAtom window symbols) + +private def fiveForbiddenWindowOuterHighAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMaximum + (fiveForbiddenWindowFirstHighAtom window symbols) + (fiveForbiddenWindowSecondHighAtom window symbols) + +private def fiveForbiddenWindowMiddleLowAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMinimum + (fiveForbiddenWindowMiddleLeftAtom window symbols) + (fiveForbiddenWindowMiddleRightAtom window symbols) + +private def fiveForbiddenWindowMiddleHighAtom + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + Variable T S := + fiveFamilyForbiddenEncodedMaximum + (fiveForbiddenWindowMiddleLeftAtom window symbols) + (fiveForbiddenWindowMiddleRightAtom window symbols) + +private theorem fiveFamilyForbiddenWindowNamedSortedAtoms_eq + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + (fiveForbiddenWindowOuterLowAtom window symbols, + fiveForbiddenWindowMiddleLowAtom window symbols, + fiveForbiddenWindowMiddleHighAtom window symbols, + fiveForbiddenWindowOuterHighAtom window symbols) = + fiveForbiddenEncodedSortedAtoms + (fiveForbiddenWindowSourceVariable window symbols .left) + (fiveForbiddenWindowSourceVariable window symbols .center) + (fiveForbiddenWindowSourceVariable window symbols .right) + (fiveForbiddenWindowSourceVariable window symbols .next) := by + rfl + +private theorem fiveFamilyForbiddenWindowNamedSortedAtomList_eq + {T S : ℕ} (window : Window T) (symbols : WindowSymbols S) : + [fiveForbiddenWindowOuterLowAtom window symbols, + fiveForbiddenWindowMiddleLowAtom window symbols, + fiveForbiddenWindowMiddleHighAtom window symbols, + fiveForbiddenWindowOuterHighAtom window symbols] = + fiveForbiddenEncodedSortedAtomList + (fiveForbiddenWindowSourceVariable window symbols .left) + (fiveForbiddenWindowSourceVariable window symbols .center) + (fiveForbiddenWindowSourceVariable window symbols .right) + (fiveForbiddenWindowSourceVariable window symbols .next) := by + have hnetwork := fiveFamilyForbiddenWindowNamedSortedAtoms_eq + window symbols + have hlist := congrArg + (fun atoms : Variable T S × Variable T S × Variable T S × Variable T S => + [atoms.1, atoms.2.1, atoms.2.2.1, atoms.2.2.2]) hnetwork + simpa only [fiveForbiddenEncodedSortedAtomList] using hlist + +section + +variable (bound : Polynomial ℕ) +variable {verifier : List Bool × List Bool → Bool} +variable (machine : VerifierTM verifier) +variable (original suffix : List Bool) +variable (window : Window (rowWidth bound machine original)) +variable (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) + +private theorem fiveForbiddenRawWindowSlotWord_valid + (coordinate : FiveFamilyForbiddenWindowCoordinate) : + fiveForbiddenRawWindowSlotWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + coordinate + (fiveFamilyForbiddenWindowSlotSymbol symbols coordinate).val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowSourceVariable + window symbols coordinate)) true := by + simpa only [fiveForbiddenRawWindowSlotWord, + fiveFamilyForbiddenValidWindowQuery] using + fiveFamilyForbiddenCoordinateSourceVariableCode_valid + bound machine original suffix window symbols coordinate + +private theorem fiveFamilyForbiddenRawWindowFirstLowWord_valid : + fiveForbiddenRawWindowFirstLowWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowFirstLowAtom window symbols)) true := by + unfold fiveForbiddenRawWindowFirstLowWord + fiveForbiddenWindowFirstLowAtom + apply fiveForbiddenRawSourceMinimumWord_valid + · simpa only [fiveFamilyForbiddenWindowSlotSymbol] using + fiveForbiddenRawWindowSlotWord_valid + bound machine original suffix window symbols .left + · simpa only [fiveFamilyForbiddenWindowSlotSymbol] using + fiveForbiddenRawWindowSlotWord_valid + bound machine original suffix window symbols .center + +private theorem fiveFamilyForbiddenRawWindowFirstHighWord_valid : + fiveForbiddenRawWindowFirstHighWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowFirstHighAtom window symbols)) true := by + unfold fiveForbiddenRawWindowFirstHighWord + fiveForbiddenWindowFirstHighAtom + apply fiveForbiddenRawSourceMaximumWord_valid + · simpa only [fiveFamilyForbiddenWindowSlotSymbol] using + fiveForbiddenRawWindowSlotWord_valid + bound machine original suffix window symbols .left + · simpa only [fiveFamilyForbiddenWindowSlotSymbol] using + fiveForbiddenRawWindowSlotWord_valid + bound machine original suffix window symbols .center + +private theorem fiveFamilyForbiddenRawWindowSecondLowWord_valid : + fiveForbiddenRawWindowSecondLowWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.2.2.1.val symbols.2.2.2.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowSecondLowAtom window symbols)) true := by + unfold fiveForbiddenRawWindowSecondLowWord + fiveForbiddenWindowSecondLowAtom + apply fiveForbiddenRawSourceMinimumWord_valid + · simpa only [fiveFamilyForbiddenWindowSlotSymbol] using + fiveForbiddenRawWindowSlotWord_valid + bound machine original suffix window symbols .right + · simpa only [fiveFamilyForbiddenWindowSlotSymbol] using + fiveForbiddenRawWindowSlotWord_valid + bound machine original suffix window symbols .next + +private theorem fiveFamilyForbiddenRawWindowSecondHighWord_valid : + fiveForbiddenRawWindowSecondHighWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.2.2.1.val symbols.2.2.2.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowSecondHighAtom window symbols)) true := by + unfold fiveForbiddenRawWindowSecondHighWord + fiveForbiddenWindowSecondHighAtom + apply fiveForbiddenRawSourceMaximumWord_valid + · simpa only [fiveFamilyForbiddenWindowSlotSymbol] using + fiveForbiddenRawWindowSlotWord_valid + bound machine original suffix window symbols .right + · simpa only [fiveFamilyForbiddenWindowSlotSymbol] using + fiveForbiddenRawWindowSlotWord_valid + bound machine original suffix window symbols .next + +private theorem fiveFamilyForbiddenRawWindowOuterLowWord_valid : + fiveForbiddenRawWindowOuterLowWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowOuterLowAtom window symbols)) true := by + unfold fiveForbiddenRawWindowOuterLowWord + fiveForbiddenWindowOuterLowAtom + apply fiveForbiddenRawSourceMinimumWord_valid + · exact fiveFamilyForbiddenRawWindowFirstLowWord_valid + bound machine original suffix window symbols + · exact fiveFamilyForbiddenRawWindowSecondLowWord_valid + bound machine original suffix window symbols + +private theorem fiveFamilyForbiddenRawWindowMiddleLeftWord_valid : + fiveForbiddenRawWindowMiddleLeftWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowMiddleLeftAtom window symbols)) true := by + unfold fiveForbiddenRawWindowMiddleLeftWord + fiveForbiddenWindowMiddleLeftAtom + apply fiveForbiddenRawSourceMaximumWord_valid + · exact fiveFamilyForbiddenRawWindowFirstLowWord_valid + bound machine original suffix window symbols + · exact fiveFamilyForbiddenRawWindowSecondLowWord_valid + bound machine original suffix window symbols + +private theorem fiveFamilyForbiddenRawWindowMiddleRightWord_valid : + fiveForbiddenRawWindowMiddleRightWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowMiddleRightAtom window symbols)) true := by + unfold fiveForbiddenRawWindowMiddleRightWord + fiveForbiddenWindowMiddleRightAtom + apply fiveForbiddenRawSourceMinimumWord_valid + · exact fiveFamilyForbiddenRawWindowFirstHighWord_valid + bound machine original suffix window symbols + · exact fiveFamilyForbiddenRawWindowSecondHighWord_valid + bound machine original suffix window symbols + +private theorem fiveFamilyForbiddenRawWindowOuterHighWord_valid : + fiveForbiddenRawWindowOuterHighWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowOuterHighAtom window symbols)) true := by + unfold fiveForbiddenRawWindowOuterHighWord + fiveForbiddenWindowOuterHighAtom + apply fiveForbiddenRawSourceMaximumWord_valid + · exact fiveFamilyForbiddenRawWindowFirstHighWord_valid + bound machine original suffix window symbols + · exact fiveFamilyForbiddenRawWindowSecondHighWord_valid + bound machine original suffix window symbols + +private theorem fiveFamilyForbiddenRawWindowMiddleLowWord_valid : + fiveForbiddenRawWindowMiddleLowWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowMiddleLowAtom window symbols)) true := by + unfold fiveForbiddenRawWindowMiddleLowWord + fiveForbiddenWindowMiddleLowAtom + apply fiveForbiddenRawSourceMinimumWord_valid + · exact fiveFamilyForbiddenRawWindowMiddleLeftWord_valid + bound machine original suffix window symbols + · exact fiveFamilyForbiddenRawWindowMiddleRightWord_valid + bound machine original suffix window symbols + +private theorem fiveFamilyForbiddenRawWindowMiddleHighWord_valid : + fiveForbiddenRawWindowMiddleHighWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (fiveFamilyForbiddenValidWindowQuery window original suffix) = + List.replicate + (Encodable.encode + (fiveForbiddenWindowMiddleHighAtom window symbols)) true := by + unfold fiveForbiddenRawWindowMiddleHighWord + fiveForbiddenWindowMiddleHighAtom + apply fiveForbiddenRawSourceMaximumWord_valid + · exact fiveFamilyForbiddenRawWindowMiddleLeftWord_valid + bound machine original suffix window symbols + · exact fiveFamilyForbiddenRawWindowMiddleRightWord_valid + bound machine original suffix window symbols + +end + +end CNFFiveFamilyForbiddenWindowGateSourceValidity + +namespace CNFFiveFamilyForbiddenWholeClauseValidity + +open Computability Turing GapCVP.CL GapCVP.CLCompleteVerifierSimulation GapCVP.CLCellRowBounds +open GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction GapCVP.CNFFlatSourceOrder +open GapCVP.CNFFlatStructuralRecordWorkerTM GapCVP.CNFFlatSourceGridDescriptorTM +open GapCVP.CNFCappedFlatSourceListFoldTM GapCVP.CNFFiveFamilyFlatCandidateGenerationTM +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM +open GapCVP.CNFFiveFamilyForbiddenWindowCoordinateTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseWorkerTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseSourceCert +open GapCVP.CNFFiveFamilyForbiddenWholeClauseExactSourceTM +open GapCVP.CNFFiveFamilyForbiddenWindowGateSourceValidity + +private theorem fiveFamilyForbiddenExactWindowDistinctPayloadWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) + (payload : List Bool → List Bool) + (output : Variable + (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm) → List Bool) + (hpayload : ∀ atom, + payload (List.replicate (Encodable.encode atom) true) = + output atom) : + fiveForbiddenExactWindowDistinctPayloadWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val payload + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + (fiveForbiddenEncodedSortedAtomList + (fiveForbiddenWindowSourceVariable window symbols .left) + (fiveForbiddenWindowSourceVariable window symbols .center) + (fiveForbiddenWindowSourceVariable window symbols .right) + (fiveForbiddenWindowSourceVariable + window symbols .next)).dedup.flatMap output := by + have hordered : + [fiveForbiddenWindowOuterLowAtom window symbols, + fiveForbiddenWindowMiddleLowAtom window symbols, + fiveForbiddenWindowMiddleHighAtom window symbols, + fiveForbiddenWindowOuterHighAtom window symbols].Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second) := by + rw [fiveFamilyForbiddenWindowNamedSortedAtomList_eq] + exact fiveFamilyForbiddenEncodedSortedAtomList_pairwise + (fiveForbiddenWindowSourceVariable window symbols .left) + (fiveForbiddenWindowSourceVariable window symbols .center) + (fiveForbiddenWindowSourceVariable window symbols .right) + (fiveForbiddenWindowSourceVariable window symbols .next) + have hresult := fiveFamilyForbiddenRawDistinctPayloadWord_valid + (fiveForbiddenRawWindowOuterLowWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val) + (fiveForbiddenRawWindowMiddleLowWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val) + (fiveForbiddenRawWindowMiddleHighWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val) + (fiveForbiddenRawWindowOuterHighWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val) + payload (fiveFamilyForbiddenValidWindowQuery window original suffix) + (fiveForbiddenWindowOuterLowAtom window symbols) + (fiveForbiddenWindowMiddleLowAtom window symbols) + (fiveForbiddenWindowMiddleHighAtom window symbols) + (fiveForbiddenWindowOuterHighAtom window symbols) + output + (fiveFamilyForbiddenRawWindowOuterLowWord_valid + bound machine original suffix window symbols) + (fiveFamilyForbiddenRawWindowMiddleLowWord_valid + bound machine original suffix window symbols) + (fiveFamilyForbiddenRawWindowMiddleHighWord_valid + bound machine original suffix window symbols) + (fiveFamilyForbiddenRawWindowOuterHighWord_valid + bound machine original suffix window symbols) + hpayload hordered + rw [fiveFamilyForbiddenWindowNamedSortedAtomList_eq + window symbols] at hresult + simpa only [fiveForbiddenExactWindowDistinctPayloadWord, + fiveFamilyForbiddenValidWindowQuery] using hresult + +private theorem fiveFamilyForbiddenExactWindowDescriptorPayloadWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + fiveForbiddenExactWindowDistinctPayloadWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (tableauSourceSignedLiteralDescriptorWord false) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseDescriptorPayload + (transitionClause window symbols) := by + have hphysical := fiveFamilyForbiddenExactWindowDistinctPayloadWord_valid + bound machine original suffix window symbols + (tableauSourceSignedLiteralDescriptorWord false) + (fun atom => flatSignedLiteralDescriptor + (sourceLiteral (negative atom))) + (fun atom => by + simpa only [sourceLiteral, negative] using + tableauSourceSignedLiteralDescriptorWord_variable atom false) + rw [hphysical] + simp only [flatSourceClauseDescriptorPayload, + sortedElements_transitionClause_eq_sortedNetwork, + fiveForbiddenWindowSortedUniqueLiteralList, + flatSignedLiteralDescriptorStream, + List.flatMap_map, List.map_map, Function.comp_def] + +private theorem fiveFamilyForbiddenExactWindowDuplicatedPayloadWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + fiveForbiddenExactWindowDistinctPayloadWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (duplicatedUnarySignedLiteralCodeWord false) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseDuplicatedCodePayload + (transitionClause window symbols) := by + have hphysical := fiveFamilyForbiddenExactWindowDistinctPayloadWord_valid + bound machine original suffix window symbols + (duplicatedUnarySignedLiteralCodeWord false) + (fun atom => flatDuplicatedUnaryField + (Encodable.encode (negative atom))) + (fun atom => by + simpa only [negative] using + duplicatedUnarySignedLiteralCodeWord_sourceVariable atom false) + rw [hphysical] + simp only [flatSourceClauseDuplicatedCodePayload, + flatSourceFinsetCodes, + sortedElements_transitionClause_eq_sortedNetwork, + fiveForbiddenWindowSortedUniqueLiteralList, + flatDuplicatedUnarySourceStream, + List.flatMap_map, List.map_map, Function.comp_def] + +private theorem fiveFamilyForbiddenExactWindowUnaryCountWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + fiveForbiddenExactWindowDistinctPayloadWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (fun _ => [true]) + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseUnaryCountPayload + (transitionClause window symbols) := by + have hphysical := fiveFamilyForbiddenExactWindowDistinctPayloadWord_valid + bound machine original suffix window symbols + (fun _ => [true]) (fun _ => [true]) (fun _ => rfl) + rw [hphysical] + have hcard := congrArg List.length + (sortedElements_transitionClause_eq_sortedNetwork window symbols) + simp only [sortedElements_length, + fiveForbiddenWindowSortedUniqueLiteralList, + List.length_map] at hcard + unfold flatSourceClauseUnaryCountPayload + rw [← List.map_eq_flatMap, List.map_const', ← hcard] + +private theorem fiveFamilyForbiddenExactWindowWholeClauseRecordWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original suffix : List Bool) + (window : Window (rowWidth bound machine original)) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + fiveForbiddenExactWindowWholeClauseRecordWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + symbols.1.val symbols.2.1.val + symbols.2.2.1.val symbols.2.2.2.val + (lengthPrefixedWord + (List.replicate + (fiveFamilyForbiddenWindowSourceRank window) true) ++ + lengthPrefixedWord original ++ suffix) = + flatSourceClauseAnnotatedRecord + (transitionClause window symbols) := by + unfold fiveForbiddenExactWindowWholeClauseRecordWord + flatSourceClauseAnnotatedRecord + rw [fiveFamilyForbiddenExactWindowDescriptorPayloadWord_valid + bound machine original suffix window symbols, + fiveFamilyForbiddenExactWindowDuplicatedPayloadWord_valid + bound machine original suffix window symbols, + fiveFamilyForbiddenExactWindowUnaryCountWord_valid + bound machine original suffix window symbols] + +end CNFFiveFamilyForbiddenWholeClauseValidity + +namespace CNFFiveFamilyIndependentFiveFamilyCatalogueSourceValidity + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLCellRowBounds GapCVP.CLPaddedAcceptanceCompiler GapCVP.BinaryEncoding +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM GapCVP.CNFFiveFamilyFlatIndexedCatalogueTM +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM GapCVP.CNFFiveFamilyFlatRowMajorCatalogueTM +open GapCVP.CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM +open GapCVP.CNFFiveFamilyFlatRowMajorAtMostClauseWorkerTM +open GapCVP.CNFFiveFamilyPackedInitialCellDecoderTM +open GapCVP.CNFFiveFamilyForbiddenWindowCoordinateTM +open GapCVP.CNFFiveFamilyForbiddenWholeClauseValidity +open GapCVP.CNFFiveFamilyIndependentFiveFamilyBundledCatalogueTM + +private def fiveIndependentAtMostSourceClauses + (T S : ℕ) : List (Clause T S) := + (fiveFamilyRowMajorSymbolPairs S).flatMap fun symbols => + (fiveFamilyRowMajorTimePositionSlots T).map fun position => + if symbols.1 < symbols.2 then + atMostOneClause position.1 position.2 symbols.1 symbols.2 + else + atLeastOneClause position.1 position.2 + +private def fiveIndependentForbiddenSourceClauses + {T S : ℕ} (specification : Specification T S) : + List (Clause T S) := + (fiveFamilyRowMajorWindowSymbols S).flatMap fun symbols => + (fiveFamilyRowMajorWindows T).map fun window => + if specification.allowed symbols = false then + transitionClause window symbols + else + atLeastOneClause window.1.1 window.1.2 + +private def fiveIndependentActualSourceClauses + {T S : ℕ} (specification : Specification T S) : + List (Clause T S) := + fiveFamilyRowMajorAtLeastClauses T S ++ + (fiveIndependentAtMostSourceClauses T S ++ + (fiveFamilyRowMajorInitialClauses specification ++ + (fiveFamilyRowMajorAcceptanceClauses specification ++ + fiveIndependentForbiddenSourceClauses specification))) + +private theorem mem_fiveFamilyIndependentAtMostSourceClauses + {T S : ℕ} (clause : Clause T S) : + clause ∈ fiveIndependentAtMostSourceClauses T S ↔ + clause ∈ fiveFamilyRowMajorAtMostClauses T S := by + simp only [fiveIndependentAtMostSourceClauses, + fiveFamilyRowMajorAtMostClauses, + List.mem_flatMap, List.mem_map] + constructor + · rintro ⟨symbols, hsymbols, position, hposition, hequality⟩ + exact ⟨position, hposition, symbols, hsymbols, hequality⟩ + · rintro ⟨position, hposition, symbols, hsymbols, hequality⟩ + exact ⟨symbols, hsymbols, position, hposition, hequality⟩ + +private theorem mem_fiveFamilyIndependentForbiddenSourceClauses + {T S : ℕ} (specification : Specification T S) + (clause : Clause T S) : + clause ∈ fiveIndependentForbiddenSourceClauses + specification ↔ + clause ∈ fiveFamilyRowMajorForbiddenClauses specification := by + simp only [fiveIndependentForbiddenSourceClauses, + fiveFamilyRowMajorForbiddenClauses, + List.mem_flatMap, List.mem_map] + constructor + · rintro ⟨symbols, hsymbols, window, hwindow, hequality⟩ + exact ⟨window, hwindow, symbols, hsymbols, hequality⟩ + · rintro ⟨window, hwindow, symbols, hsymbols, hequality⟩ + exact ⟨symbols, hsymbols, window, hwindow, hequality⟩ + +private theorem fiveFamilyIndependentActualSourceClauses_toFinset + {T S : ℕ} (specification : Specification T S) : + (fiveIndependentActualSourceClauses + specification).toFinset = tableauFormula specification := by + rw [← fiveFamilyRowMajorSourceClauses_toFinset specification] + ext clause + simp only [List.mem_toFinset, + fiveIndependentActualSourceClauses, + fiveFamilyRowMajorSourceClauses, + List.mem_append, + mem_fiveFamilyIndependentAtMostSourceClauses, + mem_fiveFamilyIndependentForbiddenSourceClauses, + or_assoc] + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentActualSourceClauseCountPolynomial + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + Polynomial ℕ := + let grid := fiveFamilyFlatIndexedGridPolynomial bound machine + let symbols := completePhaseSymbolCount machine.tm + 1 + grid * grid + + grid * grid * Polynomial.C (symbols ^ 2) + + grid + 1 + + nondeterministicTableauDimensionPolynomial bound machine * + grid * Polynomial.C (symbols ^ 4) + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveFamilyIndependentSquareGridTime + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + Time (rowWidth bound machine original) := + ⟨rank.val / (rowWidth bound machine original + 1), by + apply fiveFamilyFlatIndexedGridQuotient_lt + bound machine original rank.val + simpa only [pow_two, Polynomial.eval_mul, fiveFamilyFlatIndexedGridPolynomial_eval] + using rank.isLt⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentSquareGridPosition + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + Position (rowWidth bound machine original) := + ⟨rank.val % (rowWidth bound machine original + 1), + fiveFamilyFlatIndexedGridRemainder_lt + bound machine original rank.val⟩ + +private theorem fiveFamilyIndependentSquareGridRank_eq + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + fiveFamilyFlatSourceRowMajorIndex + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank) = rank.val := by + unfold fiveFamilyFlatSourceRowMajorIndex + fiveFamilyIndependentSquareGridTime + fiveIndependentSquareGridPosition + exact Nat.div_add_mod' rank.val + (rowWidth bound machine original + 1) + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentSquareGridSlots + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + List (Time (rowWidth bound machine original) × + Position (rowWidth bound machine original)) := + (List.finRange + ((fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)).map fun rank => + (fiveFamilyIndependentSquareGridTime + bound machine original rank, + fiveIndependentSquareGridPosition + bound machine original rank) + +@[simp] private theorem mem_fiveFamilyIndependentSquareGridSlots + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (time : Time (rowWidth bound machine original)) + (position : Position (rowWidth bound machine original)) : + (time, position) ∈ + fiveIndependentSquareGridSlots + bound machine original := by + have htime : time.val < rowWidth bound machine original + 1 := + time.isLt + have hposition : position.val < + rowWidth bound machine original + 1 := position.isLt + have hindex : + fiveFamilyFlatSourceRowMajorIndex time position < + (rowWidth bound machine original + 1) * + (rowWidth bound machine original + 1) := by + unfold fiveFamilyFlatSourceRowMajorIndex + calc + time.val * (rowWidth bound machine original + 1) + + position.val < + time.val * (rowWidth bound machine original + 1) + + (rowWidth bound machine original + 1) := + Nat.add_lt_add_left hposition _ + _ = (time.val + 1) * + (rowWidth bound machine original + 1) := by + simp only [Nat.add_mul, one_mul] + _ ≤ (rowWidth bound machine original + 1) * + (rowWidth bound machine original + 1) := + Nat.mul_le_mul_right _ (Nat.succ_le_of_lt htime) + have hbound : + fiveFamilyFlatSourceRowMajorIndex time position < + (fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length := by + simpa only [Polynomial.eval_mul, fiveFamilyFlatIndexedGridPolynomial_eval] using hindex + let rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length) := + ⟨fiveFamilyFlatSourceRowMajorIndex time position, hbound⟩ + unfold fiveIndependentSquareGridSlots + apply List.mem_map.mpr + refine ⟨rank, by simp only [List.mem_finRange], ?_⟩ + apply Prod.ext + · apply Fin.ext + change fiveFamilyFlatSourceRowMajorIndex time position / + (rowWidth bound machine original + 1) = time.val + exact fiveFamilyFlatSourceRowMajorIndex_div time position + · apply Fin.ext + change fiveFamilyFlatSourceRowMajorIndex time position % + (rowWidth bound machine original + 1) = position.val + exact fiveFamilyFlatSourceRowMajorIndex_mod time position + +private def fiveFamilyIndependentForbiddenGridTime + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + Fin (rowWidth bound machine original) := + ⟨rank.val / (rowWidth bound machine original + 1), by + apply (Nat.div_lt_iff_lt_mul (by omega)).2 + simpa only [rowWidth, Polynomial.eval_mul, fiveFamilyFlatIndexedGridPolynomial_eval] + using rank.isLt⟩ + +private def fiveFamilyIndependentForbiddenGridPosition + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + Position (rowWidth bound machine original) := + ⟨rank.val % (rowWidth bound machine original + 1), + fiveFamilyFlatIndexedGridRemainder_lt + bound machine original rank.val⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentForbiddenGridWindow + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + Window (rowWidth bound machine original) := + windowAt + (fiveFamilyIndependentForbiddenGridTime + bound machine original rank) + (fiveFamilyIndependentForbiddenGridPosition + bound machine original rank) + +private theorem fiveFamilyIndependentForbiddenGridRank_eq + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + fiveFamilyForbiddenWindowSourceRank + (fiveIndependentForbiddenGridWindow + bound machine original rank) = rank.val := by + unfold fiveFamilyForbiddenWindowSourceRank + fiveFamilyFlatSourceRowMajorIndex + fiveIndependentForbiddenGridWindow + fiveFamilyIndependentForbiddenGridTime + fiveFamilyIndependentForbiddenGridPosition + exact Nat.div_add_mod' rank.val + (rowWidth bound machine original + 1) + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentForbiddenGridWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + List (Window (rowWidth bound machine original)) := + (List.finRange + ((nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)).map + (fiveIndependentForbiddenGridWindow + bound machine original) + +@[simp] private theorem mem_fiveFamilyIndependentForbiddenGridWindows + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (window : Window (rowWidth bound machine original)) : + window ∈ fiveIndependentForbiddenGridWindows + bound machine original := by + have htime : window.1.1.val < rowWidth bound machine original := by + have hwindow := window.2 + omega + have hposition : window.1.2.val < + rowWidth bound machine original + 1 := window.1.2.isLt + have hindex : + fiveFamilyForbiddenWindowSourceRank window < + rowWidth bound machine original * + (rowWidth bound machine original + 1) := by + unfold fiveFamilyForbiddenWindowSourceRank + fiveFamilyFlatSourceRowMajorIndex + calc + window.1.1.val * (rowWidth bound machine original + 1) + + window.1.2.val < + window.1.1.val * (rowWidth bound machine original + 1) + + (rowWidth bound machine original + 1) := + Nat.add_lt_add_left hposition _ + _ = (window.1.1.val + 1) * + (rowWidth bound machine original + 1) := by + simp only [Nat.add_mul, one_mul] + _ ≤ rowWidth bound machine original * + (rowWidth bound machine original + 1) := + Nat.mul_le_mul_right _ (Nat.succ_le_of_lt htime) + have hbound : + fiveFamilyForbiddenWindowSourceRank window < + (nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length := by + simpa only [rowWidth, Polynomial.eval_mul, fiveFamilyFlatIndexedGridPolynomial_eval] + using hindex + let rank : Fin + ((nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length) := + ⟨fiveFamilyForbiddenWindowSourceRank window, hbound⟩ + unfold fiveIndependentForbiddenGridWindows + apply List.mem_map.mpr + refine ⟨rank, by simp only [List.mem_finRange], ?_⟩ + apply Subtype.ext + apply Prod.ext + · apply Fin.ext + change fiveFamilyForbiddenWindowSourceRank window / + (rowWidth bound machine original + 1) = window.1.1.val + exact fiveFamilyFlatSourceRowMajorIndex_div + window.1.1 window.1.2 + · apply Fin.ext + change fiveFamilyForbiddenWindowSourceRank window % + (rowWidth bound machine original + 1) = window.1.2.val + exact fiveFamilyFlatSourceRowMajorIndex_mod + window.1.1 window.1.2 + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyIndependentAtLeastRankWorker_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + fiveFlatRowMajorAtLeastClauseRecordWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + (lengthPrefixedWord (List.replicate rank.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original) = + flatSourceClauseAnnotatedRecord + (atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank)) := by + have hphysical := fiveFamilyFlatRowMajorAtLeastClauseRecordWord_valid + bound machine original + (List.replicate + ((flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval + original.length) true) + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank) + rw [fiveFamilyIndependentSquareGridRank_eq + bound machine original rank] at hphysical + simpa only [fiveFlatOriginalSourceAnchorWord, + List.append_assoc] using hphysical + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyIndependentAtMostRankWorker_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (pair : Symbol (completePhaseSymbolCount machine.tm) × + Symbol (completePhaseSymbolCount machine.tm)) + (rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + fiveIndependentAtMostFixedPairWorker + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + pair.1.val pair.2.val + (lengthPrefixedWord (List.replicate rank.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original) = + flatSourceClauseAnnotatedRecord + (if pair.1 < pair.2 then + atMostOneClause + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank) + pair.1 pair.2 + else + atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank)) := by + by_cases hpair : pair.1.val < pair.2.val + · have htyped : pair.1 < pair.2 := hpair + simp only [fiveIndependentAtMostFixedPairWorker, + hpair, htyped, ↓reduceIte] + have hphysical := fiveFamilyFlatRowMajorAtMostClauseRecordWord_valid + bound machine original + (List.replicate + ((flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval + original.length) true) + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank) + pair.1 pair.2 htyped + rw [fiveFamilyIndependentSquareGridRank_eq + bound machine original rank] at hphysical + simpa only [fiveFlatOriginalSourceAnchorWord, + List.append_assoc] using hphysical + · have htyped : ¬ pair.1 < pair.2 := hpair + simp only [fiveIndependentAtMostFixedPairWorker, + hpair, htyped, ↓reduceIte] + exact fiveFamilyIndependentAtLeastRankWorker_valid + bound machine original rank + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentInitialGridPosition + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + Position (rowWidth bound machine original) := + ⟨rank.val, by + simpa only [Order.lt_add_one_iff, fiveFamilyFlatIndexedGridPolynomial_eval] using rank.isLt⟩ + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyIndependentInitialRankWorker_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + fiveFlatWholePackedInitialClauseRecordWord + bound machine + (lengthPrefixedWord (List.replicate rank.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original) = + flatSourceClauseAnnotatedRecord + (initialClause + (paddedAcceptancePhaseSpecification + bound machine original).input + (fiveIndependentInitialGridPosition + bound machine original rank)) := by + have hphysical := fiveFamilyFlatWholePackedInitialClauseRecordWord_valid + bound machine original + (List.replicate + ((flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval + original.length) true) + (fiveIndependentInitialGridPosition + bound machine original rank) + simpa only [fiveFlatOriginalSourceAnchorWord, + fiveIndependentInitialGridPosition, + List.append_assoc] using hphysical + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyIndependentForbiddenRankWorker_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) + (rank : Fin + ((nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)) : + fiveIndependentForbiddenFixedTupleWorker + bound machine symbols + (lengthPrefixedWord (List.replicate rank.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original) = + flatSourceClauseAnnotatedRecord + (if paddedAcceptancePhaseSymbolAllowed machine symbols = false + then transitionClause + (fiveIndependentForbiddenGridWindow + bound machine original rank) symbols + else atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + (fiveIndependentForbiddenGridWindow + bound machine original rank).1.1 + (fiveIndependentForbiddenGridWindow + bound machine original rank).1.2) := by + by_cases hforbidden : + paddedAcceptancePhaseSymbolAllowed machine symbols = false + · simp only [fiveIndependentForbiddenFixedTupleWorker, + hforbidden, ite_true] + have hphysical := fiveFamilyForbiddenExactWindowWholeClauseRecordWord_valid + bound machine original + (List.replicate + ((flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval + original.length) true) + (fiveIndependentForbiddenGridWindow + bound machine original rank) symbols + rw [fiveFamilyIndependentForbiddenGridRank_eq + bound machine original rank] at hphysical + simpa only [fiveFlatOriginalSourceAnchorWord, + List.append_assoc] using hphysical + · simp only [fiveIndependentForbiddenFixedTupleWorker, hforbidden, Bool.true_eq_false, + ↓reduceIte] + have hphysical := fiveFamilyFlatRowMajorAtLeastClauseRecordWord_valid + bound machine original + (List.replicate + ((flatSourceAnnotatedClauseLengthPolynomial + (nondeterministicTableauDimensionPolynomial bound machine) + (completePhaseSymbolCount machine.tm)).eval + original.length) true) + (fiveIndependentForbiddenGridWindow + bound machine original rank).1.1 + (fiveIndependentForbiddenGridWindow + bound machine original rank).1.2 + have hrank := fiveFamilyIndependentForbiddenGridRank_eq + bound machine original rank + change fiveFamilyFlatSourceRowMajorIndex + (fiveIndependentForbiddenGridWindow + bound machine original rank).1.1 + (fiveIndependentForbiddenGridWindow + bound machine original rank).1.2 = rank.val at hrank + rw [hrank] at hphysical + simpa only [fiveFlatOriginalSourceAnchorWord, + List.append_assoc] using hphysical + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentPhysicalAtLeastSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) := + (fiveIndependentSquareGridSlots + bound machine original).map fun position => + atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + position.1 position.2 + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentPhysicalAtMostSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) := + (fiveFamilyRowMajorSymbolPairs + (completePhaseSymbolCount machine.tm)).flatMap fun symbols => + (fiveIndependentSquareGridSlots + bound machine original).map fun position => + if symbols.1 < symbols.2 then + atMostOneClause position.1 position.2 symbols.1 symbols.2 + else + atLeastOneClause position.1 position.2 + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentInitialGridPositions + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + List (Position (rowWidth bound machine original)) := + (List.finRange + ((fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length)).map + (fiveIndependentInitialGridPosition + bound machine original) + +@[simp] private theorem mem_fiveFamilyIndependentInitialGridPositions + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (position : Position (rowWidth bound machine original)) : + position ∈ fiveIndependentInitialGridPositions + bound machine original := by + have hbound : position.val < + (fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length := by + simpa only [fiveFamilyFlatIndexedGridPolynomial_eval, Order.lt_add_one_iff] using position.isLt + let rank : Fin + ((fiveFamilyFlatIndexedGridPolynomial bound machine).eval + original.length) := ⟨position.val, hbound⟩ + unfold fiveIndependentInitialGridPositions + apply List.mem_map.mpr + refine ⟨rank, by simp only [List.mem_finRange], ?_⟩ + apply Fin.ext + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentPhysicalInitialSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) := + (fiveIndependentInitialGridPositions + bound machine original).map + (initialClause + (paddedAcceptancePhaseSpecification + bound machine original).input) + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentPhysicalForbiddenSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) := + (fiveFamilyRowMajorWindowSymbols + (completePhaseSymbolCount machine.tm)).flatMap fun symbols => + (fiveIndependentForbiddenGridWindows + bound machine original).map fun window => + if paddedAcceptancePhaseSymbolAllowed machine symbols = false + then transitionClause window symbols + else atLeastOneClause window.1.1 window.1.2 + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentPhysicalSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) := + fiveIndependentPhysicalAtLeastSourceClauses + bound machine original ++ + (fiveIndependentPhysicalAtMostSourceClauses + bound machine original ++ + (fiveIndependentPhysicalInitialSourceClauses + bound machine original ++ + ((fiveFamilyRowMajorAcceptanceClauses + (paddedAcceptancePhaseSpecification + bound machine original) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm))) ++ + fiveIndependentPhysicalForbiddenSourceClauses + bound machine original))) + +private theorem mem_fiveFamilyIndependentPhysicalAtLeastSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (clause : Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) : + clause ∈ fiveIndependentPhysicalAtLeastSourceClauses + bound machine original ↔ + clause ∈ fiveFamilyRowMajorAtLeastClauses + (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm) := by + simp only [fiveIndependentPhysicalAtLeastSourceClauses, + fiveFamilyRowMajorAtLeastClauses, List.mem_map] + constructor + · rintro ⟨position, _, hequality⟩ + exact ⟨position, + mem_fiveFamilyRowMajorTimePositionSlots + position.1 position.2, + hequality⟩ + · rintro ⟨position, _, hequality⟩ + exact ⟨position, + mem_fiveFamilyIndependentSquareGridSlots + bound machine original position.1 position.2, + hequality⟩ + +private theorem mem_fiveFamilyIndependentPhysicalAtMostSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (clause : Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) : + clause ∈ fiveIndependentPhysicalAtMostSourceClauses + bound machine original ↔ + clause ∈ fiveIndependentAtMostSourceClauses + (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm) := by + simp only [fiveIndependentPhysicalAtMostSourceClauses, + fiveIndependentAtMostSourceClauses, + List.mem_flatMap, List.mem_map] + constructor + · rintro ⟨symbols, hsymbols, position, _, hequality⟩ + exact ⟨symbols, hsymbols, position, + mem_fiveFamilyRowMajorTimePositionSlots + position.1 position.2, + hequality⟩ + · rintro ⟨symbols, hsymbols, position, _, hequality⟩ + exact ⟨symbols, hsymbols, position, + mem_fiveFamilyIndependentSquareGridSlots + bound machine original position.1 position.2, + hequality⟩ + +private theorem mem_fiveFamilyIndependentPhysicalInitialSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (clause : Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) : + clause ∈ fiveIndependentPhysicalInitialSourceClauses + bound machine original ↔ + clause ∈ fiveFamilyRowMajorInitialClauses + (paddedAcceptancePhaseSpecification + bound machine original) := by + change + clause ∈ (fiveIndependentInitialGridPositions + bound machine original).map + (initialClause + (paddedAcceptancePhaseSpecification + bound machine original).input) ↔ + clause ∈ (List.finRange + (rowWidth bound machine original + 1)).map + (initialClause + (paddedAcceptancePhaseSpecification + bound machine original).input) + constructor + · intro hmember + obtain ⟨position, _, hequality⟩ := List.mem_map.mp hmember + apply List.mem_map.mpr + exact ⟨position, List.mem_finRange position, hequality⟩ + · intro hmember + obtain ⟨position, _, hequality⟩ := List.mem_map.mp hmember + apply List.mem_map.mpr + exact ⟨position, + mem_fiveFamilyIndependentInitialGridPositions + bound machine original position, + hequality⟩ + +private theorem mem_fiveFamilyIndependentPhysicalForbiddenSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (clause : Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) : + clause ∈ fiveIndependentPhysicalForbiddenSourceClauses + bound machine original ↔ + clause ∈ fiveIndependentForbiddenSourceClauses + (paddedAcceptancePhaseSpecification + bound machine original) := by + unfold fiveIndependentPhysicalForbiddenSourceClauses + fiveIndependentForbiddenSourceClauses + constructor + · intro hmember + obtain ⟨symbols, hsymbols, hwindow⟩ := + List.mem_flatMap.mp hmember + obtain ⟨window, _, hequality⟩ := List.mem_map.mp hwindow + apply List.mem_flatMap.mpr + refine ⟨symbols, hsymbols, ?_⟩ + apply List.mem_map.mpr + refine ⟨window, mem_fiveFamilyRowMajorWindows window, ?_⟩ + exact hequality + · intro hmember + obtain ⟨symbols, hsymbols, hwindow⟩ := + List.mem_flatMap.mp hmember + obtain ⟨window, _, hequality⟩ := List.mem_map.mp hwindow + apply List.mem_flatMap.mpr + refine ⟨symbols, hsymbols, ?_⟩ + apply List.mem_map.mpr + refine ⟨window, + mem_fiveFamilyIndependentForbiddenGridWindows + bound machine original window, ?_⟩ + exact hequality + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyIndependentPhysicalSourceClauses_toFinset + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + (fiveIndependentPhysicalSourceClauses + bound machine original).toFinset = + tableauFormula + (paddedAcceptancePhaseSpecification + bound machine original) := by + rw [← fiveFamilyIndependentActualSourceClauses_toFinset + (paddedAcceptancePhaseSpecification + bound machine original)] + ext clause + constructor + · intro hphysical + have hmember : clause ∈ + fiveIndependentPhysicalSourceClauses + bound machine original := + List.mem_toFinset.mp hphysical + have hactual : clause ∈ + fiveIndependentActualSourceClauses + (paddedAcceptancePhaseSpecification + bound machine original) := by + simp only [fiveIndependentPhysicalSourceClauses, + List.mem_append] at hmember + change + (show Clause + ((nondeterministicTableauDimensionPolynomial + bound machine).eval original.length) + (completePhaseSymbolCount machine.tm) from clause) ∈ + (fiveFamilyRowMajorAtLeastClauses + ((nondeterministicTableauDimensionPolynomial + bound machine).eval original.length) + (completePhaseSymbolCount machine.tm) ++ + (fiveIndependentAtMostSourceClauses + ((nondeterministicTableauDimensionPolynomial + bound machine).eval original.length) + (completePhaseSymbolCount machine.tm) ++ + (fiveFamilyRowMajorInitialClauses + (paddedAcceptancePhaseSpecification + bound machine original) ++ + (fiveFamilyRowMajorAcceptanceClauses + (paddedAcceptancePhaseSpecification + bound machine original) ++ + fiveIndependentForbiddenSourceClauses + (paddedAcceptancePhaseSpecification + bound machine original))))) + simp only [List.mem_append] + rcases hmember with hleast | hmost | hinitial | haccept | hforbidden + · exact Or.inl + ((mem_fiveFamilyIndependentPhysicalAtLeastSourceClauses + bound machine original clause).mp hleast) + · exact Or.inr (Or.inl + ((mem_fiveFamilyIndependentPhysicalAtMostSourceClauses + bound machine original clause).mp hmost)) + · exact Or.inr (Or.inr (Or.inl + ((mem_fiveFamilyIndependentPhysicalInitialSourceClauses + bound machine original clause).mp hinitial))) + · exact Or.inr (Or.inr (Or.inr (Or.inl haccept))) + · exact Or.inr (Or.inr (Or.inr (Or.inr + ((mem_fiveFamilyIndependentPhysicalForbiddenSourceClauses + bound machine original clause).mp hforbidden)))) + exact List.mem_toFinset.mpr hactual + · intro hactual + have hmember : clause ∈ + fiveIndependentActualSourceClauses + (paddedAcceptancePhaseSpecification + bound machine original) := + List.mem_toFinset.mp hactual + change + (show Clause + ((nondeterministicTableauDimensionPolynomial + bound machine).eval original.length) + (completePhaseSymbolCount machine.tm) from clause) ∈ + (fiveFamilyRowMajorAtLeastClauses + ((nondeterministicTableauDimensionPolynomial + bound machine).eval original.length) + (completePhaseSymbolCount machine.tm) ++ + (fiveIndependentAtMostSourceClauses + ((nondeterministicTableauDimensionPolynomial + bound machine).eval original.length) + (completePhaseSymbolCount machine.tm) ++ + (fiveFamilyRowMajorInitialClauses + (paddedAcceptancePhaseSpecification + bound machine original) ++ + (fiveFamilyRowMajorAcceptanceClauses + (paddedAcceptancePhaseSpecification + bound machine original) ++ + fiveIndependentForbiddenSourceClauses + (paddedAcceptancePhaseSpecification + bound machine original))))) at hmember + have hphysical : clause ∈ + fiveIndependentPhysicalSourceClauses + bound machine original := by + simp only [List.mem_append] at hmember + simp only [fiveIndependentPhysicalSourceClauses, + List.mem_append] + rcases hmember with hleast | hmost | hinitial | haccept | hforbidden + · exact Or.inl + ((mem_fiveFamilyIndependentPhysicalAtLeastSourceClauses + bound machine original clause).mpr hleast) + · exact Or.inr (Or.inl + ((mem_fiveFamilyIndependentPhysicalAtMostSourceClauses + bound machine original clause).mpr hmost)) + · exact Or.inr (Or.inr (Or.inl + ((mem_fiveFamilyIndependentPhysicalInitialSourceClauses + bound machine original clause).mpr hinitial))) + · exact Or.inr (Or.inr (Or.inr (Or.inl haccept))) + · exact Or.inr (Or.inr (Or.inr (Or.inr + ((mem_fiveFamilyIndependentPhysicalForbiddenSourceClauses + bound machine original clause).mpr hforbidden)))) + exact List.mem_toFinset.mpr hphysical + +end CNFFiveFamilyIndependentFiveFamilyCatalogueSourceValidity + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part08B.lean b/LeanPool/GapCVP/Part08B.lean new file mode 100644 index 000000000..e5c327b2b --- /dev/null +++ b/LeanPool/GapCVP/Part08B.lean @@ -0,0 +1,937 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part08A + +/-! # GapCVP proof, part 08, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiveFamilyIndependentFiveFamilyCatalogueSourceValidity + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLCompleteVerifierSimulation + +open GapCVP.CLCellRowBounds GapCVP.CLPaddedAcceptanceCompiler GapCVP.BinaryEncoding + +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM GapCVP.CNFFiveFamilyFlatIndexedCatalogueTM + +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM GapCVP.CNFFiveFamilyFlatRowMajorCatalogueTM + +open GapCVP.CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM + +open GapCVP.CNFFiveFamilyFlatRowMajorAtMostClauseWorkerTM + +open GapCVP.CNFFiveFamilyPackedInitialCellDecoderTM + +open GapCVP.CNFFiveFamilyForbiddenWindowCoordinateTM + +open GapCVP.CNFFiveFamilyForbiddenWholeClauseValidity + +open GapCVP.CNFFiveFamilyIndependentFiveFamilyBundledCatalogueTM + +end CNFFiveFamilyIndependentFiveFamilyCatalogueSourceValidity + +namespace CNFAnnotatedSourceCompleteBubbleSortTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFTypedRecordWorkerTM GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM +open GapCVP.CNFAnnotatedSourceCompleteFiniteSetComparatorSourceCert + +/-- Internal support shared across GapCVP continuation modules. -/ +def annotatedCompleteBubbleSortState + (pending count sorted : List Bool) : List Bool := + lengthPrefixedWord pending ++ + lengthPrefixedWord count ++ lengthPrefixedWord sorted + +private def flatAnnotatedCompleteBubblePending + (input : List Bool) : List Bool := + flatAnnotatedSourceFieldAt 0 input + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatAnnotatedCompleteBubbleCount + (input : List Bool) : List Bool := + flatAnnotatedSourceFieldAt 1 input + +private def flatAnnotatedCompleteBubbleSorted + (input : List Bool) : List Bool := + flatAnnotatedSourceFieldAt 2 input + +private def annotatedCompleteBubbleNextCount + (input : List Bool) : List Bool := + List.tail (flatAnnotatedCompleteBubbleCount input) + +private noncomputable def flatAnnotatedCompleteBubbleNextCountComputable : + BitTM + annotatedCompleteBubbleNextCount := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 1) + dropHeadComputable + change BitTM + (fun input : List Bool => + List.tail (flatAnnotatedSourceFieldAt 1 input)) + exact physical + +private def annotatedCompleteBubbleInnerSeed + (input : List Bool) : List Bool := + lengthPrefixedWord (flatAnnotatedCompleteBubblePending input) ++ + lengthPrefixedWord [] + +private noncomputable def flatAnnotatedCompleteBubbleInnerSeedComputable : + BitTM + annotatedCompleteBubbleInnerSeed := by + have hpending := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 0) + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable hpending + (sourceFixedWordComputable (lengthPrefixedWord [])) + change BitTM + (fun input : List Bool => + lengthPrefixedWord (flatAnnotatedSourceFieldAt 0 input) ++ + lengthPrefixedWord []) + simpa only [Function.comp_def] using physical + +private def annotatedCompleteBubbleInnerInput + (input : List Bool) : List Bool := + annotatedCompleteBubbleNextCount input ++ + false :: annotatedCompleteBubbleInnerSeed input + +private noncomputable def flatAnnotatedCompleteBubbleInnerInputComputable : + BitTM + annotatedCompleteBubbleInnerInput := by + have htail := pointwiseAppendComputable + (sourceFixedWordComputable [false]) + flatAnnotatedCompleteBubbleInnerSeedComputable + have physical := pointwiseAppendComputable + flatAnnotatedCompleteBubbleNextCountComputable htail + change BitTM + (fun input : List Bool => + annotatedCompleteBubbleNextCount input ++ + ([false] ++ annotatedCompleteBubbleInnerSeed input)) + simpa only [List.cons_append, List.nil_append] using physical + +private def annotatedCompleteBubbleInnerOutput : List Bool → List Bool := + boundedRecordFoldOutput + (flatAnnotatedBubblePassStep + annotatedCompleteTotalSourceComparison) ∘ + annotatedCompleteBubbleInnerInput + +private noncomputable def flatAnnotatedCompleteBubbleInnerOutputComputable : + BitTM + annotatedCompleteBubbleInnerOutput := by + exact GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteBubbleInnerInputComputable + (flatAnnotatedBubblePassFoldComputable + flatAnnotatedCompleteTotalSourceComparisonComputable) + +private def annotatedCompleteBubbleNextPending + (input : List Bool) : List Bool := + firstFieldContents + (firstFieldSuffix (annotatedCompleteBubbleInnerOutput input)) + +private noncomputable def flatAnnotatedCompleteBubbleNextPendingComputable : + BitTM + annotatedCompleteBubbleNextPending := by + have htail := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteBubbleInnerOutputComputable + firstFieldSuffixComputable + have physical := GapCVP.TMComposition.computableInPolyTime + htail firstFieldContentsComputable + change BitTM + (fun input : List Bool => + firstFieldContents + (firstFieldSuffix (annotatedCompleteBubbleInnerOutput input))) + simpa only [Function.comp_def] using physical + +private def annotatedCompleteBubbleNextSorted + (input : List Bool) : List Bool := + firstFieldContents (annotatedCompleteBubbleInnerOutput input) ++ + flatAnnotatedCompleteBubbleSorted input + +private noncomputable def flatAnnotatedCompleteBubbleNextSortedComputable : + BitTM + annotatedCompleteBubbleNextSorted := by + have hselected := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteBubbleInnerOutputComputable + firstFieldContentsComputable + have physical := pointwiseAppendComputable hselected + (annotatedSourceFieldAtComputable 2) + change BitTM + (fun input : List Bool => + firstFieldContents + (annotatedCompleteBubbleInnerOutput input) ++ + flatAnnotatedSourceFieldAt 2 input) + simpa only [Function.comp_def] using physical + +private def flatAnnotatedCompleteBubbleSortStep + (input : List Bool) : List Bool := + annotatedCompleteBubbleSortState + (annotatedCompleteBubbleNextPending input) + (annotatedCompleteBubbleNextCount input) + (annotatedCompleteBubbleNextSorted input) + +private noncomputable def flatAnnotatedCompleteBubbleSortStepComputable : + BitTM + flatAnnotatedCompleteBubbleSortStep := by + have hpending := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteBubbleNextPendingComputable + structuralPrefixWriterComputable + have hcount := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteBubbleNextCountComputable + structuralPrefixWriterComputable + have hsorted := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteBubbleNextSortedComputable + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable hpending + (pointwiseAppendComputable hcount hsorted) + have hequality : + (fun input : List Bool => + lengthPrefixedWord + (annotatedCompleteBubbleNextPending input) ++ + (lengthPrefixedWord + (annotatedCompleteBubbleNextCount input) ++ + lengthPrefixedWord + (annotatedCompleteBubbleNextSorted input))) = + flatAnnotatedCompleteBubbleSortStep := by + funext input + simp only [flatAnnotatedCompleteBubbleSortStep, annotatedCompleteBubbleSortState, + List.append_assoc] + rw [← hequality] + exact physical + +@[simp] private theorem flatAnnotatedCompleteBubbleSortState_pending + (pending count sorted : List Bool) : + flatAnnotatedCompleteBubblePending + (annotatedCompleteBubbleSortState pending count sorted) = + pending := by + simp only [flatAnnotatedCompleteBubblePending, flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, + annotatedCompleteBubbleSortState, List.append_assoc, Function.iterate_zero, id_eq, + firstFieldContents_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem flatAnnotatedCompleteBubbleSortState_count + (pending count sorted : List Bool) : + flatAnnotatedCompleteBubbleCount + (annotatedCompleteBubbleSortState pending count sorted) = + count := by + simp only [flatAnnotatedCompleteBubbleCount, flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, + annotatedCompleteBubbleSortState, List.append_assoc, Function.iterate_one, + firstFieldSuffix_valid, + firstFieldContents_valid] + +@[simp] private theorem flatAnnotatedCompleteBubbleSortState_sorted + (pending count sorted : List Bool) : + flatAnnotatedCompleteBubbleSorted + (annotatedCompleteBubbleSortState pending count sorted) = + sorted := by + simpa [flatAnnotatedCompleteBubbleSorted, + annotatedCompleteBubbleSortState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', List.append_assoc] using + (firstFieldContents_valid sorted []) + +private theorem flatAnnotatedCompleteBubbleThreeFieldAccounting + (input : List Bool) : + 2 * (flatAnnotatedCompleteBubblePending input).length + + 2 * (flatAnnotatedCompleteBubbleCount input).length + + 2 * (flatAnnotatedCompleteBubbleSorted input).length ≤ + input.length := by + have hfirst := annotatedStructuralFieldAccounting input + have hsecond := annotatedStructuralFieldAccounting + (firstFieldSuffix input) + have hthird := annotatedStructuralFieldAccounting + (firstFieldSuffix (firstFieldSuffix input)) + simp only [flatAnnotatedCompleteBubblePending, + flatAnnotatedCompleteBubbleCount, + flatAnnotatedCompleteBubbleSorted, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', Function.iterate_zero, + id_eq] at * + omega + +private theorem flatAnnotatedCompleteBubbleParsedPrefix_count_le + (markers suffix : List Bool) + (count : ℕ) (seed : List Bool) + (hparse : + parseUnaryBoundedFold (markers ++ false :: suffix) = + some (count, seed)) : + count ≤ markers.length := by + induction markers generalizing count seed with + | nil => + simp only [List.nil_append, parseUnaryBoundedFold, Option.some.injEq, Prod.mk.injEq] + at hparse + omega + | cons bit remaining ih => + cases bit with + | false => + simp only [List.cons_append, parseUnaryBoundedFold, Option.some.injEq, Prod.mk.injEq] + at hparse + omega + | true => + cases hremaining : + parseUnaryBoundedFold (remaining ++ false :: suffix) with + | none => + simp only [List.cons_append, parseUnaryBoundedFold, hremaining, Option.map_none, + reduceCtorEq] at hparse + | some parsed => + obtain ⟨remainingCount, remainingSeed⟩ := parsed + have hbound := + ih remainingCount remainingSeed hremaining + simp only [List.cons_append, parseUnaryBoundedFold, hremaining, Option.map_some, + Option.some.injEq, + Prod.mk.injEq] at hparse + simp only [List.length_cons] at hbound ⊢ + omega + +private theorem flatAnnotatedCompleteBubbleInnerInput_length + (input : List Bool) : + (annotatedCompleteBubbleInnerInput input).length = + (annotatedCompleteBubbleNextCount input).length + + 2 * (flatAnnotatedCompleteBubblePending input).length + 3 := by + simp only [annotatedCompleteBubbleInnerInput, annotatedCompleteBubbleInnerSeed, + List.length_append, + List.length_cons, lengthPrefixedWord_length, List.length_nil, mul_zero, zero_add] + omega + +private theorem flatAnnotatedCompleteBubbleInnerOutput_length_le + (input : List Bool) : + (annotatedCompleteBubbleInnerOutput input).length ≤ + (annotatedCompleteBubbleInnerInput input).length + + 4 * (flatAnnotatedCompleteBubbleCount input).length := by + unfold annotatedCompleteBubbleInnerOutput + rw [Function.comp_apply] + cases hparse : + parseUnaryBoundedFold + (annotatedCompleteBubbleInnerInput input) with + | none => simp only [boundedRecordFoldOutput, hparse, List.length_nil, zero_le] + | some parsed => + obtain ⟨count, seed⟩ := parsed + have hseed := parsedUnaryFold_seed_length_le + (annotatedCompleteBubbleInnerInput input) + count seed hparse + have hprefix := flatAnnotatedCompleteBubbleParsedPrefix_count_le + (annotatedCompleteBubbleNextCount input) + (annotatedCompleteBubbleInnerSeed input) + count seed (by + simpa only [annotatedCompleteBubbleInnerInput] using hparse) + have htail : + (annotatedCompleteBubbleNextCount input).length ≤ + (flatAnnotatedCompleteBubbleCount input).length := by + simp only [annotatedCompleteBubbleNextCount, List.length_tail, tsub_le_iff_right, + le_add_iff_nonneg_right, + zero_le] + have hpass := flatAnnotatedBubblePassStep_iterate_length_le + annotatedCompleteTotalSourceComparison seed count + simp only [boundedRecordFoldOutput, hparse] + omega + +private theorem flatAnnotatedCompleteBubbleSortStep_length_le + (input : List Bool) : + (flatAnnotatedCompleteBubbleSortStep input).length ≤ + input.length + + 5 * (flatAnnotatedCompleteBubbleCount input).length + 6 := by + have hsource := + flatAnnotatedCompleteBubbleThreeFieldAccounting input + change + 2 * (flatAnnotatedCompleteBubblePending input).length + + 2 * (flatAnnotatedCompleteBubbleCount input).length + + 2 * (flatAnnotatedSourceFieldAt 2 input).length ≤ + input.length at hsource + have hinner := + flatAnnotatedCompleteBubbleInnerOutput_length_le input + have hinnerLength := + flatAnnotatedCompleteBubbleInnerInput_length input + have hfields := annotatedStructuralTwoFieldAccounting + (annotatedCompleteBubbleInnerOutput input) + have htail : + (annotatedCompleteBubbleNextCount input).length ≤ + (flatAnnotatedCompleteBubbleCount input).length := by + simp only [annotatedCompleteBubbleNextCount, List.length_tail, tsub_le_iff_right, + le_add_iff_nonneg_right, + zero_le] + simp only [flatAnnotatedCompleteBubbleSortStep, + annotatedCompleteBubbleSortState, + annotatedCompleteBubbleNextPending, + annotatedCompleteBubbleNextSorted, + flatAnnotatedCompleteBubbleSorted, + List.length_append, lengthPrefixedWord_length] + omega + +@[simp] private theorem flatAnnotatedCompleteBubbleSortStep_count + (input : List Bool) : + flatAnnotatedCompleteBubbleCount + (flatAnnotatedCompleteBubbleSortStep input) = + List.tail (flatAnnotatedCompleteBubbleCount input) := by + unfold flatAnnotatedCompleteBubbleSortStep + rw [flatAnnotatedCompleteBubbleSortState_count] + rfl + +private theorem flatAnnotatedCompleteBubbleSortStep_iterate_count_le + (input : List Bool) (stage : ℕ) : + (flatAnnotatedCompleteBubbleCount + (((flatAnnotatedCompleteBubbleSortStep)^[stage]) input)).length ≤ + (flatAnnotatedCompleteBubbleCount input).length := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + rw [flatAnnotatedCompleteBubbleSortStep_count] + simp only [List.length_tail] + omega + +private theorem flatAnnotatedCompleteBubbleSortStep_iterate_length_le + (input : List Bool) (stage : ℕ) : + (((flatAnnotatedCompleteBubbleSortStep)^[stage]) input).length ≤ + input.length + + stage * (5 * (flatAnnotatedCompleteBubbleCount input).length + 6) := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, zero_mul, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have hstep := flatAnnotatedCompleteBubbleSortStep_length_le + (((flatAnnotatedCompleteBubbleSortStep)^[stage]) input) + have hcount := + flatAnnotatedCompleteBubbleSortStep_iterate_count_le input stage + have hsuccessor : + (stage + 1) * + (5 * (flatAnnotatedCompleteBubbleCount input).length + 6) = + stage * + (5 * (flatAnnotatedCompleteBubbleCount input).length + 6) + + (5 * (flatAnnotatedCompleteBubbleCount input).length + 6) := + Nat.succ_mul stage + (5 * (flatAnnotatedCompleteBubbleCount input).length + 6) + rw [hsuccessor] + omega + +private theorem flatAnnotatedCompleteBubbleSort_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + flatAnnotatedCompleteBubbleSortStep + (5 * Polynomial.X ^ 2 + 7 * Polynomial.X) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := parsedUnaryFold_seed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate := + flatAnnotatedCompleteBubbleSortStep_iterate_length_le seed stage + have hfield := + flatAnnotatedCompleteBubbleThreeFieldAccounting seed + simp only [Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_pow, Polynomial.eval_X] + nlinarith + +private noncomputable def flatAnnotatedCompleteBubbleSortFoldComputable : + BitTM + (boundedRecordFoldOutput flatAnnotatedCompleteBubbleSortStep) := + boundedDependentRecordFoldComputable + flatAnnotatedCompleteBubbleSortStepComputable + (5 * Polynomial.X ^ 2 + 7 * Polynomial.X) + flatAnnotatedCompleteBubbleSort_polynomiallyBoundedFoldStates + +end CNFAnnotatedSourceCompleteBubbleSortTM + +namespace CNFAnnotatedSourceCompleteBubbleSortSourceCert + +open Turing GapCVP.CL GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM +open GapCVP.CNFAnnotatedSourceCompleteFiniteSetComparatorSourceCert +open GapCVP.CNFAnnotatedSourceCompleteBubbleSortTM + +private def flatAnnotatedOriginalBubblePass + {T S : ℕ} (champion : Clause T S) + (remaining emitted : List (Clause T S)) : + Clause T S × List (Clause T S) := + match remaining with + | [] => (champion, emitted) + | next :: tail => + if Encodable.encode next < Encodable.encode champion then + flatAnnotatedOriginalBubblePass champion tail + (emitted ++ [next]) + else + flatAnnotatedOriginalBubblePass next tail + (emitted ++ [champion]) +termination_by remaining.length + +private theorem flatAnnotatedBubblePassStep_iterate_originalClauseState + {T S : ℕ} (champion : Clause T S) + (remaining emitted : List (Clause T S)) : + (((flatAnnotatedBubblePassStep + annotatedCompleteTotalSourceComparison)^[remaining.length]) + (flatAnnotatedBubbleClauseState + (champion :: remaining) emitted)) = + flatAnnotatedBubbleClauseState + [(flatAnnotatedOriginalBubblePass + champion remaining emitted).1] + (flatAnnotatedOriginalBubblePass + champion remaining emitted).2 := by + induction remaining generalizing champion emitted with + | nil => simp only [List.length_nil, Function.iterate_zero, id_eq, + flatAnnotatedOriginalBubblePass] + | cons next tail ih => + simp only [List.length_cons, Function.iterate_succ_apply] + rw [flatAnnotatedBubblePassStep_clauseState + flatAnnotatedCompleteTotalSourceComparison_correct] + by_cases horder : Encodable.encode next < Encodable.encode champion + · simp only [horder, ↓reduceIte, + flatAnnotatedOriginalBubblePass] + exact ih champion (emitted ++ [next]) + · simp only [horder, ↓reduceIte, + flatAnnotatedOriginalBubblePass] + exact ih next (emitted ++ [champion]) + +@[simp] private theorem flatAnnotatedOriginalBubblePass_emitted_length + {T S : ℕ} (champion : Clause T S) + (remaining emitted : List (Clause T S)) : + (flatAnnotatedOriginalBubblePass + champion remaining emitted).2.length = + remaining.length + emitted.length := by + induction remaining generalizing champion emitted with + | nil => simp only [flatAnnotatedOriginalBubblePass, List.length_nil, zero_add] + | cons next tail ih => + by_cases horder : Encodable.encode next < Encodable.encode champion + · simp only [flatAnnotatedOriginalBubblePass, horder, + ↓reduceIte] + rw [ih] + simp only [List.length_append, List.length_cons, List.length_nil, zero_add] + omega + · simp only [flatAnnotatedOriginalBubblePass, horder, + ↓reduceIte] + rw [ih] + simp only [List.length_append, List.length_cons, List.length_nil, zero_add] + omega + +private theorem flatAnnotatedCompleteBubbleInnerInput_originalClauseState + {T S : ℕ} (champion : Clause T S) + (remaining sorted : List (Clause T S)) : + annotatedCompleteBubbleInnerInput + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream + (champion :: remaining)) + (List.replicate (champion :: remaining).length true) + (flatAnnotatedBundledClauseStream sorted)) = + unaryBoundedFoldWord remaining.length + (flatAnnotatedBubbleClauseState + (champion :: remaining) []) := by + simp only [annotatedCompleteBubbleInnerInput, annotatedCompleteBubbleNextCount, + flatAnnotatedBundledClauseStream, List.flatMap_cons, List.length_cons, List.replicate_succ, + flatAnnotatedCompleteBubbleSortState_count, List.tail_cons, annotatedCompleteBubbleInnerSeed, + flatAnnotatedCompleteBubbleSortState_pending, unaryBoundedFoldWord, + flatAnnotatedBubbleClauseState, + flatAnnotatedBubblePassState, List.flatMap_nil] + +private theorem flatAnnotatedCompleteBubbleInnerOutput_originalClauseState + {T S : ℕ} (champion : Clause T S) + (remaining sorted : List (Clause T S)) : + annotatedCompleteBubbleInnerOutput + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream + (champion :: remaining)) + (List.replicate (champion :: remaining).length true) + (flatAnnotatedBundledClauseStream sorted)) = + flatAnnotatedBubbleClauseState + [(flatAnnotatedOriginalBubblePass + champion remaining []).1] + (flatAnnotatedOriginalBubblePass + champion remaining []).2 := by + unfold annotatedCompleteBubbleInnerOutput + rw [Function.comp_apply, + flatAnnotatedCompleteBubbleInnerInput_originalClauseState] + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + exact flatAnnotatedBubblePassStep_iterate_originalClauseState + champion remaining [] + +private theorem flatAnnotatedCompleteBubbleSortStep_originalClauseState + {T S : ℕ} (champion : Clause T S) + (remaining sorted : List (Clause T S)) : + flatAnnotatedCompleteBubbleSortStep + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream + (champion :: remaining)) + (List.replicate (champion :: remaining).length true) + (flatAnnotatedBundledClauseStream sorted)) = + annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream + (flatAnnotatedOriginalBubblePass + champion remaining []).2) + (List.replicate remaining.length true) + (flatAnnotatedBundledClauseStream + ((flatAnnotatedOriginalBubblePass + champion remaining []).1 :: sorted)) := by + unfold flatAnnotatedCompleteBubbleSortStep + simp only [annotatedCompleteBubbleNextPending, + annotatedCompleteBubbleNextCount, + annotatedCompleteBubbleNextSorted, + flatAnnotatedCompleteBubbleSortState_count, + flatAnnotatedCompleteBubbleSortState_sorted, + flatAnnotatedCompleteBubbleInnerOutput_originalClauseState] + have hpending : + firstFieldContents + (lengthPrefixedWord + (flatAnnotatedBundledClauseStream + (flatAnnotatedOriginalBubblePass + champion remaining []).2)) = + flatAnnotatedBundledClauseStream + (flatAnnotatedOriginalBubblePass + champion remaining []).2 := by + simpa only [List.append_nil] using + firstFieldContents_valid + (flatAnnotatedBundledClauseStream (flatAnnotatedOriginalBubblePass champion remaining + []).2) [] + simp only [flatAnnotatedBubbleClauseState, + flatAnnotatedBubblePassState, + firstFieldContents_valid, firstFieldSuffix_valid] + rw [hpending] + simp only [flatAnnotatedBundledClauseStream, List.length_cons, List.replicate_succ, + List.tail_cons, + List.flatMap_cons, List.flatMap_nil, List.append_nil] + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatAnnotatedOriginalBubbleSortAux + {T S : ℕ} (pending sorted : List (Clause T S)) : + List (Clause T S) := + match pending with + | [] => sorted + | champion :: remaining => + let result := flatAnnotatedOriginalBubblePass + champion remaining [] + flatAnnotatedOriginalBubbleSortAux + result.2 (result.1 :: sorted) +termination_by pending.length +decreasing_by + simp only [flatAnnotatedOriginalBubblePass_emitted_length, + List.length_nil, Nat.add_zero, List.length_cons] + omega + +private theorem flatAnnotatedCompleteBubbleSortStep_iterate_originalClauseState + {T S : ℕ} (pending sorted : List (Clause T S)) : + (((flatAnnotatedCompleteBubbleSortStep)^[pending.length]) + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream pending) + (List.replicate pending.length true) + (flatAnnotatedBundledClauseStream sorted))) = + annotatedCompleteBubbleSortState + [] [] + (flatAnnotatedBundledClauseStream + (flatAnnotatedOriginalBubbleSortAux pending sorted)) := by + cases pending with + | nil => + simp only [List.length_nil, flatAnnotatedBundledClauseStream, List.flatMap_nil, + List.replicate_zero, + Function.iterate_zero, id_eq, flatAnnotatedOriginalBubbleSortAux] + | cons champion remaining => + rw [List.length_cons, Function.iterate_succ_apply] + have hfirst := + flatAnnotatedCompleteBubbleSortStep_originalClauseState + champion remaining sorted + rw [List.length_cons] at hfirst + rw [hfirst] + have hlength : + (flatAnnotatedOriginalBubblePass + champion remaining []).2.length = remaining.length := by + simpa only [List.length_nil, Nat.add_zero] using + flatAnnotatedOriginalBubblePass_emitted_length + champion remaining [] + rw [← hlength] + have hrecursive := + flatAnnotatedCompleteBubbleSortStep_iterate_originalClauseState + (flatAnnotatedOriginalBubblePass + champion remaining []).2 + ((flatAnnotatedOriginalBubblePass + champion remaining []).1 :: sorted) + simpa only [flatAnnotatedOriginalBubbleSortAux] using hrecursive +termination_by pending.length +decreasing_by + simp only [flatAnnotatedOriginalBubblePass_emitted_length, + List.length_nil, Nat.add_zero, List.length_cons] + omega + +private theorem boundedRecordFoldOutput_flatAnnotatedCompleteBubbleSort + {T S : ℕ} (pending sorted : List (Clause T S)) : + boundedRecordFoldOutput flatAnnotatedCompleteBubbleSortStep + (unaryBoundedFoldWord pending.length + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream pending) + (List.replicate pending.length true) + (flatAnnotatedBundledClauseStream sorted))) = + annotatedCompleteBubbleSortState + [] [] + (flatAnnotatedBundledClauseStream + (flatAnnotatedOriginalBubbleSortAux pending sorted)) := by + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + exact flatAnnotatedCompleteBubbleSortStep_iterate_originalClauseState + pending sorted + +private theorem flatAnnotatedOriginalBubblePass_perm + {T S : ℕ} (champion : Clause T S) + (remaining emitted : List (Clause T S)) : + ((flatAnnotatedOriginalBubblePass + champion remaining emitted).1 :: + (flatAnnotatedOriginalBubblePass + champion remaining emitted).2).Perm + (champion :: (remaining ++ emitted)) := by + induction remaining generalizing champion emitted with + | nil => simp only [flatAnnotatedOriginalBubblePass, List.nil_append, List.Perm.refl] + | cons next tail ih => + by_cases horder : Encodable.encode next < Encodable.encode champion + · simp only [flatAnnotatedOriginalBubblePass, horder, + ↓reduceIte] + have hpass := ih champion (emitted ++ [next]) + have hmove : + (champion :: (tail ++ (emitted ++ [next]))).Perm + (champion :: (next :: tail ++ emitted)) := by + simpa only [List.cons_append, List.perm_cons, List.append_assoc] using + (List.perm_append_singleton next (tail ++ emitted)).cons champion + exact hpass.trans hmove + · simp only [flatAnnotatedOriginalBubblePass, horder, + ↓reduceIte] + have hpass := ih next (emitted ++ [champion]) + have hmove : + (next :: (tail ++ (emitted ++ [champion]))).Perm + (champion :: (next :: tail ++ emitted)) := by + simpa only [List.cons_append, List.append_assoc] using + List.perm_append_singleton champion (next :: (tail ++ emitted)) + exact hpass.trans hmove + +private theorem flatAnnotatedOriginalBubblePass_champion_le + {T S : ℕ} (champion : Clause T S) + (remaining emitted : List (Clause T S)) + (record : Clause T S) + (hrecord : record ∈ champion :: remaining) : + Encodable.encode record ≤ + Encodable.encode + (flatAnnotatedOriginalBubblePass + champion remaining emitted).1 := by + induction remaining generalizing champion emitted record with + | nil => + simp only [List.mem_cons, List.not_mem_nil, or_false, flatAnnotatedOriginalBubblePass] + at hrecord ⊢ + exact hrecord ▸ Nat.le_refl _ + | cons next tail ih => + by_cases horder : Encodable.encode next < Encodable.encode champion + · simp only [flatAnnotatedOriginalBubblePass, horder, + ↓reduceIte] + simp only [List.mem_cons] at hrecord + rcases hrecord with hchampion | hrest + · subst record + exact ih champion (emitted ++ [next]) champion + (by simp only [List.mem_cons, true_or]) + · rcases hrest with hnext | htail + · subst record + exact Nat.le_trans (Nat.le_of_lt horder) + (ih champion (emitted ++ [next]) champion (by simp only [List.mem_cons, true_or])) + · exact ih champion (emitted ++ [next]) record + (by simp only [List.mem_cons, htail, or_true]) + · simp only [flatAnnotatedOriginalBubblePass, horder, + ↓reduceIte] + simp only [List.mem_cons] at hrecord + rcases hrecord with hchampion | hrest + · subst record + exact Nat.le_trans (Nat.le_of_not_gt horder) + (ih next (emitted ++ [champion]) next (by simp only [List.mem_cons, true_or])) + · rcases hrest with hnext | htail + · subst record + exact ih next (emitted ++ [champion]) next (by simp only [List.mem_cons, true_or]) + · exact ih next (emitted ++ [champion]) record + (by simp only [List.mem_cons, htail, or_true]) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAnnotatedOriginalBubbleSortAux_perm + {T S : ℕ} (pending sorted : List (Clause T S)) : + (flatAnnotatedOriginalBubbleSortAux pending sorted).Perm + (pending ++ sorted) := by + cases pending with + | nil => simp only [flatAnnotatedOriginalBubbleSortAux, List.nil_append, List.Perm.refl] + | cons champion remaining => + have hpass := + flatAnnotatedOriginalBubblePass_perm + champion remaining [] + simp only [List.append_nil] at hpass + have hrecursive := flatAnnotatedOriginalBubbleSortAux_perm + (flatAnnotatedOriginalBubblePass + champion remaining []).2 + ((flatAnnotatedOriginalBubblePass + champion remaining []).1 :: sorted) + have hmiddle : + ((flatAnnotatedOriginalBubblePass + champion remaining []).2 ++ + (flatAnnotatedOriginalBubblePass + champion remaining []).1 :: sorted).Perm + (((flatAnnotatedOriginalBubblePass + champion remaining []).1 :: + (flatAnnotatedOriginalBubblePass + champion remaining []).2) ++ sorted) := by + exact List.perm_middle + have hsource := hpass.append_right sorted + simp only [flatAnnotatedOriginalBubbleSortAux] + exact hrecursive.trans (hmiddle.trans hsource) +termination_by pending.length +decreasing_by + simp only [flatAnnotatedOriginalBubblePass_emitted_length, + List.length_nil, Nat.add_zero, List.length_cons] + omega + +private theorem flatAnnotatedOriginalBubbleSortAux_pairwise + {T S : ℕ} (pending sorted : List (Clause T S)) + (hsorted : sorted.Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second)) + (hbounded : + ∀ first ∈ pending, ∀ second ∈ sorted, + Encodable.encode first ≤ Encodable.encode second) : + (flatAnnotatedOriginalBubbleSortAux pending sorted).Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second) := by + cases pending with + | nil => simpa only [flatAnnotatedOriginalBubbleSortAux] using hsorted + | cons champion remaining => + have hpass := + flatAnnotatedOriginalBubblePass_perm + champion remaining [] + simp only [List.append_nil] at hpass + have hchampion : + (flatAnnotatedOriginalBubblePass + champion remaining []).1 ∈ champion :: remaining := + hpass.subset (by simp only [List.mem_cons, true_or]) + have hnewSorted : + ((flatAnnotatedOriginalBubblePass + champion remaining []).1 :: sorted).Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second) := by + apply List.pairwise_cons.mpr + refine ⟨?_, hsorted⟩ + intro second hsecond + exact hbounded _ hchampion second hsecond + have hnewBounded : + ∀ first ∈ + (flatAnnotatedOriginalBubblePass + champion remaining []).2, + ∀ second ∈ + (flatAnnotatedOriginalBubblePass + champion remaining []).1 :: sorted, + Encodable.encode first ≤ Encodable.encode second := by + intro first hfirst second hsecond + have horiginal : first ∈ champion :: remaining := + hpass.subset (List.mem_cons_of_mem _ hfirst) + rcases List.mem_cons.mp hsecond with hselected | hsortedSecond + · subst second + exact flatAnnotatedOriginalBubblePass_champion_le + champion remaining [] first horiginal + · exact hbounded first horiginal second hsortedSecond + simp only [flatAnnotatedOriginalBubbleSortAux] + exact flatAnnotatedOriginalBubbleSortAux_pairwise + (flatAnnotatedOriginalBubblePass + champion remaining []).2 + ((flatAnnotatedOriginalBubblePass + champion remaining []).1 :: sorted) + hnewSorted hnewBounded +termination_by pending.length +decreasing_by + simp_all only [flatAnnotatedOriginalBubblePass_emitted_length, + List.length_nil, Nat.add_zero, List.length_cons] + omega + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAnnotatedOriginalBubbleSort_pairwise + {T S : ℕ} (pending : List (Clause T S)) : + (flatAnnotatedOriginalBubbleSortAux pending []).Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second) := by + apply flatAnnotatedOriginalBubbleSortAux_pairwise + · simp only [List.Pairwise.nil] + · simp only [List.not_mem_nil, IsEmpty.forall_iff, implies_true] + +private def annotatedCompleteBubbleSortPreparedInput + (input : List Bool) : List Bool := + flatAnnotatedCompleteBubbleCount input ++ false :: input + +private noncomputable def flatAnnotatedCompleteBubbleSortPreparedInputComputable : + BitTM + annotatedCompleteBubbleSortPreparedInput := by + have htail := pointwiseAppendComputable + (sourceFixedWordComputable [false]) + (Turing.idComputableInPolyTime bitEncoding) + have physical := pointwiseAppendComputable + (annotatedSourceFieldAtComputable 1) htail + change BitTM + (fun input : List Bool => + flatAnnotatedSourceFieldAt 1 input ++ false :: input) + simpa only [id_eq, List.cons_append, List.nil_append] using physical + +/-- Internal support shared across GapCVP continuation modules. -/ +def annotatedCompleteBubbleSortedSourceOutput : + List Bool → List Bool := + flatAnnotatedCompleteBubbleSorted ∘ + boundedRecordFoldOutput flatAnnotatedCompleteBubbleSortStep ∘ + annotatedCompleteBubbleSortPreparedInput + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def flatAnnotatedCompleteBubbleSortedSourceComputable : + BitTM + annotatedCompleteBubbleSortedSourceOutput := by + have hfold := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteBubbleSortPreparedInputComputable + flatAnnotatedCompleteBubbleSortFoldComputable + have physical := GapCVP.TMComposition.computableInPolyTime + hfold (annotatedSourceFieldAtComputable 2) + change BitTM + (fun input : List Bool => + flatAnnotatedSourceFieldAt 2 + (boundedRecordFoldOutput flatAnnotatedCompleteBubbleSortStep + (annotatedCompleteBubbleSortPreparedInput input))) + simpa only [Function.comp_def] using physical + +@[simp] private theorem flatAnnotatedCompleteBubbleSortPreparedInput_originalClauseState + {T S : ℕ} (pending sorted : List (Clause T S)) : + annotatedCompleteBubbleSortPreparedInput + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream pending) + (List.replicate pending.length true) + (flatAnnotatedBundledClauseStream sorted)) = + unaryBoundedFoldWord pending.length + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream pending) + (List.replicate pending.length true) + (flatAnnotatedBundledClauseStream sorted)) := by + simp only [annotatedCompleteBubbleSortPreparedInput, flatAnnotatedCompleteBubbleSortState_count, + unaryBoundedFoldWord] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAnnotatedCompleteBubbleSortedSourceOutput_valid + {T S : ℕ} (pending sorted : List (Clause T S)) : + annotatedCompleteBubbleSortedSourceOutput + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream pending) + (List.replicate pending.length true) + (flatAnnotatedBundledClauseStream sorted)) = + flatAnnotatedBundledClauseStream + (flatAnnotatedOriginalBubbleSortAux pending sorted) := by + unfold annotatedCompleteBubbleSortedSourceOutput + rw [Function.comp_apply, Function.comp_apply, + flatAnnotatedCompleteBubbleSortPreparedInput_originalClauseState, + boundedRecordFoldOutput_flatAnnotatedCompleteBubbleSort, + flatAnnotatedCompleteBubbleSortState_sorted] + +end CNFAnnotatedSourceCompleteBubbleSortSourceCert + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part08C.lean b/LeanPool/GapCVP/Part08C.lean new file mode 100644 index 000000000..2940e78df --- /dev/null +++ b/LeanPool/GapCVP/Part08C.lean @@ -0,0 +1,1556 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part08B + +/-! # GapCVP proof, part 08, continuation 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFAnnotatedSourceCompleteBubbleSortSourceCert + +open Turing GapCVP.CL GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder + +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold + +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFAnnotatedSourceClausePairPreparationTM + +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM + +open GapCVP.CNFAnnotatedSourceCompleteFiniteSetComparatorSourceCert + +open GapCVP.CNFAnnotatedSourceCompleteBubbleSortTM + +end CNFAnnotatedSourceCompleteBubbleSortSourceCert + +namespace CNFAnnotatedSourceCompleteSortedDedupTM + +open Turing GapCVP.CL GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputPolynomialCompositionClosure +open GapCVP.OutputBoundedDependentRecordFold GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFEncodedClauseSort GapCVP.CNFFlatSourceOrder GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFTypedRecordWorkerTM GapCVP.CNFGuardedFiveFamilyTagDispatchTM +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM GapCVP.CNFAnnotatedSourceClauseBubblePassTM +open GapCVP.CNFAnnotatedSourceCompleteFiniteSetComparatorSourceCert +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.SourceFourFamilyTaggedPredicateDispatchTM + +private def annotatedSortedDedupSourceOrdering + (input : List Bool) : List Bool := + firstFieldSuffix + (annotatedBundledPairComparisonWord + annotatedCompleteTotalSourceComparison + (firstFieldContents input)) + +private noncomputable def flatAnnotatedSortedDedupSourceOrderingComputable : + BitTM + annotatedSortedDedupSourceOrdering := by + have hcomparison := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable + (flatAnnotatedBundledPairComparisonComputable + flatAnnotatedCompleteTotalSourceComparisonComputable) + have physical := GapCVP.TMComposition.computableInPolyTime + hcomparison firstFieldSuffixComputable + change BitTM + (fun input : List Bool => + firstFieldSuffix + (annotatedBundledPairComparisonWord + annotatedCompleteTotalSourceComparison + (firstFieldContents input))) + simpa only [Function.comp_def] using physical + +private def flatAnnotatedSortedDedupEqualityBit + (input : List Bool) : List Bool := + fiveFamilyOriginalHeadBitWord + (encodedOrderingEqualityBitWord + (annotatedSortedDedupSourceOrdering input)) + +private noncomputable def flatAnnotatedSortedDedupEqualityBitComputable : + BitTM + flatAnnotatedSortedDedupEqualityBit := by + have hequality := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSortedDedupSourceOrderingComputable + encodedOrderingEqualityBitComputable + have physical := GapCVP.TMComposition.computableInPolyTime + hequality fiveFamilyOriginalHeadBitComputable + change BitTM + (fun input : List Bool => + fiveFamilyOriginalHeadBitWord + (encodedOrderingEqualityBitWord + (annotatedSortedDedupSourceOrdering input))) + simpa only [Function.comp_def] using physical + +private def annotatedSortedDedupSecondPresence + (input : List Bool) : List Bool := + fiveFamilyOriginalHeadBitWord + (firstFieldSuffix (firstFieldContents input)) + +private noncomputable def flatAnnotatedSortedDedupSecondPresenceComputable : + BitTM + annotatedSortedDedupSecondPresence := by + have hpending := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable firstFieldSuffixComputable + have physical := GapCVP.TMComposition.computableInPolyTime + hpending fiveFamilyOriginalHeadBitComputable + change BitTM + (fun input : List Bool => + fiveFamilyOriginalHeadBitWord + (firstFieldSuffix (firstFieldContents input))) + simpa only [Function.comp_def] using physical + +private def annotatedSortedDedupEqualityQuery + (input : List Bool) : List Bool := + flatAnnotatedSortedDedupEqualityBit input ++ + annotatedSortedDedupSecondPresence input + +private noncomputable def flatAnnotatedSortedDedupEqualityQueryComputable : + BitTM + annotatedSortedDedupEqualityQuery := by + exact pointwiseAppendComputable + flatAnnotatedSortedDedupEqualityBitComputable + flatAnnotatedSortedDedupSecondPresenceComputable + +private def annotatedSortedDedupEffectiveMarker : List Bool → List Bool := + markerConditionalOutput fiveFamilyOriginalHeadBitWord [false] ∘ + annotatedSortedDedupEqualityQuery + +private noncomputable def flatAnnotatedSortedDedupEffectiveMarkerComputable : + BitTM + annotatedSortedDedupEffectiveMarker := by + have hconditional := markerConditionalComputable + fiveFamilyOriginalHeadBitComputable [false] + exact GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSortedDedupEqualityQueryComputable hconditional + +private def flatAnnotatedSortedDedupNextPending + (input : List Bool) : List Bool := + firstFieldSuffix (firstFieldContents input) + +private noncomputable def flatAnnotatedSortedDedupNextPendingComputable : + BitTM + flatAnnotatedSortedDedupNextPending := by + have physical := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable firstFieldSuffixComputable + change BitTM + (fun input : List Bool => + firstFieldSuffix (firstFieldContents input)) + exact physical + +private def flatAnnotatedSortedDedupArchive + (input : List Bool) : List Bool := + firstFieldContents (firstFieldSuffix input) + +private noncomputable def flatAnnotatedSortedDedupArchiveComputable : + BitTM + flatAnnotatedSortedDedupArchive := by + have htail := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + change BitTM + (fun input : List Bool => + firstFieldContents (firstFieldSuffix input)) + exact htail + +private def flatAnnotatedSortedDedupSelected + (input : List Bool) : List Bool := + lengthPrefixedWord + (firstFieldContents (firstFieldContents input)) + +private noncomputable def flatAnnotatedSortedDedupSelectedComputable : + BitTM + flatAnnotatedSortedDedupSelected := by + have hinner := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable firstFieldContentsComputable + have physical := GapCVP.TMComposition.computableInPolyTime + hinner structuralPrefixWriterComputable + change BitTM + (fun input : List Bool => + lengthPrefixedWord + (firstFieldContents (firstFieldContents input))) + simpa only [Function.comp_def] using physical + +private def flatAnnotatedSortedDedupDropStep + (input : List Bool) : List Bool := + flatAnnotatedBubblePassState + (flatAnnotatedSortedDedupNextPending input) + (flatAnnotatedSortedDedupArchive input) + +private noncomputable def flatAnnotatedSortedDedupDropStepComputable : + BitTM + flatAnnotatedSortedDedupDropStep := by + have hpending := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSortedDedupNextPendingComputable + structuralPrefixWriterComputable + have harchive := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSortedDedupArchiveComputable + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable hpending harchive + change BitTM + (fun input : List Bool => + lengthPrefixedWord + (flatAnnotatedSortedDedupNextPending input) ++ + lengthPrefixedWord + (flatAnnotatedSortedDedupArchive input)) + simpa only [Function.comp_def] using physical + +private def flatAnnotatedSortedDedupEmitStep + (input : List Bool) : List Bool := + flatAnnotatedBubblePassState + (flatAnnotatedSortedDedupNextPending input) + (flatAnnotatedSortedDedupArchive input ++ + flatAnnotatedSortedDedupSelected input) + +private noncomputable def flatAnnotatedSortedDedupEmitStepComputable : + BitTM + flatAnnotatedSortedDedupEmitStep := by + have hpending := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSortedDedupNextPendingComputable + structuralPrefixWriterComputable + have harchive := pointwiseAppendComputable + flatAnnotatedSortedDedupArchiveComputable + flatAnnotatedSortedDedupSelectedComputable + have harchivePrefix := GapCVP.TMComposition.computableInPolyTime + harchive structuralPrefixWriterComputable + have physical := pointwiseAppendComputable + hpending harchivePrefix + change BitTM + (fun input : List Bool => + lengthPrefixedWord + (flatAnnotatedSortedDedupNextPending input) ++ + lengthPrefixedWord + (flatAnnotatedSortedDedupArchive input ++ + flatAnnotatedSortedDedupSelected input)) + simpa only [Function.comp_def] using physical + +private def flatAnnotatedSortedDedupShapeTag + (input : List Bool) : List Bool := + annotatedSortedDedupEffectiveMarker input ++ [false] + +private noncomputable def flatAnnotatedSortedDedupShapeTagComputable : + BitTM + flatAnnotatedSortedDedupShapeTag := by + exact pointwiseAppendComputable + flatAnnotatedSortedDedupEffectiveMarkerComputable + (sourceFixedWordComputable [false]) + +private def flatAnnotatedSortedDedupDispatchInput + (input : List Bool) : List Bool := + lengthPrefixedWord (flatAnnotatedSortedDedupShapeTag input) ++ input + +private noncomputable def flatAnnotatedSortedDedupDispatchInputComputable : + BitTM + flatAnnotatedSortedDedupDispatchInput := by + have htag := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSortedDedupShapeTagComputable + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable htag + (Turing.idComputableInPolyTime bitEncoding) + change BitTM + (fun input : List Bool => + lengthPrefixedWord (flatAnnotatedSortedDedupShapeTag input) ++ input) + simpa only [Function.comp_def, id_eq] using physical + +private def flatAnnotatedSortedDedupStep : List Bool → List Bool := + fourFamilyTaggedPredicateMarker + flatAnnotatedSortedDedupEmitStep + (fun _ => []) + flatAnnotatedSortedDedupDropStep + (fun _ => []) ∘ + flatAnnotatedSortedDedupDispatchInput + +private noncomputable def flatAnnotatedSortedDedupStepComputable : + BitTM + flatAnnotatedSortedDedupStep := by + have hdispatch := fourFamilyTaggedPredicateMarkerComputable + flatAnnotatedSortedDedupEmitStepComputable + (sourceFixedWordComputable []) + flatAnnotatedSortedDedupDropStepComputable + (sourceFixedWordComputable []) + exact GapCVP.TMComposition.computableInPolyTime + flatAnnotatedSortedDedupDispatchInputComputable hdispatch + +@[simp] private theorem flatAnnotatedSortedDedupEffectiveMarker_eq + (input : List Bool) : + annotatedSortedDedupEffectiveMarker input = + [((encodedOrderingEqualityBitWord + (annotatedSortedDedupSourceOrdering input)).headD false && + (firstFieldSuffix (firstFieldContents input)).headD false)] := by + unfold annotatedSortedDedupEffectiveMarker + rw [Function.comp_apply] + unfold annotatedSortedDedupEqualityQuery + flatAnnotatedSortedDedupEqualityBit + annotatedSortedDedupSecondPresence + rw [fiveFamilyOriginalHeadBitWord_eq, + fiveFamilyOriginalHeadBitWord_eq] + cases (encodedOrderingEqualityBitWord + (annotatedSortedDedupSourceOrdering input)).headD false <;> + cases (firstFieldSuffix (firstFieldContents input)).headD false <;> + rfl + +private theorem flatAnnotatedSortedDedupStep_eq + (input : List Bool) : + flatAnnotatedSortedDedupStep input = + if (encodedOrderingEqualityBitWord + (annotatedSortedDedupSourceOrdering input)).headD false && + (firstFieldSuffix (firstFieldContents input)).headD false then + flatAnnotatedSortedDedupDropStep input + else flatAnnotatedSortedDedupEmitStep input := by + unfold flatAnnotatedSortedDedupStep + rw [Function.comp_apply] + unfold flatAnnotatedSortedDedupDispatchInput + unfold flatAnnotatedSortedDedupShapeTag + rw [flatAnnotatedSortedDedupEffectiveMarker_eq] + cases hbit : + (encodedOrderingEqualityBitWord + (annotatedSortedDedupSourceOrdering input)).headD false && + (firstFieldSuffix (firstFieldContents input)).headD false with + | false => + simp only [Bool.false_eq_true, ↓reduceIte] + change fourFamilyTaggedPredicateMarker _ _ _ _ + (lengthPrefixedWord [false, false] ++ input) = _ + rw [sourceFourFamilyTaggedPredicateMarker_interpolation] + | true => + simp only [↓reduceIte] + change fourFamilyTaggedPredicateMarker _ _ _ _ + (lengthPrefixedWord [true, false] ++ input) = _ + rw [sourceFourFamilyTaggedPredicateMarker_diagonal] + +private theorem flatAnnotatedSortedDedupDropStep_length_le + (input : List Bool) : + (flatAnnotatedSortedDedupDropStep input).length ≤ + input.length + 2 := by + have hsource := annotatedStructuralTwoFieldAccounting input + have hpending := annotatedStructuralFieldAccounting + (firstFieldContents input) + simp only [flatAnnotatedSortedDedupDropStep, + flatAnnotatedBubblePassState, + flatAnnotatedSortedDedupNextPending, + flatAnnotatedSortedDedupArchive, + List.length_append, lengthPrefixedWord_length] + omega + +private theorem flatAnnotatedSortedDedupEmitStep_length_le + (input : List Bool) : + (flatAnnotatedSortedDedupEmitStep input).length ≤ + input.length + 4 := by + have hsource := annotatedStructuralTwoFieldAccounting input + have hpending := annotatedStructuralFieldAccounting + (firstFieldContents input) + simp only [flatAnnotatedSortedDedupEmitStep, + flatAnnotatedBubblePassState, + flatAnnotatedSortedDedupNextPending, + flatAnnotatedSortedDedupArchive, + flatAnnotatedSortedDedupSelected, + List.length_append, lengthPrefixedWord_length] + omega + +private theorem flatAnnotatedSortedDedupStep_length_le + (input : List Bool) : + (flatAnnotatedSortedDedupStep input).length ≤ + input.length + 4 := by + rw [flatAnnotatedSortedDedupStep_eq] + split + · have hdrop := flatAnnotatedSortedDedupDropStep_length_le input + omega + · exact flatAnnotatedSortedDedupEmitStep_length_le input + +private theorem flatAnnotatedSortedDedupStep_iterate_length_le + (input : List Bool) (count : ℕ) : + (((flatAnnotatedSortedDedupStep)^[count]) input).length ≤ + input.length + 4 * count := by + induction count with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, Std.le_refl] + | succ count ih => + rw [Function.iterate_succ_apply'] + have hstep := flatAnnotatedSortedDedupStep_length_le + (((flatAnnotatedSortedDedupStep)^[count]) input) + omega + +private theorem flatAnnotatedSortedDedup_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + flatAnnotatedSortedDedupStep + (5 * Polynomial.X) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := parsedUnaryFold_seed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate := flatAnnotatedSortedDedupStep_iterate_length_le + seed stage + simp only [Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + omega + +private noncomputable def flatAnnotatedSortedDedupFoldComputable : + BitTM + (boundedRecordFoldOutput flatAnnotatedSortedDedupStep) := + boundedDependentRecordFoldComputable + flatAnnotatedSortedDedupStepComputable + (5 * Polynomial.X) + flatAnnotatedSortedDedup_polynomiallyBoundedFoldStates + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAnnotatedSortedDedupSourceClauseRecord_ne_nil + {T S : ℕ} (clause : Clause T S) : + flatSourceClauseAnnotatedRecord clause ≠ [] := by + intro hrecord + have hlength := congrArg List.length hrecord + simp only [flatSourceClauseAnnotatedRecord, List.append_assoc, List.length_append, + lengthPrefixedWord_length, + flatSourceClauseUnaryCountPayload_length, List.length_nil, Nat.add_eq_zero_iff, mul_eq_zero, + OfNat.ofNat_ne_zero, + List.length_eq_zero_iff, false_or, one_ne_zero, and_false, and_self] at hlength + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatAnnotatedSortedDedupHeadBit_nonemptyPrefix + (record suffix : List Bool) (hrecord : record ≠ []) : + fiveFamilyOriginalHeadBitWord + (lengthPrefixedWord record ++ suffix) = [true] := by + cases record with + | nil => exact False.elim (hrecord rfl) + | cons head tail => + simp only [lengthPrefixedWord, List.length_cons, List.replicate_succ, List.cons_append, + List.append_assoc, + fiveFamilyOriginalHeadBitWord_eq, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] + +private theorem flatAnnotatedSortedDedupSourceOrdering_originalClauseState + {T S : ℕ} (first second : Clause T S) + (remaining emitted : List (Clause T S)) : + annotatedSortedDedupSourceOrdering + (flatAnnotatedBubbleClauseState + (first :: second :: remaining) emitted) = + encodedWordOrderingWord + (flatSortedSourceListOrdering + (flatSourceFinsetCodes first) + (flatSourceFinsetCodes second)) := by + simp only [annotatedSortedDedupSourceOrdering, + flatAnnotatedBubbleClauseState, + flatAnnotatedBubblePassState, + flatAnnotatedBundledClauseStream, + List.flatMap_cons, + firstFieldContents_valid] + unfold annotatedBundledPairComparisonWord + rw [← List.append_assoc, + flatAnnotatedBundledPairComparisonInput_records] + unfold annotatedCompleteTotalSourceComparison + rw [firstFieldSuffix_valid, + flatAnnotatedCompleteOriginalClausePair_records, + flatAnnotatedCompleteTotalOrderingWord_valid] + +@[simp] private theorem flatAnnotatedSortedDedupEqualityBit_originalClauseState + {T S : ℕ} (first second : Clause T S) + (remaining emitted : List (Clause T S)) : + flatAnnotatedSortedDedupEqualityBit + (flatAnnotatedBubbleClauseState + (first :: second :: remaining) emitted) = + [decide (first = second)] := by + unfold flatAnnotatedSortedDedupEqualityBit + rw [flatAnnotatedSortedDedupSourceOrdering_originalClauseState, + encodedOrderingEqualityBitWord_ordering, + fiveFamilyOriginalHeadBitWord_eq] + simp only [List.headD_cons] + simp only [flatSourceFinsetOrdering_equal_iff] + +@[simp] private theorem flatAnnotatedSortedDedupSecondPresence_originalClausePair + {T S : ℕ} (first second : Clause T S) + (remaining emitted : List (Clause T S)) : + annotatedSortedDedupSecondPresence + (flatAnnotatedBubbleClauseState + (first :: second :: remaining) emitted) = [true] := by + unfold annotatedSortedDedupSecondPresence + simp only [flatAnnotatedBubbleClauseState, + flatAnnotatedBubblePassState, + flatAnnotatedBundledClauseStream, + List.flatMap_cons, + firstFieldContents_valid, + flatAnnotatedBundledClauseRecord, + firstFieldSuffix_valid] + exact flatAnnotatedSortedDedupHeadBit_nonemptyPrefix + (flatSourceClauseAnnotatedRecord second) + (remaining.flatMap flatAnnotatedBundledClauseRecord) + (flatAnnotatedSortedDedupSourceClauseRecord_ne_nil second) + +@[simp] private theorem flatAnnotatedSortedDedupSecondPresence_originalSingleton + {T S : ℕ} (first : Clause T S) + (emitted : List (Clause T S)) : + annotatedSortedDedupSecondPresence + (flatAnnotatedBubbleClauseState [first] emitted) = [false] := by + have htail : + firstFieldSuffix + (lengthPrefixedWord + (flatSourceClauseAnnotatedRecord first)) = [] := by + simpa only [List.append_nil] using firstFieldSuffix_valid (flatSourceClauseAnnotatedRecord + first) [] + simp only [annotatedSortedDedupSecondPresence, flatAnnotatedBubbleClauseState, + flatAnnotatedBubblePassState, + flatAnnotatedBundledClauseStream, List.flatMap_cons, flatAnnotatedBundledClauseRecord, + List.flatMap_nil, + List.append_nil, firstFieldContents_valid, htail, fiveFamilyOriginalHeadBitWord_eq, + List.headD_eq_head?_getD, + List.head?_nil, Option.getD_none] + +private theorem flatAnnotatedSortedDedupEffectiveMarker_originalClausePair + {T S : ℕ} (first second : Clause T S) + (remaining emitted : List (Clause T S)) : + annotatedSortedDedupEffectiveMarker + (flatAnnotatedBubbleClauseState + (first :: second :: remaining) emitted) = + [decide (first = second)] := by + unfold annotatedSortedDedupEffectiveMarker + rw [Function.comp_apply] + unfold annotatedSortedDedupEqualityQuery + rw [flatAnnotatedSortedDedupEqualityBit_originalClauseState, + flatAnnotatedSortedDedupSecondPresence_originalClausePair] + by_cases hequal : first = second <;> + simp [hequal, markerConditionalOutput, + fiveFamilyOriginalHeadBitWord_eq] + +private theorem flatAnnotatedSortedDedupEffectiveMarker_originalSingleton + {T S : ℕ} (first : Clause T S) + (emitted : List (Clause T S)) : + annotatedSortedDedupEffectiveMarker + (flatAnnotatedBubbleClauseState [first] emitted) = [false] := by + unfold annotatedSortedDedupEffectiveMarker + rw [Function.comp_apply] + unfold annotatedSortedDedupEqualityQuery + rw [flatAnnotatedSortedDedupSecondPresence_originalSingleton] + unfold flatAnnotatedSortedDedupEqualityBit + rw [fiveFamilyOriginalHeadBitWord_eq] + cases (encodedOrderingEqualityBitWord + (annotatedSortedDedupSourceOrdering + (flatAnnotatedBubbleClauseState [first] emitted))).headD false <;> + rfl + +@[simp] private theorem flatAnnotatedSortedDedupDropStep_originalClauseState + {T S : ℕ} (first : Clause T S) + (remaining emitted : List (Clause T S)) : + flatAnnotatedSortedDedupDropStep + (flatAnnotatedBubbleClauseState + (first :: remaining) emitted) = + flatAnnotatedBubbleClauseState remaining emitted := by + have harchive : + firstFieldContents + (lengthPrefixedWord + (flatAnnotatedBundledClauseStream emitted)) = + flatAnnotatedBundledClauseStream emitted := by + simpa only [List.append_nil] using firstFieldContents_valid (flatAnnotatedBundledClauseStream + emitted) [] + have harchiveFlat : + firstFieldContents + (lengthPrefixedWord + (emitted.flatMap flatAnnotatedBundledClauseRecord)) = + emitted.flatMap flatAnnotatedBundledClauseRecord := by + simpa only [flatAnnotatedBundledClauseStream] using harchive + unfold flatAnnotatedSortedDedupDropStep + flatAnnotatedSortedDedupNextPending + flatAnnotatedSortedDedupArchive + simp only [flatAnnotatedBubbleClauseState, + flatAnnotatedBubblePassState, + flatAnnotatedBundledClauseStream, + List.flatMap_cons, + firstFieldContents_valid, + flatAnnotatedBundledClauseRecord, + firstFieldSuffix_valid] + simp only [harchiveFlat] + +@[simp] private theorem flatAnnotatedSortedDedupEmitStep_originalClauseState + {T S : ℕ} (first : Clause T S) + (remaining emitted : List (Clause T S)) : + flatAnnotatedSortedDedupEmitStep + (flatAnnotatedBubbleClauseState + (first :: remaining) emitted) = + flatAnnotatedBubbleClauseState + remaining (emitted ++ [first]) := by + have harchive : + firstFieldContents + (lengthPrefixedWord + (flatAnnotatedBundledClauseStream emitted)) = + flatAnnotatedBundledClauseStream emitted := by + simpa only [List.append_nil] using firstFieldContents_valid (flatAnnotatedBundledClauseStream + emitted) [] + have harchiveFlat : + firstFieldContents + (lengthPrefixedWord + (emitted.flatMap flatAnnotatedBundledClauseRecord)) = + emitted.flatMap flatAnnotatedBundledClauseRecord := by + simpa only [flatAnnotatedBundledClauseStream] using harchive + unfold flatAnnotatedSortedDedupEmitStep + flatAnnotatedSortedDedupNextPending + flatAnnotatedSortedDedupArchive + flatAnnotatedSortedDedupSelected + simp only [flatAnnotatedBubbleClauseState, + flatAnnotatedBubblePassState, + flatAnnotatedBundledClauseStream, + List.flatMap_cons, + firstFieldContents_valid, + flatAnnotatedBundledClauseRecord, + firstFieldSuffix_valid] + simp only [harchiveFlat, List.flatMap_append, List.flatMap_cons, + flatAnnotatedBundledClauseRecord, + List.flatMap_nil, List.append_nil] + +private theorem flatAnnotatedSortedDedupStep_effective + (input : List Bool) : + flatAnnotatedSortedDedupStep input = + if (annotatedSortedDedupEffectiveMarker input).headD false then + flatAnnotatedSortedDedupDropStep input + else flatAnnotatedSortedDedupEmitStep input := by + rw [flatAnnotatedSortedDedupStep_eq, + flatAnnotatedSortedDedupEffectiveMarker_eq] + rfl + +@[simp] private theorem flatAnnotatedSortedDedupStep_originalClausePair + {T S : ℕ} (first second : Clause T S) + (remaining emitted : List (Clause T S)) : + flatAnnotatedSortedDedupStep + (flatAnnotatedBubbleClauseState + (first :: second :: remaining) emitted) = + if first = second then + flatAnnotatedBubbleClauseState + (second :: remaining) emitted + else + flatAnnotatedBubbleClauseState + (second :: remaining) (emitted ++ [first]) := by + rw [flatAnnotatedSortedDedupStep_effective, + flatAnnotatedSortedDedupEffectiveMarker_originalClausePair] + simp only [List.headD_cons] + by_cases hequal : first = second <;> + simp [hequal] + +@[simp] private theorem flatAnnotatedSortedDedupStep_originalSingleton + {T S : ℕ} (first : Clause T S) + (emitted : List (Clause T S)) : + flatAnnotatedSortedDedupStep + (flatAnnotatedBubbleClauseState [first] emitted) = + flatAnnotatedBubbleClauseState [] (emitted ++ [first]) := by + rw [flatAnnotatedSortedDedupStep_effective, + flatAnnotatedSortedDedupEffectiveMarker_originalSingleton] + simp only [List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, Bool.false_eq_true, + ↓reduceIte, + flatAnnotatedSortedDedupEmitStep_originalClauseState] + +private def flatAnnotatedOriginalSortedDedupAux + {T S : ℕ} (pending emitted : List (Clause T S)) : + List (Clause T S) := + match pending with + | [] => emitted + | [first] => emitted ++ [first] + | first :: second :: remaining => + if first = second then + flatAnnotatedOriginalSortedDedupAux + (second :: remaining) emitted + else + flatAnnotatedOriginalSortedDedupAux + (second :: remaining) (emitted ++ [first]) +termination_by pending.length +decreasing_by + all_goals + simp only [List.length_cons] + omega + +private theorem flatAnnotatedSortedDedupStep_iterate_originalClauseState + {T S : ℕ} (pending emitted : List (Clause T S)) : + (((flatAnnotatedSortedDedupStep)^[pending.length]) + (flatAnnotatedBubbleClauseState pending emitted)) = + flatAnnotatedBubbleClauseState [] + (flatAnnotatedOriginalSortedDedupAux pending emitted) := by + cases pending with + | nil => + simp only [List.length_nil, Function.iterate_zero, id_eq, + flatAnnotatedOriginalSortedDedupAux] + | cons first remaining => + cases remaining with + | nil => + simp only [List.length_cons, List.length_nil, zero_add, Function.iterate_one, + flatAnnotatedSortedDedupStep_originalSingleton, flatAnnotatedOriginalSortedDedupAux] + | cons second tail => + rw [List.length_cons, Function.iterate_succ_apply, + flatAnnotatedSortedDedupStep_originalClausePair] + by_cases hequal : first = second + · simp only [hequal, ↓reduceIte, + flatAnnotatedOriginalSortedDedupAux] + exact flatAnnotatedSortedDedupStep_iterate_originalClauseState + (second :: tail) emitted + · simp only [hequal, ↓reduceIte, + flatAnnotatedOriginalSortedDedupAux] + exact flatAnnotatedSortedDedupStep_iterate_originalClauseState + (second :: tail) (emitted ++ [first]) +termination_by pending.length +decreasing_by + all_goals + simp only [List.length_cons] + omega + +private theorem boundedRecordFoldOutput_flatAnnotatedSortedDedup + {T S : ℕ} (pending emitted : List (Clause T S)) : + boundedRecordFoldOutput flatAnnotatedSortedDedupStep + (unaryBoundedFoldWord pending.length + (flatAnnotatedBubbleClauseState pending emitted)) = + flatAnnotatedBubbleClauseState [] + (flatAnnotatedOriginalSortedDedupAux pending emitted) := by + simp only [boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + exact flatAnnotatedSortedDedupStep_iterate_originalClauseState + pending emitted + +end CNFAnnotatedSourceCompleteSortedDedupTM + +namespace CNFAnnotatedSourceCompleteSortedDedupSourceCert + +open Turing GapCVP.CL GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFiniteRecordSort +open GapCVP.CNFInputDependentRecordSort GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM GapCVP.CNFAnnotatedSourceCompleteBubbleSortTM +open GapCVP.CNFAnnotatedSourceCompleteBubbleSortSourceCert +open GapCVP.CNFAnnotatedSourceCompleteSortedDedupTM + +private theorem flatAnnotatedSortedDistinctHead_not_mem_tail + {T S : ℕ} {first second : Clause T S} + {remaining : List (Clause T S)} + (hordered : (first :: second :: remaining).Pairwise + (fun left right => Encodable.encode left ≤ Encodable.encode right)) + (hdistinct : first ≠ second) : + first ∉ second :: remaining := by + intro hmember + rcases List.mem_cons.mp hmember with hequal | hremaining + · exact hdistinct hequal + · have hforward : Encodable.encode first ≤ Encodable.encode second := + (List.pairwise_cons.mp hordered).1 second (by simp only [List.mem_cons, true_or]) + have hbackward : Encodable.encode second ≤ Encodable.encode first := + (List.pairwise_cons.mp + (List.pairwise_cons.mp hordered).2).1 first hremaining + exact hdistinct + (Encodable.encode_injective (Nat.le_antisymm hforward hbackward)) + +private theorem flatAnnotatedOriginalSortedDedupAux_eq_dedup + {T S : ℕ} (pending emitted : List (Clause T S)) + (hordered : pending.Pairwise + (fun first second => Encodable.encode first ≤ Encodable.encode second)) : + flatAnnotatedOriginalSortedDedupAux pending emitted = + emitted ++ pending.dedup := by + induction pending using List.twoStepInduction generalizing emitted with + | nil => + simp only [flatAnnotatedOriginalSortedDedupAux, List.dedup_nil, List.append_nil] + | singleton first => + simp only [flatAnnotatedOriginalSortedDedupAux, List.not_mem_nil, not_false_eq_true, + List.dedup_cons_of_notMem, List.dedup_nil] + | cons_cons first second remaining _ ih => + have htail : (second :: remaining).Pairwise + (fun left right => + Encodable.encode left ≤ Encodable.encode right) := + (List.pairwise_cons.mp hordered).2 + by_cases hequal : first = second + · subst second + simp only [flatAnnotatedOriginalSortedDedupAux, + ↓reduceIte] + have hduplicate : + (first :: first :: remaining).dedup = + (first :: remaining).dedup := + List.dedup_cons_of_mem (by simp only [List.mem_cons, true_or]) + calc + flatAnnotatedOriginalSortedDedupAux + (first :: remaining) emitted = + emitted ++ (first :: remaining).dedup := + ih first emitted htail + _ = emitted ++ (first :: first :: remaining).dedup := + congrArg (fun records => emitted ++ records) + hduplicate.symm + · have hnot : first ∉ second :: remaining := + flatAnnotatedSortedDistinctHead_not_mem_tail + hordered hequal + simp only [flatAnnotatedOriginalSortedDedupAux, + hequal, ↓reduceIte] + calc + flatAnnotatedOriginalSortedDedupAux + (second :: remaining) (emitted ++ [first]) = + (emitted ++ [first]) ++ + (second :: remaining).dedup := + ih second (emitted ++ [first]) htail + _ = emitted ++ (first :: second :: remaining).dedup := by + rw [List.dedup_cons_of_notMem hnot] + simp only [List.append_assoc, List.cons_append, List.nil_append] + +private theorem flatAnnotatedOriginalSortedDedup_eq_sourceOrderedDistinctRecords + {T S : ℕ} (pending : List (Clause T S)) : + flatAnnotatedOriginalSortedDedupAux + (flatAnnotatedOriginalBubbleSortAux pending []) [] = + sourceOrderedDistinctRecords pending := by + let ordered := flatAnnotatedOriginalBubbleSortAux pending [] + have hordered : ordered.Pairwise + (fun first second => + Encodable.encode first ≤ Encodable.encode second) := + flatAnnotatedOriginalBubbleSort_pairwise pending + have hpermutation : ordered.Perm pending := by + simpa only [List.append_nil] using + flatAnnotatedOriginalBubbleSortAux_perm pending [] + rw [flatAnnotatedOriginalSortedDedupAux_eq_dedup + ordered [] hordered] + simp only [List.nil_append] + symm + apply sourceOrderedDistinctRecords_eq_of_nodup_pairwise + pending ordered.dedup + · intro record + simpa only [List.mem_dedup] using + (hpermutation.mem_iff (a := record)) + · exact List.nodup_dedup ordered + · exact List.Pairwise.sublist + (List.dedup_sublist ordered) hordered + +private def annotatedCompleteSortedDedupPreparedInput + (input : List Bool) : List Bool := + flatAnnotatedCompleteBubbleCount input ++ false :: + flatAnnotatedBubblePassState + (annotatedCompleteBubbleSortedSourceOutput input) [] + +private noncomputable def flatAnnotatedCompleteSortedDedupPreparedInputComputable : + BitTM + annotatedCompleteSortedDedupPreparedInput := by + have hpending := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteBubbleSortedSourceComputable + structuralPrefixWriterComputable + have hstate := pointwiseAppendComputable hpending + (sourceFixedWordComputable (lengthPrefixedWord [])) + have hdelimited := pointwiseAppendComputable + (sourceFixedWordComputable [false]) hstate + have physical := pointwiseAppendComputable + (annotatedSourceFieldAtComputable 1) hdelimited + change BitTM + (fun input : List Bool => + flatAnnotatedSourceFieldAt 1 input ++ + false :: + (lengthPrefixedWord + (annotatedCompleteBubbleSortedSourceOutput input) ++ + lengthPrefixedWord [])) + simpa only [Function.comp_def, + List.cons_append, List.nil_append] using physical + +private def annotatedCompleteSortedDistinctSourceOutput : + List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ + boundedRecordFoldOutput flatAnnotatedSortedDedupStep ∘ + annotatedCompleteSortedDedupPreparedInput + +private noncomputable def flatAnnotatedCompleteSortedDistinctSourceComputable : + BitTM + annotatedCompleteSortedDistinctSourceOutput := by + have hfold := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedCompleteSortedDedupPreparedInputComputable + flatAnnotatedSortedDedupFoldComputable + have htail := GapCVP.TMComposition.computableInPolyTime + hfold firstFieldSuffixComputable + have physical := GapCVP.TMComposition.computableInPolyTime + htail firstFieldContentsComputable + simpa only [annotatedCompleteSortedDistinctSourceOutput, + Function.comp_def] using physical + +@[simp] private theorem flatAnnotatedCompleteSortedDedupPreparedInput_originalClauseState + {T S : ℕ} (pending : List (Clause T S)) : + annotatedCompleteSortedDedupPreparedInput + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream pending) + (List.replicate pending.length true) []) = + unaryBoundedFoldWord + (flatAnnotatedOriginalBubbleSortAux pending []).length + (flatAnnotatedBubbleClauseState + (flatAnnotatedOriginalBubbleSortAux pending []) []) := by + have hlength : + (flatAnnotatedOriginalBubbleSortAux pending []).length = + pending.length := by + simpa only [List.append_nil] using + (flatAnnotatedOriginalBubbleSortAux_perm pending []).length_eq + have hsorted : + annotatedCompleteBubbleSortedSourceOutput + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream pending) + (List.replicate pending.length true) []) = + flatAnnotatedBundledClauseStream + (flatAnnotatedOriginalBubbleSortAux pending []) := by + simpa only [flatAnnotatedBundledClauseStream, List.flatMap_nil] using + flatAnnotatedCompleteBubbleSortedSourceOutput_valid pending [] + simp only [annotatedCompleteSortedDedupPreparedInput, + flatAnnotatedCompleteBubbleSortState_count, + hsorted] + simp only [flatAnnotatedBundledClauseStream, unaryBoundedFoldWord, hlength, + flatAnnotatedBubbleClauseState, + List.flatMap_nil] + +private theorem flatAnnotatedCompleteSortedDistinctSourceOutput_valid + {T S : ℕ} (pending : List (Clause T S)) : + annotatedCompleteSortedDistinctSourceOutput + (annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream pending) + (List.replicate pending.length true) []) = + flatAnnotatedBundledClauseStream + (sourceOrderedDistinctRecords pending) := by + unfold annotatedCompleteSortedDistinctSourceOutput + rw [Function.comp_apply, Function.comp_apply, + Function.comp_apply, + flatAnnotatedCompleteSortedDedupPreparedInput_originalClauseState, + boundedRecordFoldOutput_flatAnnotatedSortedDedup] + have hempty : + flatAnnotatedBundledClauseStream ([] : List (Clause T S)) = + [] := rfl + simp only [flatAnnotatedBubbleClauseState, + flatAnnotatedBubblePassState, hempty, + firstFieldSuffix_valid, + flatAnnotatedOriginalSortedDedup_eq_sourceOrderedDistinctRecords] + simpa only [List.append_nil] using + firstFieldContents_valid + (flatAnnotatedBundledClauseStream + (sourceOrderedDistinctRecords pending)) [] + +end CNFAnnotatedSourceCompleteSortedDedupSourceCert + +namespace CNFFiveFamilyIndependentFiveFamilyPhysicalBundledSourceCert + +open Computability Turing GapCVP.CL GapCVP.CLNondeterminism GapCVP.CLCompleteVerifierSimulation +open GapCVP.CLCellRowBounds GapCVP.CLPaddedAcceptanceCompiler GapCVP.BinaryEncoding +open GapCVP.SourceUniformTuringTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CLStructuralWholeCNFOutputTM GapCVP.CNFFiniteRecordSort +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFAnnotatedSourceClauseBubblePassTM +open GapCVP.CNFAnnotatedSourceCompleteBubbleSortTM +open GapCVP.CNFAnnotatedSourceCompleteSortedDedupSourceCert +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM GapCVP.CNFFiveFamilyFlatIndexedCatalogueTM +open GapCVP.CNFFiveFamilyFlatIndexedRankArithmeticTM GapCVP.CNFFiveFamilyFlatRowMajorCatalogueTM +open GapCVP.CNFFiveFamilyFlatRowMajorAtLeastClauseWorkerTM +open GapCVP.CNFFiveFamilyFlatAcceptanceVariableTM GapCVP.CNFFiveFamilyFlatAcceptanceClauseFoldTM +open GapCVP.CNFFiveFamilyPackedInitialCellDecoderTM +open GapCVP.CNFFiveFamilyIndependentAnchoredFamilyStreamTM +open GapCVP.CNFFiveFamilyIndependentFiveFamilyBundledCatalogueTM +open GapCVP.CNFFiveFamilyIndependentFiveFamilyCatalogueSourceValidity + +private theorem fiveIndependentActualRankBundledStream_valid + (bound count : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (candidate : List Bool → List Bool) + (clauses : Fin (count.eval original.length) → + Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) + (hvalid : ∀ rank : Fin (count.eval original.length), + candidate + (lengthPrefixedWord (List.replicate rank.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original) = + flatSourceClauseAnnotatedRecord (clauses rank)) : + fiveIndependentAnchoredFamilyBundledStreamWord + bound count machine candidate original = + flatAnnotatedBundledClauseStream + ((List.finRange (count.eval original.length)).map clauses) := by + have hfit : ∀ rank : Fin (count.eval original.length), + (candidate + (lengthPrefixedWord (List.replicate rank.val true) ++ + fiveFlatOriginalSourceAnchorWord + bound machine original)).length ≤ + (fiveFlatOriginalSourceAnchorWord + bound machine original).length := by + intro rank + rw [hvalid rank] + exact fiveFamilyActualAnnotatedRecord_fits_originalAnchor + bound machine original (clauses rank) + rw [fiveFamilyIndependentAnchoredFamilyBundledStreamWord_valid + bound count machine candidate original hfit] + unfold fiveIndependentSourceRankWords + flatAnnotatedBundledClauseStream + flatAnnotatedBundledClauseRecord + rw [← List.map_coe_finRange_eq_range] + simp only [List.flatMap_map, List.map_map, Function.comp_def, + hvalid] + +private theorem fiveFamilyIndependentAtLeastBundledStreamWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveIndependentAtLeastBundledStreamWord + bound machine original = + flatAnnotatedBundledClauseStream + (fiveIndependentPhysicalAtLeastSourceClauses + bound machine original) := by + have hphysical := fiveIndependentActualRankBundledStream_valid + bound + (fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine original + (fiveFlatRowMajorAtLeastClauseRecordWord + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1)) + (fun rank => atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank)) + (fiveFamilyIndependentAtLeastRankWorker_valid + bound machine original) + simpa only [fiveIndependentAtLeastBundledStreamWord, + fiveIndependentPhysicalAtLeastSourceClauses, + fiveIndependentSquareGridSlots, + List.map_map, Function.comp_def] using hphysical + +private theorem fiveFamilyIndependentFixedFamilyBundledStream_valid + {α : Type} {T S : ℕ} + (indices : List α) + (stream : α → List Bool → List Bool) + (clauses : α → List (Clause T S)) + (original : List Bool) + (hvalid : ∀ index ∈ indices, + stream index original = + flatAnnotatedBundledClauseStream (clauses index)) : + fiveIndependentFixedFamilyStreamWord + indices stream original = + flatAnnotatedBundledClauseStream + (indices.flatMap clauses) := by + induction indices with + | nil => + rfl + | cons index remaining ih => + have hfirst := hvalid index (by simp only [List.mem_cons, true_or]) + have hremaining := ih (fun next hnext => + hvalid next (by simp only [List.mem_cons, hnext, or_true])) + change stream index original ++ + fiveIndependentFixedFamilyStreamWord + remaining stream original = + flatAnnotatedBundledClauseStream + (clauses index ++ remaining.flatMap clauses) + rw [hfirst, hremaining] + simp only [flatAnnotatedBundledClauseStream, List.flatMap_append] + +private def fiveIndependentPhysicalAtMostFixedPairSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (pair : Symbol (completePhaseSymbolCount machine.tm) × + Symbol (completePhaseSymbolCount machine.tm)) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) := + (fiveIndependentSquareGridSlots + bound machine original).map fun position => + if pair.1 < pair.2 then + atMostOneClause position.1 position.2 pair.1 pair.2 + else + atLeastOneClause position.1 position.2 + +private theorem fiveFamilyIndependentAtMostFixedPairBundledStreamWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (pair : Symbol (completePhaseSymbolCount machine.tm) × + Symbol (completePhaseSymbolCount machine.tm)) : + fiveIndependentAtMostFixedPairBundledStreamWord + bound machine pair original = + flatAnnotatedBundledClauseStream + (fiveIndependentPhysicalAtMostFixedPairSourceClauses + bound machine original pair) := by + have hphysical := fiveIndependentActualRankBundledStream_valid + bound + (fiveFamilyFlatIndexedGridPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine original + (fiveIndependentAtMostFixedPairWorker + (fiveFamilyFlatIndexedGridPolynomial bound machine) + (completePhaseSymbolCount machine.tm + 1) + pair.1.val pair.2.val) + (fun rank => + if pair.1 < pair.2 then + atMostOneClause + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank) + pair.1 pair.2 + else + atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + (fiveFamilyIndependentSquareGridTime + bound machine original rank) + (fiveIndependentSquareGridPosition + bound machine original rank)) + (fiveFamilyIndependentAtMostRankWorker_valid + bound machine original pair) + simpa only [fiveIndependentAtMostFixedPairBundledStreamWord, + fiveIndependentPhysicalAtMostFixedPairSourceClauses, + fiveIndependentSquareGridSlots, + List.map_map, Function.comp_def] using hphysical + +private theorem fiveFamilyIndependentAtMostBundledStreamWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveIndependentAtMostBundledStreamWord + bound machine original = + flatAnnotatedBundledClauseStream + (fiveIndependentPhysicalAtMostSourceClauses + bound machine original) := by + have hphysical := fiveFamilyIndependentFixedFamilyBundledStream_valid + (fiveFamilyRowMajorSymbolPairs + (completePhaseSymbolCount machine.tm)) + (fiveIndependentAtMostFixedPairBundledStreamWord + bound machine) + (fiveIndependentPhysicalAtMostFixedPairSourceClauses + bound machine original) + original + (fun pair _ => + fiveFamilyIndependentAtMostFixedPairBundledStreamWord_valid + bound machine original pair) + have hclauses : + (fiveFamilyRowMajorSymbolPairs + (completePhaseSymbolCount machine.tm)).flatMap + (fiveIndependentPhysicalAtMostFixedPairSourceClauses + bound machine original) = + fiveIndependentPhysicalAtMostSourceClauses + bound machine original := by + rfl + rw [hclauses] at hphysical + exact hphysical + +private theorem fiveFamilyIndependentInitialBundledStreamWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveIndependentInitialBundledStreamWord + bound machine original = + flatAnnotatedBundledClauseStream + (fiveIndependentPhysicalInitialSourceClauses + bound machine original) := by + have hphysical := fiveIndependentActualRankBundledStream_valid + bound (fiveFamilyFlatIndexedGridPolynomial bound machine) + machine original + (fiveFlatWholePackedInitialClauseRecordWord + bound machine) + (fun rank => initialClause + (paddedAcceptancePhaseSpecification + bound machine original).input + (fiveIndependentInitialGridPosition + bound machine original rank)) + (fiveFamilyIndependentInitialRankWorker_valid + bound machine original) + simpa only [fiveIndependentInitialBundledStreamWord, + fiveIndependentPhysicalInitialSourceClauses, + fiveIndependentInitialGridPositions, + List.map_map, Function.comp_def] using hphysical + +private theorem fiveFamilyIndependentAcceptanceBundledStreamWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveIndependentAcceptanceBundledStreamWord + bound machine original = + flatAnnotatedBundledClauseStream + (fiveFamilyRowMajorAcceptanceClauses + (paddedAcceptancePhaseSpecification + bound machine original)) := by + unfold fiveIndependentAcceptanceBundledStreamWord + rw [fiveFamilyFlatWholeAcceptanceClauseRecordWord_valid + bound machine original] + simp only [fiveFamilyVerifierAcceptingSymbol, flatAnnotatedBundledClauseStream, + fiveFamilyRowMajorAcceptanceClauses, paddedAcceptancePhaseSpecification, List.flatMap_cons, + flatAnnotatedBundledClauseRecord, List.flatMap_nil, List.append_nil] + +private def fiveIndependentPhysicalForbiddenFixedTupleSourceClauses + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm)) := + (fiveIndependentForbiddenGridWindows + bound machine original).map fun window => + if paddedAcceptancePhaseSymbolAllowed machine symbols = false + then transitionClause window symbols + else atLeastOneClause window.1.1 window.1.2 + +private theorem fiveFamilyIndependentForbiddenFixedTupleBundledStreamWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) + (symbols : WindowSymbols (completePhaseSymbolCount machine.tm)) : + fiveIndependentForbiddenFixedTupleBundledStreamWord + bound machine symbols original = + flatAnnotatedBundledClauseStream + (fiveIndependentPhysicalForbiddenFixedTupleSourceClauses + bound machine original symbols) := by + have hphysical := fiveIndependentActualRankBundledStream_valid + bound + (nondeterministicTableauDimensionPolynomial bound machine * + fiveFamilyFlatIndexedGridPolynomial bound machine) + machine original + (fiveIndependentForbiddenFixedTupleWorker + bound machine symbols) + (fun rank => + if paddedAcceptancePhaseSymbolAllowed machine symbols = false + then transitionClause + (fiveIndependentForbiddenGridWindow + bound machine original rank) symbols + else atLeastOneClause + (S := completePhaseSymbolCount machine.tm) + (fiveIndependentForbiddenGridWindow + bound machine original rank).1.1 + (fiveIndependentForbiddenGridWindow + bound machine original rank).1.2) + (fiveFamilyIndependentForbiddenRankWorker_valid + bound machine original symbols) + simpa only [fiveIndependentForbiddenFixedTupleBundledStreamWord, + fiveIndependentPhysicalForbiddenFixedTupleSourceClauses, + fiveIndependentForbiddenGridWindows, + List.map_map, Function.comp_def] using hphysical + +private theorem fiveFamilyIndependentForbiddenBundledStreamWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveIndependentForbiddenBundledStreamWord + bound machine original = + flatAnnotatedBundledClauseStream + (fiveIndependentPhysicalForbiddenSourceClauses + bound machine original) := by + have hphysical := fiveFamilyIndependentFixedFamilyBundledStream_valid + (fiveFamilyRowMajorWindowSymbols + (completePhaseSymbolCount machine.tm)) + (fiveIndependentForbiddenFixedTupleBundledStreamWord + bound machine) + (fiveIndependentPhysicalForbiddenFixedTupleSourceClauses + bound machine original) + original + (fun symbols _ => + fiveFamilyIndependentForbiddenFixedTupleBundledStreamWord_valid + bound machine original symbols) + have hclauses : + (fiveFamilyRowMajorWindowSymbols + (completePhaseSymbolCount machine.tm)).flatMap + (fiveIndependentPhysicalForbiddenFixedTupleSourceClauses + bound machine original) = + fiveIndependentPhysicalForbiddenSourceClauses + bound machine original := by + rfl + rw [hclauses] at hphysical + exact hphysical + +private theorem fiveFamilyIndependentActualBundledCatalogueWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveIndependentActualBundledCatalogueWord + bound machine original = + flatAnnotatedBundledClauseStream + (fiveIndependentPhysicalSourceClauses + bound machine original) := by + unfold fiveIndependentActualBundledCatalogueWord + fiveIndependentPhysicalSourceClauses + rw [fiveFamilyIndependentAtLeastBundledStreamWord_valid + bound machine original, + fiveFamilyIndependentAtMostBundledStreamWord_valid + bound machine original, + fiveFamilyIndependentInitialBundledStreamWord_valid + bound machine original, + fiveFamilyIndependentAcceptanceBundledStreamWord_valid + bound machine original, + fiveFamilyIndependentForbiddenBundledStreamWord_valid + bound machine original] + simp only [flatAnnotatedBundledClauseStream, List.flatMap_append] + +private theorem fiveFamilyIndependentPhysicalSourceClauses_length + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + (fiveIndependentPhysicalSourceClauses + bound machine original).length = + (fiveIndependentActualSourceClauseCountPolynomial + bound machine).eval original.length := by + let grid := fiveFamilyFlatIndexedGridPolynomial bound machine + let dimension := nondeterministicTableauDimensionPolynomial + bound machine + let alphabet := completePhaseSymbolCount machine.tm + 1 + have hleast : + (fiveIndependentPhysicalAtLeastSourceClauses + bound machine original).length = + (grid * grid).eval original.length := by + simp only [fiveIndependentPhysicalAtLeastSourceClauses, fiveIndependentSquareGridSlots, + List.map_map, + List.length_map, List.length_finRange, Polynomial.eval_mul, + fiveFamilyFlatIndexedGridPolynomial_eval, grid] + have hmost : + (fiveIndependentPhysicalAtMostSourceClauses + bound machine original).length = + alphabet ^ 2 * (grid * grid).eval original.length := by + simp only [fiveIndependentPhysicalAtMostSourceClauses, fiveIndependentSquareGridSlots, + List.map_map, + List.length_flatMap, List.length_map, List.length_finRange, Polynomial.eval_mul, + fiveFamilyFlatIndexedGridPolynomial_eval, List.map_const', + fiveFamilyRowMajorSymbolPairs_length, pow_two, + List.sum_replicate, smul_eq_mul, alphabet, grid] + have hinitial : + (fiveIndependentPhysicalInitialSourceClauses + bound machine original).length = + grid.eval original.length := by + simp only [fiveIndependentPhysicalInitialSourceClauses, fiveIndependentInitialGridPositions, + List.map_map, List.length_map, List.length_finRange, + fiveFamilyFlatIndexedGridPolynomial_eval, + grid] + have hforbidden : + (fiveIndependentPhysicalForbiddenSourceClauses + bound machine original).length = + alphabet ^ 4 * (dimension * grid).eval original.length := by + simp only [fiveIndependentPhysicalForbiddenSourceClauses, fiveIndependentForbiddenGridWindows, + List.map_map, + List.length_flatMap, List.length_map, List.length_finRange, Polynomial.eval_mul, + fiveFamilyFlatIndexedGridPolynomial_eval, List.map_const', + fiveFamilyRowMajorWindowSymbols_length, + List.sum_replicate, smul_eq_mul, alphabet, dimension, grid] + change + (fiveIndependentPhysicalAtLeastSourceClauses + bound machine original ++ + (fiveIndependentPhysicalAtMostSourceClauses + bound machine original ++ + (fiveIndependentPhysicalInitialSourceClauses + bound machine original ++ + ((fiveFamilyRowMajorAcceptanceClauses + (paddedAcceptancePhaseSpecification + bound machine original) : + List (Clause (rowWidth bound machine original) + (completePhaseSymbolCount machine.tm))) ++ + fiveIndependentPhysicalForbiddenSourceClauses + bound machine original)))).length = _ + rw [List.length_append, List.length_append, + List.length_append, List.length_append, + hleast, hmost, hinitial] + simp only [fiveFamilyRowMajorAcceptanceClauses, + List.length_cons, List.length_nil, Nat.zero_add] + rw [hforbidden] + simp only [Polynomial.eval_mul, fiveFamilyFlatIndexedGridPolynomial_eval, + fiveIndependentActualSourceClauseCountPolynomial, eq_natCast, Nat.cast_pow, Nat.cast_add, + Nat.cast_one, + Polynomial.eval_add, Polynomial.eval_pow, Polynomial.eval_natCast, Nat.cast_id, + Polynomial.eval_one, grid, alphabet, + dimension] + ring + +private def fiveIndependentActualBubbleSortInputWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + annotatedCompleteBubbleSortState + (fiveIndependentActualBundledCatalogueWord + bound machine original) + (fiveIndependentSourceCountWord + (fiveIndependentActualSourceClauseCountPolynomial + bound machine) original) + [] + +private noncomputable def fiveFamilyIndependentActualBubbleSortInputComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentActualBubbleSortInputWord + bound machine) := by + have hpending := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyIndependentActualBundledCatalogueComputable + bound machine) + structuralPrefixWriterComputable + have hcount := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyIndependentSourceCountComputable + (fiveIndependentActualSourceClauseCountPolynomial + bound machine)) + structuralPrefixWriterComputable + have hsuffix := pointwiseAppendComputable hcount + (constantWordComputable (lengthPrefixedWord [])) + have physical := pointwiseAppendComputable hpending hsuffix + have hequality : + (fun original : List Bool => + lengthPrefixedWord + (fiveIndependentActualBundledCatalogueWord + bound machine original) ++ + (lengthPrefixedWord + (fiveIndependentSourceCountWord + (fiveIndependentActualSourceClauseCountPolynomial + bound machine) original) ++ + lengthPrefixedWord [])) = + fiveIndependentActualBubbleSortInputWord + bound machine := by + funext original + simp only [fiveIndependentActualBubbleSortInputWord, annotatedCompleteBubbleSortState, + List.append_assoc] + rw [← hequality] + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyIndependentActualBubbleSortInputWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveIndependentActualBubbleSortInputWord + bound machine original = + annotatedCompleteBubbleSortState + (flatAnnotatedBundledClauseStream + (fiveIndependentPhysicalSourceClauses + bound machine original)) + (List.replicate + (fiveIndependentPhysicalSourceClauses + bound machine original).length true) + [] := by + unfold fiveIndependentActualBubbleSortInputWord + rw [fiveFamilyIndependentActualBundledCatalogueWord_valid + bound machine original] + unfold fiveIndependentSourceCountWord + rw [fiveFamilyIndependentPhysicalSourceClauses_length] + +/-- Internal support shared across GapCVP continuation modules. -/ +def fiveIndependentActualSortedDistinctBundledSourceWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + annotatedCompleteSortedDistinctSourceOutput + (fiveIndependentActualBubbleSortInputWord + bound machine original) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def fiveFamilyIndependentActualSortedDistinctBundledSourceComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveIndependentActualSortedDistinctBundledSourceWord + bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyIndependentActualBubbleSortInputComputable + bound machine) + flatAnnotatedCompleteSortedDistinctSourceComputable + change BitTM + (fun original => annotatedCompleteSortedDistinctSourceOutput + (fiveIndependentActualBubbleSortInputWord + bound machine original)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyIndependentPhysicalSourceClauses_sorted + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + sourceOrderedDistinctRecords + (fiveIndependentPhysicalSourceClauses + bound machine original) = + structuralWholeSourceClauses bound machine original := by + unfold sourceOrderedDistinctRecords structuralWholeSourceClauses + rw [fiveFamilyIndependentPhysicalSourceClauses_toFinset + bound machine original] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem fiveFamilyIndependentActualSortedDistinctBundledSourceWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveIndependentActualSortedDistinctBundledSourceWord + bound machine original = + flatAnnotatedBundledClauseStream + (structuralWholeSourceClauses + bound machine original) := by + unfold fiveIndependentActualSortedDistinctBundledSourceWord + rw [fiveFamilyIndependentActualBubbleSortInputWord_valid + bound machine original] + rw [flatAnnotatedCompleteSortedDistinctSourceOutput_valid] + rw [fiveFamilyIndependentPhysicalSourceClauses_sorted + bound machine original] + +end CNFFiveFamilyIndependentFiveFamilyPhysicalBundledSourceCert + +namespace CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceUniformTuringTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatStructuralRecordWorkerTM +open GapCVP.CNFFlatSourceGridDescriptorTM GapCVP.CNFUnaryPairIndexTM +open GapCVP.CNFPairedSourceGridDescriptorTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM + +/-- GapCVP reduction support. -/ +def flatAnnotatedIndexedORGadgetState + (clauseIndex prefixWord pending active emitted count : List Bool) : + List Bool := + lengthPrefixedWord clauseIndex ++ + lengthPrefixedWord prefixWord ++ + lengthPrefixedWord pending ++ + lengthPrefixedWord active ++ + lengthPrefixedWord emitted ++ + lengthPrefixedWord count + +/-- Internal support shared across GapCVP continuation modules. -/ +def flatIndexedGadgetNegateLeadingBitWord : List Bool → List Bool + | [] => [] + | bit :: remaining => (!bit) :: remaining + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev flatIndexedGadgetNegateLeadingBitMachine : Turing.FinTM2 where + K := Unit + k₀ := () + k₁ := () + Γ _ := Bool + Λ := Unit + main := () + σ := Option Bool + initialState := none + m _ := + .peek () (fun _ inspected => inspected) + (.pop () (fun state _ => state) + (.branch (fun state => state.isSome) + (.push () (fun state => !(state.getD false)) + (.load (fun _ => none) .halt)) + (.load (fun _ => none) .halt))) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem flatIndexedGadgetNegateLeadingBitMachine_step + (input : List Bool) : + flatIndexedGadgetNegateLeadingBitMachine.step + (Turing.initList flatIndexedGadgetNegateLeadingBitMachine input) = + some (Turing.haltList flatIndexedGadgetNegateLeadingBitMachine + (flatIndexedGadgetNegateLeadingBitWord input)) := by + cases input with + | nil => + simp only [flatIndexedGadgetNegateLeadingBitMachine, FinTM2.step, TM2.step, initList, + ↓reduceDIte, + eq_mpr_eq_cast, cast_eq, TM2.stepAux, List.head?_nil, Option.isSome_none, List.tail_nil, + Function.update_eq_self, + Option.getD_none, Bool.not_false, Function.update_self, Bool.cond_false, haltList, + flatIndexedGadgetNegateLeadingBitWord] + rfl + | cons bit remaining => + cases bit <;> + simp [flatIndexedGadgetNegateLeadingBitMachine, + flatIndexedGadgetNegateLeadingBitWord, Turing.initList, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] + <;> congr 2 + +end CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part08D.lean b/LeanPool/GapCVP/Part08D.lean new file mode 100644 index 000000000..ef4ee69e6 --- /dev/null +++ b/LeanPool/GapCVP/Part08D.lean @@ -0,0 +1,5839 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part08C + +/-! # GapCVP proof, part 08, continuation 04 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction + +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceUniformTuringTM + +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatStructuralRecordWorkerTM + +open GapCVP.CNFFlatSourceGridDescriptorTM GapCVP.CNFUnaryPairIndexTM + +open GapCVP.CNFPairedSourceGridDescriptorTM GapCVP.CNFFlatPhysicalBinaryAppendTM + +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM + +private noncomputable def flatIndexedGadgetNegateLeadingBitComputable : + BitTM + flatIndexedGadgetNegateLeadingBitWord where + tm := flatIndexedGadgetNegateLeadingBitMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 1 + outputsFun input := { + steps := 1 + evals_in_steps := by + rw [Function.iterate_one, Option.bind_eq_bind] + simp only [flip] + rw [Option.bind_some] + simpa only [FinTM2.step, Equiv.invFun_as_coe, Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, + Option.map_some] using + flatIndexedGadgetNegateLeadingBitMachine_step input + steps_le_m := by simp only [id_eq, Polynomial.eval_one, Std.le_refl] + } + +private def flatIndexedGadgetSourcePayloadWord + (state : List Bool) : List Bool := + firstFieldContents (flatAnnotatedSourceFieldAt 3 state) + +private noncomputable def flatIndexedGadgetSourcePayloadComputable : + BitTM + flatIndexedGadgetSourcePayloadWord := by + have physical := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 3) + firstFieldContentsComputable + change BitTM + (fun state : List Bool => + firstFieldContents (flatAnnotatedSourceFieldAt 3 state)) + simpa only [Function.comp_def] using physical + +private def flatIndexedGadgetSourceDescriptorWord + (negated : Bool) (state : List Bool) : List Bool := + lengthPrefixedWord + (if negated then + flatIndexedGadgetNegateLeadingBitWord + (flatIndexedGadgetSourcePayloadWord state) + else + flatIndexedGadgetSourcePayloadWord state) + +private noncomputable def flatIndexedGadgetSourceDescriptorComputable + (negated : Bool) : + BitTM + (flatIndexedGadgetSourceDescriptorWord negated) := by + cases negated with + | false => + have physical := GapCVP.TMComposition.computableInPolyTime + flatIndexedGadgetSourcePayloadComputable + structuralPrefixWriterComputable + change BitTM + (fun state : List Bool => + lengthPrefixedWord (flatIndexedGadgetSourcePayloadWord state)) + simpa only [Function.comp_def] using physical + | true => + have negate := GapCVP.TMComposition.computableInPolyTime + flatIndexedGadgetSourcePayloadComputable + flatIndexedGadgetNegateLeadingBitComputable + have physical := GapCVP.TMComposition.computableInPolyTime + negate structuralPrefixWriterComputable + change BitTM + (fun state : List Bool => lengthPrefixedWord + (flatIndexedGadgetNegateLeadingBitWord + (flatIndexedGadgetSourcePayloadWord state))) + simpa only [Function.comp_def] using physical + +private def flatIndexedGadgetAccumulatorPairWord + (next : Bool) (state : List Bool) : List Bool := + (flatAnnotatedSourceFieldAt 0 state ++ [false]) ++ + ((if next then flatAnnotatedSourceFieldAt 1 state + else (flatAnnotatedSourceFieldAt 1 state).tail) ++ [false]) + +private noncomputable def flatIndexedGadgetAccumulatorPairComputable + (next : Bool) : + BitTM + (flatIndexedGadgetAccumulatorPairWord next) := by + have first := pointwiseAppendComputable + (annotatedSourceFieldAtComputable 0) + (constantWordComputable [false]) + cases next with + | false => + have predecessor := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 1) + dropHeadComputable + have second := pointwiseAppendComputable + predecessor (constantWordComputable [false]) + have physical := pointwiseAppendComputable first second + change BitTM + (fun state : List Bool => + (flatAnnotatedSourceFieldAt 0 state ++ [false]) ++ + ((flatAnnotatedSourceFieldAt 1 state).tail ++ [false])) + simpa only [Function.comp_def] using physical + | true => + have second := pointwiseAppendComputable + (annotatedSourceFieldAtComputable 1) + (constantWordComputable [false]) + have physical := pointwiseAppendComputable first second + change BitTM + (fun state : List Bool => + (flatAnnotatedSourceFieldAt 0 state ++ [false]) ++ + (flatAnnotatedSourceFieldAt 1 state ++ [false])) + simpa only [Function.comp_def] using physical + +private def flatIndexedGadgetAccumulatorDescriptorWord + (next sign : Bool) (state : List Bool) : List Bool := + pairedAccumulatorSignedLiteralDescriptorWord sign + (flatIndexedGadgetAccumulatorPairWord next state) + +private noncomputable def flatIndexedGadgetAccumulatorDescriptorComputable + (next sign : Bool) : + BitTM + (flatIndexedGadgetAccumulatorDescriptorWord next sign) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (flatIndexedGadgetAccumulatorPairComputable next) + (pairedAccumulatorSignedLiteralDescriptorComputable sign) + change BitTM + (fun state : List Bool => + pairedAccumulatorSignedLiteralDescriptorWord sign + (flatIndexedGadgetAccumulatorPairWord next state)) + simpa only [Function.comp_def] using physical + +private def flatIndexedGadgetPaddingDescriptorWord + (which : Bool) (sign : Bool) (state : List Bool) : List Bool := + paddingSignedLiteralDescriptorWord + (if which then 3 else 2) + sign state + +private noncomputable def flatIndexedGadgetPaddingDescriptorComputable + (which sign : Bool) : + BitTM + (flatIndexedGadgetPaddingDescriptorWord which sign) := by + exact paddingSignedLiteralDescriptorComputable + (if which then 3 else 2) sign + +private def flatIndexedGadgetThreeDescriptorWord + (first second third : List Bool → List Bool) + (state : List Bool) : List Bool := + first state ++ second state ++ third state + +private noncomputable def flatIndexedGadgetThreeDescriptorComputable + {first second third : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) + (hthird : BitTM third) : + BitTM + (flatIndexedGadgetThreeDescriptorWord first second third) := by + have tail := pointwiseAppendComputable hsecond hthird + have physical := pointwiseAppendComputable hfirst tail + change BitTM + (fun state : List Bool => + first state ++ second state ++ third state) + simpa only [List.append_assoc] using physical + +private def flatIndexedSourceORGadgetDescriptorWord + (state : List Bool) : List Bool := + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetSourceDescriptorWord true) + (flatIndexedGadgetAccumulatorDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord false true) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetSourceDescriptorWord true) + (flatIndexedGadgetAccumulatorDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord false false) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord true false) + (flatIndexedGadgetAccumulatorDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord false true) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord true false) + (flatIndexedGadgetAccumulatorDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord false false) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetSourceDescriptorWord false) + (flatIndexedGadgetAccumulatorDescriptorWord true true) + (flatIndexedGadgetAccumulatorDescriptorWord false false) state + +private noncomputable def flatIndexedSourceORGadgetDescriptorComputable : + BitTM + flatIndexedSourceORGadgetDescriptorWord := by + have hsource := flatIndexedGadgetSourceDescriptorComputable false + have hnegative := flatIndexedGadgetSourceDescriptorComputable true + have hcurrent := flatIndexedGadgetAccumulatorDescriptorComputable + false true + have hcurrentNegative := flatIndexedGadgetAccumulatorDescriptorComputable + false false + have hnext := flatIndexedGadgetAccumulatorDescriptorComputable true true + have hnextNegative := + flatIndexedGadgetAccumulatorDescriptorComputable true false + have hpadTrue := flatIndexedGadgetPaddingDescriptorComputable + false true + have hpadFalse := flatIndexedGadgetPaddingDescriptorComputable + false false + have hfirst := flatIndexedGadgetThreeDescriptorComputable + hnegative hcurrent hpadTrue + have hsecond := flatIndexedGadgetThreeDescriptorComputable + hnegative hcurrent hpadFalse + have hthird := flatIndexedGadgetThreeDescriptorComputable + hnextNegative hcurrent hpadTrue + have hfourth := flatIndexedGadgetThreeDescriptorComputable + hnextNegative hcurrent hpadFalse + have hfifth := flatIndexedGadgetThreeDescriptorComputable + hsource hnext hcurrentNegative + have physical := pointwiseAppendComputable hfirst + (pointwiseAppendComputable hsecond + (pointwiseAppendComputable hthird + (pointwiseAppendComputable hfourth hfifth))) + change BitTM + (fun state : List Bool => + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetSourceDescriptorWord true) + (flatIndexedGadgetAccumulatorDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord false true) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetSourceDescriptorWord true) + (flatIndexedGadgetAccumulatorDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord false false) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord true false) + (flatIndexedGadgetAccumulatorDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord false true) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord true false) + (flatIndexedGadgetAccumulatorDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord false false) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetSourceDescriptorWord false) + (flatIndexedGadgetAccumulatorDescriptorWord true true) + (flatIndexedGadgetAccumulatorDescriptorWord false false) state) + simpa only [List.append_assoc] using physical + +private def flatIndexedSourceORPaddingDescriptorWord + (sign : Bool) (state : List Bool) : List Bool := + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord false sign) + (flatIndexedGadgetPaddingDescriptorWord false false) + (flatIndexedGadgetPaddingDescriptorWord true false) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord false sign) + (flatIndexedGadgetPaddingDescriptorWord false false) + (flatIndexedGadgetPaddingDescriptorWord true true) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord false sign) + (flatIndexedGadgetPaddingDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord true false) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord false sign) + (flatIndexedGadgetPaddingDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord true true) state + +private noncomputable def flatIndexedSourceORPaddingDescriptorComputable + (sign : Bool) : + BitTM + (flatIndexedSourceORPaddingDescriptorWord sign) := by + have haccumulator := flatIndexedGadgetAccumulatorDescriptorComputable + false sign + have hzeroFalse := flatIndexedGadgetPaddingDescriptorComputable + false false + have hzeroTrue := flatIndexedGadgetPaddingDescriptorComputable + false true + have honeFalse := flatIndexedGadgetPaddingDescriptorComputable + true false + have honeTrue := flatIndexedGadgetPaddingDescriptorComputable + true true + have hfirst := flatIndexedGadgetThreeDescriptorComputable + haccumulator hzeroFalse honeFalse + have hsecond := flatIndexedGadgetThreeDescriptorComputable + haccumulator hzeroFalse honeTrue + have hthird := flatIndexedGadgetThreeDescriptorComputable + haccumulator hzeroTrue honeFalse + have hfourth := flatIndexedGadgetThreeDescriptorComputable + haccumulator hzeroTrue honeTrue + have physical := pointwiseAppendComputable hfirst + (pointwiseAppendComputable hsecond + (pointwiseAppendComputable hthird hfourth)) + change BitTM + (fun state : List Bool => + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord false sign) + (flatIndexedGadgetPaddingDescriptorWord false false) + (flatIndexedGadgetPaddingDescriptorWord true false) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord false sign) + (flatIndexedGadgetPaddingDescriptorWord false false) + (flatIndexedGadgetPaddingDescriptorWord true true) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord false sign) + (flatIndexedGadgetPaddingDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord true false) state ++ + flatIndexedGadgetThreeDescriptorWord + (flatIndexedGadgetAccumulatorDescriptorWord false sign) + (flatIndexedGadgetPaddingDescriptorWord false true) + (flatIndexedGadgetPaddingDescriptorWord true true) state) + simpa only [List.append_assoc] using physical + +@[simp] private theorem flatIndexedGadgetAccumulatorDescriptorWord_valid + (clauseIndex prefixIndex : ℕ) + (pending active emitted count : List Bool) + (next sign : Bool) : + flatIndexedGadgetAccumulatorDescriptorWord next sign + (flatAnnotatedIndexedORGadgetState + (List.replicate clauseIndex true) + (List.replicate (prefixIndex + 1) true) + pending active emitted count) = + flatSignedLiteralDescriptor + (accumulatorVariable clauseIndex + (if next then prefixIndex + 1 else prefixIndex), sign) := by + cases next with + | false => + simpa only [flatIndexedGadgetAccumulatorDescriptorWord, flatIndexedGadgetAccumulatorPairWord, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + flatAnnotatedIndexedORGadgetState, List.replicate_succ, + List.append_assoc, Function.iterate_zero, id_eq, firstFieldContents_valid, + Bool.false_eq_true, ↓reduceIte, + Function.iterate_one, firstFieldSuffix_valid, List.tail_cons, List.cons_append, + List.nil_append, + unarySourcePairWord] using (pairedAccumulatorSignedLiteralDescriptorWord_pair clauseIndex + prefixIndex sign) + | true => + simpa only [flatIndexedGadgetAccumulatorDescriptorWord, flatIndexedGadgetAccumulatorPairWord, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + flatAnnotatedIndexedORGadgetState, List.replicate_succ, + List.append_assoc, Function.iterate_zero, id_eq, firstFieldContents_valid, ↓reduceIte, + Function.iterate_one, + firstFieldSuffix_valid, List.cons_append, List.nil_append, unarySourcePairWord] using + (pairedAccumulatorSignedLiteralDescriptorWord_pair clauseIndex (prefixIndex + 1) sign) + +@[simp] private theorem flatIndexedGadgetAccumulatorDescriptorWord_valid_initial + (clauseIndex : ℕ) + (pending active emitted count : List Bool) + (sign : Bool) : + flatIndexedGadgetAccumulatorDescriptorWord false sign + (flatAnnotatedIndexedORGadgetState + (List.replicate clauseIndex true) + [] pending active emitted count) = + flatSignedLiteralDescriptor + (accumulatorVariable clauseIndex 0, sign) := by + simpa only [flatIndexedGadgetAccumulatorDescriptorWord, flatIndexedGadgetAccumulatorPairWord, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, flatAnnotatedIndexedORGadgetState, + List.append_assoc, + Function.iterate_zero, id_eq, firstFieldContents_valid, Bool.false_eq_true, ↓reduceIte, + Function.iterate_one, + firstFieldSuffix_valid, List.tail_nil, List.nil_append, List.cons_append, + unarySourcePairWord, + List.replicate_zero] using (pairedAccumulatorSignedLiteralDescriptorWord_pair clauseIndex 0 + sign) + +@[simp] private theorem flatIndexedGadgetSourceDescriptorWord_valid + (literal : Literal) + (clauseIndex prefixWord pending remaining emitted count : List Bool) + (negated : Bool) : + flatIndexedGadgetSourceDescriptorWord negated + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending + (flatSignedLiteralDescriptor literal ++ remaining) + emitted count) = + flatSignedLiteralDescriptor + (if negated then negate literal else literal) := by + rcases literal with ⟨index, sign⟩ + cases negated <;> cases sign <;> + simp [flatIndexedGadgetSourceDescriptorWord, + flatIndexedGadgetSourcePayloadWord, + flatIndexedGadgetNegateLeadingBitWord, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + flatAnnotatedIndexedORGadgetState, + flatSignedLiteralDescriptor, negate, + Function.iterate_succ_apply', List.append_assoc] + +private theorem flatIndexedSourceORGadgetDescriptorWord_valid + (clauseIndex prefixIndex : ℕ) (literal : Literal) + (pending remaining emitted count : List Bool) : + flatIndexedSourceORGadgetDescriptorWord + (flatAnnotatedIndexedORGadgetState + (List.replicate clauseIndex true) + (List.replicate (prefixIndex + 1) true) + pending (flatSignedLiteralDescriptor literal ++ remaining) + emitted count) = + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals + (orGate literal + (accumulatorLiteral clauseIndex (prefixIndex + 1) true) + (accumulatorLiteral clauseIndex prefixIndex true))) := by + simp only [flatIndexedSourceORGadgetDescriptorWord, flatIndexedGadgetThreeDescriptorWord, + flatIndexedGadgetSourceDescriptorWord_valid, ↓reduceIte, negate, + flatIndexedGadgetAccumulatorDescriptorWord_valid, + Bool.false_eq_true, flatIndexedGadgetPaddingDescriptorWord, + paddingSignedLiteralDescriptorWord_eq, + List.append_assoc, flatSignedLiteralDescriptorStream, flatThreeClauseLiterals, Fin.isValue, + orGate, paddedBinary, + triple, accumulatorLiteral, Bool.not_true, List.cons_append, List.nil_append, + List.flatMap_cons, + Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, List.flatMap_nil, + List.append_nil] + +private theorem flatIndexedSourceORPaddingDescriptorWord_valid + (clauseIndex prefixIndex : ℕ) (sign : Bool) + (pending active emitted count : List Bool) : + flatIndexedSourceORPaddingDescriptorWord sign + (flatAnnotatedIndexedORGadgetState + (List.replicate clauseIndex true) + (List.replicate (prefixIndex + 1) true) + pending active emitted count) = + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals + (paddedUnary + (accumulatorLiteral clauseIndex prefixIndex sign))) := by + simp only [flatIndexedSourceORPaddingDescriptorWord, flatIndexedGadgetThreeDescriptorWord, + flatIndexedGadgetAccumulatorDescriptorWord_valid, Bool.false_eq_true, ↓reduceIte, + flatIndexedGadgetPaddingDescriptorWord, paddingSignedLiteralDescriptorWord_eq, + List.append_assoc, + flatSignedLiteralDescriptorStream, flatThreeClauseLiterals, Fin.isValue, paddedUnary, triple, + accumulatorLiteral, + List.flatMap_cons, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, + List.flatMap_nil, List.append_nil, + List.cons_append, List.nil_append] + +private theorem flatIndexedSourceORPaddingDescriptorWord_valid_initial + (clauseIndex : ℕ) (sign : Bool) + (pending active emitted count : List Bool) : + flatIndexedSourceORPaddingDescriptorWord sign + (flatAnnotatedIndexedORGadgetState + (List.replicate clauseIndex true) + [] pending active emitted count) = + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals + (paddedUnary (accumulatorLiteral clauseIndex 0 sign))) := by + simp only [flatIndexedSourceORPaddingDescriptorWord, flatIndexedGadgetThreeDescriptorWord, + flatIndexedGadgetAccumulatorDescriptorWord_valid_initial, + flatIndexedGadgetPaddingDescriptorWord, + Bool.false_eq_true, ↓reduceIte, paddingSignedLiteralDescriptorWord_eq, List.append_assoc, + flatSignedLiteralDescriptorStream, flatThreeClauseLiterals, Fin.isValue, paddedUnary, triple, + accumulatorLiteral, + List.flatMap_cons, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, + List.flatMap_nil, List.append_nil, + List.cons_append, List.nil_append] + +end CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM + +namespace CNFGuardedSourceDescriptorCompositeFoldTM + +open Computability Turing GapCVP.CLVerifier GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction +open GapCVP.CNFFlatStructuralRecordWorkerTM + +private theorem guardedSourcePair_le_quadratic + (first second : ℕ) : + Nat.pair first second ≤ + (first + second) * (first + second) + (first + second) := by + unfold Nat.pair + split <;> nlinarith + +private theorem guardedSourcePair_quadratic_lt_two_pow + (count : ℕ) : + 4 * (count * count + count) + 1 < + 2 ^ ((count + 12) / 2) := by + induction count using Nat.strong_induction_on with + | h count ih => + by_cases hsmall : count < 7 + · interval_cases count <;> norm_num + · have hcount : 7 ≤ count := by omega + let previous := count - 2 + have hprevious : 5 ≤ previous := by + dsimp [previous] + omega + have hlt : previous < count := by + dsimp [previous] + omega + have hinduction := ih previous hlt + have hproduct : 5 * previous ≤ previous * previous := by + have hmul := Nat.mul_le_mul_right previous hprevious + simpa only [Nat.mul_comm, ge_iff_le] using hmul + have hquadratic : + 4 * ((previous + 2) * (previous + 2) + + (previous + 2)) + 1 ≤ + 2 * (4 * (previous * previous + previous) + 1) := by + linarith + have hdiv : + (previous + 2 + 12) / 2 = + (previous + 12) / 2 + 1 := by + omega + have hexponent : + 2 ^ ((previous + 2 + 12) / 2) = + 2 * 2 ^ ((previous + 12) / 2) := by + rw [hdiv, pow_succ] + omega + have hrecover : count = previous + 2 := by + dsimp [previous] + omega + rw [hrecover, hexponent] + omega + +private theorem guardedSourcePair_size_le + (first second : ℕ) : + Nat.size (4 * Nat.pair first second + 1) ≤ + (first + second + 12) / 2 := by + apply Nat.size_le.mpr + have hpair := guardedSourcePair_le_quadratic first second + have hexponent := guardedSourcePair_quadratic_lt_two_pow + (first + second) + omega + +private theorem guardedSourceAccumulatorDescriptor_length_le + (first second : ℕ) (sign : Bool) : + (flatSignedLiteralDescriptor + (accumulatorVariable first second, sign)).length ≤ + first + second + 15 := by + have hsize := guardedSourcePair_size_le first second + change (lengthPrefixedWord + (sign :: Computability.encodeNat + (4 * Nat.pair first second + 1))).length ≤ _ + simp only [lengthPrefixedWord_length, + List.length_cons, encodeNat_length_eq_size] + omega + +end CNFGuardedSourceDescriptorCompositeFoldTM + +namespace CNFFiveFamilySourceIndexedORGadgetFoldCoreTM + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.CNFFiveFamilyForbiddenWindowCoordinateTM +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceFourFamilyTaggedPredicateDispatchTM +open GapCVP.CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM + +/-- GapCVP reduction support. -/ +def flatAnnotatedIndexedORGadgetState + (clauseIndex prefixWord pending active emitted count : List Bool) : + List Bool := + lengthPrefixedWord clauseIndex ++ + lengthPrefixedWord prefixWord ++ + lengthPrefixedWord pending ++ + lengthPrefixedWord active ++ + lengthPrefixedWord emitted ++ + lengthPrefixedWord count + +@[simp] private theorem flatAnnotatedIndexedORGadgetState_field_zero + (clauseIndex prefixWord pending active emitted count : List Bool) : + flatAnnotatedSourceFieldAt 0 + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = + clauseIndex := by + simp only [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + flatAnnotatedIndexedORGadgetState, + List.append_assoc, Function.iterate_zero, id_eq, firstFieldContents_valid] + +@[simp] private theorem flatAnnotatedIndexedORGadgetState_field_one + (clauseIndex prefixWord pending active emitted count : List Bool) : + flatAnnotatedSourceFieldAt 1 + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = + prefixWord := by + simp only [flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + flatAnnotatedIndexedORGadgetState, + List.append_assoc, Function.iterate_one, firstFieldSuffix_valid, firstFieldContents_valid] + +@[simp] private theorem flatAnnotatedIndexedORGadgetState_field_two + (clauseIndex prefixWord pending active emitted count : List Bool) : + flatAnnotatedSourceFieldAt 2 + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = + pending := by + simp [flatAnnotatedIndexedORGadgetState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', List.append_assoc] + +@[simp] private theorem flatAnnotatedIndexedORGadgetState_field_three + (clauseIndex prefixWord pending active emitted count : List Bool) : + flatAnnotatedSourceFieldAt 3 + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = + active := by + simp [flatAnnotatedIndexedORGadgetState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', List.append_assoc] + +@[simp] private theorem flatAnnotatedIndexedORGadgetState_field_four + (clauseIndex prefixWord pending active emitted count : List Bool) : + flatAnnotatedSourceFieldAt 4 + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = + emitted := by + simp [flatAnnotatedIndexedORGadgetState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', List.append_assoc] + +@[simp] private theorem flatAnnotatedIndexedORGadgetState_field_five + (clauseIndex prefixWord pending active emitted count : List Bool) : + flatAnnotatedSourceFieldAt 5 + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = + count := by + simpa [flatAnnotatedIndexedORGadgetState, + flatAnnotatedSourceFieldAt, flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', List.append_assoc] using + (firstFieldContents_valid count []) + +@[simp] private theorem flatAnnotatedIndexedORGadgetState_length + (clauseIndex prefixWord pending active emitted count : List Bool) : + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count).length = + 2 * (clauseIndex.length + prefixWord.length + pending.length + + active.length + emitted.length + count.length) + 6 := by + simp only [flatAnnotatedIndexedORGadgetState, List.append_assoc, List.length_append, + lengthPrefixedWord_length] + omega + +private noncomputable def orGadgetPrefixedComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (fun input => lengthPrefixedWord (worker input)) := + GapCVP.TMComposition.computableInPolyTime + computer structuralPrefixWriterComputable + +private noncomputable def orGadgetStateComputable + {clauseIndex prefixWord pending active emitted count : List Bool → List Bool} + (hclause : BitTM clauseIndex) + (hprefix : BitTM prefixWord) + (hpending : BitTM pending) + (hactive : BitTM active) + (hemitted : BitTM emitted) + (hcount : BitTM count) : + BitTM + (fun input => flatAnnotatedIndexedORGadgetState + (clauseIndex input) (prefixWord input) (pending input) + (active input) (emitted input) (count input)) := by + have hlast := pointwiseAppendComputable + (orGadgetPrefixedComputable hemitted) + (orGadgetPrefixedComputable hcount) + have hfour := pointwiseAppendComputable + (orGadgetPrefixedComputable hactive) hlast + have hthree := pointwiseAppendComputable + (orGadgetPrefixedComputable hpending) hfour + have htwo := pointwiseAppendComputable + (orGadgetPrefixedComputable hprefix) hthree + have physical := pointwiseAppendComputable + (orGadgetPrefixedComputable hclause) htwo + change BitTM + (fun input => + lengthPrefixedWord (clauseIndex input) ++ + lengthPrefixedWord (prefixWord input) ++ + lengthPrefixedWord (pending input) ++ + lengthPrefixedWord (active input) ++ + lengthPrefixedWord (emitted input) ++ + lengthPrefixedWord (count input)) + simpa only [List.append_assoc] using physical + +private def orGadgetInitialState + (input : List Bool) : List Bool := + flatAnnotatedIndexedORGadgetState [] [] input [] [] [] + +private noncomputable def flatAnnotatedIndexedORGadgetInitialStateComputable : + BitTM + orGadgetInitialState := by + exact orGadgetStateComputable + (sourceFixedWordComputable []) + (sourceFixedWordComputable []) + (Turing.idComputableInPolyTime bitEncoding) + (sourceFixedWordComputable []) + (sourceFixedWordComputable []) + (sourceFixedWordComputable []) + +private def orGadgetFieldHeadMarker + (offset : ℕ) (input : List Bool) : List Bool := + fiveFamilyOriginalHeadBitWord + (flatAnnotatedSourceFieldAt offset input) + +private noncomputable def orGadgetFieldHeadComputable + (offset : ℕ) : + BitTM + (orGadgetFieldHeadMarker offset) := by + exact GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable offset) + fiveFamilyOriginalHeadBitComputable + +private def orGadgetBooleanOr + (first second : List Bool → List Bool) : List Bool → List Bool := + sourceFourFamilyBooleanOrOutput first second + +private noncomputable def flatAnnotatedIndexedORGadgetBooleanOrComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (orGadgetBooleanOr first second) := + sourceFourFamilyBooleanOrComputable hfirst hsecond + +private theorem flatAnnotatedIndexedORGadgetBooleanOr_bits + (first second : List Bool → List Bool) + (input : List Bool) (firstBit secondBit : Bool) + (hfirst : first input = [firstBit]) + (hsecond : second input = [secondBit]) : + orGadgetBooleanOr first second input = + [firstBit || secondBit] := + fourFamilyBooleanOrOutput_bits first second input firstBit secondBit + hfirst hsecond + +private def flatAnnotatedIndexedORGadgetDispatchChoice : List Bool → List Bool := + orGadgetBooleanOr + (sourceFourFamilyBooleanAndOutput + (orGadgetFieldHeadMarker 1) + (orGadgetFieldHeadMarker 3)) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + (orGadgetFieldHeadMarker 1)) + (orGadgetFieldHeadMarker 2)) + +private noncomputable def flatAnnotatedIndexedORGadgetDispatchChoiceComputable : + BitTM + flatAnnotatedIndexedORGadgetDispatchChoice := by + have hprefix := orGadgetFieldHeadComputable 1 + exact flatAnnotatedIndexedORGadgetBooleanOrComputable + (fourFamilyBooleanAndComputable hprefix + (orGadgetFieldHeadComputable 3)) + (fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable hprefix) + (orGadgetFieldHeadComputable 2)) + +private def orGadgetDispatchTag + (input : List Bool) : List Bool := + orGadgetFieldHeadMarker 1 input ++ + flatAnnotatedIndexedORGadgetDispatchChoice input + +private noncomputable def flatAnnotatedIndexedORGadgetDispatchTagComputable : + BitTM + orGadgetDispatchTag := by + exact pointwiseAppendComputable + (orGadgetFieldHeadComputable 1) + flatAnnotatedIndexedORGadgetDispatchChoiceComputable + +private def flatAnnotatedIndexedORGadgetDispatchInput + (input : List Bool) : List Bool := + lengthPrefixedWord + (orGadgetDispatchTag input) ++ input + +private noncomputable def flatAnnotatedIndexedORGadgetDispatchInputComputable : + BitTM + flatAnnotatedIndexedORGadgetDispatchInput := by + have htag := orGadgetPrefixedComputable + flatAnnotatedIndexedORGadgetDispatchTagComputable + exact pointwiseAppendComputable htag + (Turing.idComputableInPolyTime bitEncoding) + +private def orGadgetStartStep + (input : List Bool) : List Bool := + flatAnnotatedIndexedORGadgetState + (flatAnnotatedSourceFieldAt 0 input) + [true] + (firstFieldSuffix (flatAnnotatedSourceFieldAt 2 input)) + (firstFieldContents + (firstFieldContents (flatAnnotatedSourceFieldAt 2 input))) + (flatAnnotatedSourceFieldAt 4 input ++ + flatIndexedSourceORPaddingDescriptorWord true input) + (List.replicate 4 true ++ flatAnnotatedSourceFieldAt 5 input) + +private noncomputable def flatAnnotatedIndexedORGadgetStartStepComputable : + BitTM + orGadgetStartStep := by + have hpending := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 2) + firstFieldSuffixComputable + have hbody := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 2) + firstFieldContentsComputable + have hactive := GapCVP.TMComposition.computableInPolyTime + hbody firstFieldContentsComputable + have hemitted := pointwiseAppendComputable + (annotatedSourceFieldAtComputable 4) + (flatIndexedSourceORPaddingDescriptorComputable true) + have hcount := pointwiseAppendComputable + (sourceFixedWordComputable (List.replicate 4 true)) + (annotatedSourceFieldAtComputable 5) + exact orGadgetStateComputable + (annotatedSourceFieldAtComputable 0) + (sourceFixedWordComputable [true]) hpending hactive hemitted hcount + +private def orGadgetGateStep + (input : List Bool) : List Bool := + flatAnnotatedIndexedORGadgetState + (flatAnnotatedSourceFieldAt 0 input) + (true :: flatAnnotatedSourceFieldAt 1 input) + (flatAnnotatedSourceFieldAt 2 input) + (firstFieldSuffix (flatAnnotatedSourceFieldAt 3 input)) + (flatAnnotatedSourceFieldAt 4 input ++ + flatIndexedSourceORGadgetDescriptorWord input) + (List.replicate 5 true ++ flatAnnotatedSourceFieldAt 5 input) + +private noncomputable def flatAnnotatedIndexedORGadgetGateStepComputable : + BitTM + orGadgetGateStep := by + have hprefix := fiveForbiddenUnarySuccessorComputable + (annotatedSourceFieldAtComputable 1) + have hactive := GapCVP.TMComposition.computableInPolyTime + (annotatedSourceFieldAtComputable 3) + firstFieldSuffixComputable + have hemitted := pointwiseAppendComputable + (annotatedSourceFieldAtComputable 4) + flatIndexedSourceORGadgetDescriptorComputable + have hcount := pointwiseAppendComputable + (sourceFixedWordComputable (List.replicate 5 true)) + (annotatedSourceFieldAtComputable 5) + exact orGadgetStateComputable + (annotatedSourceFieldAtComputable 0) + hprefix (annotatedSourceFieldAtComputable 2) + hactive hemitted hcount + +private def orGadgetFinishStep + (input : List Bool) : List Bool := + flatAnnotatedIndexedORGadgetState + (true :: flatAnnotatedSourceFieldAt 0 input) + [] + (flatAnnotatedSourceFieldAt 2 input) + [] + (flatAnnotatedSourceFieldAt 4 input ++ + flatIndexedSourceORPaddingDescriptorWord false input) + (List.replicate 4 true ++ flatAnnotatedSourceFieldAt 5 input) + +private noncomputable def flatAnnotatedIndexedORGadgetFinishStepComputable : + BitTM + orGadgetFinishStep := by + have hclause := fiveForbiddenUnarySuccessorComputable + (annotatedSourceFieldAtComputable 0) + have hemitted := pointwiseAppendComputable + (annotatedSourceFieldAtComputable 4) + (flatIndexedSourceORPaddingDescriptorComputable false) + have hcount := pointwiseAppendComputable + (sourceFixedWordComputable (List.replicate 4 true)) + (annotatedSourceFieldAtComputable 5) + exact orGadgetStateComputable + hclause (sourceFixedWordComputable []) + (annotatedSourceFieldAtComputable 2) + (sourceFixedWordComputable []) hemitted hcount + +private def flatAnnotatedIndexedORGadgetStep : List Bool → List Bool := + fourFamilyTaggedPredicateMarker + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep ∘ + flatAnnotatedIndexedORGadgetDispatchInput + +private noncomputable def flatAnnotatedIndexedORGadgetStepComputable : + BitTM + flatAnnotatedIndexedORGadgetStep := by + have hdispatch := fourFamilyTaggedPredicateMarkerComputable + (Turing.idComputableInPolyTime bitEncoding) + flatAnnotatedIndexedORGadgetStartStepComputable + flatAnnotatedIndexedORGadgetFinishStepComputable + flatAnnotatedIndexedORGadgetGateStepComputable + exact GapCVP.TMComposition.computableInPolyTime + flatAnnotatedIndexedORGadgetDispatchInputComputable hdispatch + +private theorem flatAnnotatedIndexedORGadgetDispatchTag_state + (clauseIndex prefixWord pending active emitted count : List Bool) : + orGadgetDispatchTag + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = + [prefixWord.headD false, + (prefixWord.headD false && active.headD false) || + (!(prefixWord.headD false) && pending.headD false)] := by + let state := flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count + have hprefix : + orGadgetFieldHeadMarker 1 state = + [prefixWord.headD false] := by + simp only [orGadgetFieldHeadMarker, flatAnnotatedIndexedORGadgetState_field_one, + fiveFamilyOriginalHeadBitWord_eq, List.headD_eq_head?_getD, state] + have hactive : + orGadgetFieldHeadMarker 3 state = + [active.headD false] := by + simp only [orGadgetFieldHeadMarker, flatAnnotatedIndexedORGadgetState_field_three, + fiveFamilyOriginalHeadBitWord_eq, List.headD_eq_head?_getD, state] + have hpending : + orGadgetFieldHeadMarker 2 state = + [pending.headD false] := by + simp only [orGadgetFieldHeadMarker, flatAnnotatedIndexedORGadgetState_field_two, + fiveFamilyOriginalHeadBitWord_eq, List.headD_eq_head?_getD, state] + have hnotprefix := fourFamilyBooleanNotOutput_bit + (orGadgetFieldHeadMarker 1) + state (prefixWord.headD false) hprefix + have hleft := fourFamilyBooleanAndOutput_bits + (orGadgetFieldHeadMarker 1) + (orGadgetFieldHeadMarker 3) + state (prefixWord.headD false) (active.headD false) + hprefix hactive + have hright := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput + (orGadgetFieldHeadMarker 1)) + (orGadgetFieldHeadMarker 2) + state (!(prefixWord.headD false)) (pending.headD false) + hnotprefix hpending + have hchoice := flatAnnotatedIndexedORGadgetBooleanOr_bits + (sourceFourFamilyBooleanAndOutput + (orGadgetFieldHeadMarker 1) + (orGadgetFieldHeadMarker 3)) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + (orGadgetFieldHeadMarker 1)) + (orGadgetFieldHeadMarker 2)) + state + (prefixWord.headD false && active.headD false) + (!(prefixWord.headD false) && pending.headD false) + hleft hright + change orGadgetDispatchTag state = _ + unfold orGadgetDispatchTag + rw [hprefix] + change [prefixWord.headD false] ++ + orGadgetBooleanOr _ _ state = _ + rw [hchoice] + rfl + +private theorem orGadgetStep_state + (clauseIndex prefixWord pending active emitted count : List Bool) : + flatAnnotatedIndexedORGadgetStep + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = + if prefixWord.headD false then + if active.headD false then + orGadgetGateStep + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) + else + orGadgetFinishStep + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) + else if pending.headD false then + orGadgetStartStep + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) + else + flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count := by + unfold flatAnnotatedIndexedORGadgetStep + rw [Function.comp_apply] + change fourFamilyTaggedPredicateMarker + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep + (lengthPrefixedWord + (orGadgetDispatchTag + (flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count)) ++ + flatAnnotatedIndexedORGadgetState + clauseIndex prefixWord pending active emitted count) = _ + rw [flatAnnotatedIndexedORGadgetDispatchTag_state] + cases hp : prefixWord.headD false with + | false => + cases hn : pending.headD false with + | false => + simp only [Bool.false_and, Bool.true_and, + Bool.false_or, Bool.not_false] + exact sourceFourFamilyTaggedPredicateMarker_interpolation + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep _ + | true => + simp only [Bool.false_and, Bool.true_and, + Bool.false_or, Bool.not_false, ↓reduceIte] + exact sourceFourFamilyTaggedPredicateMarker_normalization + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep _ + | true => + cases ha : active.headD false with + | false => + simp only [Bool.false_and, Bool.true_and, + Bool.false_or, Bool.not_true, ↓reduceIte] + exact sourceFourFamilyTaggedPredicateMarker_diagonal + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep _ + | true => + simp only [Bool.false_and, Bool.true_and, + Bool.true_or, Bool.not_true, ↓reduceIte] + exact sourceFourFamilyTaggedPredicateMarker_clause + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep _ + +end CNFFiveFamilySourceIndexedORGadgetFoldCoreTM + +namespace CNFFiveFamilySourceIndexedORGadgetRecordWorkerBoundCert + +open Computability Turing GapCVP.CLVerifier GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction +open GapCVP.SourceTotalStructuralDecoder GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CNFFlatStructuralRecordWorkerTM GapCVP.CNFFlatSourceGridDescriptorTM +open GapCVP.CNFUnaryPairIndexTM GapCVP.CNFPairedSourceGridDescriptorTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM +open GapCVP.CNFGuardedSourceDescriptorCompositeFoldTM +open GapCVP.CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM + +private theorem flatIndexedGadgetFirstFieldContents_length_le + (input : List Bool) : + (firstFieldContents input).length ≤ input.length := by + have accounting := annotatedStructuralFieldAccounting input + omega + +@[simp] private theorem flatIndexedGadgetNegateLeadingBitWord_length + (input : List Bool) : + (flatIndexedGadgetNegateLeadingBitWord input).length = + input.length := by + cases input with + | nil => rfl + | cons bit remaining => + simp only [flatIndexedGadgetNegateLeadingBitWord, List.length_cons] + +private theorem flatIndexedGadgetSourceDescriptorWord_length_le + (negated : Bool) (state : List Bool) : + (flatIndexedGadgetSourceDescriptorWord negated state).length ≤ + 2 * (flatAnnotatedSourceFieldAt 3 state).length + 1 := by + have payload := flatIndexedGadgetFirstFieldContents_length_le + (flatAnnotatedSourceFieldAt 3 state) + cases negated <;> + simp only [flatIndexedGadgetSourceDescriptorWord, + Bool.false_eq_true, ↓reduceIte, lengthPrefixedWord_length, + flatIndexedGadgetSourcePayloadWord, + flatIndexedGadgetNegateLeadingBitWord_length] <;> + omega + +private theorem flatIndexedGadgetAccumulatorPairWord_length_le + (next : Bool) (state : List Bool) : + (flatIndexedGadgetAccumulatorPairWord next state).length ≤ + (flatAnnotatedSourceFieldAt 0 state).length + + (flatAnnotatedSourceFieldAt 1 state).length + 2 := by + have tail : + (flatAnnotatedSourceFieldAt 1 state).tail.length ≤ + (flatAnnotatedSourceFieldAt 1 state).length := by + simp only [List.length_tail, tsub_le_iff_right, le_add_iff_nonneg_right, zero_le] + cases next <;> + simp only [flatIndexedGadgetAccumulatorPairWord, + Bool.false_eq_true, ↓reduceIte, + List.length_append, List.length_cons, + List.length_nil] <;> + omega + +private theorem flatIndexedPairedAccumulatorDescriptorWord_length_le + (sign : Bool) (input : List Bool) : + (pairedAccumulatorSignedLiteralDescriptorWord sign input).length ≤ + input.length + 15 := by + cases unaryInputSplit input with + | inl missing => + obtain ⟨count, hinput⟩ := missing + subst input + simp only [pairedAccumulatorSignedLiteralDescriptorWord, + accumulatorSignedLiteralDescriptorWord, + polynomialSignedLiteralDescriptorWord, unarySourcePairOutput, readUnaryPrefix_missing, + List.length_nil, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, + mul_zero, Polynomial.eval_one, + zero_add, lengthPrefixedWord_length, List.length_cons, encodeNat_length_eq_size, + Nat.size_one, Nat.reduceAdd, + Nat.reduceMul, List.length_replicate, le_add_iff_nonneg_left, zero_le] + | inr delimited => + obtain ⟨first, tail, hinput⟩ := delimited + subst input + cases unaryInputSplit tail with + | inl missing => + obtain ⟨second, htail⟩ := missing + subst tail + simp only [pairedAccumulatorSignedLiteralDescriptorWord, + accumulatorSignedLiteralDescriptorWord, + polynomialSignedLiteralDescriptorWord, unarySourcePairOutput, + readUnaryPrefix_replicate, readUnaryPrefix_missing, + List.length_nil, Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X, mul_zero, + Polynomial.eval_one, zero_add, lengthPrefixedWord_length, List.length_cons, + encodeNat_length_eq_size, Nat.size_one, + Nat.reduceAdd, Nat.reduceMul, List.length_append, List.length_replicate, + le_add_iff_nonneg_left, zero_le] + | inr delimited => + obtain ⟨second, remaining, htail⟩ := delimited + subst tail + cases remaining with + | nil => + have bound := guardedSourceAccumulatorDescriptor_length_le + first second sign + have pair : + pairedAccumulatorSignedLiteralDescriptorWord sign + (List.replicate first true ++ + false :: (List.replicate second true ++ [false])) = + flatSignedLiteralDescriptor + (accumulatorVariable first second, sign) := by + simpa only [unarySourcePairWord] + using (pairedAccumulatorSignedLiteralDescriptorWord_pair first second sign) + rw [pair] + simp only [List.length_append, List.length_replicate, + List.length_cons, List.length_nil] + omega + | cons bit remaining => + simp only [pairedAccumulatorSignedLiteralDescriptorWord, + accumulatorSignedLiteralDescriptorWord, + polynomialSignedLiteralDescriptorWord, unarySourcePairOutput, + readUnaryPrefix_replicate, List.length_nil, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X, mul_zero, Polynomial.eval_one, + zero_add, lengthPrefixedWord_length, List.length_cons, encodeNat_length_eq_size, + Nat.size_one, Nat.reduceAdd, + Nat.reduceMul, List.length_append, List.length_replicate, le_add_iff_nonneg_left, + zero_le] + +private theorem flatIndexedGadgetAccumulatorDescriptorWord_length_le + (next sign : Bool) (state : List Bool) : + (flatIndexedGadgetAccumulatorDescriptorWord next sign state).length ≤ + (flatAnnotatedSourceFieldAt 0 state).length + + (flatAnnotatedSourceFieldAt 1 state).length + 17 := by + have pair := flatIndexedGadgetAccumulatorPairWord_length_le + next state + have descriptor := flatIndexedPairedAccumulatorDescriptorWord_length_le + sign (flatIndexedGadgetAccumulatorPairWord next state) + change + (pairedAccumulatorSignedLiteralDescriptorWord sign + (flatIndexedGadgetAccumulatorPairWord next state)).length ≤ _ + omega + +private theorem flatIndexedGadgetPaddingDescriptorWord_length_le + (which sign : Bool) (state : List Bool) : + (flatIndexedGadgetPaddingDescriptorWord which sign state).length ≤ + 7 := by + cases which <;> cases sign <;> + simp only [flatIndexedGadgetPaddingDescriptorWord, + paddingSignedLiteralDescriptorWord_eq, + flatSignedLiteralDescriptor, + lengthPrefixedWord_length] <;> + decide + +private theorem flatIndexedSourceORGadgetDescriptorWord_length_le + (state : List Bool) : + (flatIndexedSourceORGadgetDescriptorWord state).length ≤ + 200 * + ((flatAnnotatedSourceFieldAt 0 state).length + + (flatAnnotatedSourceFieldAt 1 state).length + + (flatAnnotatedSourceFieldAt 3 state).length + 1) := by + have source := flatIndexedGadgetSourceDescriptorWord_length_le + false state + have negative := flatIndexedGadgetSourceDescriptorWord_length_le + true state + have current := flatIndexedGadgetAccumulatorDescriptorWord_length_le + false true state + have currentNegative := + flatIndexedGadgetAccumulatorDescriptorWord_length_le + false false state + have next := flatIndexedGadgetAccumulatorDescriptorWord_length_le + true true state + have nextNegative := + flatIndexedGadgetAccumulatorDescriptorWord_length_le + true false state + have padTrue := flatIndexedGadgetPaddingDescriptorWord_length_le + false true state + have padFalse := flatIndexedGadgetPaddingDescriptorWord_length_le + false false state + simp only [flatIndexedSourceORGadgetDescriptorWord, + flatIndexedGadgetThreeDescriptorWord, List.length_append] + omega + +private theorem flatIndexedSourceORPaddingDescriptorWord_length_le + (sign : Bool) (state : List Bool) : + (flatIndexedSourceORPaddingDescriptorWord sign state).length ≤ + 200 * + ((flatAnnotatedSourceFieldAt 0 state).length + + (flatAnnotatedSourceFieldAt 1 state).length + + (flatAnnotatedSourceFieldAt 3 state).length + 1) := by + have accumulator := + flatIndexedGadgetAccumulatorDescriptorWord_length_le + false sign state + have zeroFalse := flatIndexedGadgetPaddingDescriptorWord_length_le + false false state + have zeroTrue := flatIndexedGadgetPaddingDescriptorWord_length_le + false true state + have oneFalse := flatIndexedGadgetPaddingDescriptorWord_length_le + true false state + have oneTrue := flatIndexedGadgetPaddingDescriptorWord_length_le + true true state + simp only [flatIndexedSourceORPaddingDescriptorWord, + flatIndexedGadgetThreeDescriptorWord, List.length_append] + omega + +end CNFFiveFamilySourceIndexedORGadgetRecordWorkerBoundCert + +namespace CNFFiveFamilySourceIndexedORGadgetFoldBoundCert + +open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.CNFTypedRecordWorkerTM +open GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyTaggedPredicateDispatchTM +open GapCVP.CNFFiveFamilySourceIndexedORGadgetRecordWorkerBoundCert +open GapCVP.CNFFiveFamilySourceIndexedORGadgetFoldCoreTM + +private def orGadgetSourceWeight + (input : List Bool) : ℕ := + (flatAnnotatedSourceFieldAt 0 input).length + + (flatAnnotatedSourceFieldAt 1 input).length + + (flatAnnotatedSourceFieldAt 2 input).length + + (flatAnnotatedSourceFieldAt 3 input).length + +private theorem flatAnnotatedIndexedORGadgetSixFieldAccounting + (input : List Bool) : + 2 * + ((flatAnnotatedSourceFieldAt 0 input).length + + (flatAnnotatedSourceFieldAt 1 input).length + + (flatAnnotatedSourceFieldAt 2 input).length + + (flatAnnotatedSourceFieldAt 3 input).length + + (flatAnnotatedSourceFieldAt 4 input).length + + (flatAnnotatedSourceFieldAt 5 input).length) ≤ + input.length := by + have hzero := annotatedStructuralFieldAccounting input + have hone := annotatedStructuralFieldAccounting + (firstFieldSuffix input) + have htwo := annotatedStructuralFieldAccounting + (firstFieldSuffix (firstFieldSuffix input)) + have hthree := annotatedStructuralFieldAccounting + (firstFieldSuffix + (firstFieldSuffix (firstFieldSuffix input))) + have hfour := annotatedStructuralFieldAccounting + (firstFieldSuffix + (firstFieldSuffix + (firstFieldSuffix (firstFieldSuffix input)))) + have hfive := annotatedStructuralFieldAccounting + (firstFieldSuffix + (firstFieldSuffix + (firstFieldSuffix + (firstFieldSuffix (firstFieldSuffix input))))) + simp only [flatAnnotatedSourceFieldAt, + flatAnnotatedSourceFieldTail, + Function.iterate_succ_apply', Function.iterate_zero, + id_eq] at * + omega + +private theorem flatAnnotatedIndexedORGadgetDispatchTag_all + (input : List Bool) : + orGadgetDispatchTag input = + [(flatAnnotatedSourceFieldAt 1 input).headD false, + ((flatAnnotatedSourceFieldAt 1 input).headD false && + (flatAnnotatedSourceFieldAt 3 input).headD false) || + (!(flatAnnotatedSourceFieldAt 1 input).headD false && + (flatAnnotatedSourceFieldAt 2 input).headD false)] := by + have hprefix : + orGadgetFieldHeadMarker 1 input = + [(flatAnnotatedSourceFieldAt 1 input).headD false] := by + simp only [orGadgetFieldHeadMarker, + CNFFiveFamilyOriginalIndexedBitTM.fiveFamilyOriginalHeadBitWord_eq, + List.headD_eq_head?_getD] + have hactive : + orGadgetFieldHeadMarker 3 input = + [(flatAnnotatedSourceFieldAt 3 input).headD false] := by + simp only [orGadgetFieldHeadMarker, + CNFFiveFamilyOriginalIndexedBitTM.fiveFamilyOriginalHeadBitWord_eq, + List.headD_eq_head?_getD] + have hpending : + orGadgetFieldHeadMarker 2 input = + [(flatAnnotatedSourceFieldAt 2 input).headD false] := by + simp only [orGadgetFieldHeadMarker, + CNFFiveFamilyOriginalIndexedBitTM.fiveFamilyOriginalHeadBitWord_eq, + List.headD_eq_head?_getD] + have hnotprefix := fourFamilyBooleanNotOutput_bit + (orGadgetFieldHeadMarker 1) + input ((flatAnnotatedSourceFieldAt 1 input).headD false) hprefix + have hleft := fourFamilyBooleanAndOutput_bits + (orGadgetFieldHeadMarker 1) + (orGadgetFieldHeadMarker 3) + input ((flatAnnotatedSourceFieldAt 1 input).headD false) + ((flatAnnotatedSourceFieldAt 3 input).headD false) + hprefix hactive + have hright := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput + (orGadgetFieldHeadMarker 1)) + (orGadgetFieldHeadMarker 2) + input (!(flatAnnotatedSourceFieldAt 1 input).headD false) + ((flatAnnotatedSourceFieldAt 2 input).headD false) + hnotprefix hpending + have hchoice := flatAnnotatedIndexedORGadgetBooleanOr_bits + (sourceFourFamilyBooleanAndOutput + (orGadgetFieldHeadMarker 1) + (orGadgetFieldHeadMarker 3)) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + (orGadgetFieldHeadMarker 1)) + (orGadgetFieldHeadMarker 2)) + input + ((flatAnnotatedSourceFieldAt 1 input).headD false && + (flatAnnotatedSourceFieldAt 3 input).headD false) + (!(flatAnnotatedSourceFieldAt 1 input).headD false && + (flatAnnotatedSourceFieldAt 2 input).headD false) + hleft hright + unfold orGadgetDispatchTag + rw [hprefix] + change + [(flatAnnotatedSourceFieldAt 1 input).headD false] ++ + orGadgetBooleanOr _ _ input = _ + rw [hchoice] + rfl + +private theorem flatAnnotatedIndexedORGadgetStep_all + (input : List Bool) : + flatAnnotatedIndexedORGadgetStep input = + if (flatAnnotatedSourceFieldAt 1 input).headD false then + if (flatAnnotatedSourceFieldAt 3 input).headD false then + orGadgetGateStep input + else + orGadgetFinishStep input + else if (flatAnnotatedSourceFieldAt 2 input).headD false then + orGadgetStartStep input + else input := by + unfold flatAnnotatedIndexedORGadgetStep + rw [Function.comp_apply] + change fourFamilyTaggedPredicateMarker + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep + (lengthPrefixedWord + (orGadgetDispatchTag input) ++ input) = _ + rw [flatAnnotatedIndexedORGadgetDispatchTag_all] + cases hp : (flatAnnotatedSourceFieldAt 1 input).headD false with + | false => + cases hn : (flatAnnotatedSourceFieldAt 2 input).headD false with + | false => + simp only [Bool.false_and, Bool.true_and, + Bool.false_or, Bool.not_false] + exact sourceFourFamilyTaggedPredicateMarker_interpolation + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep _ + | true => + simp only [Bool.false_and, Bool.true_and, + Bool.false_or, Bool.not_false, ↓reduceIte] + exact sourceFourFamilyTaggedPredicateMarker_normalization + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep _ + | true => + cases ha : (flatAnnotatedSourceFieldAt 3 input).headD false with + | false => + simp only [Bool.false_and, Bool.true_and, + Bool.false_or, Bool.not_true, ↓reduceIte] + exact sourceFourFamilyTaggedPredicateMarker_diagonal + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep _ + | true => + simp only [Bool.false_and, Bool.true_and, + Bool.true_or, Bool.not_true, ↓reduceIte] + exact sourceFourFamilyTaggedPredicateMarker_clause + (fun input : List Bool => input) + orGadgetStartStep + orGadgetFinishStep + orGadgetGateStep _ + +private theorem flatAnnotatedIndexedORGadgetStep_sourceWeight_le + (input : List Bool) : + orGadgetSourceWeight + (flatAnnotatedIndexedORGadgetStep input) ≤ + orGadgetSourceWeight input + 1 := by + rw [flatAnnotatedIndexedORGadgetStep_all] + split + · split + · have active := annotatedStructuralFieldAccounting + (flatAnnotatedSourceFieldAt 3 input) + simp only [orGadgetGateStep, + orGadgetSourceWeight, + flatAnnotatedIndexedORGadgetState_field_zero, + flatAnnotatedIndexedORGadgetState_field_one, + flatAnnotatedIndexedORGadgetState_field_two, + flatAnnotatedIndexedORGadgetState_field_three, + List.length_cons] + omega + · simp only [orGadgetFinishStep, + orGadgetSourceWeight, + flatAnnotatedIndexedORGadgetState_field_zero, + flatAnnotatedIndexedORGadgetState_field_one, + flatAnnotatedIndexedORGadgetState_field_two, + flatAnnotatedIndexedORGadgetState_field_three, + List.length_cons, List.length_nil] + omega + · split + · have pending := annotatedStructuralFieldAccounting + (flatAnnotatedSourceFieldAt 2 input) + have active := annotatedStructuralFieldAccounting + (firstFieldContents (flatAnnotatedSourceFieldAt 2 input)) + simp only [orGadgetStartStep, + orGadgetSourceWeight, + flatAnnotatedIndexedORGadgetState_field_zero, + flatAnnotatedIndexedORGadgetState_field_one, + flatAnnotatedIndexedORGadgetState_field_two, + flatAnnotatedIndexedORGadgetState_field_three, + List.length_cons, List.length_nil] + omega + · omega + +private theorem flatAnnotatedIndexedORGadgetStep_length_le + (input : List Bool) : + (flatAnnotatedIndexedORGadgetStep input).length ≤ + input.length + + 800 * (orGadgetSourceWeight input + 1) + 100 := by + have accounting := flatAnnotatedIndexedORGadgetSixFieldAccounting input + rw [flatAnnotatedIndexedORGadgetStep_all] + split + · split + · have descriptor := + flatIndexedSourceORGadgetDescriptorWord_length_le input + have active := annotatedStructuralFieldAccounting + (flatAnnotatedSourceFieldAt 3 input) + simp only [orGadgetGateStep, + flatAnnotatedIndexedORGadgetState_length, + orGadgetSourceWeight, + List.length_append, List.length_cons, + List.length_replicate] at * + omega + · have descriptor := + flatIndexedSourceORPaddingDescriptorWord_length_le false input + simp only [orGadgetFinishStep, + flatAnnotatedIndexedORGadgetState_length, + orGadgetSourceWeight, + List.length_append, List.length_cons, + List.length_nil, List.length_replicate] at * + omega + · split + · have descriptor := + flatIndexedSourceORPaddingDescriptorWord_length_le true input + have pending := annotatedStructuralFieldAccounting + (flatAnnotatedSourceFieldAt 2 input) + have active := annotatedStructuralFieldAccounting + (firstFieldContents (flatAnnotatedSourceFieldAt 2 input)) + simp only [orGadgetStartStep, + flatAnnotatedIndexedORGadgetState_length, + orGadgetSourceWeight, + List.length_append, List.length_cons, + List.length_nil, List.length_replicate] at * + omega + · omega + +private theorem flatAnnotatedIndexedORGadgetStep_iterate_sourceWeight_le + (input : List Bool) (stage : ℕ) : + orGadgetSourceWeight + ((flatAnnotatedIndexedORGadgetStep^[stage]) input) ≤ + orGadgetSourceWeight input + stage := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have transition := flatAnnotatedIndexedORGadgetStep_sourceWeight_le + ((flatAnnotatedIndexedORGadgetStep^[stage]) input) + omega + +private theorem flatAnnotatedIndexedORGadgetStep_iterate_length_le + (input : List Bool) (stage : ℕ) : + ((flatAnnotatedIndexedORGadgetStep^[stage]) input).length ≤ + input.length + + stage * + (800 * + (orGadgetSourceWeight input + stage + 1) + + 100) := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, add_zero, zero_mul, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have transition := flatAnnotatedIndexedORGadgetStep_length_le + ((flatAnnotatedIndexedORGadgetStep^[stage]) input) + have potential := + flatAnnotatedIndexedORGadgetStep_iterate_sourceWeight_le + input stage + linarith + +private def flatAnnotatedIndexedORGadgetFoldStatePolynomial : Polynomial ℕ := + 2000 * Polynomial.X ^ 2 + 2000 * Polynomial.X + 100 + +private theorem flatAnnotatedIndexedORGadgetStep_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + flatAnnotatedIndexedORGadgetStep + flatAnnotatedIndexedORGadgetFoldStatePolynomial := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have seedLength := parsedUnaryFold_seed_length_le + input count seed hparse + have countLength := parsedUnaryFold_count_le_length + input count seed hparse + have seedAccounting := flatAnnotatedIndexedORGadgetSixFieldAccounting seed + have iterate := flatAnnotatedIndexedORGadgetStep_iterate_length_le + seed stage + have stageLength : stage ≤ input.length := hstage.trans countLength + have weightLength : + orGadgetSourceWeight seed ≤ input.length := by + unfold orGadgetSourceWeight + omega + have product := Nat.mul_le_mul stageLength (show + orGadgetSourceWeight seed + stage + 1 ≤ + 2 * input.length + 1 by omega) + simp only [flatAnnotatedIndexedORGadgetFoldStatePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_pow, Polynomial.eval_ofNat, + Polynomial.eval_X] + linarith + +end CNFFiveFamilySourceIndexedORGadgetFoldBoundCert + +namespace CNFFiveFamilySourceIndexedORGadgetSourceIterationBudgetCert + +open Computability Turing GapCVP.CL GapCVP.BinaryEncoding +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM GapCVP.CNFAnnotatedSourceClauseBubblePassTM +open GapCVP.CNFFiveFamilySourceIndexedORGadgetFoldCoreTM + +private def orGadgetBundledSourceStepCount + {T S : ℕ} (clauses : List (Clause T S)) : ℕ := + (clauses.map (fun clause => clause.card + 2)).sum + +private theorem flatAnnotatedIndexedORGadgetBundledSourceRecordStepCount_le + {T S : ℕ} (clause : Clause T S) : + clause.card + 2 ≤ + (flatAnnotatedBundledClauseRecord clause).length := by + simp only [flatAnnotatedBundledClauseRecord, flatSourceClauseAnnotatedRecord, + flatSourceClauseUnaryCountPayload, List.append_assoc, lengthPrefixedWord_length, + List.length_append, + List.length_replicate, Nat.reduceLeDiff, Order.add_one_le_iff] + omega + +private theorem flatAnnotatedIndexedORGadgetBundledSourceStepCount_le + {T S : ℕ} (clauses : List (Clause T S)) : + orGadgetBundledSourceStepCount clauses ≤ + (flatAnnotatedBundledClauseStream clauses).length := by + induction clauses with + | nil => + simp only [orGadgetBundledSourceStepCount, List.map_nil, List.sum_nil, + flatAnnotatedBundledClauseStream, + List.flatMap_nil, List.length_nil, Std.le_refl] + | cons clause remaining ih => + have head := + flatAnnotatedIndexedORGadgetBundledSourceRecordStepCount_le clause + have together := Nat.add_le_add head ih + simpa only [orGadgetBundledSourceStepCount, List.map_cons, List.sum_cons, List.sum_map_add, + List.map_const', + List.sum_replicate, smul_eq_mul, flatAnnotatedBundledClauseStream, List.flatMap_cons, + List.length_append, + List.length_flatMap, ge_iff_le] using together + +@[simp] private theorem flatAnnotatedIndexedORGadgetIdleEmptyStep + (clauseIndex emitted count : List Bool) : + flatAnnotatedIndexedORGadgetStep + (flatAnnotatedIndexedORGadgetState + clauseIndex [] [] [] emitted count) = + flatAnnotatedIndexedORGadgetState + clauseIndex [] [] [] emitted count := by + rw [orGadgetStep_state] + simp only [List.headD_eq_head?_getD, List.head?_nil, Option.getD_none, Bool.false_eq_true, + ↓reduceIte] + +private theorem flatAnnotatedIndexedORGadgetIdleEmptyIterate + (clauseIndex emitted count : List Bool) + (extra : ℕ) : + ((flatAnnotatedIndexedORGadgetStep^[extra]) + (flatAnnotatedIndexedORGadgetState + clauseIndex [] [] [] emitted count)) = + flatAnnotatedIndexedORGadgetState + clauseIndex [] [] [] emitted count := by + induction extra with + | zero => simp only [Function.iterate_zero, id_eq] + | succ extra ih => + rw [Function.iterate_succ_apply'] + rw [ih, flatAnnotatedIndexedORGadgetIdleEmptyStep] + +end CNFFiveFamilySourceIndexedORGadgetSourceIterationBudgetCert + +namespace CNFFiveFamilySourceIndexedGadgetDescriptorExpansionTM + +open Computability Turing GapCVP.CL GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.CLStructuralNaturalBinaryWriter +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFlatStructuralRecordWorkerTM +open GapCVP.CNFFlatWholeWordFoldTM GapCVP.CNFAnnotatedSourceClausePairPreparationTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM GapCVP.CNFAnnotatedSourceCompleteSortedDedupTM +open GapCVP.CNFFiveFamilyFlatCandidateGenerationTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM +open GapCVP.CNFFiveFamilySourceIndexedORGadgetFoldCoreTM +open GapCVP.CNFFiveFamilySourceIndexedORGadgetFoldBoundCert +open GapCVP.CNFFiveFamilySourceIndexedORGadgetSourceIterationBudgetCert + +private def orGadgetBoundedInput + (input : List Bool) : List Bool := + unaryBoundedFoldWord input.length + (orGadgetInitialState input) + +private noncomputable def flatAnnotatedIndexedORGadgetBoundedInputComputable : + BitTM + orGadgetBoundedInput := by + have hcounter := polynomialValueUnaryComputable Polynomial.X + have hdelimiter := pointwiseAppendComputable + (sourceFixedWordComputable [false]) + flatAnnotatedIndexedORGadgetInitialStateComputable + have physical := pointwiseAppendComputable hcounter hdelimiter + unfold orGadgetBoundedInput + simpa only [unaryBoundedFoldWord, Polynomial.eval_X, List.cons_append, List.nil_append] + using physical + +private noncomputable def flatAnnotatedIndexedORGadgetBoundedFoldComputable : + BitTM + (boundedRecordFoldOutput flatAnnotatedIndexedORGadgetStep) := + boundedDependentRecordFoldComputable + flatAnnotatedIndexedORGadgetStepComputable + flatAnnotatedIndexedORGadgetFoldStatePolynomial + flatAnnotatedIndexedORGadgetStep_polynomiallyBoundedFoldStates + +private def flatAnnotatedIndexedORGadgetFinalWord + (state : List Bool) : List Bool := + let count := flatAnnotatedSourceFieldAt 5 state + let emitted := flatAnnotatedSourceFieldAt 4 state + count ++ count ++ count ++ + [false] ++ emitted ++ + lengthPrefixedWord (Computability.encodeNat count.length) + +private noncomputable def flatAnnotatedIndexedORGadgetFinalWordComputable : + BitTM + flatAnnotatedIndexedORGadgetFinalWord := by + have hcount := annotatedSourceFieldAtComputable 5 + have hemitted := annotatedSourceFieldAtComputable 4 + have hbinary := GapCVP.TMComposition.computableInPolyTime + hcount structuralNaturalBinaryWriterComputable + have hheader := GapCVP.TMComposition.computableInPolyTime + hbinary structuralPrefixWriterComputable + have hbody := pointwiseAppendComputable hemitted hheader + have hdelimiter := pointwiseAppendComputable + (sourceFixedWordComputable [false]) hbody + have hthree := pointwiseAppendComputable hcount hdelimiter + have htwo := pointwiseAppendComputable hcount hthree + have physical := pointwiseAppendComputable hcount htwo + change BitTM + (fun state : List Bool => + flatAnnotatedSourceFieldAt 5 state ++ + flatAnnotatedSourceFieldAt 5 state ++ + flatAnnotatedSourceFieldAt 5 state ++ + [false] ++ flatAnnotatedSourceFieldAt 4 state ++ + lengthPrefixedWord + (Computability.encodeNat + (flatAnnotatedSourceFieldAt 5 state).length)) + simpa only [Function.comp_apply, List.append_assoc] using physical + +private def orGadgetFoldOutput + (input : List Bool) : List Bool := + flatAnnotatedIndexedORGadgetFinalWord + (boundedRecordFoldOutput flatAnnotatedIndexedORGadgetStep + (orGadgetBoundedInput input)) + +private noncomputable def flatAnnotatedIndexedORGadgetFoldComputable : + BitTM + orGadgetFoldOutput := by + have hfold := GapCVP.TMComposition.computableInPolyTime + flatAnnotatedIndexedORGadgetBoundedInputComputable + flatAnnotatedIndexedORGadgetBoundedFoldComputable + exact GapCVP.TMComposition.computableInPolyTime + hfold flatAnnotatedIndexedORGadgetFinalWordComputable + +private abbrev orGadgetPhysicalState := + GapCVP.CNFFiveFamilySourceIndexedORGadgetFoldCoreTM.flatAnnotatedIndexedORGadgetState + +private def orGadgetIdleState + {T S : ℕ} + (clauseIndex : ℕ) + (pending : List (Clause T S)) + (emitted : ThreeCNF) : List Bool := + orGadgetPhysicalState + (List.replicate clauseIndex true) + [] + (flatAnnotatedBundledClauseStream pending) + [] + (flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals emitted)) + (List.replicate emitted.length true) + +private def orGadgetActiveState + {T S : ℕ} + (clauseIndex prefixIndex : ℕ) + (pending : List (Clause T S)) + (active : List (SignedLiteral T S)) + (emitted : ThreeCNF) : List Bool := + orGadgetPhysicalState + (List.replicate clauseIndex true) + (List.replicate (prefixIndex + 1) true) + (flatAnnotatedBundledClauseStream pending) + (flatSignedLiteralDescriptorStream + (active.map sourceLiteral)) + (flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals emitted)) + (List.replicate emitted.length true) + +@[simp] private theorem flatAnnotatedIndexedORGadgetClauseDescriptors_append + (first second : ThreeCNF) : + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals (first ++ second)) = + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals first) ++ + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals second) := by + simp only [flatSignedLiteralDescriptorStream, flatThreeClauseLiterals, Fin.isValue, + List.flatMap_append] + +private theorem flatAnnotatedIndexedORGadgetBundledSourceHead + {T S : ℕ} (clause : Clause T S) + (remaining : List (Clause T S)) : + (flatAnnotatedBundledClauseStream + (clause :: remaining)).headD false = true := by + have hrecord := flatAnnotatedSortedDedupSourceClauseRecord_ne_nil clause + have hhead := flatAnnotatedSortedDedupHeadBit_nonemptyPrefix + (flatSourceClauseAnnotatedRecord clause) + (flatAnnotatedBundledClauseStream remaining) hrecord + simpa only [flatAnnotatedBundledClauseStream, List.flatMap_cons, + flatAnnotatedBundledClauseRecord, + List.headD_eq_head?_getD, List.head?_append, Option.getD_or, + fiveFamilyOriginalHeadBitWord_eq, List.cons.injEq, + and_true] using hhead + +private theorem flatAnnotatedIndexedORGadgetStartState_valid + {T S : ℕ} + (clauseIndex : ℕ) + (clause : Clause T S) + (remaining : List (Clause T S)) + (emitted : ThreeCNF) : + flatAnnotatedIndexedORGadgetStep + (orGadgetIdleState + clauseIndex (clause :: remaining) emitted) = + orGadgetActiveState + clauseIndex 0 remaining (sortedElements clause) + (emitted ++ + paddedUnary (accumulatorLiteral clauseIndex 0 true)) := by + have hpending := flatAnnotatedIndexedORGadgetBundledSourceHead + clause remaining + have hpadding : + flatIndexedSourceORPaddingDescriptorWord true + (orGadgetIdleState + clauseIndex (clause :: remaining) emitted) = + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals + (paddedUnary + (accumulatorLiteral clauseIndex 0 true))) := by + simpa only [orGadgetIdleState, orGadgetPhysicalState, + CNFFiveFamilySourceIndexedORGadgetFoldCoreTM.flatAnnotatedIndexedORGadgetState, + List.append_assoc, + CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM.flatAnnotatedIndexedORGadgetState] using + flatIndexedSourceORPaddingDescriptorWord_valid_initial clauseIndex true + (flatAnnotatedBundledClauseStream (clause :: remaining)) [] + (flatSignedLiteralDescriptorStream (flatThreeClauseLiterals emitted)) (List.replicate + emitted.length true) + unfold orGadgetIdleState + orGadgetActiveState + rw [orGadgetStep_state] + simp only [List.headD_nil, Bool.false_eq_true, + ↓reduceIte, hpending] + unfold orGadgetStartStep + simp only [flatAnnotatedIndexedORGadgetState_field_zero, + flatAnnotatedIndexedORGadgetState_field_two, + flatAnnotatedIndexedORGadgetState_field_four, + flatAnnotatedIndexedORGadgetState_field_five] + rw [show + flatIndexedSourceORPaddingDescriptorWord true + (orGadgetPhysicalState + (List.replicate clauseIndex true) [] + (flatAnnotatedBundledClauseStream (clause :: remaining)) + [] (flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals emitted)) + (List.replicate emitted.length true)) = _ + from hpadding] + simp only [flatAnnotatedBundledClauseStream, List.flatMap_cons, flatAnnotatedBundledClauseRecord, + flatSourceClauseAnnotatedRecord, flatSourceClauseDescriptorPayload, List.append_assoc, + firstFieldSuffix_valid, + firstFieldContents_valid, List.reduceReplicate, List.cons_append, List.nil_append, + orGadgetPhysicalState, zero_add, + List.replicate_one, flatAnnotatedIndexedORGadgetClauseDescriptors_append, List.length_append, + paddedUnary_length, + Nat.add_comm, List.replicate_add] + +private theorem flatAnnotatedIndexedORGadgetGateState_valid + {T S : ℕ} + (clauseIndex prefixIndex : ℕ) + (pending : List (Clause T S)) + (literal : SignedLiteral T S) + (remaining : List (SignedLiteral T S)) + (emitted : ThreeCNF) : + flatAnnotatedIndexedORGadgetStep + (orGadgetActiveState + clauseIndex prefixIndex pending (literal :: remaining) emitted) = + orGadgetActiveState + clauseIndex (prefixIndex + 1) pending remaining + (emitted ++ orGate (sourceLiteral literal) + (accumulatorLiteral clauseIndex (prefixIndex + 1) true) + (accumulatorLiteral clauseIndex prefixIndex true)) := by + have hgate : + flatIndexedSourceORGadgetDescriptorWord + (orGadgetActiveState + clauseIndex prefixIndex pending (literal :: remaining) emitted) = + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals + (orGate (sourceLiteral literal) + (accumulatorLiteral clauseIndex (prefixIndex + 1) true) + (accumulatorLiteral clauseIndex prefixIndex true))) := by + simpa only [orGadgetActiveState, orGadgetPhysicalState, + CNFFiveFamilySourceIndexedORGadgetFoldCoreTM.flatAnnotatedIndexedORGadgetState, + List.append_assoc, + flatSignedLiteralDescriptorStream, List.map_cons, List.flatMap_cons, + CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM.flatAnnotatedIndexedORGadgetState] using + flatIndexedSourceORGadgetDescriptorWord_valid clauseIndex prefixIndex (sourceLiteral + literal) + (flatAnnotatedBundledClauseStream pending) (flatSignedLiteralDescriptorStream + (remaining.map sourceLiteral)) + (flatSignedLiteralDescriptorStream (flatThreeClauseLiterals emitted)) (List.replicate + emitted.length true) + unfold orGadgetActiveState + rw [orGadgetStep_state] + have hprefix : + (List.replicate (prefixIndex + 1) true).headD false = true := by + simp only [List.replicate_succ, List.headD_eq_head?_getD, List.head?_cons, Option.getD_some] + have hactive : + (flatSignedLiteralDescriptorStream + ((literal :: remaining).map sourceLiteral)).headD false = + true := by + simp only [flatSignedLiteralDescriptorStream, List.map_cons, List.flatMap_cons, + flatSignedLiteralDescriptor, + lengthPrefixedWord, List.length_cons, List.replicate_succ, List.cons_append, + List.append_assoc, + List.headD_eq_head?_getD, List.head?_cons, Option.getD_some] + rw [hprefix, hactive] + simp only [↓reduceIte] + unfold orGadgetGateStep + simp only [flatAnnotatedIndexedORGadgetState_field_zero, + flatAnnotatedIndexedORGadgetState_field_one, + flatAnnotatedIndexedORGadgetState_field_two, + flatAnnotatedIndexedORGadgetState_field_three, + flatAnnotatedIndexedORGadgetState_field_four, + flatAnnotatedIndexedORGadgetState_field_five] + rw [show flatIndexedSourceORGadgetDescriptorWord + (orGadgetPhysicalState + (List.replicate clauseIndex true) + (List.replicate (prefixIndex + 1) true) + (flatAnnotatedBundledClauseStream pending) + (flatSignedLiteralDescriptorStream + ((literal :: remaining).map sourceLiteral)) + (flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals emitted)) + (List.replicate emitted.length true)) = _ from hgate] + simp only [List.replicate_succ, flatSignedLiteralDescriptorStream, List.map_cons, + List.flatMap_cons, + flatSignedLiteralDescriptor, firstFieldSuffix_valid, flatThreeClauseLiterals, Fin.isValue, + List.replicate_zero, + List.cons_append, List.nil_append, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd, + List.flatMap_append, + List.length_append, orGate_length, List.replicate_add] + +private theorem flatAnnotatedIndexedORGadgetFinishState_valid + {T S : ℕ} + (clauseIndex prefixIndex : ℕ) + (pending : List (Clause T S)) + (emitted : ThreeCNF) : + flatAnnotatedIndexedORGadgetStep + (orGadgetActiveState + clauseIndex prefixIndex pending [] emitted) = + orGadgetIdleState + (clauseIndex + 1) pending + (emitted ++ + paddedUnary + (accumulatorLiteral clauseIndex prefixIndex false)) := by + have hpadding : + flatIndexedSourceORPaddingDescriptorWord false + (orGadgetActiveState + clauseIndex prefixIndex pending [] emitted) = + flatSignedLiteralDescriptorStream + (flatThreeClauseLiterals + (paddedUnary + (accumulatorLiteral clauseIndex prefixIndex false))) := by + simpa only [orGadgetActiveState, orGadgetPhysicalState, + CNFFiveFamilySourceIndexedORGadgetFoldCoreTM.flatAnnotatedIndexedORGadgetState, + List.append_assoc, + flatSignedLiteralDescriptorStream, List.map_nil, List.flatMap_nil, + CNFFiveFamilySourceIndexedORGadgetRecordWorkerTM.flatAnnotatedIndexedORGadgetState] using + flatIndexedSourceORPaddingDescriptorWord_valid clauseIndex prefixIndex false + (flatAnnotatedBundledClauseStream pending) [] + (flatSignedLiteralDescriptorStream (flatThreeClauseLiterals emitted)) (List.replicate + emitted.length true) + have hpadding' := hpadding + simp only [orGadgetActiveState, + orGadgetPhysicalState, + List.replicate_succ, List.map_nil, + flatSignedLiteralDescriptorStream, List.flatMap_nil] at hpadding' + unfold orGadgetActiveState + orGadgetIdleState + rw [orGadgetStep_state] + simp only [List.replicate_succ, List.headD_cons, + List.map_nil, flatSignedLiteralDescriptorStream, + List.flatMap_nil, List.headD_nil, ↓reduceIte] + simp only [Bool.false_eq_true, ↓reduceIte] + unfold orGadgetFinishStep + simp only [flatAnnotatedIndexedORGadgetState_field_zero, + flatAnnotatedIndexedORGadgetState_field_two, + flatAnnotatedIndexedORGadgetState_field_four, + flatAnnotatedIndexedORGadgetState_field_five] + rw [hpadding'] + simp only [flatThreeClauseLiterals, Fin.isValue, List.replicate_succ, List.replicate_zero, + List.cons_append, + List.nil_append, List.flatMap_append, List.length_append, paddedUnary_length, Nat.add_comm, + List.replicate_add] + +private theorem flatAnnotatedIndexedORGadgetActiveIterate_valid + {T S : ℕ} + (clauseIndex prefixIndex : ℕ) + (pending : List (Clause T S)) + (active : List (SignedLiteral T S)) + (emitted : ThreeCNF) : + ((flatAnnotatedIndexedORGadgetStep^[active.length + 1]) + (orGadgetActiveState + clauseIndex prefixIndex pending active emitted)) = + orGadgetIdleState + (clauseIndex + 1) pending + (emitted ++ gateList clauseIndex prefixIndex active ++ + paddedUnary + (accumulatorLiteral clauseIndex + (prefixIndex + active.length) false)) := by + induction active generalizing prefixIndex emitted with + | nil => + simpa only [List.length_nil, zero_add, Function.iterate_one, gateList, List.append_nil, + add_zero] using + flatAnnotatedIndexedORGadgetFinishState_valid clauseIndex prefixIndex pending emitted + | cons literal remaining ih => + have hcount : + (literal :: remaining).length + 1 = + (remaining.length + 1) + 1 := by + simp only [List.length_cons] + rw [hcount, Function.iterate_succ_apply, + flatAnnotatedIndexedORGadgetGateState_valid] + rw [ih (prefixIndex + 1) + (emitted ++ orGate (sourceLiteral literal) + (accumulatorLiteral clauseIndex (prefixIndex + 1) true) + (accumulatorLiteral clauseIndex prefixIndex true))] + simp only [List.append_assoc, Nat.add_assoc, gateList, List.length_cons, Nat.add_comm] + +private theorem flatAnnotatedIndexedORGadgetSingleClauseIterate_valid + {T S : ℕ} + (clauseIndex : ℕ) + (clause : Clause T S) + (remaining : List (Clause T S)) + (emitted : ThreeCNF) : + ((flatAnnotatedIndexedORGadgetStep^[clause.card + 2]) + (orGadgetIdleState + clauseIndex (clause :: remaining) emitted)) = + orGadgetIdleState + (clauseIndex + 1) remaining + (emitted ++ encodeClause clauseIndex clause) := by + have hcount : + clause.card + 2 = + ((sortedElements clause).length + 1) + 1 := by + simp only [sortedElements_length] + rw [hcount, Function.iterate_add_apply, + Function.iterate_one, + flatAnnotatedIndexedORGadgetStartState_valid, + flatAnnotatedIndexedORGadgetActiveIterate_valid] + simp only [List.append_assoc, sortedElements_length, zero_add, encodeClause] + +private theorem flatAnnotatedIndexedORGadgetSourceIterate_valid + {T S : ℕ} + (clauses : List (Clause T S)) + (clauseIndex : ℕ) + (emitted : ThreeCNF) : + ((flatAnnotatedIndexedORGadgetStep^[ + orGadgetBundledSourceStepCount clauses]) + (orGadgetIdleState + clauseIndex clauses emitted)) = + orGadgetIdleState + (clauseIndex + clauses.length) ([] : List (Clause T S)) + (emitted ++ encodeFormulaFrom clauseIndex clauses) := by + induction clauses generalizing clauseIndex emitted with + | nil => + simp only [orGadgetBundledSourceStepCount, List.map_nil, List.sum_nil, Function.iterate_zero, + id_eq, + List.length_nil, add_zero, encodeFormulaFrom, List.append_nil] + | cons clause remaining ih => + have hcount : + orGadgetBundledSourceStepCount + (clause :: remaining) = + (clause.card + 2) + + orGadgetBundledSourceStepCount + remaining := by + rfl + rw [hcount, Nat.add_comm, Function.iterate_add_apply, + flatAnnotatedIndexedORGadgetSingleClauseIterate_valid] + rw [ih (clauseIndex + 1) + (emitted ++ encodeClause clauseIndex clause)] + simp only [Nat.add_assoc, List.append_assoc, List.length_cons, Nat.add_comm, + encodeFormulaFrom] + +private theorem flatAnnotatedIndexedORGadgetBoundedFoldOutput_valid + {T S : ℕ} + (clauses : List (Clause T S)) : + boundedRecordFoldOutput flatAnnotatedIndexedORGadgetStep + (orGadgetBoundedInput + (flatAnnotatedBundledClauseStream clauses)) = + orGadgetIdleState + clauses.length ([] : List (Clause T S)) + (encodeFormulaFrom 0 clauses) := by + have hbudget := + flatAnnotatedIndexedORGadgetBundledSourceStepCount_le clauses + let steps := orGadgetBundledSourceStepCount clauses + let source := flatAnnotatedBundledClauseStream clauses + have hsplit : source.length = (source.length - steps) + steps := by + dsimp [source, steps] + omega + have hinitial : + orGadgetInitialState source = + orGadgetIdleState 0 clauses [] := by + simp only [orGadgetInitialState, orGadgetIdleState, orGadgetPhysicalState, List.replicate_zero, + flatSignedLiteralDescriptorStream, flatThreeClauseLiterals, Fin.isValue, List.flatMap_nil, + List.length_nil, source] + unfold orGadgetBoundedInput + rw [show flatAnnotatedBundledClauseStream clauses = source from rfl] + simp only [boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + rw [hinitial, hsplit, Function.iterate_add_apply] + change + ((flatAnnotatedIndexedORGadgetStep^[source.length - steps]) + (((flatAnnotatedIndexedORGadgetStep^[steps]) + (orGadgetIdleState 0 clauses [])))) = _ + rw [show + ((flatAnnotatedIndexedORGadgetStep^[steps]) + (orGadgetIdleState 0 clauses [])) = + orGadgetIdleState + clauses.length [] (encodeFormulaFrom 0 clauses) by + simpa only [zero_add, List.nil_append, steps] using + flatAnnotatedIndexedORGadgetSourceIterate_valid clauses 0 []] + simpa only [orGadgetIdleState, orGadgetPhysicalState, flatAnnotatedBundledClauseStream, + List.flatMap_nil] using + flatAnnotatedIndexedORGadgetIdleEmptyIterate (List.replicate clauses.length true) + (flatSignedLiteralDescriptorStream (flatThreeClauseLiterals (encodeFormulaFrom 0 clauses))) + (List.replicate (encodeFormulaFrom 0 clauses).length true) (source.length - steps) + +private theorem flatAnnotatedIndexedORGadgetFoldOutput_valid + {T S : ℕ} + (clauses : List (Clause T S)) : + orGadgetFoldOutput + (flatAnnotatedBundledClauseStream clauses) = + structuralThreeCNFFlatFoldInput + (encodeFormulaFrom 0 clauses) := by + unfold orGadgetFoldOutput + rw [flatAnnotatedIndexedORGadgetBoundedFoldOutput_valid clauses] + simp only [flatAnnotatedIndexedORGadgetFinalWord, + orGadgetIdleState, + orGadgetPhysicalState, + flatAnnotatedIndexedORGadgetState_field_four, + flatAnnotatedIndexedORGadgetState_field_five, + List.length_replicate, + structuralThreeCNFFlatFoldInput, + unaryBoundedFoldWord] + rw [show 3 * (encodeFormulaFrom 0 clauses).length = + (encodeFormulaFrom 0 clauses).length + + (encodeFormulaFrom 0 clauses).length + + (encodeFormulaFrom 0 clauses).length by omega, + List.replicate_add, List.replicate_add] + simp only [List.append_assoc, List.cons_append, + List.nil_append] + +end CNFFiveFamilySourceIndexedGadgetDescriptorExpansionTM + +namespace CNFFiveFamilySourceIndexedORGadgetFinalCert + +open Computability Turing GapCVP.CLStructuralWholeCNFOutputTM GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatWholeWordFoldTM +open GapCVP.CNFFiveFamilyIndependentFiveFamilyPhysicalBundledSourceCert +open GapCVP.CNFFiveFamilySourceIndexedGadgetDescriptorExpansionTM + +private def fiveActualSourceSortedIndexedORGadgetPreparationWord + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : List Bool := + orGadgetFoldOutput + (fiveIndependentActualSortedDistinctBundledSourceWord + bound machine original) + +private noncomputable def fiveFamilyActualSourceSortedIndexedORGadgetPreparationComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (fiveActualSourceSortedIndexedORGadgetPreparationWord + bound machine) := by + have physical := GapCVP.TMComposition.computableInPolyTime + (fiveFamilyIndependentActualSortedDistinctBundledSourceComputable + bound machine) + flatAnnotatedIndexedORGadgetFoldComputable + change BitTM + (fun original : List Bool => + orGadgetFoldOutput + (fiveIndependentActualSortedDistinctBundledSourceWord + bound machine original)) + simpa only [Function.comp_def] using physical + +private theorem fiveFamilyActualSourceSortedIndexedORGadgetPreparationWord_valid + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (original : List Bool) : + fiveActualSourceSortedIndexedORGadgetPreparationWord + bound machine original = + totalVerifierSortedFiveFamilyFlatFoldInput + bound machine original := by + unfold fiveActualSourceSortedIndexedORGadgetPreparationWord + rw [fiveFamilyIndependentActualSortedDistinctBundledSourceWord_valid + bound machine original] + rw [flatAnnotatedIndexedORGadgetFoldOutput_valid] + unfold totalVerifierSortedFiveFamilyFlatFoldInput + rw [totalVerifierFiveFamilySourceClauseCandidates_sorted] + rfl + +private noncomputable def actualSortedFiveFamilyFlatPreparationComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (totalVerifierSortedFiveFamilyFlatFoldInput bound machine) := by + have physical := + fiveFamilyActualSourceSortedIndexedORGadgetPreparationComputable + bound machine + have equality : + fiveActualSourceSortedIndexedORGadgetPreparationWord + bound machine = + totalVerifierSortedFiveFamilyFlatFoldInput bound machine := by + funext original + exact fiveFamilyActualSourceSortedIndexedORGadgetPreparationWord_valid + bound machine original + rwa [equality] at physical + +/-- GapCVP reduction support. -/ +noncomputable def actualWholeStructuralCNFOutputComputable + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) : + BitTM + (structuralWholeCNFWord bound machine) := + actualWholeStructuralCNFOutputComputableOfFlatPreparation + bound machine + (actualSortedFiveFamilyFlatPreparationComputable bound machine) + +end CNFFiveFamilySourceIndexedORGadgetFinalCert + +section + +/-- GapCVP reduction support. -/ +noncomputable def gapFactor400 (I : GapCVPInstance) : ℝ := + (I.dimension : ℝ) ^ ((1 : ℝ) / 400) + +/-- GapCVP reduction support. -/ +noncomputable def gapYES400 (I : GapCVPInstance) : Bool := + @decide ( + gapCVPWellFormed I ∧ + ∃ z : Fin I.dimension → ℤ, + distanceSquared I z ≤ (I.radius : ℝ) ^ 2 + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def gapNO400 (I : GapCVPInstance) : Bool := + @decide ( + gapCVPWellFormed I ∧ + ∀ z : Fin I.dimension → ℤ, + (gapFactor400 I * (I.radius : ℝ)) ^ 2 < distanceSquared I z + ) (Classical.propDecidable _) +private theorem gapFactor400_one_le {I : GapCVPInstance} + (hdimension : 0 < I.dimension) : + 1 ≤ gapFactor400 I := by + unfold gapFactor400 + apply Real.one_le_rpow + · exact_mod_cast hdimension + · norm_num + +theorem gapYES400_not_gapNO400 (I : GapCVPInstance) + (hyes : gapYES400 I) (hno : gapNO400 I) : False := by + unfold gapYES400 at hyes + unfold gapNO400 at hno + have hyesProposition := ofClassicalDecide08 hyes + have hnoProposition := ofClassicalDecide08 hno + rcases hyesProposition with ⟨hwellFormed, z, hz⟩ + unfold gapCVPWellFormed at hwellFormed + have hwellFormedProposition := ofClassicalDecide08 hwellFormed + rcases hwellFormedProposition with ⟨hdimension, _, hradius⟩ + have hfactor := gapFactor400_one_le hdimension + have hradius_real : 0 < (I.radius : ℝ) := by + exact_mod_cast hradius + have hscaled : + (I.radius : ℝ) ≤ gapFactor400 I * (I.radius : ℝ) := by + nlinarith + have hsquare : + (I.radius : ℝ) ^ 2 ≤ + (gapFactor400 I * (I.radius : ℝ)) ^ 2 := by + nlinarith [sq_nonneg (gapFactor400 I * (I.radius : ℝ)), + sq_nonneg (I.radius : ℝ)] + have hfar := hnoProposition.2 z + linarith + +/-- GapCVP reduction support. -/ +noncomputable def gapCVP400Promise : PromiseProblem where + yes bits := + @decide ( + ∃ I : GapCVPInstance, + (binaryFinEncoding GapCVPInstance).encode I = bits ∧ gapYES400 I + ) (Classical.propDecidable _) + no bits := + @decide ( + ∃ I : GapCVPInstance, + (binaryFinEncoding GapCVPInstance).encode I = bits ∧ gapNO400 I + ) (Classical.propDecidable _) + disjoint bits hyes hno := by + simp only [decide_eq_true_eq] at hyes hno + rcases hyes with ⟨I, hI, hy⟩ + rcases hno with ⟨J, hJ, hn⟩ + have hsame : I = J := + (binaryFinEncoding GapCVPInstance).encode_injective + (hI.trans hJ.symm) + subst J + exact gapYES400_not_gapNO400 I hy hn + +theorem gapYES400_iff_gapYES (I : GapCVPInstance) : + gapYES400 I ↔ gapYES I := Iff.rfl + +end + +namespace Factor400BinaryCanonicalNo + +private theorem canonicalNoInstance_squaredNo400 : + GapCVP.Core.SquaredNoAt ((1 : ℝ) / 400) + GapCVP.Core.canonicalNoInstance := by + simp only [GapCVP.Core.SquaredNoAt, decide_eq_true_eq] at * + intro z + have hodd := GapCVP.Core.odd_integer_distance_gt_half (z 0) + have hnonnegative : + (0 : ℝ) ≤ |(1 : ℝ) - 2 * (z 0 : ℝ)| := abs_nonneg _ + have hsquare : + ((1 : ℝ) / 2) ^ 2 < + ((1 : ℝ) - 2 * (z 0 : ℝ)) ^ 2 := by + nlinarith [sq_abs ((1 : ℝ) - 2 * (z 0 : ℝ))] + simpa only [Core.canonicalNoInstance, one_div, Nat.cast_one, + Real.one_rpow, Rat.cast_inv, Rat.cast_ofNat, one_mul, inv_pow, + Core.squaredDistance, Matrix.of_apply, Fin.sum_univ_one, + Rat.cast_one, Int.cast_ofNat, gt_iff_lt] using hsquare + +/-- GapCVP reduction support. -/ +abbrev adaptedCanonicalNoInstance : GapCVP.GapCVPInstance where + dimension := GapCVP.Core.canonicalNoInstance.dimension + basis := GapCVP.Core.canonicalNoInstance.basis + target := GapCVP.Core.canonicalNoInstance.target + radius := GapCVP.Core.canonicalNoInstance.radius + +private theorem adaptedCanonicalNoInstance_wellFormed : + gapCVPWellFormed adaptedCanonicalNoInstance := by + simp only [GapCVP.gapCVPWellFormed, decide_eq_true_eq] at * + exact ⟨GapCVP.Core.canonicalNoInstance.dimension_pos, + GapCVP.Core.canonicalNoInstance.basis_nonsingular, + GapCVP.Core.canonicalNoInstance.radius_pos⟩ + +private theorem adaptedCanonicalNoInstance_distanceSquared + (z : Fin 1 → ℤ) : + distanceSquared adaptedCanonicalNoInstance z = + GapCVP.Core.squaredDistance GapCVP.Core.canonicalNoInstance z := by + simp only [distanceSquared, adaptedCanonicalNoInstance, + Core.canonicalNoInstance, Matrix.of_apply, Fin.sum_univ_one, + Int.cast_ofNat, Rat.cast_one, Core.squaredDistance] + ring + +private theorem adaptedCanonicalNoInstance_gapNO400 : + gapNO400 adaptedCanonicalNoInstance := by + simp only [GapCVP.gapNO400, decide_eq_true_eq] + refine ⟨adaptedCanonicalNoInstance_wellFormed, ?_⟩ + intro z + rw [adaptedCanonicalNoInstance_distanceSquared] + have noProof := canonicalNoInstance_squaredNo400 + simp only [GapCVP.Core.SquaredNoAt, decide_eq_true_eq] at noProof + have h := noProof z + simpa only [gapFactor400, adaptedCanonicalNoInstance, Core.canonicalNoInstance, one_div, + Nat.cast_one, + Real.one_rpow, Rat.cast_inv, Rat.cast_ofNat, one_mul, inv_pow, gt_iff_lt] using h + +/-- GapCVP reduction support. -/ +def adaptedCanonicalNoWord : List Bool := + (binaryFinEncoding GapCVPInstance).encode adaptedCanonicalNoInstance + +theorem adaptedCanonicalNoWord_mem_no : + gapCVP400Promise.no adaptedCanonicalNoWord := by + simp only [GapCVP.gapCVP400Promise, decide_eq_true_eq] + exact ⟨adaptedCanonicalNoInstance, rfl, + adaptedCanonicalNoInstance_gapNO400⟩ + +end Factor400BinaryCanonicalNo + +namespace Core + +/-- GapCVP reduction support. -/ +structure Literal (variableCount : ℕ) where + /-- GapCVP reduction support. -/ + variableIndex : Fin variableCount + /-- GapCVP reduction support. -/ + satisfyingValue : Bool +deriving DecidableEq + +/-- GapCVP reduction support. -/ +structure Clause (variableCount : ℕ) where + /-- GapCVP reduction support. -/ + literals : Finset (Literal variableCount) + nonempty : literals.Nonempty + size_le_three : literals.card ≤ 3 + +/-- GapCVP reduction support. -/ +structure Formula where + /-- GapCVP reduction support. -/ + variableCount : ℕ + /-- GapCVP reduction support. -/ + clauses : List (Clause variableCount) + +/-- GapCVP reduction support. -/ +noncomputable def Clause.Satisfied {variableCount : ℕ} (clause : Clause variableCount) + (assignment : Fin variableCount → Bool) : Bool := + @decide ( + ∃ literal ∈ clause.literals, + assignment literal.variableIndex = literal.satisfyingValue + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def Formula.Satisfied (formula : Formula) + (assignment : Fin formula.variableCount → Bool) : Bool := + @decide ( + ∀ i : Fin formula.clauses.length, + (formula.clauses.get i).Satisfied assignment + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def Formula.Satisfiable (formula : Formula) : Bool := + @decide ( + ∃ assignment : Fin formula.variableCount → Bool, + formula.Satisfied assignment + ) (Classical.propDecidable _) +end Core + +namespace Factor400FormulaBridge + +open GapCVP.SourceMachineCert + +theorem formula_satisfied_iff_forall_mem + (formula : GapCVP.Core.Formula) + (assignment : Fin formula.variableCount → Bool) : + formula.Satisfied assignment ↔ + ∀ clause ∈ formula.clauses, clause.Satisfied assignment := by + simp only [GapCVP.Core.Formula.Satisfied, decide_eq_true_eq] + constructor + · intro hsatisfied clause hclause + obtain ⟨index, hindex⟩ := List.mem_iff_get.mp hclause + rw [← hindex] + exact hsatisfied index + · intro hsatisfied index + exact hsatisfied _ (List.get_mem formula.clauses index) + +end Factor400FormulaBridge + +namespace BinarySourceVariableCompaction + +open GapCVP.SourceMachineCert + +/-- GapCVP reduction support. -/ +def occurringVariables (formula : ThreeCNF) : List ℕ := + (formulaVariables formula).eraseDups + +/-- GapCVP reduction support. -/ +def occurringVariableCount (formula : ThreeCNF) : ℕ := + (occurringVariables formula).length + +theorem mem_occurringVariables_iff + (formula : ThreeCNF) (name : ℕ) : + name ∈ occurringVariables formula ↔ + name ∈ formulaVariables formula := by + simp only [occurringVariables, List.mem_eraseDups] + +theorem eraseDups_nodup (names : List ℕ) : + names.eraseDups.Nodup := by + induction names using + (measure fun values : List ℕ => values.length).wf.induction with + | h names induction => + cases names with + | nil => simp only [List.eraseDups_nil, List.nodup_nil] + | cons name remaining => + rw [List.eraseDups_cons, List.nodup_cons] + constructor + · simp only [List.mem_eraseDups, List.mem_filter, BEq.rfl, Bool.not_true, + Bool.false_eq_true, and_false, + not_false_eq_true] + · exact induction + (remaining.filter fun candidate => !(candidate == name)) + (Nat.lt_succ_of_le (List.length_filter_le _ _)) + +theorem occurringVariables_nodup (formula : ThreeCNF) : + (occurringVariables formula).Nodup := + eraseDups_nodup (formulaVariables formula) + +/-- GapCVP reduction support. -/ +def compactVariableRank (formula : ThreeCNF) (name : ℕ) : ℕ := + (occurringVariables formula).idxOf name + +theorem mem_formulaVariables_iff_exists_literal + (formula : ThreeCNF) (name : ℕ) : + name ∈ formulaVariables formula ↔ + ∃ clause ∈ formula, ∃ index : Fin 3, + (clause index).1 = name := by + constructor + · intro hvariable + unfold formulaVariables at hvariable + obtain ⟨clause, hclause, hposition⟩ := + List.mem_flatMap.mp hvariable + simp only [List.mem_cons, List.not_mem_nil, or_false] at hposition + rcases hposition with hzero | hone | htwo + · exact ⟨clause, hclause, 0, hzero.symm⟩ + · exact ⟨clause, hclause, 1, hone.symm⟩ + · exact ⟨clause, hclause, 2, htwo.symm⟩ + · rintro ⟨clause, hclause, index, rfl⟩ + exact mem_formulaVariables formula clause hclause index + +end BinarySourceVariableCompaction + +namespace Core.EffectiveBinaryGaussian + +open scoped BigOperators +open Matrix + +/-- GapCVP reduction support. -/ +structure System (m n : ℕ) where + /-- GapCVP reduction support. -/ + check : Matrix (Fin m) (Fin n) (ZMod 2) + /-- GapCVP reduction support. -/ + rhs : Fin m → ZMod 2 + +/-- GapCVP reduction support. -/ +noncomputable def System.Satisfies {m n : ℕ} (system : System m n) + (assignment : Fin n → ZMod 2) : Bool := + @decide ( + system.check.mulVec assignment = system.rhs + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def swapRows {m n : ℕ} (system : System m n) + (left right : Fin m) : System m n where + check row column := system.check (Equiv.swap left right row) column + rhs row := system.rhs (Equiv.swap left right row) + +theorem swapRows_satisfies_iff {m n : ℕ} (system : System m n) + (left right : Fin m) (assignment : Fin n → ZMod 2) : + (swapRows system left right).Satisfies assignment ↔ + system.Satisfies assignment := by + simp only [GapCVP.Core.EffectiveBinaryGaussian.System.Satisfies, decide_eq_true_eq] at * + constructor + · intro h + funext row + have hr := congrFun h (Equiv.swap left right row) + simpa only [mulVec, dotProduct, swapRows, Equiv.swap_apply_self] using hr + · intro h + funext row + have hr := congrFun h (Equiv.swap left right row) + simpa only [mulVec, dotProduct, swapRows] using hr + +/-- GapCVP reduction support. -/ +def addRow {m n : ℕ} (system : System m n) + (source target : Fin m) : System m n where + check row column := + if row = target then + system.check row column + system.check source column + else system.check row column + rhs row := + if row = target then system.rhs row + system.rhs source + else system.rhs row + +theorem binary_add_self (value : ZMod 2) : value + value = 0 := by + have htwo : (2 : ZMod 2) = 0 := by decide + rw [← two_mul, htwo, zero_mul] + +theorem binary_eq_zero_of_ne_one (value : ZMod 2) + (hne : value ≠ 1) : value = 0 := by + have hval : value.val < 2 := ZMod.val_lt value + have hnotone : value.val ≠ 1 := by + intro h + apply hne + apply ZMod.val_injective 2 + rw [ZMod.val_one] + exact h + apply ZMod.val_injective 2 + simp only [ZMod.val_zero] + omega + +@[simp] private theorem addRow_twice {m n : ℕ} (system : System m n) + (source target : Fin m) (hne : source ≠ target) : + addRow (addRow system source target) source target = system := by + cases system with + | mk check rhs => + refine congrArg₂ (@System.mk m n) ?_ ?_ + · funext row column + by_cases hr : row = target + · subst row + simp only [↓reduceIte, addRow, hne, add_assoc, binary_add_self, add_zero] + · simp only [hr, ↓reduceIte, addRow] + · funext row + by_cases hr : row = target + · subst row + simp only [↓reduceIte, addRow, hne, add_assoc, binary_add_self, add_zero] + · simp only [hr, ↓reduceIte, addRow] + +private theorem satisfies_addRow {m n : ℕ} (system : System m n) + (source target : Fin m) (assignment : Fin n → ZMod 2) + (h : system.Satisfies assignment) : + (addRow system source target).Satisfies assignment := by + simp only [GapCVP.Core.EffectiveBinaryGaussian.System.Satisfies, decide_eq_true_eq] at * + funext row + by_cases hr : row = target + · subst row + have htarget := congrFun h target + have hsource := congrFun h source + simp only [addRow, ↓reduceIte, Matrix.mulVec, dotProduct] at htarget hsource ⊢ + simp_rw [add_mul] + rw [Finset.sum_add_distrib, htarget, hsource] + · have hrow := congrFun h row + simpa only [mulVec, dotProduct, addRow, hr, ↓reduceIte] using hrow + +theorem addRow_satisfies_iff {m n : ℕ} (system : System m n) + (source target : Fin m) (hne : source ≠ target) + (assignment : Fin n → ZMod 2) : + (addRow system source target).Satisfies assignment ↔ + system.Satisfies assignment := by + constructor + · intro h + have h' := satisfies_addRow + (addRow system source target) source target assignment h + simpa only [addRow_twice system source target hne] using h' + · exact satisfies_addRow system source target assignment + +/-- GapCVP reduction support. -/ +inductive RowOperation (m : ℕ) where + | swap (left right : Fin m) + | add (source target : Fin m) (distinct : source ≠ target) + +/-- GapCVP reduction support. -/ +def RowOperation.apply {m n : ℕ} (operation : RowOperation m) + (system : System m n) : System m n := + match operation with + | .swap left right => swapRows system left right + | .add source target _ => addRow system source target + +theorem RowOperation.satisfies_iff {m n : ℕ} + (operation : RowOperation m) (system : System m n) + (assignment : Fin n → ZMod 2) : + (operation.apply system).Satisfies assignment ↔ + system.Satisfies assignment := by + cases operation with + | swap left right => + exact swapRows_satisfies_iff system left right assignment + | add source target distinct => + exact addRow_satisfies_iff system source target distinct assignment + +/-- GapCVP reduction support. -/ +structure State (m n : ℕ) where + /-- GapCVP reduction support. -/ + system : System m n + /-- GapCVP reduction support. -/ + nextPivot : ℕ + /-- GapCVP reduction support. -/ + pivots : List (Fin m × Fin n) + /-- GapCVP reduction support. -/ + operations : List (RowOperation m) + +/-- GapCVP reduction support. -/ +def initialState {m n : ℕ} (system : System m n) : State m n where + system := system + nextPivot := 0 + pivots := [] + operations := [] + +/-- GapCVP reduction support. -/ +def applyOperation {m n : ℕ} (state : State m n) + (operation : RowOperation m) : State m n where + system := operation.apply state.system + nextPivot := state.nextPivot + pivots := state.pivots + operations := operation :: state.operations + +private theorem applyOperation_satisfies_iff {m n : ℕ} + (state : State m n) (operation : RowOperation m) + (assignment : Fin n → ZMod 2) : + (applyOperation state operation).system.Satisfies assignment ↔ + state.system.Satisfies assignment := + operation.satisfies_iff state.system assignment + +/-- GapCVP reduction support. -/ +def findPivotOption {m n : ℕ} (state : State m n) + (column : Fin n) : Option (Fin m) := + (List.finRange m).find? fun row => + decide (state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2)) + +theorem findPivotOption_some {m n : ℕ} (state : State m n) + (column : Fin n) (row : Fin m) + (h : findPivotOption state column = some row) : + state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2) := by + have hp := List.find?_some h + simpa only [Bool.decide_and, Bool.and_eq_true, decide_eq_true_eq] using hp + +/-- GapCVP reduction support. -/ +def clearTarget {m n : ℕ} (pivot : Fin m) (column : Fin n) + (state : State m n) (target : Fin m) : State m n := + if htarget : target = pivot then + state + else if state.system.check target column = (1 : ZMod 2) then + applyOperation state (.add pivot target (Ne.symm htarget)) + else + state + +private theorem clearTarget_satisfies_iff {m n : ℕ} + (pivot : Fin m) (column : Fin n) + (state : State m n) (target : Fin m) + (assignment : Fin n → ZMod 2) : + (clearTarget pivot column state target).system.Satisfies assignment ↔ + state.system.Satisfies assignment := by + unfold clearTarget + split + · rfl + · split + · exact applyOperation_satisfies_iff _ _ _ + · rfl + +theorem clearTarget_check_pivot {m n : ℕ} + (pivot : Fin m) (column otherColumn : Fin n) + (state : State m n) (target : Fin m) : + (clearTarget pivot column state target).system.check pivot otherColumn = + state.system.check pivot otherColumn := by + unfold clearTarget + split + · rfl + · rename_i hne + split + · simp only [applyOperation, RowOperation.apply, addRow, Ne.symm hne, ↓reduceIte] + · rfl + +theorem clearTarget_rhs_pivot {m n : ℕ} + (pivot : Fin m) (column : Fin n) + (state : State m n) (target : Fin m) : + (clearTarget pivot column state target).system.rhs pivot = + state.system.rhs pivot := by + unfold clearTarget + split + · rfl + · rename_i hne + split + · simp only [applyOperation, RowOperation.apply, addRow, Ne.symm hne, ↓reduceIte] + · rfl + +private theorem clearTarget_check_zero {m n : ℕ} + (pivot : Fin m) (column : Fin n) + (state : State m n) (target row : Fin m) + (hzero : state.system.check row column = 0) : + (clearTarget pivot column state target).system.check row column = 0 := by + unfold clearTarget + split + · exact hzero + · split + · rename_i hne hone + by_cases hrow : row = target + · subst row + simp only [hzero, zero_ne_one] at hone + · simpa only [applyOperation, RowOperation.apply, addRow, hrow, ↓reduceIte] using hzero + · exact hzero + +private theorem clearTarget_check_target_zero {m n : ℕ} + (pivot : Fin m) (column : Fin n) + (state : State m n) (target : Fin m) + (hne : target ≠ pivot) + (hpivot : state.system.check pivot column = 1) : + (clearTarget pivot column state target).system.check target column = 0 := by + unfold clearTarget + simp only [hne, ↓reduceDIte] + by_cases hone : state.system.check target column = (1 : ZMod 2) + · simp only [hone, ↓reduceIte, applyOperation, RowOperation.apply, + addRow, ↓reduceIte] + rw [hpivot, binary_add_self] + · simp only [hone, ↓reduceIte] + exact binary_eq_zero_of_ne_one _ hone + +/-- GapCVP reduction support. -/ +def clearTargets {m n : ℕ} (pivot : Fin m) (column : Fin n) + (targets : List (Fin m)) (state : State m n) : State m n := + targets.foldl (clearTarget pivot column) state + +private theorem clearTargets_satisfies_iff {m n : ℕ} + (pivot : Fin m) (column : Fin n) + (targets : List (Fin m)) (state : State m n) + (assignment : Fin n → ZMod 2) : + (clearTargets pivot column targets state).system.Satisfies assignment ↔ + state.system.Satisfies assignment := by + induction targets generalizing state with + | nil => rfl + | cons target rest ih => + change + (clearTargets pivot column rest + (clearTarget pivot column state target)).system.Satisfies assignment ↔ + state.system.Satisfies assignment + exact (ih (clearTarget pivot column state target)).trans + (clearTarget_satisfies_iff pivot column state target assignment) + +private theorem clearTargets_check_pivot {m n : ℕ} + (pivot : Fin m) (column otherColumn : Fin n) + (targets : List (Fin m)) (state : State m n) : + (clearTargets pivot column targets state).system.check + pivot otherColumn = state.system.check pivot otherColumn := by + induction targets generalizing state with + | nil => rfl + | cons target rest ih => + change + (clearTargets pivot column rest + (clearTarget pivot column state target)).system.check + pivot otherColumn = state.system.check pivot otherColumn + exact (ih (clearTarget pivot column state target)).trans + (clearTarget_check_pivot pivot column otherColumn state target) + +private theorem clearTargets_check_zero {m n : ℕ} + (pivot : Fin m) (column : Fin n) + (targets : List (Fin m)) (state : State m n) (row : Fin m) + (hzero : state.system.check row column = 0) : + (clearTargets pivot column targets state).system.check row column = 0 := by + induction targets generalizing state with + | nil => exact hzero + | cons target rest ih => + change + (clearTargets pivot column rest + (clearTarget pivot column state target)).system.check + row column = 0 + exact ih (clearTarget pivot column state target) + (clearTarget_check_zero pivot column state target row hzero) + +private theorem clearTargets_check_zero_of_mem {m n : ℕ} + (pivot : Fin m) (column : Fin n) + (targets : List (Fin m)) (state : State m n) (row : Fin m) + (hpivot : state.system.check pivot column = 1) + (hne : row ≠ pivot) (hmem : row ∈ targets) : + (clearTargets pivot column targets state).system.check row column = 0 := by + induction targets generalizing state with + | nil => simp only [List.not_mem_nil] at hmem + | cons target rest ih => + change + (clearTargets pivot column rest + (clearTarget pivot column state target)).system.check + row column = 0 + rcases List.mem_cons.mp hmem with hrow | hrest + · subst target + exact clearTargets_check_zero pivot column rest + (clearTarget pivot column state row) row + (clearTarget_check_target_zero pivot column state row hne hpivot) + · apply ih (clearTarget pivot column state target) + · rw [clearTarget_check_pivot] + exact hpivot + · exact hrest + +/-- GapCVP reduction support. -/ +def columnStep {m n : ℕ} (state : State m n) + (column : Fin n) : State m n := + if hrow : state.nextPivot < m then + match findPivotOption state column with + | none => state + | some candidate => + let pivot : Fin m := ⟨state.nextPivot, hrow⟩ + let swapped := applyOperation state (.swap candidate pivot) + let cleared := clearTargets pivot column (List.finRange m) swapped + { cleared with + nextPivot := state.nextPivot + 1 + pivots := (pivot, column) :: cleared.pivots } + else + state + +private theorem columnStep_satisfies_iff {m n : ℕ} + (state : State m n) (column : Fin n) + (assignment : Fin n → ZMod 2) : + (columnStep state column).system.Satisfies assignment ↔ + state.system.Satisfies assignment := by + by_cases hrow : state.nextPivot < m + · cases hpivot : findPivotOption state column with + | none => + simp only [columnStep, hrow, ↓reduceDIte, hpivot] + | some candidate => + simp only [columnStep, hrow, ↓reduceDIte, hpivot] + exact (clearTargets_satisfies_iff + ⟨state.nextPivot, hrow⟩ column (List.finRange m) + (applyOperation state + (.swap candidate ⟨state.nextPivot, hrow⟩)) assignment).trans + (applyOperation_satisfies_iff state + (.swap candidate ⟨state.nextPivot, hrow⟩) assignment) + · simp only [columnStep, hrow, ↓reduceDIte] + +theorem columnStep_pivot_column {m n : ℕ} + (state : State m n) (column : Fin n) + (hrow : state.nextPivot < m) (candidate : Fin m) + (hfound : findPivotOption state column = some candidate) + (row : Fin m) : + (columnStep state column).system.check row column = + if row = (⟨state.nextPivot, hrow⟩ : Fin m) + then (1 : ZMod 2) else 0 := by + let pivot : Fin m := ⟨state.nextPivot, hrow⟩ + let swapped : State m n := + applyOperation state (.swap candidate pivot) + have hcandidate := (findPivotOption_some state column candidate hfound).2 + have hpivot : swapped.system.check pivot column = 1 := by + simp [swapped, applyOperation, RowOperation.apply, + swapRows, Equiv.swap_apply_right, hcandidate] + simp only [columnStep, hrow, ↓reduceDIte, hfound] + by_cases hsame : row = pivot + · subst row + change + (clearTargets pivot column (List.finRange m) swapped).system.check + pivot column = if pivot = ⟨state.nextPivot, hrow⟩ then 1 else 0 + rw [clearTargets_check_pivot] + simpa [pivot] using hpivot + · change + (clearTargets pivot column (List.finRange m) swapped).system.check + row column = if row = ⟨state.nextPivot, hrow⟩ then 1 else 0 + have hzero := clearTargets_check_zero_of_mem + pivot column (List.finRange m) swapped row hpivot hsame + (List.mem_finRange row) + simpa [pivot, hsame] using hzero + +private theorem addRow_check_of_source_zero {m n : ℕ} + (system : System m n) (source target : Fin m) + (column : Fin n) + (hzero : system.check source column = 0) (row : Fin m) : + (addRow system source target).check row column = + system.check row column := by + by_cases hrow : row = target + · subst row + simp only [addRow, ↓reduceIte, hzero, add_zero] + · simp only [addRow, hrow, ↓reduceIte] + +private theorem clearTarget_check_of_pivot_zero {m n : ℕ} + (pivot : Fin m) (pivotColumn oldColumn : Fin n) + (state : State m n) (target row : Fin m) + (hzero : state.system.check pivot oldColumn = 0) : + (clearTarget pivot pivotColumn state target).system.check + row oldColumn = state.system.check row oldColumn := by + unfold clearTarget + split + · rfl + · split + · exact addRow_check_of_source_zero + state.system pivot target oldColumn hzero row + · rfl + +theorem clearTargets_check_of_pivot_zero {m n : ℕ} + (pivot : Fin m) (pivotColumn oldColumn : Fin n) + (targets : List (Fin m)) (state : State m n) + (hzero : state.system.check pivot oldColumn = 0) (row : Fin m) : + (clearTargets pivot pivotColumn targets state).system.check + row oldColumn = state.system.check row oldColumn := by + induction targets generalizing state with + | nil => rfl + | cons target rest ih => + change + (clearTargets pivot pivotColumn rest + (clearTarget pivot pivotColumn state target)).system.check + row oldColumn = state.system.check row oldColumn + have hpivot : + (clearTarget pivot pivotColumn state target).system.check + pivot oldColumn = 0 := by + rw [clearTarget_check_pivot] + exact hzero + calc + (clearTargets pivot pivotColumn rest + (clearTarget pivot pivotColumn state target)).system.check + row oldColumn = + (clearTarget pivot pivotColumn state target).system.check + row oldColumn := ih _ hpivot + _ = state.system.check row oldColumn := + clearTarget_check_of_pivot_zero + pivot pivotColumn oldColumn state target row hzero + +/-- GapCVP reduction support. -/ +def runColumns {m n : ℕ} + (columns : List (Fin n)) (state : State m n) : State m n := + columns.foldl columnStep state + +private theorem runColumns_satisfies_iff {m n : ℕ} + (columns : List (Fin n)) (state : State m n) + (assignment : Fin n → ZMod 2) : + (runColumns columns state).system.Satisfies assignment ↔ + state.system.Satisfies assignment := by + induction columns generalizing state with + | nil => rfl + | cons column rest ih => + change + (runColumns rest (columnStep state column)).system.Satisfies assignment ↔ + state.system.Satisfies assignment + exact (ih (columnStep state column)).trans + (columnStep_satisfies_iff state column assignment) + +/-- GapCVP reduction support. -/ +def eliminate {m n : ℕ} (system : System m n) : State m n := + runColumns (List.finRange n) (initialState system) + +theorem eliminate_satisfies_iff {m n : ℕ} + (system : System m n) (assignment : Fin n → ZMod 2) : + (eliminate system).system.Satisfies assignment ↔ + system.Satisfies assignment := by + exact runColumns_satisfies_iff + (List.finRange n) (initialState system) assignment + +end Core.EffectiveBinaryGaussian + +namespace Core.EffectiveBinaryField + +open scoped BigOperators +open Polynomial + +/-- GapCVP reduction support. -/ +abbrev Word (e : ℕ) := Fin e → Bool + +/-- GapCVP reduction support. -/ +def allWords : (e : ℕ) → List (Word e) + | 0 => [fun i => Fin.elim0 i] + | e + 1 => + (allWords e).flatMap fun tail => + [Fin.cases false tail, Fin.cases true tail] + +private theorem word_head_tail {e : ℕ} (word : Word (e + 1)) : + Fin.cases (word 0) (fun i : Fin e => word i.succ) = word := by + funext i + refine Fin.cases ?_ (fun j => ?_) i + · rfl + · rfl + +theorem mem_allWords {e : ℕ} (word : Word e) : word ∈ allWords e := by + induction e with + | zero => + have heq : word = (fun i : Fin 0 => Fin.elim0 i) := by + funext i + exact Fin.elim0 i + simp only [allWords, heq, List.mem_cons, List.not_mem_nil, or_false] + | succ e ih => + let tail : Word e := fun i => word i.succ + have htail : tail ∈ allWords e := ih tail + have hword : Fin.cases (word 0) tail = word := + word_head_tail word + rw [← hword, allWords] + apply List.mem_flatMap.mpr + refine ⟨tail, htail, ?_⟩ + cases hbit : word 0 <;> simp + +/-- GapCVP reduction support. -/ +def bitValue (bit : Bool) : ZMod 2 := + if bit then 1 else 0 + +theorem bitValue_xor (left right : Bool) : + bitValue (Bool.xor left right) = + bitValue left + bitValue right := by + cases left <;> cases right <;> decide + +private theorem bitValue_and (left right : Bool) : + bitValue (left && right) = + bitValue left * bitValue right := by + cases left <;> cases right <;> decide + +private theorem bitValue_decide (value : ZMod 2) : + bitValue (decide (value = 1)) = value := by + by_cases h : value = 1 + · subst value + decide + · have hz := EffectiveBinaryGaussian.binary_eq_zero_of_ne_one value h + simp only [bitValue, hz, zero_ne_one, decide_false, Bool.false_eq_true, ↓reduceIte] + +/-- GapCVP reduction support. -/ +noncomputable def wordPolynomial {e : ℕ} + (word : Word e) : (ZMod 2)[X] := + ∑ i : Fin e, Polynomial.monomial i.val (bitValue (word i)) + +@[simp] theorem wordPolynomial_coeff_fin {e : ℕ} + (word : Word e) (i : Fin e) : + (wordPolynomial word).coeff i.val = bitValue (word i) := by + classical + unfold wordPolynomial + rw [Polynomial.finsetSum_coeff] + rw [Finset.sum_eq_single i] + · simp only [coeff_monomial_same] + · intro j _ hji + have hval : j.val ≠ i.val := by + intro heq + exact hji (Fin.ext heq) + simp only [coeff_monomial, hval, ↓reduceIte] + · simp only [Finset.mem_univ, not_true_eq_false, coeff_monomial_same, IsEmpty.forall_iff] + +theorem wordPolynomial_coeff_eq_zero {e : ℕ} + (word : Word e) (k : ℕ) (hk : e ≤ k) : + (wordPolynomial word).coeff k = 0 := by + classical + simp only [wordPolynomial, finsetSum_coeff, coeff_monomial, + show ∀ i : Fin e, i.val ≠ k by + intro i h + have := i.isLt + omega, + ↓reduceIte, Finset.sum_const_zero] + +theorem wordPolynomial_degree_lt {e : ℕ} + (word : Word e) : + (wordPolynomial word).degree < (e : WithBot ℕ) := by + apply (Polynomial.degree_lt_iff_coeff_zero _ e).mpr + intro k hk + exact wordPolynomial_coeff_eq_zero word k hk + +/-- GapCVP reduction support. -/ +noncomputable def monicPolynomial {e : ℕ} + (word : Word e) : (ZMod 2)[X] := + Polynomial.X ^ e + wordPolynomial word + +/-- GapCVP reduction support. -/ +noncomputable def coefficientWord (e : ℕ) (p : (ZMod 2)[X]) : Word e := + fun i => decide (p.coeff i.val = 1) + +private theorem wordPolynomial_coefficientWord + (e : ℕ) (p : (ZMod 2)[X]) + (hdegree : p.degree < (e : WithBot ℕ)) : + wordPolynomial (coefficientWord e p) = p := by + classical + apply Polynomial.ext + intro k + by_cases hk : k < e + · let i : Fin e := ⟨k, hk⟩ + change + (wordPolynomial (coefficientWord e p)).coeff i.val = + p.coeff i.val + rw [wordPolynomial_coeff_fin] + exact bitValue_decide (p.coeff i.val) + · have hke : e ≤ k := Nat.le_of_not_gt hk + rw [wordPolynomial_coeff_eq_zero _ k hke] + symm + exact ((Polynomial.degree_lt_iff_coeff_zero p e).mp hdegree) k hke + +private theorem exists_monicPolynomial_word + {e : ℕ} (p : (ZMod 2)[X]) + (hmonic : p.Monic) (hdegree : p.natDegree = e) : + ∃ word : Word e, monicPolynomial word = p := by + let lower := p.eraseLead + have hlow : lower.degree < (e : WithBot ℕ) := by + have hp : p ≠ 0 := hmonic.ne_zero + have h := Polynomial.degree_eraseLead_lt hp + rw [Polynomial.degree_eq_natDegree hp, hdegree] at h + exact h + refine ⟨coefficientWord e lower, ?_⟩ + unfold monicPolynomial + rw [wordPolynomial_coefficientWord e lower hlow] + have hlead := Polynomial.eraseLead_add_monomial_natDegree_leadingCoeff p + rw [hdegree, hmonic.leadingCoeff, ← Polynomial.X_pow_eq_monomial] at hlead + simpa only [add_comm] using hlead + +private theorem exists_monic_irreducible_polynomial + (e : ℕ) (he : 0 < e) : + ∃ p : (ZMod 2)[X], + p.Monic ∧ p.natDegree = e ∧ Irreducible p := by + obtain ⟨root, hroot⟩ := + Field.exists_primitive_element_of_finite_top + (ZMod 2) (GaloisField 2 e) + have hintegral : IsIntegral (ZMod 2) root := + IsIntegral.of_finite (ZMod 2) root + refine ⟨minpoly (ZMod 2) root, + minpoly.monic hintegral, ?_, minpoly.irreducible hintegral⟩ + calc + (minpoly (ZMod 2) root).natDegree = + Module.finrank (ZMod 2) (GaloisField 2 e) := + (Field.primitive_element_iff_minpoly_natDegree_eq + (ZMod 2) root).mp hroot + _ = e := GaloisField.finrank 2 (Nat.ne_of_gt he) + +private theorem exists_monic_irreducible_word + (e : ℕ) (he : 0 < e) : + ∃ word : Word e, Irreducible (monicPolynomial word) := by + obtain ⟨p, hmonic, hdegree, hirr⟩ := + exists_monic_irreducible_polynomial e he + obtain ⟨word, hword⟩ := + exists_monicPolynomial_word p hmonic hdegree + exact ⟨word, hword.symm ▸ hirr⟩ + +private theorem monicPolynomial_monic {e : ℕ} + (word : Word e) : + (monicPolynomial word).Monic := by + exact Polynomial.monic_X_pow_add (wordPolynomial_degree_lt word) + +private theorem monicPolynomial_natDegree {e : ℕ} + (word : Word e) : + (monicPolynomial word).natDegree = e := by + have hdegree : + (monicPolynomial word).degree = (e : WithBot ℕ) := by + unfold monicPolynomial + have hlt : + (wordPolynomial word).degree < + (Polynomial.X ^ e : (ZMod 2)[X]).degree := by + simpa only [degree_pow, degree_X, nsmul_eq_mul, mul_one] using wordPolynomial_degree_lt word + simpa only [degree_pow, degree_X, nsmul_eq_mul, mul_one] + using Polynomial.degree_add_eq_left_of_degree_lt hlt + have hne : monicPolynomial word ≠ 0 := + (monicPolynomial_monic word).ne_zero + rw [Polynomial.degree_eq_natDegree hne] at hdegree + exact_mod_cast hdegree + +private theorem bitValue_foldl {α : Type} + (items : List α) (step : Bool → α → Bool) + (weight : α → ZMod 2) + (hstep : ∀ accumulator item, + bitValue (step accumulator item) = + bitValue accumulator + weight item) + (initial : Bool) : + bitValue (items.foldl step initial) = + bitValue initial + (items.map weight).sum := by + induction items generalizing initial with + | nil => + simp only [bitValue, List.foldl_nil, List.map_nil, List.sum_nil, add_zero] + rfl + | cons item rest ih => + simp only [List.foldl_cons, List.map_cons, List.sum_cons] + rw [ih (step initial item), hstep] + ac_rfl + +private theorem finRange_list_sum {e : ℕ} (f : Fin e → ZMod 2) : + ((List.finRange e).map f).sum = ∑ i : Fin e, f i := by + rfl + +/-- GapCVP reduction support. -/ +def multiplyWords {e : ℕ} (left right : Word e) : Word (2 * e) := + fun k => + (List.finRange e).foldl + (fun acc i => + (List.finRange e).foldl + (fun inner j => + if i.val + j.val = k.val then + Bool.xor inner (left i && right j) + else inner) + acc) + false + +private theorem bitValue_multiplyWords {e : ℕ} + (left right : Word e) (k : Fin (2 * e)) : + bitValue (multiplyWords left right k) = + ∑ i : Fin e, ∑ j : Fin e, + if i.val + j.val = k.val then + bitValue (left i) * bitValue (right j) + else 0 := by + have hinner (i : Fin e) (initial : Bool) : + bitValue + ((List.finRange e).foldl + (fun inner j => + if i.val + j.val = k.val then + Bool.xor inner (left i && right j) + else inner) + initial) = + bitValue initial + + ∑ j : Fin e, + if i.val + j.val = k.val then + bitValue (left i) * bitValue (right j) + else 0 := by + calc + bitValue + ((List.finRange e).foldl + (fun inner j => + if i.val + j.val = k.val then + Bool.xor inner (left i && right j) + else inner) + initial) = + bitValue initial + + ((List.finRange e).map fun j => + if i.val + j.val = k.val then + bitValue (left i) * bitValue (right j) + else 0).sum := by + apply bitValue_foldl + intro accumulator j + by_cases hij : i.val + j.val = k.val + · simp only [hij, ↓reduceIte, bitValue_xor, bitValue_and] + · simp only [hij, ↓reduceIte, add_zero] + _ = bitValue initial + + ∑ j : Fin e, + if i.val + j.val = k.val then + bitValue (left i) * bitValue (right j) + else 0 := by + rw [finRange_list_sum] + unfold multiplyWords + calc + bitValue + ((List.finRange e).foldl + (fun acc i => + (List.finRange e).foldl + (fun inner j => + if i.val + j.val = k.val then + Bool.xor inner (left i && right j) + else inner) + acc) + false) = + bitValue false + + ((List.finRange e).map fun i => + ∑ j : Fin e, + if i.val + j.val = k.val then + bitValue (left i) * bitValue (right j) + else 0).sum := by + apply bitValue_foldl + intro accumulator i + exact hinner i accumulator + _ = ∑ i : Fin e, ∑ j : Fin e, + if i.val + j.val = k.val then + bitValue (left i) * bitValue (right j) + else 0 := by + rw [finRange_list_sum] + simp only [bitValue, Bool.false_eq_true, ↓reduceIte, mul_ite, mul_one, mul_zero, zero_add] + +private theorem wordPolynomial_mul_coeff {e : ℕ} + (left right : Word e) (k : ℕ) : + (wordPolynomial left * wordPolynomial right).coeff k = + ∑ i : Fin e, ∑ j : Fin e, + if i.val + j.val = k then + bitValue (left i) * bitValue (right j) + else 0 := by + classical + simp only [wordPolynomial, Finset.mul_sum, Finset.sum_mul, monomial_mul_monomial, + finsetSum_coeff, + coeff_monomial] + rw [Finset.sum_comm] + +theorem wordPolynomial_multiplyWords {e : ℕ} + (left right : Word e) : + wordPolynomial (multiplyWords left right) = + wordPolynomial left * wordPolynomial right := by + classical + apply Polynomial.ext + intro k + by_cases hk : k < 2 * e + · let i : Fin (2 * e) := ⟨k, hk⟩ + change + (wordPolynomial (multiplyWords left right)).coeff i.val = + (wordPolynomial left * wordPolynomial right).coeff i.val + rw [wordPolynomial_coeff_fin, bitValue_multiplyWords, + wordPolynomial_mul_coeff] + · have hlarge : 2 * e ≤ k := Nat.le_of_not_gt hk + rw [wordPolynomial_coeff_eq_zero _ k hlarge, + wordPolynomial_mul_coeff] + symm + apply Finset.sum_eq_zero + intro i _ + apply Finset.sum_eq_zero + intro j _ + have hne : i.val + j.val ≠ k := by + have hi := i.isLt + have hj := j.isLt + omega + simp only [hne, ↓reduceIte] + +/-- GapCVP reduction support. -/ +def monicWord {e : ℕ} (lower : Word e) : Word (2 * e) := + fun i => + if h : i.val < e then lower ⟨i.val, h⟩ + else decide (i.val = e) + +theorem bitValue_injective : Function.Injective bitValue := by + intro left right h + cases left <;> cases right <;> simp [bitValue] at h ⊢ + +private theorem wordPolynomial_injective {e : ℕ} : + Function.Injective (@wordPolynomial e) := by + intro left right h + funext i + apply bitValue_injective + have hcoeff := congrArg (fun p : (ZMod 2)[X] => p.coeff i.val) h + simpa only [wordPolynomial_coeff_fin] using hcoeff + +private theorem wordPolynomial_monicWord {e : ℕ} (he : 0 < e) + (lower : Word e) : + wordPolynomial (monicWord lower) = monicPolynomial lower := by + classical + apply Polynomial.ext + intro k + by_cases hk : k < 2 * e + · let i : Fin (2 * e) := ⟨k, hk⟩ + change + (wordPolynomial (monicWord lower)).coeff i.val = + (monicPolynomial lower).coeff i.val + rw [wordPolynomial_coeff_fin] + unfold monicPolynomial + rw [Polynomial.coeff_add, Polynomial.coeff_X_pow] + by_cases hlow : i.val < e + · have hne : i.val ≠ e := Nat.ne_of_lt hlow + rw [ite_eq_right hne] + simp only [zero_add] + change + bitValue (if h : i.val < e then lower ⟨i.val, h⟩ + else decide (i.val = e)) = + (wordPolynomial lower).coeff i.val + simp only [hlow, ↓reduceDIte] + exact (wordPolynomial_coeff_fin lower ⟨i.val, hlow⟩).symm + · have hlarge : e ≤ i.val := Nat.le_of_not_gt hlow + rw [wordPolynomial_coeff_eq_zero lower i.val hlarge, add_zero] + change + bitValue (if h : i.val < e then lower ⟨i.val, h⟩ + else decide (i.val = e)) = + if i.val = e then 1 else 0 + simp only [bitValue, hlow, ↓reduceDIte, decide_eq_true_eq] + · have hlarge : 2 * e ≤ k := Nat.le_of_not_gt hk + rw [wordPolynomial_coeff_eq_zero _ k hlarge] + unfold monicPolynomial + rw [Polynomial.coeff_add, Polynomial.coeff_X_pow] + have hke : e ≤ k := by omega + rw [wordPolynomial_coeff_eq_zero lower k hke] + have hne : k ≠ e := by omega + simp only [hne, ↓reduceIte, add_zero] + +private theorem multiplyWords_eq_monicWord_iff {e : ℕ} (he : 0 < e) + (left right lower : Word e) : + multiplyWords left right = monicWord lower ↔ + wordPolynomial left * wordPolynomial right = + monicPolynomial lower := by + constructor + · intro h + calc + wordPolynomial left * wordPolynomial right = + wordPolynomial (multiplyWords left right) := + (wordPolynomial_multiplyWords left right).symm + _ = wordPolynomial (monicWord lower) := congrArg wordPolynomial h + _ = monicPolynomial lower := wordPolynomial_monicWord he lower + · intro h + apply wordPolynomial_injective + rw [wordPolynomial_multiplyWords, + wordPolynomial_monicWord he lower] + exact h + +/-- GapCVP reduction support. -/ +def noProperFactors (e : ℕ) (lower : Word e) : Bool := + (allWords e).all fun left => + (allWords e).all fun right => + decide (multiplyWords left right ≠ monicWord lower) + +theorem noProperFactors_eq_true_iff {e : ℕ} (lower : Word e) : + noProperFactors e lower = true ↔ + ∀ left right : Word e, + multiplyWords left right ≠ monicWord lower := by + constructor + · intro h left right + have hleft := (List.all_eq_true.mp h) left (mem_allWords left) + have hright := (List.all_eq_true.mp hleft) right (mem_allWords right) + exact of_decide_eq_true hright + · intro h + apply List.all_eq_true.mpr + intro left _ + apply List.all_eq_true.mpr + intro right _ + exact decide_eq_true (h left right) + +private theorem monicPolynomial_irreducible_iff {e : ℕ} (he : 0 < e) + (lower : Word e) : + Irreducible (monicPolynomial lower) ↔ + ∀ left right : Word e, + multiplyWords left right ≠ monicWord lower := by + constructor + · intro hirr left right hbits + have hfactor : + monicPolynomial lower = + wordPolynomial left * wordPolynomial right := + ((multiplyWords_eq_monicWord_iff he left right lower).mp hbits).symm + have hnonzero : monicPolynomial lower ≠ 0 := + (monicPolynomial_monic lower).ne_zero + have hleft : wordPolynomial left ≠ 0 := by + intro h + apply hnonzero + rw [hfactor, h, zero_mul] + have hright : wordPolynomial right ≠ 0 := by + intro h + apply hnonzero + rw [hfactor, h, mul_zero] + have hleftdegree : (wordPolynomial left).natDegree < e := + (Polynomial.natDegree_lt_iff_degree_lt hleft).mpr + (wordPolynomial_degree_lt left) + have hrightdegree : (wordPolynomial right).natDegree < e := + (Polynomial.natDegree_lt_iff_degree_lt hright).mpr + (wordPolynomial_degree_lt right) + have hdegree : + e = (wordPolynomial left).natDegree + + (wordPolynomial right).natDegree := by + have h := congrArg Polynomial.natDegree hfactor + rw [monicPolynomial_natDegree, + Polynomial.natDegree_mul hleft hright] at h + exact h + rcases (irreducible_iff.mp hirr).2 hfactor with hunit | hunit + · have hzero := Polynomial.natDegree_eq_zero_of_isUnit hunit + omega + · have hzero := Polynomial.natDegree_eq_zero_of_isUnit hunit + omega + · intro hno + apply irreducible_iff.mpr + constructor + · apply Polynomial.not_isUnit_of_natDegree_pos + rw [monicPolynomial_natDegree] + exact he + · intro left right hfactor + by_cases hleftunit : IsUnit left + · exact Or.inl hleftunit + by_cases hrightunit : IsUnit right + · exact Or.inr hrightunit + exfalso + have hnonzero : monicPolynomial lower ≠ 0 := + (monicPolynomial_monic lower).ne_zero + have hleft : left ≠ 0 := by + intro h + apply hnonzero + rw [hfactor, h, zero_mul] + have hright : right ≠ 0 := by + intro h + apply hnonzero + rw [hfactor, h, mul_zero] + have hdegree : e = left.natDegree + right.natDegree := by + have h := congrArg Polynomial.natDegree hfactor + rw [monicPolynomial_natDegree, + Polynomial.natDegree_mul hleft hright] at h + exact h + have hleftpositive : 0 < left.natDegree := + Polynomial.natDegree_pos_of_not_isUnit_of_dvd_monic + (monicPolynomial_monic lower) hleftunit + ⟨right, hfactor⟩ + have hrightpositive : 0 < right.natDegree := + Polynomial.natDegree_pos_of_not_isUnit_of_dvd_monic + (monicPolynomial_monic lower) hrightunit + ⟨left, by simpa only [mul_comm] using hfactor⟩ + have hleftdegree : left.natDegree < e := by omega + have hrightdegree : right.natDegree < e := by omega + have hleftdegree' : left.degree < (e : WithBot ℕ) := + (Polynomial.natDegree_lt_iff_degree_lt hleft).mp hleftdegree + have hrightdegree' : right.degree < (e : WithBot ℕ) := + (Polynomial.natDegree_lt_iff_degree_lt hright).mp hrightdegree + let leftWord := coefficientWord e left + let rightWord := coefficientWord e right + have hleftWord : wordPolynomial leftWord = left := + wordPolynomial_coefficientWord e left hleftdegree' + have hrightWord : wordPolynomial rightWord = right := + wordPolynomial_coefficientWord e right hrightdegree' + apply hno leftWord rightWord + apply (multiplyWords_eq_monicWord_iff + he leftWord rightWord lower).mpr + rw [hleftWord, hrightWord] + exact hfactor.symm + +private theorem noProperFactors_eq_true_iff_irreducible {e : ℕ} + (he : 0 < e) (lower : Word e) : + noProperFactors e lower = true ↔ + Irreducible (monicPolynomial lower) := by + rw [noProperFactors_eq_true_iff] + exact (monicPolynomial_irreducible_iff he lower).symm + +/-- GapCVP reduction support. -/ +def findIrreducibleWordOption (e : ℕ) : Option (Word e) := + (allWords e).find? (noProperFactors e) + +private theorem findIrreducibleWordOption_some {e : ℕ} (word : Word e) + (h : findIrreducibleWordOption e = some word) : + noProperFactors e word = true := + List.find?_some h + +theorem findIrreducibleWordOption_exists + (e : ℕ) (he : 0 < e) : + ∃ word : Word e, + findIrreducibleWordOption e = some word ∧ + Irreducible (monicPolynomial word) := by + obtain ⟨candidate, hirr⟩ := exists_monic_irreducible_word e he + have hcandidate : noProperFactors e candidate = true := + (noProperFactors_eq_true_iff_irreducible he candidate).mpr hirr + cases hfind : findIrreducibleWordOption e with + | none => + exfalso + have hnone : + ∀ word ∈ allWords e, + ¬ noProperFactors e word = true := by + exact List.find?_eq_none.mp hfind + exact hnone candidate (mem_allWords candidate) hcandidate + | some word => + refine ⟨word, rfl, ?_⟩ + apply (noProperFactors_eq_true_iff_irreducible he word).mp + exact findIrreducibleWordOption_some word hfind + +/-- GapCVP reduction support. -/ +def irreducibleWord (e : ℕ) : Word e := + (findIrreducibleWordOption e).getD fun _ => false + +private theorem irreducibleWord_irreducible (e : ℕ) (he : 0 < e) : + Irreducible (monicPolynomial (irreducibleWord e)) := by + obtain ⟨word, hword, hirr⟩ := findIrreducibleWordOption_exists e he + simpa only [irreducibleWord, hword, Option.getD_some] using hirr + +/-- GapCVP reduction support. -/ +def xorAt {d : ℕ} (word : Word d) (index : Fin d) (bit : Bool) : Word d := + fun i => if i = index then Bool.xor (word i) bit else word i + +theorem wordPolynomial_xorAt {d : ℕ} + (word : Word d) (index : Fin d) (bit : Bool) : + wordPolynomial (xorAt word index bit) = + wordPolynomial word + + Polynomial.monomial index.val (bitValue bit) := by + classical + apply Polynomial.ext + intro k + by_cases hk : k < d + · let i : Fin d := ⟨k, hk⟩ + change + (wordPolynomial (xorAt word index bit)).coeff i.val = + (wordPolynomial word + + Polynomial.monomial index.val (bitValue bit)).coeff i.val + rw [Polynomial.coeff_add, wordPolynomial_coeff_fin, + wordPolynomial_coeff_fin, Polynomial.coeff_monomial] + by_cases hi : i = index + · subst index + simp only [xorAt, ↓reduceIte, bitValue_xor] + · have hval : index.val ≠ i.val := by + intro h + exact hi (Fin.ext h.symm) + simp only [xorAt, hi, ↓reduceIte, hval, add_zero] + · have hlarge : d ≤ k := Nat.le_of_not_gt hk + have hindex : index.val ≠ k := by + have hlt := index.isLt + omega + rw [wordPolynomial_coeff_eq_zero _ k hlarge, + Polynomial.coeff_add, + wordPolynomial_coeff_eq_zero _ k hlarge, + Polynomial.coeff_monomial] + simp only [hindex, ↓reduceIte, add_zero] + +/-- GapCVP reduction support. -/ +def shiftXor {e : ℕ} (lower : Word e) (degree : ℕ) + (word : Word (2 * e)) : Word (2 * e) := + (List.finRange e).foldl + (fun accumulator i => + if h : degree - e + i.val < 2 * e then + xorAt accumulator ⟨degree - e + i.val, h⟩ (lower i) + else + accumulator) + word + +/-- GapCVP reduction support. -/ +def reduceAt {e : ℕ} (lower : Word e) (degree : ℕ) + (word : Word (2 * e)) : Word (2 * e) := + if hd : e ≤ degree ∧ degree < 2 * e then + let leading : Fin (2 * e) := ⟨degree, hd.2⟩ + if word leading then + shiftXor lower degree (xorAt word leading true) + else + word + else + word + +/-- GapCVP reduction support. -/ +def reduceProduct {e : ℕ} (lower : Word e) + (word : Word (2 * e)) : Word (2 * e) := + (List.range e).foldl + (fun accumulator offset => + reduceAt lower (2 * e - 1 - offset) accumulator) + word + +/-- GapCVP reduction support. -/ +def multiplyMod {e : ℕ} + (lower left right : Word e) : Word e := + fun i => + (reduceProduct lower (multiplyWords left right)) + ⟨i.val, by + have hi := i.isLt + omega⟩ + +/-- GapCVP reduction support. -/ +noncomputable def selectedPolynomial (e : ℕ) : (ZMod 2)[X] := + monicPolynomial (irreducibleWord e) + +theorem selectedPolynomial_monic (e : ℕ) : + (selectedPolynomial e).Monic := + monicPolynomial_monic (irreducibleWord e) + +theorem selectedPolynomial_natDegree (e : ℕ) : + (selectedPolynomial e).natDegree = e := + monicPolynomial_natDegree (irreducibleWord e) + +private theorem selectedPolynomial_irreducible (e : ℕ) (he : 0 < e) : + Irreducible (selectedPolynomial e) := + irreducibleWord_irreducible e he + +/-- GapCVP reduction support. -/ +abbrev Extension (e : ℕ) := + AdjoinRoot (selectedPolynomial e) + +private noncomputable def extensionBasis (e : ℕ) : + Module.Basis (Fin e) (ZMod 2) (Extension e) := + (AdjoinRoot.powerBasisAux' (selectedPolynomial_monic e)).reindex + (finCongr (selectedPolynomial_natDegree e)) + +noncomputable instance extensionFintype (e : ℕ) : + Fintype (Extension e) := + Fintype.ofEquiv (Fin e → ZMod 2) + (extensionBasis e).equivFun.toEquiv.symm + +private theorem extension_card (e : ℕ) : + Fintype.card (Extension e) = 2 ^ e := by + simpa only [ZMod.card, Fintype.card_fin] using Module.card_fintype (extensionBasis e) + +/-- GapCVP reduction support. -/ +noncomputable def extensionAlgEquivGaloisField (e : ℕ) (he : 0 < e) : + Extension e ≃ₐ[ZMod 2] GaloisField 2 e := by + letI : Fact (Irreducible (selectedPolynomial e)) := + ⟨selectedPolynomial_irreducible e he⟩ + exact GaloisField.algEquivGaloisFieldOfFintype 2 e + (extension_card e) + +end Core.EffectiveBinaryField + +namespace BinaryFieldBasis + +open Polynomial GapCVP.Core GapCVP.Core.EffectiveBinaryField + +/-- GapCVP reduction support. -/ +def indexedWord (degree : ℕ) (index : Fin (2 ^ degree)) : + EffectiveBinaryField.Word degree := + fun bit => index.val.testBit bit.val + +theorem indexedWord_injective (degree : ℕ) : + Function.Injective (indexedWord degree) := by + intro left right hwords + apply Fin.ext + apply Nat.eq_of_testBit_eq + intro bit + by_cases hin : bit < degree + · exact congrFun hwords ⟨bit, hin⟩ + · have hge : degree ≤ bit := Nat.le_of_not_gt hin + have hpower : 2 ^ degree ≤ 2 ^ bit := + Nat.pow_le_pow_right (by norm_num) hge + have hleft : left.val < 2 ^ bit := + lt_of_lt_of_le left.isLt hpower + have hright : right.val < 2 ^ bit := + lt_of_lt_of_le right.isLt hpower + rw [Nat.testBit_eq_false_of_lt hleft, + Nat.testBit_eq_false_of_lt hright] + +/-- GapCVP reduction support. -/ +def boundedWordIndex {degree count : ℕ} + (hcount : count ≤ 2 ^ degree) : + Fin count ↪ Fin (2 ^ degree) := + Fin.castLEEmb hcount + +/-- GapCVP reduction support. -/ +def evaluationWordIndex {degree count : ℕ} + (hcount : count ≤ 2 ^ degree) : + Fin (2 ^ degree - count) ↪ Fin (2 ^ degree) := + (Fin.natAddEmb count).trans + (finCongr (Nat.add_sub_of_le hcount)).toEmbedding + +attribute [local instance] Classical.propDecidable + +noncomputable instance (priority := 100) + factor400GaloisFieldFintype (degree : ℕ) : + Fintype (GaloisField 2 degree) := + Fintype.ofFinite (GaloisField 2 degree) + +/-- GapCVP reduction support. -/ +def wordElement {degree : ℕ} + (word : EffectiveBinaryField.Word degree) : + EffectiveBinaryField.Extension degree := + AdjoinRoot.mk (EffectiveBinaryField.selectedPolynomial degree) + (EffectiveBinaryField.wordPolynomial word) + +theorem wordElement_injective (degree : ℕ) : + Function.Injective (@wordElement degree) := by + intro left right helements + have hdivides : + EffectiveBinaryField.selectedPolynomial degree ∣ + EffectiveBinaryField.wordPolynomial left - + EffectiveBinaryField.wordPolynomial right := + AdjoinRoot.mk_eq_mk.mp helements + have hdegree : + (EffectiveBinaryField.wordPolynomial left - + EffectiveBinaryField.wordPolynomial right).degree < + (degree : WithBot ℕ) := + (Polynomial.degree_sub_le _ _).trans_lt + (max_lt (EffectiveBinaryField.wordPolynomial_degree_lt left) + (EffectiveBinaryField.wordPolynomial_degree_lt right)) + have hmodulus : + (EffectiveBinaryField.selectedPolynomial degree).degree = + (degree : WithBot ℕ) := by + rw [Polynomial.degree_eq_natDegree + (EffectiveBinaryField.selectedPolynomial_monic degree).ne_zero, + EffectiveBinaryField.selectedPolynomial_natDegree] + have hzero : + EffectiveBinaryField.wordPolynomial left - + EffectiveBinaryField.wordPolynomial right = 0 := by + by_contra hnonzero + have hmonic := EffectiveBinaryField.selectedPolynomial_monic degree + have hnot := hmonic.not_dvd_of_degree_lt hnonzero (by + rw [hmodulus] + exact hdegree) + exact hnot hdivides + exact EffectiveBinaryField.wordPolynomial_injective + (sub_eq_zero.mp hzero) + +/-- GapCVP reduction support. -/ +def effectiveExtensionBasis (degree : ℕ) : + Module.Basis (Fin degree) (ZMod 2) + (EffectiveBinaryField.Extension degree) := + EffectiveBinaryField.extensionBasis degree + +/-- GapCVP reduction support. -/ +def effectiveFieldBasis (degree : ℕ) (hdegree : 0 < degree) : + Module.Basis (Fin degree) (ZMod 2) (GaloisField 2 degree) := + (effectiveExtensionBasis degree).map + (EffectiveBinaryField.extensionAlgEquivGaloisField + degree hdegree).toLinearEquiv + +theorem effectiveFieldBasis_coordinates_transport + (degree : ℕ) (hdegree : 0 < degree) + (value : EffectiveBinaryField.Extension degree) : + (effectiveFieldBasis degree hdegree).equivFun + (EffectiveBinaryField.extensionAlgEquivGaloisField + degree hdegree value) = + (effectiveExtensionBasis degree).equivFun value := by + simp only [effectiveFieldBasis, Module.Basis.map_equivFun, LinearEquiv.trans_apply, + AlgEquiv.coe_symm_toLinearEquiv, AlgEquiv.symm_apply_apply, Module.Basis.equivFun_apply] + +private def indexedFieldElement (degree : ℕ) (hdegree : 0 < degree) + (index : Fin (2 ^ degree)) : GaloisField 2 degree := + EffectiveBinaryField.extensionAlgEquivGaloisField degree hdegree + (wordElement (indexedWord degree index)) + +private theorem indexedFieldElement_injective + (degree : ℕ) (hdegree : 0 < degree) : + Function.Injective (indexedFieldElement degree hdegree) := by + exact (EffectiveBinaryField.extensionAlgEquivGaloisField + degree hdegree).injective.comp + ((wordElement_injective degree).comp + (indexedWord_injective degree)) + +private theorem field_card (degree : ℕ) (hdegree : 0 < degree) : + Fintype.card (GaloisField 2 degree) = 2 ^ degree := by + rw [Fintype.card_eq_nat_card] + exact GaloisField.card 2 degree hdegree.ne' + +private theorem indexedFieldElement_bijective + (degree : ℕ) (hdegree : 0 < degree) : + Function.Bijective (indexedFieldElement degree hdegree) := by + apply (Fintype.bijective_iff_injective_and_card _).2 + refine ⟨indexedFieldElement_injective degree hdegree, ?_⟩ + simp only [Fintype.card_fin, field_card degree hdegree] + +/-- GapCVP reduction support. -/ +def indexedFieldEquiv (degree : ℕ) (hdegree : 0 < degree) : + Fin (2 ^ degree) ≃ GaloisField 2 degree := + Equiv.ofBijective (indexedFieldElement degree hdegree) + (indexedFieldElement_bijective degree hdegree) + +/-- GapCVP reduction support. -/ +def effectiveAnchor (degree : ℕ) (hdegree : 0 < degree) + {count : ℕ} (hcount : count ≤ 2 ^ degree) : + Fin count ↪ GaloisField 2 degree where + toFun index := indexedFieldElement degree hdegree + (boundedWordIndex hcount index) + inj' := (indexedFieldElement_injective degree hdegree).comp + (boundedWordIndex hcount).injective + +/-- GapCVP reduction support. -/ +def effectiveEvaluationEmbedding (degree : ℕ) (hdegree : 0 < degree) + {count : ℕ} (hcount : count ≤ 2 ^ degree) : + Fin (2 ^ degree - count) ↪ GaloisField 2 degree where + toFun index := indexedFieldElement degree hdegree + (evaluationWordIndex hcount index) + inj' := (indexedFieldElement_injective degree hdegree).comp + (evaluationWordIndex hcount).injective + +theorem effectiveEvaluationEmbedding_ne_anchor + (degree : ℕ) (hdegree : 0 < degree) + {count : ℕ} (hcount : count ≤ 2 ^ degree) + (point : Fin (2 ^ degree - count)) + (anchor : Fin count) : + effectiveEvaluationEmbedding degree hdegree hcount point ≠ + effectiveAnchor degree hdegree hcount anchor := by + intro hequal + have hindex := + indexedFieldElement_injective degree hdegree hequal + have hvalue := congrArg Fin.val hindex + change count + point.val = anchor.val at hvalue + have hanchor := anchor.isLt + omega + +end BinaryFieldBasis + +namespace Core + +section + +open Matrix + +variable {K : Type*} [Field K] [Algebra (ZMod 2) K] +variable {e m n : ℕ} + +/-- GapCVP reduction support. -/ +def binaryFieldVectorEquiv + (basis : Module.Basis (Fin e) (ZMod 2) K) (dimension : ℕ) : + (Fin dimension → K) ≃ₗ[ZMod 2] + ((Fin dimension × Fin e) → ZMod 2) := + (LinearEquiv.piCongrRight fun _ : Fin dimension => basis.equivFun).trans + (LinearEquiv.curry (ZMod 2) (ZMod 2) (Fin dimension) (Fin e)).symm + +/-- GapCVP reduction support. -/ +def binaryFieldBitEmbedding (dimension : ℕ) : + (Fin dimension → ZMod 2) →ₗ[ZMod 2] (Fin dimension → K) := + LinearMap.pi fun i => + (Algebra.linearMap (ZMod 2) K).comp (LinearMap.proj i) + +/-- GapCVP reduction support. -/ +def binaryFieldParityLinearMap + (basis : Module.Basis (Fin e) (ZMod 2) K) + (checks : Matrix (Fin m) (Fin n) K) : + (Fin n → ZMod 2) →ₗ[ZMod 2] + ((Fin m × Fin e) → ZMod 2) := + (binaryFieldVectorEquiv basis m).toLinearMap.comp + ((checks.mulVecLin.restrictScalars (ZMod 2)).comp + (binaryFieldBitEmbedding n)) + +/-- GapCVP reduction support. -/ +def binaryFieldParityMatrix + (basis : Module.Basis (Fin e) (ZMod 2) K) + (checks : Matrix (Fin m) (Fin n) K) : + Matrix (Fin m × Fin e) (Fin n) (ZMod 2) := + LinearMap.toMatrix' (binaryFieldParityLinearMap basis checks) + +private def binaryFieldRightHandSide + (basis : Module.Basis (Fin e) (ZMod 2) K) + (target : Fin m → K) : (Fin m × Fin e) → ZMod 2 := + binaryFieldVectorEquiv basis m target + +private theorem binaryFieldParityMatrix_mulVec + (basis : Module.Basis (Fin e) (ZMod 2) K) + (checks : Matrix (Fin m) (Fin n) K) + (bits : Fin n → ZMod 2) : + (binaryFieldParityMatrix basis checks).mulVec bits = + binaryFieldVectorEquiv basis m + (checks.mulVec + (fun position => algebraMap (ZMod 2) K (bits position))) := by + rw [binaryFieldParityMatrix, LinearMap.toMatrix'_mulVec] + rfl + +private theorem binaryFieldParityMatrix_mulVec_eq_iff + (basis : Module.Basis (Fin e) (ZMod 2) K) + (checks : Matrix (Fin m) (Fin n) K) + (bits : Fin n → ZMod 2) (target : Fin m → K) : + (binaryFieldParityMatrix basis checks).mulVec bits = + binaryFieldRightHandSide basis target ↔ + checks.mulVec + (fun position => algebraMap (ZMod 2) K (bits position)) = + target := by + rw [binaryFieldParityMatrix_mulVec] + change binaryFieldVectorEquiv basis m _ = + binaryFieldVectorEquiv basis m target ↔ _ + constructor + · intro h + exact (binaryFieldVectorEquiv basis m).injective h + · intro h + rw [h] + +end + +section + +/-- GapCVP reduction support. -/ +def binaryResidue {n : ℕ} (z : Fin n → ℤ) : Fin n → ZMod 2 := + fun i => (z i : ZMod 2) + +theorem binaryResidue_sub {n : ℕ} (x y : Fin n → ℤ) : + binaryResidue (x - y) = binaryResidue x - binaryResidue y := by + ext i + simp only [binaryResidue, Pi.sub_apply, Int.cast_sub] + +/-- GapCVP reduction support. -/ +structure BinaryAffineSystem where + /-- GapCVP reduction support. -/ + rowCount : ℕ + /-- GapCVP reduction support. -/ + dimension : ℕ + /-- GapCVP reduction support. -/ + check : Matrix (Fin rowCount) (Fin dimension) (ZMod 2) + /-- GapCVP reduction support. -/ + rightHandSide : Fin rowCount → ZMod 2 + +/-- GapCVP reduction support. -/ +noncomputable def BinaryAffineSystem.Solves (system : BinaryAffineSystem) + (z : Fin system.dimension → ℤ) : Bool := + @decide ( + system.check.mulVec (binaryResidue z) = system.rightHandSide + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +noncomputable def BinaryAffineSystem.InLattice (system : BinaryAffineSystem) + (z : Fin system.dimension → ℤ) : Bool := + @decide ( + system.check.mulVec (binaryResidue z) = 0 + ) (Classical.propDecidable _) +theorem BinaryAffineSystem.solves_sub_iff_inLattice + (system : BinaryAffineSystem) {u : Fin system.dimension → ℤ} + (hu : system.Solves u) (z : Fin system.dimension → ℤ) : + system.Solves (u - z) ↔ system.InLattice z := by + simp only [BinaryAffineSystem.Solves, BinaryAffineSystem.InLattice, + decide_eq_true_eq] at hu ⊢ + rw [binaryResidue_sub, Matrix.mulVec_sub, hu] + simp only [sub_eq_self] + +open Matrix + +variable {ι K : Type*} [Field K] [Algebra (ZMod 2) K] +variable {e n : ℕ} + +/-- GapCVP reduction support. -/ +abbrev assembledBinaryRow (rowCounts : ι → ℕ) (e : ℕ) := + Σ family : ι, Fin (rowCounts family) × Fin e + +/-- GapCVP reduction support. -/ +def assembledBinaryParityMatrix + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → Matrix (Fin (rowCounts family)) (Fin n) K) : + Matrix (assembledBinaryRow rowCounts e) (Fin n) (ZMod 2) := + fun row column => + binaryFieldParityMatrix basis (checks row.1) row.2 column + +/-- GapCVP reduction support. -/ +def assembledBinaryRightHandSide + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (targets : (family : ι) → Fin (rowCounts family) → K) : + assembledBinaryRow rowCounts e → ZMod 2 := + fun row => binaryFieldRightHandSide basis (targets row.1) row.2 + +@[simp] theorem assembledBinaryParityMatrix_mulVec_apply + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → Matrix (Fin (rowCounts family)) (Fin n) K) + (bits : Fin n → ZMod 2) + (row : assembledBinaryRow rowCounts e) : + (assembledBinaryParityMatrix basis rowCounts checks).mulVec bits row = + (binaryFieldParityMatrix basis (checks row.1)).mulVec bits row.2 := by + rfl + +theorem assembledBinaryParityMatrix_mulVec_eq_iff + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → Matrix (Fin (rowCounts family)) (Fin n) K) + (bits : Fin n → ZMod 2) + (targets : (family : ι) → Fin (rowCounts family) → K) : + (assembledBinaryParityMatrix basis rowCounts checks).mulVec bits = + assembledBinaryRightHandSide basis rowCounts targets ↔ + ∀ family : ι, + (checks family).mulVec + (fun position => algebraMap (ZMod 2) K (bits position)) = + targets family := by + constructor + · intro h family + apply (binaryFieldParityMatrix_mulVec_eq_iff + basis (checks family) bits (targets family)).mp + funext coordinate + exact congrFun h ⟨family, coordinate⟩ + · intro h + funext row + obtain ⟨family, coordinate⟩ := row + change + (binaryFieldParityMatrix basis (checks family)).mulVec bits coordinate = + binaryFieldRightHandSide basis (targets family) coordinate + exact congrFun + ((binaryFieldParityMatrix_mulVec_eq_iff + basis (checks family) bits (targets family)).mpr (h family)) + coordinate + +/-- GapCVP reduction support. -/ +abbrev assembledBinaryAffineSystem [Fintype ι] + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → Matrix (Fin (rowCounts family)) (Fin n) K) + (targets : (family : ι) → Fin (rowCounts family) → K) : + BinaryAffineSystem where + rowCount := Fintype.card (assembledBinaryRow rowCounts e) + dimension := n + check := fun row column => + assembledBinaryParityMatrix basis rowCounts checks + ((Fintype.equivFin (assembledBinaryRow rowCounts e)).symm row) + column + rightHandSide := fun row => + assembledBinaryRightHandSide basis rowCounts targets + ((Fintype.equivFin (assembledBinaryRow rowCounts e)).symm row) + +@[simp] private theorem assembledBinaryAffineSystem_check_mulVec_apply + [Fintype ι] + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → Matrix (Fin (rowCounts family)) (Fin n) K) + (targets : (family : ι) → Fin (rowCounts family) → K) + (bits : Fin n → ZMod 2) + (row : Fin (Fintype.card (assembledBinaryRow rowCounts e))) : + (assembledBinaryAffineSystem basis rowCounts checks targets).check.mulVec + bits row = + (assembledBinaryParityMatrix basis rowCounts checks).mulVec bits + ((Fintype.equivFin (assembledBinaryRow rowCounts e)).symm row) := by + rfl + +@[simp] private theorem assembledBinaryAffineSystem_rightHandSide_apply + [Fintype ι] + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → Matrix (Fin (rowCounts family)) (Fin n) K) + (targets : (family : ι) → Fin (rowCounts family) → K) + (row : Fin (Fintype.card (assembledBinaryRow rowCounts e))) : + (assembledBinaryAffineSystem basis rowCounts checks targets).rightHandSide + row = + assembledBinaryRightHandSide basis rowCounts targets + ((Fintype.equivFin (assembledBinaryRow rowCounts e)).symm row) := by + rfl + +private theorem assembledBinaryAffineSystem_check_mulVec_eq_iff + [Fintype ι] + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → Matrix (Fin (rowCounts family)) (Fin n) K) + (bits : Fin n → ZMod 2) + (targets : (family : ι) → Fin (rowCounts family) → K) : + (assembledBinaryAffineSystem basis rowCounts checks targets).check.mulVec + bits = + (assembledBinaryAffineSystem basis rowCounts checks targets).rightHandSide ↔ + ∀ family : ι, + (checks family).mulVec + (fun position => algebraMap (ZMod 2) K (bits position)) = + targets family := by + let rowEquiv := Fintype.equivFin (assembledBinaryRow rowCounts e) + constructor + · intro h + apply (assembledBinaryParityMatrix_mulVec_eq_iff + basis rowCounts checks bits targets).mp + funext row + have hrow := congrFun h (rowEquiv row) + rw [assembledBinaryAffineSystem_check_mulVec_apply, + assembledBinaryAffineSystem_rightHandSide_apply] at hrow + simpa [rowEquiv] using hrow + · intro h + have hstack := (assembledBinaryParityMatrix_mulVec_eq_iff + basis rowCounts checks bits targets).mpr h + funext row + have hrow := congrFun hstack (rowEquiv.symm row) + rw [assembledBinaryAffineSystem_check_mulVec_apply, + assembledBinaryAffineSystem_rightHandSide_apply] + exact hrow + +theorem assembledBinaryAffineSystem_solves_iff + [Fintype ι] + (basis : Module.Basis (Fin e) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → Matrix (Fin (rowCounts family)) (Fin n) K) + (targets : (family : ι) → Fin (rowCounts family) → K) + (z : Fin n → ℤ) : + (assembledBinaryAffineSystem basis rowCounts checks targets).Solves z ↔ + ∀ family : ι, + (checks family).mulVec + (fun position => algebraMap (ZMod 2) K + (z position : ZMod 2)) = targets family := by + simp only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] + exact assembledBinaryAffineSystem_check_mulVec_eq_iff + basis rowCounts checks (binaryResidue z) targets + +end + +section + +theorem source_moment_degree_le {N d : ℕ} + (hd : d ≤ N) : d * N ^ 30 ≤ N ^ 31 := by + calc + d * N ^ 30 ≤ N * N ^ 30 := Nat.mul_le_mul_right _ hd + _ = N ^ 31 := + (mul_comm N (N ^ 30)).trans (pow_succ N 30).symm + +private theorem source_moment_degree_lt_punctured_grid {N q m : ℕ} + (hN : 100 ≤ N) (hq : N ^ 200 ≤ q) (hm : m ≤ N) : + N ^ 31 < q - m := by + have hbase : 1 < N := by omega + have hNpow : N ≤ N ^ 31 := by + calc + N = N ^ 1 := by simp only [pow_one] + _ ≤ N ^ 31 := Nat.pow_le_pow_right (by omega) (by norm_num) + have hdouble : N ^ 31 + N ^ 31 ≤ N * N ^ 31 := by + have h := Nat.mul_le_mul_right (N ^ 31) (show 2 ≤ N by omega) + simpa only [ge_iff_le, two_mul] using h + have hsum : N ^ 31 + N ≤ N ^ 32 := by + calc + N ^ 31 + N ≤ N ^ 31 + N ^ 31 := Nat.add_le_add_left hNpow _ + _ ≤ N * N ^ 31 := hdouble + _ = N ^ 32 := + (mul_comm N (N ^ 31)).trans (pow_succ N 31).symm + have hpow : N ^ 32 < N ^ 200 := + Nat.pow_lt_pow_right hbase (by norm_num) + have htotal : N ^ 31 + m < q := by + have hsmall : N ^ 31 + m ≤ N ^ 31 + N := Nat.add_le_add_left hm _ + exact (hsmall.trans hsum).trans_lt (hpow.trans_le hq) + omega + +/-- GapCVP reduction support. -/ +def sourcePuncturedGrid {k : Type*} [Fintype k] [DecidableEq k] + (variablePlaces : Finset k) : Finset k := + Finset.univ \ variablePlaces + +private theorem sourcePuncturedGrid_card {k : Type*} + [Fintype k] [DecidableEq k] (variablePlaces : Finset k) : + (sourcePuncturedGrid variablePlaces).card = + Fintype.card k - variablePlaces.card := by + unfold sourcePuncturedGrid + rw [Finset.card_sdiff_of_subset (Finset.subset_univ _)] + simp only [Finset.card_univ] + +theorem source_moment_degree_lt_actual_grid + {k : Type*} [Fintype k] [DecidableEq k] + {N : ℕ} (variablePlaces : Finset k) + (hN : 100 ≤ N) + (hq : N ^ 200 ≤ Fintype.card k) + (hplaces : variablePlaces.card ≤ N) : + N ^ 31 < (sourcePuncturedGrid variablePlaces).card := by + rw [sourcePuncturedGrid_card] + exact source_moment_degree_lt_punctured_grid hN hq hplaces + +theorem source_cleared_moment_degree_lt_half_field_size {N q : ℕ} + (hN : 100 ≤ N) (hq : N ^ 200 ≤ q) : + 2 * N ^ 39 < q / 2 := by + have hpositive : 1 ≤ N ^ 39 := by + have hpos : 0 < N ^ 39 := pow_pos (by omega) _ + omega + have hscale : 6 * N ^ 39 ≤ N * N ^ 39 := + Nat.mul_le_mul_right (N ^ 39) (show 6 ≤ N by omega) + have hneeded : (2 * N ^ 39 + 1) * 2 ≤ q := by + calc + (2 * N ^ 39 + 1) * 2 ≤ 6 * N ^ 39 := by omega + _ ≤ N * N ^ 39 := hscale + _ = N ^ 40 := + (mul_comm N (N ^ 39)).trans (pow_succ N 39).symm + _ ≤ N ^ 200 := + Nat.pow_le_pow_right (by omega) (by norm_num) + _ ≤ q := hq + have hhalf : 2 * N ^ 39 + 1 ≤ q / 2 := + (Nat.le_div_iff_mul_le (by norm_num : 0 < (2 : ℕ))).mpr hneeded + omega + +theorem source_clause_support_lt_moment_budget {N : ℕ} + (hN : 100 ≤ N) : 9 * N ^ 4 < N ^ 30 := by + calc + 9 * N ^ 4 ≤ N * N ^ 4 := + Nat.mul_le_mul_right (N ^ 4) (by omega) + _ = N ^ 5 := (mul_comm N (N ^ 4)).trans (pow_succ N 4).symm + _ < N ^ 30 := Nat.pow_lt_pow_right (by omega) (by norm_num) + +private theorem source_valuation_moment_degree_lt_budget {N : ℕ} + (hN : 100 ≤ N) : 5 * N ^ 21 < N ^ 30 := by + calc + 5 * N ^ 21 ≤ N * N ^ 21 := + Nat.mul_le_mul_right (N ^ 21) (by omega) + _ = N ^ 22 := (mul_comm N (N ^ 21)).trans (pow_succ N 21).symm + _ < N ^ 30 := Nat.pow_lt_pow_right (by omega) (by norm_num) + +private theorem source_valuation_index_le {N h U : ℕ} + (hN : 100 ≤ N) (hh : h ≤ N ^ 4) (hU : U ≤ 4 * N ^ 17) : + h * U + h ≤ 5 * N ^ 21 := by + have hproduct : N ^ 4 * (4 * N ^ 17) = 4 * N ^ 21 := by + rw [show (21 : ℕ) = 4 + 17 by norm_num, pow_add] + ring + have hpower : N ^ 4 ≤ N ^ 21 := + Nat.pow_le_pow_right (by omega) (by norm_num) + calc + h * U + h ≤ N ^ 4 * (4 * N ^ 17) + N ^ 4 := by + gcongr + _ = 4 * N ^ 21 + N ^ 4 := by rw [hproduct] + _ ≤ 5 * N ^ 21 := by omega + +theorem source_valuation_index_lt_moment_budget {N h U : ℕ} + (hN : 100 ≤ N) (hh : h ≤ N ^ 4) (hU : U ≤ 4 * N ^ 17) : + h * U + h < N ^ 30 := by + exact (source_valuation_index_le hN hh hU).trans_lt + (source_valuation_moment_degree_lt_budget hN) + +theorem source_cleared_moment_degree_le {N d h j : ℕ} + (hd : d ≤ N) (hh : h ≤ N ^ 4) (hj : j ≤ N ^ 30) : + 2 * d * h ^ 2 * j ≤ 2 * N ^ 39 := by + calc + 2 * d * h ^ 2 * j ≤ 2 * N * (N ^ 4) ^ 2 * N ^ 30 := by + gcongr + _ = 2 * N ^ (1 + 4 * 2 + 30) := by + rw [pow_add, pow_add, pow_one, pow_mul] + ring + _ = 2 * N ^ 39 := by norm_num + +private theorem source_output_dimension_le {N ell theta p q : ℕ} + (hN : 100 ≤ N) + (hell : ell ≤ N) + (htheta : theta ≤ 1 + 8 * ell) + (hp : p ≤ q) + (hq : q < 2 * N ^ 200) : + theta * p * q ≤ 40 * N ^ 401 := by + have hthetaNine : theta ≤ 9 * N := by omega + have hqTwo : q ≤ 2 * N ^ 200 := Nat.le_of_lt hq + have hpTwo : p ≤ 2 * N ^ 200 := hp.trans hqTwo + calc + theta * p * q ≤ + (9 * N) * (2 * N ^ 200) * (2 * N ^ 200) := by + gcongr + _ = 36 * N ^ 401 := by + rw [show (401 : ℕ) = 1 + 200 + 200 by norm_num, + pow_add, pow_add, pow_one] + ring + _ ≤ 40 * N ^ 401 := Nat.mul_le_mul_right _ (by norm_num) + +/-- GapCVP reduction support. -/ +@[irreducible] def sourceFieldExponent (N : ℕ) : ℕ := + Nat.clog 2 (N ^ 200) + +theorem sourceFieldExponent_eq (N : ℕ) : + sourceFieldExponent N = Nat.clog 2 (N ^ 200) := by + rw [sourceFieldExponent] + +/-- GapCVP reduction support. -/ +abbrev SourceFiniteField (N : ℕ) := + GaloisField 2 (sourceFieldExponent N) + +noncomputable instance sourceFiniteFieldFintype (N : ℕ) : + Fintype (SourceFiniteField N) := + Fintype.ofFinite (SourceFiniteField N) + +theorem sourceFieldExponent_pos {N : ℕ} (hN : 100 ≤ N) : + 0 < sourceFieldExponent N := by + unfold sourceFieldExponent + apply Nat.clog_pos (by norm_num) + simpa only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, Nat.one_lt_pow_iff, pow_zero] using + (Nat.pow_lt_pow_right (show 1 < N by omega) (show (0 : ℕ) < 200 by norm_num)) + +theorem sourceFiniteField_card {N : ℕ} (hN : 100 ≤ N) : + Fintype.card (SourceFiniteField N) = + 2 ^ sourceFieldExponent N := by + rw [Fintype.card_eq_nat_card] + exact GaloisField.card 2 (sourceFieldExponent N) + (Nat.ne_of_gt (sourceFieldExponent_pos hN)) + +theorem sourceFiniteField_card_lower {N : ℕ} (hN : 100 ≤ N) : + N ^ 200 ≤ Fintype.card (SourceFiniteField N) := by + rw [sourceFiniteField_card hN, sourceFieldExponent_eq] + exact Nat.le_pow_clog (by norm_num) (N ^ 200) + +theorem sourceFiniteField_card_upper {N : ℕ} (hN : 100 ≤ N) : + Fintype.card (SourceFiniteField N) < 2 * N ^ 200 := by + rw [sourceFiniteField_card hN] + have hpow : 1 < N ^ 200 := by + simpa only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, Nat.one_lt_pow_iff, pow_zero] using + (Nat.pow_lt_pow_right (show 1 < N by omega) (show (0 : ℕ) < 200 by norm_num)) + have hpred : + 2 ^ (sourceFieldExponent N).pred < N ^ 200 := by + rw [sourceFieldExponent_eq] + exact Nat.pow_pred_clog_lt_self (by norm_num) hpow + have hexp : (sourceFieldExponent N).pred + 1 = + sourceFieldExponent N := + Nat.succ_pred_eq_of_pos (sourceFieldExponent_pos hN) + calc + 2 ^ sourceFieldExponent N = + 2 ^ ((sourceFieldExponent N).pred + 1) := by rw [hexp] + _ = 2 * 2 ^ (sourceFieldExponent N).pred := by + rw [pow_succ] + ac_rfl + _ < 2 * N ^ 200 := Nat.mul_lt_mul_of_pos_left hpred (by norm_num) + +open Matrix Finset + +private theorem hankel_eq_vandermonde_transpose_mul {R : Type*} [CommRing R] + {n : ℕ} (v : Fin n → R) : + (Matrix.of fun i j : Fin n => ∑ k : Fin n, v k ^ (i.val + j.val)) = + (Matrix.vandermonde v)ᵀ * Matrix.vandermonde v := by + ext i j + simpa only [of_apply] using (Matrix.vandermonde_transpose_mul_vandermonde v i j).symm + +theorem hankel_det_eq_vandermonde_det_sq {R : Type*} [CommRing R] + {n : ℕ} (v : Fin n → R) : + (Matrix.of fun i j : Fin n => ∑ k : Fin n, v k ^ (i.val + j.val)).det = + (Matrix.vandermonde v).det ^ 2 := by + rw [hankel_eq_vandermonde_transpose_mul, Matrix.det_mul, + Matrix.det_transpose, pow_two] + +theorem hankel_det_ne_zero_of_injective {R : Type*} [CommRing R] [IsDomain R] + {n : ℕ} {v : Fin n → R} (hv : Function.Injective v) : + (Matrix.of fun i j : Fin n => ∑ k : Fin n, v k ^ (i.val + j.val)).det ≠ 0 := by + rw [hankel_det_eq_vandermonde_det_sq] + exact pow_ne_zero 2 (Matrix.det_vandermonde_ne_zero_iff.mpr hv) + +private theorem exists_nonzero_power_sum {K : Type*} [Field K] + {n : ℕ} (hn : 0 < n) {v : Fin n → K} (hv : Function.Injective v) : + ∃ j : Fin n, (∑ i : Fin n, v i ^ j.val) ≠ 0 := by + by_contra h + push Not at h + have hmul : (Matrix.vandermonde v)ᵀ.mulVec (fun _ : Fin n => (1 : K)) = 0 := by + ext j + simpa only [mulVec, dotProduct, transpose_apply, vandermonde_apply, mul_one, Pi.zero_apply] + using h j + have hdet : ((Matrix.vandermonde v)ᵀ).det ≠ 0 := by + simpa only [det_transpose, ne_eq] using (Matrix.det_vandermonde_ne_zero_iff.mpr hv) + have hz : (fun _ : Fin n => (1 : K)) = 0 := + Matrix.eq_zero_of_mulVec_eq_zero hdet hmul + have hone : (1 : K) = 0 := congrFun hz ⟨0, hn⟩ + exact one_ne_zero hone + +end + +section + +open Finset Polynomial +open scoped symmDiff + +theorem polynomial_eq_of_agree_on_points {K : Type*} [Field K] + (points : Finset K) (f g : K[X]) + (hdeg : max f.natDegree g.natDegree < points.card) + (hagree : ∀ x ∈ points, f.eval x = g.eval x) : f = g := by + exact Polynomial.eq_of_natDegree_lt_card_of_eval_eq' f g points hagree hdeg + +private theorem exists_assignment_interpolant {K : Type*} [Field K] {m : ℕ} + (variablePoint : Fin m → K) + (hinj : Function.Injective variablePoint) + (assignment : Fin m → K) : + ∃ polynomial : K[X], + polynomial.degree < (m : WithBot ℕ) ∧ + ∀ i : Fin m, polynomial.eval (variablePoint i) = assignment i := by + classical + let points : Finset (Fin m) := Finset.univ + let polynomial : K[X] := + Lagrange.interpolate points variablePoint assignment + refine ⟨polynomial, ?_, ?_⟩ + · simpa [points, polynomial] using + (Lagrange.degree_interpolate_lt assignment + (s := points) hinj.injOn) + · intro i + simpa [points, polynomial] using + (Lagrange.eval_interpolate_at_node assignment + (s := points) hinj.injOn (Finset.mem_univ i)) + +/-- GapCVP reduction support. -/ +noncomputable def supportMoment {K : Type*} [Field K] + (support : Finset K) (j : ℕ) : K := + ∑ a ∈ support, a ^ j + +private theorem exists_nonzero_supportMoment {K : Type*} [Field K] + (support : Finset K) (hsupport : support.Nonempty) : + ∃ j : ℕ, j < support.card ∧ supportMoment support j ≠ 0 := by + classical + let e := Finset.equivFin support + let v : Fin support.card → K := fun i => (e.symm i : K) + have hinj : Function.Injective v := by + intro i j hij + exact e.symm.injective (Subtype.ext hij) + obtain ⟨j, hj⟩ := exists_nonzero_power_sum + (Finset.card_pos.mpr hsupport) hinj + refine ⟨j.val, j.isLt, ?_⟩ + intro hzero + apply hj + calc + (∑ i : Fin support.card, v i ^ j.val) = + ∑ a : support, (a : K) ^ j.val := by + exact Equiv.sum_comp e.symm (fun a : support => (a : K) ^ j.val) + _ = supportMoment support j.val := by + exact (Finset.sum_subtype support (fun _ => Iff.rfl) + (fun a : K => a ^ j.val)).symm + _ = 0 := hzero + +private theorem support_eq_empty_of_low_moments_eq_zero {K : Type*} [Field K] + (support : Finset K) + (hmoments : ∀ j : ℕ, j < support.card → supportMoment support j = 0) : + support = ∅ := by + classical + by_contra hnonempty + obtain ⟨j, hj, hne⟩ := exists_nonzero_supportMoment support + (Finset.nonempty_iff_ne_empty.mpr hnonempty) + exact hne (hmoments j hj) + +private theorem supportMoment_symmDiff {K : Type*} [Field K] [CharP K 2] + [DecidableEq K] + (s t : Finset K) (j : ℕ) : + supportMoment (s ∆ t) j = supportMoment s j + supportMoment t j := by + classical + have hdisjoint : Disjoint (s \ t) (t \ s) := by + apply Finset.disjoint_left.mpr + intro a ha hb + exact (Finset.mem_sdiff.mp ha).2 (Finset.mem_sdiff.mp hb).1 + have hs : + (∑ a ∈ s ∩ t, a ^ j) + (∑ a ∈ s \ t, a ^ j) = + ∑ a ∈ s, a ^ j := + Finset.sum_inter_add_sum_sdiff s t (fun a : K => a ^ j) + have ht : + (∑ a ∈ s ∩ t, a ^ j) + (∑ a ∈ t \ s, a ^ j) = + ∑ a ∈ t, a ^ j := by + simpa only [inter_comm] using (Finset.sum_inter_add_sum_sdiff t s (fun a : K => a ^ j)) + rw [supportMoment, Finset.symmDiff_def, Finset.sum_union hdisjoint] + calc + (∑ a ∈ s \ t, a ^ j) + (∑ a ∈ t \ s, a ^ j) = + ((∑ a ∈ s ∩ t, a ^ j) + (∑ a ∈ s ∩ t, a ^ j)) + + ((∑ a ∈ s \ t, a ^ j) + (∑ a ∈ t \ s, a ^ j)) := by + rw [CharTwo.add_self_eq_zero, zero_add] + _ = ((∑ a ∈ s ∩ t, a ^ j) + (∑ a ∈ s \ t, a ^ j)) + + ((∑ a ∈ s ∩ t, a ^ j) + (∑ a ∈ t \ s, a ^ j)) := by + ac_rfl + _ = (∑ a ∈ s, a ^ j) + (∑ a ∈ t, a ^ j) := by + rw [hs, ht] + +private theorem support_eq_of_low_supportMoments_eq + {K : Type*} [Field K] [CharP K 2] [DecidableEq K] + (s t : Finset K) + (hmoments : ∀ j : ℕ, j < (s ∆ t).card → + supportMoment s j = supportMoment t j) : s = t := by + apply Finset.symmDiff_eq_empty.mp + apply support_eq_empty_of_low_moments_eq_zero + intro j hj + rw [supportMoment_symmDiff, hmoments j hj, + CharTwo.add_self_eq_zero] + +private theorem support_eq_of_supportMoments_eq_below_card_sum + {K : Type*} [Field K] [CharP K 2] + (s t : Finset K) + (hmoments : ∀ j : ℕ, j < s.card + t.card → + supportMoment s j = supportMoment t j) : s = t := by + classical + apply support_eq_of_low_supportMoments_eq s t + intro j hj + apply hmoments j + exact lt_of_lt_of_le hj + ((Finset.card_le_card (Finset.symmDiff_subset_union (s := s) (t := t))).trans + (Finset.card_union_le s t)) + +/-- GapCVP reduction support. -/ +def paritySupport {K : Type*} [DecidableEq K] : + List (Finset K) → Finset K + | [] => ∅ + | s :: supports => s ∆ paritySupport supports + +private theorem supportMoment_paritySupport + {K : Type*} [Field K] [CharP K 2] [DecidableEq K] + (supports : List (Finset K)) (j : ℕ) : + supportMoment (paritySupport supports) j = + (supports.map (fun s => supportMoment s j)).sum := by + induction supports with + | nil => simp only [supportMoment, paritySupport, sum_empty, List.map_nil, List.sum_nil] + | cons s supports ih => + simp only [paritySupport, supportMoment_symmDiff, ih, List.map_cons, List.sum_cons] + +private theorem exists_mem_of_mem_paritySupport + {K : Type*} [DecidableEq K] + (supports : List (Finset K)) {a : K} + (ha : a ∈ paritySupport supports) : + ∃ s ∈ supports, a ∈ s := by + induction supports generalizing a with + | nil => simp only [paritySupport, notMem_empty] at ha + | cons s supports ih => + have hcases : + a ∈ s ∧ a ∉ paritySupport supports ∨ + a ∈ paritySupport supports ∧ a ∉ s := by + apply Finset.mem_symmDiff.mp + simpa only [paritySupport] using ha + rcases hcases with ⟨has, _⟩ | ⟨haparity, _⟩ + · exact ⟨s, by simp only [List.mem_cons, true_or], has⟩ + · obtain ⟨t, ht, hat⟩ := ih haparity + exact ⟨t, by simp only [List.mem_cons, ht, or_true], hat⟩ + +private theorem global_support_eq_paritySupport_of_moment_refinement + {K : Type*} [Field K] [CharP K 2] [DecidableEq K] + (global : Finset K) (subtypes : List (Finset K)) + (hmoments : ∀ j : ℕ, + j < global.card + (paritySupport subtypes).card → + supportMoment global j = + (subtypes.map (fun s => supportMoment s j)).sum) : + global = paritySupport subtypes := by + apply support_eq_of_supportMoments_eq_below_card_sum + intro j hj + calc + supportMoment global j = + (subtypes.map (fun s => supportMoment s j)).sum := hmoments j hj + _ = supportMoment (paritySupport subtypes) j := + (supportMoment_paritySupport subtypes j).symm + +theorem global_root_mem_subtype_of_moment_refinement + {K : Type*} [Field K] [CharP K 2] [DecidableEq K] + (global : Finset K) (subtypes : List (Finset K)) + (hmoments : ∀ j : ℕ, + j < global.card + (paritySupport subtypes).card → + supportMoment global j = + (subtypes.map (fun s => supportMoment s j)).sum) + {a : K} (ha : a ∈ global) : + ∃ s ∈ subtypes, a ∈ s := by + apply exists_mem_of_mem_paritySupport subtypes + rw [← global_support_eq_paritySupport_of_moment_refinement + global subtypes hmoments] + exact ha + +private theorem shifted_supportMoment_binomial {K : Type*} [Field K] + (support : Finset K) (β : K) (j : ℕ) : + (∑ w ∈ support, (w - β) ^ j) = + ∑ l ∈ Finset.range (j + 1), + (j.choose l : K) * (-β) ^ (j - l) * supportMoment support l := by + classical + simp_rw [sub_eq_add_neg, add_pow, supportMoment] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro l hl + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro w hw + ring + +theorem scaled_shifted_supportMoment {K : Type*} [Field K] + (support : Finset K) (β π : K) (j : ℕ) (hπ : π ≠ 0) : + π ^ j * (∑ w ∈ support, ((w - β) / π) ^ j) = + ∑ l ∈ Finset.range (j + 1), + (j.choose l : K) * (-β) ^ (j - l) * supportMoment support l := by + classical + calc + π ^ j * (∑ w ∈ support, ((w - β) / π) ^ j) = + ∑ w ∈ support, (w - β) ^ j := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro w hw + rw [div_pow] + exact mul_div_cancel₀ ((w - β) ^ j) (pow_ne_zero j hπ) + _ = _ := shifted_supportMoment_binomial support β j + +/-- GapCVP reduction support. -/ +noncomputable def shiftedMomentCombination {K : Type*} [Field K] + (moments : ℕ → K[X]) (β : K) (j : ℕ) : K[X] := + ∑ l ∈ Finset.range (j + 1), + Polynomial.C ((j.choose l : K) * (-β) ^ (j - l)) * moments l + +end + +section + +/-- GapCVP reduction support. -/ +def sourceSizeParameter (encodingLength : ℕ) (formula : Formula) : ℕ := + 100 + encodingLength + formula.variableCount + formula.clauses.length + +theorem sourceSizeParameter_ge_one_hundred + (encodingLength : ℕ) (formula : Formula) : + 100 ≤ sourceSizeParameter encodingLength formula := by + simp only [sourceSizeParameter] + omega + +theorem source_variableCount_le_size + (encodingLength : ℕ) (formula : Formula) : + formula.variableCount ≤ sourceSizeParameter encodingLength formula := by + simp only [sourceSizeParameter] + omega + +theorem source_clauseCount_le_size + (encodingLength : ℕ) (formula : Formula) : + formula.clauses.length ≤ sourceSizeParameter encodingLength formula := by + simp only [sourceSizeParameter] + omega + +open scoped BigOperators +open Finset Matrix Polynomial + +/-- GapCVP reduction support. -/ +def Clause.variableSet {m : ℕ} (C : Clause m) : Finset (Fin m) := + C.literals.image (fun literal => literal.variableIndex) + +theorem Clause.variableSet_card_le_three {m : ℕ} (C : Clause m) : + C.variableSet.card ≤ 3 := + (Finset.card_image_le).trans C.size_le_three + +/-- GapCVP reduction support. -/ +abbrev Clause.LocalVariable {m : ℕ} (C : Clause m) := + {i : Fin m // i ∈ C.variableSet} + +/-- GapCVP reduction support. -/ +abbrev Clause.LocalAssignment {m : ℕ} (C : Clause m) := + C.LocalVariable → Bool + +/-- GapCVP reduction support. -/ +noncomputable def Clause.LocalSatisfied {m : ℕ} (C : Clause m) + (assignment : C.LocalAssignment) : Bool := + @decide ( + ∃ (literal : Literal m) (hliteral : literal ∈ C.literals), + assignment + ⟨literal.variableIndex, + Finset.mem_image_of_mem (fun l : Literal m => l.variableIndex) + hliteral⟩ = literal.satisfyingValue + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +abbrev Clause.SatisfyingLocalTuple {m : ℕ} (C : Clause m) := + {assignment : C.LocalAssignment // C.LocalSatisfied assignment} + +noncomputable instance Clause.instFintypeSatisfyingLocalTuple + {m : ℕ} (C : Clause m) : Fintype C.SatisfyingLocalTuple := + Fintype.ofFinite _ + +theorem Clause.satisfyingLocalTuple_card_le_eight + {m : ℕ} (C : Clause m) : + Fintype.card C.SatisfyingLocalTuple ≤ 8 := by + calc + Fintype.card C.SatisfyingLocalTuple ≤ + Fintype.card C.LocalAssignment := + Fintype.card_subtype_le (fun assignment => C.LocalSatisfied assignment) + _ = 2 ^ C.variableSet.card := by + rw [Fintype.card_fun] + simp only [Fintype.card_bool, Fintype.card_coe] + _ ≤ 2 ^ (3 : ℕ) := + Nat.pow_le_pow_right (by norm_num) C.variableSet_card_le_three + _ = 8 := by norm_num + +/-- GapCVP reduction support. -/ +def Clause.restrictAssignment {m : ℕ} (C : Clause m) + (assignment : Fin m → Bool) : C.LocalAssignment := + fun i => assignment i.val + +theorem Clause.localSatisfied_restrict_iff {m : ℕ} (C : Clause m) + (assignment : Fin m → Bool) : + C.LocalSatisfied (C.restrictAssignment assignment) ↔ + C.Satisfied assignment := by + simp only [GapCVP.Core.Clause.LocalSatisfied, GapCVP.Core.Clause.Satisfied, decide_eq_true_eq] + constructor + · rintro ⟨literal, hliteral, hvalue⟩ + exact ⟨literal, hliteral, hvalue⟩ + · rintro ⟨literal, hliteral, hvalue⟩ + exact ⟨literal, hliteral, hvalue⟩ + +/-- GapCVP reduction support. -/ +def Clause.satisfyingLocalTupleOfAssignment {m : ℕ} + (C : Clause m) (assignment : Fin m → Bool) + (h : C.Satisfied assignment) : C.SatisfyingLocalTuple := + ⟨C.restrictAssignment assignment, + (C.localSatisfied_restrict_iff assignment).mpr h⟩ + +/-- GapCVP reduction support. -/ +abbrev sourceSATTableType (F : Formula) := + Unit ⊕ + (Σ C : Fin F.clauses.length, + (F.clauses.get C).SatisfyingLocalTuple) + +private theorem sourceSATTableType_card_le (F : Formula) : + Fintype.card (sourceSATTableType F) ≤ 1 + 8 * F.clauses.length := by + classical + simp only [Fintype.card_sum, Fintype.card_unique, + Fintype.card_sigma] + have hsum : + (∑ C : Fin F.clauses.length, + Fintype.card (F.clauses.get C).SatisfyingLocalTuple) ≤ + ∑ _C : Fin F.clauses.length, (8 : ℕ) := by + exact Finset.sum_le_sum + (fun C _ => (F.clauses.get C).satisfyingLocalTuple_card_le_eight) + simpa only [List.get_eq_getElem, add_le_add_iff_left, ge_iff_le, sum_const, card_univ, + Fintype.card_fin, + smul_eq_mul, Nat.mul_comm] using Nat.add_le_add_left hsum 1 + +/-- GapCVP reduction support. -/ +abbrev sourceSATGridPoint {K : Type*} (points : Finset K) := + {p : K // p ∈ points} + +/-- GapCVP reduction support. -/ +abbrev sourceSATTableCoordinate + (F : Formula) (K : Type*) (points : Finset K) := + sourceSATTableType F × sourceSATGridPoint points × K + +/-- GapCVP reduction support. -/ +def sourceSATTableDimension + (F : Formula) (K : Type*) [Fintype K] + (points : Finset K) : ℕ := + Fintype.card (sourceSATTableCoordinate F K points) + +theorem sourceSATTableDimension_eq + (F : Formula) (K : Type*) [Fintype K] + (points : Finset K) : + sourceSATTableDimension F K points = + Fintype.card (sourceSATTableType F) * points.card * Fintype.card K := by + classical + simp only [sourceSATTableDimension, Fintype.card_prod, Fintype.card_sum, Fintype.card_unique, + List.get_eq_getElem, Fintype.card_sigma, Fintype.card_coe, mul_assoc] + +theorem sourceSATTableDimension_le + (F : Formula) (K : Type*) [Fintype K] + (points : Finset K) (N : ℕ) + (hN : 100 ≤ N) (hclauses : F.clauses.length ≤ N) + (hgrid : points.card ≤ Fintype.card K) + (hfield : Fintype.card K < 2 * N ^ 200) : + sourceSATTableDimension F K points ≤ 40 * N ^ 401 := by + rw [sourceSATTableDimension_eq] + exact source_output_dimension_le hN hclauses + (sourceSATTableType_card_le F) hgrid hfield + +variable {K : Type*} [Field K] + +private def sourceGridEvaluationLinearMap (points : Finset K) : + K[X] →ₗ[K] (sourceSATGridPoint points → K) := + LinearMap.pi fun p : sourceSATGridPoint points => + (Polynomial.aeval (p : K)).toLinearMap + +/-- GapCVP reduction support. -/ +def sourceReedSolomonCode (points : Finset K) (degreeBound : ℕ) : + Submodule K (sourceSATGridPoint points → K) := + LinearMap.range + ((sourceGridEvaluationLinearMap points).comp + (Polynomial.degreeLE K (degreeBound : WithBot ℕ)).subtype) + +theorem sourceReedSolomonCode_mem_iff + (points : Finset K) (degreeBound : ℕ) + (values : sourceSATGridPoint points → K) : + values ∈ sourceReedSolomonCode points degreeBound ↔ + ∃ polynomial : K[X], polynomial.natDegree ≤ degreeBound ∧ + ∀ point : sourceSATGridPoint points, + polynomial.eval point.val = values point := by + constructor + · rintro ⟨⟨polynomial, hdegree⟩, hvalues⟩ + refine ⟨polynomial, ?_, ?_⟩ + · exact Polynomial.natDegree_le_iff_degree_le.mpr + (Polynomial.mem_degreeLE.mp hdegree) + · intro point + exact congrFun hvalues point + · rintro ⟨polynomial, hdegree, hvalues⟩ + refine ⟨⟨polynomial, ?_⟩, ?_⟩ + · exact Polynomial.mem_degreeLE.mpr + (Polynomial.natDegree_le_iff_degree_le.mp hdegree) + · funext point + exact hvalues point + +private def sourceReedSolomonCodimension + (points : Finset K) (degreeBound : ℕ) : ℕ := + Module.finrank K + ((sourceSATGridPoint points → K) ⧸ + sourceReedSolomonCode points degreeBound) + +private def sourceReedSolomonParityMap + (points : Finset K) (degreeBound : ℕ) : + (sourceSATGridPoint points → K) →ₗ[K] + (Fin (sourceReedSolomonCodimension points degreeBound) → K) := + (Module.finBasis K + ((sourceSATGridPoint points → K) ⧸ + sourceReedSolomonCode points degreeBound)).equivFun.toLinearMap.comp + (sourceReedSolomonCode points degreeBound).mkQ + +private theorem sourceReedSolomonParityMap_eq_zero_iff + (points : Finset K) (degreeBound : ℕ) + (values : sourceSATGridPoint points → K) : + sourceReedSolomonParityMap points degreeBound values = 0 ↔ + values ∈ sourceReedSolomonCode points degreeBound := by + change + (Module.finBasis K + ((sourceSATGridPoint points → K) ⧸ + sourceReedSolomonCode points degreeBound)).equivFun + ((sourceReedSolomonCode points degreeBound).mkQ values) = 0 ↔ + values ∈ sourceReedSolomonCode points degreeBound + rw [LinearEquiv.map_eq_zero_iff] + exact Submodule.Quotient.mk_eq_zero _ + +/-- GapCVP reduction support. -/ +def sourceFiniteReindexLinearEquiv + (α : Type*) [Fintype α] : + (α → K) ≃ₗ[K] (Fin (Fintype.card α) → K) := + LinearEquiv.funCongrLeft K K (Fintype.equivFin α).symm + +/-- GapCVP reduction support. -/ +def sourceSATColumnIndex + (F : Formula) [Fintype K] (points : Finset K) + (tableType : sourceSATTableType F) + (point : sourceSATGridPoint points) (value : K) : + Fin (sourceSATTableDimension F K points) := + Fintype.equivFin (sourceSATTableCoordinate F K points) + (tableType, point, value) + +/-- GapCVP reduction support. -/ +def sourceGlobalNormalizationMap + (F : Formula) [Fintype K] (points : Finset K) : + (Fin (sourceSATTableDimension F K points) → K) →ₗ[K] + (sourceSATGridPoint points → K) where + toFun table point := + ∑ value : K, + table (sourceSATColumnIndex F points (.inl ()) point value) + map_add' left right := by + funext point + simp only [List.get_eq_getElem, Pi.add_apply, sum_add_distrib] + map_smul' scalar table := by + funext point + simp only [List.get_eq_getElem, Pi.smul_apply, smul_eq_mul, RingHom.id_apply, mul_sum] + +/-- GapCVP reduction support. -/ +def sourceClauseRefinementMap + (F : Formula) [Fintype K] (points : Finset K) + (clause : Fin F.clauses.length) : + (Fin (sourceSATTableDimension F K points) → K) →ₗ[K] + (sourceSATGridPoint points × K → K) where + toFun table position := + table (sourceSATColumnIndex F points (.inl ()) + position.1 position.2) - + ∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + table (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) position.1 position.2) + map_add' left right := by + funext position + simp only [List.get_eq_getElem, Pi.add_apply, sum_add_distrib] + ring + map_smul' scalar table := by + funext position + simp only [Pi.smul_apply, smul_eq_mul, mul_sub, RingHom.id_apply] + rw [Finset.mul_sum] + +/-- GapCVP reduction support. -/ +def sourceOrdinaryMomentMap + (F : Formula) [Fintype K] (points : Finset K) + (tableType : sourceSATTableType F) (j : ℕ) : + (Fin (sourceSATTableDimension F K points) → K) →ₗ[K] + (sourceSATGridPoint points → K) where + toFun table point := + ∑ value : K, + table (sourceSATColumnIndex F points tableType point value) * + value ^ j + map_add' left right := by + funext point + simp only [Pi.add_apply, add_mul, sum_add_distrib] + map_smul' scalar table := by + funext point + simp only [Pi.smul_apply, smul_eq_mul, mul_assoc, RingHom.id_apply, mul_sum] + +/-- GapCVP reduction support. -/ +def sourceSATFieldBit (bit : Bool) : K := + if bit then 1 else 0 + +/-- GapCVP reduction support. -/ +def sourceShiftedMomentMap + (F : Formula) [Fintype K] (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) : + (Fin (sourceSATTableDimension F K points) → K) →ₗ[K] + (sourceSATGridPoint points → K) where + toFun table point := + ∑ value : K, + table (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value) * + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j + map_add' left right := by + funext point + simp only [List.get_eq_getElem, Pi.add_apply, add_mul, sum_add_distrib] + map_smul' scalar table := by + funext point + simp only [List.get_eq_getElem, Pi.smul_apply, smul_eq_mul, mul_assoc, RingHom.id_apply, + mul_sum] + +/-- GapCVP reduction support. -/ +abbrev sourceSATConstraintFamily (F : Formula) (momentBudget : ℕ) := + Unit ⊕ + (Fin F.clauses.length ⊕ + ((sourceSATTableType F × Fin (momentBudget + 1)) ⊕ + (Σ clause : Fin F.clauses.length, + Σ _tuple : (F.clauses.get clause).SatisfyingLocalTuple, + (F.clauses.get clause).LocalVariable × + Fin (momentBudget + 1)))) + +private def sourceSATFamilyRowCount + (F : Formula) [Fintype K] + (points : Finset K) (momentBudget : ℕ) + (family : sourceSATConstraintFamily F momentBudget) : ℕ := + match family with + | .inl _ => Fintype.card (sourceSATGridPoint points) + | .inr (.inl _) => + Fintype.card (sourceSATGridPoint points × K) + | .inr (.inr (.inl ⟨_, j⟩)) => + sourceReedSolomonCodimension points + (F.variableCount * j.val) + | .inr (.inr (.inr ⟨_, _, _, j⟩)) => + sourceReedSolomonCodimension points + ((F.variableCount - 1) * j.val) + +private def sourceSATFamilyLinearMap + (F : Formula) [Fintype K] + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (family : sourceSATConstraintFamily F momentBudget) : + (Fin (sourceSATTableDimension F K points) → K) →ₗ[K] + (Fin (sourceSATFamilyRowCount F points momentBudget family) → K) := by + classical + rcases family with _ | family + · exact + (sourceFiniteReindexLinearEquiv + (K := K) (sourceSATGridPoint points)).toLinearMap.comp + (sourceGlobalNormalizationMap F points) + · rcases family with clause | family + · exact + (sourceFiniteReindexLinearEquiv + (K := K) (sourceSATGridPoint points × K)).toLinearMap.comp + (sourceClauseRefinementMap F points clause) + · rcases family with ordinary | shifted + · obtain ⟨tableType, j⟩ := ordinary + exact + (sourceReedSolomonParityMap points + (F.variableCount * j.val)).comp + (sourceOrdinaryMomentMap F points tableType j.val) + · obtain ⟨clause, tuple, localVar, j⟩ := shifted + exact + (sourceReedSolomonParityMap points + ((F.variableCount - 1) * j.val)).comp + (sourceShiftedMomentMap F points variablePlace + clause tuple localVar j.val) + +private def sourceSATFamilyTarget + (F : Formula) [Fintype K] + (points : Finset K) (momentBudget : ℕ) + (family : sourceSATConstraintFamily F momentBudget) : + Fin (sourceSATFamilyRowCount F points momentBudget family) → K := + fun _ => match family with + | .inl _ => 1 + | .inr _ => 0 + +private def sourceSATFamilyFieldMatrix + (F : Formula) [Fintype K] + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (family : sourceSATConstraintFamily F momentBudget) : + Matrix + (Fin (sourceSATFamilyRowCount F points momentBudget family)) + (Fin (sourceSATTableDimension F K points)) K := + LinearMap.toMatrix' + (sourceSATFamilyLinearMap F points variablePlace momentBudget family) + +/-- GapCVP reduction support. -/ +def concreteSATBinaryAffineSystem + [Algebra (ZMod 2) K] [Fintype K] + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) : BinaryAffineSystem := + assembledBinaryAffineSystem fieldBasis + (sourceSATFamilyRowCount F points momentBudget) + (sourceSATFamilyFieldMatrix F points variablePlace momentBudget) + (sourceSATFamilyTarget F points momentBudget) + +private theorem concreteSATBinaryAffineSystem_solves_iff_family + [Algebra (ZMod 2) K] [Fintype K] + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) : + (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z ↔ + ∀ family : sourceSATConstraintFamily F momentBudget, + sourceSATFamilyLinearMap F points variablePlace + momentBudget family + (fun position => + algebraMap (ZMod 2) K (z position : ZMod 2)) = + sourceSATFamilyTarget F points momentBudget family := by + unfold concreteSATBinaryAffineSystem + rw [assembledBinaryAffineSystem_solves_iff] + simp only [sourceSATFamilyFieldMatrix, LinearMap.toMatrix'_mulVec] + +/-- GapCVP reduction support. -/ +noncomputable def concreteSATFieldChecks + (F : Formula) [Fintype K] + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (values : Fin (sourceSATTableDimension F K points) → K) : Bool := + @decide ( + sourceGlobalNormalizationMap F points values = + (fun _ : sourceSATGridPoint points => (1 : K)) ∧ + (∀ clause : Fin F.clauses.length, + sourceClauseRefinementMap F points clause values = 0) ∧ + (∀ (tableType : sourceSATTableType F) + (j : Fin (momentBudget + 1)), + sourceOrdinaryMomentMap F points tableType j.val values ∈ + sourceReedSolomonCode points (F.variableCount * j.val)) ∧ + (∀ (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : Fin (momentBudget + 1)), + sourceShiftedMomentMap F points variablePlace + clause tuple localVar j.val values ∈ + sourceReedSolomonCode points + ((F.variableCount - 1) * j.val)) + ) (Classical.propDecidable _) +private theorem sourceSATFamilyChecks_iff_concrete + (F : Formula) [Fintype K] + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (values : Fin (sourceSATTableDimension F K points) → K) : + (∀ family : sourceSATConstraintFamily F momentBudget, + sourceSATFamilyLinearMap F points variablePlace + momentBudget family values = + sourceSATFamilyTarget F points momentBudget family) ↔ + concreteSATFieldChecks F points variablePlace momentBudget values := by + simp only [GapCVP.Core.concreteSATFieldChecks, decide_eq_true_eq] + classical + constructor + · intro hfamilies + refine ⟨?_, ?_, ?_, ?_⟩ + · funext point + have hpoint := congrFun + (hfamilies (.inl ())) + (Fintype.equivFin (sourceSATGridPoint points) point) + change + sourceGlobalNormalizationMap F points values + ((Fintype.equivFin (sourceSATGridPoint points)).symm + (Fintype.equivFin (sourceSATGridPoint points) point)) = 1 + at hpoint + simpa only [Equiv.symm_apply_apply] using hpoint + · intro clause + funext position + have hposition := congrFun + (hfamilies (.inr (.inl clause))) + (Fintype.equivFin (sourceSATGridPoint points × K) position) + change + sourceClauseRefinementMap F points clause values + ((Fintype.equivFin (sourceSATGridPoint points × K)).symm + (Fintype.equivFin (sourceSATGridPoint points × K) position)) = 0 + at hposition + simpa only [Pi.zero_apply, Equiv.symm_apply_apply] using hposition + · intro tableType j + apply (sourceReedSolomonParityMap_eq_zero_iff points + (F.variableCount * j.val) + (sourceOrdinaryMomentMap F points tableType j.val values)).mp + have hmoment := hfamilies + (.inr (.inr (.inl (tableType, j)))) + change + sourceReedSolomonParityMap points (F.variableCount * j.val) + (sourceOrdinaryMomentMap F points tableType j.val values) = 0 + at hmoment + exact hmoment + · intro clause tuple localVar j + apply (sourceReedSolomonParityMap_eq_zero_iff points + ((F.variableCount - 1) * j.val) + (sourceShiftedMomentMap F points variablePlace + clause tuple localVar j.val values)).mp + have hmoment := hfamilies + (.inr (.inr (.inr ⟨clause, tuple, localVar, j⟩))) + change + sourceReedSolomonParityMap points + ((F.variableCount - 1) * j.val) + (sourceShiftedMomentMap F points variablePlace + clause tuple localVar j.val values) = 0 + at hmoment + exact hmoment + · rintro ⟨hnormalization, hrefinement, hordinary, hshifted⟩ + intro family + rcases family with _ | family + · change + (sourceFiniteReindexLinearEquiv (K := K) + (sourceSATGridPoint points)) + (sourceGlobalNormalizationMap F points values) = + fun _ => (1 : K) + rw [hnormalization] + rfl + · rcases family with clause | family + · change + (sourceFiniteReindexLinearEquiv (K := K) + (sourceSATGridPoint points × K)) + (sourceClauseRefinementMap F points clause values) = 0 + rw [hrefinement clause] + exact map_zero _ + · rcases family with ordinary | shifted + · obtain ⟨tableType, j⟩ := ordinary + change + sourceReedSolomonParityMap points + (F.variableCount * j.val) + (sourceOrdinaryMomentMap F points tableType j.val values) = 0 + exact (sourceReedSolomonParityMap_eq_zero_iff points + (F.variableCount * j.val) + (sourceOrdinaryMomentMap F points tableType j.val values)).mpr + (hordinary tableType j) + · obtain ⟨clause, tuple, localVar, j⟩ := shifted + change + sourceReedSolomonParityMap points + ((F.variableCount - 1) * j.val) + (sourceShiftedMomentMap F points variablePlace + clause tuple localVar j.val values) = 0 + exact (sourceReedSolomonParityMap_eq_zero_iff points + ((F.variableCount - 1) * j.val) + (sourceShiftedMomentMap F points variablePlace + clause tuple localVar j.val values)).mpr + (hshifted clause tuple localVar j) + +theorem concreteSATBinaryAffineSystem_solves_iff + [Algebra (ZMod 2) K] [Fintype K] + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) : + (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z ↔ + concreteSATFieldChecks F points variablePlace momentBudget + (fun position => + algebraMap (ZMod 2) K (z position : ZMod 2)) := by + exact + (concreteSATBinaryAffineSystem_solves_iff_family + F fieldBasis points variablePlace momentBudget z).trans + (sourceSATFamilyChecks_iff_concrete F points variablePlace + momentBudget _) + +/-- GapCVP reduction support. -/ +def sourceSATPuncturedGrid + (F : Formula) [Fintype K] + (variablePlace : Fin F.variableCount → K) : Finset K := by + classical + exact sourcePuncturedGrid + ((Finset.univ : Finset (Fin F.variableCount)).image variablePlace) + +omit [Field K] in +theorem sourceSATPuncturedGrid_card + (F : Formula) [Fintype K] + (variablePlace : Fin F.variableCount → K) + (hinjective : Function.Injective variablePlace) : + (sourceSATPuncturedGrid F variablePlace).card = + Fintype.card K - F.variableCount := by + classical + unfold sourceSATPuncturedGrid + rw [sourcePuncturedGrid_card, + Finset.card_image_of_injective _ hinjective] + simp only [card_univ, Fintype.card_fin] + +theorem sourceSATPuncturedGrid_sub_ne_zero + (F : Formula) [Fintype K] + (variablePlace : Fin F.variableCount → K) + (point : sourceSATGridPoint + (sourceSATPuncturedGrid F variablePlace)) + (i : Fin F.variableCount) : + point.val - variablePlace i ≠ 0 := by + classical + have hpoint : point.val ∈ + (Finset.univ : Finset K) \ + ((Finset.univ : Finset (Fin F.variableCount)).image variablePlace) := by + exact point.property + have hnot := (Finset.mem_sdiff.mp hpoint).2 + apply sub_ne_zero.mpr + intro heq + apply hnot + exact Finset.mem_image.mpr + ⟨i, Finset.mem_univ i, heq.symm⟩ + +end + +section + +open scoped BigOperators + +/-- GapCVP reduction support. -/ +abbrev sourceFormulaField (encodingLength : ℕ) (F : Formula) := + SourceFiniteField (sourceSizeParameter encodingLength F) + +end + +section + +open scoped BigOperators +open Finset Matrix Polynomial + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + +omit [Fintype K] [DecidableEq K] in +/-- GapCVP reduction support. -/ +def sourceActiveLocalTuple + (F : Formula) (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (clause : Fin F.clauses.length) : + (F.clauses.get clause).SatisfyingLocalTuple := by + have satisfaction := hsatisfies + simp only [GapCVP.Core.Formula.Satisfied, decide_eq_true_eq] at satisfaction + exact (F.clauses.get clause).satisfyingLocalTupleOfAssignment + assignment (satisfaction clause) + +@[simp] private theorem sourceActiveLocalTuple_apply + (F : Formula) (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (clause : Fin F.clauses.length) + (localVar : (F.clauses.get clause).LocalVariable) : + (sourceActiveLocalTuple F assignment hsatisfies clause).val localVar = + assignment localVar.val := by + rfl + +omit [Fintype K] [DecidableEq K] in +theorem exists_sourceSAT_assignment_interpolant_of_injective + (F : Formula) + (variablePlace : Fin F.variableCount → K) + (hinjective : Function.Injective variablePlace) + (assignment : Fin F.variableCount → Bool) : + ∃ interpolant : K[X], + interpolant.natDegree ≤ F.variableCount - 1 ∧ + ∀ i : Fin F.variableCount, + interpolant.eval (variablePlace i) = + sourceSATFieldBit (K := K) (assignment i) := by + classical + obtain ⟨interpolant, hdegree, hvalues⟩ := + exists_assignment_interpolant variablePlace hinjective + (fun i => sourceSATFieldBit (K := K) (assignment i)) + refine ⟨interpolant, ?_, hvalues⟩ + by_cases hzero : interpolant = 0 + · simp only [hzero, natDegree_zero, zero_le] + · have hlt : interpolant.natDegree < F.variableCount := + (Polynomial.natDegree_lt_iff_degree_lt hzero).mpr hdegree + omega + +/-- GapCVP reduction support. -/ +def sourceOneHotSignedTable + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) : + Fin (sourceSATTableDimension F K points) → ℤ := by + classical + intro position + let coordinate := + (Fintype.equivFin (sourceSATTableCoordinate F K points)).symm position + exact match coordinate.1 with + | .inl _ => + if coordinate.2.2 = interpolant.eval coordinate.2.1.val + then 1 else 0 + | .inr ⟨clause, tuple⟩ => + if tuple = sourceActiveLocalTuple F assignment hsatisfies clause ∧ + coordinate.2.2 = interpolant.eval coordinate.2.1.val + then 1 else 0 + +private def sourceOneHotFieldTable [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) : + Fin (sourceSATTableDimension F K points) → K := + fun position => algebraMap (ZMod 2) K + (sourceOneHotSignedTable F points assignment hsatisfies + interpolant position : ZMod 2) + +@[simp] private theorem sourceOneHotSignedTable_global + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (point : sourceSATGridPoint points) (value : K) : + sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inl ()) point value) = + if value = interpolant.eval point.val then 1 else 0 := by + classical + simp only [sourceOneHotSignedTable, sourceSATColumnIndex, List.get_eq_getElem, + Equiv.symm_apply_apply] + +@[simp] private theorem sourceOneHotSignedTable_subtype + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (point : sourceSATGridPoint points) (value : K) : + sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inr ⟨clause, tuple⟩) point value) = + if tuple = sourceActiveLocalTuple F assignment hsatisfies clause ∧ + value = interpolant.eval point.val then 1 else 0 := by + classical + simp only [sourceOneHotSignedTable, sourceSATColumnIndex, List.get_eq_getElem, + Equiv.symm_apply_apply] + +@[simp] private theorem sourceOneHotFieldTable_global [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (point : sourceSATGridPoint points) (value : K) : + sourceOneHotFieldTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inl ()) point value) = + if value = interpolant.eval point.val then 1 else 0 := by + classical + simp only [sourceOneHotFieldTable, List.get_eq_getElem, sourceOneHotSignedTable_global, + Int.cast_ite, + Int.cast_one, Int.cast_zero, MonoidWithZeroHom.map_ite_one_zero] + +@[simp] private theorem sourceOneHotFieldTable_subtype [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (point : sourceSATGridPoint points) (value : K) : + sourceOneHotFieldTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inr ⟨clause, tuple⟩) point value) = + if tuple = sourceActiveLocalTuple F assignment hsatisfies clause ∧ + value = interpolant.eval point.val then 1 else 0 := by + classical + simp only [sourceOneHotFieldTable, List.get_eq_getElem, sourceOneHotSignedTable_subtype, + Int.cast_ite, + Int.cast_one, Int.cast_zero, MonoidWithZeroHom.map_ite_one_zero] + +private theorem sourceOneHot_global_normalization [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) : + sourceGlobalNormalizationMap F points + (sourceOneHotFieldTable F points assignment hsatisfies interpolant) = + (fun _ : sourceSATGridPoint points => (1 : K)) := by + classical + funext point + change + (∑ value : K, + sourceOneHotFieldTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inl ()) point value)) = 1 + simp only [List.get_eq_getElem, sourceOneHotFieldTable_global, sum_ite_eq', mem_univ, ↓reduceIte] + +private theorem sourceOneHot_clause_refinement [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (clause : Fin F.clauses.length) : + sourceClauseRefinementMap F points clause + (sourceOneHotFieldTable F points assignment hsatisfies interpolant) = 0 := by + classical + funext position + change + sourceOneHotFieldTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inl ()) position.1 position.2) - + (∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + sourceOneHotFieldTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) position.1 position.2)) = 0 + by_cases hvalue : position.2 = interpolant.eval position.1.val + · simp only [List.get_eq_getElem, hvalue, sourceOneHotFieldTable_global, ↓reduceIte, + sourceOneHotFieldTable_subtype, and_true, sum_ite_eq', mem_univ, sub_self] + · simp only [List.get_eq_getElem, sourceOneHotFieldTable_global, hvalue, ↓reduceIte, + sourceOneHotFieldTable_subtype, and_false, sum_const_zero, sub_self] + +@[simp] private theorem sourceOneHot_global_moment [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) (j : ℕ) + (point : sourceSATGridPoint points) : + sourceOrdinaryMomentMap F points (.inl ()) j + (sourceOneHotFieldTable F points assignment hsatisfies interpolant) + point = interpolant.eval point.val ^ j := by + classical + change + (∑ value : K, + sourceOneHotFieldTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inl ()) point value) * value ^ j) = _ + simp only [List.get_eq_getElem, sourceOneHotFieldTable_global, ite_mul, one_mul, zero_mul, + sum_ite_eq', + mem_univ, ↓reduceIte] + +@[simp] private theorem sourceOneHot_subtype_moment [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (j : ℕ) (point : sourceSATGridPoint points) : + sourceOrdinaryMomentMap F points (.inr ⟨clause, tuple⟩) j + (sourceOneHotFieldTable F points assignment hsatisfies interpolant) + point = + if tuple = sourceActiveLocalTuple F assignment hsatisfies clause + then interpolant.eval point.val ^ j else 0 := by + classical + change + (∑ value : K, + sourceOneHotFieldTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value) * value ^ j) = _ + by_cases hactive : + tuple = sourceActiveLocalTuple F assignment hsatisfies clause + · simp only [List.get_eq_getElem, hactive, sourceOneHotFieldTable_subtype, true_and, ite_mul, + one_mul, zero_mul, + sum_ite_eq', mem_univ, ↓reduceIte] + · simp only [List.get_eq_getElem, sourceOneHotFieldTable_subtype, hactive, false_and, ↓reduceIte, + zero_mul, + sum_const_zero] + +@[simp] private theorem sourceOneHot_shifted_moment [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) (point : sourceSATGridPoint points) : + sourceShiftedMomentMap F points variablePlace clause tuple localVar j + (sourceOneHotFieldTable F points assignment hsatisfies interpolant) + point = + if tuple = sourceActiveLocalTuple F assignment hsatisfies clause + then + ((interpolant.eval point.val - + sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j + else 0 := by + classical + change + (∑ value : K, + sourceOneHotFieldTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value) * + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j) = _ + by_cases hactive : + tuple = sourceActiveLocalTuple F assignment hsatisfies clause + · simp only [List.get_eq_getElem, hactive, sourceOneHotFieldTable_subtype, true_and, + sourceActiveLocalTuple_apply, ite_mul, one_mul, zero_mul, sum_ite_eq', mem_univ, + ↓reduceIte] + · simp only [List.get_eq_getElem, sourceOneHotFieldTable_subtype, hactive, false_and, ↓reduceIte, + zero_mul, + sum_const_zero] + +private theorem sourceOneHot_ordinary_reedSolomon [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (hdegree : interpolant.natDegree ≤ F.variableCount) + (tableType : sourceSATTableType F) (j : ℕ) : + sourceOrdinaryMomentMap F points tableType j + (sourceOneHotFieldTable F points assignment hsatisfies interpolant) + ∈ sourceReedSolomonCode points (F.variableCount * j) := by + classical + cases tableType with + | inl global => + cases global + apply (sourceReedSolomonCode_mem_iff points + (F.variableCount * j) _).mpr + refine ⟨interpolant ^ j, ?_, ?_⟩ + · rw [Polynomial.natDegree_pow] + simpa only [Nat.mul_comm] using Nat.mul_le_mul_left j hdegree + · intro point + simp only [eval_pow, List.get_eq_getElem, sourceOneHot_global_moment] + | inr subtype => + obtain ⟨clause, tuple⟩ := subtype + by_cases hactive : + tuple = sourceActiveLocalTuple F assignment hsatisfies clause + · apply (sourceReedSolomonCode_mem_iff points + (F.variableCount * j) _).mpr + refine ⟨interpolant ^ j, ?_, ?_⟩ + · rw [Polynomial.natDegree_pow] + simpa only [Nat.mul_comm] using Nat.mul_le_mul_left j hdegree + · intro point + simp only [eval_pow, List.get_eq_getElem, hactive, sourceOneHot_subtype_moment, + ↓reduceIte] + · have hzero : + sourceOrdinaryMomentMap F points (.inr ⟨clause, tuple⟩) j + (sourceOneHotFieldTable F points assignment hsatisfies + interpolant) = 0 := by + funext point + simp only [List.get_eq_getElem, sourceOneHot_subtype_moment, hactive, ↓reduceIte, + Pi.zero_apply] + rw [hzero] + exact (sourceReedSolomonCode points + (F.variableCount * j)).zero_mem + +omit [Fintype K] [DecidableEq K] in +private theorem exists_sourceShiftedMomentQuotient + (interpolant : K[X]) (place bit : K) (bound : ℕ) + (hdegree : interpolant.natDegree ≤ bound) + (hroot : interpolant.eval place = bit) : + ∃ quotient : K[X], + quotient.natDegree ≤ bound ∧ + interpolant - Polynomial.C bit = + (Polynomial.X - Polynomial.C place) * quotient := by + classical + have hdivides : + Polynomial.X - Polynomial.C place ∣ + interpolant - Polynomial.C bit := by + simpa only [hroot] using (Polynomial.X_sub_C_dvd_sub_C_eval (a := place) (p := interpolant)) + by_cases hzero : interpolant - Polynomial.C bit = 0 + · refine ⟨0, by simp only [natDegree_zero, zero_le], ?_⟩ + simpa only [mul_zero] using hzero + · obtain ⟨quotient, hquotient⟩ := hdivides + refine ⟨quotient, ?_, hquotient⟩ + have hquotientDivides : + quotient ∣ interpolant - Polynomial.C bit := by + refine ⟨Polynomial.X - Polynomial.C place, ?_⟩ + simpa only [mul_comm] using hquotient + calc + quotient.natDegree ≤ + (interpolant - Polynomial.C bit).natDegree := + Polynomial.natDegree_le_of_dvd hquotientDivides hzero + _ ≤ max interpolant.natDegree (Polynomial.C bit).natDegree := + Polynomial.natDegree_sub_le _ _ + _ = interpolant.natDegree := by simp only [natDegree_C, zero_le, sup_of_le_left] + _ ≤ bound := hdegree + +omit [Fintype K] [DecidableEq K] in +private theorem sourceShiftedMomentQuotient_eval + (interpolant quotient : K[X]) (place bit point : K) + (hfactor : interpolant - Polynomial.C bit = + (Polynomial.X - Polynomial.C place) * quotient) + (hpoint : point - place ≠ 0) : + quotient.eval point = + (interpolant.eval point - bit) / (point - place) := by + apply (eq_div_iff hpoint).mpr + have heval := congrArg + (fun polynomial : K[X] => polynomial.eval point) hfactor + simpa only [mul_comm, eval_mul, eval_sub, eval_X, eval_C] using heval.symm + +private theorem sourceOneHot_shifted_reedSolomon [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (hdegree : interpolant.natDegree ≤ F.variableCount - 1) + (hinterpolant : ∀ i : Fin F.variableCount, + interpolant.eval (variablePlace i) = + sourceSATFieldBit (K := K) (assignment i)) + (hplaces : ∀ point : sourceSATGridPoint points, + ∀ i : Fin F.variableCount, point.val - variablePlace i ≠ 0) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) : + sourceShiftedMomentMap F points variablePlace + clause tuple localVar j + (sourceOneHotFieldTable F points assignment hsatisfies + interpolant) ∈ + sourceReedSolomonCode points ((F.variableCount - 1) * j) := by + classical + by_cases hactive : + tuple = sourceActiveLocalTuple F assignment hsatisfies clause + · have hroot : + interpolant.eval (variablePlace localVar.val) = + sourceSATFieldBit (K := K) (tuple.val localVar) := by + subst tuple + simpa only [List.get_eq_getElem, sourceActiveLocalTuple_apply] using hinterpolant + localVar.val + obtain ⟨quotient, hquotientDegree, hquotient⟩ := + exists_sourceShiftedMomentQuotient interpolant + (variablePlace localVar.val) + (sourceSATFieldBit (K := K) (tuple.val localVar)) + (F.variableCount - 1) hdegree hroot + apply (sourceReedSolomonCode_mem_iff points + ((F.variableCount - 1) * j) _).mpr + refine ⟨quotient ^ j, ?_, ?_⟩ + · rw [Polynomial.natDegree_pow] + simpa only [Nat.mul_comm] using Nat.mul_le_mul_left j hquotientDegree + · intro point + rw [Polynomial.eval_pow, sourceOneHot_shifted_moment] + simp only [hactive, ite_true] + simpa only [List.get_eq_getElem, sourceActiveLocalTuple_apply, hactive] using + congrArg (fun value : K => value ^ j) + (sourceShiftedMomentQuotient_eval interpolant quotient (variablePlace localVar.val) + (sourceSATFieldBit (K := K) (tuple.val localVar)) point.val hquotient (hplaces point + localVar.val)) + · have hzero : + sourceShiftedMomentMap F points variablePlace + clause tuple localVar j + (sourceOneHotFieldTable F points assignment hsatisfies + interpolant) = 0 := by + funext point + simp only [sourceOneHot_shifted_moment, List.get_eq_getElem, hactive, ↓reduceIte, + Pi.zero_apply] + rw [hzero] + exact (sourceReedSolomonCode points + ((F.variableCount - 1) * j)).zero_mem + +private theorem sourceOneHot_satisfies_concreteFieldChecks + [Algebra (ZMod 2) K] + (F : Formula) (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (hdegree : interpolant.natDegree ≤ F.variableCount - 1) + (hinterpolant : ∀ i : Fin F.variableCount, + interpolant.eval (variablePlace i) = + sourceSATFieldBit (K := K) (assignment i)) + (hplaces : ∀ point : sourceSATGridPoint points, + ∀ i : Fin F.variableCount, point.val - variablePlace i ≠ 0) + (momentBudget : ℕ) : + concreteSATFieldChecks F points variablePlace momentBudget + (sourceOneHotFieldTable F points assignment hsatisfies interpolant) := by + simp only [GapCVP.Core.concreteSATFieldChecks, decide_eq_true_eq] + refine ⟨sourceOneHot_global_normalization + F points assignment hsatisfies interpolant, ?_, ?_, ?_⟩ + · intro clause + exact sourceOneHot_clause_refinement + F points assignment hsatisfies interpolant clause + · intro tableType j + apply sourceOneHot_ordinary_reedSolomon + F points assignment hsatisfies interpolant _ tableType j.val + exact hdegree.trans (Nat.sub_le _ _) + · intro clause tuple localVar j + exact sourceOneHot_shifted_reedSolomon + F points variablePlace assignment hsatisfies interpolant + hdegree hinterpolant hplaces clause tuple localVar j.val + +theorem sourceOneHot_solves_concreteSATBinaryAffineSystem + [Algebra (ZMod 2) K] + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (hdegree : interpolant.natDegree ≤ F.variableCount - 1) + (hinterpolant : ∀ i : Fin F.variableCount, + interpolant.eval (variablePlace i) = + sourceSATFieldBit (K := K) (assignment i)) + (hplaces : ∀ point : sourceSATGridPoint points, + ∀ i : Fin F.variableCount, point.val - variablePlace i ≠ 0) + (momentBudget : ℕ) : + (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves + (sourceOneHotSignedTable F points assignment hsatisfies + interpolant) := by + apply (concreteSATBinaryAffineSystem_solves_iff + F fieldBasis points variablePlace momentBudget + (sourceOneHotSignedTable F points assignment hsatisfies + interpolant)).mpr + change concreteSATFieldChecks F points variablePlace momentBudget + (sourceOneHotFieldTable F points assignment hsatisfies interpolant) + exact sourceOneHot_satisfies_concreteFieldChecks + F points variablePlace assignment hsatisfies interpolant + hdegree hinterpolant hplaces momentBudget + +private theorem sourceOneHotSignedTable_global_row_weight + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (point : sourceSATGridPoint points) : + (∑ value : K, + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inl ()) point value)).natAbs ^ 2) = + 1 := by + classical + calc + (∑ value : K, + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inl ()) point value)).natAbs ^ 2) = + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points (.inl ()) point + (interpolant.eval point.val))).natAbs ^ 2 := by + apply Fintype.sum_eq_single (interpolant.eval point.val) + intro value hvalue + simp only [List.get_eq_getElem, sourceOneHotSignedTable_global, hvalue, ↓reduceIte, + Int.natAbs_zero, ne_eq, + OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow] + _ = 1 := by simp only [List.get_eq_getElem, sourceOneHotSignedTable_global, ↓reduceIte, + isUnit_one, Int.natAbs_of_isUnit, + one_pow] + +private theorem sourceOneHotSignedTable_clause_row_weight + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) + (clause : Fin F.clauses.length) + (point : sourceSATGridPoint points) : + (∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + ∑ value : K, + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value)).natAbs ^ 2) = 1 := by + classical + calc + (∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + ∑ value : K, + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value)).natAbs ^ 2) = + ∑ value : K, + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points + (.inr ⟨clause, + sourceActiveLocalTuple F assignment hsatisfies clause⟩) + point value)).natAbs ^ 2 := by + apply Fintype.sum_eq_single + (sourceActiveLocalTuple F assignment hsatisfies clause) + intro tuple htuple + simp only [List.get_eq_getElem, sourceOneHotSignedTable_subtype, htuple, false_and, + ↓reduceIte, + Int.natAbs_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, + sum_const_zero] + _ = (sourceOneHotSignedTable F points assignment hsatisfies interpolant + (sourceSATColumnIndex F points + (.inr ⟨clause, + sourceActiveLocalTuple F assignment hsatisfies clause⟩) + point (interpolant.eval point.val))).natAbs ^ 2 := by + apply Fintype.sum_eq_single (interpolant.eval point.val) + intro value hvalue + simp only [List.get_eq_getElem, sourceOneHotSignedTable_subtype, hvalue, and_false, + ↓reduceIte, + Int.natAbs_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow] + _ = 1 := by simp only [List.get_eq_getElem, sourceOneHotSignedTable_subtype, and_self, + ↓reduceIte, isUnit_one, + Int.natAbs_of_isUnit, one_pow] + +theorem sourceOneHotSignedTable_squaredNorm + (F : Formula) (points : Finset K) + (assignment : Fin F.variableCount → Bool) + (hsatisfies : F.Satisfied assignment) + (interpolant : K[X]) : + (∑ position : Fin (sourceSATTableDimension F K points), + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + position).natAbs ^ 2) = + (F.clauses.length + 1) * points.card := by + classical + calc + (∑ position : Fin (sourceSATTableDimension F K points), + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + position).natAbs ^ 2) = + ∑ coordinate : sourceSATTableCoordinate F K points, + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + (Fintype.equivFin + (sourceSATTableCoordinate F K points) coordinate)).natAbs ^ 2 := by + exact (Equiv.sum_comp + (Fintype.equivFin (sourceSATTableCoordinate F K points)) + (fun position : Fin (sourceSATTableDimension F K points) => + (sourceOneHotSignedTable F points assignment hsatisfies interpolant + position).natAbs ^ 2)).symm + _ = (F.clauses.length + 1) * points.card := by + rw [Fintype.sum_prod_type] + simp_rw [Fintype.sum_prod_type] + change + (∑ tableType : sourceSATTableType F, + ∑ point : sourceSATGridPoint points, + ∑ value : K, + (sourceOneHotSignedTable F points assignment hsatisfies + interpolant + (sourceSATColumnIndex F points tableType point value)).natAbs ^ + 2) = + (F.clauses.length + 1) * points.card + rw [Fintype.sum_sum_type, Fintype.sum_sigma] + have hclause : + ∀ clause : Fin F.clauses.length, + (∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + ∑ point : sourceSATGridPoint points, + ∑ value : K, + (sourceOneHotSignedTable F points assignment hsatisfies + interpolant (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value)).natAbs ^ 2) = + points.card := by + intro clause + rw [Finset.sum_comm] + simp_rw [sourceOneHotSignedTable_clause_row_weight] + simp only [univ_eq_attach, sum_const, card_attach, smul_eq_mul, mul_one] + simp_rw [sourceOneHotSignedTable_global_row_weight, hclause] + simp only [univ_unique, PUnit.default_eq_unit, univ_eq_attach, sum_const, card_attach, + smul_eq_mul, mul_one, + card_singleton, one_mul, card_univ, Fintype.card_fin] + rw [Nat.add_mul] + simp only [one_mul, Nat.add_comm] + +/-- GapCVP reduction support. -/ +def integerSquaredNorm {n : ℕ} (z : Fin n → ℤ) : ℕ := + ∑ i : Fin n, (z i).natAbs ^ 2 + +/-- GapCVP reduction support. -/ +def sourceOneHotCompletenessRadius + (F : Formula) {α : Type*} (points : Finset α) : ℚ := + (Nat.ceil + (Real.sqrt (((F.clauses.length + 1) * points.card : ℕ) : ℝ)) : ℚ) + +theorem sourceOneHotCompletenessRadius_pos + (F : Formula) {α : Type*} (points : Finset α) + (hpoints : 0 < points.card) : + 0 < sourceOneHotCompletenessRadius F points := by + have hweight : + 0 < (F.clauses.length + 1) * points.card := + Nat.mul_pos (Nat.zero_lt_succ F.clauses.length) hpoints + have hreal : + (0 : ℝ) < + (((F.clauses.length + 1) * points.card : ℕ) : ℝ) := by + exact_mod_cast hweight + have hceil : + 0 < Nat.ceil + (Real.sqrt (((F.clauses.length + 1) * points.card : ℕ) : ℝ)) := + Nat.ceil_pos.mpr (Real.sqrt_pos.mpr hreal) + unfold sourceOneHotCompletenessRadius + exact_mod_cast hceil + +theorem sourceOneHotCompletenessRadius_squared_bound + (F : Formula) {α : Type*} (points : Finset α) : + ((((F.clauses.length + 1) * points.card : ℕ) : ℝ)) ≤ + ((sourceOneHotCompletenessRadius F points : ℚ) : ℝ) ^ 2 := by + have hroot := Nat.le_ceil + (Real.sqrt (((F.clauses.length + 1) * points.card : ℕ) : ℝ)) + have hsquare := Real.sq_sqrt + (by positivity : + (0 : ℝ) ≤ (((F.clauses.length + 1) * points.card : ℕ) : ℝ)) + unfold sourceOneHotCompletenessRadius + norm_num only [Rat.cast_natCast] + nlinarith [Real.sqrt_nonneg + (((F.clauses.length + 1) * points.card : ℕ) : ℝ)] + +end + +end Core + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part09.lean b/LeanPool/GapCVP/Part09.lean new file mode 100644 index 000000000..3b573a846 --- /dev/null +++ b/LeanPool/GapCVP/Part09.lean @@ -0,0 +1,8644 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part08 +import Mathlib.Algebra.Order.Floor.Semifield +import Mathlib.Data.Int.Star +import Mathlib.FieldTheory.RatFunc.AsPolynomial +import Mathlib.RingTheory.Flat.TorsionFree +import Mathlib.RingTheory.Henselian +import Mathlib.RingTheory.MvPolynomial.Symmetric.FundamentalTheorem +import Mathlib.RingTheory.MvPolynomial.Symmetric.NewtonIdentities +import Mathlib.RingTheory.Polynomial.Resultant.Basic +import Mathlib.RingTheory.Polynomial.Vieta +import Mathlib.RingTheory.RegularLocalRing.Defs +import Mathlib.RingTheory.SimpleRing.Principal + +/-! # GapCVP proof, part 09 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace Factor400BinaryConstructiveSourcePlaces + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryFieldBasis + +/-- GapCVP reduction support. -/ +abbrev sourceFormulaField (encodingLength : ℕ) (formula : Formula) := + GapCVP.Core.sourceFormulaField encodingLength formula + +theorem variableCount_le_fieldWordCount + (encodingLength : ℕ) (formula : Formula) : + formula.variableCount ≤ + 2 ^ sourceFieldExponent + (sourceSizeParameter encodingLength formula) := by + let sourceSize := sourceSizeParameter encodingLength formula + have hsource : 100 ≤ sourceSize := + sourceSizeParameter_ge_one_hundred encodingLength formula + have hvariable : formula.variableCount ≤ sourceSize := + source_variableCount_le_size encodingLength formula + have hpower : sourceSize ≤ sourceSize ^ 200 := by + calc + sourceSize = sourceSize ^ 1 := by simp only [pow_one] + _ ≤ sourceSize ^ 200 := + Nat.pow_le_pow_right (by omega) (by norm_num) + have hcard : sourceSize ^ 200 ≤ + 2 ^ sourceFieldExponent sourceSize := by + simpa only [sourceFiniteField_card hsource] using sourceFiniteField_card_lower hsource + exact hvariable.trans (hpower.trans hcard) + +/-- GapCVP reduction support. -/ +def sourceFormulaVariableWordIndex + (encodingLength : ℕ) (formula : Formula) : + Fin formula.variableCount ↪ + Fin (2 ^ sourceFieldExponent + (sourceSizeParameter encodingLength formula)) := + boundedWordIndex (variableCount_le_fieldWordCount + encodingLength formula) + +/-- GapCVP reduction support. -/ +def sourceFormulaVariableWord + (encodingLength : ℕ) (formula : Formula) + (index : Fin formula.variableCount) : + EffectiveBinaryField.Word + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)) := + indexedWord _ + (sourceFormulaVariableWordIndex encodingLength formula index) + +/-- GapCVP reduction support. -/ +def sourceFormulaVariablePlace + (encodingLength : ℕ) (formula : Formula) : + Fin formula.variableCount → sourceFormulaField encodingLength formula := + effectiveAnchor + (sourceFieldExponent (sourceSizeParameter encodingLength formula)) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + (variableCount_le_fieldWordCount encodingLength formula) + +theorem sourceFormulaVariablePlace_injective + (encodingLength : ℕ) (formula : Formula) : + Function.Injective + (sourceFormulaVariablePlace encodingLength formula) := + (effectiveAnchor + (sourceFieldExponent (sourceSizeParameter encodingLength formula)) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + (variableCount_le_fieldWordCount encodingLength formula)).injective + +/-- GapCVP reduction support. -/ +def sourceFormulaFieldBasis (encodingLength : ℕ) (formula : Formula) : + Module.Basis + (Fin (sourceFieldExponent + (sourceSizeParameter encodingLength formula))) + (ZMod 2) (sourceFormulaField encodingLength formula) := + effectiveFieldBasis + (sourceFieldExponent (sourceSizeParameter encodingLength formula)) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + +/-- GapCVP reduction support. -/ +def sourceFormulaGrid (encodingLength : ℕ) (formula : Formula) : + Finset (sourceFormulaField encodingLength formula) := + sourceSATPuncturedGrid formula + (sourceFormulaVariablePlace encodingLength formula) + +private theorem sourceFormulaGrid_card + (encodingLength : ℕ) (formula : Formula) : + (sourceFormulaGrid encodingLength formula).card = + Fintype.card (sourceFormulaField encodingLength formula) - + formula.variableCount := by + exact sourceSATPuncturedGrid_card formula + (sourceFormulaVariablePlace encodingLength formula) + (sourceFormulaVariablePlace_injective encodingLength formula) + +theorem sourceFormulaGrid_card_eq_fieldWordCount + (encodingLength : ℕ) (formula : Formula) : + (sourceFormulaGrid encodingLength formula).card = + 2 ^ sourceFieldExponent + (sourceSizeParameter encodingLength formula) - + formula.variableCount := by + rw [sourceFormulaGrid_card, + sourceFiniteField_card + (sourceSizeParameter_ge_one_hundred encodingLength formula)] + +private theorem sourceFormulaGrid_max_degree_lt + (encodingLength : ℕ) (formula : Formula) : + sourceSizeParameter encodingLength formula ^ 31 < + (sourceFormulaGrid encodingLength formula).card := by + classical + let sourceSize := sourceSizeParameter encodingLength formula + let places : Finset (sourceFormulaField encodingLength formula) := + (Finset.univ : Finset (Fin formula.variableCount)).image + (sourceFormulaVariablePlace encodingLength formula) + have hplaces : places.card ≤ sourceSize := by + calc + places.card ≤ + (Finset.univ : Finset (Fin formula.variableCount)).card := by + dsimp [places] + exact Finset.card_image_le + _ = formula.variableCount := by simp only [Finset.card_univ, Fintype.card_fin] + _ ≤ sourceSize := source_variableCount_le_size encodingLength formula + have hgrid := source_moment_degree_lt_actual_grid + places (sourceSizeParameter_ge_one_hundred encodingLength formula) + (sourceFiniteField_card_lower + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + hplaces + simpa only [sourceFormulaGrid, sourceSATPuncturedGrid, gt_iff_lt] using hgrid + +theorem sourceFormulaGrid_card_pos + (encodingLength : ℕ) (formula : Formula) : + 0 < (sourceFormulaGrid encodingLength formula).card := + Nat.zero_lt_of_lt + (sourceFormulaGrid_max_degree_lt encodingLength formula) + +/-- GapCVP reduction support. -/ +abbrev sourceFormulaDimension (encodingLength : ℕ) (formula : Formula) : ℕ := + sourceSATTableDimension formula + (sourceFormulaField encodingLength formula) + (sourceFormulaGrid encodingLength formula) + +theorem sourceFormulaDimension_pos + (encodingLength : ℕ) (formula : Formula) : + 0 < sourceFormulaDimension encodingLength formula := by + unfold sourceFormulaDimension + rw [sourceSATTableDimension_eq] + have htypes : 0 < Fintype.card (sourceSATTableType formula) := + Fintype.card_pos_iff.mpr ⟨.inl ()⟩ + have hfield : + 0 < Fintype.card (sourceFormulaField encodingLength formula) := + Fintype.card_pos_iff.mpr ⟨0⟩ + exact Nat.mul_pos + (Nat.mul_pos htypes + (sourceFormulaGrid_card_pos encodingLength formula)) hfield + +theorem sourceFormulaDimension_le + (encodingLength : ℕ) (formula : Formula) : + sourceFormulaDimension encodingLength formula ≤ + 40 * sourceSizeParameter encodingLength formula ^ 401 := by + unfold sourceFormulaDimension + apply sourceSATTableDimension_le formula + (sourceFormulaField encodingLength formula) + (sourceFormulaGrid encodingLength formula) + (sourceSizeParameter encodingLength formula) + (sourceSizeParameter_ge_one_hundred encodingLength formula) + (source_clauseCount_le_size encodingLength formula) + · exact Finset.card_le_card (Finset.subset_univ _) + · exact sourceFiniteField_card_upper + (sourceSizeParameter_ge_one_hundred encodingLength formula) + +/-- GapCVP reduction support. -/ +def sourceFormulaBinarySystem + (encodingLength : ℕ) (formula : Formula) : BinaryAffineSystem := + concreteSATBinaryAffineSystem formula + (sourceFormulaFieldBasis encodingLength formula) + (sourceFormulaGrid encodingLength formula) + (sourceFormulaVariablePlace encodingLength formula) + (sourceSizeParameter encodingLength formula ^ 30) + +theorem sourceFormulaBinarySystem_solves_iff + (encodingLength : ℕ) (formula : Formula) + (z : Fin (sourceFormulaDimension encodingLength formula) → ℤ) : + (sourceFormulaBinarySystem encodingLength formula).Solves z ↔ + concreteSATFieldChecks formula + (sourceFormulaGrid encodingLength formula) + (sourceFormulaVariablePlace encodingLength formula) + (sourceSizeParameter encodingLength formula ^ 30) + (fun position => algebraMap (ZMod 2) + (sourceFormulaField encodingLength formula) + (z position : ZMod 2)) := by + exact concreteSATBinaryAffineSystem_solves_iff + formula (sourceFormulaFieldBasis encodingLength formula) + (sourceFormulaGrid encodingLength formula) + (sourceFormulaVariablePlace encodingLength formula) + (sourceSizeParameter encodingLength formula ^ 30) z + +end Factor400BinaryConstructiveSourcePlaces + +namespace BinarySourceCoordinateOrder + +open GapCVP.Core GapCVP.BinaryFieldBasis GapCVP.Factor400BinaryConstructiveSourcePlaces + +attribute [local instance] Classical.propDecidable + +/-- GapCVP reduction support. -/ +abbrev sourceFormulaWordDegree + (encodingLength : ℕ) (formula : Formula) : ℕ := + sourceFieldExponent (sourceSizeParameter encodingLength formula) + +/-- GapCVP reduction support. -/ +def sourceFormulaFieldWordOrder + (encodingLength : ℕ) (formula : Formula) : + Fin (2 ^ sourceFormulaWordDegree encodingLength formula) ≃ + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula := + indexedFieldEquiv (sourceFormulaWordDegree encodingLength formula) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + +theorem sourceFormulaFieldWordOrder_card + (encodingLength : ℕ) (formula : Formula) : + Fintype.card + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) = + 2 ^ sourceFormulaWordDegree encodingLength formula := + sourceFiniteField_card + (sourceSizeParameter_ge_one_hundred encodingLength formula) + +/-- GapCVP reduction support. -/ +def sourceFormulaFieldCardOrder + (encodingLength : ℕ) (formula : Formula) : + Fin (Fintype.card + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula)) ≃ + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula := + (finCongr (sourceFormulaFieldWordOrder_card + encodingLength formula)).trans + (sourceFormulaFieldWordOrder encodingLength formula) + +/-- GapCVP reduction support. -/ +def sourceFormulaEvaluationWord + (encodingLength : ℕ) (formula : Formula) + (index : Fin + (2 ^ sourceFormulaWordDegree encodingLength formula - + formula.variableCount)) : + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula := + effectiveEvaluationEmbedding + (sourceFormulaWordDegree encodingLength formula) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + (variableCount_le_fieldWordCount encodingLength formula) index + +theorem sourceFormulaEvaluationWord_ne_variablePlace + (encodingLength : ℕ) (formula : Formula) + (index : Fin + (2 ^ sourceFormulaWordDegree encodingLength formula - + formula.variableCount)) + (variableIndex : Fin formula.variableCount) : + sourceFormulaEvaluationWord encodingLength formula index ≠ + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength formula variableIndex := by + exact effectiveEvaluationEmbedding_ne_anchor + (sourceFormulaWordDegree encodingLength formula) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + (variableCount_le_fieldWordCount encodingLength formula) + index variableIndex + +private def sourceFormulaGridWordEmbedding + (encodingLength : ℕ) (formula : Formula) : + Fin (2 ^ sourceFormulaWordDegree encodingLength formula - + formula.variableCount) ↪ + sourceSATGridPoint + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) where + toFun index := + ⟨sourceFormulaEvaluationWord encodingLength formula index, by + change sourceFormulaEvaluationWord encodingLength formula index ∈ + Finset.univ \ + ((Finset.univ : Finset (Fin formula.variableCount)).image + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength formula)) + apply Finset.mem_sdiff.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + intro himage + obtain ⟨variableIndex, _, hequal⟩ := + Finset.mem_image.mp himage + exact (sourceFormulaEvaluationWord_ne_variablePlace + encodingLength formula index variableIndex) hequal.symm⟩ + inj' := by + intro first second hequal + apply (effectiveEvaluationEmbedding + (sourceFormulaWordDegree encodingLength formula) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + (variableCount_le_fieldWordCount encodingLength formula)).injective + exact congrArg Subtype.val hequal + +private theorem sourceFormulaGridWordEmbedding_bijective + (encodingLength : ℕ) (formula : Formula) : + Function.Bijective + (sourceFormulaGridWordEmbedding encodingLength formula) := by + apply (Fintype.bijective_iff_injective_and_card _).2 + refine ⟨(sourceFormulaGridWordEmbedding + encodingLength formula).injective, ?_⟩ + simpa only [Fintype.card_fin, Fintype.card_coe] using + (sourceFormulaGrid_card_eq_fieldWordCount encodingLength formula).symm + +/-- GapCVP reduction support. -/ +def sourceFormulaGridWordOrder + (encodingLength : ℕ) (formula : Formula) : + Fin (2 ^ sourceFormulaWordDegree encodingLength formula - + formula.variableCount) ≃ + sourceSATGridPoint + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) := + Equiv.ofBijective + (sourceFormulaGridWordEmbedding encodingLength formula) + (sourceFormulaGridWordEmbedding_bijective encodingLength formula) + +/-- GapCVP reduction support. -/ +def sourceFormulaGridOrder + (encodingLength : ℕ) (formula : Formula) : + Fin ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula).card) ≃ + sourceSATGridPoint + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) := + (finCongr + (sourceFormulaGrid_card_eq_fieldWordCount + encodingLength formula)).trans + (sourceFormulaGridWordOrder encodingLength formula) + +/-- GapCVP reduction support. -/ +def sourceFormulaCoordinateOrder + (encodingLength : ℕ) (formula : Formula) + (typeOrder : + Fin (Fintype.card (sourceSATTableType formula)) ≃ + sourceSATTableType formula) : + Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) ≃ + sourceSATTableCoordinate formula + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) := by + let grid := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula + let field := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula + have hdimension : + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula = + Fintype.card (sourceSATTableType formula) * + grid.card * Fintype.card field := by + exact sourceSATTableDimension_eq formula field grid + refine (finCongr hdimension).trans ?_ + let first := + (finProdFinEquiv + (m := Fintype.card (sourceSATTableType formula) * grid.card) + (n := Fintype.card field)).symm + let second := + (finProdFinEquiv + (m := Fintype.card (sourceSATTableType formula)) + (n := grid.card)).symm + exact first.trans + ((second.prodCongr + (sourceFormulaFieldCardOrder encodingLength formula)).trans + ((Equiv.prodAssoc + (Fin (Fintype.card (sourceSATTableType formula))) + (Fin grid.card) field).trans + (typeOrder.prodCongr + ((sourceFormulaGridOrder encodingLength formula).prodCongr + (Equiv.refl field))))) + +end BinarySourceCoordinateOrder + +namespace BinaryReedSolomonParity + +open Polynomial Matrix + +variable {K : Type*} [Field K] + +/-- GapCVP reduction support. -/ +def orderedInterpolationNode {p D : ℕ} + (points : Fin p → K) (hdegree : D < p) : Fin (D + 1) → K := + fun index => points + (Fin.castLE (Nat.succ_le_of_lt hdegree) index) + +omit [Field K] in +private theorem orderedInterpolationNode_injective {p D : ℕ} + (points : Fin p → K) (hdegree : D < p) + (hpoints : Function.Injective points) : + Function.Injective (orderedInterpolationNode points hdegree) := by + intro first second heq + have hcast : + Fin.castLE (Nat.succ_le_of_lt hdegree) first = + Fin.castLE (Nat.succ_le_of_lt hdegree) second := + hpoints heq + apply Fin.ext + simpa only [Nat.succ_eq_add_one, Fin.val_castLE] using congrArg (fun index : Fin p => index.val) + hcast + +/-- GapCVP reduction support. -/ +def orderedInterpolationPrefix {p D : ℕ} + (hdegree : D < p) : + (Fin p → K) →ₗ[K] (Fin (D + 1) → K) where + toFun values index := + values (Fin.castLE (Nat.succ_le_of_lt hdegree) index) + map_add' first second := by + funext index + rfl + map_smul' scalar values := by + funext index + rfl + +/-- GapCVP reduction support. -/ +def orderedInterpolationPolynomial {p D : ℕ} + (points : Fin p → K) (hdegree : D < p) + (values : Fin p → K) : K[X] := + Lagrange.interpolate (Finset.univ : Finset (Fin (D + 1))) + (orderedInterpolationNode points hdegree) + (orderedInterpolationPrefix hdegree values) + +private def orderedGridEvaluation {p : ℕ} + (points : Fin p → K) : K[X] →ₗ[K] (Fin p → K) where + toFun polynomial index := polynomial.eval (points index) + map_add' first second := by + funext index + simp only [eval_add, Pi.add_apply] + map_smul' scalar polynomial := by + funext index + simp only [eval_smul, smul_eq_mul, RingHom.id_apply, Pi.smul_apply] + +/-- GapCVP reduction support. -/ +def constructiveParityLinearMap {p D : ℕ} + (points : Fin p → K) (hdegree : D < p) : + (Fin p → K) →ₗ[K] (Fin p → K) := + LinearMap.id - + (orderedGridEvaluation points).comp + ((Lagrange.interpolate (Finset.univ : Finset (Fin (D + 1))) + (orderedInterpolationNode points hdegree)).comp + (orderedInterpolationPrefix hdegree)) + +/-- GapCVP reduction support. -/ +def constructiveParityMatrix {p D : ℕ} + (points : Fin p → K) (hdegree : D < p) : + Matrix (Fin p) (Fin p) K := + LinearMap.toMatrix' (constructiveParityLinearMap points hdegree) + +@[simp] theorem constructiveParityLinearMap_apply {p D : ℕ} + (points : Fin p → K) (hdegree : D < p) + (values : Fin p → K) (index : Fin p) : + constructiveParityLinearMap points hdegree values index = + values index - + (orderedInterpolationPolynomial points hdegree values).eval + (points index) := by + rfl + +private theorem orderedInterpolationPolynomial_natDegree_le {p D : ℕ} + (points : Fin p → K) (hdegree : D < p) + (hpoints : Function.Injective points) + (values : Fin p → K) : + (orderedInterpolationPolynomial points hdegree values).natDegree ≤ D := by + let nodes := orderedInterpolationNode points hdegree + have hnodes : Function.Injective nodes := + orderedInterpolationNode_injective points hdegree hpoints + have hlt : + (orderedInterpolationPolynomial points hdegree values).degree < + ((D + 1 : ℕ) : WithBot ℕ) := by + simpa only [orderedInterpolationPolynomial, Lagrange.interpolate_apply, Nat.cast_add, + Nat.cast_one, + Finset.card_univ, Fintype.card_fin] using + (Lagrange.degree_interpolate_lt (s := (Finset.univ : Finset (Fin (D + 1)))) + (orderedInterpolationPrefix hdegree values) hnodes.injOn) + by_cases hzero : orderedInterpolationPolynomial points hdegree values = 0 + · simp only [hzero, natDegree_zero, zero_le] + · have hnat := + (Polynomial.natDegree_lt_iff_degree_lt hzero).mpr hlt + omega + +private theorem constructiveParityMatrix_mulVec_eq_zero_iff_polynomial + {p D : ℕ} (points : Fin p → K) (hdegree : D < p) + (hpoints : Function.Injective points) + (values : Fin p → K) : + (constructiveParityMatrix points hdegree).mulVec values = 0 ↔ + ∃ polynomial : K[X], polynomial.natDegree ≤ D ∧ + ∀ index : Fin p, polynomial.eval (points index) = values index := by + rw [constructiveParityMatrix, LinearMap.toMatrix'_mulVec] + constructor + · intro hzero + refine ⟨orderedInterpolationPolynomial points hdegree values, + orderedInterpolationPolynomial_natDegree_le + points hdegree hpoints values, ?_⟩ + intro index + have hindex := congrFun hzero index + rw [constructiveParityLinearMap_apply] at hindex + exact (sub_eq_zero.mp hindex).symm + · rintro ⟨polynomial, hpoly, heval⟩ + let nodes := orderedInterpolationNode points hdegree + have hnodes : Function.Injective nodes := + orderedInterpolationNode_injective points hdegree hpoints + have hpolynomialdegree : + polynomial.degree < ((D + 1 : ℕ) : WithBot ℕ) := by + by_cases hzero : polynomial = 0 + · simp only [hzero, degree_zero, Nat.cast_add, Nat.cast_one, WithBot.bot_lt_add, + WithBot.bot_lt_natCast, + WithBot.bot_lt_one, and_self] + · apply (Polynomial.natDegree_lt_iff_degree_lt hzero).mp + omega + have hinterpolation : + polynomial = orderedInterpolationPolynomial + points hdegree values := by + unfold orderedInterpolationPolynomial + have hpolynomialdegree' : + polynomial.degree < + (((Finset.univ : Finset (Fin (D + 1))).card : ℕ) : WithBot ℕ) := by + simpa only [Finset.card_univ, Fintype.card_fin, Nat.cast_add, Nat.cast_one] + using hpolynomialdegree + apply Lagrange.eq_interpolate_of_eval_eq + (orderedInterpolationPrefix hdegree values) + hnodes.injOn hpolynomialdegree' + intro index _ + exact heval (Fin.castLE (Nat.succ_le_of_lt hdegree) index) + funext index + rw [constructiveParityLinearMap_apply] + change values index - + (orderedInterpolationPolynomial points hdegree values).eval + (points index) = 0 + rw [← hinterpolation, heval index, sub_self] + +end BinaryReedSolomonParity + +namespace Core + +section + +open Polynomial IsDedekindDomain + +variable {K E : Type*} [Field K] [Field E] + +private def functionFieldPlaceIdeal (a : K) : Ideal K[X] := + Ideal.span ({X - C a} : Set K[X]) + +private theorem functionFieldPlaceIdeal_isMaximal (a : K) : + (functionFieldPlaceIdeal a).IsMaximal := by + simpa only [functionFieldPlaceIdeal] using + (PrincipalIdealRing.isMaximal_of_irreducible (Polynomial.irreducible_X_sub_C a)) + +private theorem functionFieldPlaceIdeal_ne_bot (a : K) : + functionFieldPlaceIdeal a ≠ ⊥ := by + intro h + apply Polynomial.X_sub_C_ne_zero a + exact Ideal.span_singleton_eq_bot.mp h + +section + +variable [Algebra (RatFunc K) E] [Algebra K[X] E] +variable [IsScalarTower K[X] (RatFunc K) E] +variable [FiniteDimensional (RatFunc K) E] +variable [Algebra.IsSeparable (RatFunc K) E] + +omit [FiniteDimensional (RatFunc K) E] + [Algebra.IsSeparable (RatFunc K) E] in +theorem functionFieldPolynomial_algebraMap_injective : + Function.Injective (algebraMap K[X] E) := by + rw [IsScalarTower.algebraMap_eq K[X] (RatFunc K) E] + exact (algebraMap (RatFunc K) E).injective.comp + (IsFractionRing.injective K[X] (RatFunc K)) + +omit [FiniteDimensional (RatFunc K) E] + [Algebra.IsSeparable (RatFunc K) E] in +private theorem functionFieldIntegralClosure_algebraMap_injective : + Function.Injective + (algebraMap K[X] (integralClosure K[X] E)) := by + intro x y h + apply functionFieldPolynomial_algebraMap_injective (K := K) (E := E) + calc + algebraMap K[X] E x = + algebraMap (integralClosure K[X] E) E + (algebraMap K[X] (integralClosure K[X] E) x) := + IsScalarTower.algebraMap_apply K[X] (integralClosure K[X] E) E x + _ = algebraMap (integralClosure K[X] E) E + (algebraMap K[X] (integralClosure K[X] E) y) := + congrArg (algebraMap (integralClosure K[X] E) E) h + _ = algebraMap K[X] E y := + (IsScalarTower.algebraMap_apply K[X] + (integralClosure K[X] E) E y).symm + +omit [FiniteDimensional (RatFunc K) E] + [Algebra.IsSeparable (RatFunc K) E] in +private theorem exists_functionFieldPlace_maximal (a : K) : + ∃ P : Ideal (integralClosure K[X] E), + P.IsMaximal ∧ + P.comap (algebraMap K[X] (integralClosure K[X] E)) = + functionFieldPlaceIdeal a := by + let : (functionFieldPlaceIdeal a).IsMaximal := + functionFieldPlaceIdeal_isMaximal a + apply Ideal.exists_ideal_over_maximal_of_isIntegral + (S := integralClosure K[X] E) (functionFieldPlaceIdeal a) + rw [(RingHom.injective_iff_ker_eq_bot _).mp + (functionFieldIntegralClosure_algebraMap_injective + (K := K) (E := E))] + exact bot_le + +omit [FiniteDimensional (RatFunc K) E] + [Algebra.IsSeparable (RatFunc K) E] in +private theorem exists_functionFieldPlace_heightOne (a : K) : + ∃ P : HeightOneSpectrum (integralClosure K[X] E), + P.asIdeal.comap (algebraMap K[X] (integralClosure K[X] E)) = + functionFieldPlaceIdeal a := by + obtain ⟨P, hmaximal, hover⟩ := + exists_functionFieldPlace_maximal (K := K) (E := E) a + have hnonzero : P ≠ ⊥ := by + intro hzero + apply functionFieldPlaceIdeal_ne_bot a + calc + functionFieldPlaceIdeal a = + P.comap (algebraMap K[X] (integralClosure K[X] E)) := + hover.symm + _ = ⊥ := by + rw [hzero] + exact Ideal.comap_bot_of_injective + (algebraMap K[X] (integralClosure K[X] E)) + (functionFieldIntegralClosure_algebraMap_injective + (K := K) (E := E)) + exact ⟨⟨P, hmaximal.isPrime, hnonzero⟩, hover⟩ + +private def functionFieldPlaceValuation + (place : HeightOneSpectrum (integralClosure K[X] E)) : + Valuation E (WithZero (Multiplicative ℤ)) := by + letI : IsDedekindDomain (integralClosure K[X] E) := + integralClosure.isDedekindDomain K[X] (RatFunc K) E + letI : IsFractionRing (integralClosure K[X] E) E := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) E + exact place.valuation E + +private theorem functionFieldPlaceValuation_lt_one_iff_mem + (place : HeightOneSpectrum (integralClosure K[X] E)) + (x : integralClosure K[X] E) : + functionFieldPlaceValuation (K := K) (E := E) place + (algebraMap (integralClosure K[X] E) E x) < 1 ↔ + x ∈ place.asIdeal := by + let : IsDedekindDomain (integralClosure K[X] E) := + integralClosure.isDedekindDomain K[X] (RatFunc K) E + let : IsFractionRing (integralClosure K[X] E) E := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) E + change place.valuation E + (algebraMap (integralClosure K[X] E) E x) < 1 ↔ _ + exact place.valuation_lt_one_iff_mem x + +private theorem functionFieldPlaceValuation_polynomial_lt_one_iff + (place : HeightOneSpectrum (integralClosure K[X] E)) (a : K) + (hover : place.asIdeal.comap + (algebraMap K[X] (integralClosure K[X] E)) = + functionFieldPlaceIdeal a) + (f : K[X]) : + functionFieldPlaceValuation (K := K) (E := E) place + (algebraMap K[X] E f) < 1 ↔ + f ∈ functionFieldPlaceIdeal a := by + rw [IsScalarTower.algebraMap_apply K[X] + (integralClosure K[X] E) E f] + rw [functionFieldPlaceValuation_lt_one_iff_mem] + change f ∈ place.asIdeal.comap + (algebraMap K[X] (integralClosure K[X] E)) ↔ _ + rw [hover] + +private def functionFieldHeightOnePlace (a : K) : + HeightOneSpectrum (integralClosure K[X] E) := + Classical.choose + (exists_functionFieldPlace_heightOne (K := K) (E := E) a) + +omit [FiniteDimensional (RatFunc K) E] + [Algebra.IsSeparable (RatFunc K) E] in +private theorem functionFieldHeightOnePlace_comap (a : K) : + (functionFieldHeightOnePlace (K := K) (E := E) a).asIdeal.comap + (algebraMap K[X] (integralClosure K[X] E)) = + functionFieldPlaceIdeal a := + Classical.choose_spec + (exists_functionFieldPlace_heightOne (K := K) (E := E) a) + +/-- GapCVP reduction support. -/ +def functionFieldExtendedValuation (a : K) : + Valuation E (WithZero (Multiplicative ℤ)) := + functionFieldPlaceValuation (K := K) (E := E) + (functionFieldHeightOnePlace (K := K) (E := E) a) + +private theorem functionFieldExtendedValuation_polynomial_lt_one_iff + (a : K) (f : K[X]) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E f) < 1 ↔ + f ∈ functionFieldPlaceIdeal a := by + exact functionFieldPlaceValuation_polynomial_lt_one_iff + (functionFieldHeightOnePlace (K := K) (E := E) a) a + (functionFieldHeightOnePlace_comap (K := K) (E := E) a) f + +theorem functionFieldExtendedValuation_place_lt_one (a : K) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) < 1 := by + apply (functionFieldExtendedValuation_polynomial_lt_one_iff + (K := K) (E := E) a (X - C a)).mpr + exact Ideal.mem_span_singleton_self (X - C a) + +end + +end + +section + +open Finset + +private def badPoints {α : Type*} + (points : Finset α) (fiberWeight : α → ℕ) (K : ℕ) : Finset α := + points.filter fun p => K < fiberWeight p + +private def goodPoints {α : Type*} + (points : Finset α) (fiberWeight : α → ℕ) (K : ℕ) : Finset α := + points.filter fun p => fiberWeight p ≤ K + +private theorem badPoints_card_mul_le_sum {α : Type*} + (points : Finset α) (fiberWeight : α → ℕ) (K : ℕ) : + (badPoints points fiberWeight K).card * (K + 1) ≤ + ∑ p ∈ points, fiberWeight p := by + classical + calc + (badPoints points fiberWeight K).card * (K + 1) = + ∑ p ∈ badPoints points fiberWeight K, (K + 1) := by simp only [sum_const, smul_eq_mul] + _ ≤ ∑ p ∈ badPoints points fiberWeight K, fiberWeight p := by + apply Finset.sum_le_sum + intro p hp + exact Nat.succ_le_of_lt (Finset.mem_filter.mp hp).2 + _ ≤ ∑ p ∈ points, fiberWeight p := by + apply Finset.sum_le_sum_of_subset_of_nonneg + · exact Finset.filter_subset _ _ + · intro p _ _ + exact Nat.zero_le _ + +private theorem badPoints_card_le_div {α : Type*} + (points : Finset α) (fiberWeight : α → ℕ) (K budget : ℕ) + (hbudget : (∑ p ∈ points, fiberWeight p) ≤ budget) : + (badPoints points fiberWeight K).card ≤ budget / (K + 1) := by + classical + apply (Nat.le_div_iff_mul_le (Nat.zero_lt_succ K)).2 + exact (badPoints_card_mul_le_sum points fiberWeight K).trans hbudget + +private theorem goodPoints_card_add_badPoints_card {α : Type*} + (points : Finset α) (fiberWeight : α → ℕ) (K : ℕ) : + (goodPoints points fiberWeight K).card + + (badPoints points fiberWeight K).card = points.card := by + classical + simpa only [goodPoints, badPoints, not_le] using + (Finset.card_filter_add_card_filter_not (s := points) (fun p => fiberWeight p ≤ K)) + +private theorem goodPoints_card_lower_bound {α : Type*} + (points : Finset α) (fiberWeight : α → ℕ) (K budget : ℕ) + (hbudget : (∑ p ∈ points, fiberWeight p) ≤ budget) : + points.card - budget / (K + 1) ≤ + (goodPoints points fiberWeight K).card := by + classical + have hbad := badPoints_card_le_div points fiberWeight K budget hbudget + have hpartition := goodPoints_card_add_badPoints_card points fiberWeight K + omega + +end + +section + +open Finset Matrix Polynomial + +private def polynomialHankel {K : Type*} [Field K] + (moments : ℕ → K[X]) (h : ℕ) : Matrix (Fin h) (Fin h) K[X] := + Matrix.of fun i j => moments (i.val + j.val) + +private noncomputable def leadingHankelDet {K : Type*} [Field K] + (moments : ℕ → K[X]) (h : ℕ) : K[X] := + (polynomialHankel moments h).det + +private theorem card_hankel_zero_points_le_natDegree + {K : Type*} [Field K] [DecidableEq K] + (moments : ℕ → K[X]) (h : ℕ) + (points : Finset K) + (hdet : leadingHankelDet moments h ≠ 0) : + (points.filter fun p => (leadingHankelDet moments h).eval p = 0).card ≤ + (leadingHankelDet moments h).natDegree := by + classical + let d := leadingHankelDet moments h + have hd : d ≠ 0 := hdet + have hsubset : (points.filter fun p => d.eval p = 0) ⊆ d.roots.toFinset := by + intro p hp + have heval : d.eval p = 0 := (Finset.mem_filter.mp hp).2 + exact Multiset.mem_toFinset.mpr ((Polynomial.mem_roots hd).mpr heval) + calc + (points.filter fun p => d.eval p = 0).card ≤ d.roots.toFinset.card := + Finset.card_le_card hsubset + _ ≤ d.roots.card := Multiset.toFinset_card_le _ + _ ≤ d.natDegree := Polynomial.card_roots' d + +private theorem leadingHankelDet_zero {K : Type*} [Field K] + (moments : ℕ → K[X]) : leadingHankelDet moments 0 = 1 := by + simp only [leadingHankelDet, polynomialHankel, det_fin_zero] + +private noncomputable def nonzeroHankelRanks {K : Type*} [Field K] + (moments : ℕ → K[X]) (rankBound : ℕ) : Finset ℕ := by + classical + exact (Finset.range (rankBound + 1)).filter + fun h => leadingHankelDet moments h ≠ 0 + +private theorem nonzeroHankelRanks_nonempty {K : Type*} [Field K] + (moments : ℕ → K[X]) (rankBound : ℕ) : + (nonzeroHankelRanks moments rankBound).Nonempty := by + classical + refine ⟨0, ?_⟩ + simp only [nonzeroHankelRanks, ne_eq, mem_filter, mem_range, lt_add_iff_pos_left, + Order.lt_add_one_iff, + zero_le, leadingHankelDet_zero, one_ne_zero, not_false_eq_true, and_self] + +private noncomputable def maximalLeadingHankelRank {K : Type*} [Field K] + (moments : ℕ → K[X]) (rankBound : ℕ) : ℕ := + (nonzeroHankelRanks moments rankBound).max' + (nonzeroHankelRanks_nonempty moments rankBound) + +private theorem maximalLeadingHankelRank_mem {K : Type*} [Field K] + (moments : ℕ → K[X]) (rankBound : ℕ) : + maximalLeadingHankelRank moments rankBound ≤ rankBound ∧ + leadingHankelDet moments + (maximalLeadingHankelRank moments rankBound) ≠ 0 := by + classical + have hmem := Finset.max'_mem + (nonzeroHankelRanks moments rankBound) + (nonzeroHankelRanks_nonempty moments rankBound) + change maximalLeadingHankelRank moments rankBound ∈ + nonzeroHankelRanks moments rankBound at hmem + have hf := Finset.mem_filter.mp (show + maximalLeadingHankelRank moments rankBound ∈ + (Finset.range (rankBound + 1)).filter + (fun h => leadingHankelDet moments h ≠ 0) from hmem) + exact ⟨Nat.lt_succ_iff.mp (Finset.mem_range.mp hf.1), hf.2⟩ + +private theorem leadingHankelDet_eq_zero_of_maximal_lt {K : Type*} [Field K] + (moments : ℕ → K[X]) (rankBound h : ℕ) + (hh : h ≤ rankBound) + (hmax : maximalLeadingHankelRank moments rankBound < h) : + leadingHankelDet moments h = 0 := by + classical + by_contra hne + have hmem : h ∈ nonzeroHankelRanks moments rankBound := by + change h ∈ (Finset.range (rankBound + 1)).filter + (fun r => leadingHankelDet moments r ≠ 0) + exact Finset.mem_filter.mpr ⟨Finset.mem_range.mpr (Nat.lt_succ_of_le hh), hne⟩ + have hle : h ≤ maximalLeadingHankelRank moments rankBound := by + simpa only [maximalLeadingHankelRank] using (Finset.le_max' (nonzeroHankelRanks moments + rankBound) h hmem) + omega + +private theorem card_good_nonzero_hankel_lower_bound + {K : Type*} [Field K] [DecidableEq K] + (moments : ℕ → K[X]) (h : ℕ) + (points : Finset K) (fiberWeight : K → ℕ) + (supportBound budget : ℕ) + (hbudget : (∑ p ∈ points, fiberWeight p) ≤ budget) + (hdet : leadingHankelDet moments h ≠ 0) : + points.card - budget / (supportBound + 1) - + (leadingHankelDet moments h).natDegree ≤ + ((goodPoints points fiberWeight supportBound).filter fun p => + (leadingHankelDet moments h).eval p ≠ 0).card := by + classical + let G := goodPoints points fiberWeight supportBound + let d := leadingHankelDet moments h + have hgood : points.card - budget / (supportBound + 1) ≤ G.card := + goodPoints_card_lower_bound points fiberWeight supportBound budget hbudget + have hzero : (G.filter fun p => d.eval p = 0).card ≤ d.natDegree := + card_hankel_zero_points_le_natDegree moments h G hdet + have hpartition : + (G.filter fun p => d.eval p ≠ 0).card + + (G.filter fun p => d.eval p = 0).card = G.card := by + simpa only [ne_eq, Decidable.not_not] using + (Finset.card_filter_add_card_filter_not (s := G) (fun p => d.eval p ≠ 0)) + change points.card - budget / (supportBound + 1) - d.natDegree ≤ + (G.filter fun p => d.eval p ≠ 0).card + omega + +end + +section + +open scoped BigOperators +open Matrix Finset Polynomial + +private def powerSumHankel {R : Type*} [CommRing R] {n : ℕ} + (roots : Fin n → R) : Matrix (Fin n) (Fin n) R := + Matrix.of fun i j => ∑ k : Fin n, roots k ^ (i.val + j.val) + +private theorem powerSumHankel_det_eq_vandermonde_det_sq + {R : Type*} [CommRing R] {n : ℕ} (roots : Fin n → R) : + (powerSumHankel roots).det = (Matrix.vandermonde roots).det ^ 2 := by + exact hankel_det_eq_vandermonde_det_sq roots + +private theorem powerSumHankel_det_ne_zero + {R : Type*} [CommRing R] [IsDomain R] {n : ℕ} + {roots : Fin n → R} (hroots : Function.Injective roots) : + (powerSumHankel roots).det ≠ 0 := by + exact hankel_det_ne_zero_of_injective hroots + +private def shiftedPowerSumVector + {K : Type*} [Field K] {h : ℕ} (roots : Fin h → K) : Fin h → K := + fun i => -(∑ j : Fin h, roots j ^ (i.val + h)) + +private def recoveredHankelCoefficients + {K : Type*} [Field K] {h : ℕ} (roots : Fin h → K) : Fin h → K := + (powerSumHankel roots)⁻¹.mulVec (shiftedPowerSumVector roots) + +private theorem powerSumHankel_mul_recoveredCoefficients + {K : Type*} [Field K] {h : ℕ} + (roots : Fin h → K) (hroots : Function.Injective roots) : + (powerSumHankel roots).mulVec + (recoveredHankelCoefficients roots) = + shiftedPowerSumVector roots := by + unfold recoveredHankelCoefficients + rw [Matrix.mulVec_mulVec, Matrix.mul_nonsing_inv] + · exact Matrix.one_mulVec _ + · exact isUnit_iff_ne_zero.mpr (powerSumHankel_det_ne_zero hroots) + +private theorem recoveredHankelCoefficients_unique + {K : Type*} [Field K] {h : ℕ} + (roots : Fin h → K) (hroots : Function.Injective roots) + (coefficients : Fin h → K) + (hcoefficients : (powerSumHankel roots).mulVec coefficients = + shiftedPowerSumVector roots) : + coefficients = recoveredHankelCoefficients roots := by + have hzero : + (powerSumHankel roots).mulVec + (coefficients - recoveredHankelCoefficients roots) = 0 := by + rw [Matrix.mulVec_sub, hcoefficients, + powerSumHankel_mul_recoveredCoefficients roots hroots, sub_self] + have hcoeff : coefficients - recoveredHankelCoefficients roots = 0 := + Matrix.eq_zero_of_mulVec_eq_zero + (powerSumHankel_det_ne_zero hroots) hzero + exact sub_eq_zero.mp hcoeff + +variable {K : Type*} [Field K] + +/-- GapCVP reduction support. -/ +def rootMoment {h : ℕ} (roots : Fin h → K) (j : ℕ) : K := + ∑ i : Fin h, roots i ^ j + +/-- GapCVP reduction support. -/ +def rootSupportPolynomial + {h : ℕ} (roots : Fin h → K) : K[X] := + ∏ i : Fin h, (Polynomial.X - Polynomial.C (roots i)) + +private theorem rootSupportPolynomial_monic + {h : ℕ} (roots : Fin h → K) : + (rootSupportPolynomial roots).Monic := by + classical + simpa only [rootSupportPolynomial] using Polynomial.monic_prod_X_sub_C roots (Finset.univ : + Finset (Fin h)) + +private theorem rootSupportPolynomial_natDegree + {h : ℕ} (roots : Fin h → K) : + (rootSupportPolynomial roots).natDegree = h := by + classical + simp only [rootSupportPolynomial, mem_univ, monic_X_sub_C, imp_self, implies_true, + natDegree_prod_of_monic, + natDegree_sub_C, natDegree_X, sum_const, card_univ, Fintype.card_fin, smul_eq_mul, mul_one] + +private theorem rootSupportPolynomial_eval_root + {h : ℕ} (roots : Fin h → K) (i : Fin h) : + (rootSupportPolynomial roots).eval (roots i) = 0 := by + classical + rw [rootSupportPolynomial, Polynomial.eval_prod] + exact Finset.prod_eq_zero (Finset.mem_univ i) (by simp only [eval_sub, eval_X, eval_C, sub_self]) + +private theorem rootMoment_recurrence + {h n : ℕ} (roots : Fin h → K) + (polynomial : K[X]) + (hdegree : polynomial.natDegree < n) + (hroots : ∀ i : Fin h, polynomial.eval (roots i) = 0) + (j : ℕ) : + ∑ l ∈ Finset.range n, + polynomial.coeff l * rootMoment roots (j + l) = 0 := by + classical + calc + ∑ l ∈ Finset.range n, + polynomial.coeff l * rootMoment roots (j + l) + = ∑ i : Fin h, ∑ l ∈ Finset.range n, + polynomial.coeff l * roots i ^ (j + l) := by + simp only [rootMoment, Finset.mul_sum] + rw [Finset.sum_comm] + _ = ∑ i : Fin h, roots i ^ j * polynomial.eval (roots i) := by + apply Finset.sum_congr rfl + intro i _ + rw [Polynomial.eval_eq_sum_range' hdegree] + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + rw [pow_add] + ring + _ = 0 := by simp only [hroots, mul_zero, sum_const_zero] + +private theorem rootSupportPolynomial_moment_recurrence + {h : ℕ} (roots : Fin h → K) (j : ℕ) : + ∑ l ∈ Finset.range (h + 1), + (rootSupportPolynomial roots).coeff l * rootMoment roots (j + l) = 0 := by + apply rootMoment_recurrence roots (rootSupportPolynomial roots) + · rw [rootSupportPolynomial_natDegree] + omega + · exact rootSupportPolynomial_eval_root roots + +private def rootSupportCoefficients + {h : ℕ} (roots : Fin h → K) : Fin h → K := + fun i => (rootSupportPolynomial roots).coeff i.val + +private theorem powerSumHankel_mul_rootSupportCoefficients + {h : ℕ} (roots : Fin h → K) : + (powerSumHankel roots).mulVec (rootSupportCoefficients roots) = + shiftedPowerSumVector roots := by + classical + funext i + have hrec := rootSupportPolynomial_moment_recurrence roots i.val + rw [Finset.sum_range_succ] at hrec + have hleading : (rootSupportPolynomial roots).coeff h = 1 := by + have hm := (rootSupportPolynomial_monic roots).leadingCoeff + simpa only [Polynomial.leadingCoeff, + rootSupportPolynomial_natDegree] using hm + rw [hleading, one_mul] at hrec + change + (∑ j : Fin h, + rootMoment roots (i.val + j.val) * + (rootSupportPolynomial roots).coeff j.val) = + -rootMoment roots (i.val + h) + have hsum : + (∑ j : Fin h, + rootMoment roots (i.val + j.val) * + (rootSupportPolynomial roots).coeff j.val) = + ∑ l ∈ Finset.range h, + (rootSupportPolynomial roots).coeff l * + rootMoment roots (i.val + l) := by + rw [Finset.sum_fin_eq_sum_range] + apply Finset.sum_congr rfl + intro l hl + have hlt : l < h := Finset.mem_range.mp hl + simp only [hlt, ↓reduceDIte, mul_comm] + rw [hsum] + exact eq_neg_of_add_eq_zero_left hrec + +private theorem recoveredHankelCoefficients_eq_rootSupportCoefficients + {h : ℕ} (roots : Fin h → K) + (hinj : Function.Injective roots) : + recoveredHankelCoefficients roots = rootSupportCoefficients roots := by + symm + exact recoveredHankelCoefficients_unique roots hinj + (rootSupportCoefficients roots) + (powerSumHankel_mul_rootSupportCoefficients roots) + +end + +section + +open scoped BigOperators +open Polynomial Matrix Finset + +variable {K : Type*} [Field K] + +/-- GapCVP reduction support. -/ +def genericHankelDenominator (h : ℕ) (moments : ℕ → K[X]) : K[X] := + leadingHankelDet moments h + +private def genericShiftedMoments (h : ℕ) (moments : ℕ → K[X]) : + Fin h → K[X] := + fun i => -moments (i.val + h) + +private def genericHankelNumerator (h : ℕ) (moments : ℕ → K[X]) : + Fin h → K[X] := + (polynomialHankel moments h).cramer (genericShiftedMoments h moments) + +private theorem polynomial_matrix_det_natDegree_le + {h : ℕ} (matrix : Matrix (Fin h) (Fin h) K[X]) (D : ℕ) + (hdegree : ∀ i j, (matrix i j).natDegree ≤ D) : + matrix.det.natDegree ≤ h * D := by + classical + rw [Matrix.det_apply] + apply Polynomial.natDegree_sum_le_of_forall_le + intro permutation _ + calc + (Equiv.Perm.sign permutation • + ∏ i : Fin h, matrix (permutation i) i).natDegree + ≤ (∏ i : Fin h, matrix (permutation i) i).natDegree := + Polynomial.natDegree_smul_le _ _ + _ ≤ ∑ i : Fin h, (matrix (permutation i) i).natDegree := + Polynomial.natDegree_prod_le _ _ + _ ≤ ∑ _i : Fin h, D := by + exact Finset.sum_le_sum + (fun i _ => hdegree (permutation i) i) + _ = h * D := by simp only [sum_const, card_univ, Fintype.card_fin, smul_eq_mul] + +private theorem genericHankelDenominator_natDegree_le + {h : ℕ} (moments : ℕ → K[X]) (D : ℕ) + (hdegree : ∀ j, j < 2 * h → (moments j).natDegree ≤ D) : + (genericHankelDenominator h moments).natDegree ≤ h * D := by + apply polynomial_matrix_det_natDegree_le + (polynomialHankel moments h) D + intro i j + exact hdegree (i.val + j.val) (by omega) + +private theorem genericHankelDenominator_natDegree_le_sharp + {h : ℕ} (moments : ℕ → K[X]) (d : ℕ) + (hdegree : ∀ j, j < 2 * h → (moments j).natDegree ≤ d * j) : + (genericHankelDenominator h moments).natDegree ≤ d * h * (h - 1) := by + classical + unfold genericHankelDenominator leadingHankelDet + rw [Matrix.det_apply] + apply Polynomial.natDegree_sum_le_of_forall_le + intro permutation _ + calc + (Equiv.Perm.sign permutation • + ∏ i : Fin h, polynomialHankel moments h (permutation i) i).natDegree + ≤ (∏ i : Fin h, + polynomialHankel moments h (permutation i) i).natDegree := + Polynomial.natDegree_smul_le _ _ + _ ≤ ∑ i : Fin h, + (polynomialHankel moments h (permutation i) i).natDegree := + Polynomial.natDegree_prod_le _ _ + _ ≤ ∑ i : Fin h, d * ((permutation i).val + i.val) := by + apply Finset.sum_le_sum + intro i _ + exact hdegree ((permutation i).val + i.val) (by omega) + _ = d * h * (h - 1) := by + simp_rw [mul_add] + rw [Finset.sum_add_distrib] + rw [← Finset.mul_sum, ← Finset.mul_sum] + rw [Equiv.sum_comp permutation (fun i : Fin h => i.val)] + rw [← mul_add, ← mul_two] + rw [Fin.sum_univ_eq_sum_range (fun i : ℕ => i) h] + rw [Finset.sum_range_id_mul_two] + simp only [mul_assoc] + +private theorem genericHankelNumerator_natDegree_le + {h : ℕ} (moments : ℕ → K[X]) (D : ℕ) + (hdegree : ∀ j, j < 2 * h → (moments j).natDegree ≤ D) + (i : Fin h) : + (genericHankelNumerator h moments i).natDegree ≤ h * D := by + classical + unfold genericHankelNumerator + rw [Matrix.cramer_apply] + apply polynomial_matrix_det_natDegree_le _ D + intro row column + by_cases hcolumn : column = i + · subst column + rw [Matrix.updateCol_self] + change (-moments (row.val + h)).natDegree ≤ D + rw [Polynomial.natDegree_neg] + exact hdegree (row.val + h) (by omega) + · rw [Matrix.updateCol_ne hcolumn] + exact hdegree (row.val + column.val) (by omega) + +private theorem polynomialHankel_specializes + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) : + (polynomialHankel moments h).map (Polynomial.evalRingHom point) = + powerSumHankel roots := by + ext i j + change (moments (i.val + j.val)).eval point = + ∑ r : Fin h, roots r ^ (i.val + j.val) + exact hmoments (i.val + j.val) (by omega) + +private theorem genericHankelDenominator_eval + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) : + (genericHankelDenominator h moments).eval point = + (powerSumHankel roots).det := by + calc + (genericHankelDenominator h moments).eval point + = ((polynomialHankel moments h).map + (Polynomial.evalRingHom point)).det := by + simpa only [genericHankelDenominator, leadingHankelDet, coe_evalRingHom, + RingHom.mapMatrix_apply] using + ((Polynomial.evalRingHom point).map_det (polynomialHankel moments h)) + _ = (powerSumHankel roots).det := by + rw [polynomialHankel_specializes moments point roots hmoments] + +private theorem genericHankelDenominator_ne_zero_of_good_point + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinj : Function.Injective roots) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) : + genericHankelDenominator h moments ≠ 0 := by + intro hzero + have heval := genericHankelDenominator_eval moments point roots hmoments + rw [hzero, Polynomial.eval_zero] at heval + exact powerSumHankel_det_ne_zero hinj heval.symm + +private def genericHankelCoefficient + (h : ℕ) (moments : ℕ → K[X]) (i : Fin h) : RatFunc K := + algebraMap K[X] (RatFunc K) (genericHankelNumerator h moments i) / + algebraMap K[X] (RatFunc K) (genericHankelDenominator h moments) + +/-- GapCVP reduction support. -/ +def maximalGenericHankelRank + (moments : ℕ → K[X]) (rankBound : ℕ) : ℕ := + maximalLeadingHankelRank moments rankBound + +theorem maximalGenericHankelRank_spec + (moments : ℕ → K[X]) (rankBound : ℕ) : + maximalGenericHankelRank moments rankBound ≤ rankBound ∧ + genericHankelDenominator + (maximalGenericHankelRank moments rankBound) moments ≠ 0 := by + exact maximalLeadingHankelRank_mem moments rankBound + +private theorem genericHankelDenominator_eq_zero_of_maximal_lt + (moments : ℕ → K[X]) (rankBound h : ℕ) + (hh : h ≤ rankBound) + (hmax : maximalGenericHankelRank moments rankBound < h) : + genericHankelDenominator h moments = 0 := by + exact leadingHankelDet_eq_zero_of_maximal_lt + moments rankBound h hh hmax + +private theorem card_good_nonzero_genericHankel_lower_bound + [DecidableEq K] (moments : ℕ → K[X]) (h : ℕ) + (points : Finset K) (fiberWeight : K → ℕ) + (supportBound budget : ℕ) + (hbudget : (∑ point ∈ points, fiberWeight point) ≤ budget) + (hdet : genericHankelDenominator h moments ≠ 0) : + points.card - budget / (supportBound + 1) - + (genericHankelDenominator h moments).natDegree ≤ + ((goodPoints points fiberWeight supportBound).filter fun point => + (genericHankelDenominator h moments).eval point ≠ 0).card := by + exact card_good_nonzero_hankel_lower_bound + moments h points fiberWeight supportBound budget hbudget hdet + +end + +section + +open Finset Polynomial + +/-- GapCVP reduction support. -/ +noncomputable def familySplittingPolynomial + {F ι : Type*} [Field F] [Fintype ι] + (family : ι → F[X]) : F[X] := + ∏ i : ι, family i + +private abbrev CommonSplittingField + {F ι : Type*} [Field F] [Fintype ι] + (family : ι → F[X]) := + (familySplittingPolynomial family).SplittingField + +private theorem familySplittingPolynomial_ne_zero + {F ι : Type*} [Field F] [Fintype ι] + (family : ι → F[X]) + (hnonzero : ∀ i, family i ≠ 0) : + familySplittingPolynomial family ≠ 0 := by + classical + unfold familySplittingPolynomial + exact Finset.prod_ne_zero_iff.mpr (fun i _ => hnonzero i) + +private theorem commonSplittingField_splits + {F ι : Type*} [Field F] [Fintype ι] + (family : ι → F[X]) + (hnonzero : ∀ i, family i ≠ 0) (i : ι) : + ((family i).map + (algebraMap F (CommonSplittingField family))).Splits := by + classical + have hdiv : family i ∣ familySplittingPolynomial family := by + unfold familySplittingPolynomial + exact Finset.dvd_prod_of_mem family (Finset.mem_univ i) + apply (Polynomial.SplittingField.splits + (familySplittingPolynomial family)).of_dvd + · exact Polynomial.map_ne_zero + (familySplittingPolynomial_ne_zero family hnonzero) + · exact Polynomial.map_dvd + (algebraMap F (CommonSplittingField family)) hdiv + +/-- GapCVP reduction support. -/ +noncomputable abbrev CommonAmbientSplittingField {F : Type*} [Field F] + {t : ℕ} (polynomials : Fin t → F[X]) := + CommonSplittingField polynomials + +private noncomputable abbrev CommonSeparableSplittingField {F : Type*} [Field F] + {t : ℕ} (polynomials : Fin t → F[X]) := + separableClosure F (CommonAmbientSplittingField polynomials) + +private theorem commonAmbientSplittingField_splits {F : Type*} [Field F] + {t : ℕ} (polynomials : Fin t → F[X]) + (hnonzero : ∀ i, polynomials i ≠ 0) (i : Fin t) : + ((polynomials i).map + (algebraMap F (CommonAmbientSplittingField polynomials))).Splits := + commonSplittingField_splits polynomials hnonzero i + +private theorem separable_of_mem_separable_rootSet + {F E : Type*} [Field F] [Field E] [Algebra F E] + (p : F[X]) (hseparable : p.Separable) {root : E} + (hroot : root ∈ p.rootSet E) : IsSeparable F root := by + exact hseparable.of_dvd + (minpoly.dvd F root (Polynomial.aeval_eq_zero_of_mem_rootSet hroot)) + +private theorem commonSeparableSplittingField_splits + {F : Type*} [Field F] {t : ℕ} + (polynomials : Fin t → F[X]) + (hnonzero : ∀ i, polynomials i ≠ 0) + (hseparable : ∀ i, (polynomials i).Separable) (i : Fin t) : + ((polynomials i).map + (algebraMap F (CommonSeparableSplittingField polynomials))).Splits := by + apply IntermediateField.splits_of_splits + (commonAmbientSplittingField_splits polynomials hnonzero i) + intro root hroot + exact separable_of_mem_separable_rootSet + (polynomials i) (hseparable i) hroot + +end + +section + +open scoped BigOperators +open Polynomial Matrix Finset + +variable {K : Type*} [Field K] + +private def genericMomentSupportPolynomial (h : ℕ) (moments : ℕ → K[X]) : + (RatFunc K)[X] := + Polynomial.X ^ h + + ∑ i : Fin h, + Polynomial.C (genericHankelCoefficient h moments i) * + Polynomial.X ^ i.val + +private def clearedGenericMomentSupportPolynomial (h : ℕ) (moments : ℕ → K[X]) : + (K[X])[X] := + Polynomial.C (genericHankelDenominator h moments) * Polynomial.X ^ h + + ∑ i : Fin h, + Polynomial.C (genericHankelNumerator h moments i) * + Polynomial.X ^ i.val + +private theorem genericMomentSupportPolynomial_monic + (h : ℕ) (moments : ℕ → K[X]) : + (genericMomentSupportPolynomial h moments).Monic := by + unfold genericMomentSupportPolynomial + exact Polynomial.monic_X_pow_add + (Polynomial.degree_sum_fin_lt + (fun i : Fin h => genericHankelCoefficient h moments i)) + +private def specializedGenericHankelCoefficient + (h : ℕ) (moments : ℕ → K[X]) (point : K) (i : Fin h) : K := + (genericHankelNumerator h moments i).eval point / + (genericHankelDenominator h moments).eval point + +private def specializedGenericMomentSupportPolynomial + (h : ℕ) (moments : ℕ → K[X]) (point : K) : K[X] := + Polynomial.X ^ h + + ∑ i : Fin h, + Polynomial.C + (specializedGenericHankelCoefficient h moments point i) * + Polynomial.X ^ i.val + +private theorem genericHankelNumerator_eval_eq_cramer + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) + (i : Fin h) : + (genericHankelNumerator h moments i).eval point = + (powerSumHankel roots).cramer + (shiftedPowerSumVector roots) i := by + calc + (genericHankelNumerator h moments i).eval point = + (((polynomialHankel moments h).updateCol i + (genericShiftedMoments h moments)).map + (Polynomial.evalRingHom point)).det := by + simpa only [genericHankelNumerator, cramer_apply, coe_evalRingHom, RingHom.mapMatrix_apply] + using + (Polynomial.evalRingHom point).map_det ((polynomialHankel moments h).updateCol i + (genericShiftedMoments h moments)) + _ = (powerSumHankel roots).cramer + (shiftedPowerSumVector roots) i := by + rw [Matrix.map_updateCol] + rw [polynomialHankel_specializes moments point roots hmoments] + have hshift : + (Polynomial.evalRingHom point) ∘ + genericShiftedMoments h moments = + shiftedPowerSumVector roots := by + funext row + change (-(moments (row.val + h))).eval point = + -(rootMoment roots (row.val + h)) + simpa only [eval_neg, neg_inj] using congrArg Neg.neg (hmoments (row.val + h) (by omega)) + rw [hshift, Matrix.cramer_apply] + +private theorem genericHankelNumerator_eval_eq_det_mul_rootSupportCoefficient + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinjective : Function.Injective roots) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) + (i : Fin h) : + (genericHankelNumerator h moments i).eval point = + (genericHankelDenominator h moments).eval point * + rootSupportCoefficients roots i := by + have hdet : (powerSumHankel roots).det ≠ 0 := + powerSumHankel_det_ne_zero hinjective + calc + (genericHankelNumerator h moments i).eval point = + (powerSumHankel roots).cramer + (shiftedPowerSumVector roots) i := + genericHankelNumerator_eval_eq_cramer + moments point roots hmoments i + _ = (powerSumHankel roots).det * + recoveredHankelCoefficients roots i := by + symm + simpa only [recoveredHankelCoefficients, Pi.smul_apply, smul_eq_mul] using + congrFun + (Matrix.det_smul_inv_mulVec_eq_cramer (powerSumHankel roots) (shiftedPowerSumVector + roots) + (isUnit_iff_ne_zero.mpr hdet)) + i + _ = (powerSumHankel roots).det * + rootSupportCoefficients roots i := by + rw [recoveredHankelCoefficients_eq_rootSupportCoefficients + roots hinjective] + _ = (genericHankelDenominator h moments).eval point * + rootSupportCoefficients roots i := by + rw [genericHankelDenominator_eval moments point roots hmoments] + +private theorem genericHankelDenominator_eval_ne_zero_of_distinct_fiber + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinjective : Function.Injective roots) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) : + (genericHankelDenominator h moments).eval point ≠ 0 := by + rw [genericHankelDenominator_eval moments point roots hmoments] + exact powerSumHankel_det_ne_zero hinjective + +private theorem specializedGenericHankelCoefficient_eq_rootSupportCoefficient + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinjective : Function.Injective roots) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) + (i : Fin h) : + specializedGenericHankelCoefficient h moments point i = + rootSupportCoefficients roots i := by + unfold specializedGenericHankelCoefficient + rw [genericHankelNumerator_eval_eq_det_mul_rootSupportCoefficient + moments point roots hinjective hmoments i] + exact mul_div_cancel_left₀ + (rootSupportCoefficients roots i) + (genericHankelDenominator_eval_ne_zero_of_distinct_fiber + moments point roots hinjective hmoments) + +private theorem specializedGenericMomentSupportPolynomial_eq_rootSupportPolynomial + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinjective : Function.Injective roots) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) : + specializedGenericMomentSupportPolynomial h moments point = + rootSupportPolynomial roots := by + unfold specializedGenericMomentSupportPolynomial + simp_rw [specializedGenericHankelCoefficient_eq_rootSupportCoefficient + moments point roots hinjective hmoments] + have hsum : + (∑ i : Fin h, + Polynomial.C (rootSupportCoefficients roots i) * + Polynomial.X ^ i.val) = + ∑ i ∈ Finset.range h, + Polynomial.C ((rootSupportPolynomial roots).coeff i) * + Polynomial.X ^ i := by + rw [Finset.sum_fin_eq_sum_range] + apply Finset.sum_congr rfl + intro i hi + simp only [Finset.mem_range.mp hi, ↓reduceDIte, rootSupportCoefficients] + rw [hsum] + simpa only [rootSupportPolynomial_natDegree] using (rootSupportPolynomial_monic + roots).as_sum.symm + +private theorem separable_ratFunc_map_of_separable_specialization + (polynomial : (K[X])[X]) (point : K) + (hleading : polynomial.leadingCoeff.eval point ≠ 0) + (hspecial : + (polynomial.map (Polynomial.evalRingHom point)).Separable) : + (polynomial.map (algebraMap K[X] (RatFunc K))).Separable := by + classical + let evaluation : K[X] →+* K := Polynomial.evalRingHom point + let embedding : K[X] →+* RatFunc K := algebraMap K[X] (RatFunc K) + let fiber : K[X] := polynomial.map evaluation + let generic : (RatFunc K)[X] := polynomial.map embedding + have hinjective : Function.Injective embedding := by + exact FaithfulSMul.algebraMap_injective K[X] (RatFunc K) + have hfiberseparable : fiber.Separable := by + simpa only using hspecial + have hfiberdegree : fiber.natDegree = polynomial.natDegree := by + dsimp [fiber] + apply Polynomial.natDegree_map_of_leadingCoeff_ne_zero evaluation + exact hleading + have hderivativedegree : + fiber.derivative.natDegree ≤ polynomial.derivative.natDegree := by + dsimp [fiber] + rw [Polynomial.derivative_map] + exact Polynomial.natDegree_map_le + have hfiberleading : fiber.coeff polynomial.natDegree ≠ 0 := by + intro hzero + apply hleading + change evaluation polynomial.leadingCoeff = 0 + have hcoefficient : + fiber.coeff polynomial.natDegree = + evaluation polynomial.leadingCoeff := by + change (polynomial.map evaluation).coeff polynomial.natDegree = + evaluation (polynomial.coeff polynomial.natDegree) + exact Polynomial.coeff_map evaluation polynomial.natDegree + rw [← hcoefficient, hzero] + have hfiberresultant : + fiber.resultant fiber.derivative ≠ 0 := + Polynomial.resultant_ne_zero fiber fiber.derivative hfiberseparable + have hfiberfixed : + fiber.resultant fiber.derivative + polynomial.natDegree polynomial.derivative.natDegree ≠ 0 := by + have hfactor := Polynomial.resultant_add_right_deg + fiber fiber.derivative polynomial.natDegree fiber.derivative.natDegree + (polynomial.derivative.natDegree - fiber.derivative.natDegree) + (le_refl fiber.derivative.natDegree) + rw [Nat.add_sub_of_le hderivativedegree] at hfactor + rw [hfactor] + exact mul_ne_zero + (pow_ne_zero _ hfiberleading) + (by simpa only [hfiberdegree] using hfiberresultant) + have hpolynomialresultant : + polynomial.resultant polynomial.derivative + polynomial.natDegree polynomial.derivative.natDegree ≠ 0 := by + intro hzero + apply hfiberfixed + calc + fiber.resultant fiber.derivative + polynomial.natDegree polynomial.derivative.natDegree = + evaluation + (polynomial.resultant polynomial.derivative + polynomial.natDegree polynomial.derivative.natDegree) := by + change + (polynomial.map evaluation).resultant + (polynomial.map evaluation).derivative + polynomial.natDegree polynomial.derivative.natDegree = + evaluation + (polynomial.resultant polynomial.derivative + polynomial.natDegree polynomial.derivative.natDegree) + rw [Polynomial.derivative_map] + exact Polynomial.resultant_map_map polynomial polynomial.derivative + polynomial.natDegree polynomial.derivative.natDegree evaluation + _ = 0 := by simp only [hzero, map_zero] + have hgenericfixed : + generic.resultant generic.derivative + polynomial.natDegree polynomial.derivative.natDegree ≠ 0 := by + intro hzero + apply hpolynomialresultant + apply hinjective + have hmap : + embedding + (polynomial.resultant polynomial.derivative + polynomial.natDegree polynomial.derivative.natDegree) = 0 := by + calc + embedding + (polynomial.resultant polynomial.derivative + polynomial.natDegree polynomial.derivative.natDegree) = + generic.resultant generic.derivative + polynomial.natDegree polynomial.derivative.natDegree := by + symm + change + (polynomial.map embedding).resultant + (polynomial.map embedding).derivative + polynomial.natDegree polynomial.derivative.natDegree = + embedding + (polynomial.resultant polynomial.derivative + polynomial.natDegree polynomial.derivative.natDegree) + rw [Polynomial.derivative_map] + exact Polynomial.resultant_map_map polynomial polynomial.derivative + polynomial.natDegree polynomial.derivative.natDegree embedding + _ = 0 := hzero + simpa only [map_zero] using hmap + have hgenericdegree : generic.natDegree = polynomial.natDegree := by + exact Polynomial.natDegree_map_eq_of_injective hinjective polynomial + have hgenericderivativedegree : + generic.derivative.natDegree = polynomial.derivative.natDegree := by + dsimp [generic] + rw [Polynomial.derivative_map] + exact Polynomial.natDegree_map_eq_of_injective hinjective + polynomial.derivative + have hgenericresultant : generic.resultant generic.derivative ≠ 0 := by + simpa only [hgenericdegree, hgenericderivativedegree] using hgenericfixed + have hgenericnonzero : generic ≠ 0 := by + intro hzero + have hpolynomialzero : polynomial = 0 := + (Polynomial.map_eq_zero_iff hinjective).mp hzero + apply hleading + simp only [hpolynomialzero, leadingCoeff_zero, eval_zero] + have hgenericseparable : generic.Separable := by + apply (Polynomial.separable_def generic).2 + by_contra hnot + apply hgenericresultant + exact Polynomial.resultant_eq_zero_iff.mpr + ⟨Or.inl hgenericnonzero, hnot⟩ + exact hgenericseparable + +private theorem clearedGenericMomentSupportPolynomial_natDegree_le + (h : ℕ) (moments : ℕ → K[X]) : + (clearedGenericMomentSupportPolynomial h moments).natDegree ≤ h := by + classical + unfold clearedGenericMomentSupportPolynomial + apply Polynomial.natDegree_add_le_of_degree_le + · calc + (Polynomial.C (genericHankelDenominator h moments) * + (Polynomial.X : (K[X])[X]) ^ h).natDegree ≤ + ((Polynomial.X : (K[X])[X]) ^ h).natDegree := + Polynomial.natDegree_C_mul_le _ _ + _ = h := Polynomial.natDegree_X_pow h + · apply Polynomial.natDegree_sum_le_of_forall_le + intro i _ + calc + (Polynomial.C (genericHankelNumerator h moments i) * + (Polynomial.X : (K[X])[X]) ^ i.val).natDegree ≤ + ((Polynomial.X : (K[X])[X]) ^ i.val).natDegree := + Polynomial.natDegree_C_mul_le _ _ + _ = i.val := Polynomial.natDegree_X_pow i.val + _ ≤ h := Nat.le_of_lt i.isLt + +private theorem clearedGenericMomentSupportPolynomial_coeff_rank + (h : ℕ) (moments : ℕ → K[X]) : + (clearedGenericMomentSupportPolynomial h moments).coeff h = + genericHankelDenominator h moments := by + classical + unfold clearedGenericMomentSupportPolynomial + rw [Polynomial.coeff_add, Polynomial.coeff_C_mul, + Polynomial.coeff_X_pow] + simp only [ite_true, mul_one] + have hsum : + (∑ i : Fin h, + Polynomial.C (genericHankelNumerator h moments i) * + (Polynomial.X : (K[X])[X]) ^ i.val).coeff h = 0 := by + rw [Polynomial.finsetSum_coeff] + apply Finset.sum_eq_zero + intro i _ + rw [Polynomial.coeff_C_mul, Polynomial.coeff_X_pow, + ite_eq_right (Nat.ne_of_gt i.isLt), mul_zero] + rw [hsum, add_zero] + +private theorem clearedGenericMomentSupportPolynomial_leadingCoeff + (h : ℕ) (moments : ℕ → K[X]) + (hdenominator : genericHankelDenominator h moments ≠ 0) : + (clearedGenericMomentSupportPolynomial h moments).leadingCoeff = + genericHankelDenominator h moments := by + have hcoefficient := clearedGenericMomentSupportPolynomial_coeff_rank + h moments + have hdegree : + (clearedGenericMomentSupportPolynomial h moments).natDegree = h := + Polynomial.natDegree_eq_of_le_of_coeff_ne_zero + (clearedGenericMomentSupportPolynomial_natDegree_le h moments) + (by rw [hcoefficient]; exact hdenominator) + simpa only [Polynomial.leadingCoeff, hdegree] using hcoefficient + +private theorem clearedGenericMomentSupportPolynomial_specializes + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinjective : Function.Injective roots) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) : + (clearedGenericMomentSupportPolynomial h moments).map + (Polynomial.evalRingHom point) = + Polynomial.C ((genericHankelDenominator h moments).eval point) * + rootSupportPolynomial roots := by + classical + have hrootexpansion : + rootSupportPolynomial roots = + (Polynomial.X : K[X]) ^ h + + ∑ i : Fin h, + Polynomial.C (rootSupportCoefficients roots i) * + Polynomial.X ^ i.val := by + calc + rootSupportPolynomial roots = + specializedGenericMomentSupportPolynomial h moments point := + (specializedGenericMomentSupportPolynomial_eq_rootSupportPolynomial + moments point roots hinjective hmoments).symm + _ = (Polynomial.X : K[X]) ^ h + + ∑ i : Fin h, + Polynomial.C (rootSupportCoefficients roots i) * + Polynomial.X ^ i.val := by + unfold specializedGenericMomentSupportPolynomial + simp_rw [specializedGenericHankelCoefficient_eq_rootSupportCoefficient + moments point roots hinjective hmoments] + rw [hrootexpansion] + unfold clearedGenericMomentSupportPolynomial + simp only [Polynomial.map_add, Polynomial.map_mul, + Polynomial.map_C, Polynomial.map_pow, Polynomial.map_X, + Polynomial.map_sum] + rw [mul_add, Finset.mul_sum] + refine congrArg₂ (· + ·) rfl ?_ + apply Finset.sum_congr rfl + intro i _ + change + Polynomial.C ((genericHankelNumerator h moments i).eval point) * + (Polynomial.X : K[X]) ^ i.val = + Polynomial.C ((genericHankelDenominator h moments).eval point) * + (Polynomial.C (rootSupportCoefficients roots i) * + Polynomial.X ^ i.val) + rw [genericHankelNumerator_eval_eq_det_mul_rootSupportCoefficient + moments point roots hinjective hmoments i] + rw [Polynomial.C_mul] + ring + +private theorem clearedGenericMomentSupportPolynomial_map_ratFunc + (h : ℕ) (moments : ℕ → K[X]) + (hdenominator : genericHankelDenominator h moments ≠ 0) : + (clearedGenericMomentSupportPolynomial h moments).map + (algebraMap K[X] (RatFunc K)) = + Polynomial.C + (algebraMap K[X] (RatFunc K) + (genericHankelDenominator h moments)) * + genericMomentSupportPolynomial h moments := by + classical + have hdenominator' : + algebraMap K[X] (RatFunc K) + (genericHankelDenominator h moments) ≠ 0 := by + intro hzero + apply hdenominator + apply FaithfulSMul.algebraMap_injective K[X] (RatFunc K) + simpa only [map_zero, FaithfulSMul.algebraMap_eq_zero_iff] using hzero + unfold clearedGenericMomentSupportPolynomial + genericMomentSupportPolynomial + simp only [Polynomial.map_add, Polynomial.map_mul, + Polynomial.map_C, Polynomial.map_pow, Polynomial.map_X, + Polynomial.map_sum] + rw [mul_add, Finset.mul_sum] + refine congrArg₂ (· + ·) rfl ?_ + apply Finset.sum_congr rfl + intro i _ + have hcoefficient : + algebraMap K[X] (RatFunc K) + (genericHankelDenominator h moments) * + genericHankelCoefficient h moments i = + algebraMap K[X] (RatFunc K) + (genericHankelNumerator h moments i) := by + unfold genericHankelCoefficient + field_simp [hdenominator'] + rw [← hcoefficient, Polynomial.C_mul] + ring + +private theorem genericMomentSupportPolynomial_separable + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinjective : Function.Injective roots) + (hmoments : ∀ j : ℕ, j < 2 * h → + (moments j).eval point = rootMoment roots j) : + (genericMomentSupportPolynomial h moments).Separable := by + have hnonzero : genericHankelDenominator h moments ≠ 0 := + genericHankelDenominator_ne_zero_of_good_point + moments point roots hinjective hmoments + have hfibernonzero : + (genericHankelDenominator h moments).eval point ≠ 0 := + genericHankelDenominator_eval_ne_zero_of_distinct_fiber + moments point roots hinjective hmoments + have hspecial : + ((clearedGenericMomentSupportPolynomial h moments).map + (Polynomial.evalRingHom point)).Separable := by + rw [clearedGenericMomentSupportPolynomial_specializes + moments point roots hinjective hmoments] + rw [mul_comm] + apply (Polynomial.separable_prod_X_sub_C_iff.mpr hinjective).mul_unit + exact Polynomial.isUnit_C.mpr + (isUnit_iff_ne_zero.mpr hfibernonzero) + have hgeneric := separable_ratFunc_map_of_separable_specialization + (clearedGenericMomentSupportPolynomial h moments) point + (by rw [clearedGenericMomentSupportPolynomial_leadingCoeff + h moments hnonzero]; exact hfibernonzero) + hspecial + rw [clearedGenericMomentSupportPolynomial_map_ratFunc + h moments hnonzero] at hgeneric + exact hgeneric.of_mul_right + +private def finiteSupportRoots (support : Finset K) : Fin support.card → K := + fun i => ((Finset.equivFin support).symm i : K) + +omit [Field K] in +private theorem finiteSupportRoots_injective (support : Finset K) : + Function.Injective (finiteSupportRoots support) := by + intro i j h + exact (Finset.equivFin support).symm.injective (Subtype.ext h) + +private theorem rootMoment_finiteSupportRoots (support : Finset K) (j : ℕ) : + rootMoment (finiteSupportRoots support) j = + supportMoment support j := by + classical + unfold rootMoment finiteSupportRoots supportMoment + calc + (∑ i : Fin support.card, + ((Finset.equivFin support).symm i : K) ^ j) = + ∑ a : support, (a : K) ^ j := + Equiv.sum_comp (Finset.equivFin support).symm + (fun a : support => (a : K) ^ j) + _ = ∑ a ∈ support, a ^ j := + (Finset.sum_subtype support (fun _ => Iff.rfl) + (fun a : K => a ^ j)).symm + +private def fiberPowerSumHankel {supportSize : ℕ} + (rank : ℕ) (roots : Fin supportSize → K) : + Matrix (Fin rank) (Fin rank) K := + fun i j => rootMoment roots (i.val + j.val) + +private theorem polynomialHankel_specializes_fiberPowerSumHankel + {rank supportSize : ℕ} + (moments : ℕ → K[X]) (point : K) + (roots : Fin supportSize → K) + (hmoments : ∀ j : ℕ, j < 2 * rank → + (moments j).eval point = rootMoment roots j) : + (polynomialHankel moments rank).map + (Polynomial.evalRingHom point) = + fiberPowerSumHankel rank roots := by + ext i j + exact hmoments (i.val + j.val) (by omega) + +private theorem fiberPowerSumHankel_det_eq_zero_of_support_lt + {rank supportSize : ℕ} + (roots : Fin supportSize → K) (hsize : supportSize < rank) : + (fiberPowerSumHankel rank roots).det = 0 := by + classical + by_contra hdet + let coefficients : Fin rank → K := + fun i => (rootSupportPolynomial roots).coeff i.val + have hkernel : + (fiberPowerSumHankel rank roots).mulVec coefficients = 0 := by + funext row + have hrec := rootMoment_recurrence roots + (rootSupportPolynomial roots) + (by simpa only [rootSupportPolynomial_natDegree] using hsize) + (rootSupportPolynomial_eval_root roots) row.val + change + (∑ i : Fin rank, + rootMoment roots (row.val + i.val) * + (rootSupportPolynomial roots).coeff i.val) = 0 + rw [Finset.sum_fin_eq_sum_range] + calc + (∑ i ∈ Finset.range rank, + if hi : i < rank then + rootMoment roots (row.val + i) * + (rootSupportPolynomial roots).coeff i + else 0) = + ∑ i ∈ Finset.range rank, + (rootSupportPolynomial roots).coeff i * + rootMoment roots (row.val + i) := by + apply Finset.sum_congr rfl + intro i hi + simp only [Finset.mem_range.mp hi, ↓reduceDIte, mul_comm] + _ = 0 := hrec + have hcoefficients : coefficients = 0 := + Matrix.eq_zero_of_mulVec_eq_zero hdet hkernel + have hleading : (rootSupportPolynomial roots).coeff supportSize = 1 := by + have hm := (rootSupportPolynomial_monic roots).leadingCoeff + simpa only [Polynomial.leadingCoeff, + rootSupportPolynomial_natDegree] using hm + have hzero := congrFun hcoefficients ⟨supportSize, hsize⟩ + change (rootSupportPolynomial roots).coeff supportSize = 0 at hzero + exact one_ne_zero (hleading.symm.trans hzero) + +private theorem genericHankelDenominator_eval_eq_zero_of_smaller_fiber + {rank supportSize : ℕ} + (moments : ℕ → K[X]) (point : K) + (roots : Fin supportSize → K) + (hsize : supportSize < rank) + (hmoments : ∀ j : ℕ, j < 2 * rank → + (moments j).eval point = rootMoment roots j) : + (genericHankelDenominator rank moments).eval point = 0 := by + calc + (genericHankelDenominator rank moments).eval point = + ((polynomialHankel moments rank).map + (Polynomial.evalRingHom point)).det := by + simpa only [genericHankelDenominator, leadingHankelDet, coe_evalRingHom, + RingHom.mapMatrix_apply] using + (Polynomial.evalRingHom point).map_det (polynomialHankel moments rank) + _ = (fiberPowerSumHankel rank roots).det := by + rw [polynomialHankel_specializes_fiberPowerSumHankel + moments point roots hmoments] + _ = 0 := fiberPowerSumHankel_det_eq_zero_of_support_lt roots hsize + +private theorem goodFiber_card_eq_maximalGenericHankelRank + (moments : ℕ → K[X]) (supports : K → Finset K) + (rankBound momentBudget : ℕ) (point : K) + (hgood : (supports point).card ≤ rankBound) + (hbudget : 2 * rankBound ≤ momentBudget + 1) + (hmoments : ∀ j : ℕ, j ≤ momentBudget → + (moments j).eval point = supportMoment (supports point) j) + (hnonsingular : + (genericHankelDenominator + (maximalGenericHankelRank moments rankBound) moments).eval point ≠ 0) : + (supports point).card = maximalGenericHankelRank moments rankBound := by + have hmax := maximalGenericHankelRank_spec moments rankBound + apply Nat.le_antisymm + · by_contra hnot + have hlarger : + maximalGenericHankelRank moments rankBound < (supports point).card := + Nat.lt_of_not_ge hnot + have hzero := genericHankelDenominator_eq_zero_of_maximal_lt + moments rankBound (supports point).card hgood hlarger + have hnonzero := genericHankelDenominator_ne_zero_of_good_point + moments point (finiteSupportRoots (supports point)) + (finiteSupportRoots_injective (supports point)) + (fun j hj => by + rw [rootMoment_finiteSupportRoots] + apply hmoments j + omega) + exact hnonzero hzero + · by_contra hnot + have hsmaller : + (supports point).card < maximalGenericHankelRank moments rankBound := + Nat.lt_of_not_ge hnot + apply hnonsingular + exact genericHankelDenominator_eval_eq_zero_of_smaller_fiber + moments point (finiteSupportRoots (supports point)) hsmaller + (fun j hj => by + rw [rootMoment_finiteSupportRoots] + apply hmoments j + omega) + +private def maximalGenericGoodFiberPoints + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (rankBound : ℕ) : Finset K := by + classical + exact (goodPoints points (fun point => (supports point).card) rankBound).filter + fun point => + (genericHankelDenominator + (maximalGenericHankelRank moments rankBound) moments).eval point ≠ 0 + +private theorem mem_maximalGenericGoodFiberPoints + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (rankBound : ℕ) (point : K) : + point ∈ maximalGenericGoodFiberPoints points supports moments rankBound ↔ + point ∈ points ∧ + (supports point).card ≤ rankBound ∧ + (genericHankelDenominator + (maximalGenericHankelRank moments rankBound) moments).eval point ≠ 0 := by + classical + simp only [maximalGenericGoodFiberPoints, ne_eq, goodPoints, mem_filter, and_assoc] + +private theorem maximalGenericGoodFiberPoints_card_lower_bound + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (rankBound supportBudget : ℕ) + (hbudget : (∑ point ∈ points, (supports point).card) ≤ supportBudget) : + points.card - supportBudget / (rankBound + 1) - + (genericHankelDenominator + (maximalGenericHankelRank moments rankBound) moments).natDegree ≤ + (maximalGenericGoodFiberPoints points supports moments rankBound).card := by + classical + simpa only [maximalGenericGoodFiberPoints, ne_eq, tsub_le_iff_right] using + card_good_nonzero_genericHankel_lower_bound moments (maximalGenericHankelRank moments + rankBound) points + (fun point => (supports point).card) rankBound supportBudget hbudget + (maximalGenericHankelRank_spec moments rankBound).2 + +private theorem maximalGenericGoodFiberPoints_card_eq_rank + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (rankBound momentBudget : ℕ) + (hbudget : 2 * rankBound ≤ momentBudget + 1) + (hmoments : ∀ point ∈ points, ∀ j : ℕ, j ≤ momentBudget → + (moments j).eval point = supportMoment (supports point) j) + (point : K) + (hpoint : point ∈ + maximalGenericGoodFiberPoints points supports moments rankBound) : + (supports point).card = maximalGenericHankelRank moments rankBound := by + have hp := (mem_maximalGenericGoodFiberPoints + points supports moments rankBound point).mp hpoint + exact goodFiber_card_eq_maximalGenericHankelRank + moments supports rankBound momentBudget point hp.2.1 hbudget + (hmoments point hp.1) hp.2.2 + +private theorem genericHankelDenominator_ratFunc_ne_zero_of_polynomial + {h : ℕ} (moments : ℕ → K[X]) + (hdenominator : genericHankelDenominator h moments ≠ 0) : + algebraMap K[X] (RatFunc K) + (genericHankelDenominator h moments) ≠ 0 := by + intro hzero + apply hdenominator + apply FaithfulSMul.algebraMap_injective K[X] (RatFunc K) + simpa only [map_zero, FaithfulSMul.algebraMap_eq_zero_iff] using hzero + +private def universalElementaryPowerSum + (R : Type*) [CommRing R] (h j : ℕ) : + MvPolynomial (Fin h) R := + (MvPolynomial.esymmAlgEquiv (Fin h) R (Fintype.card_fin h)).symm + ⟨MvPolynomial.psum (Fin h) R j, + MvPolynomial.psum_isSymmetric (Fin h) R j⟩ + +private theorem universalElementaryPowerSum_esymm_identity + (R : Type*) [CommRing R] (h j : ℕ) : + MvPolynomial.aeval + (fun i : Fin h => MvPolynomial.esymm (Fin h) R (i.val + 1)) + (universalElementaryPowerSum R h j) = + MvPolynomial.psum (Fin h) R j := by + have hidentity := congrArg Subtype.val + ((MvPolynomial.esymmAlgEquiv + (Fin h) R (Fintype.card_fin h)).apply_symm_apply + ⟨MvPolynomial.psum (Fin h) R j, + MvPolynomial.psum_isSymmetric (Fin h) R j⟩) + simpa only [universalElementaryPowerSum, + MvPolynomial.esymmAlgEquiv_apply, + MvPolynomial.esymmAlgHom_apply] using hidentity + +private theorem universalElementaryPowerSum_evaluates_to_rootMoment + {R S : Type*} [CommRing R] [Field S] [Algebra R S] + {h : ℕ} (roots : Fin h → S) (j : ℕ) : + MvPolynomial.aeval + (fun i : Fin h => + (((Finset.univ : Finset (Fin h)).val.map roots).esymm + (i.val + 1))) + (universalElementaryPowerSum R h j) = + rootMoment roots j := by + have hidentity := congrArg + (fun p : MvPolynomial (Fin h) R => MvPolynomial.aeval roots p) + (universalElementaryPowerSum_esymm_identity R h j) + rw [MvPolynomial.comp_aeval_apply] at hidentity + simp_rw [MvPolynomial.aeval_esymm_eq_multiset_esymm] at hidentity + simpa only [Fin.univ_val_map, rootMoment, MvPolynomial.psum, map_sum, map_pow, + MvPolynomial.aeval_X] using + hidentity + +private def supportElementaryCoefficients + {R : Type*} [CommRing R] {h : ℕ} + (coefficients : Fin h → R) (i : Fin h) : R := + (-1 : R) ^ (i.val + 1) * coefficients i.rev + +private theorem supportElementaryCoefficients_rootSupport + {S : Type*} [Field S] {h : ℕ} + (roots : Fin h → S) (i : Fin h) : + supportElementaryCoefficients (rootSupportCoefficients roots) i = + (((Finset.univ : Finset (Fin h)).val.map roots).esymm + (i.val + 1)) := by + classical + have hindex : h - i.rev.val = i.val + 1 := by + rw [Fin.val_rev] + omega + have hcard : + ((Finset.univ : Finset (Fin h)).val.map roots).card = h := by + simp only [Fin.univ_val_map, Multiset.coe_card, List.length_ofFn] + have hvieta := Multiset.prod_X_sub_C_coeff + (((Finset.univ : Finset (Fin h)).val.map roots)) + (k := i.rev.val) + (by omega) + rw [hcard, hindex] at hvieta + have hproduct : + (Multiset.map (fun root : S => + (Polynomial.X : S[X]) - Polynomial.C root) + (((Finset.univ : Finset (Fin h)).val.map roots))).prod = + rootSupportPolynomial roots := by + simp only [Multiset.map_map] + rfl + have hcoefficient : + rootSupportCoefficients roots i.rev = + (-1 : S) ^ (i.val + 1) * + (((Finset.univ : Finset (Fin h)).val.map roots).esymm + (i.val + 1)) := by + change (rootSupportPolynomial roots).coeff i.rev.val = + (-1 : S) ^ (i.val + 1) * + (((Finset.univ : Finset (Fin h)).val.map roots).esymm + (i.val + 1)) + rw [← hproduct] + exact hvieta + unfold supportElementaryCoefficients + rw [hcoefficient, ← mul_assoc, ← pow_add] + simp only [← two_mul, pow_mul, even_two, Even.neg_pow, one_pow, Fin.univ_val_map, one_mul] + +private theorem universalElementaryPowerSum_evaluates_supportCoefficients + {R S : Type*} [CommRing R] [Field S] [Algebra R S] + {h : ℕ} (roots : Fin h → S) (j : ℕ) : + MvPolynomial.aeval + (supportElementaryCoefficients (rootSupportCoefficients roots)) + (universalElementaryPowerSum R h j) = + rootMoment roots j := by + have hvariables : + supportElementaryCoefficients (rootSupportCoefficients roots) = + (fun i : Fin h => + (((Finset.univ : Finset (Fin h)).val.map roots).esymm + (i.val + 1))) := by + funext i + exact supportElementaryCoefficients_rootSupport roots i + rw [hvariables] + exact universalElementaryPowerSum_evaluates_to_rootMoment roots j + +private def clearedMvPolynomialEvaluation {h : ℕ} + (polynomial : MvPolynomial (Fin h) K) + (denominator : K[X]) (numerators : Fin h → K[X]) : K[X] := + ∑ exponent ∈ polynomial.support, + Polynomial.C (polynomial.coeff exponent) * + denominator ^ (polynomial.totalDegree - + exponent.sum (fun _ power => power)) * + ∏ i ∈ exponent.support, numerators i ^ exponent i + +private theorem clearedMvPolynomialEvaluation_map + {h : ℕ} {E : Type*} [Field E] + (polynomial : MvPolynomial (Fin h) K) + (denominator : K[X]) (numerators : Fin h → K[X]) + (map : K[X] →+* E) + (hnonzero : map denominator ≠ 0) : + map (clearedMvPolynomialEvaluation polynomial denominator numerators) = + map denominator ^ polynomial.totalDegree * + MvPolynomial.eval₂ (map.comp Polynomial.C) + (fun i => map (numerators i) / map denominator) polynomial := by + classical + unfold clearedMvPolynomialEvaluation + rw [MvPolynomial.eval₂_eq] + simp only [map_sum, map_mul, map_pow, map_prod] + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro exponent hexponent + have hdegree : + exponent.sum (fun _ power => power) ≤ polynomial.totalDegree := + MvPolynomial.le_totalDegree hexponent + have hdenominatorProduct : + (∏ i ∈ exponent.support, + map denominator ^ exponent i) = + map denominator ^ exponent.sum (fun _ power => power) := by + simpa only [Finsupp.sum] using + Finset.prod_pow_eq_pow_sum exponent.support (fun i => exponent i) (map denominator) + simp only [RingHom.coe_comp, Function.comp_apply] + simp_rw [div_pow] + rw [Finset.prod_div_distrib, hdenominatorProduct] + field_simp [hnonzero] + have hpowers := pow_sub_mul_pow (map denominator) hdegree + linear_combination map (Polynomial.C (polynomial.coeff exponent)) * + (∏ i ∈ exponent.support, map (numerators i) ^ exponent i) * hpowers + +private theorem genericMomentSupportPolynomial_coeff + {h : ℕ} (moments : ℕ → K[X]) (i : Fin h) : + (genericMomentSupportPolynomial h moments).coeff i.val = + genericHankelCoefficient h moments i := by + classical + unfold genericMomentSupportPolynomial + rw [Polynomial.coeff_add, Polynomial.coeff_X_pow, + ite_eq_right (Nat.ne_of_lt i.isLt), zero_add, + Polynomial.finsetSum_coeff] + rw [Finset.sum_eq_single i] + · rw [Polynomial.coeff_C_mul, Polynomial.coeff_X_pow, + ite_eq_left rfl, mul_one] + · intro other _ hother + rw [Polynomial.coeff_C_mul, Polynomial.coeff_X_pow] + have hne : i.val ≠ other.val := by + intro heq + exact hother (Fin.ext heq.symm) + rw [ite_eq_right hne, mul_zero] + · simp only [mem_univ, not_true_eq_false, coeff_C_mul, coeff_X_pow, ↓reduceIte, mul_one, + IsEmpty.forall_iff] + +private def genericSupportElementaryNumerator + (h : ℕ) (moments : ℕ → K[X]) (i : Fin h) : K[X] := + (-1 : K[X]) ^ (i.val + 1) * + genericHankelNumerator h moments i.rev + +private def genericRootPowerSum + (h : ℕ) (moments : ℕ → K[X]) (j : ℕ) : RatFunc K := + MvPolynomial.aeval + (supportElementaryCoefficients + (genericHankelCoefficient h moments)) + (universalElementaryPowerSum K h j) + +private def clearedGenericRootPowerSum + (h : ℕ) (moments : ℕ → K[X]) (j : ℕ) : K[X] := + clearedMvPolynomialEvaluation + (universalElementaryPowerSum K h j) + (genericHankelDenominator h moments) + (genericSupportElementaryNumerator h moments) + +private def genericRootMomentDifferencePolynomial + (h : ℕ) (moments : ℕ → K[X]) (j : ℕ) : K[X] := + genericHankelDenominator h moments ^ + (universalElementaryPowerSum K h j).totalDegree * + moments j - + clearedGenericRootPowerSum h moments j + +private theorem clearedGenericRootPowerSum_map_ratFunc + (h : ℕ) (moments : ℕ → K[X]) (j : ℕ) + (hdenominator : genericHankelDenominator h moments ≠ 0) : + algebraMap K[X] (RatFunc K) + (clearedGenericRootPowerSum h moments j) = + algebraMap K[X] (RatFunc K) + (genericHankelDenominator h moments) ^ + (universalElementaryPowerSum K h j).totalDegree * + genericRootPowerSum h moments j := by + have hnonzero := + genericHankelDenominator_ratFunc_ne_zero_of_polynomial + moments hdenominator + have hscalar : + (algebraMap K[X] (RatFunc K)).comp + (Polynomial.C : K →+* K[X]) = + algebraMap K (RatFunc K) := by + symm + simpa only [Polynomial.algebraMap_eq] using + IsScalarTower.algebraMap_eq K K[X] (RatFunc K) + have hvariables : + (fun i : Fin h => + algebraMap K[X] (RatFunc K) + (genericSupportElementaryNumerator h moments i) / + algebraMap K[X] (RatFunc K) + (genericHankelDenominator h moments)) = + supportElementaryCoefficients + (genericHankelCoefficient h moments) := by + funext i + unfold genericSupportElementaryNumerator + supportElementaryCoefficients genericHankelCoefficient + simp only [map_mul, map_pow, map_neg, map_one] + ring + unfold clearedGenericRootPowerSum + rw [clearedMvPolynomialEvaluation_map + (universalElementaryPowerSum K h j) + (genericHankelDenominator h moments) + (genericSupportElementaryNumerator h moments) + (algebraMap K[X] (RatFunc K)) hnonzero] + rw [hscalar, hvariables, ← MvPolynomial.aeval_def] + rfl + +private theorem clearedGenericRootPowerSum_eval_eq_rootMoment + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinjective : Function.Injective roots) + (hmoments : ∀ k : ℕ, k < 2 * h → + (moments k).eval point = rootMoment roots k) + (j : ℕ) : + (clearedGenericRootPowerSum h moments j).eval point = + (genericHankelDenominator h moments).eval point ^ + (universalElementaryPowerSum K h j).totalDegree * + rootMoment roots j := by + have hnonzero := + genericHankelDenominator_eval_ne_zero_of_distinct_fiber + moments point roots hinjective hmoments + have hscalar : + (Polynomial.evalRingHom point).comp + (Polynomial.C : K →+* K[X]) = + algebraMap K K := by + ext x + simp only [RingHom.coe_comp, coe_evalRingHom, Function.comp_apply, eval_C, + Algebra.algebraMap_self, + RingHom.id_apply] + have hvariables : + (fun i : Fin h => + (Polynomial.evalRingHom point) + (genericSupportElementaryNumerator h moments i) / + (Polynomial.evalRingHom point) + (genericHankelDenominator h moments)) = + supportElementaryCoefficients + (rootSupportCoefficients roots) := by + funext i + unfold genericSupportElementaryNumerator + supportElementaryCoefficients + simp only [map_mul, map_pow, map_neg, map_one] + change + ((-1 : K) ^ (i.val + 1) * + (genericHankelNumerator h moments i.rev).eval point) / + (genericHankelDenominator h moments).eval point = + (-1 : K) ^ (i.val + 1) * + rootSupportCoefficients roots i.rev + rw [genericHankelNumerator_eval_eq_det_mul_rootSupportCoefficient + moments point roots hinjective hmoments i.rev] + field_simp [hnonzero] + unfold clearedGenericRootPowerSum + change + (Polynomial.evalRingHom point) + (clearedMvPolynomialEvaluation + (universalElementaryPowerSum K h j) + (genericHankelDenominator h moments) + (genericSupportElementaryNumerator h moments)) = + (Polynomial.evalRingHom point) + (genericHankelDenominator h moments) ^ + (universalElementaryPowerSum K h j).totalDegree * + rootMoment roots j + rw [clearedMvPolynomialEvaluation_map + (universalElementaryPowerSum K h j) + (genericHankelDenominator h moments) + (genericSupportElementaryNumerator h moments) + (Polynomial.evalRingHom point) hnonzero] + rw [hscalar, hvariables, ← MvPolynomial.aeval_def] + rw [universalElementaryPowerSum_evaluates_supportCoefficients roots j] + +private theorem genericRootMomentDifferencePolynomial_eval_eq_zero_of_fiber + {h : ℕ} (moments : ℕ → K[X]) (point : K) + (roots : Fin h → K) (hinjective : Function.Injective roots) + (hmoments : ∀ k : ℕ, k < 2 * h → + (moments k).eval point = rootMoment roots k) + (j : ℕ) + (hmomentj : (moments j).eval point = rootMoment roots j) : + (genericRootMomentDifferencePolynomial h moments j).eval point = 0 := by + unfold genericRootMomentDifferencePolynomial + rw [Polynomial.eval_sub, Polynomial.eval_mul, Polynomial.eval_pow, + hmomentj, clearedGenericRootPowerSum_eval_eq_rootMoment + moments point roots hinjective hmoments j] + exact sub_self _ + +private theorem genericRootMomentDifferencePolynomial_eq_zero_of_maximal_good_fibers + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (rankBound momentBudget j : ℕ) + (hbudget : 2 * rankBound ≤ momentBudget + 1) + (hj : j ≤ momentBudget) + (hmoments : ∀ point ∈ points, ∀ k : ℕ, k ≤ momentBudget → + (moments k).eval point = supportMoment (supports point) k) + (hdegree : + (genericRootMomentDifferencePolynomial + (maximalGenericHankelRank moments rankBound) moments j).natDegree < + (maximalGenericGoodFiberPoints points supports moments rankBound).card) : + genericRootMomentDifferencePolynomial + (maximalGenericHankelRank moments rankBound) moments j = 0 := by + apply Polynomial.eq_zero_of_natDegree_lt_card_of_eval_eq_zero' + (genericRootMomentDifferencePolynomial + (maximalGenericHankelRank moments rankBound) moments j) + (maximalGenericGoodFiberPoints points supports moments rankBound) + · intro point hpoint + have hp := (mem_maximalGenericGoodFiberPoints + points supports moments rankBound point).mp hpoint + have hcard := maximalGenericGoodFiberPoints_card_eq_rank + points supports moments rankBound momentBudget + hbudget hmoments point hpoint + have heval := + genericRootMomentDifferencePolynomial_eval_eq_zero_of_fiber + moments point (finiteSupportRoots (supports point)) + (finiteSupportRoots_injective (supports point)) + (fun k hk => by + rw [rootMoment_finiteSupportRoots] + exact hmoments point hp.1 k (by omega)) + j + (by rw [rootMoment_finiteSupportRoots] + exact hmoments point hp.1 j hj) + simpa only [hcard] using heval + · exact hdegree + +private theorem genericMoment_eq_genericRootPowerSum_of_cleared + (h : ℕ) (moments : ℕ → K[X]) (j : ℕ) + (hdenominator : genericHankelDenominator h moments ≠ 0) + (hidentity : genericRootMomentDifferencePolynomial h moments j = 0) : + algebraMap K[X] (RatFunc K) (moments j) = + genericRootPowerSum h moments j := by + have hnonzero := + genericHankelDenominator_ratFunc_ne_zero_of_polynomial + moments hdenominator + have hmapped := congrArg (algebraMap K[X] (RatFunc K)) hidentity + simp only [genericRootMomentDifferencePolynomial, map_sub, + map_mul, map_pow, map_zero] at hmapped + rw [clearedGenericRootPowerSum_map_ratFunc + h moments j hdenominator] at hmapped + have hequality := sub_eq_zero.mp hmapped + exact mul_left_cancel₀ + (pow_ne_zero _ hnonzero) hequality + +private theorem genericRootPowerSum_map_eq_rootMoment + {h : ℕ} (moments : ℕ → K[X]) (j : ℕ) + {E : Type*} [Field E] [Algebra K E] + [Algebra (RatFunc K) E] [IsScalarTower K (RatFunc K) E] + (roots : Fin h → E) + (hroots : + (genericMomentSupportPolynomial h moments).map + (algebraMap (RatFunc K) E) = + rootSupportPolynomial roots) : + algebraMap (RatFunc K) E (genericRootPowerSum h moments j) = + rootMoment roots j := by + have hcoefficients (i : Fin h) : + algebraMap (RatFunc K) E + (genericHankelCoefficient h moments i) = + rootSupportCoefficients roots i := by + have heq := congrArg (fun p : E[X] => p.coeff i.val) hroots + rw [Polynomial.coeff_map, + genericMomentSupportPolynomial_coeff moments i] at heq + exact heq + have hvariables : + (fun i : Fin h => + algebraMap (RatFunc K) E + (supportElementaryCoefficients + (genericHankelCoefficient h moments) i)) = + supportElementaryCoefficients + (rootSupportCoefficients roots) := by + funext i + unfold supportElementaryCoefficients + rw [map_mul, map_pow, map_neg, map_one, + hcoefficients i.rev] + unfold genericRootPowerSum + calc + algebraMap (RatFunc K) E + (MvPolynomial.aeval + (supportElementaryCoefficients + (genericHankelCoefficient h moments)) + (universalElementaryPowerSum K h j)) = + MvPolynomial.aeval + (fun i : Fin h => + algebraMap (RatFunc K) E + (supportElementaryCoefficients + (genericHankelCoefficient h moments) i)) + (universalElementaryPowerSum K h j) := by + simpa only [IsScalarTower.toAlgHom_apply] using + MvPolynomial.comp_aeval_apply + (supportElementaryCoefficients + (genericHankelCoefficient h moments)) + (IsScalarTower.toAlgHom K (RatFunc K) E) + (universalElementaryPowerSum K h j) + _ = rootMoment roots j := by + rw [hvariables] + exact universalElementaryPowerSum_evaluates_supportCoefficients + roots j + +private theorem genericRootMoment_eq_rootMoment_of_maximal_good_fibers + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (rankBound momentBudget j : ℕ) + (hbudget : 2 * rankBound ≤ momentBudget + 1) + (hj : j ≤ momentBudget) + (hmoments : ∀ point ∈ points, ∀ k : ℕ, k ≤ momentBudget → + (moments k).eval point = supportMoment (supports point) k) + (hdegree : + (genericRootMomentDifferencePolynomial + (maximalGenericHankelRank moments rankBound) moments j).natDegree < + (maximalGenericGoodFiberPoints points supports moments rankBound).card) + {E : Type*} [Field E] [Algebra K E] + [Algebra (RatFunc K) E] [IsScalarTower K (RatFunc K) E] + (roots : Fin (maximalGenericHankelRank moments rankBound) → E) + (hroots : + (genericMomentSupportPolynomial + (maximalGenericHankelRank moments rankBound) moments).map + (algebraMap (RatFunc K) E) = + rootSupportPolynomial roots) : + algebraMap (RatFunc K) E + (algebraMap K[X] (RatFunc K) (moments j)) = + rootMoment roots j := by + have hidentity := + genericRootMomentDifferencePolynomial_eq_zero_of_maximal_good_fibers + points supports moments rankBound momentBudget j + hbudget hj hmoments hdegree + have hgeneric := genericMoment_eq_genericRootPowerSum_of_cleared + (maximalGenericHankelRank moments rankBound) moments j + (maximalGenericHankelRank_spec moments rankBound).2 hidentity + calc + algebraMap (RatFunc K) E + (algebraMap K[X] (RatFunc K) (moments j)) = + algebraMap (RatFunc K) E + (genericRootPowerSum + (maximalGenericHankelRank moments rankBound) moments j) := + congrArg (algebraMap (RatFunc K) E) hgeneric + _ = rootMoment roots j := + genericRootPowerSum_map_eq_rootMoment moments j roots hroots + +private theorem genericMoments_eq_rootMoments_of_maximal_good_grid + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (rankBound momentBudget : ℕ) + (hbudget : 2 * rankBound ≤ momentBudget + 1) + (hmoments : ∀ point ∈ points, ∀ j : ℕ, j ≤ momentBudget → + (moments j).eval point = supportMoment (supports point) j) + (hdegrees : ∀ j : ℕ, j ≤ momentBudget → + (genericRootMomentDifferencePolynomial + (maximalGenericHankelRank moments rankBound) moments j).natDegree < + (maximalGenericGoodFiberPoints points supports moments rankBound).card) + {E : Type*} [Field E] [Algebra K E] + [Algebra (RatFunc K) E] [IsScalarTower K (RatFunc K) E] + (roots : Fin (maximalGenericHankelRank moments rankBound) → E) + (hroots : + (genericMomentSupportPolynomial + (maximalGenericHankelRank moments rankBound) moments).map + (algebraMap (RatFunc K) E) = + rootSupportPolynomial roots) : + ∀ j : ℕ, j ≤ momentBudget → + algebraMap (RatFunc K) E + (algebraMap K[X] (RatFunc K) (moments j)) = + rootMoment roots j := by + intro j hj + exact genericRootMoment_eq_rootMoment_of_maximal_good_fibers + points supports moments rankBound momentBudget j hbudget hj + hmoments (hdegrees j hj) roots hroots + +private def universalElementaryVariable + (R : Type*) [Field R] (h k : ℕ) : + MvPolynomial (Fin h) R := + if hzero : k = 0 then 1 + else if hbound : k ≤ h then + MvPolynomial.X ⟨k - 1, by omega⟩ + else 0 + +private theorem universalElementaryVariable_esymm_identity + (R : Type*) [Field R] (h k : ℕ) : + MvPolynomial.aeval + (fun i : Fin h => MvPolynomial.esymm (Fin h) R (i.val + 1)) + (universalElementaryVariable R h k) = + MvPolynomial.esymm (Fin h) R k := by + classical + by_cases hzero : k = 0 + · subst k + simp only [MvPolynomial.aeval_eq_bind₁, universalElementaryVariable, ↓reduceDIte, map_one, + MvPolynomial.esymm_zero] + · by_cases hbound : k ≤ h + · have hpositive : 0 < k := Nat.pos_of_ne_zero hzero + simp only [MvPolynomial.aeval_eq_bind₁, universalElementaryVariable, hzero, ↓reduceDIte, + hbound, + MvPolynomial.bind₁_X_right, Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hzero)] + · have hempty : + (Finset.univ : Finset (Fin h)).powersetCard k = ∅ := by + apply Finset.powersetCard_eq_empty.mpr + simp only [card_univ, Fintype.card_fin] + omega + simp only [MvPolynomial.esymm, MvPolynomial.aeval_eq_bind₁, universalElementaryVariable, + hzero, ↓reduceDIte, + hbound, map_zero, hempty, sum_empty] + +private theorem universalElementaryVariable_totalDegree_le_one + (R : Type*) [Field R] (h k : ℕ) : + (universalElementaryVariable R h k).totalDegree ≤ 1 := by + classical + by_cases hzero : k = 0 + · simp only [universalElementaryVariable, hzero, ↓reduceDIte, MvPolynomial.totalDegree_one, + zero_le] + · by_cases hbound : k ≤ h <;> + simp [universalElementaryVariable, hzero, hbound] + +private theorem universalElementaryPowerSum_zero + (R : Type*) [Field R] (h : ℕ) : + universalElementaryPowerSum R h 0 = + MvPolynomial.C (h : R) := by + apply (MvPolynomial.esymmAlgEquiv + (Fin h) R (Fintype.card_fin h)).injective + apply Subtype.ext + simp only [MvPolynomial.esymmAlgEquiv_apply, + MvPolynomial.esymmAlgHom_apply] + rw [universalElementaryPowerSum_esymm_identity] + simp only [MvPolynomial.psum, pow_zero, sum_const, card_univ, Fintype.card_fin, nsmul_eq_mul, + mul_one, + MvPolynomial.aeval_eq_bind₁, map_natCast] + +private theorem universalElementaryPowerSum_newton_recurrence + (R : Type*) [Field R] (h j : ℕ) (hj : 0 < j) : + universalElementaryPowerSum R h j = + MvPolynomial.C ((-1 : R) ^ (j + 1) * (j : R)) * + universalElementaryVariable R h j - + ∑ a ∈ Finset.HasAntidiagonal.antidiagonal j with a.1 ∈ Set.Ioo 0 j, + MvPolynomial.C ((-1 : R) ^ a.1) * + universalElementaryVariable R h a.1 * + universalElementaryPowerSum R h a.2 := by + classical + apply (MvPolynomial.esymmAlgEquiv + (Fin h) R (Fintype.card_fin h)).injective + apply Subtype.ext + simp only [MvPolynomial.esymmAlgEquiv_apply, + MvPolynomial.esymmAlgHom_apply] + rw [universalElementaryPowerSum_esymm_identity] + rw [MvPolynomial.psum_eq_mul_esymm_sub_sum (Fin h) R j hj] + simp only [map_sub, map_sum, map_mul, + map_pow, map_neg, map_one, map_natCast] + simp_rw [universalElementaryVariable_esymm_identity, + universalElementaryPowerSum_esymm_identity] + +private theorem universalElementaryPowerSum_totalDegree_le + (R : Type*) [Field R] (h j : ℕ) : + (universalElementaryPowerSum R h j).totalDegree ≤ j := by + classical + induction j using Nat.strong_induction_on with + | h j ih => + by_cases hzero : j = 0 + · subst j + rw [universalElementaryPowerSum_zero] + exact (MvPolynomial.totalDegree_C (h : R)).le + · have hj : 0 < j := Nat.pos_of_ne_zero hzero + rw [universalElementaryPowerSum_newton_recurrence R h j hj] + apply (MvPolynomial.totalDegree_sub _ _).trans + apply max_le + · calc + (MvPolynomial.C ((-1 : R) ^ (j + 1) * (j : R)) * + universalElementaryVariable R h j).totalDegree ≤ + (MvPolynomial.C + ((-1 : R) ^ (j + 1) * (j : R))).totalDegree + + (universalElementaryVariable R h j).totalDegree := + MvPolynomial.totalDegree_mul _ _ + _ ≤ j := by + rw [MvPolynomial.totalDegree_C] + have hvar := universalElementaryVariable_totalDegree_le_one R h j + omega + · apply MvPolynomial.totalDegree_finsetSum_le + intro pair hpair + have hp := Finset.mem_filter.mp hpair + have hsum := Finset.HasAntidiagonal.mem_antidiagonal.mp hp.1 + have hpos : 0 < pair.1 := hp.2.1 + have hlt : pair.2 < j := by omega + calc + (MvPolynomial.C ((-1 : R) ^ pair.1) * + universalElementaryVariable R h pair.1 * + universalElementaryPowerSum R h pair.2).totalDegree ≤ + (MvPolynomial.C ((-1 : R) ^ pair.1) * + universalElementaryVariable R h pair.1).totalDegree + + (universalElementaryPowerSum R h pair.2).totalDegree := + MvPolynomial.totalDegree_mul _ _ + _ ≤ 1 + pair.2 := by + have hfirst := + MvPolynomial.totalDegree_mul + (MvPolynomial.C ((-1 : R) ^ pair.1)) + (universalElementaryVariable R h pair.1) + rw [MvPolynomial.totalDegree_C, zero_add] at hfirst + exact Nat.add_le_add + (hfirst.trans + (universalElementaryVariable_totalDegree_le_one R h pair.1)) + (ih pair.2 hlt) + _ ≤ j := by omega + +private theorem clearedMvPolynomialEvaluation_natDegree_le + {h : ℕ} (polynomial : MvPolynomial (Fin h) K) + (denominator : K[X]) (numerators : Fin h → K[X]) + (degreeBound : ℕ) + (hdenominator : denominator.natDegree ≤ degreeBound) + (hnumerators : ∀ i, (numerators i).natDegree ≤ degreeBound) : + (clearedMvPolynomialEvaluation polynomial denominator numerators).natDegree ≤ + polynomial.totalDegree * degreeBound := by + classical + unfold clearedMvPolynomialEvaluation + apply Polynomial.natDegree_sum_le_of_forall_le + intro exponent hexponent + have hdegree : + exponent.sum (fun _ power => power) ≤ polynomial.totalDegree := + MvPolynomial.le_totalDegree hexponent + have hproduct : + (∏ i ∈ exponent.support, + numerators i ^ exponent i).natDegree ≤ + exponent.sum (fun _ power => power) * degreeBound := by + calc + (∏ i ∈ exponent.support, + numerators i ^ exponent i).natDegree ≤ + ∑ i ∈ exponent.support, + (numerators i ^ exponent i).natDegree := + Polynomial.natDegree_prod_le exponent.support + (fun i => numerators i ^ exponent i) + _ ≤ ∑ i ∈ exponent.support, exponent i * degreeBound := by + apply Finset.sum_le_sum + intro i _ + exact Polynomial.natDegree_pow_le.trans + (Nat.mul_le_mul_left (exponent i) (hnumerators i)) + _ = exponent.sum (fun _ power => power) * degreeBound := by + change + (∑ i ∈ exponent.support, exponent i * degreeBound) = + (∑ i ∈ exponent.support, exponent i) * degreeBound + rw [Finset.sum_mul] + calc + (Polynomial.C (polynomial.coeff exponent) * + denominator ^ (polynomial.totalDegree - + exponent.sum (fun _ power => power)) * + ∏ i ∈ exponent.support, numerators i ^ exponent i).natDegree = + (Polynomial.C (polynomial.coeff exponent) * + (denominator ^ (polynomial.totalDegree - + exponent.sum (fun _ power => power)) * + ∏ i ∈ exponent.support, numerators i ^ exponent i)).natDegree := by + rw [mul_assoc] + _ ≤ (denominator ^ (polynomial.totalDegree - + exponent.sum (fun _ power => power)) * + ∏ i ∈ exponent.support, numerators i ^ exponent i).natDegree := + Polynomial.natDegree_C_mul_le _ _ + _ ≤ (denominator ^ (polynomial.totalDegree - + exponent.sum (fun _ power => power))).natDegree + + (∏ i ∈ exponent.support, + numerators i ^ exponent i).natDegree := + Polynomial.natDegree_mul_le + _ ≤ (polynomial.totalDegree - + exponent.sum (fun _ power => power)) * degreeBound + + exponent.sum (fun _ power => power) * degreeBound := by + apply Nat.add_le_add + · exact Polynomial.natDegree_pow_le.trans + (Nat.mul_le_mul_left + (polynomial.totalDegree - + exponent.sum (fun _ power => power)) hdenominator) + · exact hproduct + _ = polynomial.totalDegree * degreeBound := by + rw [← Nat.add_mul, Nat.sub_add_cancel hdegree] + +private theorem genericSupportElementaryNumerator_natDegree_le + (moments : ℕ → K[X]) (d h : ℕ) + (hmomentdegree : ∀ k : ℕ, (moments k).natDegree ≤ d * k) + (i : Fin h) : + (genericSupportElementaryNumerator h moments i).natDegree ≤ + 2 * d * h * h := by + have hsmall : ∀ k : ℕ, k < 2 * h → + (moments k).natDegree ≤ d * (2 * h) := by + intro k hk + exact (hmomentdegree k).trans + (Nat.mul_le_mul_left d (Nat.le_of_lt hk)) + have hnumerator := + genericHankelNumerator_natDegree_le + moments (d * (2 * h)) hsmall i.rev + unfold genericSupportElementaryNumerator + calc + ((-1 : K[X]) ^ (i.val + 1) * + genericHankelNumerator h moments i.rev).natDegree ≤ + ((-1 : K[X]) ^ (i.val + 1)).natDegree + + (genericHankelNumerator h moments i.rev).natDegree := + Polynomial.natDegree_mul_le + _ = (genericHankelNumerator h moments i.rev).natDegree := by simp only [natDegree_pow, + natDegree_neg, natDegree_one, mul_zero, zero_add] + _ ≤ h * (d * (2 * h)) := hnumerator + _ = 2 * d * h * h := by ring + +private theorem genericHankelDenominator_natDegree_le_uniform_source + (moments : ℕ → K[X]) (d h : ℕ) + (hmomentdegree : ∀ k : ℕ, (moments k).natDegree ≤ d * k) : + (genericHankelDenominator h moments).natDegree ≤ + 2 * d * h * h := by + have hsmall : ∀ k : ℕ, k < 2 * h → + (moments k).natDegree ≤ d * (2 * h) := by + intro k hk + exact (hmomentdegree k).trans + (Nat.mul_le_mul_left d (Nat.le_of_lt hk)) + calc + (genericHankelDenominator h moments).natDegree ≤ + h * (d * (2 * h)) := + genericHankelDenominator_natDegree_le + moments (d * (2 * h)) hsmall + _ = 2 * d * h * h := by ring + +private theorem clearedGenericRootPowerSum_natDegree_le + (moments : ℕ → K[X]) (d h j : ℕ) + (hmomentdegree : ∀ k : ℕ, (moments k).natDegree ≤ d * k) : + (clearedGenericRootPowerSum h moments j).natDegree ≤ + 2 * d * h ^ 2 * j := by + unfold clearedGenericRootPowerSum + calc + (clearedMvPolynomialEvaluation + (universalElementaryPowerSum K h j) + (genericHankelDenominator h moments) + (genericSupportElementaryNumerator h moments)).natDegree ≤ + (universalElementaryPowerSum K h j).totalDegree * + (2 * d * h * h) := + clearedMvPolynomialEvaluation_natDegree_le + (universalElementaryPowerSum K h j) + (genericHankelDenominator h moments) + (genericSupportElementaryNumerator h moments) + (2 * d * h * h) + (genericHankelDenominator_natDegree_le_uniform_source + moments d h hmomentdegree) + (genericSupportElementaryNumerator_natDegree_le + moments d h hmomentdegree) + _ ≤ j * (2 * d * h * h) := + Nat.mul_le_mul_right (2 * d * h * h) + (universalElementaryPowerSum_totalDegree_le K h j) + _ = 2 * d * h ^ 2 * j := by ring + +private theorem genericRootMomentDifferencePolynomial_natDegree_le + (moments : ℕ → K[X]) (d h j : ℕ) + (hmomentdegree : ∀ k : ℕ, (moments k).natDegree ≤ d * k) : + (genericRootMomentDifferencePolynomial h moments j).natDegree ≤ + max (d * j) (2 * d * h ^ 2 * j) := by + have hdenominator : + (genericHankelDenominator h moments).natDegree ≤ + d * h * (h - 1) := + genericHankelDenominator_natDegree_le_sharp + (h := h) moments d (fun k _ => hmomentdegree k) + have huniversal := + universalElementaryPowerSum_totalDegree_le K h j + have hfirst : + (genericHankelDenominator h moments ^ + (universalElementaryPowerSum K h j).totalDegree * + moments j).natDegree ≤ + max (d * j) (2 * d * h ^ 2 * j) := by + have hbasic : + (genericHankelDenominator h moments ^ + (universalElementaryPowerSum K h j).totalDegree * + moments j).natDegree ≤ + (universalElementaryPowerSum K h j).totalDegree * + (d * h * (h - 1)) + + d * j := by + calc + (genericHankelDenominator h moments ^ + (universalElementaryPowerSum K h j).totalDegree * + moments j).natDegree ≤ + (genericHankelDenominator h moments ^ + (universalElementaryPowerSum K h j).totalDegree).natDegree + + (moments j).natDegree := + Polynomial.natDegree_mul_le + _ ≤ (universalElementaryPowerSum K h j).totalDegree * + (d * h * (h - 1)) + d * j := by + apply Nat.add_le_add + · exact Polynomial.natDegree_pow_le.trans + (Nat.mul_le_mul_left + (universalElementaryPowerSum K h j).totalDegree + hdenominator) + · exact hmomentdegree j + by_cases hzero : h = 0 + · subst h + simpa only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, mul_zero, zero_mul, + zero_le, + sup_of_le_left, ge_iff_le, zero_tsub, zero_add] using hbasic + · have hpositive : 0 < h := Nat.pos_of_ne_zero hzero + have hsquare : 0 < h * h := Nat.mul_pos hpositive hpositive + have hquadratic : h * (h - 1) + 1 ≤ 2 * h * h := by + have hsmaller := + Nat.mul_le_mul_left h (Nat.sub_le h 1) + calc + h * (h - 1) + 1 ≤ h * h + h * h := by omega + _ = 2 * h * h := by ring + apply (hbasic.trans ?_).trans (le_max_right _ _) + calc + (universalElementaryPowerSum K h j).totalDegree * + (d * h * (h - 1)) + d * j ≤ + j * (d * h * (h - 1)) + d * j := + Nat.add_le_add_right + (Nat.mul_le_mul_right (d * h * (h - 1)) huniversal) _ + _ = (d * j) * (h * (h - 1) + 1) := by ring + _ ≤ (d * j) * (2 * h * h) := + Nat.mul_le_mul_left (d * j) hquadratic + _ = 2 * d * h ^ 2 * j := by ring + unfold genericRootMomentDifferencePolynomial + exact (Polynomial.natDegree_sub_le _ _).trans + (max_le hfirst + ((clearedGenericRootPowerSum_natDegree_le + moments d h j hmomentdegree).trans (le_max_right _ _))) + +private theorem genericMoments_eq_rootMoments_of_maximal_good_grid_degree_bound + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (rankBound momentBudget d : ℕ) + (hbudget : 2 * rankBound ≤ momentBudget + 1) + (hmoments : ∀ point ∈ points, ∀ j : ℕ, j ≤ momentBudget → + (moments j).eval point = supportMoment (supports point) j) + (hmomentdegree : ∀ j : ℕ, (moments j).natDegree ≤ d * j) + (hgrid : + max (d * momentBudget) + (2 * d * (maximalGenericHankelRank moments rankBound) ^ 2 * + momentBudget) < + (maximalGenericGoodFiberPoints + points supports moments rankBound).card) + {E : Type*} [Field E] [Algebra K E] + [Algebra (RatFunc K) E] [IsScalarTower K (RatFunc K) E] + (roots : Fin (maximalGenericHankelRank moments rankBound) → E) + (hroots : + (genericMomentSupportPolynomial + (maximalGenericHankelRank moments rankBound) moments).map + (algebraMap (RatFunc K) E) = + rootSupportPolynomial roots) : + ∀ j : ℕ, j ≤ momentBudget → + algebraMap (RatFunc K) E + (algebraMap K[X] (RatFunc K) (moments j)) = + rootMoment roots j := by + apply genericMoments_eq_rootMoments_of_maximal_good_grid + points supports moments rankBound momentBudget hbudget hmoments + (E := E) (roots := roots) (hroots := hroots) + intro j hj + calc + (genericRootMomentDifferencePolynomial + (maximalGenericHankelRank moments rankBound) + moments j).natDegree ≤ + max (d * j) + (2 * d * (maximalGenericHankelRank moments rankBound) ^ 2 * j) := + genericRootMomentDifferencePolynomial_natDegree_le + moments d (maximalGenericHankelRank moments rankBound) j + hmomentdegree + _ ≤ max (d * momentBudget) + (2 * d * (maximalGenericHankelRank moments rankBound) ^ 2 * + momentBudget) := by + apply max_le_max + · exact Nat.mul_le_mul_left d hj + · exact Nat.mul_le_mul_left + (2 * d * (maximalGenericHankelRank moments rankBound) ^ 2) hj + _ < (maximalGenericGoodFiberPoints + points supports moments rankBound).card := hgrid + +private theorem maximalGenericHankelRank_pos_of_normalized_moment + (moments : ℕ → K[X]) (rankBound : ℕ) (point : K) + (hbound : 0 < rankBound) + (hnormalized : (moments 0).eval point = 1) : + 0 < maximalGenericHankelRank moments rankBound := by + have hone : genericHankelDenominator 1 moments ≠ 0 := by + intro hzero + have heval := congrArg (fun polynomial : K[X] => + polynomial.eval point) hzero + have hdeterminant : + genericHankelDenominator 1 moments = moments 0 := by + simp only [genericHankelDenominator, leadingHankelDet, polynomialHankel, Fin.val_eq_zero, + add_zero, + det_unique, Fin.default_eq_zero, Fin.isValue, of_apply] + rw [hdeterminant, hnormalized, Polynomial.eval_zero] at heval + exact one_ne_zero heval + by_contra hnot + have hmax : maximalGenericHankelRank moments rankBound = 0 := + Nat.eq_zero_of_not_pos hnot + apply hone + exact genericHankelDenominator_eq_zero_of_maximal_lt + moments rankBound 1 (by omega) (by omega) + +private theorem sourceGenericMoments_eq_rootMoments + (points : Finset K) (supports : K → Finset K) + (moments : ℕ → K[X]) (N d : ℕ) + (hN : 100 ≤ N) (hd : d ≤ N) + (hmoments : ∀ point ∈ points, ∀ j : ℕ, j ≤ N ^ 30 → + (moments j).eval point = supportMoment (supports point) j) + (hmomentdegree : ∀ j : ℕ, (moments j).natDegree ≤ d * j) + (hgrid : + 2 * N ^ 39 < + (maximalGenericGoodFiberPoints + points supports moments (N ^ 4)).card) + {E : Type*} [Field E] [Algebra K E] + [Algebra (RatFunc K) E] [IsScalarTower K (RatFunc K) E] + (roots : Fin (maximalGenericHankelRank moments (N ^ 4)) → E) + (hroots : + (genericMomentSupportPolynomial + (maximalGenericHankelRank moments (N ^ 4)) moments).map + (algebraMap (RatFunc K) E) = + rootSupportPolynomial roots) : + ∀ j : ℕ, j ≤ N ^ 30 → + algebraMap (RatFunc K) E + (algebraMap K[X] (RatFunc K) (moments j)) = + rootMoment roots j := by + have hbudget : 2 * N ^ 4 ≤ N ^ 30 + 1 := by + have hsource := source_clause_support_lt_moment_budget hN + omega + have hfirst : d * N ^ 30 ≤ 2 * N ^ 39 := by + calc + d * N ^ 30 ≤ N ^ 31 := source_moment_degree_le hd + _ ≤ N ^ 39 := + Nat.pow_le_pow_right (by omega) (by norm_num) + _ ≤ 2 * N ^ 39 := by omega + have hrank : + maximalGenericHankelRank moments (N ^ 4) ≤ N ^ 4 := + (maximalGenericHankelRank_spec moments (N ^ 4)).1 + have hsecond : + 2 * d * (maximalGenericHankelRank moments (N ^ 4)) ^ 2 * + N ^ 30 ≤ 2 * N ^ 39 := + source_cleared_moment_degree_le hd hrank (le_refl _) + apply genericMoments_eq_rootMoments_of_maximal_good_grid_degree_bound + points supports moments (N ^ 4) (N ^ 30) d hbudget + hmoments hmomentdegree + (lt_of_le_of_lt (max_le hfirst hsecond) hgrid) + roots hroots + +/-- GapCVP reduction support. -/ +def enumeratedRootSupport + {E : Type*} {h : ℕ} + (roots : Fin h → E) : Finset E := by + classical + exact Finset.univ.image roots + +private theorem supportMoment_enumeratedRootSupport + {E : Type*} [Field E] {h : ℕ} + (roots : Fin h → E) + (hinjective : Function.Injective roots) (j : ℕ) : + supportMoment (enumeratedRootSupport roots) j = + rootMoment roots j := by + classical + unfold supportMoment rootMoment enumeratedRootSupport + rw [Finset.sum_image] + intro first _ second _ hequal + exact hinjective hequal + +private theorem enumeratedRootSupport_card + {E : Type*} {h : ℕ} + (roots : Fin h → E) + (hinjective : Function.Injective roots) : + (enumeratedRootSupport roots).card = h := by + classical + unfold enumeratedRootSupport + rw [Finset.card_image_iff.mpr (Set.injOn_of_injective hinjective)] + exact Finset.card_fin h + +end + +section + +open Polynomial IsDedekindDomain + +variable {K E : Type*} [Field K] [Field E] +variable [Algebra (RatFunc K) E] [Algebra K[X] E] +variable [IsScalarTower K[X] (RatFunc K) E] +variable [FiniteDimensional (RatFunc K) E] +variable [Algebra.IsSeparable (RatFunc K) E] + +theorem functionFieldExtendedValuation_polynomial_le_one + (a : K) (f : K[X]) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E f) ≤ 1 := by + let : IsDedekindDomain (integralClosure K[X] E) := + integralClosure.isDedekindDomain K[X] (RatFunc K) E + let : IsFractionRing (integralClosure K[X] E) E := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) E + change + (functionFieldHeightOnePlace (K := K) (E := E) a).valuation E + (algebraMap K[X] E f) ≤ 1 + rw [IsScalarTower.algebraMap_apply K[X] + (integralClosure K[X] E) E f] + exact + (functionFieldHeightOnePlace (K := K) (E := E) a).valuation_le_one + (algebraMap K[X] (integralClosure K[X] E) f) + +private theorem functionFieldExtendedValuation_polynomial_eq_one_of_eval_ne_zero + (a : K) (f : K[X]) (heval : f.eval a ≠ 0) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E f) = 1 := by + apply le_antisymm + (functionFieldExtendedValuation_polynomial_le_one a f) + apply le_of_not_gt + intro hlt + have hmem := + (functionFieldExtendedValuation_polynomial_lt_one_iff + (K := K) (E := E) a f).mp hlt + have hdvd : (X - C a : K[X]) ∣ f := + Ideal.mem_span_singleton.mp + (show f ∈ Ideal.span ({X - C a} : Set K[X]) by + simpa only [functionFieldPlaceIdeal] using hmem) + exact heval ((Polynomial.dvd_iff_isRoot.mp hdvd)) + +private theorem functionField_rootMultiplicity_le_natDegree + (a : K) (f : K[X]) (hf : f ≠ 0) : + f.rootMultiplicity a ≤ f.natDegree := by + have hdegree := Polynomial.natDegree_le_of_dvd + (Polynomial.pow_rootMultiplicity_dvd f a) hf + simpa only [ge_iff_le, natDegree_pow, natDegree_sub_C, natDegree_X, mul_one] using hdegree + +private theorem functionFieldExtendedValuation_polynomial_eq_place_pow + (a : K) (f : K[X]) (hf : f ≠ 0) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E f) = + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ f.rootMultiplicity a := by + obtain ⟨remaining, hfactor, hremaining⟩ := + f.exists_eq_pow_rootMultiplicity_mul_and_not_dvd hf a + have heval : remaining.eval a ≠ 0 := by + intro hzero + apply hremaining + apply Polynomial.dvd_iff_isRoot.mpr + exact hzero + have hunit := + functionFieldExtendedValuation_polynomial_eq_one_of_eval_ne_zero + (E := E) a remaining heval + calc + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E f) = + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E + ((X - C a) ^ f.rootMultiplicity a * remaining)) := + congrArg + (fun polynomial : K[X] => + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E polynomial)) hfactor + _ = functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ f.rootMultiplicity a * + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E remaining) := by + rw [map_mul, map_pow, Valuation.map_mul, Valuation.map_pow] + _ = functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ f.rootMultiplicity a := by + rw [hunit, mul_one] + +private theorem functionFieldExtendedValuation_place_pow_natDegree_le + (a : K) (f : K[X]) (hf : f ≠ 0) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ f.natDegree ≤ + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E f) := by + rw [functionFieldExtendedValuation_polynomial_eq_place_pow a f hf] + apply pow_le_pow_of_le_one + · exact zero_le + · exact le_of_lt + (functionFieldExtendedValuation_place_lt_one (K := K) (E := E) a) + · exact functionField_rootMultiplicity_le_natDegree a f hf + +private theorem functionFieldExtendedValuation_polynomial_div_le + (a : K) (numerator denominator : K[X]) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E numerator / + algebraMap K[X] E denominator) ≤ + (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E denominator))⁻¹ := by + rw [Valuation.map_div, div_eq_mul_inv] + calc + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E numerator) * + (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E denominator))⁻¹ ≤ + 1 * (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E denominator))⁻¹ := by + rw [mul_comm] + simpa only [mul_one, one_mul] using + mul_le_mul_right + (functionFieldExtendedValuation_polynomial_le_one a numerator) + (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E denominator))⁻¹ + _ = _ := one_mul _ + +private theorem functionFieldExtendedValuation_genericHankelCoefficient_le + (a : K) (moments : ℕ → K[X]) (h : ℕ) (i : Fin h) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap (RatFunc K) E + (genericHankelCoefficient h moments i)) ≤ + (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E + (genericHankelDenominator h moments)))⁻¹ := by + unfold genericHankelCoefficient + rw [map_div₀, + ← IsScalarTower.algebraMap_apply K[X] (RatFunc K) E + (genericHankelNumerator h moments i), + ← IsScalarTower.algebraMap_apply K[X] (RatFunc K) E + (genericHankelDenominator h moments)] + exact functionFieldExtendedValuation_polynomial_div_le + a (genericHankelNumerator h moments i) + (genericHankelDenominator h moments) + +private theorem functionFieldExtendedValuation_genericHankelDenominator_place_pow_le + (a : K) (moments : ℕ → K[X]) (d h : ℕ) + (hmoments : ∀ j : ℕ, (moments j).natDegree ≤ d * j) + (hdenominator : genericHankelDenominator h moments ≠ 0) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ (d * h * (h - 1)) ≤ + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E + (genericHankelDenominator h moments)) := by + have hdegree := genericHankelDenominator_natDegree_le_sharp + (h := h) moments d (fun j _ => hmoments j) + calc + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ (d * h * (h - 1)) ≤ + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ + (genericHankelDenominator h moments).natDegree := by + apply pow_le_pow_of_le_one + · exact zero_le + · exact le_of_lt + (functionFieldExtendedValuation_place_lt_one + (K := K) (E := E) a) + · exact hdegree + _ ≤ functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E + (genericHankelDenominator h moments)) := + functionFieldExtendedValuation_place_pow_natDegree_le + a (genericHankelDenominator h moments) hdenominator + +private theorem functionFieldExtendedValuation_genericHankelCoefficient_le_place_inv_pow + (a : K) (moments : ℕ → K[X]) (d h : ℕ) + (hmoments : ∀ j : ℕ, (moments j).natDegree ≤ d * j) + (hdenominator : genericHankelDenominator h moments ≠ 0) + (i : Fin h) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap (RatFunc K) E + (genericHankelCoefficient h moments i)) ≤ + (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ + (d * h * (h - 1)))⁻¹ := by + have hplaceNonzero : algebraMap K[X] E (X - C a) ≠ 0 := + (map_ne_zero_iff (algebraMap K[X] E) + (functionFieldPolynomial_algebraMap_injective + (K := K) (E := E))).mpr + (Polynomial.X_sub_C_ne_zero a) + have hplacePositive : + 0 < functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) := + (Valuation.pos_iff _).mpr hplaceNonzero + have hlower := + functionFieldExtendedValuation_genericHankelDenominator_place_pow_le + (E := E) a moments d h hmoments hdenominator + calc + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap (RatFunc K) E + (genericHankelCoefficient h moments i)) ≤ + (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E + (genericHankelDenominator h moments)))⁻¹ := + functionFieldExtendedValuation_genericHankelCoefficient_le + a moments h i + _ ≤ (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ + (d * h * (h - 1)))⁻¹ := + inv_anti₀ (pow_pos hplacePositive _) hlower + +end + +section + +open scoped BigOperators +open Finset Polynomial + +variable {K : Type*} [Field K] [Algebra (ZMod 2) K] [Fintype K] + +private def sourceSignedFiberSupport + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (tableType : sourceSATTableType F) + (point : sourceSATGridPoint points) : Finset K := by + classical + exact Finset.univ.filter fun value : K => + (z (sourceSATColumnIndex F points tableType point value) : ZMod 2) ≠ 0 + +omit [Field K] [Algebra (ZMod 2) K] in +@[simp] private theorem mem_sourceSignedFiberSupport + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (tableType : sourceSATTableType F) + (point : sourceSATGridPoint points) (value : K) : + value ∈ sourceSignedFiberSupport F points z tableType point ↔ + (z (sourceSATColumnIndex F points tableType point value) : ZMod 2) ≠ + 0 := by + classical + simp only [sourceSignedFiberSupport, ne_eq, mem_filter, mem_univ, true_and] + +private theorem sourceBinaryResidue_eq_one_of_ne_zero + (value : ZMod 2) (hvalue : value ≠ 0) : value = 1 := by + apply ZMod.val_injective 2 + have hnonzero : value.val ≠ 0 := by + intro hzero + apply hvalue + apply ZMod.val_injective 2 + simpa only [ZMod.val_zero, ZMod.val_eq_zero] using hzero + have hlt := ZMod.val_lt value + change value.val = 1 + omega + +omit [Field K] [Algebra (ZMod 2) K] in +private theorem sourceSignedFiberSupport_card_le_rowSquaredNorm + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (tableType : sourceSATTableType F) + (point : sourceSATGridPoint points) : + (sourceSignedFiberSupport F points z tableType point).card ≤ + ∑ value : K, + (z (sourceSATColumnIndex F points tableType point value)).natAbs ^ + 2 := by + classical + calc + (sourceSignedFiberSupport F points z tableType point).card = + ∑ value ∈ sourceSignedFiberSupport F points z tableType point, + (1 : ℕ) := + Finset.card_eq_sum_ones _ + _ ≤ ∑ value ∈ sourceSignedFiberSupport F points z tableType point, + (z (sourceSATColumnIndex F points tableType point value)).natAbs ^ + 2 := by + apply Finset.sum_le_sum + intro value hvalue + have hnonzero : + z (sourceSATColumnIndex F points tableType point value) ≠ 0 := by + intro hzero + have hodd := + (mem_sourceSignedFiberSupport F points z tableType point + value).mp hvalue + simp only [hzero, Int.cast_zero, ne_eq, not_true_eq_false] at hodd + have hpositive := Int.natAbs_pos.mpr hnonzero + nlinarith + _ ≤ ∑ value : K, + (z (sourceSATColumnIndex F points tableType point value)).natAbs ^ + 2 := + Finset.sum_le_sum_of_subset + (Finset.subset_univ _) + +omit [Field K] [Algebra (ZMod 2) K] in +private theorem sourceSigned_totalFiberSupport_le_integerSquaredNorm + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) : + (∑ tableType : sourceSATTableType F, + ∑ point : sourceSATGridPoint points, + (sourceSignedFiberSupport F points z tableType point).card) ≤ + integerSquaredNorm z := by + classical + calc + (∑ tableType : sourceSATTableType F, + ∑ point : sourceSATGridPoint points, + (sourceSignedFiberSupport F points z tableType point).card) ≤ + ∑ tableType : sourceSATTableType F, + ∑ point : sourceSATGridPoint points, + ∑ value : K, + (z (sourceSATColumnIndex F points + tableType point value)).natAbs ^ 2 := by + apply Finset.sum_le_sum + intro tableType _ + apply Finset.sum_le_sum + intro point _ + exact sourceSignedFiberSupport_card_le_rowSquaredNorm + F points z tableType point + _ = ∑ coordinate : sourceSATTableCoordinate F K points, + (z (Fintype.equivFin + (sourceSATTableCoordinate F K points) coordinate)).natAbs ^ + 2 := by + symm + rw [Fintype.sum_prod_type] + simp_rw [Fintype.sum_prod_type] + rfl + _ = ∑ position : Fin (sourceSATTableDimension F K points), + (z position).natAbs ^ 2 := + Equiv.sum_comp + (Fintype.equivFin (sourceSATTableCoordinate F K points)) + (fun position : Fin (sourceSATTableDimension F K points) => + (z position).natAbs ^ 2) + _ = integerSquaredNorm z := rfl + +omit [Field K] [Algebra (ZMod 2) K] in +private theorem sourceSigned_typeFiberSupport_le_integerSquaredNorm + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (tableType : sourceSATTableType F) : + (∑ point : sourceSATGridPoint points, + (sourceSignedFiberSupport F points z tableType point).card) ≤ + integerSquaredNorm z := by + calc + (∑ point : sourceSATGridPoint points, + (sourceSignedFiberSupport F points z tableType point).card) ≤ + ∑ otherType : sourceSATTableType F, + ∑ point : sourceSATGridPoint points, + (sourceSignedFiberSupport F points z otherType point).card := by + exact Finset.single_le_sum + (s := Finset.univ) + (f := fun otherType : sourceSATTableType F => + ∑ point : sourceSATGridPoint points, + (sourceSignedFiberSupport F points z otherType point).card) + (fun _ _ => Nat.zero_le _) + (Finset.mem_univ tableType) + _ ≤ integerSquaredNorm z := + sourceSigned_totalFiberSupport_le_integerSquaredNorm + F points z + +private def sourceSignedFiberSupportAt + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (tableType : sourceSATTableType F) (point : K) : Finset K := by + classical + exact if hpoint : point ∈ points then + sourceSignedFiberSupport F points z tableType ⟨point, hpoint⟩ + else ∅ + +omit [Field K] [Algebra (ZMod 2) K] in +@[simp] private theorem sourceSignedFiberSupportAt_grid + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (tableType : sourceSATTableType F) + (point : sourceSATGridPoint points) : + sourceSignedFiberSupportAt F points z tableType point.val = + sourceSignedFiberSupport F points z tableType point := by + classical + simp only [sourceSignedFiberSupportAt, point.property, ↓reduceDIte, Subtype.coe_eta] + +omit [Field K] [Algebra (ZMod 2) K] in +private theorem sourceSignedFiberSupportAt_grid_budget + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (tableType : sourceSATTableType F) : + (∑ point ∈ points, + (sourceSignedFiberSupportAt F points z tableType point).card) ≤ + integerSquaredNorm z := by + classical + rw [Finset.sum_subtype points (fun _ => Iff.rfl)] + · simp_rw [sourceSignedFiberSupportAt_grid] + exact sourceSigned_typeFiberSupport_le_integerSquaredNorm + F points z tableType + +private theorem sourceSignedFiberSupport_moment + (F : Formula) (points : Finset K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (tableType : sourceSATTableType F) + (point : sourceSATGridPoint points) (j : ℕ) : + sourceOrdinaryMomentMap F points tableType j + (fun position => algebraMap (ZMod 2) K + (z position : ZMod 2)) point = + supportMoment (sourceSignedFiberSupport F points z tableType point) j := by + classical + change + (∑ value : K, + algebraMap (ZMod 2) K + (z (sourceSATColumnIndex F points tableType point value) : ZMod 2) * + value ^ j) = + ∑ value ∈ sourceSignedFiberSupport F points z tableType point, + value ^ j + unfold sourceSignedFiberSupport + rw [Finset.sum_filter] + apply Finset.sum_congr rfl + intro value _ + let b : ZMod 2 := + (z (sourceSATColumnIndex F points tableType point value) : ZMod 2) + change algebraMap (ZMod 2) K b * value ^ j = + if b ≠ 0 then value ^ j else 0 + by_cases hb : b = 0 + · simp only [hb, map_zero, zero_mul, ne_eq, not_true_eq_false, ↓reduceIte] + · have hone := sourceBinaryResidue_eq_one_of_ne_zero b hb + simp only [hone, map_one, one_mul, ne_eq, one_ne_zero, not_false_eq_true, ↓reduceIte] + +private theorem sourceSignedFiberSupport_moment_polynomial_of_solves + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hsolves : + (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (tableType : sourceSATTableType F) + (j : ℕ) (hj : j ≤ momentBudget) : + ∃ polynomial : K[X], + polynomial.natDegree ≤ F.variableCount * j ∧ + ∀ point : sourceSATGridPoint points, + polynomial.eval point.val = + supportMoment + (sourceSignedFiberSupport F points z tableType point) j := by + have hchecks := + (concreteSATBinaryAffineSystem_solves_iff + F fieldBasis points variablePlace momentBudget z).mp hsolves + simp only [GapCVP.Core.concreteSATFieldChecks, decide_eq_true_eq] at hchecks + obtain ⟨_, _, hordinary, _⟩ := hchecks + have hmem := hordinary tableType + ⟨j, Nat.lt_succ_iff.mpr hj⟩ + obtain ⟨polynomial, hdegree, heval⟩ := + (sourceReedSolomonCode_mem_iff points + (F.variableCount * j) _).mp hmem + refine ⟨polynomial, hdegree, ?_⟩ + intro point + exact (heval point).trans + (sourceSignedFiberSupport_moment F points z tableType point j) + +private def sourceSignedOrdinaryMomentPolynomials + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (tableType : sourceSATTableType F) : ℕ → K[X] := by + classical + intro j + exact if hj : j ≤ momentBudget then + Classical.choose + (sourceSignedFiberSupport_moment_polynomial_of_solves F fieldBasis + points variablePlace momentBudget z hz tableType j hj) + else 0 + +private theorem sourceSignedOrdinaryMomentPolynomials_natDegree + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (tableType : sourceSATTableType F) + (j : ℕ) : + (sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz tableType j).natDegree ≤ + F.variableCount * j := by + classical + unfold sourceSignedOrdinaryMomentPolynomials + by_cases hj : j ≤ momentBudget + · rw [dite_eq_left hj] + exact (Classical.choose_spec + (sourceSignedFiberSupport_moment_polynomial_of_solves F fieldBasis + points variablePlace momentBudget z hz tableType j hj)).1 + · rw [dite_eq_right hj] + simp only [natDegree_zero, zero_le] + +private theorem sourceSignedOrdinaryMomentPolynomials_eval + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (tableType : sourceSATTableType F) + (point : sourceSATGridPoint points) + (j : ℕ) (hj : j ≤ momentBudget) : + (sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz tableType j).eval point.val = + supportMoment + (sourceSignedFiberSupport F points z tableType point) j := by + classical + unfold sourceSignedOrdinaryMomentPolynomials + rw [dite_eq_left hj] + exact (Classical.choose_spec + (sourceSignedFiberSupport_moment_polynomial_of_solves F fieldBasis + points variablePlace momentBudget z hz tableType j hj)).2 point + +private theorem sourceSigned_globalSupportMoment_zero + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (point : sourceSATGridPoint points) : + supportMoment + (sourceSignedFiberSupport F points z (.inl ()) point) 0 = + (1 : K) := by + have hchecks := + (concreteSATBinaryAffineSystem_solves_iff F fieldBasis points + variablePlace momentBudget z).mp hz + have checks := hchecks + simp only [GapCVP.Core.concreteSATFieldChecks, decide_eq_true_eq] at checks + have hnormalization := congrFun checks.1 point + change + (∑ value : K, + algebraMap (ZMod 2) K + (z (sourceSATColumnIndex F points (.inl ()) point value) : ZMod 2)) = 1 + at hnormalization + calc + supportMoment + (sourceSignedFiberSupport F points z (.inl ()) point) 0 = + sourceOrdinaryMomentMap F points (.inl ()) 0 + (fun position => algebraMap (ZMod 2) K + (z position : ZMod 2)) point := + (sourceSignedFiberSupport_moment + F points z (.inl ()) point 0).symm + _ = 1 := by + change + (∑ value : K, + algebraMap (ZMod 2) K + (z (sourceSATColumnIndex F points (.inl ()) point value) : + ZMod 2) * value ^ 0) = 1 + simpa only [List.get_eq_getElem, map_intCast, pow_zero, mul_one] using hnormalization + +private theorem sourceSigned_globalSupportMoment_eq_clauseSubtypeSum + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (clause : Fin F.clauses.length) + (point : sourceSATGridPoint points) + (j : ℕ) : + supportMoment + (sourceSignedFiberSupport F points z (.inl ()) point) j = + ∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + supportMoment + (sourceSignedFiberSupport F points z + (.inr ⟨clause, tuple⟩) point) j := by + classical + let values : Fin (sourceSATTableDimension F K points) → K := + fun position => algebraMap (ZMod 2) K (z position : ZMod 2) + have hchecks : concreteSATFieldChecks F points variablePlace + momentBudget values := + (concreteSATBinaryAffineSystem_solves_iff F fieldBasis points + variablePlace momentBudget z).mp hz + have checks := hchecks + simp only [GapCVP.Core.concreteSATFieldChecks, decide_eq_true_eq] at checks + have hrefinement : ∀ value : K, + values (sourceSATColumnIndex F points (.inl ()) point value) = + ∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + values (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value) := by + intro value + have hpoint := congrFun (checks.2.1 clause) (point, value) + change + values (sourceSATColumnIndex F points (.inl ()) point value) - + (∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + values (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value)) = 0 at hpoint + exact sub_eq_zero.mp hpoint + calc + supportMoment + (sourceSignedFiberSupport F points z (.inl ()) point) j = + sourceOrdinaryMomentMap F points (.inl ()) j values point := + (sourceSignedFiberSupport_moment + F points z (.inl ()) point j).symm + _ = ∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + sourceOrdinaryMomentMap F points (.inr ⟨clause, tuple⟩) j + values point := by + change + (∑ value : K, + values + (sourceSATColumnIndex F points (.inl ()) point value) * + value ^ j) = + ∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + ∑ value : K, + values + (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value) * value ^ j + simp_rw [hrefinement, Finset.sum_mul] + rw [Finset.sum_comm] + _ = ∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + supportMoment + (sourceSignedFiberSupport F points z + (.inr ⟨clause, tuple⟩) point) j := by + apply Finset.sum_congr rfl + intro tuple _ + exact sourceSignedFiberSupport_moment + F points z (.inr ⟨clause, tuple⟩) point j + +private theorem sourceSignedShiftedMoment_eq_fiberPowerSum + (F : Formula) (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) (point : sourceSATGridPoint points) : + sourceShiftedMomentMap F points variablePlace + clause tuple localVar j + (fun position => algebraMap (ZMod 2) K + (z position : ZMod 2)) point = + ∑ value ∈ sourceSignedFiberSupport F points z + (.inr ⟨clause, tuple⟩) point, + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j := by + classical + change + (∑ value : K, + algebraMap (ZMod 2) K + (z (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value) : ZMod 2) * + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j) = + ∑ value ∈ sourceSignedFiberSupport F points z + (.inr ⟨clause, tuple⟩) point, + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j + unfold sourceSignedFiberSupport + rw [Finset.sum_filter] + apply Finset.sum_congr rfl + intro value _ + let b : ZMod 2 := + (z (sourceSATColumnIndex F points + (.inr ⟨clause, tuple⟩) point value) : ZMod 2) + change + algebraMap (ZMod 2) K b * + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j = + if b ≠ 0 then + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j + else 0 + by_cases hb : b = 0 + · simp only [hb, map_zero, List.get_eq_getElem, zero_mul, ne_eq, not_true_eq_false, ↓reduceIte] + · have hone := sourceBinaryResidue_eq_one_of_ne_zero b hb + simp only [hone, map_one, List.get_eq_getElem, one_mul, ne_eq, one_ne_zero, not_false_eq_true, + ↓reduceIte] + +private theorem sourceSigned_exists_shiftedMomentPolynomial + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) (hj : j ≤ momentBudget) : + ∃ moment : K[X], + moment.natDegree ≤ (F.variableCount - 1) * j ∧ + ∀ point : sourceSATGridPoint points, + moment.eval point.val = + ∑ value ∈ sourceSignedFiberSupport F points z + (.inr ⟨clause, tuple⟩) point, + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j := by + have hchecks := + (concreteSATBinaryAffineSystem_solves_iff F fieldBasis points + variablePlace momentBudget z).mp hz + have checks := hchecks + simp only [GapCVP.Core.concreteSATFieldChecks, decide_eq_true_eq] at checks + have hmoment := checks.2.2.2 clause tuple localVar + (⟨j, Nat.lt_succ_iff.mpr hj⟩ : Fin (momentBudget + 1)) + obtain ⟨moment, hdegree, hvalues⟩ := + (sourceReedSolomonCode_mem_iff points + ((F.variableCount - 1) * j) _).mp hmoment + refine ⟨moment, hdegree, ?_⟩ + intro point + rw [hvalues point] + exact sourceSignedShiftedMoment_eq_fiberPowerSum + F points variablePlace z clause tuple localVar j point + +private def sourceSignedShiftedMomentPolynomials + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) : ℕ → K[X] := by + classical + intro j + exact if hj : j ≤ momentBudget then + Classical.choose + (sourceSigned_exists_shiftedMomentPolynomial + F fieldBasis points variablePlace momentBudget z hz + clause tuple localVar j hj) + else 0 + +private theorem sourceSignedShiftedMomentPolynomials_natDegree + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) : + (sourceSignedShiftedMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz clause tuple localVar j).natDegree ≤ + (F.variableCount - 1) * j := by + classical + unfold sourceSignedShiftedMomentPolynomials + split + next hj => + exact + (Classical.choose_spec + (sourceSigned_exists_shiftedMomentPolynomial + F fieldBasis points variablePlace momentBudget z hz + clause tuple localVar j hj)).1 + next _ => simp only [natDegree_zero, zero_le] + +private theorem sourceSignedShiftedMomentPolynomials_eval + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) (hj : j ≤ momentBudget) + (point : sourceSATGridPoint points) : + (sourceSignedShiftedMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz clause tuple localVar j).eval point.val = + ∑ value ∈ sourceSignedFiberSupport F points z + (.inr ⟨clause, tuple⟩) point, + ((value - sourceSATFieldBit (K := K) (tuple.val localVar)) / + (point.val - variablePlace localVar.val)) ^ j := by + classical + unfold sourceSignedShiftedMomentPolynomials + rw [dite_eq_left hj] + exact + (Classical.choose_spec + (sourceSigned_exists_shiftedMomentPolynomial + F fieldBasis points variablePlace momentBudget z hz + clause tuple localVar j hj)).2 point + +private theorem sourceSigned_shiftedMomentCombination_natDegree + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (tableType : sourceSATTableType F) + (bit : K) (j : ℕ) : + (shiftedMomentCombination + (sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz tableType) + bit j).natDegree ≤ F.variableCount * j := by + classical + have hterms : ∀ l ∈ Finset.range (j + 1), + (Polynomial.C ((j.choose l : K) * (-bit) ^ (j - l)) * + sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz tableType l).natDegree ≤ + F.variableCount * j := by + intro l hl + calc + (Polynomial.C ((j.choose l : K) * (-bit) ^ (j - l)) * + sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz tableType l).natDegree ≤ + (Polynomial.C ((j.choose l : K) * (-bit) ^ (j - l))).natDegree + + (sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz tableType l).natDegree := + Polynomial.natDegree_mul_le + _ = (sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz tableType l).natDegree := by + rw [Polynomial.natDegree_C, Nat.zero_add] + _ ≤ F.variableCount * l := + sourceSignedOrdinaryMomentPolynomials_natDegree F + fieldBasis points variablePlace momentBudget z hz tableType l + _ ≤ F.variableCount * j := + Nat.mul_le_mul_left F.variableCount + (Nat.lt_succ_iff.mp (Finset.mem_range.mp hl)) + have hmember : + shiftedMomentCombination + (sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz tableType) + bit j ∈ Polynomial.degreeLE K + (F.variableCount * j : WithBot ℕ) := by + unfold shiftedMomentCombination + apply Submodule.sum_mem + intro l hl + exact Polynomial.mem_degreeLE.mpr + (Polynomial.natDegree_le_iff_degree_le.mp (hterms l hl)) + exact Polynomial.natDegree_le_iff_degree_le.mpr + (Polynomial.mem_degreeLE.mp hmember) + +private theorem sourceSigned_scaledShiftedMoment_natDegree + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) : + (((Polynomial.X - Polynomial.C + (variablePlace localVar.val)) ^ j) * + sourceSignedShiftedMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz clause tuple localVar j).natDegree ≤ + F.variableCount * j := by + have hm : 0 < F.variableCount := + Nat.zero_lt_of_lt localVar.val.isLt + calc + (((Polynomial.X - Polynomial.C + (variablePlace localVar.val)) ^ j) * + sourceSignedShiftedMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz clause tuple localVar j).natDegree ≤ + ((Polynomial.X - Polynomial.C + (variablePlace localVar.val)) ^ j).natDegree + + (sourceSignedShiftedMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz clause tuple localVar j).natDegree := + Polynomial.natDegree_mul_le + _ = j + + (sourceSignedShiftedMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz clause tuple localVar j).natDegree := by + rw [Polynomial.natDegree_pow, Polynomial.natDegree_X_sub_C] + simp only [mul_one] + _ ≤ j + (F.variableCount - 1) * j := + Nat.add_le_add_left + (sourceSignedShiftedMomentPolynomials_natDegree F + fieldBasis points variablePlace momentBudget z hz + clause tuple localVar j) j + _ = F.variableCount * j := by + have hone : 1 ≤ F.variableCount := hm + have hdecomposition : 1 + (F.variableCount - 1) = F.variableCount := by + omega + calc + j + (F.variableCount - 1) * j = + (1 + (F.variableCount - 1)) * j := by ring + _ = F.variableCount * j := by rw [hdecomposition] + +private theorem sourceSigned_shiftedMomentPolynomial_identity + (F : Formula) + {e : ℕ} (fieldBasis : Module.Basis (Fin e) (ZMod 2) K) + (points : Finset K) + (variablePlace : Fin F.variableCount → K) + (momentBudget : ℕ) + (z : Fin (sourceSATTableDimension F K points) → ℤ) + (hz : (concreteSATBinaryAffineSystem F fieldBasis points + variablePlace momentBudget).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) (hj : j ≤ momentBudget) + (hplace : ∀ point : sourceSATGridPoint points, + point.val - variablePlace localVar.val ≠ 0) + (hgrid : F.variableCount * j < points.card) : + (Polynomial.X - Polynomial.C (variablePlace localVar.val)) ^ j * + sourceSignedShiftedMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz clause tuple localVar j = + shiftedMomentCombination + (sourceSignedOrdinaryMomentPolynomials F fieldBasis points + variablePlace momentBudget z hz (.inr ⟨clause, tuple⟩)) + (sourceSATFieldBit (K := K) (tuple.val localVar)) j := by + classical + apply polynomial_eq_of_agree_on_points points + · apply lt_of_le_of_lt (max_le + (sourceSigned_scaledShiftedMoment_natDegree F + fieldBasis points variablePlace momentBudget z hz + clause tuple localVar j) + (sourceSigned_shiftedMomentCombination_natDegree F + fieldBasis points variablePlace momentBudget z hz + (.inr ⟨clause, tuple⟩) + (sourceSATFieldBit (K := K) (tuple.val localVar)) j)) + hgrid + · intro point hpoint + let gridPoint : sourceSATGridPoint points := ⟨point, hpoint⟩ + simp only [Polynomial.eval_mul, Polynomial.eval_pow, + Polynomial.eval_sub, Polynomial.eval_X, Polynomial.eval_C] + rw [sourceSignedShiftedMomentPolynomials_eval F + fieldBasis points variablePlace momentBudget z hz clause tuple localVar + j hj gridPoint] + rw [scaled_shifted_supportMoment + (sourceSignedFiberSupport F points z + (.inr ⟨clause, tuple⟩) gridPoint) + (sourceSATFieldBit (K := K) (tuple.val localVar)) + (point - variablePlace localVar.val) j + (hplace gridPoint)] + unfold shiftedMomentCombination + simp only [Polynomial.eval_finsetSum, Polynomial.eval_mul, + Polynomial.eval_C] + apply Finset.sum_congr rfl + intro l hl + have hlbudget : l ≤ momentBudget := by + have hlj : l ≤ j := + Nat.lt_succ_iff.mp (Finset.mem_range.mp hl) + exact hlj.trans hj + rw [sourceSignedOrdinaryMomentPolynomials_eval F + fieldBasis points variablePlace momentBudget z hz + (.inr ⟨clause, tuple⟩) gridPoint l hlbudget] + +end + +section + +open Finset Polynomial + +private theorem source_variable_and_hankel_exceptions_ten_mul_le_field_size + {N q m : ℕ} + (hN : 100 ≤ N) + (hq : N ^ 200 ≤ q) + (hm : m ≤ N) : + 10 * (m + N ^ 9) ≤ q := by + have hNnine : N ≤ N ^ 9 := by + calc + N = N ^ 1 := by simp only [pow_one] + _ ≤ N ^ 9 := Nat.pow_le_pow_right (by omega) (by norm_num) + calc + 10 * (m + N ^ 9) ≤ 10 * (N ^ 9 + N ^ 9) := by + gcongr + exact hm.trans hNnine + _ = 20 * N ^ 9 := by ring + _ ≤ N * N ^ 9 := Nat.mul_le_mul_right (N ^ 9) (by omega) + _ = N ^ 10 := + (mul_comm N (N ^ 9)).trans (pow_succ N 9).symm + _ ≤ N ^ 200 := Nat.pow_le_pow_right (by omega) (by norm_num) + _ ≤ q := hq + +private theorem source_hankel_denominator_natDegree_le_power + {K : Type*} [Field K] + (moments : ℕ → K[X]) + {N d h : ℕ} + (hd : d ≤ N) + (hh : h ≤ N ^ 4) + (hmoments : ∀ j : ℕ, (moments j).natDegree ≤ d * j) : + (genericHankelDenominator h moments).natDegree ≤ N ^ 9 := by + calc + (genericHankelDenominator h moments).natDegree ≤ + d * h * (h - 1) := + genericHankelDenominator_natDegree_le_sharp moments d + (fun j _ => hmoments j) + _ ≤ N * (N ^ 4) * (N ^ 4) := by + exact Nat.mul_le_mul (Nat.mul_le_mul hd hh) (by omega) + _ = N ^ 9 := by + rw [show (9 : ℕ) = 1 + 4 + 4 by norm_num, + pow_add, pow_add, pow_one] + +end + +section + +private theorem sourceOneHotCompletenessRadius_le_two_sqrt + (F : Formula) {α : Type*} (points : Finset α) + (hpoints : 0 < points.card) : + ((sourceOneHotCompletenessRadius F points : ℚ) : ℝ) ≤ + 2 * Real.sqrt + (((F.clauses.length + 1) * points.card : ℕ) : ℝ) := by + have hweight : 0 < (F.clauses.length + 1) * points.card := + Nat.mul_pos (Nat.zero_lt_succ F.clauses.length) hpoints + have hreal : + (1 : ℝ) ≤ + (((F.clauses.length + 1) * points.card : ℕ) : ℝ) := by + exact_mod_cast hweight + have hroot : + (1 : ℝ) ≤ + Real.sqrt (((F.clauses.length + 1) * points.card : ℕ) : ℝ) := + Real.one_le_sqrt.mpr hreal + have hhalf : + (2 : ℝ)⁻¹ ≤ + Real.sqrt (((F.clauses.length + 1) * points.card : ℕ) : ℝ) := by + calc + (2 : ℝ)⁻¹ ≤ 1 := by norm_num + _ ≤ Real.sqrt + (((F.clauses.length + 1) * points.card : ℕ) : ℝ) := hroot + have hceil := Nat.ceil_le_two_mul hhalf + unfold sourceOneHotCompletenessRadius + norm_num only [Rat.cast_natCast] + exact hceil + +theorem sourceOneHotCompletenessRadius_squared_le_four_weight + (F : Formula) {α : Type*} (points : Finset α) + (hpoints : 0 < points.card) : + ((sourceOneHotCompletenessRadius F points : ℚ) : ℝ) ^ 2 ≤ + 4 * (((F.clauses.length + 1) * points.card : ℕ) : ℝ) := by + let weight : ℝ := + (((F.clauses.length + 1) * points.card : ℕ) : ℝ) + let radius : ℝ := + ((sourceOneHotCompletenessRadius F points : ℚ) : ℝ) + have hbound : radius ≤ 2 * Real.sqrt weight := + sourceOneHotCompletenessRadius_le_two_sqrt F points hpoints + have hradius : 0 ≤ radius := by + dsimp [radius] + exact_mod_cast le_of_lt + (sourceOneHotCompletenessRadius_pos F points hpoints) + have hweight : 0 ≤ weight := by + dsimp [weight] + positivity + have hroot : 0 ≤ Real.sqrt weight := Real.sqrt_nonneg weight + have hsquare : Real.sqrt weight ^ 2 = weight := + Real.sq_sqrt hweight + have hproduct : + 0 ≤ (2 * Real.sqrt weight - radius) * + (2 * Real.sqrt weight + radius) := + mul_nonneg (sub_nonneg.mpr hbound) (by positivity) + change radius ^ 2 ≤ 4 * weight + linarith + +theorem source_oneHot_weight_four_mul_le + {N q ell points : ℕ} + (hN : 100 ≤ N) + (hell : ell ≤ N) + (hpoints : points ≤ q) : + 4 * ((ell + 1) * points) ≤ 8 * q * N := by + have htypes : ell + 1 ≤ 2 * N := by omega + calc + 4 * ((ell + 1) * points) ≤ 4 * ((2 * N) * q) := by + gcongr + _ = 8 * q * N := by ring + +open scoped BigOperators + +variable {E Γ₀ : Type*} [Field E] [LinearOrderedCommMonoidWithZero Γ₀] + +/-- GapCVP reduction support. -/ +noncomputable def inverseTransposeVandermonde {h : ℕ} + (roots : Fin h → E) : Matrix (Fin h) (Fin h) E := + ((Matrix.vandermonde roots).transpose)⁻¹ + +private theorem valuation_coordinate_le_of_left_inverse + {h : ℕ} (valuation : Valuation E Γ₀) + (matrix inverse : Matrix (Fin h) (Fin h) E) + (hinverse : inverse * matrix = 1) + (bound : Γ₀) + (hentries : ∀ i j, valuation (inverse i j) ≤ bound) + (coordinates : Fin h → E) + (houtputs : ∀ i, valuation ((matrix.mulVec coordinates) i) ≤ 1) : + ∀ i, valuation (coordinates i) ≤ bound := by + classical + have hreconstruct : inverse.mulVec (matrix.mulVec coordinates) = coordinates := by + rw [Matrix.mulVec_mulVec, hinverse, Matrix.one_mulVec] + intro i + rw [← congrFun hreconstruct i] + change valuation (∑ j : Fin h, + inverse i j * (matrix.mulVec coordinates) j) ≤ bound + apply valuation.map_sum_le + intro j _ + rw [valuation.map_mul] + calc + valuation (inverse i j) * valuation ((matrix.mulVec coordinates) j) + ≤ bound * 1 := mul_le_mul' (hentries i j) (houtputs j) + _ = bound := mul_one bound + +private theorem valuation_root_power_le_of_shifted_moments + {h : ℕ} (valuation : Valuation E Γ₀) + (roots : Fin h → E) (hroots : Function.Injective roots) + (bound : Γ₀) (z : ℕ) + (hinverse : ∀ i j, + valuation (inverseTransposeVandermonde roots i j) ≤ bound) + (hmoments : ∀ r : Fin h, + valuation (∑ i : Fin h, roots i ^ (z + r.val)) ≤ 1) : + ∀ i : Fin h, valuation (roots i ^ z) ≤ bound := by + let V : Matrix (Fin h) (Fin h) E := (Matrix.vandermonde roots).transpose + have hdet : V.det ≠ 0 := by + dsimp [V] + simpa using (Matrix.det_vandermonde_ne_zero_iff.mpr hroots) + have hleft : V⁻¹ * V = 1 := + Matrix.nonsing_inv_mul V (isUnit_iff_ne_zero.mpr hdet) + apply valuation_coordinate_le_of_left_inverse valuation V V⁻¹ hleft bound + (by simpa [V, inverseTransposeVandermonde] using hinverse) + (fun i => roots i ^ z) + intro r + simpa [V, Matrix.mulVec, dotProduct, Matrix.vandermonde_apply, + ← pow_add, Nat.add_comm] using hmoments r + +theorem valuation_roots_integral_of_shifted_moments + {h : ℕ} (valuation : Valuation E Γ₀) + (roots : Fin h → E) (hroots : Function.Injective roots) + (bound : Γ₀) (z : ℕ) + (hinverse : ∀ i j, + valuation (inverseTransposeVandermonde roots i j) ≤ bound) + (hmoments : ∀ r : Fin h, + valuation (∑ i : Fin h, roots i ^ (z + r.val)) ≤ 1) + (hseparation : ∀ i : Fin h, + 1 < valuation (roots i) → bound < valuation (roots i ^ z)) : + ∀ i : Fin h, valuation (roots i) ≤ 1 := by + intro i + by_contra hnot + have hroot : 1 < valuation (roots i) := lt_of_not_ge hnot + have hbounded := valuation_root_power_le_of_shifted_moments + valuation roots hroots bound z hinverse hmoments i + exact (not_lt_of_ge hbounded) (hseparation i hroot) + +end + +section + +open scoped BigOperators +open Finset Polynomial + +private theorem valuation_matrix_det_le_pow + {E Γ₀ : Type*} [Field E] + [LinearOrderedCommGroupWithZero Γ₀] + (valuation : Valuation E Γ₀) + {h : ℕ} (matrix : Matrix (Fin h) (Fin h) E) + (bound : Γ₀) + (hentries : ∀ i j, valuation (matrix i j) ≤ bound) : + valuation matrix.det ≤ bound ^ h := by + classical + rw [Matrix.det_apply'] + apply valuation.map_sum_le + intro permutation _ + rw [valuation.map_mul] + have hsign : + valuation (((Equiv.Perm.sign permutation : ℤ) : E)) = 1 := by + rcases Int.units_eq_one_or (Equiv.Perm.sign permutation) with + hpositive | hnegative + · simp only [hpositive, Units.val_one, Int.cast_one, map_one] + · simp only [hnegative, Units.val_neg, Units.val_one, Int.reduceNeg, Int.cast_neg, + Int.cast_one, + Valuation.map_neg, map_one] + rw [hsign, one_mul] + rw [show valuation (∏ i, matrix (permutation i) i) = + ∏ i, valuation (matrix (permutation i) i) by simp only [map_prod]] + simpa only [ge_iff_le, card_univ, Fintype.card_fin] using + (Finset.prod_le_pow_card (Finset.univ : Finset (Fin h)) (fun i => valuation (matrix + (permutation i) i)) bound + (fun i _ => hentries (permutation i) i)) + +private theorem valuation_matrix_adjugate_le_pow + {E Γ₀ : Type*} [Field E] + [LinearOrderedCommGroupWithZero Γ₀] + (valuation : Valuation E Γ₀) + {h : ℕ} (matrix : Matrix (Fin h) (Fin h) E) + (bound : Γ₀) (hbound : 1 ≤ bound) + (hentries : ∀ i j, valuation (matrix i j) ≤ bound) + (i j : Fin h) : + valuation (matrix.adjugate i j) ≤ bound ^ h := by + classical + rw [Matrix.adjugate_apply] + apply valuation_matrix_det_le_pow valuation + (matrix.updateRow j (Pi.single i 1)) bound + intro row column + by_cases hrow : row = j + · subst row + by_cases hcolumn : column = i + · simp only [hcolumn, Matrix.updateRow_apply, ↓reduceIte, Pi.single_eq_same, map_one, hbound] + · simp only [Matrix.updateRow_apply, ↓reduceIte, ne_eq, hcolumn, not_false_eq_true, + Pi.single_eq_of_ne, + map_zero, zero_le] + · simpa only [Matrix.updateRow_apply, hrow, ↓reduceIte] using hentries row column + +private theorem valuation_matrix_inverse_le_det_inv_mul_pow + {E Γ₀ : Type*} [Field E] + [LinearOrderedCommGroupWithZero Γ₀] + (valuation : Valuation E Γ₀) + {h : ℕ} (matrix : Matrix (Fin h) (Fin h) E) + (bound : Γ₀) (hbound : 1 ≤ bound) + (hentries : ∀ i j, valuation (matrix i j) ≤ bound) + (i j : Fin h) : + valuation (matrix⁻¹ i j) ≤ + (valuation matrix.det)⁻¹ * bound ^ h := by + classical + rw [Matrix.inv_def] + change valuation + (Ring.inverse matrix.det * matrix.adjugate i j) ≤ + (valuation matrix.det)⁻¹ * bound ^ h + rw [Ring.inverse_eq_inv, valuation.map_mul, valuation.map_inv] + exact mul_le_mul_of_nonneg_left + (valuation_matrix_adjugate_le_pow + valuation matrix bound hbound hentries i j) zero_le + +private theorem valuation_inverseTransposeVandermonde_le_det_inv_mul_pow + {E Γ₀ : Type*} [Field E] + [LinearOrderedCommGroupWithZero Γ₀] + (valuation : Valuation E Γ₀) + {h : ℕ} (roots : Fin h → E) + (bound : Γ₀) (hbound : 1 ≤ bound) + (hentries : ∀ i j : Fin h, + valuation (roots j ^ i.val) ≤ bound) + (i j : Fin h) : + valuation (inverseTransposeVandermonde roots i j) ≤ + (valuation (Matrix.vandermonde roots).det)⁻¹ * bound ^ h := by + classical + unfold inverseTransposeVandermonde + have hmatrix := valuation_matrix_inverse_le_det_inv_mul_pow + valuation (Matrix.vandermonde roots).transpose + bound hbound (fun row column => hentries row column) i j + simpa only [ge_iff_le, Matrix.det_transpose] using hmatrix + +private theorem valuation_root_le_of_monic_coefficient_bound + {E Γ₀ : Type*} [Field E] + [LinearOrderedCommGroupWithZero Γ₀] + (valuation : Valuation E Γ₀) + {h : ℕ} (coefficients : Fin h → E) + (root : E) (bound : Γ₀) + (hbound : 1 ≤ bound) + (hcoefficients : ∀ i : Fin h, + valuation (coefficients i) ≤ bound) + (hroot : root ^ h + + ∑ i : Fin h, coefficients i * root ^ i.val = 0) : + valuation root ≤ bound := by + classical + by_cases hzero : h = 0 + · subst h + simp only [pow_zero, univ_eq_empty, sum_empty, add_zero, one_ne_zero] at hroot + · have hpositive : 0 < h := Nat.pos_of_ne_zero hzero + by_contra hnot + have hlarge : bound < valuation root := lt_of_not_ge hnot + have hrootOne : 1 < valuation root := lt_of_le_of_lt hbound hlarge + have hrootPositive : 0 < valuation root := lt_trans zero_lt_one hrootOne + have hsum : + valuation (∑ i : Fin h, coefficients i * root ^ i.val) ≤ + bound * valuation root ^ (h - 1) := by + apply valuation.map_sum_le + intro i _ + rw [valuation.map_mul, valuation.map_pow] + calc + valuation (coefficients i) * valuation root ^ i.val ≤ + bound * valuation root ^ i.val := + mul_le_mul_of_nonneg_right (hcoefficients i) zero_le + _ ≤ bound * valuation root ^ (h - 1) := by + apply mul_le_mul_of_nonneg_left _ zero_le + apply pow_le_pow_right' (le_of_lt hrootOne) + have hi := i.isLt + omega + have hleading : + valuation root ^ h ≤ bound * valuation root ^ (h - 1) := by + calc + valuation root ^ h = valuation (root ^ h) := + (valuation.map_pow root h).symm + _ = valuation (-(∑ i : Fin h, coefficients i * root ^ i.val)) := by + congr 1 + exact eq_neg_of_add_eq_zero_left hroot + _ = valuation (∑ i : Fin h, coefficients i * root ^ i.val) := + valuation.map_neg _ + _ ≤ bound * valuation root ^ (h - 1) := hsum + have hstrict : + bound * valuation root ^ (h - 1) < valuation root ^ h := by + calc + bound * valuation root ^ (h - 1) < + valuation root * valuation root ^ (h - 1) := + mul_lt_mul_of_pos_right hlarge (pow_pos hrootPositive _) + _ = valuation root ^ h := by + rw [mul_comm, ← pow_succ] + congr 1 + omega + exact (not_lt_of_ge hleading) hstrict + +private theorem scaled_shifted_rootMoment + {E : Type*} [Field E] + {h : ℕ} (roots : Fin h → E) + (hinjective : Function.Injective roots) + (bit place : E) (hplace : place ≠ 0) (j : ℕ) : + place ^ j * rootMoment + (fun i => (roots i - bit) / place) j = + ∑ l ∈ Finset.range (j + 1), + (j.choose l : E) * (-bit) ^ (j - l) * rootMoment roots l := by + classical + have hshift : + rootMoment (fun i => (roots i - bit) / place) j = + ∑ value ∈ enumeratedRootSupport roots, + ((value - bit) / place) ^ j := by + unfold rootMoment enumeratedRootSupport + symm + rw [Finset.sum_image] + intro first _ second _ hequal + exact hinjective hequal + calc + place ^ j * rootMoment (fun i => (roots i - bit) / place) j = + place ^ j * + (∑ value ∈ enumeratedRootSupport roots, + ((value - bit) / place) ^ j) := by rw [hshift] + _ = ∑ l ∈ Finset.range (j + 1), + (j.choose l : E) * (-bit) ^ (j - l) * + supportMoment (enumeratedRootSupport roots) l := + scaled_shifted_supportMoment + (enumeratedRootSupport roots) bit place j hplace + _ = ∑ l ∈ Finset.range (j + 1), + (j.choose l : E) * (-bit) ^ (j - l) * rootMoment roots l := by + apply Finset.sum_congr rfl + intro l _ + rw [supportMoment_enumeratedRootSupport roots hinjective l] + +private theorem map_shiftedMomentCombination_eq_rootMomentCombination + {k E : Type*} [Field k] [Field E] + [Algebra k E] [Algebra k[X] E] [IsScalarTower k k[X] E] + (moments : ℕ → k[X]) (bit : k) (j : ℕ) + {h : ℕ} (roots : Fin h → E) + (hmoments : ∀ l : ℕ, l ≤ j → + algebraMap k[X] E (moments l) = rootMoment roots l) : + algebraMap k[X] E (shiftedMomentCombination moments bit j) = + ∑ l ∈ Finset.range (j + 1), + (j.choose l : E) * (-(algebraMap k E bit)) ^ (j - l) * + rootMoment roots l := by + classical + have hbit : + algebraMap k[X] E (Polynomial.C bit) = algebraMap k E bit := by + change algebraMap k[X] E (algebraMap k k[X] bit) = algebraMap k E bit + exact (IsScalarTower.algebraMap_apply k k[X] E bit).symm + unfold shiftedMomentCombination + simp only [map_sum, map_mul, map_pow] + apply Finset.sum_congr rfl + intro l hl + have hlj : l ≤ j := Nat.lt_succ_iff.mp (Finset.mem_range.mp hl) + rw [hmoments l hlj] + simp only [map_natCast, map_neg, hbit] + +private theorem shiftedGenericRootMoment_eq_mappedShiftedPolynomial + {k E : Type*} [Field k] [Field E] + [Algebra k E] [Algebra k[X] E] [IsScalarTower k k[X] E] + (moments : ℕ → k[X]) (shifted : k[X]) + (variablePlace bit : k) (j : ℕ) + {h : ℕ} (roots : Fin h → E) + (hinjective : Function.Injective roots) + (hplace : + algebraMap k[X] E (Polynomial.X - Polynomial.C variablePlace) ≠ 0) + (hmoments : ∀ l : ℕ, l ≤ j → + algebraMap k[X] E (moments l) = rootMoment roots l) + (hpolynomial : + (Polynomial.X - Polynomial.C variablePlace) ^ j * shifted = + shiftedMomentCombination moments bit j) : + rootMoment + (fun i => + (roots i - algebraMap k E bit) / + algebraMap k[X] E + (Polynomial.X - Polynomial.C variablePlace)) j = + algebraMap k[X] E shifted := by + classical + let place : E := + algebraMap k[X] E (Polynomial.X - Polynomial.C variablePlace) + have hscaled := scaled_shifted_rootMoment roots hinjective + (algebraMap k E bit) place hplace j + have hcombination := + map_shiftedMomentCombination_eq_rootMomentCombination + moments bit j roots hmoments + have hmap := congrArg (algebraMap k[X] E) hpolynomial + have hequality : + place ^ j * rootMoment + (fun i => (roots i - algebraMap k E bit) / place) j = + place ^ j * algebraMap k[X] E shifted := by + calc + place ^ j * rootMoment + (fun i => (roots i - algebraMap k E bit) / place) j = + ∑ l ∈ Finset.range (j + 1), + (j.choose l : E) * (-(algebraMap k E bit)) ^ (j - l) * + rootMoment roots l := hscaled + _ = algebraMap k[X] E + (shiftedMomentCombination moments bit j) := hcombination.symm + _ = place ^ j * algebraMap k[X] E shifted := by + symm + simpa only [map_sub, map_mul, map_pow, place] using hmap + exact mul_left_cancel₀ (pow_ne_zero j hplace) hequality + +end + +section + +open scoped BigOperators symmDiff +open Polynomial Finset + +private theorem genericMomentSupportPolynomial_natDegree + {K : Type*} [Field K] + (h : ℕ) (moments : ℕ → K[X]) : + (genericMomentSupportPolynomial h moments).natDegree = h := by + unfold genericMomentSupportPolynomial + apply Polynomial.natDegree_eq_of_degree_eq_some + calc + (Polynomial.X ^ h + + ∑ i : Fin h, + Polynomial.C (genericHankelCoefficient h moments i) * + Polynomial.X ^ i.val).degree = + (Polynomial.X ^ h : (RatFunc K)[X]).degree := by + apply Polynomial.degree_add_eq_left_of_degree_lt + rw [Polynomial.degree_X_pow] + exact Polynomial.degree_sum_fin_lt + (fun i : Fin h => genericHankelCoefficient h moments i) + _ = h := Polynomial.degree_X_pow h + +private theorem rootSupportPolynomial_finiteSupportRoots + {K : Type*} [Field K] + (support : Finset K) : + rootSupportPolynomial (finiteSupportRoots support) = + ∏ root ∈ support, (Polynomial.X - Polynomial.C root) := by + classical + unfold rootSupportPolynomial finiteSupportRoots + calc + (∏ index : Fin support.card, + (Polynomial.X - + Polynomial.C ((Finset.equivFin support).symm index : K))) = + ∏ root : support, + (Polynomial.X - Polynomial.C (root : K)) := + Equiv.prod_comp (Finset.equivFin support).symm + (fun root : support => Polynomial.X - Polynomial.C (root : K)) + _ = ∏ root ∈ support, (Polynomial.X - Polynomial.C root) := + (Finset.prod_subtype support (fun _ => Iff.rfl) + (fun root : K => Polynomial.X - Polynomial.C root)).symm + +private theorem exists_injective_roots_of_monic_separable_splits + {K : Type*} [Field K] + (polynomial : K[X]) + (hmonic : polynomial.Monic) + (hseparable : polynomial.Separable) + (hsplits : polynomial.Splits) : + ∃ roots : Fin polynomial.natDegree → K, + Function.Injective roots ∧ + polynomial = rootSupportPolynomial roots := by + classical + let support : Finset K := polynomial.roots.toFinset + have hcard : support.card = polynomial.natDegree := by + dsimp [support] + rw [Multiset.toFinset_card_of_nodup + (Polynomial.nodup_roots hseparable)] + exact hsplits.natDegree_eq_card_roots.symm + let roots : Fin polynomial.natDegree → K := + fun index => finiteSupportRoots support ((finCongr hcard.symm) index) + refine ⟨roots, ?_, ?_⟩ + · intro i j hij + apply (finCongr hcard.symm).injective + apply finiteSupportRoots_injective support + exact hij + · have hproduct : + rootSupportPolynomial roots = + ∏ root ∈ support, (Polynomial.X - Polynomial.C root) := by + unfold rootSupportPolynomial + dsimp [roots] + calc + (∏ index : Fin polynomial.natDegree, + (Polynomial.X - + Polynomial.C + (finiteSupportRoots support + ((finCongr hcard.symm) index)))) = + ∏ index : Fin support.card, + (Polynomial.X - + Polynomial.C (finiteSupportRoots support index)) := + Equiv.prod_comp (finCongr hcard.symm) + (fun index : Fin support.card => + Polynomial.X - Polynomial.C (finiteSupportRoots support index)) + _ = rootSupportPolynomial (finiteSupportRoots support) := rfl + _ = ∏ root ∈ support, (Polynomial.X - Polynomial.C root) := + rootSupportPolynomial_finiteSupportRoots support + rw [hproduct] + calc + polynomial = + (polynomial.roots.map + (fun root : K => + Polynomial.X - Polynomial.C root)).prod := + hsplits.eq_prod_roots_of_monic hmonic + _ = ∏ root ∈ support, + (Polynomial.X - Polynomial.C root) := by + change + (polynomial.roots.map + (fun root : K => + Polynomial.X - Polynomial.C root)).prod = + (polynomial.roots.toFinset.val.map + (fun root : K => + Polynomial.X - Polynomial.C root)).prod + rw [Multiset.toFinset_val, + Multiset.dedup_eq_self.mpr + (Polynomial.nodup_roots hseparable)] + +theorem mem_enumeratedRootSupport_iff + {E : Type*} {h : ℕ} + (roots : Fin h → E) (value : E) : + value ∈ enumeratedRootSupport roots ↔ + ∃ index : Fin h, roots index = value := by + classical + simp only [enumeratedRootSupport, mem_image, mem_univ, true_and] + +private theorem sourceParitySupport_card_le + {K : Type*} [DecidableEq K] (supports : List (Finset K)) : + (paritySupport supports).card ≤ (supports.map Finset.card).sum := by + induction supports with + | nil => simp only [paritySupport, card_empty, List.map_nil, List.sum_nil, Std.le_refl] + | cons support remaining ih => + change (support ∆ paritySupport remaining).card ≤ + support.card + (remaining.map Finset.card).sum + calc + (support ∆ paritySupport remaining).card ≤ + (support ∪ paritySupport remaining).card := + Finset.card_le_card + (Finset.symmDiff_subset_union + (s := support) (t := paritySupport remaining)) + _ ≤ support.card + (paritySupport remaining).card := + Finset.card_union_le support (paritySupport remaining) + _ ≤ support.card + (remaining.map Finset.card).sum := + Nat.add_le_add_left ih support.card + +private theorem genericRoot_mem_subtype_of_characteristicTwo_moments + {E : Type*} [Field E] [CharP E 2] {h : ℕ} + (globalRoots : Fin h → E) + (hinjective : Function.Injective globalRoots) + (subtypes : List (Finset E)) + (momentBudget : ℕ) + (hbudget : h + (subtypes.map Finset.card).sum ≤ momentBudget) + (hmoments : ∀ j : ℕ, j < momentBudget → + rootMoment globalRoots j = + (subtypes.map fun subtype => supportMoment subtype j).sum) + (index : Fin h) : + ∃ subtype ∈ subtypes, globalRoots index ∈ subtype := by + classical + apply global_root_mem_subtype_of_moment_refinement + (enumeratedRootSupport globalRoots) subtypes + · intro j hj + rw [supportMoment_enumeratedRootSupport globalRoots hinjective] + apply hmoments j + have hcard : + (enumeratedRootSupport globalRoots).card + + (paritySupport subtypes).card ≤ momentBudget := by + rw [enumeratedRootSupport_card globalRoots hinjective] + exact (Nat.add_le_add_left + (sourceParitySupport_card_le subtypes) h).trans hbudget + exact lt_of_lt_of_le hj hcard + · simp only [enumeratedRootSupport, mem_image, mem_univ, true_and, exists_apply_eq_apply] + +end + +section + +open scoped BigOperators +open Polynomial Finset + +variable {K E : Type*} [Field K] [Field E] +variable [Algebra (RatFunc K) E] [Algebra K[X] E] +variable [IsScalarTower K[X] (RatFunc K) E] +variable [FiniteDimensional (RatFunc K) E] +variable [Algebra.IsSeparable (RatFunc K) E] + +private theorem functionFieldExtendedValuation_ratFunc_eq_place_zpow + (a : K) (f : RatFunc K) (hf : f ≠ 0) : + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap (RatFunc K) E f) = + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ + ((f.num.rootMultiplicity a : ℤ) - + (f.denom.rootMultiplicity a : ℤ)) := by + let valuation := functionFieldExtendedValuation (K := K) (E := E) a + let place := algebraMap K[X] E (X - C a) + have hplace : place ≠ 0 := by + apply (map_ne_zero_iff (algebraMap K[X] E) + (functionFieldPolynomial_algebraMap_injective + (K := K) (E := E))).mpr + exact Polynomial.X_sub_C_ne_zero a + have hplaceval : valuation place ≠ 0 := + (Valuation.ne_zero_iff valuation).mpr hplace + have hrat : + algebraMap (RatFunc K) E f = + algebraMap K[X] E f.num / + algebraMap K[X] E f.denom := by + calc + algebraMap (RatFunc K) E f = + algebraMap (RatFunc K) E + (algebraMap K[X] (RatFunc K) f.num / + algebraMap K[X] (RatFunc K) f.denom) := + congrArg (algebraMap (RatFunc K) E) + (RatFunc.num_div_denom f).symm + _ = algebraMap K[X] E f.num / + algebraMap K[X] E f.denom := by + rw [map_div₀, + ← IsScalarTower.algebraMap_apply K[X] (RatFunc K) E f.num, + ← IsScalarTower.algebraMap_apply K[X] (RatFunc K) E f.denom] + calc + valuation (algebraMap (RatFunc K) E f) = + valuation + (algebraMap K[X] E f.num / + algebraMap K[X] E f.denom) := congrArg valuation hrat + _ = valuation (algebraMap K[X] E f.num) / + valuation (algebraMap K[X] E f.denom) := + valuation.map_div _ _ + _ = valuation place ^ f.num.rootMultiplicity a / + valuation place ^ f.denom.rootMultiplicity a := by + rw [functionFieldExtendedValuation_polynomial_eq_place_pow + (E := E) a f.num (RatFunc.num_ne_zero hf)] + rw [functionFieldExtendedValuation_polynomial_eq_place_pow + (E := E) a f.denom (RatFunc.denom_ne_zero f)] + _ = valuation place ^ + ((f.num.rootMultiplicity a : ℤ) - + (f.denom.rootMultiplicity a : ℤ)) := + (zpow_natCast_sub_natCast₀ hplaceval + (f.num.rootMultiplicity a) + (f.denom.rootMultiplicity a)).symm + +private theorem discrete_place_root_term_valuations_ne + (place root : WithZero (Multiplicative ℤ)) + (hplace : 0 < place) (hplacelt : place < 1) + (hroot : 1 < root) + {degree i j : ℕ} + (hi : i ≤ degree) (hj : j ≤ degree) + (hsmall : root ^ degree < place⁻¹) + (firstExponent secondExponent : ℤ) + (hindex : i ≠ j) : + place ^ firstExponent * root ^ i ≠ + place ^ secondExponent * root ^ j := by + have hplacezero : place ≠ 0 := ne_of_gt hplace + have hrootzero : root ≠ 0 := + ne_of_gt (lt_trans zero_lt_one hroot) + have hplacelog : WithZero.log place < 0 := by + have h := (WithZero.log_lt_log hplacezero + (one_ne_zero : + (1 : WithZero (Multiplicative ℤ)) ≠ 0)).mpr hplacelt + simpa only [gt_iff_lt, WithZero.log_one] using h + have hrootlog : 0 < WithZero.log root := by + have h := (WithZero.log_lt_log + (one_ne_zero : + (1 : WithZero (Multiplicative ℤ)) ≠ 0) + hrootzero).mpr hroot + simpa only [gt_iff_lt, WithZero.log_one] using h + have hpowerlog : + (degree : ℤ) * WithZero.log root < + -WithZero.log place := by + have h := (WithZero.log_lt_log + (pow_ne_zero degree hrootzero) + (inv_ne_zero hplacezero)).mpr hsmall + simpa only [gt_iff_lt, WithZero.log_pow, Int.nsmul_eq_mul, WithZero.log_inv] using h + intro hequal + have hlog := congrArg WithZero.log hequal + have hfirst : place ^ firstExponent ≠ 0 := + zpow_ne_zero firstExponent hplacezero + have hsecond : place ^ secondExponent ≠ 0 := + zpow_ne_zero secondExponent hplacezero + have hrooti : root ^ i ≠ 0 := pow_ne_zero i hrootzero + have hrootj : root ^ j ≠ 0 := pow_ne_zero j hrootzero + rw [WithZero.log_mul hfirst hrooti, + WithZero.log_mul hsecond hrootj, + WithZero.log_zpow, WithZero.log_zpow, + WithZero.log_pow, WithZero.log_pow] at hlog + simp only [zsmul_eq_mul, nsmul_eq_mul, Int.cast_id] at hlog + have hdivides : + -WithZero.log place ∣ + ((i : ℤ) - (j : ℤ)) * WithZero.log root := by + refine ⟨firstExponent - secondExponent, ?_⟩ + linear_combination hlog + have hindexBound : + |(i : ℤ) - (j : ℤ)| ≤ (degree : ℤ) := by + apply (abs_le).mpr + constructor <;> omega + have habs : + |((i : ℤ) - (j : ℤ)) * WithZero.log root| < + -WithZero.log place := by + calc + |((i : ℤ) - (j : ℤ)) * WithZero.log root| = + |(i : ℤ) - (j : ℤ)| * |WithZero.log root| := abs_mul _ _ + _ = |(i : ℤ) - (j : ℤ)| * WithZero.log root := by + rw [abs_of_pos hrootlog] + _ ≤ (degree : ℤ) * WithZero.log root := + mul_le_mul_of_nonneg_right hindexBound (le_of_lt hrootlog) + _ < -WithZero.log place := hpowerlog + have hzero : + ((i : ℤ) - (j : ℤ)) * WithZero.log root = 0 := + Int.eq_zero_of_abs_lt_dvd hdivides habs + have heq : (i : ℤ) = (j : ℤ) := by + rcases mul_eq_zero.mp hzero with h | h + · omega + · exact False.elim ((ne_of_gt hrootlog) h) + apply hindex + exact_mod_cast heq + +private theorem valuation_finset_sum_ne_zero_of_distinct + {L Γ₀ ι : Type*} [Field L] + [LinearOrderedCommGroupWithZero Γ₀] + (valuation : Valuation L Γ₀) + (indices : Finset ι) + (terms : ι → L) + (hnonempty : indices.Nonempty) + (hnonzero : ∀ i ∈ indices, terms i ≠ 0) + (hdistinct : + ∀ i ∈ indices, ∀ j ∈ indices, + i ≠ j → valuation (terms i) ≠ valuation (terms j)) : + ∑ i ∈ indices, terms i ≠ 0 := by + classical + obtain ⟨maxIndex, hmaxIndex, hmax⟩ := + Finset.exists_max_image indices + (fun i => valuation (terms i)) hnonempty + have hstrict : ∀ i ∈ indices \ {maxIndex}, + valuation (terms i) < valuation (terms maxIndex) := by + intro i hi + have himem : i ∈ indices := (Finset.mem_sdiff.mp hi).1 + have hine : i ≠ maxIndex := by + intro hequal + subst i + exact (Finset.mem_sdiff.mp hi).2 (Finset.mem_singleton_self _) + exact lt_of_le_of_ne (hmax i himem) + (hdistinct i himem maxIndex hmaxIndex hine) + have hvaluation := valuation.map_sum_eq_of_lt hmaxIndex hstrict + intro hsum + rw [hsum, valuation.map_zero] at hvaluation + exact ((Valuation.ne_zero_iff valuation).mpr + (hnonzero maxIndex hmaxIndex)) hvaluation.symm + +private theorem functionFieldExtendedValuation_monic_root_separation + (a : K) (polynomial : (RatFunc K)[X]) + (hmonic : polynomial.Monic) + (root : E) + (hroot : + polynomial.eval₂ (algebraMap (RatFunc K) E) root = 0) + (hlarge : + 1 < functionFieldExtendedValuation (K := K) (E := E) a root) : + (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (Polynomial.X - Polynomial.C a)))⁻¹ ≤ + (functionFieldExtendedValuation (K := K) (E := E) a root) ^ + polynomial.natDegree := by + classical + let valuation := functionFieldExtendedValuation (K := K) (E := E) a + let place := algebraMap K[X] E (Polynomial.X - Polynomial.C a) + have hplace : place ≠ 0 := by + apply (map_ne_zero_iff (algebraMap K[X] E) + (functionFieldPolynomial_algebraMap_injective + (K := K) (E := E))).mpr + exact Polynomial.X_sub_C_ne_zero a + have hplacePositive : 0 < valuation place := + (Valuation.pos_iff valuation).mpr hplace + have hplaceLess : valuation place < 1 := + functionFieldExtendedValuation_place_lt_one + (K := K) (E := E) a + have hrootLarge : 1 < valuation root := hlarge + have hrootNonzero : root ≠ 0 := by + intro hzero + rw [hzero, valuation.map_zero] at hrootLarge + exact (not_lt_of_ge zero_le) hrootLarge + change (valuation place)⁻¹ ≤ valuation root ^ polynomial.natDegree + by_contra hnot + have hsmall : + valuation root ^ polynomial.natDegree < (valuation place)⁻¹ := + lt_of_not_ge hnot + let terms : ℕ → E := fun index => + algebraMap (RatFunc K) E (polynomial.coeff index) * root ^ index + have hsupport : polynomial.support.Nonempty := + Polynomial.nonempty_support_iff.mpr hmonic.ne_zero + have hterms : + ∀ index ∈ polynomial.support, terms index ≠ 0 := by + intro index hindex + dsimp [terms] + apply mul_ne_zero + · exact + (map_ne_zero_iff (algebraMap (RatFunc K) E) + (algebraMap (RatFunc K) E).injective).mpr + (Polynomial.mem_support_iff.mp hindex) + · exact pow_ne_zero index hrootNonzero + have hdistinct : + ∀ i ∈ polynomial.support, ∀ j ∈ polynomial.support, + i ≠ j → valuation (terms i) ≠ valuation (terms j) := by + intro i hi j hj hne + have hicoeff : polynomial.coeff i ≠ 0 := + Polynomial.mem_support_iff.mp hi + have hjcoeff : polynomial.coeff j ≠ 0 := + Polynomial.mem_support_iff.mp hj + have hile : i ≤ polynomial.natDegree := + Polynomial.le_natDegree_of_mem_supp i hi + have hjle : j ≤ polynomial.natDegree := + Polynomial.le_natDegree_of_mem_supp j hj + dsimp [terms] + rw [valuation.map_mul, valuation.map_mul, + valuation.map_pow, valuation.map_pow] + change + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap (RatFunc K) E (polynomial.coeff i)) * + valuation root ^ i ≠ + functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap (RatFunc K) E (polynomial.coeff j)) * + valuation root ^ j + rw [functionFieldExtendedValuation_ratFunc_eq_place_zpow + (E := E) a (polynomial.coeff i) hicoeff] + rw [functionFieldExtendedValuation_ratFunc_eq_place_zpow + (E := E) a (polynomial.coeff j) hjcoeff] + exact discrete_place_root_term_valuations_ne + (valuation place) (valuation root) + hplacePositive hplaceLess hrootLarge hile hjle hsmall + (((polynomial.coeff i).num.rootMultiplicity a : ℤ) - + ((polynomial.coeff i).denom.rootMultiplicity a : ℤ)) + (((polynomial.coeff j).num.rootMultiplicity a : ℤ) - + ((polynomial.coeff j).denom.rootMultiplicity a : ℤ)) + hne + have hsum : + (∑ index ∈ polynomial.support, terms index) ≠ 0 := + valuation_finset_sum_ne_zero_of_distinct + valuation polynomial.support terms hsupport hterms hdistinct + apply hsum + have heval := hroot + rw [Polynomial.eval₂_eq_sum, Polynomial.sum_def] at heval + simpa only using heval + +private def normalizedAffineRootPolynomial + {k : Type*} [Field k] + (polynomial : k[X]) (place bit : k) : k[X] := + (polynomial.comp (Polynomial.X + Polynomial.C bit)).scaleRoots place⁻¹ + +private theorem normalizedAffineRootPolynomial_monic + {k : Type*} [Field k] + (polynomial : k[X]) (hmonic : polynomial.Monic) + (place bit : k) : + (normalizedAffineRootPolynomial polynomial place bit).Monic := by + unfold normalizedAffineRootPolynomial + apply (Polynomial.monic_scaleRoots_iff place⁻¹).mpr + apply hmonic.comp (Polynomial.monic_X_add_C bit) + rw [Polynomial.natDegree_X_add_C] + exact one_ne_zero + +private theorem normalizedAffineRootPolynomial_natDegree + {k : Type*} [Field k] + (polynomial : k[X]) (place bit : k) : + (normalizedAffineRootPolynomial polynomial place bit).natDegree = + polynomial.natDegree := by + unfold normalizedAffineRootPolynomial + rw [Polynomial.natDegree_scaleRoots, + Polynomial.natDegree_comp, + Polynomial.natDegree_X_add_C, mul_one] + +private theorem normalizedAffineRootPolynomial_eval₂_eq_zero + {k E : Type*} [Field k] [Field E] + (polynomial : k[X]) (place bit : k) + (root : E) (map : k →+* E) + (hroot : polynomial.eval₂ map root = 0) : + (normalizedAffineRootPolynomial polynomial place bit).eval₂ + map ((root - map bit) / map place) = 0 := by + have htranslated : + (polynomial.comp + (Polynomial.X + Polynomial.C bit)).eval₂ + map (root - map bit) = 0 := by + rw [Polynomial.eval₂_comp] + simpa only [eval₂_add, eval₂_X, eval₂_C, sub_add_cancel] using hroot + have hscaled := + Polynomial.scaleRoots_eval₂_eq_zero + (p := polynomial.comp (Polynomial.X + Polynomial.C bit)) + map (s := place⁻¹) htranslated + simpa only [div_eq_inv_mul, normalizedAffineRootPolynomial, map_inv₀] using hscaled + +private theorem valuation_highPower_separation_of_place_inverse_le + {E Γ₀ : Type*} [Field E] + [LinearOrderedCommGroupWithZero Γ₀] + (valuation : Valuation E Γ₀) + (place root : E) + (rank exponent : ℕ) + (hlarge : 1 < valuation root) + (hseparation : (valuation place)⁻¹ ≤ valuation root ^ rank) : + (valuation place ^ exponent)⁻¹ < + valuation (root ^ (rank * exponent + 1)) := by + have hpositive : 0 < valuation root := + lt_trans zero_lt_one hlarge + rw [valuation.map_pow] + calc + (valuation place ^ exponent)⁻¹ = + ((valuation place)⁻¹) ^ exponent := by rw [inv_pow] + _ ≤ (valuation root ^ rank) ^ exponent := + pow_le_pow_left' hseparation exponent + _ < (valuation root ^ rank) ^ exponent * valuation root := by + have hpow : 0 < (valuation root ^ rank) ^ exponent := + pow_pos (pow_pos hpositive _) _ + simpa only [gt_iff_lt, mul_one] using mul_lt_mul_of_pos_left hlarge hpow + _ = valuation root ^ (rank * exponent + 1) := by + rw [pow_succ, pow_mul] + +end + +section + +open scoped BigOperators +open Polynomial Finset Matrix + +private theorem genericHankelDenominator_map_eq_vandermonde_det_sq + {K E : Type*} [Field K] [Field E] [Algebra K[X] E] + {h : ℕ} (moments : ℕ → K[X]) (roots : Fin h → E) + (hmoments : ∀ j : ℕ, j < 2 * h → + algebraMap K[X] E (moments j) = rootMoment roots j) : + algebraMap K[X] E (genericHankelDenominator h moments) = + (Matrix.vandermonde roots).det ^ 2 := by + classical + calc + algebraMap K[X] E (genericHankelDenominator h moments) = + ((polynomialHankel moments h).map (algebraMap K[X] E)).det := by + simpa only [genericHankelDenominator, leadingHankelDet, RingHom.mapMatrix_apply] using + ((algebraMap K[X] E).map_det (polynomialHankel moments h)) + _ = (powerSumHankel roots).det := by + congr 1 + ext i j + exact hmoments (i.val + j.val) (by omega) + _ = (Matrix.vandermonde roots).det ^ 2 := + powerSumHankel_det_eq_vandermonde_det_sq roots + +private theorem vandermonde_shifted_det_mul_place_pow + {E : Type*} [Field E] {h : ℕ} + (roots : Fin h → E) (bit place : E) (hplace : place ≠ 0) : + (Matrix.vandermonde + (fun i : Fin h => (roots i - bit) / place)).det * + place ^ (∑ i : Fin h, i.val) = + (Matrix.vandermonde roots).det := by + classical + have hmatrix : + Matrix.vandermonde (fun i : Fin h => (roots i - bit) / place) * + Matrix.diagonal (fun i : Fin h => place ^ i.val) = + Matrix.vandermonde (fun i : Fin h => roots i - bit) := by + ext i j + rw [Matrix.mul_diagonal, Matrix.vandermonde_apply, + Matrix.vandermonde_apply, div_pow] + exact div_mul_cancel₀ _ (pow_ne_zero _ hplace) + have hdet := congrArg Matrix.det hmatrix + rw [Matrix.det_mul, Matrix.det_diagonal, + Matrix.det_vandermonde_sub] at hdet + simpa only [prod_pow_eq_pow_sum] using hdet + +private theorem vandermonde_shifted_det_sq_mul_place_pow + {E : Type*} [Field E] {h : ℕ} + (roots : Fin h → E) (bit place : E) (hplace : place ≠ 0) : + (Matrix.vandermonde + (fun i : Fin h => (roots i - bit) / place)).det ^ 2 * + place ^ (h * (h - 1)) = + (Matrix.vandermonde roots).det ^ 2 := by + classical + have hsum : (∑ i : Fin h, i.val) * 2 = h * (h - 1) := by + rw [Fin.sum_univ_eq_sum_range (fun i : ℕ => i) h] + exact Finset.sum_range_id_mul_two h + have hdet := congrArg (fun x : E => x ^ 2) + (vandermonde_shifted_det_mul_place_pow roots bit place hplace) + rw [mul_pow, ← pow_mul, hsum] at hdet + exact hdet + +theorem functionFieldExtendedValuation_shiftedVandermonde_det_inv_le_place_inv_pow + {K E : Type*} [Field K] [Field E] + [Algebra (RatFunc K) E] [Algebra K[X] E] + [IsScalarTower K[X] (RatFunc K) E] + [FiniteDimensional (RatFunc K) E] + [Algebra.IsSeparable (RatFunc K) E] + (a : K) (moments : ℕ → K[X]) (d : ℕ) {h : ℕ} + (roots : Fin h → E) (bit : E) + (hmoments : ∀ j : ℕ, j < 2 * h → + algebraMap K[X] E (moments j) = rootMoment roots j) + (hdegrees : ∀ j : ℕ, (moments j).natDegree ≤ d * j) + (hdenominator : genericHankelDenominator h moments ≠ 0) : + (functionFieldExtendedValuation (K := K) (E := E) a + ((Matrix.vandermonde (fun i : Fin h => + (roots i - bit) / + algebraMap K[X] E (X - C a))).det))⁻¹ ≤ + (functionFieldExtendedValuation (K := K) (E := E) a + (algebraMap K[X] E (X - C a)) ^ (d * h * h))⁻¹ := by + classical + let valuation := functionFieldExtendedValuation (K := K) (E := E) a + let place : E := algebraMap K[X] E (X - C a) + have hplace : place ≠ 0 := by + exact (map_ne_zero_iff (algebraMap K[X] E) + (functionFieldPolynomial_algebraMap_injective + (K := K) (E := E))).mpr (Polynomial.X_sub_C_ne_zero a) + have hplacePositive : 0 < valuation place := + (Valuation.pos_iff valuation).mpr hplace + have hplaceLeOne : valuation place ≤ 1 := by + exact le_of_lt + (functionFieldExtendedValuation_place_lt_one + (K := K) (E := E) a) + let shiftedRoots : Fin h → E := + fun i => (roots i - bit) / place + have hdetIdentity : + valuation ((Matrix.vandermonde shiftedRoots).det) ^ 2 * + valuation place ^ (h * (h - 1)) = + valuation (algebraMap K[X] E + (genericHankelDenominator h moments)) := by + calc + valuation ((Matrix.vandermonde shiftedRoots).det) ^ 2 * + valuation place ^ (h * (h - 1)) = + valuation + ((Matrix.vandermonde shiftedRoots).det ^ 2 * + place ^ (h * (h - 1))) := by + rw [valuation.map_mul, valuation.map_pow, + valuation.map_pow] + _ = valuation ((Matrix.vandermonde roots).det ^ 2) := by + congr 1 + exact vandermonde_shifted_det_sq_mul_place_pow + roots bit place hplace + _ = valuation (algebraMap K[X] E + (genericHankelDenominator h moments)) := by + congr 1 + exact + (genericHankelDenominator_map_eq_vandermonde_det_sq + moments roots hmoments).symm + have hdenominatorLower : + valuation place ^ (d * h * (h - 1)) ≤ + valuation (algebraMap K[X] E + (genericHankelDenominator h moments)) := + functionFieldExtendedValuation_genericHankelDenominator_place_pow_le + (E := E) a moments d h hdegrees hdenominator + have hdenominatorUpper : + valuation (algebraMap K[X] E + (genericHankelDenominator h moments)) ≤ + valuation ((Matrix.vandermonde shiftedRoots).det) ^ 2 := by + calc + valuation (algebraMap K[X] E + (genericHankelDenominator h moments)) = + valuation ((Matrix.vandermonde shiftedRoots).det) ^ 2 * + valuation place ^ (h * (h - 1)) := hdetIdentity.symm + _ ≤ valuation ((Matrix.vandermonde shiftedRoots).det) ^ 2 * 1 := + mul_le_mul_of_nonneg_left + (pow_le_one₀ zero_le hplaceLeOne) zero_le + _ = valuation ((Matrix.vandermonde shiftedRoots).det) ^ 2 := + mul_one _ + have hexponents : d * h * (h - 1) ≤ 2 * (d * h * h) := by + calc + d * h * (h - 1) ≤ d * h * h := + Nat.mul_le_mul_left (d * h) (Nat.sub_le h 1) + _ ≤ 2 * (d * h * h) := by omega + have hsquares : + (valuation place ^ (d * h * h)) ^ 2 ≤ + valuation ((Matrix.vandermonde shiftedRoots).det) ^ 2 := by + calc + (valuation place ^ (d * h * h)) ^ 2 = + valuation place ^ (2 * (d * h * h)) := by + rw [← pow_mul] + simp only [Nat.mul_comm] + _ ≤ valuation place ^ (d * h * (h - 1)) := + pow_le_pow_of_le_one zero_le hplaceLeOne hexponents + _ ≤ valuation (algebraMap K[X] E + (genericHankelDenominator h moments)) := hdenominatorLower + _ ≤ valuation ((Matrix.vandermonde shiftedRoots).det) ^ 2 := + hdenominatorUpper + have hdetLower : + valuation place ^ (d * h * h) ≤ + valuation ((Matrix.vandermonde shiftedRoots).det) := + (sq_le_sq₀ zero_le zero_le).mp hsquares + change (valuation ((Matrix.vandermonde shiftedRoots).det))⁻¹ ≤ + (valuation place ^ (d * h * h))⁻¹ + exact inv_anti₀ (pow_pos hplacePositive _) hdetLower + +end + +section + +variable {E Γ₀ : Type*} [Field E] [LinearOrderedCommMonoidWithZero Γ₀] + +/-- GapCVP reduction support. -/ +def bitInField (b : Bool) : E := if b then 1 else 0 + +private theorem valuation_bits_unique (v : Valuation E Γ₀) (a : E) + {b₁ b₂ : Bool} + (h₁ : v (a - bitInField (E := E) b₁) < 1) + (h₂ : v (a - bitInField (E := E) b₂) < 1) : b₁ = b₂ := by + cases b₁ <;> cases b₂ + · rfl + · simp only [bitInField, Bool.false_eq_true, ↓reduceIte, + sub_zero] at h₁ h₂ + have hneg : v (-(a - 1)) < 1 := by + rw [v.map_neg] + exact h₂ + have h : v (a - (a - 1)) < 1 := by + simpa only [sub_eq_add_neg, neg_add_rev, neg_neg, add_neg_cancel_comm_assoc, map_one, + lt_self_iff_false] using + v.map_add_lt h₁ hneg + have hunit : a - (a - 1) = 1 := by ring + rw [hunit, v.map_one] at h + exact False.elim ((lt_irrefl _) h) + · simp only [bitInField, Bool.false_eq_true, ↓reduceIte, + sub_zero] at h₁ h₂ + have hneg : v (-(a - 1)) < 1 := by + rw [v.map_neg] + exact h₁ + have h : v (a - (a - 1)) < 1 := by + simpa only [sub_eq_add_neg, neg_add_rev, neg_neg, add_neg_cancel_comm_assoc, map_one, + lt_self_iff_false] using + v.map_add_lt h₂ hneg + have hunit : a - (a - 1) = 1 := by ring + rw [hunit, v.map_one] at h + exact False.elim ((lt_irrefl _) h) + · rfl + +theorem satisfiable_of_common_valuation_root + (formula : Formula) + (valuation : Fin formula.variableCount → Valuation E Γ₀) + (commonRoot : E) + (localAssignment : + Fin formula.clauses.length → Fin formula.variableCount → Bool) + (local_satisfies : ∀ C : Fin formula.clauses.length, + (formula.clauses.get C).Satisfied (localAssignment C)) + (local_close : ∀ (C : Fin formula.clauses.length) + (literal : Literal formula.variableCount), + literal ∈ (formula.clauses.get C).literals → + valuation literal.variableIndex + (commonRoot - + bitInField (E := E) + (localAssignment C literal.variableIndex)) < 1) : + formula.Satisfiable := by + simp only [GapCVP.Core.Formula.Satisfiable, decide_eq_true_eq] at * + classical + let assignment : Fin formula.variableCount → Bool := fun i => + if h : ∃ (C : Fin formula.clauses.length) + (literal : Literal formula.variableCount), + literal ∈ (formula.clauses.get C).literals ∧ + literal.variableIndex = i then + localAssignment (Classical.choose h) i + else false + refine ⟨assignment, ?_⟩ + simp only [GapCVP.Core.Formula.Satisfied, decide_eq_true_eq] + intro C + have clauseSatisfied := local_satisfies C + simp only [GapCVP.Core.Clause.Satisfied, decide_eq_true_eq] at clauseSatisfied ⊢ + obtain ⟨literal, hliteral, hvalue⟩ := clauseSatisfied + refine ⟨literal, hliteral, ?_⟩ + have hoccurs : ∃ (D : Fin formula.clauses.length) + (other : Literal formula.variableCount), + other ∈ (formula.clauses.get D).literals ∧ + other.variableIndex = literal.variableIndex := + ⟨C, literal, hliteral, rfl⟩ + dsimp [assignment] + split + next h => + obtain ⟨other, hother, hindex⟩ := Classical.choose_spec h + have hsame : + localAssignment C literal.variableIndex = + localAssignment (Classical.choose h) literal.variableIndex := + valuation_bits_unique (valuation literal.variableIndex) commonRoot + (local_close C literal hliteral) + (by + have hc := local_close (Classical.choose h) other hother + simpa only [gt_iff_lt, hindex] using hc) + exact hsame.symm.trans hvalue + next h => + exact False.elim (h hoccurs) + +end + +section + +open scoped BigOperators +open Polynomial Finset Matrix + +private theorem functionFieldExtendedValuation_genericSupportRoot_le_place_inv_pow + {k E : Type*} [Field k] [Field E] + [Algebra (RatFunc k) E] [Algebra k[X] E] + [IsScalarTower k[X] (RatFunc k) E] + [FiniteDimensional (RatFunc k) E] + [Algebra.IsSeparable (RatFunc k) E] + (moments : ℕ → k[X]) (d h : ℕ) + (hmoments : ∀ j : ℕ, (moments j).natDegree ≤ d * j) + (hdenominator : genericHankelDenominator h moments ≠ 0) + (roots : Fin h → E) + (hroots : + (genericMomentSupportPolynomial h moments).map + (algebraMap (RatFunc k) E) = rootSupportPolynomial roots) + (place : k) (index : Fin h) : + functionFieldExtendedValuation (K := k) (E := E) place (roots index) ≤ + (functionFieldExtendedValuation (K := k) (E := E) place + (algebraMap k[X] E (Polynomial.X - Polynomial.C place)) ^ + (d * h * (h - 1)))⁻¹ := by + classical + let v := functionFieldExtendedValuation (K := k) (E := E) place + let q := v (algebraMap k[X] E (Polynomial.X - Polynomial.C place)) + have hq : 0 < q := by + apply (Valuation.pos_iff v).mpr + apply (map_ne_zero_iff (algebraMap k[X] E) + (functionFieldPolynomial_algebraMap_injective + (K := k) (E := E))).mpr + exact Polynomial.X_sub_C_ne_zero place + have hqone : q ≤ 1 := + le_of_lt + (functionFieldExtendedValuation_place_lt_one + (K := k) (E := E) place) + have hbound : 1 ≤ (q ^ (d * h * (h - 1)))⁻¹ := + (one_le_inv₀ (pow_pos hq _)).mpr + (pow_le_one₀ zero_le hqone) + apply valuation_root_le_of_monic_coefficient_bound v + (fun i : Fin h => + algebraMap (RatFunc k) E (genericHankelCoefficient h moments i)) + (roots index) (q ^ (d * h * (h - 1)))⁻¹ hbound + · intro i + exact + functionFieldExtendedValuation_genericHankelCoefficient_le_place_inv_pow + (E := E) place moments d h hmoments hdenominator i + · have hroot : + ((genericMomentSupportPolynomial h moments).map + (algebraMap (RatFunc k) E)).eval (roots index) = 0 := by + rw [hroots] + exact rootSupportPolynomial_eval_root roots index + simpa only [genericMomentSupportPolynomial, Polynomial.map_add, Polynomial.map_pow, map_X, + eval_add, eval_pow, + eval_X, eval_map_algebraMap, map_sum, map_mul, aeval_C, map_pow, aeval_X] using hroot + +theorem functionFieldExtendedValuation_shiftedGenericRoot_le_place_inv_pow + {k E : Type*} [Field k] [Field E] + [Algebra k E] [Algebra (RatFunc k) E] [Algebra k[X] E] + [IsScalarTower k k[X] E] + [IsScalarTower k[X] (RatFunc k) E] + [FiniteDimensional (RatFunc k) E] + [Algebra.IsSeparable (RatFunc k) E] + (moments : ℕ → k[X]) (d h : ℕ) + (hmoments : ∀ j : ℕ, (moments j).natDegree ≤ d * j) + (hdenominator : genericHankelDenominator h moments ≠ 0) + (roots : Fin h → E) + (hroots : + (genericMomentSupportPolynomial h moments).map + (algebraMap (RatFunc k) E) = rootSupportPolynomial roots) + (place bit : k) (index : Fin h) : + functionFieldExtendedValuation (K := k) (E := E) place + ((roots index - algebraMap k E bit) / + algebraMap k[X] E (Polynomial.X - Polynomial.C place)) ≤ + (functionFieldExtendedValuation (K := k) (E := E) place + (algebraMap k[X] E (Polynomial.X - Polynomial.C place)) ^ + (d * h * (h - 1) + 1))⁻¹ := by + classical + let v := functionFieldExtendedValuation (K := k) (E := E) place + let q := v (algebraMap k[X] E (Polynomial.X - Polynomial.C place)) + let D := d * h * (h - 1) + have hq : 0 < q := by + apply (Valuation.pos_iff v).mpr + apply (map_ne_zero_iff (algebraMap k[X] E) + (functionFieldPolynomial_algebraMap_injective + (K := k) (E := E))).mpr + exact Polynomial.X_sub_C_ne_zero place + have hqone : q ≤ 1 := + le_of_lt + (functionFieldExtendedValuation_place_lt_one + (K := k) (E := E) place) + have hbound : 1 ≤ (q ^ D)⁻¹ := + (one_le_inv₀ (pow_pos hq _)).mpr + (pow_le_one₀ zero_le hqone) + have halpha : v (roots index) ≤ (q ^ D)⁻¹ := + functionFieldExtendedValuation_genericSupportRoot_le_place_inv_pow + moments d h hmoments hdenominator roots hroots place index + have hbitEq : + algebraMap k E bit = algebraMap k[X] E (Polynomial.C bit) := by + change algebraMap k E bit = + algebraMap k[X] E (algebraMap k k[X] bit) + exact IsScalarTower.algebraMap_apply k k[X] E bit + have hbit : v (algebraMap k E bit) ≤ 1 := by + rw [hbitEq] + exact functionFieldExtendedValuation_polynomial_le_one + place (Polynomial.C bit) + have hsub : v (roots index - algebraMap k E bit) ≤ (q ^ D)⁻¹ := + (v.map_sub _ _).trans (max_le halpha (hbit.trans hbound)) + calc + v ((roots index - algebraMap k E bit) / + algebraMap k[X] E (Polynomial.X - Polynomial.C place)) = + v (roots index - algebraMap k E bit) / q := v.map_div _ _ + _ = v (roots index - algebraMap k E bit) * q⁻¹ := + div_eq_mul_inv _ _ + _ ≤ (q ^ D)⁻¹ * q⁻¹ := + mul_le_mul_of_nonneg_right hsub zero_le + _ = (q ^ (D + 1))⁻¹ := by + rw [pow_succ, mul_inv] + +theorem valuation_inverseTransposeVandermonde_le_place_inv_pow + {E Γ₀ : Type*} [Field E] [LinearOrderedCommGroupWithZero Γ₀] + (v : Valuation E Γ₀) {h : ℕ} (roots : Fin h → E) + (p : Γ₀) (hp : 0 < p) (hpone : p ≤ 1) + (A B : ℕ) + (hroots : ∀ i, v (roots i) ≤ (p ^ A)⁻¹) + (hdet : (v (Matrix.vandermonde roots).det)⁻¹ ≤ + (p ^ B)⁻¹) + (i j : Fin h) : + v (inverseTransposeVandermonde roots i j) ≤ + (p ^ (B + A * h * h))⁻¹ := by + classical + have hbase : 1 ≤ (p ^ A)⁻¹ := + (one_le_inv₀ (pow_pos hp _)).mpr + (pow_le_one₀ zero_le hpone) + have hmatrixBound : 1 ≤ (p ^ (A * h))⁻¹ := + (one_le_inv₀ (pow_pos hp _)).mpr + (pow_le_one₀ zero_le hpone) + have hentries : + ∀ r c : Fin h, + v (roots c ^ r.val) ≤ (p ^ (A * h))⁻¹ := by + intro r c + calc + v (roots c ^ r.val) = v (roots c) ^ r.val := + v.map_pow (roots c) r.val + _ ≤ ((p ^ A)⁻¹) ^ r.val := + pow_le_pow_left' (hroots c) r.val + _ ≤ ((p ^ A)⁻¹) ^ h := + pow_le_pow_right' hbase (Nat.le_of_lt r.isLt) + _ = (p ^ (A * h))⁻¹ := by + rw [inv_pow, ← pow_mul] + calc + v (inverseTransposeVandermonde roots i j) ≤ + (v (Matrix.vandermonde roots).det)⁻¹ * + ((p ^ (A * h))⁻¹) ^ h := + valuation_inverseTransposeVandermonde_le_det_inv_mul_pow + v roots ((p ^ (A * h))⁻¹) + hmatrixBound hentries i j + _ ≤ (p ^ B)⁻¹ * ((p ^ (A * h))⁻¹) ^ h := + mul_le_mul_of_nonneg_right hdet zero_le + _ = (p ^ (B + A * h * h))⁻¹ := by + rw [inv_pow, ← mul_inv, ← pow_mul, ← pow_add] + +end + +section + +open scoped BigOperators +open Matrix + +/-- GapCVP reduction support. -/ +abbrev BinaryAffineSystem.effectiveGaussianSystem (H : BinaryAffineSystem) : + EffectiveBinaryGaussian.System H.rowCount H.dimension where + check := H.check + rhs := H.rightHandSide + +/-- GapCVP reduction support. -/ +abbrev BinaryAffineSystem.effectiveGaussianState (H : BinaryAffineSystem) : + EffectiveBinaryGaussian.State H.rowCount H.dimension := + EffectiveBinaryGaussian.eliminate H.effectiveGaussianSystem + +theorem BinaryAffineSystem.effectiveGaussian_solves_iff + (H : BinaryAffineSystem) (z : Fin H.dimension → ℤ) : + H.effectiveGaussianState.system.Satisfies (binaryResidue z) ↔ + H.Solves z := by + simpa only [EffectiveBinaryGaussian.System.Satisfies, + effectiveGaussianState, effectiveGaussianSystem, Solves] using + EffectiveBinaryGaussian.eliminate_satisfies_iff H.effectiveGaussianSystem (binaryResidue z) + +/-- GapCVP reduction support. -/ +def BinaryAffineSystem.effectivePivotRowOption + (H : BinaryAffineSystem) (column : Fin H.dimension) : + Option (Fin H.rowCount) := + (H.effectiveGaussianState.pivots.find? + (fun pivot => decide (pivot.2 = column))).map Prod.fst + +/-- GapCVP reduction support. -/ +def BinaryAffineSystem.effectiveAffineBits + (H : BinaryAffineSystem) : Fin H.dimension → ZMod 2 := + fun column => + match H.effectivePivotRowOption column with + | some row => H.effectiveGaussianState.system.rhs row + | none => 0 + +/-- GapCVP reduction support. -/ +def BinaryAffineSystem.effectiveAffineRepresentative + (H : BinaryAffineSystem) : Fin H.dimension → ℤ := + fun column => ((H.effectiveAffineBits column).val : ℤ) + +@[simp] theorem BinaryAffineSystem.effectiveAffineRepresentative_residue + (H : BinaryAffineSystem) : + binaryResidue H.effectiveAffineRepresentative = + H.effectiveAffineBits := by + funext column + change (((H.effectiveAffineBits column).val : ℤ) : ZMod 2) = + H.effectiveAffineBits column + exact_mod_cast ZMod.natCast_zmod_val (H.effectiveAffineBits column) + +theorem effectiveBinary_eq_zero_or_one (bit : ZMod 2) : + bit = 0 ∨ bit = 1 := by + by_cases h : bit = 1 + · exact Or.inr h + · exact Or.inl + (EffectiveBinaryGaussian.binary_eq_zero_of_ne_one bit h) + +theorem BinaryAffineSystem.effectiveAffineRepresentative_eq_zero_or_one + (H : BinaryAffineSystem) (column : Fin H.dimension) : + H.effectiveAffineRepresentative column = 0 ∨ + H.effectiveAffineRepresentative column = 1 := by + rcases effectiveBinary_eq_zero_or_one + (H.effectiveAffineBits column) with hzero | hone + · left + simp only [effectiveAffineRepresentative, hzero, ZMod.val_zero, CharP.cast_eq_zero] + · right + change ((H.effectiveAffineBits column).val : ℤ) = 1 + simp only [hone, ZMod.val_one, Nat.cast_one] + +/-- GapCVP reduction support. -/ +def BinaryAffineSystem.effectiveSquareBasisMatrix + (H : BinaryAffineSystem) : + Matrix (Fin H.dimension) (Fin H.dimension) ℤ := + fun row column => + match H.effectivePivotRowOption row, H.effectivePivotRowOption column with + | some pivotRow, none => + ((H.effectiveGaussianState.system.check pivotRow column).val : ℤ) + | some _, some _ => if row = column then 2 else 0 + | none, none => if row = column then 1 else 0 + | none, some _ => 0 + +theorem BinaryAffineSystem.effectiveSquareBasisMatrix_mulVec_free + (H : BinaryAffineSystem) (coefficients : Fin H.dimension → ℤ) + (row : Fin H.dimension) + (hrow : H.effectivePivotRowOption row = none) : + H.effectiveSquareBasisMatrix.mulVec coefficients row = + coefficients row := by + classical + unfold Matrix.mulVec dotProduct + rw [Finset.sum_eq_single row] + · simp only [effectiveSquareBasisMatrix, hrow, ↓reduceIte, one_mul] + · intro column _ hne + cases hcolumn : H.effectivePivotRowOption column with + | none => + simp only [effectiveSquareBasisMatrix, hrow, hcolumn, Ne.symm hne, ↓reduceIte, zero_mul] + | some pivot => + simp only [effectiveSquareBasisMatrix, hrow, hcolumn, zero_mul] + · simp only [Finset.mem_univ, not_true_eq_false, mul_eq_zero, IsEmpty.forall_iff] + +theorem BinaryAffineSystem.effectiveSquareBasisMatrix_mulVec_pivot + (H : BinaryAffineSystem) (coefficients : Fin H.dimension → ℤ) + (row : Fin H.dimension) (pivot : Fin H.rowCount) + (hrow : H.effectivePivotRowOption row = some pivot) + (hfree : ∀ column : Fin H.dimension, + H.effectivePivotRowOption column = none → coefficients column = 0) : + H.effectiveSquareBasisMatrix.mulVec coefficients row = + 2 * coefficients row := by + classical + unfold Matrix.mulVec dotProduct + rw [Finset.sum_eq_single row] + · simp only [effectiveSquareBasisMatrix, hrow, ↓reduceIte] + · intro column _ hne + cases hcolumn : H.effectivePivotRowOption column with + | none => + simp only [hfree column hcolumn, mul_zero] + | some other => + simp only [effectiveSquareBasisMatrix, hrow, hcolumn, Ne.symm hne, ↓reduceIte, zero_mul] + · simp only [Finset.mem_univ, not_true_eq_false, mul_eq_zero, IsEmpty.forall_iff] + +theorem BinaryAffineSystem.effectiveSquareBasisMatrix_det_ne_zero + (H : BinaryAffineSystem) : + H.effectiveSquareBasisMatrix.det ≠ 0 := by + classical + intro hdet + obtain ⟨coefficients, hnonzero, hzero⟩ := + Matrix.exists_mulVec_eq_zero_iff.mpr hdet + have hfree : ∀ column : Fin H.dimension, + H.effectivePivotRowOption column = none → + coefficients column = 0 := by + intro column hcolumn + have hcoordinate := congrFun hzero column + rw [H.effectiveSquareBasisMatrix_mulVec_free + coefficients column hcolumn] at hcoordinate + simpa only [Pi.zero_apply] using hcoordinate + apply hnonzero + funext column + cases hpivot : H.effectivePivotRowOption column with + | none => + exact hfree column hpivot + | some pivot => + have hcoordinate := congrFun hzero column + rw [H.effectiveSquareBasisMatrix_mulVec_pivot + coefficients column pivot hpivot hfree] at hcoordinate + have hmul : 2 * coefficients column = 0 := by + simpa only [mul_eq_zero, OfNat.ofNat_ne_zero, false_or, Pi.zero_apply] using hcoordinate + exact (mul_eq_zero.mp hmul).resolve_left (by norm_num) + +/-- GapCVP reduction support. -/ +def effectiveConstructionAInstance + (H : BinaryAffineSystem) (hdimension : 0 < H.dimension) + (radius : ℚ) (hradius : 0 < radius) : GapCVPInstance where + dimension := H.dimension + dimension_pos := hdimension + basis := H.effectiveSquareBasisMatrix + basis_nonsingular := H.effectiveSquareBasisMatrix_det_ne_zero + target := fun i => (H.effectiveAffineRepresentative i : ℚ) + radius := radius + radius_pos := hradius + +namespace EffectiveBinaryGaussian + +@[simp] private theorem clearTarget_pivots + {m n : ℕ} (pivot : Fin m) (column : Fin n) + (state : State m n) (target : Fin m) : + (clearTarget pivot column state target).pivots = state.pivots := by + unfold clearTarget + split + · rfl + · split + · rfl + · rfl + +@[simp] theorem clearTargets_pivots + {m n : ℕ} (pivot : Fin m) (column : Fin n) + (targets : List (Fin m)) (state : State m n) : + (clearTargets pivot column targets state).pivots = + state.pivots := by + induction targets generalizing state with + | nil => rfl + | cons target rest ih => + change + (clearTargets pivot column rest + (clearTarget pivot column state target)).pivots = state.pivots + rw [ih, clearTarget_pivots] + +/-- GapCVP reduction support. -/ +noncomputable def PrefixNormal {m n : ℕ} + (scanned : List (Fin n)) (state : State m n) : Bool := + @decide + (state.nextPivot ≤ m ∧ + (∀ pair ∈ state.pivots, + pair.1.val < state.nextPivot) ∧ + (∀ row : Fin m, + row.val < state.nextPivot → + ∃ column : Fin n, (row, column) ∈ state.pivots) ∧ + (∀ pair ∈ state.pivots, + ∀ row : Fin m, + state.system.check row pair.2 = + if row = pair.1 then 1 else 0) ∧ + (∀ column ∈ scanned, + ∀ row : Fin m, state.nextPivot ≤ row.val → + state.system.check row column = 0)) + (Classical.propDecidable _) + +theorem PrefixNormal.nextPivot_le {m n : ℕ} + {scanned : List (Fin n)} {state : State m n} + (normal : PrefixNormal scanned state) : + state.nextPivot ≤ m := by + simp only [PrefixNormal, decide_eq_true_eq] at normal + exact normal.1 + +theorem PrefixNormal.pivot_below {m n : ℕ} + {scanned : List (Fin n)} {state : State m n} + (normal : PrefixNormal scanned state) + (pair : Fin m × Fin n) (hpair : pair ∈ state.pivots) : + pair.1.val < state.nextPivot := by + simp only [PrefixNormal, decide_eq_true_eq] at normal + exact normal.2.1 pair hpair + +theorem PrefixNormal.pivot_complete {m n : ℕ} + {scanned : List (Fin n)} {state : State m n} + (normal : PrefixNormal scanned state) + (row : Fin m) (hrow : row.val < state.nextPivot) : + ∃ column : Fin n, (row, column) ∈ state.pivots := by + simp only [PrefixNormal, decide_eq_true_eq] at normal + exact normal.2.2.1 row hrow + +theorem PrefixNormal.pivot_unit {m n : ℕ} + {scanned : List (Fin n)} {state : State m n} + (normal : PrefixNormal scanned state) + (pair : Fin m × Fin n) (hpair : pair ∈ state.pivots) + (row : Fin m) : + state.system.check row pair.2 = + if row = pair.1 then 1 else 0 := by + simp only [PrefixNormal, decide_eq_true_eq] at normal + exact normal.2.2.2.1 pair hpair row + +theorem PrefixNormal.scanned_lower_zero {m n : ℕ} + {scanned : List (Fin n)} {state : State m n} + (normal : PrefixNormal scanned state) + (column : Fin n) (hcolumn : column ∈ scanned) + (row : Fin m) (hrow : state.nextPivot ≤ row.val) : + state.system.check row column = 0 := by + simp only [PrefixNormal, decide_eq_true_eq] at normal + exact normal.2.2.2.2 column hcolumn row hrow + +theorem initialState_prefixNormal + {m n : ℕ} (system : System m n) : + PrefixNormal [] (initialState system) := by + simp only [PrefixNormal, decide_eq_true_eq] + refine ⟨Nat.zero_le m, ?_, ?_, ?_, ?_⟩ + · intro pair hpair + simp only [initialState, List.not_mem_nil] at hpair + · intro row hrow + simp only [initialState, not_lt_zero] at hrow + · intro pair hpair + simp only [initialState, List.not_mem_nil] at hpair + · intro column hcolumn + simp only [List.not_mem_nil] at hcolumn + +end EffectiveBinaryGaussian + +end + +end Core + +namespace Factor400BinarySourceTM + +open GapCVP.OutputBoundedDependentRecordFold + +theorem boundedFoldStates_of_nonexpansive + {worker : List Bool → List Bool} + (hworker : ∀ state : List Bool, + (worker state).length ≤ state.length) : + PolynomiallyBoundedFoldStates worker Polynomial.X := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] at * + intro input count seed hparse stage _ + have hseed : seed.length ≤ input.length := by + have hword := parseUnaryBoundedFold_eq_word input count seed hparse + rw [hword, unaryBoundedFoldWord] + simp only [List.length_append, List.length_replicate, + List.length_cons] + omega + have hiterate : ∀ index : ℕ, + ((worker^[index]) seed).length ≤ seed.length := by + intro index + induction index with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ index ih => + rw [Function.iterate_succ_apply'] + exact (hworker _).trans ih + simpa only [Polynomial.eval_X, ge_iff_le] using (hiterate stage).trans hseed + +private noncomputable def boundedWorkerComputable + {worker : List Bool → List Bool} + (computer : Turing.TM2ComputableInPolyTime + GapCVP.bitEncoding GapCVP.bitEncoding worker) + (bound : Polynomial ℕ) + (hstates : PolynomiallyBoundedFoldStates worker bound) : + Turing.TM2ComputableInPolyTime + GapCVP.bitEncoding GapCVP.bitEncoding + (boundedRecordFoldOutput worker) := + boundedDependentRecordFoldComputable computer bound hstates + +/-- GapCVP reduction support. -/ +noncomputable def nonexpansiveBoundedWorkerComputable + {worker : List Bool → List Bool} + (computer : Turing.TM2ComputableInPolyTime + GapCVP.bitEncoding GapCVP.bitEncoding worker) + (hworker : ∀ state : List Bool, + (worker state).length ≤ state.length) : + Turing.TM2ComputableInPolyTime + GapCVP.bitEncoding GapCVP.bitEncoding + (boundedRecordFoldOutput worker) := + boundedWorkerComputable computer Polynomial.X + (boundedFoldStates_of_nonexpansive hworker) + +end Factor400BinarySourceTM + +namespace Factor400BinaryPreservingXorWorker + +open Turing + +private def binaryGaussianXorPreservingWord : List Bool → List Bool + | first :: second :: remaining => + Bool.xor first second :: remaining + | _ => [] + +private theorem binaryGaussianXorPreservingWord_nonexpansive + (input : List Bool) : + (binaryGaussianXorPreservingWord input).length ≤ input.length := by + cases input with + | nil => simp only [binaryGaussianXorPreservingWord, List.length_nil, Std.le_refl] + | cons first remaining => + cases remaining <;> + simp [binaryGaussianXorPreservingWord] + +private def preservingXorPeek (stack : Fin 3) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def preservingXorGoto (phase : Fin 4) : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .goto (fun _ => phase) + +private def preservingXorFirstStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + preservingXorPeek 0 + (.pop 0 (fun _ symbol => symbol) (preservingXorGoto 1)) + (preservingXorGoto 2) + +private def preservingXorSecondStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + .pop 0 + (fun first second => + second.map (fun bit => Bool.xor (first.getD false) bit)) + (.branch (fun result => result.isSome) + (.push 1 (fun result => result.getD false) + (.load (fun _ => none) (preservingXorGoto 2))) + (.load (fun _ => none) (preservingXorGoto 2))) + +private def preservingXorScanStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + preservingXorPeek 0 + (.pop 0 (fun _ bit => bit) + (.push 1 (fun bit => bit.getD false) + (.load (fun _ => none) (preservingXorGoto 2)))) + (.load (fun _ => none) (preservingXorGoto 3)) + +private def preservingXorRestoreStatement : + Turing.TM2.Stmt + (fun _ : Fin 3 => Bool) (Fin 4) (Option Bool) := + preservingXorPeek 1 + (.pop 1 (fun _ bit => bit) + (.push 2 (fun bit => bit.getD false) + (.load (fun _ => none) (preservingXorGoto 3)))) + (.load (fun _ => none) .halt) + +private abbrev preservingXorMachine : Turing.FinTM2 where + K := Fin 3 + k₀ := 0 + k₁ := 2 + Γ _ := Bool + Λ := Fin 4 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 4) then + preservingXorFirstStatement + else if phase = (1 : Fin 4) then + preservingXorSecondStatement + else if phase = (2 : Fin 4) then + preservingXorScanStatement + else + preservingXorRestoreStatement + +private def preservingXorConfiguration + (phase : Fin 4) (state : Option Bool) + (input archive output : List Bool) : preservingXorMachine.Cfg where + l := some phase + var := state + stk := ![input, archive, output] + +private theorem preservingXorMachine_init (input : List Bool) : + Turing.initList preservingXorMachine input = + preservingXorConfiguration 0 none input [] [] := by + simp only [preservingXorMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + preservingXorConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `preservingXorStepTac` machine-step simplifier. -/ +macro "preservingXorStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [preservingXorMachine, preservingXorConfiguration, + preservingXorPeek, preservingXorGoto, + preservingXorFirstStatement, preservingXorSecondStatement, + preservingXorScanStatement, preservingXorRestoreStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem preservingXor_first_step + (first : Bool) (remaining archive output : List Bool) : + preservingXorMachine.step + (preservingXorConfiguration 0 none + (first :: remaining) archive output) = + some (preservingXorConfiguration 1 + (some first) remaining archive output) := by + cases first <;> preservingXorStepTac + +private theorem preservingXor_first_missing + (archive output : List Bool) : + preservingXorMachine.step + (preservingXorConfiguration 0 none [] archive output) = + some (preservingXorConfiguration 2 none [] archive output) := by + preservingXorStepTac + +private theorem preservingXor_second_step + (first second : Bool) (remaining archive output : List Bool) : + preservingXorMachine.step + (preservingXorConfiguration 1 (some first) + (second :: remaining) archive output) = + some (preservingXorConfiguration 2 none + remaining (Bool.xor first second :: archive) output) := by + cases first <;> cases second <;> preservingXorStepTac + +private theorem preservingXor_second_missing + (first : Bool) (archive output : List Bool) : + preservingXorMachine.step + (preservingXorConfiguration 1 (some first) [] archive output) = + some (preservingXorConfiguration 2 none [] archive output) := by + cases first <;> preservingXorStepTac + +private theorem preservingXor_scan_step + (bit : Bool) (remaining archive output : List Bool) : + preservingXorMachine.step + (preservingXorConfiguration 2 none + (bit :: remaining) archive output) = + some (preservingXorConfiguration 2 none + remaining (bit :: archive) output) := by + cases bit <;> preservingXorStepTac + +private theorem preservingXor_scan_finish + (archive output : List Bool) : + preservingXorMachine.step + (preservingXorConfiguration 2 none [] archive output) = + some (preservingXorConfiguration 3 none [] archive output) := by + preservingXorStepTac + +private theorem preservingXor_restore_step + (bit : Bool) (archive output : List Bool) : + preservingXorMachine.step + (preservingXorConfiguration 3 none [] + (bit :: archive) output) = + some (preservingXorConfiguration 3 none [] + archive (bit :: output)) := by + cases bit <;> preservingXorStepTac + +private theorem preservingXor_restore_finish + (output : List Bool) : + preservingXorMachine.step + (preservingXorConfiguration 3 none [] [] output) = + some (Turing.haltList preservingXorMachine output) := by + preservingXorStepTac + +private def preservingXor_scanTrace + (input archive output : List Bool) : + EvalsToInTime preservingXorMachine.step (preservingXorConfiguration 2 none input archive + output) + (some (preservingXorConfiguration 3 none [] + (input.reverse ++ archive) output)) + (input.length + 1) := by + induction input generalizing archive with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (preservingXor_scan_finish archive output) + | cons bit input ih => + have first := oneStep _ _ (preservingXor_scan_step bit input archive output) + have rest := ih (bit :: archive) + have full := EvalsToInTime.trans preservingXorMachine.step _ _ _ _ _ first rest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using full + +private def preservingXor_restoreTrace + (archive output : List Bool) : + EvalsToInTime preservingXorMachine.step (preservingXorConfiguration 3 none [] archive output) + (some (Turing.haltList preservingXorMachine + (archive.reverse ++ output))) + (archive.length + 1) := by + induction archive generalizing output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, + zero_add] using + oneStep _ _ (preservingXor_restore_finish output) + | cons bit archive ih => + have first := oneStep _ _ (preservingXor_restore_step bit archive output) + have rest := ih (bit :: output) + have full := EvalsToInTime.trans preservingXorMachine.step _ _ _ _ _ first rest + simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, + List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using full + +private def preservingXor_totalTrace (input : List Bool) : + EvalsToInTime preservingXorMachine.step (preservingXorConfiguration 0 none input [] []) + (some (Turing.haltList preservingXorMachine + (binaryGaussianXorPreservingWord input))) + (2 * input.length + 4) := by + cases input with + | nil => + have first := oneStep _ _ (preservingXor_first_missing [] []) + have scan := preservingXor_scanTrace [] [] [] + have restore := preservingXor_restoreTrace [] [] + have firstScan := EvalsToInTime.trans preservingXorMachine.step _ _ _ _ _ first scan + have full := EvalsToInTime.trans preservingXorMachine.step _ _ _ _ _ firstScan restore + exact rebound full (by simp only [List.length_nil, zero_add, Nat.reduceAdd, mul_zero, + Nat.reduceLeDiff]) + | cons first remaining => + have firstStep := oneStep _ _ (preservingXor_first_step first remaining [] []) + cases remaining with + | nil => + have secondStep := oneStep _ _ (preservingXor_second_missing first [] []) + have scan := preservingXor_scanTrace [] [] [] + have restore := preservingXor_restoreTrace [] [] + have firstTwo := EvalsToInTime.trans + preservingXorMachine.step _ _ _ _ _ firstStep secondStep + have firstScan := EvalsToInTime.trans preservingXorMachine.step _ _ _ _ _ firstTwo scan + have full := EvalsToInTime.trans preservingXorMachine.step _ _ _ _ _ firstScan restore + exact rebound full (by simp only [List.length_nil, zero_add, Nat.reduceAdd, + List.length_cons, mul_one, Nat.reduceLeDiff]) + | cons second remaining => + have secondStep := oneStep _ _ (preservingXor_second_step first second remaining [] []) + have scan := preservingXor_scanTrace + remaining [Bool.xor first second] [] + have restore := preservingXor_restoreTrace + (remaining.reverse ++ [Bool.xor first second]) [] + have firstTwo := EvalsToInTime.trans + preservingXorMachine.step _ _ _ _ _ firstStep secondStep + have firstScan := EvalsToInTime.trans preservingXorMachine.step _ _ _ _ _ firstTwo scan + have full := EvalsToInTime.trans preservingXorMachine.step _ _ _ _ _ firstScan restore + have houtput : + (remaining.reverse ++ [Bool.xor first second]).reverse ++ + ([] : List Bool) = + binaryGaussianXorPreservingWord + (first :: second :: remaining) := by + simp only [List.reverse_append, List.reverse_cons, List.reverse_nil, List.nil_append, + List.reverse_reverse, + List.cons_append, List.append_nil, binaryGaussianXorPreservingWord] + rw [houtput] at full + exact rebound full (by + simp only [List.length_append, List.length_reverse, List.length_cons, List.length_nil, + zero_add, + Nat.reduceAdd] + omega) + +private noncomputable def binaryGaussianXorPreservingComputable : + Turing.TM2ComputableInPolyTime GapCVP.bitEncoding + GapCVP.bitEncoding binaryGaussianXorPreservingWord where + tm := preservingXorMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 2 * Polynomial.X + 4 + outputsFun input := { + steps := (preservingXor_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, preservingXorMachine_init, + Option.map_some] using + (preservingXor_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (preservingXor_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +end Factor400BinaryPreservingXorWorker + +namespace Factor400BinaryPhysicalParityTM + +open GapCVP.OutputBoundedDependentRecordFold +open GapCVP.Factor400BinarySourceTM GapCVP.Factor400BinaryPreservingXorWorker + +/-- GapCVP reduction support. -/ +def prefixParityOutput : List Bool → List Bool := + boundedRecordFoldOutput binaryGaussianXorPreservingWord + +/-- GapCVP reduction support. -/ +noncomputable def prefixParityComputable : + Turing.TM2ComputableInPolyTime + GapCVP.bitEncoding GapCVP.bitEncoding prefixParityOutput := + nonexpansiveBoundedWorkerComputable + binaryGaussianXorPreservingComputable + binaryGaussianXorPreservingWord_nonexpansive + +private theorem preservingXor_iterate_prefix + (first : Bool) (remaining suffix : List Bool) : + ((binaryGaussianXorPreservingWord^[remaining.length]) + (first :: (remaining ++ suffix))) = + remaining.foldl Bool.xor first :: suffix := by + induction remaining generalizing first with + | nil => + simp only [List.length_nil, List.nil_append, Function.iterate_zero, id_eq, List.foldl_nil] + | cons next tail ih => + rw [List.length_cons, Function.iterate_succ_apply] + change + ((binaryGaussianXorPreservingWord^[tail.length]) + (Bool.xor first next :: (tail ++ suffix))) = + tail.foldl Bool.xor (Bool.xor first next) :: suffix + exact ih (Bool.xor first next) + +theorem prefixParityOutput_valid + (first : Bool) (remaining suffix : List Bool) : + prefixParityOutput + (unaryBoundedFoldWord remaining.length + (first :: (remaining ++ suffix))) = + remaining.foldl Bool.xor first :: suffix := by + simp only [prefixParityOutput, boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + exact preservingXor_iterate_prefix first remaining suffix + +end Factor400BinaryPhysicalParityTM + +namespace BinaryCoefficientTM + +open Turing GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM +open GapCVP.SourceFourFamilyMarkerRotationTM GapCVP.Factor400BinaryPhysicalParityTM + +private def convolutionProductMarker : List Bool → List Bool := + markerConditionalOutput + (markerConditionalOutput + (markerConditionalOutput + (fun _ : List Bool => [true]) [false]) + [false]) + [false] + +private noncomputable def convolutionProductMarkerComputable : + BitTM + convolutionProductMarker := + markerConditionalComputable + (markerConditionalComputable + (markerConditionalComputable + (sourceFixedWordComputable [true]) [false]) + [false]) + [false] + +@[simp] private theorem convolutionProductMarker_valid + (matched left right : Bool) : + convolutionProductMarker [matched, left, right] = + [matched && left && right] := by + cases matched <;> cases left <;> cases right <;> rfl + +private theorem convolutionProductMarker_length + (input : List Bool) : + (convolutionProductMarker input).length = 1 := by + cases input with + | nil => rfl + | cons matched remaining => + cases matched with + | false => rfl + | true => + cases remaining with + | nil => rfl + | cons left remaining => + cases left with + | false => rfl + | true => + cases remaining with + | nil => rfl + | cons right remaining => + cases right <;> rfl + +private def convolutionProductRecordFoldOutput : List Bool → List Bool := + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + convolutionProductMarker) + +private noncomputable def convolutionProductRecordFoldComputable : + BitTM + convolutionProductRecordFoldOutput := by + exact fourFamilyOriginalMarkerFoldComputable + convolutionProductMarkerComputable + (fun input => (convolutionProductMarker_length input).le) + +private def convolutionProductMarkerStream + (queries : List (List Bool)) : List Bool := + fourFamilyOriginalMarkerStream + convolutionProductMarker queries + +private theorem convolutionProductMarkerStream_length + (queries : List (List Bool)) : + (convolutionProductMarkerStream queries).length = + queries.length := by + induction queries with + | nil => rfl + | cons query remaining ih => + change + (convolutionProductMarker query ++ + convolutionProductMarkerStream remaining).length = + remaining.length + 1 + rw [List.length_append, + convolutionProductMarker_length, ih] + omega + +/-- GapCVP reduction support. -/ +def convolutionCoefficientOutput : List Bool → List Bool := + prefixParityOutput ∘ convolutionProductRecordFoldOutput + +/-- GapCVP reduction support. -/ +noncomputable def convolutionCoefficientComputable : + BitTM + convolutionCoefficientOutput := + GapCVP.TMComposition.computableInPolyTime + convolutionProductRecordFoldComputable + prefixParityComputable + +/-- GapCVP reduction support. -/ +def convolutionCoefficientQuery + (queries : List (List Bool)) : List Bool := + unaryBoundedFoldWord queries.length + (sourceMixedRadixOriginalSourceQueryStream queries ++ + unaryBoundedFoldWord queries.length [false]) + +@[simp] private theorem convolutionCoefficientOutput_queries + (queries : List (List Bool)) : + convolutionCoefficientOutput + (convolutionCoefficientQuery queries) = + [(convolutionProductMarkerStream queries).foldl + Bool.xor false] := by + unfold convolutionCoefficientOutput + convolutionProductRecordFoldOutput + convolutionCoefficientQuery + rw [Function.comp_apply, + boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries] + have hlength : + (fourFamilyOriginalMarkerStream + convolutionProductMarker queries).length = + queries.length := by + simpa only [convolutionProductMarkerStream] using convolutionProductMarkerStream_length queries + simpa only [unaryBoundedFoldWord, List.append_assoc, List.cons_append, List.nil_append, + convolutionProductMarkerStream, hlength, List.append_nil] using + prefixParityOutput_valid false (convolutionProductMarkerStream queries) [] + +/-- GapCVP reduction support. -/ +def wordConvolutionQueries + {e : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word e) + (coefficient : Fin (2 * e)) : List (List Bool) := + (List.finRange e).flatMap fun i => + (List.finRange e).map fun j => + [decide (i.val + j.val = coefficient.val), left i, right j] + +private def wordConvolutionProductBits + {e : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word e) + (coefficient : Fin (2 * e)) : List Bool := + (List.finRange e).flatMap fun i => + (List.finRange e).map fun j => + if i.val + j.val = coefficient.val + then left i && right j + else false + +theorem wordConvolutionQueries_length + {e : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word e) + (coefficient : Fin (2 * e)) : + (wordConvolutionQueries left right coefficient).length = e * e := by + simp only [wordConvolutionQueries, List.length_flatMap, List.length_map, List.length_finRange, + List.map_const', List.sum_replicate, smul_eq_mul] + +private theorem convolutionProductMarkerStream_wordQueries + {e : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word e) + (coefficient : Fin (2 * e)) : + convolutionProductMarkerStream + (wordConvolutionQueries left right coefficient) = + wordConvolutionProductBits left right coefficient := by + have hinner (i : Fin e) (items : List (Fin e)) : + (items.map fun j => + [decide (i.val + j.val = coefficient.val), + left i, right j]).flatMap convolutionProductMarker = + items.map fun j => + if i.val + j.val = coefficient.val + then left i && right j + else false := by + induction items with + | nil => rfl + | cons j remaining ih => + simp only [List.map_cons, List.flatMap_cons, + convolutionProductMarker_valid] + by_cases h : i.val + j.val = coefficient.val + · simp only [h, decide_true, Bool.true_and, ih, Bool.ite_false_right, List.cons_append, + List.nil_append, + ↓reduceIte] + · simp only [h, decide_false, Bool.false_and, ih, Bool.ite_false_right, List.cons_append, + List.nil_append, + ↓reduceIte] + have houter (items : List (Fin e)) : + (items.flatMap fun i => + (List.finRange e).map fun j => + [decide (i.val + j.val = coefficient.val), + left i, right j]).flatMap convolutionProductMarker = + items.flatMap fun i => + (List.finRange e).map fun j => + if i.val + j.val = coefficient.val + then left i && right j + else false := by + induction items with + | nil => rfl + | cons i remaining ih => + simp only [List.flatMap_cons, List.flatMap_append, hinner i (List.finRange e), + Bool.ite_false_right, ih] + exact houter (List.finRange e) + +private theorem foldl_xor_flatMap + {α : Type} (items : List α) + (bits : α → List Bool) (initial : Bool) : + (items.flatMap bits).foldl Bool.xor initial = + items.foldl + (fun accumulator item => + (bits item).foldl Bool.xor accumulator) + initial := by + induction items generalizing initial with + | nil => rfl + | cons first remaining ih => + simp only [List.flatMap_cons, List.foldl_append, + List.foldl_cons] + exact ih ((bits first).foldl Bool.xor initial) + +private theorem convolutionInnerFold + {e : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word e) + (coefficient : Fin (2 * e)) + (i : Fin e) (items : List (Fin e)) + (initial : Bool) : + (items.map fun j => + if i.val + j.val = coefficient.val + then left i && right j + else false).foldl Bool.xor initial = + items.foldl + (fun accumulator j => + if i.val + j.val = coefficient.val then + Bool.xor accumulator (left i && right j) + else accumulator) + initial := by + induction items generalizing initial with + | nil => rfl + | cons first remaining ih => + simp only [List.map_cons, List.foldl_cons] + by_cases h : i.val + first.val = coefficient.val + · simp only [h, ↓reduceIte] + exact ih (Bool.xor initial (left i && right first)) + · simp only [h, ↓reduceIte, Bool.xor_false] + exact ih initial + +private theorem wordConvolutionProductBits_foldl + {e : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word e) + (coefficient : Fin (2 * e)) : + (wordConvolutionProductBits left right coefficient).foldl + Bool.xor false = + GapCVP.Core.EffectiveBinaryField.multiplyWords + left right coefficient := by + unfold wordConvolutionProductBits + rw [foldl_xor_flatMap] + unfold GapCVP.Core.EffectiveBinaryField.multiplyWords + congr 1 + funext accumulator i + exact convolutionInnerFold left right coefficient i + (List.finRange e) accumulator + +/-- GapCVP reduction support. -/ +def wordConvolutionCoefficientQuery + {e : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word e) + (coefficient : Fin (2 * e)) : List Bool := + convolutionCoefficientQuery + (wordConvolutionQueries left right coefficient) + +@[simp] theorem convolutionCoefficientOutput_word + {e : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word e) + (coefficient : Fin (2 * e)) : + convolutionCoefficientOutput + (wordConvolutionCoefficientQuery left right coefficient) = + [GapCVP.Core.EffectiveBinaryField.multiplyWords + left right coefficient] := by + unfold wordConvolutionCoefficientQuery + rw [convolutionCoefficientOutput_queries, + convolutionProductMarkerStream_wordQueries, + wordConvolutionProductBits_foldl] + +end BinaryCoefficientTM + +namespace GaussianXorWorker + +open Turing + +/-- GapCVP reduction support. -/ +def binaryGaussianXorHeadWord : List Bool → List Bool + | first :: second :: _ => [Bool.xor first second] + | _ => [] + +private def binaryGaussianXorPeek + (present absent : Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + .peek 0 (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def binaryGaussianXorGoto (phase : Fin 3) : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + .goto (fun _ => phase) + +private def binaryGaussianXorFirstStatement : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + binaryGaussianXorPeek + (.pop 0 (fun _ symbol => symbol) (binaryGaussianXorGoto 1)) + (binaryGaussianXorGoto 2) + +private def binaryGaussianXorSecondStatement : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + .pop 0 + (fun first second => + second.map (fun bit => Bool.xor (first.getD false) bit)) + (.branch (fun result => result.isSome) + (.push 1 (fun result => result.getD false) + (.load (fun _ => none) (binaryGaussianXorGoto 2))) + (.load (fun _ => none) (binaryGaussianXorGoto 2))) + +private def binaryGaussianXorDrainStatement : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + binaryGaussianXorPeek + (.pop 0 (fun _ _ => none) (binaryGaussianXorGoto 2)) + (.load (fun _ => none) .halt) + +private abbrev binaryGaussianXorMachine : Turing.FinTM2 where + K := Fin 2 + k₀ := 0 + k₁ := 1 + Γ _ := Bool + Λ := Fin 3 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 3) then + binaryGaussianXorFirstStatement + else if phase = (1 : Fin 3) then + binaryGaussianXorSecondStatement + else + binaryGaussianXorDrainStatement + +private def binaryGaussianXorConfiguration + (phase : Fin 3) (state : Option Bool) + (input output : List Bool) : binaryGaussianXorMachine.Cfg where + l := some phase + var := state + stk := ![input, output] + +private theorem binaryGaussianXorMachine_init (input : List Bool) : + Turing.initList binaryGaussianXorMachine input = + binaryGaussianXorConfiguration 0 none input [] := by + simp only [binaryGaussianXorMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, dite_eq_ite, + binaryGaussianXorConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `binaryGaussianXorStepTac` machine-step simplifier. -/ +macro "binaryGaussianXorStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [binaryGaussianXorMachine, binaryGaussianXorConfiguration, + binaryGaussianXorPeek, binaryGaussianXorGoto, + binaryGaussianXorFirstStatement, + binaryGaussianXorSecondStatement, + binaryGaussianXorDrainStatement, Turing.haltList, + Turing.FinTM2.step, Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem binaryGaussianXor_first_step + (first : Bool) (remaining output : List Bool) : + binaryGaussianXorMachine.step + (binaryGaussianXorConfiguration 0 none + (first :: remaining) output) = + some (binaryGaussianXorConfiguration 1 + (some first) remaining output) := by + cases first <;> binaryGaussianXorStepTac + +private theorem binaryGaussianXor_first_missing + (output : List Bool) : + binaryGaussianXorMachine.step + (binaryGaussianXorConfiguration 0 none [] output) = + some (binaryGaussianXorConfiguration 2 none [] output) := by + binaryGaussianXorStepTac + +private theorem binaryGaussianXor_second_step + (first second : Bool) (remaining output : List Bool) : + binaryGaussianXorMachine.step + (binaryGaussianXorConfiguration 1 (some first) + (second :: remaining) output) = + some (binaryGaussianXorConfiguration 2 none + remaining (Bool.xor first second :: output)) := by + cases first <;> cases second <;> binaryGaussianXorStepTac + +private theorem binaryGaussianXor_second_missing + (first : Bool) (output : List Bool) : + binaryGaussianXorMachine.step + (binaryGaussianXorConfiguration 1 (some first) [] output) = + some (binaryGaussianXorConfiguration 2 none [] output) := by + cases first <;> binaryGaussianXorStepTac + +private theorem binaryGaussianXor_drain_step + (bit : Bool) (remaining output : List Bool) : + binaryGaussianXorMachine.step + (binaryGaussianXorConfiguration 2 none + (bit :: remaining) output) = + some (binaryGaussianXorConfiguration 2 none + remaining output) := by + cases bit <;> binaryGaussianXorStepTac + +private theorem binaryGaussianXor_drain_finish (output : List Bool) : + binaryGaussianXorMachine.step + (binaryGaussianXorConfiguration 2 none [] output) = + some (Turing.haltList binaryGaussianXorMachine output) := by + binaryGaussianXorStepTac + +private def binaryGaussianXor_drainTrace + (input output : List Bool) : + EvalsToInTime binaryGaussianXorMachine.step (binaryGaussianXorConfiguration 2 none input + output) + (some (Turing.haltList binaryGaussianXorMachine output)) + (input.length + 1) := by + induction input with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (binaryGaussianXor_drain_finish output) + | cons bit input ih => + have first := oneStep _ _ (binaryGaussianXor_drain_step bit input output) + have full := EvalsToInTime.trans binaryGaussianXorMachine.step _ _ _ _ _ first ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using full + +private def binaryGaussianXor_totalTrace (input : List Bool) : + EvalsToInTime binaryGaussianXorMachine.step (binaryGaussianXorConfiguration 0 none input []) + (some (Turing.haltList binaryGaussianXorMachine + (binaryGaussianXorHeadWord input))) + (input.length + 2) := by + cases input with + | nil => + have first := oneStep _ _ (binaryGaussianXor_first_missing []) + have rest := binaryGaussianXor_drainTrace [] [] + simpa [binaryGaussianXorHeadWord] using + EvalsToInTime.trans binaryGaussianXorMachine.step _ _ _ _ _ first rest + | cons first remaining => + have firstStep := oneStep _ _ (binaryGaussianXor_first_step first remaining []) + cases remaining with + | nil => + have secondStep := oneStep _ _ (binaryGaussianXor_second_missing first []) + have rest := binaryGaussianXor_drainTrace [] [] + have firstTwo := EvalsToInTime.trans + binaryGaussianXorMachine.step _ _ _ _ _ firstStep secondStep + simpa [binaryGaussianXorHeadWord] using + EvalsToInTime.trans binaryGaussianXorMachine.step _ _ _ _ _ firstTwo rest + | cons second remaining => + have secondStep := oneStep _ _ (binaryGaussianXor_second_step first second remaining []) + have rest := binaryGaussianXor_drainTrace + remaining [Bool.xor first second] + have firstTwo := EvalsToInTime.trans + binaryGaussianXorMachine.step _ _ _ _ _ firstStep secondStep + have full := EvalsToInTime.trans binaryGaussianXorMachine.step _ _ _ _ _ firstTwo rest + exact rebound full (by simp) + +/-- GapCVP reduction support. -/ +noncomputable def binaryGaussianXorHeadComputable : + Turing.TM2ComputableInPolyTime GapCVP.bitEncoding + GapCVP.bitEncoding binaryGaussianXorHeadWord where + tm := binaryGaussianXorMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := Polynomial.X + 2 + outputsFun input := { + steps := (binaryGaussianXor_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, binaryGaussianXorMachine_init, + Option.map_some] using + (binaryGaussianXor_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (binaryGaussianXor_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_X, + Polynomial.eval_ofNat, ge_iff_le] using hsteps + } + +end GaussianXorWorker + +namespace GaussianRowWorker + +open Turing GapCVP.OutputPolynomialCompositionClosure GapCVP.SourceCanonicalFixedWordTuringTM + +/-- GapCVP reduction support. -/ +def binaryGaussianFirstCellWord : List Bool → List Bool := + markerConditionalOutput (fun _ : List Bool => [true]) [false] + +/-- GapCVP reduction support. -/ +noncomputable def binaryGaussianFirstCellComputable : + BitTM + binaryGaussianFirstCellWord := + markerConditionalComputable + (sourceFixedWordComputable [true]) [false] + +@[simp] theorem binaryGaussianFirstCellWord_valid + (first : Bool) (remaining : List Bool) : + binaryGaussianFirstCellWord (first :: remaining) = [first] := by + cases first <;> rfl + +end GaussianRowWorker + +namespace BinaryModularReductionTM + +open Turing GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceFourFamilyMarkerRotationTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.GaussianXorWorker GapCVP.GaussianRowWorker + +private def modularReductionGatedMaskOutput : List Bool → List Bool := + markerConditionalOutput + (markerConditionalOutput + (fun _ : List Bool => [true]) [false]) + [false] + +private noncomputable def modularReductionGatedMaskComputable : + BitTM + modularReductionGatedMaskOutput := + markerConditionalComputable + (markerConditionalComputable + (sourceFixedWordComputable [true]) [false]) + [false] + +private def modularReductionDestinationOutput + (input : List Bool) : List Bool := + binaryGaussianFirstCellWord input.tail.tail + +private noncomputable def modularReductionDestinationComputable : + BitTM + modularReductionDestinationOutput := by + have htail := GapCVP.TMComposition.computableInPolyTime + dropHeadComputable dropHeadComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + htail binaryGaussianFirstCellComputable + change BitTM + (fun input => binaryGaussianFirstCellWord input.tail.tail) + simpa only [Function.comp_def] using hphysical + +private def modularReductionPackedXorInput + (input : List Bool) : List Bool := + modularReductionGatedMaskOutput input ++ + modularReductionDestinationOutput input + +private noncomputable def modularReductionPackedXorComputable : + BitTM + modularReductionPackedXorInput := + pointwiseAppendComputable + modularReductionGatedMaskComputable + modularReductionDestinationComputable + +/-- GapCVP reduction support. -/ +def modularReductionCellOutput : List Bool → List Bool := + binaryGaussianXorHeadWord ∘ modularReductionPackedXorInput + +private noncomputable def modularReductionCellComputable : + BitTM + modularReductionCellOutput := + GapCVP.TMComposition.computableInPolyTime + modularReductionPackedXorComputable + binaryGaussianXorHeadComputable + +@[simp] theorem modularReductionCellOutput_valid + (gate mask destination : Bool) : + modularReductionCellOutput [gate, mask, destination] = + [Bool.xor (gate && mask) destination] := by + cases gate <;> cases mask <;> cases destination <;> rfl + +private theorem modularReductionGatedMaskOutput_singleton + (input : List Bool) : + ∃ bit : Bool, modularReductionGatedMaskOutput input = [bit] := by + cases input with + | nil => exact ⟨false, rfl⟩ + | cons gate remaining => + cases gate with + | false => exact ⟨false, rfl⟩ + | true => + cases remaining with + | nil => exact ⟨false, rfl⟩ + | cons mask remaining => + cases mask with + | false => exact ⟨false, rfl⟩ + | true => exact ⟨true, rfl⟩ + +private theorem modularReductionDestinationOutput_singleton + (input : List Bool) : + ∃ bit : Bool, modularReductionDestinationOutput input = [bit] := by + unfold modularReductionDestinationOutput + cases htail : input.tail.tail with + | nil => + refine ⟨false, ?_⟩ + simp only [binaryGaussianFirstCellWord, markerConditionalOutput] + | cons bit remaining => + refine ⟨bit, ?_⟩ + exact binaryGaussianFirstCellWord_valid bit remaining + +theorem modularReductionCellOutput_length + (input : List Bool) : + (modularReductionCellOutput input).length = 1 := by + obtain ⟨gate, hgate⟩ := + modularReductionGatedMaskOutput_singleton input + obtain ⟨destination, hdestination⟩ := + modularReductionDestinationOutput_singleton input + simp only [modularReductionCellOutput, Function.comp_apply, binaryGaussianXorHeadWord, + modularReductionPackedXorInput, hgate, hdestination, List.cons_append, List.nil_append, + List.length_cons, + List.length_nil, zero_add] + +/-- GapCVP reduction support. -/ +def modularReductionWordRowOutput : List Bool → List Bool := + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + modularReductionCellOutput) + +/-- GapCVP reduction support. -/ +noncomputable def modularReductionWordRowComputable : + BitTM + modularReductionWordRowOutput := by + exact fourFamilyOriginalMarkerFoldComputable + modularReductionCellComputable + (fun input => (modularReductionCellOutput_length input).le) + +/-- GapCVP reduction support. -/ +def finiteWordBits {d : ℕ} + (word : GapCVP.Core.EffectiveBinaryField.Word d) : List Bool := + (List.finRange d).map word + +end BinaryModularReductionTM + +namespace BinaryExplicitAffineSystem + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.BinaryReedSolomonParity + +/-- GapCVP reduction support. -/ +def explicitMomentBudget + (encodingLength : ℕ) (formula : Formula) : ℕ := + sourceSizeParameter encodingLength formula ^ 30 + +/-- GapCVP reduction support. -/ +abbrev ExplicitConstraintFamily + (encodingLength : ℕ) (formula : Formula) := + sourceSATConstraintFamily formula + (explicitMomentBudget encodingLength formula) + +/-- GapCVP reduction support. -/ +abbrev ExplicitGridPoint + (encodingLength : ℕ) (formula : Formula) := + sourceSATGridPoint + (sourceFormulaGrid encodingLength formula) + +/-- GapCVP reduction support. -/ +def sourceFormulaExplicitGridOrder + (encodingLength : ℕ) (formula : Formula) : + Fin (Fintype.card + (ExplicitGridPoint encodingLength formula)) ≃ + ExplicitGridPoint encodingLength formula := + (finCongr (show + Fintype.card (ExplicitGridPoint encodingLength formula) = + (sourceFormulaGrid encodingLength formula).card by simp only [Fintype.card_coe])).trans + (GapCVP.BinarySourceCoordinateOrder.sourceFormulaGridOrder + encodingLength formula) + +private def explicitFiniteReindexLinearEquiv + {K : Type*} [Field K] + {α : Type*} {n : ℕ} + (order : Fin n ≃ α) : + (α → K) ≃ₗ[K] (Fin n → K) := + LinearEquiv.funCongrLeft K K order + +/-- GapCVP reduction support. -/ +abbrev explicitFamilyRowCount + (encodingLength : ℕ) (formula : Formula) + (family : ExplicitConstraintFamily encodingLength formula) : ℕ := + match family with + | .inl _ => + Fintype.card (ExplicitGridPoint encodingLength formula) + | .inr (.inl _) => + Fintype.card + (ExplicitGridPoint encodingLength formula × + sourceFormulaField encodingLength formula) + | .inr (.inr (.inl _)) => + Fintype.card (ExplicitGridPoint encodingLength formula) + | .inr (.inr (.inr _)) => + Fintype.card (ExplicitGridPoint encodingLength formula) + +theorem explicitOrdinaryDegree_lt_grid + (encodingLength : ℕ) (formula : Formula) + (index : Fin (explicitMomentBudget encodingLength formula + 1)) : + formula.variableCount * index.val < + Fintype.card (ExplicitGridPoint encodingLength formula) := by + let sourceSize := sourceSizeParameter encodingLength formula + have hvariables : formula.variableCount ≤ sourceSize := + source_variableCount_le_size encodingLength formula + have hindex : index.val ≤ sourceSize ^ 30 := by + have hlt := index.isLt + simpa only [explicitMomentBudget, ge_iff_le] using Nat.le_of_lt_succ hlt + have hgrid := sourceFormulaGrid_max_degree_lt + encodingLength formula + have hproduct : + formula.variableCount * index.val ≤ sourceSize ^ 31 := by + calc + formula.variableCount * index.val ≤ + sourceSize * sourceSize ^ 30 := + Nat.mul_le_mul hvariables hindex + _ = sourceSize ^ 31 := by + calc + sourceSize * sourceSize ^ 30 = + sourceSize ^ 30 * sourceSize := Nat.mul_comm _ _ + _ = sourceSize ^ 31 := by + simpa only [Nat.reduceAdd] using (pow_succ sourceSize 30).symm + have hcard : + Fintype.card (ExplicitGridPoint encodingLength formula) = + (sourceFormulaGrid encodingLength formula).card := by + simp only [Fintype.card_coe] + rw [hcard] + exact lt_of_le_of_lt hproduct hgrid + +theorem explicitShiftedDegree_lt_grid + (encodingLength : ℕ) (formula : Formula) + (index : Fin (explicitMomentBudget encodingLength formula + 1)) : + (formula.variableCount - 1) * index.val < + Fintype.card (ExplicitGridPoint encodingLength formula) := by + exact lt_of_le_of_lt + (Nat.mul_le_mul_right index.val + (Nat.sub_le formula.variableCount 1)) + (explicitOrdinaryDegree_lt_grid + encodingLength formula index) + +/-- GapCVP reduction support. -/ +def explicitFamilyLinearMap + (encodingLength : ℕ) (formula : Formula) + (family : ExplicitConstraintFamily encodingLength formula) : + (Fin (sourceFormulaDimension encodingLength formula) → + sourceFormulaField encodingLength formula) →ₗ[ + sourceFormulaField encodingLength formula] + (Fin (explicitFamilyRowCount + encodingLength formula family) → + sourceFormulaField encodingLength formula) := by + let grid := sourceFormulaGrid encodingLength formula + let gridOrder := sourceFormulaExplicitGridOrder + encodingLength formula + rcases family with _ | family + · exact + (explicitFiniteReindexLinearEquiv gridOrder).toLinearMap.comp + (sourceGlobalNormalizationMap formula grid) + · rcases family with clause | family + · exact + (sourceFiniteReindexLinearEquiv + (K := sourceFormulaField encodingLength formula) + (ExplicitGridPoint encodingLength formula × + sourceFormulaField encodingLength formula)).toLinearMap.comp + (sourceClauseRefinementMap formula grid clause) + · rcases family with ordinary | shifted + · obtain ⟨tableType, moment⟩ := ordinary + exact + (constructiveParityLinearMap + (fun position => (gridOrder position).val) + (explicitOrdinaryDegree_lt_grid + encodingLength formula moment)).comp + ((explicitFiniteReindexLinearEquiv + gridOrder).toLinearMap.comp + (sourceOrdinaryMomentMap + formula grid tableType moment.val)) + · obtain ⟨clause, tuple, localVariable, moment⟩ := shifted + exact + (constructiveParityLinearMap + (fun position => (gridOrder position).val) + (explicitShiftedDegree_lt_grid + encodingLength formula moment)).comp + ((explicitFiniteReindexLinearEquiv + gridOrder).toLinearMap.comp + (sourceShiftedMomentMap + formula grid + (sourceFormulaVariablePlace + encodingLength formula) + clause tuple localVariable moment.val)) + +/-- GapCVP reduction support. -/ +def explicitFamilyTarget + (encodingLength : ℕ) (formula : Formula) + (family : ExplicitConstraintFamily encodingLength formula) : + Fin (explicitFamilyRowCount + encodingLength formula family) → + sourceFormulaField encodingLength formula := + fun _ => match family with + | .inl _ => 1 + | .inr _ => 0 + +private def explicitFamilyFieldMatrix + (encodingLength : ℕ) (formula : Formula) + (family : ExplicitConstraintFamily encodingLength formula) : + Matrix + (Fin (explicitFamilyRowCount + encodingLength formula family)) + (Fin (sourceFormulaDimension encodingLength formula)) + (sourceFormulaField encodingLength formula) := + LinearMap.toMatrix' + (explicitFamilyLinearMap encodingLength formula family) + +/-- GapCVP reduction support. -/ +abbrev sourceFormulaExplicitBinarySystem + (encodingLength : ℕ) (formula : Formula) : BinaryAffineSystem := + assembledBinaryAffineSystem + (sourceFormulaFieldBasis encodingLength formula) + (explicitFamilyRowCount encodingLength formula) + (explicitFamilyFieldMatrix encodingLength formula) + (explicitFamilyTarget encodingLength formula) + +theorem sourceFormulaExplicitBinarySystem_solves_iff_family + (encodingLength : ℕ) (formula : Formula) + (values : Fin (sourceFormulaDimension + encodingLength formula) → ℤ) : + (sourceFormulaExplicitBinarySystem + encodingLength formula).Solves values ↔ + ∀ family : ExplicitConstraintFamily encodingLength formula, + explicitFamilyLinearMap encodingLength formula family + (fun position => + algebraMap (ZMod 2) + (sourceFormulaField encodingLength formula) + (values position : ZMod 2)) = + explicitFamilyTarget encodingLength formula family := by + unfold sourceFormulaExplicitBinarySystem + rw [assembledBinaryAffineSystem_solves_iff] + simp only [explicitFamilyFieldMatrix, + LinearMap.toMatrix'_mulVec] + +end BinaryExplicitAffineSystem + +namespace BinarySourceRowOrder + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryExplicitAffineSystem + +attribute [local instance] Classical.propDecidable + +/-- GapCVP reduction support. -/ +def sourceFormulaExplicitRefinementOrder + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) : + Fin (Fintype.card + (ExplicitGridPoint encodingLength formula × + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula)) ≃ + ExplicitGridPoint encodingLength formula × + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula := by + let grid := ExplicitGridPoint encodingLength formula + let field := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula + have hcard : Fintype.card (grid × field) = + Fintype.card grid * Fintype.card field := by + simp only [Fintype.card_prod] + refine (finCongr hcard).trans ?_ + exact (finProdFinEquiv + (m := Fintype.card grid) + (n := Fintype.card field)).symm.trans + ((sourceFormulaExplicitGridOrder encodingLength formula).prodCongr + (GapCVP.BinarySourceCoordinateOrder.sourceFormulaFieldCardOrder + encodingLength formula)) + +end BinarySourceRowOrder + +namespace BinaryOrderedAssembly + +open GapCVP.Core + +variable {ι K : Type*} [Field K] [Algebra (ZMod 2) K] +variable {degree dimension rowCount : ℕ} + +/-- GapCVP reduction support. -/ +abbrev assembledBinaryAffineSystemOrdered + (basis : Module.Basis (Fin degree) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → + Matrix (Fin (rowCounts family)) (Fin dimension) K) + (targets : (family : ι) → Fin (rowCounts family) → K) + (rowOrder : Fin rowCount ≃ assembledBinaryRow rowCounts degree) : + BinaryAffineSystem where + rowCount := rowCount + dimension := dimension + check := fun row column => + assembledBinaryParityMatrix basis rowCounts checks + (rowOrder row) column + rightHandSide := fun row => + assembledBinaryRightHandSide basis rowCounts targets + (rowOrder row) + +@[simp] private theorem assembledBinaryAffineSystemOrdered_rightHandSide_apply + (basis : Module.Basis (Fin degree) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → + Matrix (Fin (rowCounts family)) (Fin dimension) K) + (targets : (family : ι) → Fin (rowCounts family) → K) + (rowOrder : Fin rowCount ≃ assembledBinaryRow rowCounts degree) + (row : Fin rowCount) : + (assembledBinaryAffineSystemOrdered + basis rowCounts checks targets rowOrder).rightHandSide row = + assembledBinaryRightHandSide basis rowCounts targets + (rowOrder row) := by + rfl + +@[simp] private theorem assembledBinaryAffineSystemOrdered_check_mulVec_apply + (basis : Module.Basis (Fin degree) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → + Matrix (Fin (rowCounts family)) (Fin dimension) K) + (targets : (family : ι) → Fin (rowCounts family) → K) + (rowOrder : Fin rowCount ≃ assembledBinaryRow rowCounts degree) + (bits : Fin dimension → ZMod 2) + (row : Fin rowCount) : + (assembledBinaryAffineSystemOrdered + basis rowCounts checks targets rowOrder).check.mulVec bits row = + (assembledBinaryParityMatrix + basis rowCounts checks).mulVec bits (rowOrder row) := by + rfl + +private theorem assembledBinaryAffineSystemOrdered_check_mulVec_eq_iff + (basis : Module.Basis (Fin degree) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → + Matrix (Fin (rowCounts family)) (Fin dimension) K) + (targets : (family : ι) → Fin (rowCounts family) → K) + (rowOrder : Fin rowCount ≃ assembledBinaryRow rowCounts degree) + (bits : Fin dimension → ZMod 2) : + (assembledBinaryAffineSystemOrdered + basis rowCounts checks targets rowOrder).check.mulVec bits = + (assembledBinaryAffineSystemOrdered + basis rowCounts checks targets rowOrder).rightHandSide ↔ + ∀ family : ι, + (checks family).mulVec + (fun position => algebraMap (ZMod 2) K (bits position)) = + targets family := by + constructor + · intro hordered + apply (assembledBinaryParityMatrix_mulVec_eq_iff + basis rowCounts checks bits targets).mp + funext row + have hrow := congrFun hordered (rowOrder.symm row) + rw [assembledBinaryAffineSystemOrdered_check_mulVec_apply, + assembledBinaryAffineSystemOrdered_rightHandSide_apply] at hrow + simpa only [assembledBinaryParityMatrix_mulVec_apply, Equiv.apply_symm_apply] using hrow + · intro hfamilies + have hrows := (assembledBinaryParityMatrix_mulVec_eq_iff + basis rowCounts checks bits targets).mpr hfamilies + funext row + rw [assembledBinaryAffineSystemOrdered_check_mulVec_apply, + assembledBinaryAffineSystemOrdered_rightHandSide_apply] + exact congrFun hrows (rowOrder row) + +theorem assembledBinaryAffineSystemOrdered_solves_iff + (basis : Module.Basis (Fin degree) (ZMod 2) K) + (rowCounts : ι → ℕ) + (checks : (family : ι) → + Matrix (Fin (rowCounts family)) (Fin dimension) K) + (targets : (family : ι) → Fin (rowCounts family) → K) + (rowOrder : Fin rowCount ≃ assembledBinaryRow rowCounts degree) + (values : Fin dimension → ℤ) : + (assembledBinaryAffineSystemOrdered + basis rowCounts checks targets rowOrder).Solves values ↔ + ∀ family : ι, + (checks family).mulVec + (fun position => algebraMap (ZMod 2) K + (values position : ZMod 2)) = + targets family := by + simp only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] + exact assembledBinaryAffineSystemOrdered_check_mulVec_eq_iff + basis rowCounts checks targets rowOrder (binaryResidue values) + +end BinaryOrderedAssembly + +namespace BinaryOrderedRefinement + +open GapCVP.Core GapCVP.BinaryExplicitAffineSystem GapCVP.BinarySourceRowOrder + +/-- GapCVP reduction support. -/ +def sourceFormulaPhysicalFamilyLinearMap + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (family : ExplicitConstraintFamily encodingLength formula) : + (Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) → + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) →ₗ[ + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula] + (Fin (explicitFamilyRowCount + encodingLength formula family) → + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) := by + rcases family with global | family + · exact explicitFamilyLinearMap + encodingLength formula (.inl global) + · rcases family with clause | family + · exact + (explicitFiniteReindexLinearEquiv + (sourceFormulaExplicitRefinementOrder + encodingLength formula)).toLinearMap.comp + (sourceClauseRefinementMap formula + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) clause) + · exact explicitFamilyLinearMap + encodingLength formula (.inr (.inr family)) + +/-- GapCVP reduction support. -/ +def sourceFormulaPhysicalFamilyFieldMatrix + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (family : ExplicitConstraintFamily encodingLength formula) : + Matrix + (Fin (explicitFamilyRowCount + encodingLength formula family)) + (Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula)) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) := + LinearMap.toMatrix' + (sourceFormulaPhysicalFamilyLinearMap + encodingLength formula family) + +theorem sourceFormulaPhysicalFamilyLinearMap_eq_iff_explicit + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (family : ExplicitConstraintFamily encodingLength formula) + (values : Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) → + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) : + sourceFormulaPhysicalFamilyLinearMap + encodingLength formula family values = + explicitFamilyTarget encodingLength formula family ↔ + explicitFamilyLinearMap + encodingLength formula family values = + explicitFamilyTarget encodingLength formula family := by + rcases family with global | family + · rfl + · rcases family with clause | family + · let grid := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula + let field := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula + let refinement := + sourceClauseRefinementMap formula grid clause values + change + (explicitFiniteReindexLinearEquiv + (sourceFormulaExplicitRefinementOrder + encodingLength formula)) refinement = 0 ↔ + (sourceFiniteReindexLinearEquiv + (K := field) + (ExplicitGridPoint encodingLength formula × field)) + refinement = 0 + exact + (explicitFiniteReindexLinearEquiv + (sourceFormulaExplicitRefinementOrder + encodingLength formula)).map_eq_zero_iff.trans + (sourceFiniteReindexLinearEquiv + (K := field) + (ExplicitGridPoint encodingLength formula × field)).map_eq_zero_iff.symm + · rfl + +end BinaryOrderedRefinement + +namespace BinaryExplicitFourFamilyKernel + +open GapCVP.Core GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryReedSolomonParity +open scoped BigOperators + +variable {K : Type*} [Field K] [Fintype K] + +private theorem ordinarySystematicParity_iff + (F : Formula) (points : Finset K) + {pointCount : ℕ} + (gridOrder : Fin pointCount ≃ sourceSATGridPoint points) + (tableType : sourceSATTableType F) (moment : ℕ) + (hdegree : F.variableCount * moment < pointCount) + (values : Fin (sourceSATTableDimension F K points) → K) : + (constructiveParityMatrix + (fun index => (gridOrder index).val) hdegree).mulVec + (fun index => + sourceOrdinaryMomentMap F points tableType moment values + (gridOrder index)) = 0 ↔ + sourceOrdinaryMomentMap F points tableType moment values ∈ + sourceReedSolomonCode points (F.variableCount * moment) := by + rw [constructiveParityMatrix_mulVec_eq_zero_iff_polynomial + (fun index => (gridOrder index).val) hdegree + (Subtype.val_injective.comp gridOrder.injective), + sourceReedSolomonCode_mem_iff] + refine exists_congr fun polynomial => ?_ + exact and_congr Iff.rfl (gridOrder.forall_congr fun _ => Iff.rfl) + +private theorem shiftedSystematicParity_iff + (F : Formula) (points : Finset K) + (variablePlace : Fin F.variableCount → K) + {pointCount : ℕ} + (gridOrder : Fin pointCount ≃ sourceSATGridPoint points) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (moment : ℕ) + (hdegree : (F.variableCount - 1) * moment < pointCount) + (values : Fin (sourceSATTableDimension F K points) → K) : + (constructiveParityMatrix + (fun index => (gridOrder index).val) hdegree).mulVec + (fun index => + sourceShiftedMomentMap F points variablePlace + clause tuple localVar moment values + (gridOrder index)) = 0 ↔ + sourceShiftedMomentMap F points variablePlace + clause tuple localVar moment values ∈ + sourceReedSolomonCode points + ((F.variableCount - 1) * moment) := by + rw [constructiveParityMatrix_mulVec_eq_zero_iff_polynomial + (fun index => (gridOrder index).val) hdegree + (Subtype.val_injective.comp gridOrder.injective), + sourceReedSolomonCode_mem_iff] + refine exists_congr fun polynomial => ?_ + exact and_congr Iff.rfl (gridOrder.forall_congr fun _ => Iff.rfl) + +theorem sourceFormulaExplicitBinarySystem_solves_iff_concreteSATFieldChecks + (encodingLength : ℕ) (formula : Formula) + (z : Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) → ℤ) : + (sourceFormulaExplicitBinarySystem + encodingLength formula).Solves z ↔ + concreteSATFieldChecks formula + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength formula) + (sourceSizeParameter encodingLength formula ^ 30) + (fun position => + algebraMap (ZMod 2) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) + (z position : ZMod 2)) := by + classical + rw [sourceFormulaExplicitBinarySystem_solves_iff_family] + let grid := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula + let gridOrder := sourceFormulaExplicitGridOrder + encodingLength formula + let values : Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) → + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula := + fun position => algebraMap (ZMod 2) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) + (z position : ZMod 2) + change + (∀ family : ExplicitConstraintFamily encodingLength formula, + explicitFamilyLinearMap encodingLength formula family values = + explicitFamilyTarget encodingLength formula family) ↔ + concreteSATFieldChecks formula grid + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength formula) + (explicitMomentBudget encodingLength formula) values + simp only [GapCVP.Core.concreteSATFieldChecks, decide_eq_true_eq] + constructor + · intro hfamilies + refine ⟨?_, ?_, ?_, ?_⟩ + · funext point + have hpoint := congrFun (hfamilies (.inl ())) + (gridOrder.symm point) + change + sourceGlobalNormalizationMap formula grid values + (gridOrder (gridOrder.symm point)) = 1 at hpoint + simpa only [Equiv.apply_symm_apply] using hpoint + · intro clause + funext position + let refinementOrder := Fintype.equivFin + (ExplicitGridPoint encodingLength formula × + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) + have hposition := + congrFun (hfamilies (.inr (.inl clause))) + (refinementOrder position) + change + sourceClauseRefinementMap formula grid clause values + (refinementOrder.symm (refinementOrder position)) = 0 + at hposition + simpa only [Pi.zero_apply, Equiv.symm_apply_apply] using hposition + · intro tableType moment + apply (ordinarySystematicParity_iff + formula grid gridOrder tableType moment.val + (explicitOrdinaryDegree_lt_grid + encodingLength formula moment) values).mp + rw [constructiveParityMatrix, LinearMap.toMatrix'_mulVec] + have hmoment := hfamilies + (.inr (.inr (.inl (tableType, moment)))) + change + constructiveParityLinearMap + (fun position => (gridOrder position).val) + (explicitOrdinaryDegree_lt_grid + encodingLength formula moment) + (fun position => + sourceOrdinaryMomentMap formula grid tableType moment.val + values (gridOrder position)) = 0 at hmoment + exact hmoment + · intro clause tuple localVar moment + apply (shiftedSystematicParity_iff + formula grid + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength formula) + gridOrder clause tuple localVar moment.val + (explicitShiftedDegree_lt_grid + encodingLength formula moment) values).mp + rw [constructiveParityMatrix, LinearMap.toMatrix'_mulVec] + have hmoment := hfamilies + (.inr (.inr (.inr ⟨clause, tuple, localVar, moment⟩))) + change + constructiveParityLinearMap + (fun position => (gridOrder position).val) + (explicitShiftedDegree_lt_grid + encodingLength formula moment) + (fun position => + sourceShiftedMomentMap formula grid + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength formula) + clause tuple localVar moment.val + values (gridOrder position)) = 0 at hmoment + exact hmoment + · rintro ⟨hnormalization, hrefinement, hordinary, hshifted⟩ + intro family + rcases family with _ | family + · change + explicitFiniteReindexLinearEquiv gridOrder + (sourceGlobalNormalizationMap formula grid values) = + fun _ => 1 + rw [hnormalization] + rfl + · rcases family with clause | family + · change + sourceFiniteReindexLinearEquiv + (K := GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) + (ExplicitGridPoint encodingLength formula × + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula) + (sourceClauseRefinementMap formula grid clause values) = 0 + rw [hrefinement clause] + exact map_zero _ + · rcases family with ordinary | shifted + · obtain ⟨tableType, moment⟩ := ordinary + change + constructiveParityLinearMap + (fun position => (gridOrder position).val) + (explicitOrdinaryDegree_lt_grid + encodingLength formula moment) + (fun position => + sourceOrdinaryMomentMap formula grid tableType moment.val + values (gridOrder position)) = 0 + rw [← LinearMap.toMatrix'_mulVec] + exact (ordinarySystematicParity_iff + formula grid gridOrder tableType moment.val + (explicitOrdinaryDegree_lt_grid + encodingLength formula moment) values).mpr + (hordinary tableType moment) + · obtain ⟨clause, tuple, localVar, moment⟩ := shifted + change + constructiveParityLinearMap + (fun position => (gridOrder position).val) + (explicitShiftedDegree_lt_grid + encodingLength formula moment) + (fun position => + sourceShiftedMomentMap formula grid + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength formula) + clause tuple localVar moment.val + values (gridOrder position)) = 0 + rw [← LinearMap.toMatrix'_mulVec] + exact (shiftedSystematicParity_iff + formula grid + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength formula) + gridOrder clause tuple localVar moment.val + (explicitShiftedDegree_lt_grid + encodingLength formula moment) values).mpr + (hshifted clause tuple localVar moment) + +theorem integerSquaredNorm_wordOrder + {newDimension oldDimension : ℕ} + (columnOrder : Fin newDimension ≃ Fin oldDimension) + (vector : Fin newDimension → ℤ) : + integerSquaredNorm + (fun column => vector (columnOrder.symm column)) = + integerSquaredNorm vector := by + unfold integerSquaredNorm + exact Equiv.sum_comp columnOrder.symm + (fun column : Fin newDimension => (vector column).natAbs ^ 2) + +@[simp] private theorem binaryResidue_wordOrder + {newDimension oldDimension : ℕ} + (columnOrder : Fin newDimension ≃ Fin oldDimension) + (vector : Fin newDimension → ℤ) : + binaryResidue (fun column => vector (columnOrder.symm column)) = + (fun column => binaryResidue vector (columnOrder.symm column)) := by + rfl + +/-- GapCVP reduction support. -/ +abbrev reindexBinaryAffineSystem + {rowCount dimension : ℕ} + (system : BinaryAffineSystem) + (rowOrder : Fin rowCount ≃ Fin system.rowCount) + (columnOrder : Fin dimension ≃ Fin system.dimension) : + BinaryAffineSystem where + rowCount := rowCount + dimension := dimension + check := system.check.submatrix rowOrder columnOrder + rightHandSide := fun row => system.rightHandSide (rowOrder row) + +theorem reindexBinaryAffineSystem_solves_iff + {rowCount dimension : ℕ} + (system : BinaryAffineSystem) + (rowOrder : Fin rowCount ≃ Fin system.rowCount) + (columnOrder : Fin dimension ≃ Fin system.dimension) + (vector : Fin dimension → ℤ) : + (reindexBinaryAffineSystem system rowOrder columnOrder).Solves vector ↔ + system.Solves + (fun column => vector (columnOrder.symm column)) := by + simp only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] + change + (system.check.submatrix rowOrder columnOrder).mulVec + (binaryResidue vector) = + (fun row => system.rightHandSide (rowOrder row)) ↔ + system.check.mulVec + (binaryResidue + (fun column => vector (columnOrder.symm column))) = + system.rightHandSide + rw [Matrix.submatrix_mulVec_equiv] + have hresidue : + (binaryResidue vector) ∘ columnOrder.symm = + binaryResidue + (fun column => vector (columnOrder.symm column)) := by + funext column + rfl + rw [hresidue] + constructor + · intro hsolve + funext row + have hrow := congrFun hsolve (rowOrder.symm row) + simpa only [binaryResidue_wordOrder, Function.comp_apply, Equiv.apply_symm_apply] using hrow + · intro hsolve + funext row + exact congrFun hsolve (rowOrder row) + +end BinaryExplicitFourFamilyKernel + +namespace Factor400BinaryConstructiveSourcePlaces + +section + +open GapCVP.Core +open scoped BigOperators +open Finset Polynomial + +private def sourceFormulaSignedTableFiberSupports + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (tableType : sourceSATTableType F) : + sourceFormulaField encodingLength F → + Finset (sourceFormulaField encodingLength F) := + sourceSignedFiberSupportAt F + (sourceFormulaGrid encodingLength F) z tableType + +/-- GapCVP reduction support. -/ +def sourceFormulaSignedTableOrdinaryMomentPolynomials + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) : + ℕ → (sourceFormulaField encodingLength F)[X] := by + classical + exact sourceSignedOrdinaryMomentPolynomials F + (sourceFormulaFieldBasis encodingLength F) + (sourceFormulaGrid encodingLength F) + (sourceFormulaVariablePlace encodingLength F) + (sourceSizeParameter encodingLength F ^ 30) + z hz tableType + +theorem sourceFormulaSignedTableOrdinaryMomentPolynomials_natDegree + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) + (j : ℕ) : + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType j).natDegree ≤ + F.variableCount * j := by + classical + exact sourceSignedOrdinaryMomentPolynomials_natDegree F + (sourceFormulaFieldBasis encodingLength F) + (sourceFormulaGrid encodingLength F) + (sourceFormulaVariablePlace encodingLength F) + (sourceSizeParameter encodingLength F ^ 30) + z hz tableType j + +private theorem sourceFormulaSignedTableOrdinaryMomentPolynomials_eval + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) + (point : sourceFormulaField encodingLength F) + (hpoint : point ∈ sourceFormulaGrid encodingLength F) + (j : ℕ) (hj : j ≤ sourceSizeParameter encodingLength F ^ 30) : + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType j).eval point = + supportMoment + (sourceFormulaSignedTableFiberSupports + encodingLength F z tableType point) j := by + simpa only [sourceFormulaSignedTableOrdinaryMomentPolynomials, + sourceFormulaSignedTableFiberSupports, + sourceSignedFiberSupportAt, hpoint, ↓reduceDIte] using + sourceSignedOrdinaryMomentPolynomials_eval F (sourceFormulaFieldBasis encodingLength F) + (sourceFormulaGrid encodingLength F) (sourceFormulaVariablePlace encodingLength F) + (sourceSizeParameter encodingLength F ^ 30) z hz tableType ⟨point, hpoint⟩ j hj + +private theorem sourceFormulaSignedTable_globalGenericRank_pos + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) : + 0 < maximalGenericHankelRank + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inl ())) + (sourceSizeParameter encodingLength F ^ 4) := by + classical + obtain ⟨point, hpoint⟩ := + Finset.card_pos.mp (sourceFormulaGrid_card_pos encodingLength F) + apply maximalGenericHankelRank_pos_of_normalized_moment + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inl ())) + (sourceSizeParameter encodingLength F ^ 4) point + · exact pow_pos + (lt_of_lt_of_le (by norm_num) + (sourceSizeParameter_ge_one_hundred encodingLength F)) _ + · rw [sourceFormulaSignedTableOrdinaryMomentPolynomials_eval + encodingLength F z hz (.inl ()) point hpoint 0 (Nat.zero_le _)] + simpa only [sourceFormulaSignedTableFiberSupports, sourceSignedFiberSupportAt, hpoint, + ↓reduceDIte, + List.get_eq_getElem] using + sourceSigned_globalSupportMoment_zero F (sourceFormulaFieldBasis encodingLength F) + (sourceFormulaGrid encodingLength F) (sourceFormulaVariablePlace encodingLength F) + (sourceSizeParameter encodingLength F ^ 30) z hz ⟨point, hpoint⟩ + +/-- GapCVP reduction support. -/ +def sourceFormulaSignedTableShiftedMomentPolynomials + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) : + ℕ → (sourceFormulaField encodingLength F)[X] := by + classical + exact sourceSignedShiftedMomentPolynomials F + (sourceFormulaFieldBasis encodingLength F) + (sourceFormulaGrid encodingLength F) + (sourceFormulaVariablePlace encodingLength F) + (sourceSizeParameter encodingLength F ^ 30) + z hz clause tuple localVar + +private theorem sourceFormula_testedMomentDegree_lt_grid + (encodingLength : ℕ) (F : Formula) + (j : ℕ) (hj : j ≤ sourceSizeParameter encodingLength F ^ 30) : + F.variableCount * j < (sourceFormulaGrid encodingLength F).card := by + let N := sourceSizeParameter encodingLength F + calc + F.variableCount * j ≤ N * N ^ 30 := by + exact Nat.mul_le_mul (source_variableCount_le_size encodingLength F) hj + _ = N ^ 31 := by + rw [show (31 : ℕ) = 1 + 30 by norm_num, pow_add, pow_one] + _ < (sourceFormulaGrid encodingLength F).card := + sourceFormulaGrid_max_degree_lt encodingLength F + +private theorem sourceFormulaSignedTable_shiftedMomentPolynomial_identity + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (j : ℕ) (hj : j ≤ sourceSizeParameter encodingLength F ^ 30) : + (Polynomial.X - Polynomial.C + (sourceFormulaVariablePlace encodingLength F localVar.val)) ^ j * + sourceFormulaSignedTableShiftedMomentPolynomials + encodingLength F z hz clause tuple localVar j = + shiftedMomentCombination + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inr ⟨clause, tuple⟩)) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar)) j := by + classical + apply sourceSigned_shiftedMomentPolynomial_identity F + (sourceFormulaFieldBasis encodingLength F) + (sourceFormulaGrid encodingLength F) + (sourceFormulaVariablePlace encodingLength F) + (sourceSizeParameter encodingLength F ^ 30) + z hz clause tuple localVar j hj + · intro point + exact sourceSATPuncturedGrid_sub_ne_zero F + (sourceFormulaVariablePlace encodingLength F) point localVar.val + · exact sourceFormula_testedMomentDegree_lt_grid encodingLength F j hj + +end + +section + +open GapCVP.Core Finset Polynomial + +private theorem scaledSupport_div_ten_mul_le_field + {N q budget : ℕ} + (hscaled : 10 * budget ≤ q * N ^ 4) : + 10 * (budget / (N ^ 4 + 1)) ≤ q := by + have hdiv : + (budget / (N ^ 4 + 1)) * (N ^ 4 + 1) ≤ budget := + Nat.div_mul_le_self budget (N ^ 4 + 1) + have hproduct : + (10 * (budget / (N ^ 4 + 1))) * (N ^ 4 + 1) ≤ + q * (N ^ 4 + 1) := by + calc + (10 * (budget / (N ^ 4 + 1))) * (N ^ 4 + 1) = + 10 * ((budget / (N ^ 4 + 1)) * (N ^ 4 + 1)) := by ring + _ ≤ 10 * budget := Nat.mul_le_mul_left 10 hdiv + _ ≤ q * N ^ 4 := hscaled + _ ≤ q * (N ^ 4 + 1) := Nat.mul_le_mul_left q (by omega) + exact Nat.le_of_mul_le_mul_right hproduct + (Nat.zero_lt_succ (N ^ 4)) + +private theorem scaledSupport_maximalGenericGoodFiberPoints_card + {K : Type*} [Field K] + (N q m d : ℕ) + (points : Finset K) + (supports : K → Finset K) + (moments : ℕ → K[X]) + (hN : 100 ≤ N) + (hq : N ^ 200 ≤ q) + (hm : m ≤ N) + (hd : d ≤ N) + (hpoints : points.card = q - m) + (hmoments : ∀ j : ℕ, (moments j).natDegree ≤ d * j) + (budget : ℕ) + (hweight : (∑ point ∈ points, (supports point).card) ≤ budget) + (hscaled : 10 * budget ≤ q * N ^ 4) : + 2 * N ^ 39 < + (maximalGenericGoodFiberPoints + points supports moments (N ^ 4)).card := by + classical + have hbudget : + 10 * (budget / (N ^ 4 + 1)) ≤ q := + scaledSupport_div_ten_mul_le_field hscaled + have hexceptions := + source_variable_and_hankel_exceptions_ten_mul_le_field_size + hN hq hm + have hdenominator : + (genericHankelDenominator + (maximalGenericHankelRank moments (N ^ 4)) + moments).natDegree ≤ N ^ 9 := + source_hankel_denominator_natDegree_le_power moments hd + (maximalGenericHankelRank_spec moments (N ^ 4)).1 + hmoments + have hlower := maximalGenericGoodFiberPoints_card_lower_bound + points supports moments (N ^ 4) budget hweight + have hclear := source_cleared_moment_degree_lt_half_field_size hN hq + have hqpositive : 0 < q := + (pow_pos (show 0 < N by omega) 200).trans_le hq + have hhalf : 2 * (q / 2) ≤ q := by omega + omega + +private theorem sourceFormulaSignedTable_maximalGoodFiberPoints_card_of_scaledNorm + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hscaled : + 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + 2 * sourceSizeParameter encodingLength F ^ 39 < + (maximalGenericGoodFiberPoints + (sourceFormulaGrid encodingLength F) + (sourceFormulaSignedTableFiberSupports + encodingLength F z tableType) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + (sourceSizeParameter encodingLength F ^ 4)).card := by + classical + apply scaledSupport_maximalGenericGoodFiberPoints_card + (sourceSizeParameter encodingLength F) + (Fintype.card (sourceFormulaField encodingLength F)) + F.variableCount F.variableCount + (sourceFormulaGrid encodingLength F) + (sourceFormulaSignedTableFiberSupports + encodingLength F z tableType) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + (sourceSizeParameter_ge_one_hundred encodingLength F) + (sourceFiniteField_card_lower + (sourceSizeParameter_ge_one_hundred encodingLength F)) + (source_variableCount_le_size encodingLength F) + (source_variableCount_le_size encodingLength F) + (sourceFormulaGrid_card encodingLength F) + (sourceFormulaSignedTableOrdinaryMomentPolynomials_natDegree + encodingLength F z hz tableType) + (integerSquaredNorm z) + · exact sourceSignedFiberSupportAt_grid_budget F + (sourceFormulaGrid encodingLength F) z tableType + · exact hscaled + +private theorem sourceFormulaSignedTable_genericMoments_eq_rootMoments_of_scaledNorm + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hscaled : + 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) + {E : Type*} [Field E] + [Algebra (sourceFormulaField encodingLength F) E] + [Algebra (RatFunc (sourceFormulaField encodingLength F)) E] + [IsScalarTower (sourceFormulaField encodingLength F) + (RatFunc (sourceFormulaField encodingLength F)) E] + (roots : Fin (maximalGenericHankelRank + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + (sourceSizeParameter encodingLength F ^ 4)) → E) + (hroots : + (genericMomentSupportPolynomial + (maximalGenericHankelRank + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + (sourceSizeParameter encodingLength F ^ 4)) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType)).map + (algebraMap (RatFunc (sourceFormulaField encodingLength F)) E) = + rootSupportPolynomial roots) + (j : ℕ) (hj : j ≤ sourceSizeParameter encodingLength F ^ 30) : + algebraMap (RatFunc (sourceFormulaField encodingLength F)) E + (algebraMap + (sourceFormulaField encodingLength F)[X] + (RatFunc (sourceFormulaField encodingLength F)) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType j)) = + rootMoment roots j := by + classical + apply sourceGenericMoments_eq_rootMoments + (sourceFormulaGrid encodingLength F) + (sourceFormulaSignedTableFiberSupports + encodingLength F z tableType) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + (sourceSizeParameter encodingLength F) F.variableCount + (sourceSizeParameter_ge_one_hundred encodingLength F) + (source_variableCount_le_size encodingLength F) + (fun point hpoint k hk => + sourceFormulaSignedTableOrdinaryMomentPolynomials_eval + encodingLength F z hz tableType point hpoint k hk) + (sourceFormulaSignedTableOrdinaryMomentPolynomials_natDegree + encodingLength F z hz tableType) + (sourceFormulaSignedTable_maximalGoodFiberPoints_card_of_scaledNorm + encodingLength F z hz hscaled tableType) + roots hroots j hj + +end + +section + +open GapCVP.Core + +export GapCVP.Core + (genericMomentSupportPolynomial_natDegree + rootSupportPolynomial_finiteSupportRoots + exists_injective_roots_of_monic_separable_splits + mem_enumeratedRootSupport_iff + sourceParitySupport_card_le + genericRoot_mem_subtype_of_characteristicTwo_moments) + +open scoped BigOperators symmDiff +open Polynomial Finset + +private theorem sourceFormulaSignedTable_globalOrdinaryMoment_eq_clauseSubtypeSum + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (clause : Fin F.clauses.length) + (j : ℕ) (hj : j ≤ sourceSizeParameter encodingLength F ^ 30) : + sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inl ()) j = + ∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inr ⟨clause, tuple⟩) j := by + classical + apply polynomial_eq_of_agree_on_points (sourceFormulaGrid encodingLength F) + · refine lt_of_le_of_lt (max_le + (sourceFormulaSignedTableOrdinaryMomentPolynomials_natDegree + encodingLength F z hz (.inl ()) j) + (by + apply Polynomial.natDegree_sum_le_of_forall_le + intro tuple _ + exact sourceFormulaSignedTableOrdinaryMomentPolynomials_natDegree + encodingLength F z hz (.inr ⟨clause, tuple⟩) j)) + (sourceFormula_testedMomentDegree_lt_grid encodingLength F j hj) + · intro point hpoint + simp_rw [Polynomial.eval_finsetSum, + sourceFormulaSignedTableOrdinaryMomentPolynomials_eval + encodingLength F z hz _ point hpoint j hj] + simpa only [sourceFormulaSignedTableFiberSupports, sourceSignedFiberSupportAt, hpoint, + ↓reduceDIte, + List.get_eq_getElem] using + sourceSigned_globalSupportMoment_eq_clauseSubtypeSum F (sourceFormulaFieldBasis + encodingLength F) + (sourceFormulaGrid encodingLength F) (sourceFormulaVariablePlace encodingLength F) + (sourceSizeParameter encodingLength F ^ 30) z hz clause ⟨point, hpoint⟩ j + +/-- GapCVP reduction support. -/ +def sourceFormulaGenericRank + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) : ℕ := + maximalGenericHankelRank + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + (sourceSizeParameter encodingLength F ^ 4) + +/-- GapCVP reduction support. -/ +def sourceFormulaGenericSupportPolynomial + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) : + (RatFunc (sourceFormulaField encodingLength F))[X] := + genericMomentSupportPolynomial + (sourceFormulaGenericRank encodingLength F z hz tableType) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + +theorem sourceFormulaGenericRank_le + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) : + sourceFormulaGenericRank encodingLength F z hz tableType ≤ + sourceSizeParameter encodingLength F ^ 4 := + (maximalGenericHankelRank_spec + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + (sourceSizeParameter encodingLength F ^ 4)).1 + +private theorem sourceFormulaGenericSupportPolynomial_monic + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) : + (sourceFormulaGenericSupportPolynomial + encodingLength F z hz tableType).Monic := + genericMomentSupportPolynomial_monic + (sourceFormulaGenericRank encodingLength F z hz tableType) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + +private theorem sourceFormulaGenericSupportPolynomial_separable + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + (sourceFormulaGenericSupportPolynomial + encodingLength F z hz tableType).Separable := by + classical + let points := sourceFormulaGrid encodingLength F + let supports := sourceFormulaSignedTableFiberSupports encodingLength F z tableType + let moments := sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType + let rankBound := sourceSizeParameter encodingLength F ^ 4 + let momentBudget := sourceSizeParameter encodingLength F ^ 30 + obtain ⟨point, hpoint⟩ := Finset.card_pos.mp <| + (Nat.zero_le _).trans_lt <| + sourceFormulaSignedTable_maximalGoodFiberPoints_card_of_scaledNorm + encodingLength F z hz hshort tableType + have hp := (mem_maximalGenericGoodFiberPoints + points supports moments rankBound point).mp hpoint + have budget : 2 * rankBound ≤ momentBudget + 1 := by + have bound := source_clause_support_lt_moment_budget + (sourceSizeParameter_ge_one_hundred encodingLength F) + dsimp [rankBound, momentBudget] + omega + have card := maximalGenericGoodFiberPoints_card_eq_rank + points supports moments rankBound momentBudget budget + (fun point hp j hj => sourceFormulaSignedTableOrdinaryMomentPolynomials_eval + encodingLength F z hz tableType point hp j hj) point hpoint + change (genericMomentSupportPolynomial + (maximalGenericHankelRank moments rankBound) moments).Separable + rw [← card] + apply genericMomentSupportPolynomial_separable + moments point (finiteSupportRoots (supports point)) + (finiteSupportRoots_injective (supports point)) + intro j hj + exact (sourceFormulaSignedTableOrdinaryMomentPolynomials_eval + encodingLength F z hz tableType point hp.1 j (by omega)).trans + (rootMoment_finiteSupportRoots (supports point) j).symm + +/-- GapCVP reduction support. -/ +def sourceFormulaGenericSupportFamily + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) : + Fin (Fintype.card (sourceSATTableType F)) → + (RatFunc (sourceFormulaField encodingLength F))[X] := + fun index => + sourceFormulaGenericSupportPolynomial + encodingLength F z hz + ((Fintype.equivFin (sourceSATTableType F)).symm index) + +/-- GapCVP reduction support. -/ +abbrev SourceFormulaCommonSeparableSplittingField + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) := + CommonSeparableSplittingField + (sourceFormulaGenericSupportFamily encodingLength F z hz) + +private theorem sourceFormulaCommonSeparableSplittingField_splits + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + ((sourceFormulaGenericSupportPolynomial + encodingLength F z hz tableType).map + (algebraMap (RatFunc (sourceFormulaField encodingLength F)) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz))).Splits := by + let family := sourceFormulaGenericSupportFamily encodingLength F z hz + let index := Fintype.equivFin (sourceSATTableType F) tableType + have hnonzero : ∀ i, family i ≠ 0 := by + intro i + exact + (sourceFormulaGenericSupportPolynomial_monic + encodingLength F z hz + ((Fintype.equivFin (sourceSATTableType F)).symm i)).ne_zero + have hseparable : ∀ i, (family i).Separable := by + intro i + exact sourceFormulaGenericSupportPolynomial_separable + encodingLength F z hz hshort + ((Fintype.equivFin (sourceSATTableType F)).symm i) + simpa [family, index, sourceFormulaGenericSupportFamily] using + commonSeparableSplittingField_splits family hnonzero hseparable index + +private theorem sourceFormulaCommonRoots_exists + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + ∃ roots : Fin (sourceFormulaGenericRank + encodingLength F z hz tableType) → + SourceFormulaCommonSeparableSplittingField + encodingLength F z hz, + Function.Injective roots ∧ + (sourceFormulaGenericSupportPolynomial + encodingLength F z hz tableType).map + (algebraMap (RatFunc (sourceFormulaField encodingLength F)) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz)) = + rootSupportPolynomial roots := by + let polynomial := + (sourceFormulaGenericSupportPolynomial + encodingLength F z hz tableType).map + (algebraMap (RatFunc (sourceFormulaField encodingLength F)) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz)) + have hdegree : polynomial.natDegree = + sourceFormulaGenericRank encodingLength F z hz tableType := by + simp [polynomial, sourceFormulaGenericSupportPolynomial, + genericMomentSupportPolynomial_natDegree] + change ∃ roots : Fin (sourceFormulaGenericRank + encodingLength F z hz tableType) → + SourceFormulaCommonSeparableSplittingField encodingLength F z hz, + Function.Injective roots ∧ polynomial = rootSupportPolynomial roots + rw [← hdegree] + exact exists_injective_roots_of_monic_separable_splits polynomial + ((sourceFormulaGenericSupportPolynomial_monic + encodingLength F z hz tableType).map _) + (sourceFormulaGenericSupportPolynomial_separable + encodingLength F z hz hshort tableType).map + (sourceFormulaCommonSeparableSplittingField_splits + encodingLength F z hz hshort tableType) + +/-- GapCVP reduction support. -/ +def sourceFormulaCommonRoots + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + Fin (sourceFormulaGenericRank encodingLength F z hz tableType) → + SourceFormulaCommonSeparableSplittingField + encodingLength F z hz := + Classical.choose + (sourceFormulaCommonRoots_exists encodingLength F z hz hshort tableType) + +theorem sourceFormulaCommonRoots_injective + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + Function.Injective + (sourceFormulaCommonRoots + encodingLength F z hz hshort tableType) := + (Classical.choose_spec + (sourceFormulaCommonRoots_exists + encodingLength F z hz hshort tableType)).1 + +theorem sourceFormulaCommonRoots_rootSupport + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + (sourceFormulaGenericSupportPolynomial + encodingLength F z hz tableType).map + (algebraMap (RatFunc (sourceFormulaField encodingLength F)) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz)) = + rootSupportPolynomial + (sourceFormulaCommonRoots + encodingLength F z hz hshort tableType) := + (Classical.choose_spec + (sourceFormulaCommonRoots_exists + encodingLength F z hz hshort tableType)).2 + +/-- GapCVP reduction support. -/ +def sourceFormulaCommonRootSupport + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + Finset (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) := + enumeratedRootSupport + (sourceFormulaCommonRoots encodingLength F z hz hshort tableType) + +private theorem sourceFormulaCommonRootSupport_card + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) : + (sourceFormulaCommonRootSupport + encodingLength F z hz hshort tableType).card = + sourceFormulaGenericRank encodingLength F z hz tableType := + enumeratedRootSupport_card + (sourceFormulaCommonRoots encodingLength F z hz hshort tableType) + (sourceFormulaCommonRoots_injective + encodingLength F z hz hshort tableType) + +private theorem sourceFormulaGlobalGenericRank_pos + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) : + 0 < sourceFormulaGenericRank encodingLength F z hz (.inl ()) := + sourceFormulaSignedTable_globalGenericRank_pos encodingLength F z hz + +/-- GapCVP reduction support. -/ +def sourceFormulaGlobalGenericRoot + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) : + SourceFormulaCommonSeparableSplittingField + encodingLength F z hz := + sourceFormulaCommonRoots + encodingLength F z hz hshort (.inl ()) + ⟨0, sourceFormulaGlobalGenericRank_pos encodingLength F z hz⟩ + +theorem sourceFormulaCommonRoots_moment + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (tableType : sourceSATTableType F) + (j : ℕ) (hj : j ≤ sourceSizeParameter encodingLength F ^ 30) : + algebraMap (RatFunc (sourceFormulaField encodingLength F)) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (algebraMap + (sourceFormulaField encodingLength F)[X] + (RatFunc (sourceFormulaField encodingLength F)) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType j)) = + rootMoment + (sourceFormulaCommonRoots + encodingLength F z hz hshort tableType) j := + sourceFormulaSignedTable_genericMoments_eq_rootMoments_of_scaledNorm + encodingLength F z hz hshort tableType + (sourceFormulaCommonRoots encodingLength F z hz hshort tableType) + (sourceFormulaCommonRoots_rootSupport + encodingLength F z hz hshort tableType) j hj + +private def sourceFormulaClauseRootSupports + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) : + List (Finset (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz)) := + List.ofFn + (fun index : Fin + (Fintype.card (F.clauses.get clause).SatisfyingLocalTuple) => + sourceFormulaCommonRootSupport + encodingLength F z hz hshort + (.inr ⟨clause, + (Fintype.equivFin + (F.clauses.get clause).SatisfyingLocalTuple).symm index⟩)) + +private theorem sourceFormulaClauseRootSupports_sum_card_le + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) : + ((sourceFormulaClauseRootSupports + encodingLength F z hz hshort clause).map Finset.card).sum ≤ + Fintype.card (F.clauses.get clause).SatisfyingLocalTuple * + sourceSizeParameter encodingLength F ^ 4 := by + classical + unfold sourceFormulaClauseRootSupports + rw [List.map_ofFn, List.sum_ofFn] + calc + (∑ index : Fin + (Fintype.card (F.clauses.get clause).SatisfyingLocalTuple), + (sourceFormulaCommonRootSupport + encodingLength F z hz hshort + (.inr ⟨clause, + (Fintype.equivFin + (F.clauses.get clause).SatisfyingLocalTuple).symm index⟩)).card) + ≤ ∑ _index : Fin + (Fintype.card (F.clauses.get clause).SatisfyingLocalTuple), + sourceSizeParameter encodingLength F ^ 4 := by + apply Finset.sum_le_sum + intro index _ + rw [sourceFormulaCommonRootSupport_card] + exact sourceFormulaGenericRank_le encodingLength F z hz + (.inr ⟨clause, + (Fintype.equivFin + (F.clauses.get clause).SatisfyingLocalTuple).symm index⟩) + _ = Fintype.card (F.clauses.get clause).SatisfyingLocalTuple * + sourceSizeParameter encodingLength F ^ 4 := by simp only [List.get_eq_getElem, sum_const, + card_univ, Fintype.card_fin, smul_eq_mul] + +private theorem sourceFormulaCommonGlobalRootMoment_eq_clauseSubtypeSum + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) + (j : ℕ) (hj : j ≤ sourceSizeParameter encodingLength F ^ 30) : + rootMoment + (sourceFormulaCommonRoots + encodingLength F z hz hshort (.inl ())) j = + ((sourceFormulaClauseRootSupports + encodingLength F z hz hshort clause).map + (fun subtype => supportMoment subtype j)).sum := by + classical + calc + rootMoment + (sourceFormulaCommonRoots encodingLength F z hz hshort (.inl ())) j = + algebraMap (RatFunc (sourceFormulaField encodingLength F)) + (SourceFormulaCommonSeparableSplittingField encodingLength F z hz) + (algebraMap (sourceFormulaField encodingLength F)[X] + (RatFunc (sourceFormulaField encodingLength F)) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inl ()) j)) := + (sourceFormulaCommonRoots_moment + encodingLength F z hz hshort (.inl ()) j hj).symm + _ = ∑ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + rootMoment (sourceFormulaCommonRoots + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩)) j := by + rw [sourceFormulaSignedTable_globalOrdinaryMoment_eq_clauseSubtypeSum + encodingLength F z hz clause j hj] + simp only [map_sum] + apply Finset.sum_congr rfl + intro tuple _ + exact sourceFormulaCommonRoots_moment + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩) j hj + _ = _ := by + unfold sourceFormulaClauseRootSupports sourceFormulaCommonRootSupport + rw [List.map_ofFn, List.sum_ofFn] + rw [← Equiv.sum_comp + (Fintype.equivFin (F.clauses.get clause).SatisfyingLocalTuple).symm] + apply Finset.sum_congr rfl + intro tuple _ + exact (supportMoment_enumeratedRootSupport + (sourceFormulaCommonRoots encodingLength F z hz hshort + (.inr ⟨clause, (Fintype.equivFin _).symm tuple⟩)) + (sourceFormulaCommonRoots_injective encodingLength F z hz hshort + (.inr ⟨clause, (Fintype.equivFin _).symm tuple⟩)) j).symm + +private theorem sourceFormulaCommonGlobalRoot_mem_satisfyingSubtype + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) + (index : Fin + (sourceFormulaGenericRank encodingLength F z hz (.inl ()))) : + ∃ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + sourceFormulaCommonRoots + encodingLength F z hz hshort (.inl ()) index ∈ + sourceFormulaCommonRootSupport + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩) := by + classical + have rank := sourceFormulaGenericRank_le encodingLength F z hz (.inl ()) + have supports := sourceFormulaClauseRootSupports_sum_card_le + encodingLength F z hz hshort clause + have tuples := Nat.mul_le_mul_right + (sourceSizeParameter encodingLength F ^ 4) + (F.clauses.get clause).satisfyingLocalTuple_card_le_eight + have budget := source_clause_support_lt_moment_budget + (sourceSizeParameter_ge_one_hundred encodingLength F) + have hbudget : sourceFormulaGenericRank encodingLength F z hz (.inl ()) + + ((sourceFormulaClauseRootSupports + encodingLength F z hz hshort clause).map Finset.card).sum ≤ + sourceSizeParameter encodingLength F ^ 30 := by + omega + obtain ⟨subtype, hsubtype, hroot⟩ := + genericRoot_mem_subtype_of_characteristicTwo_moments + (sourceFormulaCommonRoots encodingLength F z hz hshort (.inl ())) + (sourceFormulaCommonRoots_injective encodingLength F z hz hshort (.inl ())) + (sourceFormulaClauseRootSupports encodingLength F z hz hshort clause) + (sourceSizeParameter encodingLength F ^ 30) hbudget + (fun j hj => sourceFormulaCommonGlobalRootMoment_eq_clauseSubtypeSum + encodingLength F z hz hshort clause j (Nat.le_of_lt hj)) index + change subtype ∈ List.ofFn _ at hsubtype + obtain ⟨tupleIndex, htuple⟩ := List.mem_ofFn.mp hsubtype + exact ⟨(Fintype.equivFin + (F.clauses.get clause).SatisfyingLocalTuple).symm tupleIndex, by + rw [htuple] + exact hroot⟩ + +theorem sourceFormulaGlobalGenericRoot_mem_satisfyingSubtype + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) : + ∃ tuple : (F.clauses.get clause).SatisfyingLocalTuple, + sourceFormulaGlobalGenericRoot + encodingLength F z hz hshort ∈ + sourceFormulaCommonRootSupport + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩) := + sourceFormulaCommonGlobalRoot_mem_satisfyingSubtype + encodingLength F z hz hshort clause + ⟨0, sourceFormulaGlobalGenericRank_pos encodingLength F z hz⟩ + +end + +section + +open GapCVP.Core + +export GapCVP.Core + (functionFieldExtendedValuation_ratFunc_eq_place_zpow + discrete_place_root_term_valuations_ne + valuation_finset_sum_ne_zero_of_distinct + functionFieldExtendedValuation_monic_root_separation + normalizedAffineRootPolynomial + normalizedAffineRootPolynomial_monic + normalizedAffineRootPolynomial_natDegree + normalizedAffineRootPolynomial_eval₂_eq_zero + valuation_highPower_separation_of_place_inverse_le) + +open scoped BigOperators +open Polynomial Finset + +variable {K E : Type*} [Field K] [Field E] +variable [Algebra (RatFunc K) E] [Algebra K[X] E] +variable [IsScalarTower K[X] (RatFunc K) E] +variable [FiniteDimensional (RatFunc K) E] +variable [Algebra.IsSeparable (RatFunc K) E] + +private theorem sourceFormulaGenericSupportPolynomial_natDegree + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) : + (sourceFormulaGenericSupportPolynomial + encodingLength F z hz tableType).natDegree = + sourceFormulaGenericRank encodingLength F z hz tableType := by + unfold sourceFormulaGenericSupportPolynomial + exact genericMomentSupportPolynomial_natDegree + (sourceFormulaGenericRank encodingLength F z hz tableType) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz tableType) + +private def sourceFormulaNormalizedAffineRootPolynomial + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) : + (RatFunc (sourceFormulaField encodingLength F))[X] := + normalizedAffineRootPolynomial + (sourceFormulaGenericSupportPolynomial + encodingLength F z hz (.inr ⟨clause, tuple⟩)) + (algebraMap (sourceFormulaField encodingLength F)[X] + (RatFunc (sourceFormulaField encodingLength F)) + (Polynomial.X - + Polynomial.C + (sourceFormulaVariablePlace encodingLength F localVar.val))) + (algebraMap (sourceFormulaField encodingLength F) + (RatFunc (sourceFormulaField encodingLength F)) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) + +private theorem sourceFormulaNormalizedAffineRootPolynomial_monic + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) : + (sourceFormulaNormalizedAffineRootPolynomial + encodingLength F z hz clause tuple localVar).Monic := by + unfold sourceFormulaNormalizedAffineRootPolynomial + exact normalizedAffineRootPolynomial_monic + (sourceFormulaGenericSupportPolynomial + encodingLength F z hz (.inr ⟨clause, tuple⟩)) + (sourceFormulaGenericSupportPolynomial_monic + encodingLength F z hz (.inr ⟨clause, tuple⟩)) _ _ + +private theorem sourceFormulaNormalizedAffineRootPolynomial_natDegree + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) : + (sourceFormulaNormalizedAffineRootPolynomial + encodingLength F z hz clause tuple localVar).natDegree = + sourceFormulaGenericRank + encodingLength F z hz (.inr ⟨clause, tuple⟩) := by + unfold sourceFormulaNormalizedAffineRootPolynomial + rw [normalizedAffineRootPolynomial_natDegree] + exact sourceFormulaGenericSupportPolynomial_natDegree + encodingLength F z hz (.inr ⟨clause, tuple⟩) + +private theorem sourceFormulaNormalizedAffineRootPolynomial_eval₂_eq_zero + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (index : Fin (sourceFormulaGenericRank + encodingLength F z hz (.inr ⟨clause, tuple⟩))) : + (sourceFormulaNormalizedAffineRootPolynomial + encodingLength F z hz clause tuple localVar).eval₂ + (algebraMap (RatFunc (sourceFormulaField encodingLength F)) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz)) + ((sourceFormulaCommonRoots + encodingLength F z hz hshort + (.inr ⟨clause, tuple⟩) index - + algebraMap (sourceFormulaField encodingLength F) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) / + algebraMap (sourceFormulaField encodingLength F)[X] + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (Polynomial.X - + Polynomial.C + (sourceFormulaVariablePlace + encodingLength F localVar.val))) = 0 := by + let k := sourceFormulaField encodingLength F + let common := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz + let polynomial := sourceFormulaGenericSupportPolynomial + encodingLength F z hz (.inr ⟨clause, tuple⟩) + let place : RatFunc k := algebraMap (Polynomial k) (RatFunc k) + (Polynomial.X - Polynomial.C + (sourceFormulaVariablePlace encodingLength F localVar.val)) + let bit : k := sourceSATFieldBit (K := k) (tuple.val localVar) + let root : common := sourceFormulaCommonRoots + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩) index + have hroot : + polynomial.eval₂ (algebraMap (RatFunc k) common) root = 0 := by + rw [Polynomial.eval₂_eq_eval_map, sourceFormulaCommonRoots_rootSupport] + exact rootSupportPolynomial_eval_root + (sourceFormulaCommonRoots + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩)) index + have hnormalized := normalizedAffineRootPolynomial_eval₂_eq_zero + polynomial place (algebraMap k (RatFunc k) bit) root + (algebraMap (RatFunc k) common) hroot + rw [← IsScalarTower.algebraMap_apply k (RatFunc k) common] at hnormalized + dsimp [place] at hnormalized + rw [← IsScalarTower.algebraMap_apply + (Polynomial k) (RatFunc k) common] at hnormalized + exact hnormalized + +private theorem sourceFormulaShiftedCommonRoot_separation + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (index : Fin (sourceFormulaGenericRank + encodingLength F z hz (.inr ⟨clause, tuple⟩))) + (hlarge : + 1 < + functionFieldExtendedValuation + (K := sourceFormulaField encodingLength F) + (E := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceFormulaVariablePlace + encodingLength F localVar.val) + ((sourceFormulaCommonRoots + encodingLength F z hz hshort + (.inr ⟨clause, tuple⟩) index - + algebraMap (sourceFormulaField encodingLength F) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) / + algebraMap (sourceFormulaField encodingLength F)[X] + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (Polynomial.X - + Polynomial.C + (sourceFormulaVariablePlace + encodingLength F localVar.val)))) : + (functionFieldExtendedValuation + (K := sourceFormulaField encodingLength F) + (E := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceFormulaVariablePlace encodingLength F localVar.val) + (algebraMap (sourceFormulaField encodingLength F)[X] + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (Polynomial.X - + Polynomial.C + (sourceFormulaVariablePlace + encodingLength F localVar.val))))⁻¹ ≤ + (functionFieldExtendedValuation + (K := sourceFormulaField encodingLength F) + (E := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceFormulaVariablePlace + encodingLength F localVar.val) + ((sourceFormulaCommonRoots + encodingLength F z hz hshort + (.inr ⟨clause, tuple⟩) index - + algebraMap (sourceFormulaField encodingLength F) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) / + algebraMap (sourceFormulaField encodingLength F)[X] + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (Polynomial.X - + Polynomial.C + (sourceFormulaVariablePlace + encodingLength F localVar.val)))) ^ + sourceFormulaGenericRank + encodingLength F z hz (.inr ⟨clause, tuple⟩) := by + simpa only [sourceFormulaNormalizedAffineRootPolynomial_natDegree] using + functionFieldExtendedValuation_monic_root_separation + (sourceFormulaVariablePlace encodingLength F localVar.val) + (sourceFormulaNormalizedAffineRootPolynomial + encodingLength F z hz clause tuple localVar) + (sourceFormulaNormalizedAffineRootPolynomial_monic + encodingLength F z hz clause tuple localVar) _ + (sourceFormulaNormalizedAffineRootPolynomial_eval₂_eq_zero + encodingLength F z hz hshort clause tuple localVar index) + hlarge + +theorem sourceFormulaShiftedCommonRoot_highPower_separation + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (exponent : ℕ) + (index : Fin (sourceFormulaGenericRank + encodingLength F z hz (.inr ⟨clause, tuple⟩))) + (hlarge : + 1 < + functionFieldExtendedValuation + (K := sourceFormulaField encodingLength F) + (E := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceFormulaVariablePlace encodingLength F localVar.val) + ((sourceFormulaCommonRoots + encodingLength F z hz hshort + (.inr ⟨clause, tuple⟩) index - + algebraMap (sourceFormulaField encodingLength F) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) / + algebraMap (sourceFormulaField encodingLength F)[X] + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (Polynomial.X - + Polynomial.C + (sourceFormulaVariablePlace + encodingLength F localVar.val)))) : + (functionFieldExtendedValuation + (K := sourceFormulaField encodingLength F) + (E := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceFormulaVariablePlace encodingLength F localVar.val) + (algebraMap (sourceFormulaField encodingLength F)[X] + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (Polynomial.X - + Polynomial.C + (sourceFormulaVariablePlace + encodingLength F localVar.val))) ^ exponent)⁻¹ < + functionFieldExtendedValuation + (K := sourceFormulaField encodingLength F) + (E := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceFormulaVariablePlace encodingLength F localVar.val) + (((sourceFormulaCommonRoots + encodingLength F z hz hshort + (.inr ⟨clause, tuple⟩) index - + algebraMap (sourceFormulaField encodingLength F) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) / + algebraMap (sourceFormulaField encodingLength F)[X] + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (Polynomial.X - + Polynomial.C + (sourceFormulaVariablePlace + encodingLength F localVar.val))) ^ + (sourceFormulaGenericRank + encodingLength F z hz (.inr ⟨clause, tuple⟩) * + exponent + 1)) := by + exact valuation_highPower_separation_of_place_inverse_le _ _ _ _ + exponent hlarge + (sourceFormulaShiftedCommonRoot_separation + encodingLength F z hz hshort clause tuple localVar index hlarge) + +end + +section + +open GapCVP.Core + +/-- GapCVP reduction support. -/ +def sourceValuationInverseExponent (d h : ℕ) : ℕ := + d * h * h + (d * h * (h - 1) + 1) * h * h + +private theorem sourceValuationInverseExponent_le_four + {N d h : ℕ} (hN : 100 ≤ N) + (hd : d ≤ N) (hh : h ≤ N ^ 4) : + sourceValuationInverseExponent d h ≤ 4 * N ^ 17 := by + have hcore : d * h * h ≤ N ^ 9 := by + calc + d * h * h ≤ N * (N ^ 4) * (N ^ 4) := by gcongr + _ = N ^ 9 := by + rw [show (9 : ℕ) = 1 + 4 + 4 by norm_num, + pow_add, pow_add, pow_one] + have hcoreSeventeen : d * h * h ≤ N ^ 17 := by + exact hcore.trans + (Nat.pow_le_pow_right (by omega) (by norm_num : 9 ≤ 17)) + have hfactor : d * h * (h - 1) + 1 ≤ 2 * N ^ 9 := by + have hsub : d * h * (h - 1) ≤ d * h * h := + Nat.mul_le_mul_left (d * h) (Nat.sub_le h 1) + have hpositive : 1 ≤ N ^ 9 := by + have : 0 < N ^ 9 := pow_pos (by omega) 9 + omega + omega + have hadjugate : + (d * h * (h - 1) + 1) * h * h ≤ 2 * N ^ 17 := by + calc + (d * h * (h - 1) + 1) * h * h ≤ + (2 * N ^ 9) * (N ^ 4) * (N ^ 4) := by gcongr + _ = 2 * N ^ 17 := by + rw [show (17 : ℕ) = 9 + 4 + 4 by norm_num, + pow_add, pow_add] + ring + unfold sourceValuationInverseExponent + omega + +private theorem sourceValuationInverseExponent_high_index_lt_budget + {N d h : ℕ} (hN : 100 ≤ N) + (hd : d ≤ N) (hh : h ≤ N ^ 4) : + h * sourceValuationInverseExponent d h + h < N ^ 30 := by + apply source_valuation_index_lt_moment_budget hN hh + exact sourceValuationInverseExponent_le_four hN hd hh + +private theorem sourceValuationInverseExponent_shifted_index_le_budget + {N d h : ℕ} (hN : 100 ≤ N) + (hd : d ≤ N) (hh : h ≤ N ^ 4) (row : Fin h) : + h * sourceValuationInverseExponent d h + 1 + row.val ≤ N ^ 30 := by + have hlast := + sourceValuationInverseExponent_high_index_lt_budget hN hd hh + have hrow := row.isLt + omega + +/-- GapCVP reduction support. -/ +def sourceFormulaValuationInverseExponent + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) : ℕ := + sourceValuationInverseExponent F.variableCount + (sourceFormulaGenericRank encodingLength F z hz tableType) + +theorem sourceFormulaValuationInverseExponent_shifted_index_le_budget + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (tableType : sourceSATTableType F) + (row : Fin (sourceFormulaGenericRank + encodingLength F z hz tableType)) : + sourceFormulaGenericRank encodingLength F z hz tableType * + sourceFormulaValuationInverseExponent + encodingLength F z hz tableType + 1 + row.val ≤ + sourceSizeParameter encodingLength F ^ 30 := + sourceValuationInverseExponent_shifted_index_le_budget + (sourceSizeParameter_ge_one_hundred encodingLength F) + (source_variableCount_le_size encodingLength F) + (sourceFormulaGenericRank_le encodingLength F z hz tableType) row + +end + +section + +open GapCVP.Core + +open scoped BigOperators +open Polynomial Finset + +theorem sourceFormulaSignedTable_shiftedGenericRootMoment + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + {E : Type*} [Field E] + [Algebra (sourceFormulaField encodingLength F) E] + [Algebra (sourceFormulaField encodingLength F)[X] E] + [Algebra (RatFunc (sourceFormulaField encodingLength F)) E] + [IsScalarTower (sourceFormulaField encodingLength F) + (sourceFormulaField encodingLength F)[X] E] + [IsScalarTower (sourceFormulaField encodingLength F) + (RatFunc (sourceFormulaField encodingLength F)) E] + [IsScalarTower (sourceFormulaField encodingLength F)[X] + (RatFunc (sourceFormulaField encodingLength F)) E] + (roots : Fin (maximalGenericHankelRank + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inr ⟨clause, tuple⟩)) + (sourceSizeParameter encodingLength F ^ 4)) → E) + (hinjective : Function.Injective roots) + (hroots : + (genericMomentSupportPolynomial + (maximalGenericHankelRank + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inr ⟨clause, tuple⟩)) + (sourceSizeParameter encodingLength F ^ 4)) + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inr ⟨clause, tuple⟩))).map + (algebraMap (RatFunc (sourceFormulaField encodingLength F)) E) = + rootSupportPolynomial roots) + (j : ℕ) (hj : j ≤ sourceSizeParameter encodingLength F ^ 30) : + rootMoment + (fun index => + (roots index - algebraMap (sourceFormulaField encodingLength F) E + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) / + algebraMap (sourceFormulaField encodingLength F)[X] E + (Polynomial.X - Polynomial.C + (sourceFormulaVariablePlace encodingLength F localVar.val))) j = + algebraMap (sourceFormulaField encodingLength F)[X] E + (sourceFormulaSignedTableShiftedMomentPolynomials + encodingLength F z hz clause tuple localVar j) := by + classical + let k := sourceFormulaField encodingLength F + let place := sourceFormulaVariablePlace encodingLength F localVar.val + apply shiftedGenericRootMoment_eq_mappedShiftedPolynomial + (sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz (.inr ⟨clause, tuple⟩)) + (sourceFormulaSignedTableShiftedMomentPolynomials + encodingLength F z hz clause tuple localVar j) + place (sourceSATFieldBit (K := k) (tuple.val localVar)) j roots hinjective + ((map_ne_zero_iff (algebraMap k[X] E) + (functionFieldPolynomial_algebraMap_injective (K := k) (E := E))).mpr + (Polynomial.X_sub_C_ne_zero place)) + · intro l hl + rw [IsScalarTower.algebraMap_apply k[X] (RatFunc k) E] + exact sourceFormulaSignedTable_genericMoments_eq_rootMoments_of_scaledNorm + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩) + roots hroots l (hl.trans hj) + · exact sourceFormulaSignedTable_shiftedMomentPolynomial_identity + encodingLength F z hz clause tuple localVar j hj + +end + +end Factor400BinaryConstructiveSourcePlaces + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part10.lean b/LeanPool/GapCVP/Part10.lean new file mode 100644 index 000000000..ddd2e0701 --- /dev/null +++ b/LeanPool/GapCVP/Part10.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part10B + +/-! # GapCVP proof, part 10 -/ diff --git a/LeanPool/GapCVP/Part10A.lean b/LeanPool/GapCVP/Part10A.lean new file mode 100644 index 000000000..7b8ec3d5f --- /dev/null +++ b/LeanPool/GapCVP/Part10A.lean @@ -0,0 +1,3524 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part09 + +/-! # GapCVP proof, part 10 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceFactor400BinaryConstructionABounds + +open scoped BigOperators + +/-- GapCVP reduction support. -/ +noncomputable def gapFactor400 (dimension : ℕ) : ℝ := + (dimension : ℝ) ^ ((1 : ℝ) / 400) + +theorem gapFactor400_sq (dimension : ℕ) : + gapFactor400 dimension ^ 2 = + (dimension : ℝ) ^ ((1 : ℝ) / 200) := by + unfold gapFactor400 + rw [← Real.rpow_mul_natCast (by positivity)] + norm_num + +private theorem source_dimension_le_power402 + {N dimension : ℕ} + (hN : 100 ≤ N) + (hdimension : dimension ≤ 40 * N ^ 401) : + dimension ≤ N ^ 402 := by + have hforty : 40 ≤ N := by omega + calc + dimension ≤ 40 * N ^ 401 := hdimension + _ ≤ N * N ^ 401 := Nat.mul_le_mul_right _ hforty + _ = N ^ 402 := by ring + +private theorem source_gapFactor400_sq_le_power + {N dimension : ℕ} + (hN : 100 ≤ N) + (hdimension : dimension ≤ 40 * N ^ 401) : + gapFactor400 dimension ^ 2 ≤ + (N : ℝ) ^ ((201 : ℝ) / 100) := by + rw [gapFactor400_sq] + have hpower := source_dimension_le_power402 hN hdimension + have hcast : (dimension : ℝ) ≤ ((N ^ 402 : ℕ) : ℝ) := by + exact_mod_cast hpower + calc + (dimension : ℝ) ^ ((1 : ℝ) / 200) ≤ + ((N ^ 402 : ℕ) : ℝ) ^ ((1 : ℝ) / 200) := by + apply Real.rpow_le_rpow (by positivity) hcast + norm_num + _ = (N : ℝ) ^ ((201 : ℝ) / 100) := by + rw [Nat.cast_pow, ← Real.rpow_natCast_mul (by positivity)] + norm_num + +private theorem eighty_lt_source_power + {N : ℕ} (hN : 100 ≤ N) : + (80 : ℝ) < (N : ℝ) ^ ((99 : ℝ) / 100) := by + have hnumeric : (80 : ℝ) ^ 100 < (100 : ℝ) ^ 99 := by + norm_num + have hroot : + ((80 : ℝ) ^ 100) ^ ((1 : ℝ) / 100) < + ((100 : ℝ) ^ 99) ^ ((1 : ℝ) / 100) := by + apply Real.rpow_lt_rpow (by positivity) hnumeric + norm_num + have hleft : + ((80 : ℝ) ^ 100) ^ ((1 : ℝ) / 100) = 80 := by + rw [← Real.rpow_natCast_mul (by positivity)] + norm_num + have hright : + ((100 : ℝ) ^ 99) ^ ((1 : ℝ) / 100) = + (100 : ℝ) ^ ((99 : ℝ) / 100) := by + rw [← Real.rpow_natCast_mul (by positivity)] + norm_num + rw [hleft, hright] at hroot + have hcast : (100 : ℝ) ≤ (N : ℝ) := by + exact_mod_cast hN + exact hroot.trans_le + (Real.rpow_le_rpow (by norm_num) hcast (by norm_num)) + +private theorem source_power_margin + {N : ℕ} (hN : 100 ≤ N) : + (80 : ℝ) * (N : ℝ) ^ ((301 : ℝ) / 100) < + (N : ℝ) ^ 4 := by + have hNpositive : (0 : ℝ) < (N : ℝ) := by + exact_mod_cast (show 0 < N by omega) + calc + (80 : ℝ) * (N : ℝ) ^ ((301 : ℝ) / 100) < + (N : ℝ) ^ ((99 : ℝ) / 100) * + (N : ℝ) ^ ((301 : ℝ) / 100) := by + exact mul_lt_mul_of_pos_right + (eighty_lt_source_power hN) + (Real.rpow_pos_of_pos hNpositive _) + _ = (N : ℝ) ^ 4 := by + rw [← Real.rpow_add hNpositive] + norm_num + +private theorem source_gapFactor400_eighty_mul_size_lt_fourth_power + {N dimension : ℕ} + (hN : 100 ≤ N) + (hdimension : dimension ≤ 40 * N ^ 401) : + (80 : ℝ) * gapFactor400 dimension ^ 2 * (N : ℝ) < + (N : ℝ) ^ 4 := by + have hfactor := source_gapFactor400_sq_le_power hN hdimension + have hNpositive : (0 : ℝ) < (N : ℝ) := by + exact_mod_cast (show 0 < N by omega) + have hjoin : + (N : ℝ) ^ ((201 : ℝ) / 100) * (N : ℝ) = + (N : ℝ) ^ ((301 : ℝ) / 100) := by + conv_lhs => + rhs + rw [← Real.rpow_one (N : ℝ)] + rw [← Real.rpow_add hNpositive] + norm_num + calc + (80 : ℝ) * gapFactor400 dimension ^ 2 * (N : ℝ) ≤ + 80 * (N : ℝ) ^ ((201 : ℝ) / 100) * (N : ℝ) := by + gcongr + _ = 80 * (N : ℝ) ^ ((301 : ℝ) / 100) := by + rw [← hjoin] + ring + _ < (N : ℝ) ^ 4 := source_power_margin hN + +end SourceFactor400BinaryConstructionABounds + +namespace Factor400BinaryConstructiveSourcePlaces + +section + +open GapCVP.Core GapCVP.SourceFactor400BinaryConstructionABounds + +private theorem sourceFormulaCompletenessRadius_squared_le_eight + (encodingLength : ℕ) (F : Formula) : + ((sourceOneHotCompletenessRadius F + (sourceFormulaGrid encodingLength F) : ℚ) : ℝ) ^ 2 ≤ + ((8 * Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F : ℕ) : ℝ) := by + refine (sourceOneHotCompletenessRadius_squared_le_four_weight F + (sourceFormulaGrid encodingLength F) + (sourceFormulaGrid_card_pos encodingLength F)).trans ?_ + exact_mod_cast source_oneHot_weight_four_mul_le + (sourceSizeParameter_ge_one_hundred encodingLength F) + (source_clauseCount_le_size encodingLength F) + (Finset.card_le_card (Finset.subset_univ + (sourceFormulaGrid encodingLength F))) + +private theorem sourceFormula_radius_squared_le_eight_field_mul_size + (encodingLength : ℕ) (F : GapCVP.Core.Formula) : + ((GapCVP.Core.sourceOneHotCompletenessRadius F + (sourceFormulaGrid encodingLength F) : ℚ) : ℝ) ^ 2 ≤ + ((8 * Fintype.card + (GapCVP.Core.sourceFormulaField encodingLength F) * + GapCVP.Core.sourceSizeParameter encodingLength F : ℕ) : ℝ) := by + exact sourceFormulaCompletenessRadius_squared_le_eight + encodingLength F + +theorem sourceFormula_gapFactor400_eighty_mul_size_lt_fourth_power + (encodingLength : ℕ) (F : GapCVP.Core.Formula) : + (80 : ℝ) * + GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + (sourceFormulaDimension encodingLength F) ^ 2 * + (GapCVP.Core.sourceSizeParameter encodingLength F : ℝ) < + (GapCVP.Core.sourceSizeParameter encodingLength F : ℝ) ^ 4 := by + exact source_gapFactor400_eighty_mul_size_lt_fourth_power + (GapCVP.Core.sourceSizeParameter_ge_one_hundred encodingLength F) + (sourceFormulaDimension_le encodingLength F) + +private theorem sourceFormula_ten_mul_integerSquaredNorm_lt_field_mul_fourth_power_of_short + (encodingLength : ℕ) (F : GapCVP.Core.Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hshort : (GapCVP.Core.integerSquaredNorm z : ℝ) ≤ + (GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + (sourceFormulaDimension encodingLength F) * + ((GapCVP.Core.sourceOneHotCompletenessRadius F + (sourceFormulaGrid encodingLength F) : ℚ) : ℝ)) ^ 2) : + 10 * GapCVP.Core.integerSquaredNorm z < + Fintype.card (GapCVP.Core.sourceFormulaField encodingLength F) * + GapCVP.Core.sourceSizeParameter encodingLength F ^ 4 := by + let N := sourceSizeParameter encodingLength F + let q := Fintype.card (sourceFormulaField encodingLength F) + let factor := GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + (sourceFormulaDimension encodingLength F) + let radius := ((sourceOneHotCompletenessRadius F + (sourceFormulaGrid encodingLength F) : ℚ) : ℝ) + have hnorm : (integerSquaredNorm z : ℝ) ≤ + factor ^ 2 * ((8 * q * N : ℕ) : ℝ) := by + calc + (integerSquaredNorm z : ℝ) ≤ (factor * radius) ^ 2 := hshort + _ = factor ^ 2 * radius ^ 2 := by ring + _ ≤ factor ^ 2 * ((8 * q * N : ℕ) : ℝ) := + mul_le_mul_of_nonneg_left + (sourceFormula_radius_squared_le_eight_field_mul_size + encodingLength F) (sq_nonneg factor) + have hq : (0 : ℝ) < (q : ℝ) := by + exact_mod_cast Fintype.card_pos_iff.mpr + ⟨(0 : sourceFormulaField encodingLength F)⟩ + have hstrict : ((10 * integerSquaredNorm z : ℕ) : ℝ) < + ((q * N ^ 4 : ℕ) : ℝ) := by + calc + ((10 * integerSquaredNorm z : ℕ) : ℝ) ≤ + (80 * factor ^ 2 * (N : ℝ)) * (q : ℝ) := by + push_cast at hnorm ⊢ + linarith + _ < (N : ℝ) ^ 4 * (q : ℝ) := + mul_lt_mul_of_pos_right + (sourceFormula_gapFactor400_eighty_mul_size_lt_fourth_power + encodingLength F) hq + _ = ((q * N ^ 4 : ℕ) : ℝ) := by push_cast; ring + exact_mod_cast hstrict + +end + +section + +open GapCVP.Core +open scoped BigOperators +open Polynomial Finset Matrix + +private theorem sourceFormulaShiftedCommonRoot_integral + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (index : Fin (sourceFormulaGenericRank + encodingLength F z hz (.inr ⟨clause, tuple⟩))) : + functionFieldExtendedValuation + (K := sourceFormulaField encodingLength F) + (E := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceFormulaVariablePlace encodingLength F localVar.val) + ((sourceFormulaCommonRoots + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩) index - + algebraMap (sourceFormulaField encodingLength F) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) / + algebraMap (sourceFormulaField encodingLength F)[X] + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (Polynomial.X - Polynomial.C + (sourceFormulaVariablePlace + encodingLength F localVar.val))) ≤ 1 := by + classical + let k := sourceFormulaField encodingLength F + let E := SourceFormulaCommonSeparableSplittingField encodingLength F z hz + let : IsScalarTower k k[X] E := IsScalarTower.of_algebraMap_eq fun x => by + calc + algebraMap k E x = algebraMap (RatFunc k) E + (algebraMap k (RatFunc k) x) := + IsScalarTower.algebraMap_apply k (RatFunc k) E x + _ = algebraMap (RatFunc k) E + (algebraMap k[X] (RatFunc k) (algebraMap k k[X] x)) := by + rw [← IsScalarTower.algebraMap_apply k k[X] (RatFunc k) x] + _ = algebraMap k[X] E (algebraMap k k[X] x) := + (IsScalarTower.algebraMap_apply k[X] (RatFunc k) E _).symm + let type : sourceSATTableType F := .inr ⟨clause, tuple⟩ + let moments := sourceFormulaSignedTableOrdinaryMomentPolynomials + encodingLength F z hz type + let h := sourceFormulaGenericRank encodingLength F z hz type + let roots : Fin h → E := sourceFormulaCommonRoots + encodingLength F z hz hshort type + let a := sourceFormulaVariablePlace encodingLength F localVar.val + let bit := sourceSATFieldBit (K := k) (tuple.val localVar) + let place : E := algebraMap k[X] E (Polynomial.X - Polynomial.C a) + let valuation := functionFieldExtendedValuation (K := k) (E := E) a + let p := valuation place + let shifted : Fin h → E := fun i => (roots i - algebraMap k E bit) / place + let U := sourceFormulaValuationInverseExponent encodingLength F z hz type + have place_ne : place ≠ 0 := + (map_ne_zero_iff (algebraMap k[X] E) + (functionFieldPolynomial_algebraMap_injective + (K := k) (E := E))).mpr (Polynomial.X_sub_C_ne_zero a) + have p_pos : 0 < p := (Valuation.pos_iff valuation).mpr place_ne + have p_le : p ≤ 1 := le_of_lt + (functionFieldExtendedValuation_place_lt_one (K := k) (E := E) a) + have roots_inj := sourceFormulaCommonRoots_injective + encodingLength F z hz hshort type + have shifted_inj : Function.Injective shifted := fun i j equal => + roots_inj (sub_left_injective ((div_left_inj' place_ne).mp equal)) + have denominator := (maximalGenericHankelRank_spec + moments (sourceSizeParameter encodingLength F ^ 4)).2 + have support := sourceFormulaCommonRoots_rootSupport + encodingLength F z hz hshort type + have degrees : ∀ j : ℕ, (moments j).natDegree ≤ F.variableCount * j := + sourceFormulaSignedTableOrdinaryMomentPolynomials_natDegree + encodingLength F z hz type + have small : ∀ j : ℕ, j < 2 * h → + algebraMap k[X] E (moments j) = rootMoment roots j := by + intro j bound + have rank := sourceFormulaGenericRank_le encodingLength F z hz type + have support_bound := source_clause_support_lt_moment_budget + (sourceSizeParameter_ge_one_hundred encodingLength F) + have budget : j ≤ sourceSizeParameter encodingLength F ^ 30 := by + dsimp [h] at bound + omega + rw [IsScalarTower.algebraMap_apply k[X] (RatFunc k) E] + exact sourceFormulaCommonRoots_moment + encodingLength F z hz hshort type j budget + apply valuation_roots_integral_of_shifted_moments + valuation shifted shifted_inj (p ^ U)⁻¹ (h * U + 1) _ _ _ index + · intro i j + have bound := valuation_inverseTransposeVandermonde_le_place_inv_pow + valuation shifted p p_pos p_le + (F.variableCount * h * (h - 1) + 1) (F.variableCount * h * h) + (fun i => functionFieldExtendedValuation_shiftedGenericRoot_le_place_inv_pow + moments F.variableCount h degrees denominator roots support a bit i) + (functionFieldExtendedValuation_shiftedVandermonde_det_inv_le_place_inv_pow + a moments F.variableCount roots (algebraMap k E bit) + small degrees denominator) i j + simpa [U, sourceFormulaValuationInverseExponent, + sourceValuationInverseExponent, h] using bound + · intro r + have budget := sourceFormulaValuationInverseExponent_shifted_index_le_budget + encodingLength F z hz type r + have moment := sourceFormulaSignedTable_shiftedGenericRootMoment + encodingLength F z hz hshort clause tuple localVar roots roots_inj support + (h * U + 1 + r.val) budget + change valuation (rootMoment + (fun i => (roots i - algebraMap k E bit) / place) + (h * U + 1 + r.val)) ≤ 1 + calc + valuation (rootMoment + (fun i => (roots i - algebraMap k E bit) / place) + (h * U + 1 + r.val)) = + valuation (algebraMap k[X] E + (sourceFormulaSignedTableShiftedMomentPolynomials + encodingLength F z hz clause tuple localVar + (h * U + 1 + r.val))) := congrArg valuation moment + _ ≤ 1 := functionFieldExtendedValuation_polynomial_le_one a _ + · intro i large + exact sourceFormulaShiftedCommonRoot_highPower_separation + encodingLength F z hz hshort clause tuple localVar U i large + +private theorem sourceFormulaCommonRoot_close_to_localBit + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) + (clause : Fin F.clauses.length) + (tuple : (F.clauses.get clause).SatisfyingLocalTuple) + (localVar : (F.clauses.get clause).LocalVariable) + (index : Fin (sourceFormulaGenericRank + encodingLength F z hz (.inr ⟨clause, tuple⟩))) : + functionFieldExtendedValuation + (K := sourceFormulaField encodingLength F) + (E := SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceFormulaVariablePlace encodingLength F localVar.val) + (sourceFormulaCommonRoots + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩) index - + algebraMap (sourceFormulaField encodingLength F) + (SourceFormulaCommonSeparableSplittingField + encodingLength F z hz) + (sourceSATFieldBit + (K := sourceFormulaField encodingLength F) + (tuple.val localVar))) < 1 := by + classical + let k := sourceFormulaField encodingLength F + let E := SourceFormulaCommonSeparableSplittingField encodingLength F z hz + let a := sourceFormulaVariablePlace encodingLength F localVar.val + let place : E := algebraMap k[X] E (Polynomial.X - Polynomial.C a) + let v := functionFieldExtendedValuation (K := k) (E := E) a + let difference : E := sourceFormulaCommonRoots + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩) index - + algebraMap k E (sourceSATFieldBit (K := k) (tuple.val localVar)) + have small : v place < 1 := + functionFieldExtendedValuation_place_lt_one (K := k) (E := E) a + change v difference < 1 + calc + v difference = v (difference / place) * v place := by + rw [← v.map_mul, div_mul_cancel₀ difference] + exact (map_ne_zero_iff (algebraMap k[X] E) + (functionFieldPolynomial_algebraMap_injective (K := k) (E := E))).mpr + (Polynomial.X_sub_C_ne_zero a) + _ ≤ 1 * v place := mul_le_mul_of_nonneg_right + (sourceFormulaShiftedCommonRoot_integral + encodingLength F z hz hshort clause tuple localVar index) zero_le + _ < 1 := by simpa only [one_mul] using small + +theorem sourceFormula_satisfiable_of_short_signed_solution + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : 10 * integerSquaredNorm z ≤ + Fintype.card (sourceFormulaField encodingLength F) * + sourceSizeParameter encodingLength F ^ 4) : + F.Satisfiable := by + classical + let k := sourceFormulaField encodingLength F + let E := SourceFormulaCommonSeparableSplittingField encodingLength F z hz + let root : E := sourceFormulaGlobalGenericRoot encodingLength F z hz hshort + let selected : (clause : Fin F.clauses.length) → + (F.clauses.get clause).SatisfyingLocalTuple := fun clause => + Classical.choose (sourceFormulaGlobalGenericRoot_mem_satisfyingSubtype + encodingLength F z hz hshort clause) + have hselected : ∀ clause : Fin F.clauses.length, + root ∈ sourceFormulaCommonRootSupport + encodingLength F z hz hshort (.inr ⟨clause, selected clause⟩) := + fun clause => Classical.choose_spec + (sourceFormulaGlobalGenericRoot_mem_satisfyingSubtype + encodingLength F z hz hshort clause) + let assignment : Fin F.clauses.length → Fin F.variableCount → Bool := + fun clause varIndex => if h : varIndex ∈ (F.clauses.get clause).variableSet + then (selected clause).val ⟨varIndex, h⟩ else false + let valuation : Fin F.variableCount → Valuation E (WithZero (Multiplicative ℤ)) := + fun varIndex => functionFieldExtendedValuation (K := k) (E := E) + (sourceFormulaVariablePlace encodingLength F varIndex) + apply satisfiable_of_common_valuation_root F valuation root assignment + · intro clause + have satisfied := (selected clause).property + simp only [GapCVP.Core.Clause.LocalSatisfied, GapCVP.Core.Clause.Satisfied, + decide_eq_true_eq] at satisfied ⊢ + obtain ⟨literal, hliteral, hvalue⟩ := satisfied + have hmem : literal.variableIndex ∈ (F.clauses.get clause).variableSet := + Finset.mem_image_of_mem (fun l : GapCVP.Core.Literal F.variableCount => + l.variableIndex) hliteral + refine ⟨literal, hliteral, ?_⟩ + dsimp [assignment] + split + next => exact hvalue + next h => exact (h hmem).elim + · intro clause literal hliteral + let tuple := selected clause + have hmem : literal.variableIndex ∈ (F.clauses.get clause).variableSet := + Finset.mem_image_of_mem (fun l : GapCVP.Core.Literal F.variableCount => + l.variableIndex) hliteral + let localVar : (F.clauses.get clause).LocalVariable := + ⟨literal.variableIndex, hmem⟩ + obtain ⟨index, hindex⟩ := + (mem_enumeratedRootSupport_iff + (sourceFormulaCommonRoots + encodingLength F z hz hshort (.inr ⟨clause, tuple⟩)) root).mp + (hselected clause) + have hclose := sourceFormulaCommonRoot_close_to_localBit + encodingLength F z hz hshort clause tuple localVar index + rw [hindex] at hclose + change functionFieldExtendedValuation (K := k) (E := E) + (sourceFormulaVariablePlace encodingLength F literal.variableIndex) + (root - bitInField (E := E) (assignment clause literal.variableIndex)) < 1 + have hlocal : assignment clause literal.variableIndex = tuple.val localVar := by + dsimp [assignment] + split + next => rfl + next h => exact (h hmem).elim + rw [hlocal] + cases hbit : tuple.val localVar <;> + simpa only [hbit, sourceSATFieldBit, bitInField, localVar, + Bool.false_eq_true, ↓reduceIte, map_zero, map_one] using hclose + +private theorem sourceFormula_satisfiable_of_factor400_short_signed_solution + (encodingLength : ℕ) (F : Formula) + (z : Fin (sourceFormulaDimension encodingLength F) → ℤ) + (hz : (sourceFormulaBinarySystem encodingLength F).Solves z) + (hshort : (integerSquaredNorm z : ℝ) ≤ + (GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + (sourceFormulaDimension encodingLength F) * + ((sourceOneHotCompletenessRadius F + (sourceFormulaGrid encodingLength F) : ℚ) : ℝ)) ^ 2) : + F.Satisfiable := by + apply sourceFormula_satisfiable_of_short_signed_solution + encodingLength F z hz + exact Nat.le_of_lt + (sourceFormula_ten_mul_integerSquaredNorm_lt_field_mul_fourth_power_of_short + encodingLength F z hshort) + +end + +section + +open GapCVP.Core + +private theorem sourceFormula_satisfiable_of_factor400_short_fieldChecks + (encodingLength : ℕ) (formula : Formula) + (z : Fin (sourceFormulaDimension encodingLength formula) → ℤ) + (hchecks : + concreteSATFieldChecks formula + (sourceFormulaGrid encodingLength formula) + (sourceFormulaVariablePlace encodingLength formula) + (sourceSizeParameter encodingLength formula ^ 30) + (fun position => algebraMap (ZMod 2) + (sourceFormulaField encodingLength formula) + (z position : ZMod 2))) + (hshort : + (integerSquaredNorm z : ℝ) ≤ + (GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + (sourceFormulaDimension encodingLength formula) * + ((sourceOneHotCompletenessRadius formula + (sourceFormulaGrid encodingLength formula) : ℚ) : ℝ)) ^ 2) : + formula.Satisfiable := by + exact sourceFormula_satisfiable_of_factor400_short_signed_solution + encodingLength formula z + ((sourceFormulaBinarySystem_solves_iff + encodingLength formula z).mpr hchecks) + hshort + +end + +section + +open GapCVP.Core Polynomial + +private theorem sourceFormula_signedSolution_of_satisfiable + (encodingLength : ℕ) (F : Formula) + (hsatisfiable : F.Satisfiable) : + ∃ z : Fin (sourceFormulaDimension encodingLength F) → ℤ, + (sourceFormulaBinarySystem encodingLength F).Solves z ∧ + (integerSquaredNorm z : ℝ) ≤ + ((sourceOneHotCompletenessRadius F + (sourceFormulaGrid encodingLength F) : ℚ) : ℝ) ^ 2 := by + simp only [GapCVP.Core.Formula.Satisfiable, decide_eq_true_eq] at * + classical + obtain ⟨assignment, hsatisfies⟩ := hsatisfiable + obtain ⟨interpolant, hdegree, hinterpolant⟩ := + exists_sourceSAT_assignment_interpolant_of_injective + F (sourceFormulaVariablePlace encodingLength F) + (sourceFormulaVariablePlace_injective encodingLength F) assignment + let points := sourceFormulaGrid encodingLength F + let z := sourceOneHotSignedTable F points assignment hsatisfies interpolant + refine ⟨z, ?_, ?_⟩ + · change + (concreteSATBinaryAffineSystem F + (sourceFormulaFieldBasis encodingLength F) + points (sourceFormulaVariablePlace encodingLength F) + (sourceSizeParameter encodingLength F ^ 30)).Solves z + apply sourceOneHot_solves_concreteSATBinaryAffineSystem + F (sourceFormulaFieldBasis encodingLength F) + points (sourceFormulaVariablePlace encodingLength F) + assignment hsatisfies interpolant hdegree hinterpolant + _ (sourceSizeParameter encodingLength F ^ 30) + intro point index + exact sourceSATPuncturedGrid_sub_ne_zero F + (sourceFormulaVariablePlace encodingLength F) point index + · calc + (integerSquaredNorm z : ℝ) = + (((F.clauses.length + 1) * points.card : ℕ) : ℝ) := by + exact_mod_cast + sourceOneHotSignedTable_squaredNorm + F points assignment hsatisfies interpolant + _ ≤ ((sourceOneHotCompletenessRadius F points : ℚ) : ℝ) ^ 2 := + sourceOneHotCompletenessRadius_squared_bound F points + +end + +end Factor400BinaryConstructiveSourcePlaces + +namespace BinaryExplicitSourceSoundness + +open GapCVP.Core +open GapCVP.BinaryExplicitFourFamilyKernel +open GapCVP.Factor400BinaryConstructiveSourcePlaces + +theorem sourceFormulaExplicitBinarySystem_signedSolution_of_satisfiable + (encodingLength : ℕ) (formula : Formula) + (hsatisfiable : formula.Satisfiable) : + ∃ vector : + Fin (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) → ℤ, + (GapCVP.BinaryExplicitAffineSystem.sourceFormulaExplicitBinarySystem + encodingLength formula).Solves vector ∧ + (integerSquaredNorm vector : ℝ) ≤ + ((sourceOneHotCompletenessRadius formula + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) : ℚ) : ℝ) ^ 2 := by + obtain ⟨vector, hsolve, hshort⟩ := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormula_signedSolution_of_satisfiable + encodingLength formula hsatisfiable + refine ⟨vector, ?_, hshort⟩ + apply + (sourceFormulaExplicitBinarySystem_solves_iff_concreteSATFieldChecks + encodingLength formula vector).mpr + exact + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaBinarySystem_solves_iff + encodingLength formula vector).mp hsolve + +private theorem sourceFormulaExplicitBinarySystem_satisfiable_of_factor400_short_signed_solution + (encodingLength : ℕ) (formula : Formula) + (vector : + Fin (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) → ℤ) + (hsolve : + (GapCVP.BinaryExplicitAffineSystem.sourceFormulaExplicitBinarySystem + encodingLength formula).Solves vector) + (hshort : + (integerSquaredNorm vector : ℝ) ≤ + (GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) * + ((sourceOneHotCompletenessRadius formula + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) : ℚ) : ℝ)) ^ 2) : + formula.Satisfiable := by + exact + sourceFormula_satisfiable_of_factor400_short_fieldChecks + encodingLength formula vector + ((sourceFormulaExplicitBinarySystem_solves_iff_concreteSATFieldChecks + encodingLength formula vector).mp hsolve) + hshort + +theorem sourceFormulaExplicitBinarySystem_squaredNorm_gt_factor400_of_unsatisfiable + (encodingLength : ℕ) (formula : Formula) + (vector : + Fin (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) → ℤ) + (hsolve : + (GapCVP.BinaryExplicitAffineSystem.sourceFormulaExplicitBinarySystem + encodingLength formula).Solves vector) + (hunsatisfiable : ¬ formula.Satisfiable) : + (GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength formula) * + ((sourceOneHotCompletenessRadius formula + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength formula) : ℚ) : ℝ)) ^ 2 < + (integerSquaredNorm vector : ℝ) := by + apply lt_of_not_ge + intro hshort + exact hunsatisfiable + (sourceFormulaExplicitBinarySystem_satisfiable_of_factor400_short_signed_solution + encodingLength formula vector hsolve hshort) + +end BinaryExplicitSourceSoundness + +namespace Factor400BinaryInstanceBridge + +/-- GapCVP reduction support. -/ +abbrev adaptGapCVPInstance (I : GapCVP.Core.GapCVPInstance) : + GapCVP.GapCVPInstance where + dimension := I.dimension + basis := I.basis + target := I.target + radius := I.radius + +private theorem adaptGapCVPInstance_wellFormed + (I : GapCVP.Core.GapCVPInstance) : + gapCVPWellFormed (adaptGapCVPInstance I) := by + simp only [GapCVP.gapCVPWellFormed, decide_eq_true_eq] at * + exact ⟨I.dimension_pos, I.basis_nonsingular, I.radius_pos⟩ + +private theorem adaptGapCVPInstance_distanceSquared + (I : GapCVP.Core.GapCVPInstance) + (z : Fin I.dimension → ℤ) : + distanceSquared (adaptGapCVPInstance I) z = + GapCVP.Core.squaredDistance I z := by + unfold distanceSquared GapCVP.Core.squaredDistance + change + (∑ i : Fin I.dimension, + ((∑ j : Fin I.dimension, + (I.basis i j : ℝ) * (z j : ℝ)) - (I.target i : ℝ)) ^ 2) = + ∑ i : Fin I.dimension, + ((I.target i : ℝ) - + ∑ j : Fin I.dimension, + (I.basis i j : ℝ) * (z j : ℝ)) ^ 2 + apply Finset.sum_congr + · rfl + · intro i _ + ring + +private theorem adaptGapCVPInstance_gapYES400_iff_squaredYes + (I : GapCVP.Core.GapCVPInstance) : + gapYES400 (adaptGapCVPInstance I) ↔ + GapCVP.Core.SquaredYes I := by + simp only [GapCVP.gapYES400, GapCVP.Core.SquaredYes, decide_eq_true_eq] + constructor + · rintro ⟨_, z, hz⟩ + refine ⟨z, ?_⟩ + simpa only [adaptGapCVPInstance_distanceSquared, + adaptGapCVPInstance] using hz + · rintro ⟨z, hz⟩ + refine ⟨adaptGapCVPInstance_wellFormed I, z, ?_⟩ + simpa only [adaptGapCVPInstance_distanceSquared, + adaptGapCVPInstance] using hz + +theorem adaptGapCVPInstance_gapYES400_iff_metricYes + (I : GapCVP.Core.GapCVPInstance) : + gapYES400 (adaptGapCVPInstance I) ↔ I.IsYes := by + constructor + · intro hyes + exact GapCVP.Core.yes_of_squaredYes I + ((adaptGapCVPInstance_gapYES400_iff_squaredYes I).mp hyes) + · intro hyes + simp only [GapCVP.Core.GapCVPInstance.IsYes, decide_eq_true_eq] at hyes + obtain ⟨z, hnearest⟩ := + GapCVP.Core.exists_latticePoint_eq_latticeDistance I + apply (adaptGapCVPInstance_gapYES400_iff_squaredYes I).mpr + simp only [GapCVP.Core.SquaredYes, decide_eq_true_eq] + refine ⟨z, ?_⟩ + rw [GapCVP.Core.squaredDistance_eq_dist_sq] + have hmetric : + dist I.targetPoint (I.latticePoint z) ≤ (I.radius : ℝ) := by + change I.latticeDistance ≤ (I.radius : ℝ) at hyes + rw [hnearest] at hyes + exact hyes + have hradius : 0 ≤ (I.radius : ℝ) := by + exact_mod_cast (le_of_lt I.radius_pos) + nlinarith [dist_nonneg (x := I.targetPoint) + (y := I.latticePoint z)] + +theorem adaptGapCVPInstance_gapNO400_iff_metricNo + (I : GapCVP.Core.GapCVPInstance) : + gapNO400 (adaptGapCVPInstance I) ↔ + I.IsNo ((1 : ℝ) / 400) := by + rw [← GapCVP.Core.squaredNoAt_iff_metricNo] + simp only [GapCVP.gapNO400, GapCVP.Core.SquaredNoAt, decide_eq_true_eq] + constructor + · intro hno z + have h := hno.2 z + simpa only [gapFactor400, adaptGapCVPInstance, + adaptGapCVPInstance_distanceSquared] using h + · intro hno + refine ⟨adaptGapCVPInstance_wellFormed I, ?_⟩ + intro z + have h := hno z + simpa only [gapFactor400, adaptGapCVPInstance, + adaptGapCVPInstance_distanceSquared] using h + +/-- GapCVP reduction support. -/ +def effectiveGapCVPInstance + (H : GapCVP.Core.BinaryAffineSystem) + (hdimension : 0 < H.dimension) + (radius : ℚ) (hradius : 0 < radius) : GapCVPInstance := + adaptGapCVPInstance + (GapCVP.Core.effectiveConstructionAInstance + H hdimension radius hradius) + +theorem effectiveGapCVPInstance_wellFormed + (H : GapCVP.Core.BinaryAffineSystem) + (hdimension : 0 < H.dimension) + (radius : ℚ) (hradius : 0 < radius) : + gapCVPWellFormed + (effectiveGapCVPInstance H hdimension radius hradius) := + adaptGapCVPInstance_wellFormed + (GapCVP.Core.effectiveConstructionAInstance + H hdimension radius hradius) + +end Factor400BinaryInstanceBridge + +namespace Factor400BinaryEffectiveBasisSerializerTM + +open Turing GapCVP.BinaryEncoding GapCVP.OutputPolynomialCompositionClosure +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceWholeOutputValidBranchRecordTM GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +def effectiveBasisPackedAtom : List Bool → List Bool := + markerConditionalOutput + (markerConditionalOutput + (fun _ : List Bool => encodeAtomic (2 : ℤ)) + (encodeAtomic (1 : ℤ))) + (encodeAtomic (0 : ℤ)) + +/-- GapCVP reduction support. -/ +noncomputable def effectiveBasisPackedAtomComputable : + BitTM + effectiveBasisPackedAtom := + markerConditionalComputable + (markerConditionalComputable + (sourceFixedWordComputable (encodeAtomic (2 : ℤ))) + (encodeAtomic (1 : ℤ))) + (encodeAtomic (0 : ℤ)) + +@[simp] theorem effectiveBasisPackedAtom_zero + (suffix : List Bool) : + effectiveBasisPackedAtom (false :: suffix) = + encodeAtomic (0 : ℤ) := by + simp only [effectiveBasisPackedAtom, markerConditionalOutput] + +@[simp] theorem effectiveBasisPackedAtom_one + (suffix : List Bool) : + effectiveBasisPackedAtom (true :: false :: suffix) = + encodeAtomic (1 : ℤ) := by + simp only [effectiveBasisPackedAtom, markerConditionalOutput] + +@[simp] theorem effectiveBasisPackedAtom_two + (suffix : List Bool) : + effectiveBasisPackedAtom (true :: true :: suffix) = + encodeAtomic (2 : ℤ) := by + simp only [effectiveBasisPackedAtom, markerConditionalOutput] + +/-- GapCVP reduction support. -/ +def effectiveTargetPackedAtom : List Bool → List Bool := + markerConditionalOutput + (fun _ : List Bool => encodeAtomic (1 : ℚ)) + (encodeAtomic (0 : ℚ)) + +/-- GapCVP reduction support. -/ +noncomputable def effectiveTargetPackedAtomComputable : + BitTM + effectiveTargetPackedAtom := + markerConditionalComputable + (sourceFixedWordComputable (encodeAtomic (1 : ℚ))) + (encodeAtomic (0 : ℚ)) + +@[simp] theorem effectiveTargetPackedAtom_false + (suffix : List Bool) : + effectiveTargetPackedAtom (false :: suffix) = + encodeAtomic (0 : ℚ) := by + simp only [effectiveTargetPackedAtom, markerConditionalOutput] + +@[simp] theorem effectiveTargetPackedAtom_true + (suffix : List Bool) : + effectiveTargetPackedAtom (true :: suffix) = + encodeAtomic (1 : ℚ) := by + simp only [effectiveTargetPackedAtom, markerConditionalOutput] + +private theorem physicalRecordFold_preservesSource + (records : List (List Bool)) (source : List Bool) : + boundedRecordFoldOutput sourceFlatAtomicRecordStep + (unaryBoundedFoldWord records.length + (sourceFlatAtomicDescriptorStream records ++ + lengthPrefixedWord source)) = + lengthPrefixedWord source ++ records.flatten := by + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + exact sourceFlatAtomicRecordStep_iterate_descriptors records + (lengthPrefixedWord source) + +private def effectiveSourceSerializerPreparation + (counter descriptors : List Bool → List Bool) + (input : List Bool) : List Bool := + counter input ++ + false :: (descriptors input ++ lengthPrefixedWord input) + +private noncomputable def effectiveSourceSerializerPreparationComputable + {counter descriptors : List Bool → List Bool} + (counterComputer : BitTM counter) + (descriptorComputer : BitTM descriptors) : + BitTM + (effectiveSourceSerializerPreparation counter descriptors) := by + have hphysical := pointwiseAppendComputable counterComputer + (pointwiseAppendComputable + (sourceFixedWordComputable [false]) + (pointwiseAppendComputable descriptorComputer + CLStructuralPrefixWriter.structuralPrefixWriterComputable)) + change + BitTM + (fun input : List Bool => + counter input ++ + false :: (descriptors input ++ lengthPrefixedWord input)) + exact hphysical + +/-- GapCVP reduction support. -/ +def effectiveSourceSerializerOutput + (counter descriptors : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldSuffix + (boundedRecordFoldOutput sourceFlatAtomicRecordStep + (effectiveSourceSerializerPreparation counter descriptors input)) + +private noncomputable def effectiveSourceSerializerComputable + {counter descriptors : List Bool → List Bool} + (counterComputer : BitTM counter) + (descriptorComputer : BitTM descriptors) : + BitTM + (effectiveSourceSerializerOutput counter descriptors) := by + have hprepared := GapCVP.TMComposition.computableInPolyTime + (effectiveSourceSerializerPreparationComputable + counterComputer descriptorComputer) + sourceFlatAtomicRecordFoldComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hprepared firstFieldSuffixComputable + change + BitTM + (fun input : List Bool => + firstFieldSuffix + (boundedRecordFoldOutput sourceFlatAtomicRecordStep + (effectiveSourceSerializerPreparation + counter descriptors input))) + exact hphysical + +theorem effectiveSourceSerializerOutput_eq_flatten + (counter descriptors : List Bool → List Bool) + (records : List Bool → List (List Bool)) + (input : List Bool) + (hcounter : counter input = + List.replicate (records input).length true) + (hdescriptors : descriptors input = + sourceFlatAtomicDescriptorStream (records input)) : + effectiveSourceSerializerOutput counter descriptors input = + (records input).flatten := by + unfold effectiveSourceSerializerOutput + effectiveSourceSerializerPreparation + rw [hcounter, hdescriptors] + change + firstFieldSuffix + (boundedRecordFoldOutput sourceFlatAtomicRecordStep + (unaryBoundedFoldWord (records input).length + (sourceFlatAtomicDescriptorStream (records input) ++ + lengthPrefixedWord input))) = + (records input).flatten + rw [physicalRecordFold_preservesSource] + exact firstFieldSuffix_valid input (records input).flatten + +end Factor400BinaryEffectiveBasisSerializerTM + +namespace SourceAnchoredQaryGridCandidateCatalogueTM + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM + +private def sourceAnchoredQaryGridPaddingPolynomial + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : Polynomial ℕ := + (GapCVP.TMComposition.outputLengthPolynomial computer).comp + (3 * Polynomial.X + 1) + +private def sourceAnchoredQaryGridCompactRankSourcePair + (input : List Bool) : List Bool := + lengthPrefixedWord (firstFieldContents input) ++ + firstFieldContents (firstFieldSuffix input) + +private noncomputable def sourceAnchoredQaryGridCompactRankSourcePairComputable : + BitTM + sourceAnchoredQaryGridCompactRankSourcePair := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable structuralPrefixWriterComputable + have hbase := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + exact pointwiseAppendComputable hprefix hbase + +private def sourceAnchoredQaryGridCompactCandidate + (candidate : List Bool → List Bool) + (input : List Bool) : List Bool := + candidate (sourceAnchoredQaryGridCompactRankSourcePair input) + +private noncomputable def sourceAnchoredQaryGridCompactCandidateComputable + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceAnchoredQaryGridCompactCandidate candidate) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + sourceAnchoredQaryGridCompactRankSourcePairComputable computer + change BitTM + (fun input => candidate + (sourceAnchoredQaryGridCompactRankSourcePair input)) + simpa only [Function.comp_def] using hphysical + +private def sourceAnchoredQaryGridRankPayloads + (count : ℕ) : List (List Bool) := + (List.range count).map (fun rank => List.replicate rank true) + +end + +section + +open Turing + +@[simp] private theorem sourceAnchoredQaryGridRankPayloads_length + (count : ℕ) : + (sourceAnchoredQaryGridRankPayloads count).length = count := by + unfold sourceAnchoredQaryGridRankPayloads + simp only [List.length_map, List.length_range] + +end + +end SourceAnchoredQaryGridCandidateCatalogueTM + +namespace SourceMixedRadixMaskSelectedFlatPreparationTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceWholeOutputValidBranchRecordTM +open GapCVP.SourceAnchoredQaryGridCandidateCatalogueTM GapCVP.SourceAnchoredGridRecordFoldTM +open GapCVP.SourceCanonicalUnaryGridIndexTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFPolynomialRowMarkerTM GapCVP.CLStructuralCNFOutputMachinesUnconditional +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +structure SourceQaryMaskDynamicGridWidth where + /-- GapCVP reduction support. -/ + output : List Bool → List Bool + /-- GapCVP reduction support. -/ + computer : BitTM output + +/-- GapCVP reduction support. -/ +def sourceQaryMaskDynamicGridBaseSource + (width : SourceQaryMaskDynamicGridWidth) + (input : List Bool) : List Bool := + lengthPrefixedWord (width.output input) ++ input + +/-- GapCVP reduction support. -/ +noncomputable def maskDynamicGridBaseSourceComputable + (width : SourceQaryMaskDynamicGridWidth) : + BitTM + (sourceQaryMaskDynamicGridBaseSource width) := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + width.computer structuralPrefixWriterComputable + exact pointwiseAppendComputable hprefix + (Turing.idComputableInPolyTime bitEncoding) + +private def maskDynamicGridPaddedAnchor + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) : List Bool := + sourcePreservingPolynomialMarkerWord + (sourceAnchoredQaryGridPaddingPolynomial computer) + (sourceQaryMaskDynamicGridBaseSource width input) + +private noncomputable def sourceQaryMaskDynamicGridPaddedAnchorComputable + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (maskDynamicGridPaddedAnchor width computer) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (maskDynamicGridBaseSourceComputable width) + (sourcePreservingPolynomialMarkerComputable + (sourceAnchoredQaryGridPaddingPolynomial computer)) + change BitTM + (fun input => sourcePreservingPolynomialMarkerWord + (sourceAnchoredQaryGridPaddingPolynomial computer) + (sourceQaryMaskDynamicGridBaseSource width input)) + simpa only [Function.comp_def] using hphysical + +private def sourceQaryMaskDynamicGridCounter + (width : SourceQaryMaskDynamicGridWidth) + (input : List Bool) : List Bool := + width.output input ++ [false] + +private noncomputable def sourceQaryMaskDynamicGridCounterComputable + (width : SourceQaryMaskDynamicGridWidth) : + BitTM + (sourceQaryMaskDynamicGridCounter width) := + pointwiseAppendComputable width.computer + (sourceFixedWordComputable [false]) + +private def maskDynamicGridRankDescriptors + (width : SourceQaryMaskDynamicGridWidth) : + List Bool → List Bool := + sourceCanonicalUnaryGridIndexOutput ∘ + sourceQaryMaskDynamicGridCounter width + +private noncomputable def sourceQaryMaskDynamicGridRankDescriptorsComputable + (width : SourceQaryMaskDynamicGridWidth) : + BitTM + (maskDynamicGridRankDescriptors width) := + GapCVP.TMComposition.computableInPolyTime + (sourceQaryMaskDynamicGridCounterComputable width) + sourceCanonicalUnaryGridIndexComputable + +private def sourceQaryMaskDynamicGridFoldSeed + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) : List Bool := + lengthPrefixedWord + (maskDynamicGridPaddedAnchor width computer input) ++ + maskDynamicGridRankDescriptors width input + +private noncomputable def sourceQaryMaskDynamicGridFoldSeedComputable + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (sourceQaryMaskDynamicGridFoldSeed width computer) := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + (sourceQaryMaskDynamicGridPaddedAnchorComputable width computer) + structuralPrefixWriterComputable + exact pointwiseAppendComputable hprefix + (sourceQaryMaskDynamicGridRankDescriptorsComputable width) + +private def maskDynamicGridFoldPreparation + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) : List Bool := + sourceQaryMaskDynamicGridCounter width input ++ + sourceQaryMaskDynamicGridFoldSeed width computer input + +private noncomputable def sourceQaryMaskDynamicGridFoldPreparationComputable + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (maskDynamicGridFoldPreparation width computer) := + pointwiseAppendComputable + (sourceQaryMaskDynamicGridCounterComputable width) + (sourceQaryMaskDynamicGridFoldSeedComputable width computer) + +/-- GapCVP reduction support. -/ +def maskDynamicGridCandidateCatalogueOutput + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) : List Bool := + firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (sourceAnchoredQaryGridCompactCandidate candidate)) + (maskDynamicGridFoldPreparation width computer input)) + +/-- GapCVP reduction support. -/ +noncomputable def maskDynamicGridCandidateCatalogueComputable + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) : + BitTM + (maskDynamicGridCandidateCatalogueOutput + width computer) := by + have hfold := sourceAnchoredGridRecordFoldComputable + (sourceAnchoredQaryGridCompactCandidateComputable computer) + have hprepared := GapCVP.TMComposition.computableInPolyTime + (sourceQaryMaskDynamicGridFoldPreparationComputable width computer) + hfold + have hphysical := GapCVP.TMComposition.computableInPolyTime + hprepared firstFieldSuffixComputable + change BitTM + (fun input => firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (sourceAnchoredQaryGridCompactCandidate candidate)) + (maskDynamicGridFoldPreparation + width computer input))) + simpa only [Function.comp_def] using hphysical + +private theorem sourceQaryMaskDynamicGridCompactCandidate_paddedAnchor + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) (rank : List Bool) : + sourceAnchoredQaryGridCompactCandidate candidate + (lengthPrefixedWord rank ++ + maskDynamicGridPaddedAnchor + width computer input) = + candidate (lengthPrefixedWord rank ++ + sourceQaryMaskDynamicGridBaseSource width input) := by + unfold sourceAnchoredQaryGridCompactCandidate + sourceAnchoredQaryGridCompactRankSourcePair + maskDynamicGridPaddedAnchor + sourcePreservingPolynomialMarkerWord + simp only [firstFieldContents_valid, firstFieldSuffix_valid] + +private theorem sourceQaryMaskDynamicGridCandidate_fits + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) (count rank : ℕ) + (hwidth : width.output input = List.replicate count true) + (hrank : rank < count) : + (sourceAnchoredQaryGridCompactCandidate candidate + (lengthPrefixedWord (List.replicate rank true) ++ + maskDynamicGridPaddedAnchor + width computer input)).length ≤ + (maskDynamicGridPaddedAnchor + width computer input).length := by + let base := sourceQaryMaskDynamicGridBaseSource width input + let polynomial := GapCVP.TMComposition.outputLengthPolynomial + computer + let padding := sourceAnchoredQaryGridPaddingPolynomial computer + have hbase : base.length = 2 * count + 1 + input.length := by + simp only [sourceQaryMaskDynamicGridBaseSource, hwidth, List.length_append, + lengthPrefixedWord_length, + List.length_replicate, base] + have hrankBase : rank ≤ base.length := by omega + have hcompact : + (lengthPrefixedWord (List.replicate rank true) ++ base).length ≤ + 3 * base.length + 1 := by + simp only [List.length_append, lengthPrefixedWord_length, + List.length_replicate] + omega + have houtput := GapCVP.TMComposition.outputLengthPolynomial_bounds + computer (lengthPrefixedWord (List.replicate rank true) ++ base) + have hmonotone := GapCVP.TMComposition.natPolynomial_eval_monotone + polynomial hcompact + have hpadding : padding.eval base.length = + polynomial.eval (3 * base.length + 1) := by + simp only [sourceAnchoredQaryGridPaddingPolynomial, Polynomial.eval_comp, Polynomial.eval_add, + Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, Polynomial.eval_one, + padding, polynomial] + have hanchor : padding.eval base.length ≤ + (maskDynamicGridPaddedAnchor + width computer input).length := by + simp only [maskDynamicGridPaddedAnchor, sourcePreservingPolynomialMarkerWord, + List.length_append, + lengthPrefixedWord_length, List.length_replicate, base, padding] + omega + rw [sourceQaryMaskDynamicGridCompactCandidate_paddedAnchor + width computer input (List.replicate rank true)] + change (candidate + (lengthPrefixedWord (List.replicate rank true) ++ base)).length ≤ _ + have hpoly : + (candidate + (lengthPrefixedWord (List.replicate rank true) ++ base)).length ≤ + padding.eval base.length := by + rw [hpadding] + exact houtput.trans hmonotone + exact hpoly.trans hanchor + +private theorem sourceQaryMaskDynamicGridRankDescriptors_valid + (width : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (count : ℕ) + (hwidth : width.output input = List.replicate count true) : + maskDynamicGridRankDescriptors width input = + (sourceAnchoredQaryGridRankPayloads count).flatMap + lengthPrefixedWord := by + unfold maskDynamicGridRankDescriptors + sourceQaryMaskDynamicGridCounter + rw [Function.comp_apply, hwidth] + rw [show List.replicate count true ++ [false] = + List.replicate count true ++ false :: [] by rfl] + rw [sourceCanonicalUnaryGridIndexOutput_valid] + simp only [List.append_nil, + sourceCanonicalUnaryGridIndexDescriptors, + sourceAnchoredQaryGridRankPayloads, List.flatMap_map] + rfl + +private theorem sourceQaryMaskDynamicGridFoldPreparation_valid + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) (count : ℕ) + (hwidth : width.output input = List.replicate count true) : + maskDynamicGridFoldPreparation + width computer input = + unaryBoundedFoldWord count + (lengthPrefixedWord + (maskDynamicGridPaddedAnchor + width computer input) ++ + (sourceAnchoredQaryGridRankPayloads count).flatMap + lengthPrefixedWord) := by + unfold maskDynamicGridFoldPreparation + sourceQaryMaskDynamicGridFoldSeed + rw [sourceQaryMaskDynamicGridRankDescriptors_valid + width input count hwidth] + unfold sourceQaryMaskDynamicGridCounter + rw [hwidth] + simp only [unaryBoundedFoldWord, + List.append_assoc, List.cons_append, List.nil_append] + +private theorem sourceQaryMaskDynamicGridCandidate_fits_all + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) (count : ℕ) + (hwidth : width.output input = List.replicate count true) : + ∀ rank ∈ sourceAnchoredQaryGridRankPayloads count, + (sourceAnchoredQaryGridCompactCandidate candidate + (lengthPrefixedWord rank ++ + maskDynamicGridPaddedAnchor + width computer input)).length ≤ + (maskDynamicGridPaddedAnchor + width computer input).length := by + intro rank hmember + obtain ⟨index, hindex, hword⟩ := List.mem_map.mp hmember + have hlt := List.mem_range.mp hindex + subst rank + exact sourceQaryMaskDynamicGridCandidate_fits + width computer input count index hwidth hlt + +theorem maskDynamicGridCandidateCatalogueOutput_valid + (width : SourceQaryMaskDynamicGridWidth) + {candidate : List Bool → List Bool} + (computer : BitTM candidate) + (input : List Bool) (count : ℕ) + (hwidth : width.output input = List.replicate count true) : + maskDynamicGridCandidateCatalogueOutput + width computer input = + (List.range count).flatMap + (fun rank => lengthPrefixedWord + (candidate (lengthPrefixedWord + (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input))) := by + have hfit := sourceQaryMaskDynamicGridCandidate_fits_all + width computer input count hwidth + have hfold := boundedRecordFoldOutput_sourceAnchoredGridRecordRanks + (sourceAnchoredQaryGridCompactCandidate candidate) + (maskDynamicGridPaddedAnchor width computer input) + (sourceAnchoredQaryGridRankPayloads count) [] hfit + unfold maskDynamicGridCandidateCatalogueOutput + rw [sourceQaryMaskDynamicGridFoldPreparation_valid + width computer input count hwidth] + have hcounter : + unaryBoundedFoldWord count + (lengthPrefixedWord + (maskDynamicGridPaddedAnchor + width computer input) ++ + (sourceAnchoredQaryGridRankPayloads count).flatMap + lengthPrefixedWord) = + unaryBoundedFoldWord + (sourceAnchoredQaryGridRankPayloads count).length + (lengthPrefixedWord + (maskDynamicGridPaddedAnchor + width computer input) ++ + (sourceAnchoredQaryGridRankPayloads count).flatMap + lengthPrefixedWord ++ []) := by + rw [sourceAnchoredQaryGridRankPayloads_length] + simp only [List.append_nil] + rw [hcounter, hfold] + simp only [List.append_nil, firstFieldSuffix_valid] + unfold sourceAnchoredQaryGridRankPayloads + rw [List.flatMap_map] + apply List.flatMap_congr + intro rank _ + exact congrArg lengthPrefixedWord + (sourceQaryMaskDynamicGridCompactCandidate_paddedAnchor + width computer input (List.replicate rank true)) + +private def sourceQaryMaskDynamicGridRecordFoldPreparation + (width : SourceQaryMaskDynamicGridWidth) + {record : List Bool → List Bool} + (computer : BitTM record) + (input : List Bool) : List Bool := + width.output input ++ false :: + maskDynamicGridCandidateCatalogueOutput + width computer input + +private noncomputable def sourceQaryMaskDynamicGridRecordFoldPreparationComputable + (width : SourceQaryMaskDynamicGridWidth) + {record : List Bool → List Bool} + (computer : BitTM record) : + BitTM + (sourceQaryMaskDynamicGridRecordFoldPreparation + width computer) := by + have htail := GapCVP.TMComposition.computableInPolyTime + (maskDynamicGridCandidateCatalogueComputable + width computer) + (prependBitComputable false) + exact pointwiseAppendComputable width.computer htail + +/-- GapCVP reduction support. -/ +def maskDynamicGridRecordCatalogueOutput + (width : SourceQaryMaskDynamicGridWidth) + {record : List Bool → List Bool} + (computer : BitTM record) : List Bool → List Bool := + boundedRecordFoldOutput sourceFlatAtomicRecordStep ∘ + sourceQaryMaskDynamicGridRecordFoldPreparation width computer + +/-- GapCVP reduction support. -/ +noncomputable def maskDynamicGridRecordCatalogueComputable + (width : SourceQaryMaskDynamicGridWidth) + {record : List Bool → List Bool} + (computer : BitTM record) : + BitTM + (maskDynamicGridRecordCatalogueOutput + width computer) := + GapCVP.TMComposition.computableInPolyTime + (sourceQaryMaskDynamicGridRecordFoldPreparationComputable + width computer) + sourceFlatAtomicRecordFoldComputable + +theorem maskDynamicGridRecordCatalogueOutput_valid + (width : SourceQaryMaskDynamicGridWidth) + {record : List Bool → List Bool} + (computer : BitTM record) + (input : List Bool) (count : ℕ) + (hwidth : width.output input = List.replicate count true) : + maskDynamicGridRecordCatalogueOutput + width computer input = + (List.range count).flatMap + (fun rank => record (lengthPrefixedWord + (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input)) := by + let records : List (List Bool) := + (List.range count).map + (fun rank => record (lengthPrefixedWord + (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input)) + have hcatalogue := + maskDynamicGridCandidateCatalogueOutput_valid + width computer input count hwidth + have hrecords : + maskDynamicGridCandidateCatalogueOutput + width computer input = + sourceFlatAtomicDescriptorStream records := by + rw [hcatalogue] + change + (List.range count).flatMap + (fun rank => lengthPrefixedWord + (record (lengthPrefixedWord + (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input))) = + records.flatMap sourceFlatAtomicDescriptor + unfold records + rw [List.flatMap_map] + rfl + have hlength : records.length = count := by + simp only [List.length_map, List.length_range, records] + unfold maskDynamicGridRecordCatalogueOutput + sourceQaryMaskDynamicGridRecordFoldPreparation + rw [Function.comp_apply, hwidth, hrecords] + change boundedRecordFoldOutput sourceFlatAtomicRecordStep + (unaryBoundedFoldWord count + (sourceFlatAtomicDescriptorStream records)) = _ + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + have hresult : + ((sourceFlatAtomicRecordStep^[count]) + (sourceFlatAtomicDescriptorStream records)) = + records.flatten := by + rw [← hlength] + simpa only [List.append_nil, List.nil_append] + using sourceFlatAtomicRecordStep_iterate_descriptors records [] + rw [hresult] + simp only [List.flatten_eq_flatMap, List.flatMap_map, id_eq, records] + +end SourceMixedRadixMaskSelectedFlatPreparationTM + +namespace BinaryStructuralRecordTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceWholeOutputValidBranchRecordTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.CNFBoundedRecordFoldTM +open GapCVP.Factor400BinaryEffectiveBasisSerializerTM + +private def constructiveStructuralRecordCountPolynomial : Polynomial ℕ := + 2 + Polynomial.X + Polynomial.X ^ 2 + +/-- GapCVP reduction support. -/ +def constructiveStructuralRecordCountOutput + (dimension : SourceQaryMaskDynamicGridWidth) + (input : List Bool) : List Bool := + List.replicate + (constructiveStructuralRecordCountPolynomial.eval + (dimension.output input).length) + true + +private noncomputable def constructiveStructuralRecordCountComputable + (dimension : SourceQaryMaskDynamicGridWidth) : + BitTM + (constructiveStructuralRecordCountOutput dimension) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + dimension.computer + (polynomialValueUnaryComputable + constructiveStructuralRecordCountPolynomial) + change + BitTM + (fun input : List Bool => + List.replicate + (constructiveStructuralRecordCountPolynomial.eval + (dimension.output input).length) + true) + exact hphysical + +theorem constructiveStructuralRecordCountOutput_valid + (dimension : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (n : ℕ) + (hdimension : dimension.output input = + List.replicate n true) : + constructiveStructuralRecordCountOutput dimension input = + List.replicate (2 + n + n * n) true := by + simp only [constructiveStructuralRecordCountOutput, hdimension, List.length_replicate, + constructiveStructuralRecordCountPolynomial, pow_two, Polynomial.eval_add, + Polynomial.eval_ofNat, Polynomial.eval_X, + Polynomial.eval_mul] + +/-- Internal support shared across GapCVP continuation modules. -/ +def constructiveStructuralRecordWidth + (dimension : SourceQaryMaskDynamicGridWidth) : + SourceQaryMaskDynamicGridWidth where + output := constructiveStructuralRecordCountOutput dimension + computer := constructiveStructuralRecordCountComputable dimension + +/-- GapCVP reduction support. -/ +structure ConstructiveStructuralAtomComputer where + /-- GapCVP reduction support. -/ + output : List Bool → List Bool + /-- GapCVP reduction support. -/ + computer : BitTM output + +/-- GapCVP reduction support. -/ +def constructiveStructuralRankQuery + (dimension : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + (constructiveStructuralRecordWidth dimension) input + +/-- GapCVP reduction support. -/ +def constructiveStructuralDescriptorOutput + (dimension : SourceQaryMaskDynamicGridWidth) + (atom : ConstructiveStructuralAtomComputer) : + List Bool → List Bool := + maskDynamicGridCandidateCatalogueOutput + (constructiveStructuralRecordWidth dimension) + atom.computer + +private noncomputable def constructiveStructuralDescriptorComputable + (dimension : SourceQaryMaskDynamicGridWidth) + (atom : ConstructiveStructuralAtomComputer) : + BitTM + (constructiveStructuralDescriptorOutput dimension atom) := + maskDynamicGridCandidateCatalogueComputable + (constructiveStructuralRecordWidth dimension) + atom.computer + +private theorem constructiveStructuralDescriptorOutput_valid + (dimension : SourceQaryMaskDynamicGridWidth) + (atom : ConstructiveStructuralAtomComputer) + (input : List Bool) (n : ℕ) + (hdimension : dimension.output input = + List.replicate n true) : + constructiveStructuralDescriptorOutput dimension atom input = + (List.range (2 + n + n * n)).flatMap + (fun rank => + lengthPrefixedWord + (atom.output + (constructiveStructuralRankQuery dimension input rank))) := by + apply maskDynamicGridCandidateCatalogueOutput_valid + (constructiveStructuralRecordWidth dimension) + atom.computer input (2 + n + n * n) + exact constructiveStructuralRecordCountOutput_valid + dimension input n hdimension + +private theorem constructiveStructuralRecords_indexed + (records : List (List Bool)) : + (List.range records.length).map + (fun index => records.getD index []) = records := by + apply List.ext_getElem + · simp only [List.getD_eq_getElem?_getD, List.length_map, List.length_range] + · intro index hleft hright + simpa only [List.getD_eq_getElem?_getD, List.getElem_map, List.getElem_range] using + (List.getElem_eq_getD (l := records) (i := index) (h := hright) ([] : List Bool)).symm + +theorem constructiveStructuralDescriptorOutput_eq_records + (dimension : SourceQaryMaskDynamicGridWidth) + (atom : ConstructiveStructuralAtomComputer) + (input : List Bool) (n : ℕ) + (records : List (List Bool)) + (hdimension : dimension.output input = + List.replicate n true) + (hcount : records.length = 2 + n + n * n) + (hatoms : ∀ rank : ℕ, rank < records.length → + atom.output + (constructiveStructuralRankQuery dimension input rank) = + records.getD rank []) : + constructiveStructuralDescriptorOutput dimension atom input = + sourceFlatAtomicDescriptorStream records := by + rw [constructiveStructuralDescriptorOutput_valid + dimension atom input n hdimension] + rw [← hcount] + calc + (List.range records.length).flatMap + (fun rank => lengthPrefixedWord + (atom.output + (constructiveStructuralRankQuery dimension input rank))) = + (List.range records.length).flatMap + (fun rank => lengthPrefixedWord + (records.getD rank [])) := by + apply List.flatMap_congr + intro rank hmember + rw [hatoms rank (List.mem_range.mp hmember)] + _ = ((List.range records.length).map + (fun index => records.getD index [])).flatMap + sourceFlatAtomicDescriptor := by + simp only [List.getD_eq_getElem?_getD, List.flatMap_map, sourceFlatAtomicDescriptor] + _ = sourceFlatAtomicDescriptorStream records := by + rw [constructiveStructuralRecords_indexed] + rfl + +/-- GapCVP reduction support. -/ +def constructiveStructuralSourceWord + (dimension : SourceQaryMaskDynamicGridWidth) + (atom : ConstructiveStructuralAtomComputer) : + List Bool → List Bool := + effectiveSourceSerializerOutput + (constructiveStructuralRecordCountOutput dimension) + (constructiveStructuralDescriptorOutput dimension atom) + +/-- GapCVP reduction support. -/ +noncomputable def constructiveStructuralSourceWordComputable + (dimension : SourceQaryMaskDynamicGridWidth) + (atom : ConstructiveStructuralAtomComputer) : + BitTM + (constructiveStructuralSourceWord dimension atom) := + effectiveSourceSerializerComputable + (constructiveStructuralRecordCountComputable dimension) + (constructiveStructuralDescriptorComputable dimension atom) + +theorem constructiveStructuralSourceWord_eq_encodeGapCVPInstance + (dimension : SourceQaryMaskDynamicGridWidth) + (atom : ConstructiveStructuralAtomComputer) + (input : List Bool) (lattice : GapCVPInstance) + (hdimension : dimension.output input = + List.replicate lattice.dimension true) + (hatoms : ∀ rank : ℕ, + rank < (sourceLatticeStructuralRecords lattice).length → + atom.output + (constructiveStructuralRankQuery dimension input rank) = + (sourceLatticeStructuralRecords lattice).getD rank []) : + constructiveStructuralSourceWord dimension atom input = + BinaryEncoding.encodeGapCVPInstance lattice := by + let records := sourceLatticeStructuralRecords lattice + have hcount : records.length = + 2 + lattice.dimension + lattice.dimension * lattice.dimension := by + exact sourceLatticeStructuralRecords_length lattice + have hcounter : + constructiveStructuralRecordCountOutput dimension input = + List.replicate records.length true := by + rw [constructiveStructuralRecordCountOutput_valid + dimension input lattice.dimension hdimension, hcount] + have hdescriptors : + constructiveStructuralDescriptorOutput dimension atom input = + sourceFlatAtomicDescriptorStream records := + constructiveStructuralDescriptorOutput_eq_records + dimension atom input lattice.dimension records + hdimension hcount hatoms + change + effectiveSourceSerializerOutput + (constructiveStructuralRecordCountOutput dimension) + (constructiveStructuralDescriptorOutput dimension atom) input = _ + rw [effectiveSourceSerializerOutput_eq_flatten + (constructiveStructuralRecordCountOutput dimension) + (constructiveStructuralDescriptorOutput dimension atom) + (fun _ => records) input hcounter hdescriptors] + exact sourceLatticeStructuralRecords_flatten lattice + +end BinaryStructuralRecordTM + +namespace Core + +section + +open scoped BigOperators +open Matrix + +namespace EffectiveBinaryGaussian + +private theorem swapRows_preserves_zero_column + {m n : ℕ} (system : System m n) + (left right : Fin m) (column : Fin n) + (hleft : system.check left column = 0) + (hright : system.check right column = 0) + (row : Fin m) : + (swapRows system left right).check row column = + system.check row column := by + by_cases hl : row = left + · subst row + simp only [swapRows, Equiv.swap_apply_left, hright, hleft] + · by_cases hr : row = right + · subst row + simp only [swapRows, Equiv.swap_apply_right, hleft, hright] + · change + system.check ((Equiv.swap left right) row) column = + system.check row column + rw [Equiv.swap_apply_of_ne_of_ne hl hr] + +private theorem columnStep_preserves_scanned_column + {m n : ℕ} (scanned : List (Fin n)) (state : State m n) + (normal : PrefixNormal scanned state) + (column : Fin n) (hrow : state.nextPivot < m) + (candidate : Fin m) + (hfound : findPivotOption state column = some candidate) + (oldColumn : Fin n) (hold : oldColumn ∈ scanned) + (row : Fin m) : + (columnStep state column).system.check row oldColumn = + state.system.check row oldColumn := by + let pivot : Fin m := ⟨state.nextPivot, hrow⟩ + let swapped : State m n := + applyOperation state (.swap candidate pivot) + have hcandidate : state.nextPivot ≤ candidate.val := + (findPivotOption_some state column candidate hfound).1 + have hcZero : state.system.check candidate oldColumn = 0 := + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.scanned_lower_zero normal oldColumn hold + candidate hcandidate + have hpZero : state.system.check pivot oldColumn = 0 := + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.scanned_lower_zero normal oldColumn hold pivot + (by simp only [Std.le_refl, pivot]) + have hswap (r : Fin m) : + swapped.system.check r oldColumn = + state.system.check r oldColumn := by + change (swapRows state.system candidate pivot).check r oldColumn = + state.system.check r oldColumn + exact swapRows_preserves_zero_column state.system candidate pivot + oldColumn hcZero hpZero r + have hswappedZero : swapped.system.check pivot oldColumn = 0 := by + rw [hswap pivot, hpZero] + simp only [columnStep, hrow, ↓reduceDIte, hfound] + change + (clearTargets pivot column (List.finRange m) swapped).system.check + row oldColumn = state.system.check row oldColumn + exact + (clearTargets_check_of_pivot_zero pivot column oldColumn + (List.finRange m) swapped hswappedZero row).trans (hswap row) + +private theorem columnStep_preserves_old_pivot_column + {m n : ℕ} (scanned : List (Fin n)) (state : State m n) + (normal : PrefixNormal scanned state) + (column : Fin n) (hrow : state.nextPivot < m) + (candidate : Fin m) + (hfound : findPivotOption state column = some candidate) + (pair : Fin m × Fin n) (hpair : pair ∈ state.pivots) + (row : Fin m) : + (columnStep state column).system.check row pair.2 = + state.system.check row pair.2 := by + let pivot : Fin m := ⟨state.nextPivot, hrow⟩ + let swapped : State m n := + applyOperation state (.swap candidate pivot) + have hcandidate : state.nextPivot ≤ candidate.val := + (findPivotOption_some state column candidate hfound).1 + have hbelow : pair.1.val < state.nextPivot := + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_below normal pair hpair + have hcne : candidate ≠ pair.1 := by + intro heq + have hv := congrArg (fun i : Fin m => i.val) heq + omega + have hpne : pivot ≠ pair.1 := by + intro heq + have hv := congrArg (fun i : Fin m => i.val) heq + change state.nextPivot = pair.1.val at hv + omega + have hcZero : state.system.check candidate pair.2 = 0 := by + rw [GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit normal pair hpair candidate, + ite_eq_right hcne] + have hpZero : state.system.check pivot pair.2 = 0 := by + rw [GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit normal pair hpair pivot, + ite_eq_right + hpne] + have hswap (r : Fin m) : + swapped.system.check r pair.2 = + state.system.check r pair.2 := by + change (swapRows state.system candidate pivot).check r pair.2 = + state.system.check r pair.2 + exact swapRows_preserves_zero_column state.system candidate pivot + pair.2 hcZero hpZero r + have hswappedZero : swapped.system.check pivot pair.2 = 0 := by + rw [hswap pivot, hpZero] + simp only [columnStep, hrow, ↓reduceDIte, hfound] + change + (clearTargets pivot column (List.finRange m) swapped).system.check + row pair.2 = state.system.check row pair.2 + exact + (clearTargets_check_of_pivot_zero pivot column pair.2 + (List.finRange m) swapped hswappedZero row).trans (hswap row) + +private theorem columnStep_prefixNormal + {m n : ℕ} (scanned : List (Fin n)) (state : State m n) + (column : Fin n) (normal : PrefixNormal scanned state) : + PrefixNormal (column :: scanned) (columnStep state column) := by + by_cases hrow : state.nextPivot < m + · cases hfound : findPivotOption state column with + | none => + have hnone : + ∀ row ∈ List.finRange m, + ¬ decide + (state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2)) = true := by + exact List.find?_eq_none.mp hfound + have hstate : columnStep state column = state := by + simp only [columnStep, hrow, ↓reduceDIte, hfound] + rw [hstate] + simp only [PrefixNormal, decide_eq_true_eq] + refine ⟨GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.nextPivot_le normal, + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_below normal, + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_complete normal, + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit normal, ?_⟩ + intro oldColumn hold row hge + rcases List.mem_cons.mp hold with hnew | hold + · subst oldColumn + apply binary_eq_zero_of_ne_one + intro hone + apply hnone row (List.mem_finRange row) + simp only [hge, hone, and_self, decide_true] + · exact GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.scanned_lower_zero normal + oldColumn hold row hge + | some candidate => + let pivot : Fin m := ⟨state.nextPivot, hrow⟩ + have hpivots : + (columnStep state column).pivots = + (pivot, column) :: state.pivots := by + simp only [columnStep, hrow, ↓reduceDIte, hfound, applyOperation, clearTargets_pivots, + pivot] + have hnext : + (columnStep state column).nextPivot = + state.nextPivot + 1 := by + simp only [columnStep, hrow, ↓reduceDIte, hfound, clearTargets_pivots] + simp only [PrefixNormal, decide_eq_true_eq] + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · rw [hnext] + omega + · intro pair hpair + rw [hpivots] at hpair + rcases List.mem_cons.mp hpair with hnew | hold + · subst pair + rw [hnext] + change state.nextPivot < state.nextPivot + 1 + omega + · rw [hnext] + have hb := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_below normal pair + hold + omega + · intro row hbelow + rw [hnext] at hbelow + by_cases hold : row.val < state.nextPivot + · obtain ⟨oldColumn, hmem⟩ := + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_complete normal row hold + refine ⟨oldColumn, ?_⟩ + rw [hpivots] + exact List.mem_cons_of_mem _ hmem + · have hval : row.val = state.nextPivot := by omega + have heq : row = pivot := by + apply Fin.ext + simpa only using hval + refine ⟨column, ?_⟩ + rw [hpivots, heq] + exact List.mem_cons_self + · intro pair hpair row + rw [hpivots] at hpair + rcases List.mem_cons.mp hpair with hnew | hold + · subst pair + exact columnStep_pivot_column + state column hrow candidate hfound row + · rw [columnStep_preserves_old_pivot_column + scanned state normal column hrow candidate hfound + pair hold row] + exact GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit normal pair hold row + · intro oldColumn hold row hge + rw [hnext] at hge + rcases List.mem_cons.mp hold with hnew | hold + · subst oldColumn + have hne : row ≠ (⟨state.nextPivot, hrow⟩ : Fin m) := by + intro heq + have hv := congrArg (fun i : Fin m => i.val) heq + change row.val = state.nextPivot at hv + omega + simpa only [hne, ↓reduceIte] using (columnStep_pivot_column state column hrow candidate + hfound row) + · rw [columnStep_preserves_scanned_column + scanned state normal column hrow candidate hfound + oldColumn hold row] + apply GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.scanned_lower_zero normal + oldColumn hold row + omega + · have hstate : columnStep state column = state := by + simp only [columnStep, hrow, ↓reduceDIte] + rw [hstate] + simp only [PrefixNormal, decide_eq_true_eq] + refine ⟨GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.nextPivot_le normal, + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_below normal, + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_complete normal, + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit normal, ?_⟩ + intro oldColumn hold row hge + have hlt := row.isLt + have hfull : m ≤ state.nextPivot := Nat.le_of_not_gt hrow + omega + +private theorem columnStep_pivots_pairwise + {m n : ℕ} (scanned : List (Fin n)) (state : State m n) + (column : Fin n) (normal : PrefixNormal scanned state) + (hunique : state.pivots.Pairwise (fun p q => p.1 ≠ q.1)) : + (columnStep state column).pivots.Pairwise + (fun p q => p.1 ≠ q.1) := by + by_cases hrow : state.nextPivot < m + · cases hfound : findPivotOption state column with + | none => + simpa only [ne_eq, columnStep, hrow, ↓reduceDIte, hfound] using hunique + | some candidate => + let pivot : Fin m := ⟨state.nextPivot, hrow⟩ + have hpivots : + (columnStep state column).pivots = + (pivot, column) :: state.pivots := by + simp only [columnStep, hrow, ↓reduceDIte, hfound, applyOperation, clearTargets_pivots, + pivot] + rw [hpivots] + refine List.pairwise_cons.mpr ⟨?_, hunique⟩ + intro pair hpair heq + have hbelow := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_below normal pair + hpair + have hv := congrArg (fun i : Fin m => i.val) heq + change state.nextPivot = pair.1.val at hv + omega + · simpa only [ne_eq, columnStep, hrow, ↓reduceDIte] using hunique + +private theorem runColumns_prefixNormal + {m n : ℕ} (columns scanned : List (Fin n)) (state : State m n) + (normal : PrefixNormal scanned state) : + PrefixNormal (columns.reverse ++ scanned) (runColumns columns state) := by + induction columns generalizing scanned state with + | nil => simpa only [List.reverse_nil, List.nil_append, runColumns, List.foldl_nil] using normal + | cons column rest ih => + change + PrefixNormal ((column :: rest).reverse ++ scanned) + (runColumns rest (columnStep state column)) + have hrest := ih (column :: scanned) (columnStep state column) + (columnStep_prefixNormal scanned state column normal) + simpa only [List.reverse_cons, List.append_assoc, List.cons_append, List.nil_append] + using hrest + +private theorem eliminate_prefixNormal + {m n : ℕ} (system : System m n) : + PrefixNormal (List.finRange n).reverse (eliminate system) := by + simpa only [eliminate, List.append_nil] using + (runColumns_prefixNormal (List.finRange n) [] (initialState system) + (initialState_prefixNormal system)) + +private theorem runColumns_pivots_pairwise + {m n : ℕ} (columns scanned : List (Fin n)) (state : State m n) + (normal : PrefixNormal scanned state) + (hunique : state.pivots.Pairwise (fun p q => p.1 ≠ q.1)) : + (runColumns columns state).pivots.Pairwise + (fun p q => p.1 ≠ q.1) := by + induction columns generalizing scanned state with + | nil => simpa only [ne_eq, runColumns, List.foldl_nil] using hunique + | cons column rest ih => + change + (runColumns rest (columnStep state column)).pivots.Pairwise + (fun p q => p.1 ≠ q.1) + exact ih (column :: scanned) (columnStep state column) + (columnStep_prefixNormal scanned state column normal) + (columnStep_pivots_pairwise scanned state column normal hunique) + +private theorem eliminate_pivots_pairwise + {m n : ℕ} (system : System m n) : + (eliminate system).pivots.Pairwise (fun p q => p.1 ≠ q.1) := by + simpa only [ne_eq, eliminate] using + (runColumns_pivots_pairwise (List.finRange n) [] (initialState system) + (initialState_prefixNormal system) + (by simp [initialState])) + +/-- GapCVP reduction support. -/ +noncomputable def System.InKernel {m n : ℕ} + (system : System m n) (assignment : Fin n → ZMod 2) : Bool := + @decide ( + system.check.mulVec assignment = 0 + ) (Classical.propDecidable _) +theorem RowOperation.inKernel_iff + {m n : ℕ} (operation : RowOperation m) + (system : System m n) (assignment : Fin n → ZMod 2) : + (operation.apply system).InKernel assignment ↔ + system.InKernel assignment := by + simp only [GapCVP.Core.EffectiveBinaryGaussian.System.InKernel, decide_eq_true_eq] + cases operation with + | swap left right => + let zeroSystem : System m n := + { check := system.check, rhs := 0 } + have h := swapRows_satisfies_iff + zeroSystem left right assignment + simp only [GapCVP.Core.EffectiveBinaryGaussian.System.Satisfies, + decide_eq_true_eq] at h + change + (swapRows zeroSystem left right).check.mulVec assignment = + (swapRows zeroSystem left right).rhs ↔ + zeroSystem.check.mulVec assignment = zeroSystem.rhs at h + have hzero : (swapRows zeroSystem left right).rhs = + (0 : Fin m → ZMod 2) := by + funext row + simp only [swapRows, Pi.zero_apply, zeroSystem] + rw [hzero] at h + change + (swapRows system left right).check.mulVec assignment = + (0 : Fin m → ZMod 2) ↔ + system.check.mulVec assignment = (0 : Fin m → ZMod 2) + exact h + | add source target distinct => + let zeroSystem : System m n := + { check := system.check, rhs := 0 } + have h := addRow_satisfies_iff + zeroSystem source target distinct assignment + simp only [GapCVP.Core.EffectiveBinaryGaussian.System.Satisfies, + decide_eq_true_eq] at h + change + (addRow zeroSystem source target).check.mulVec assignment = + (addRow zeroSystem source target).rhs ↔ + zeroSystem.check.mulVec assignment = zeroSystem.rhs at h + have hzero : (addRow zeroSystem source target).rhs = + (0 : Fin m → ZMod 2) := by + funext row + simp only [addRow, Pi.zero_apply, add_zero, ite_self, zeroSystem] + rw [hzero] at h + change + (addRow system source target).check.mulVec assignment = + (0 : Fin m → ZMod 2) ↔ + system.check.mulVec assignment = (0 : Fin m → ZMod 2) + exact h + +private theorem applyOperation_inKernel_iff + {m n : ℕ} (state : State m n) + (operation : RowOperation m) + (assignment : Fin n → ZMod 2) : + (applyOperation state operation).system.InKernel assignment ↔ + state.system.InKernel assignment := + operation.inKernel_iff state.system assignment + +private theorem clearTarget_inKernel_iff + {m n : ℕ} (pivot : Fin m) (column : Fin n) + (state : State m n) (target : Fin m) + (assignment : Fin n → ZMod 2) : + (clearTarget pivot column state target).system.InKernel assignment ↔ + state.system.InKernel assignment := by + unfold clearTarget + split + · rfl + · split + · exact applyOperation_inKernel_iff _ _ _ + · rfl + +private theorem clearTargets_inKernel_iff + {m n : ℕ} (pivot : Fin m) (column : Fin n) + (targets : List (Fin m)) (state : State m n) + (assignment : Fin n → ZMod 2) : + (clearTargets pivot column targets state).system.InKernel assignment ↔ + state.system.InKernel assignment := by + induction targets generalizing state with + | nil => rfl + | cons target rest ih => + change + (clearTargets pivot column rest + (clearTarget pivot column state target)).system.InKernel + assignment ↔ + state.system.InKernel assignment + exact (ih (clearTarget pivot column state target)).trans + (clearTarget_inKernel_iff pivot column state target assignment) + +private theorem columnStep_inKernel_iff + {m n : ℕ} (state : State m n) + (column : Fin n) (assignment : Fin n → ZMod 2) : + (columnStep state column).system.InKernel assignment ↔ + state.system.InKernel assignment := by + by_cases hactive : state.nextPivot < m + · cases hfound : findPivotOption state column with + | none => simp only [columnStep, hactive, ↓reduceDIte, hfound] + | some candidate => + simp only [columnStep, hactive, ↓reduceDIte, hfound] + exact + (clearTargets_inKernel_iff + ⟨state.nextPivot, hactive⟩ column (List.finRange m) + (applyOperation state + (.swap candidate ⟨state.nextPivot, hactive⟩)) + assignment).trans + (applyOperation_inKernel_iff state + (.swap candidate ⟨state.nextPivot, hactive⟩) + assignment) + · simp only [columnStep, hactive, ↓reduceDIte] + +private theorem runColumns_inKernel_iff + {m n : ℕ} (columns : List (Fin n)) + (state : State m n) (assignment : Fin n → ZMod 2) : + (runColumns columns state).system.InKernel assignment ↔ + state.system.InKernel assignment := by + induction columns generalizing state with + | nil => rfl + | cons column rest ih => + change + (runColumns rest (columnStep state column)).system.InKernel + assignment ↔ state.system.InKernel assignment + exact (ih (columnStep state column)).trans + (columnStep_inKernel_iff state column assignment) + +private theorem eliminate_inKernel_iff + {m n : ℕ} (system : System m n) + (assignment : Fin n → ZMod 2) : + (eliminate system).system.InKernel assignment ↔ + system.InKernel assignment := + runColumns_inKernel_iff (List.finRange n) + (initialState system) assignment + +end EffectiveBinaryGaussian + +theorem BinaryAffineSystem.effectiveGaussian_kernel_iff + (H : BinaryAffineSystem) + (assignment : Fin H.dimension → ZMod 2) : + H.effectiveGaussianState.system.check.mulVec assignment = 0 ↔ + H.check.mulVec assignment = 0 := by + simpa only [BinaryAffineSystem.effectiveGaussianState, + BinaryAffineSystem.effectiveGaussianSystem, + EffectiveBinaryGaussian.System.InKernel, decide_eq_true_eq] using + EffectiveBinaryGaussian.eliminate_inKernel_iff + H.effectiveGaussianSystem assignment + +theorem BinaryAffineSystem.effectiveGaussian_signedKernel_iff + (H : BinaryAffineSystem) (z : Fin H.dimension → ℤ) : + H.effectiveGaussianState.system.check.mulVec (binaryResidue z) = 0 ↔ + H.InLattice z := by + simp only [GapCVP.Core.BinaryAffineSystem.InLattice, decide_eq_true_eq] + exact H.effectiveGaussian_kernel_iff (binaryResidue z) + +theorem BinaryAffineSystem.effectivePivotRow_some_mem + (H : BinaryAffineSystem) + (column : Fin H.dimension) (row : Fin H.rowCount) + (hrow : H.effectivePivotRowOption column = some row) : + (row, column) ∈ H.effectiveGaussianState.pivots := by + unfold BinaryAffineSystem.effectivePivotRowOption at hrow + obtain ⟨pair, hfind, hfirst⟩ := + Option.map_eq_some_iff.mp hrow + have hsecond : pair.2 = column := by + have hdecide := List.find?_some hfind + exact of_decide_eq_true hdecide + obtain ⟨_, position, hposition, hget, _⟩ := + List.find?_eq_some_iff_getElem.mp hfind + have hmember : pair ∈ H.effectiveGaussianState.pivots := + List.mem_of_getElem hget + have heq : pair = (row, column) := + Prod.ext hfirst hsecond + simpa only [heq] using hmember + +theorem BinaryAffineSystem.effectivePivotRow_eq_some_of_mem + (H : BinaryAffineSystem) + (hnormal : EffectiveBinaryGaussian.PrefixNormal + (List.finRange H.dimension).reverse H.effectiveGaussianState) + (column : Fin H.dimension) (row : Fin H.rowCount) + (hmember : (row, column) ∈ H.effectiveGaussianState.pivots) : + H.effectivePivotRowOption column = some row := by + let predicate : Fin H.rowCount × Fin H.dimension → Bool := + fun pair => decide (pair.2 = column) + cases hfind : H.effectiveGaussianState.pivots.find? predicate with + | none => + have hnone := (List.find?_eq_none.mp hfind) + (row, column) hmember + have htrue : predicate (row, column) = true := by + simp only [decide_true, predicate] + exact (hnone htrue).elim + | some pair => + have hdecide := List.find?_some hfind + have hsecond : pair.2 = column := by + exact of_decide_eq_true hdecide + obtain ⟨_, position, hposition, hget, _⟩ := + List.find?_eq_some_iff_getElem.mp hfind + have hpair : pair ∈ H.effectiveGaussianState.pivots := + List.mem_of_getElem hget + have hpairUnit := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit hnormal pair + hpair row + have hrowUnit := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit hnormal + (row, column) hmember row + have hone : + H.effectiveGaussianState.system.check row column = 1 := by + simpa only [↓reduceIte] using hrowUnit + have hequnit : + H.effectiveGaussianState.system.check row column = + if row = pair.1 then 1 else 0 := by + simpa only [hsecond] using hpairUnit + have heq : pair.1 = row := by + by_contra hne + have hother : row ≠ pair.1 := Ne.symm hne + simp only [hone, hother, ↓reduceIte, one_ne_zero] at hequnit + unfold BinaryAffineSystem.effectivePivotRowOption + change + (H.effectiveGaussianState.pivots.find? predicate).map + Prod.fst = some row + rw [hfind] + simp only [Option.map_some, heq] + +private theorem effective_binary_add_eq_zero_iff_eq (left right : ZMod 2) : + left + right = 0 ↔ left = right := by + constructor + · intro hzero + calc + left = left + 0 := (add_zero left).symm + _ = left + (right + right) := by + rw [EffectiveBinaryGaussian.binary_add_self] + _ = (left + right) + right := by + rw [add_assoc] + _ = 0 + right := by rw [hzero] + _ = right := zero_add right + · intro hequal + rw [hequal] + exact EffectiveBinaryGaussian.binary_add_self right + +theorem BinaryAffineSystem.effectiveReducedRow_mulVec + (H : BinaryAffineSystem) + (hnormal : EffectiveBinaryGaussian.PrefixNormal + (List.finRange H.dimension).reverse H.effectiveGaussianState) + (hunique : ∀ (first second : Fin H.rowCount × Fin H.dimension), + first ∈ H.effectiveGaussianState.pivots → + second ∈ H.effectiveGaussianState.pivots → + first.1 = second.1 → first.2 = second.2) + (bits : Fin H.dimension → ZMod 2) + (pivotColumn : Fin H.dimension) (pivotRow : Fin H.rowCount) + (hpivot : H.effectivePivotRowOption pivotColumn = some pivotRow) : + H.effectiveGaussianState.system.check.mulVec bits pivotRow = + bits pivotColumn + + ∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + H.effectiveGaussianState.system.check pivotRow column * + bits column + else 0 := by + classical + have hpivotMem := H.effectivePivotRow_some_mem + pivotColumn pivotRow hpivot + change + (∑ column : Fin H.dimension, + H.effectiveGaussianState.system.check pivotRow column * + bits column) = _ + calc + (∑ column : Fin H.dimension, + H.effectiveGaussianState.system.check pivotRow column * + bits column) = + ∑ column : Fin H.dimension, + ((if column = pivotColumn then bits pivotColumn else 0) + + (if H.effectivePivotRowOption column = none then + H.effectiveGaussianState.system.check pivotRow column * + bits column + else 0)) := by + apply Finset.sum_congr rfl + intro column _ + by_cases hequal : column = pivotColumn + · subst column + have hunit := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit hnormal + (pivotRow, pivotColumn) hpivotMem pivotRow + simpa only [↓reduceIte, hpivot, reduceCtorEq, add_zero, one_mul] using + congrArg (fun value : ZMod 2 => value * bits pivotColumn) hunit + · cases hcolumn : H.effectivePivotRowOption column with + | none => + simp only [hequal, ↓reduceIte, zero_add] + | some otherRow => + have hotherMem := H.effectivePivotRow_some_mem + column otherRow hcolumn + have hrowne : pivotRow ≠ otherRow := by + intro heq + have hcolumnEq := hunique + (pivotRow, pivotColumn) (otherRow, column) + hpivotMem hotherMem heq + exact hequal hcolumnEq.symm + have hunit := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_unit hnormal + (otherRow, column) hotherMem pivotRow + simp only [hrowne, ↓reduceIte] at hunit + simp only [hunit, zero_mul, hequal, ↓reduceIte, reduceCtorEq, add_zero] + _ = bits pivotColumn + + ∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + H.effectiveGaussianState.system.check pivotRow column * + bits column + else 0 := by + rw [Finset.sum_add_distrib] + simp only [Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] + +theorem BinaryAffineSystem.effectiveSquareBasisMatrix_mulVec_pivot_full + (H : BinaryAffineSystem) + (coefficients : Fin H.dimension → ℤ) + (row : Fin H.dimension) (pivot : Fin H.rowCount) + (hrow : H.effectivePivotRowOption row = some pivot) : + H.effectiveSquareBasisMatrix.mulVec coefficients row = + (∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + ((H.effectiveGaussianState.system.check pivot column).val : ℤ) * + coefficients column + else 0) + 2 * coefficients row := by + classical + change + (∑ column : Fin H.dimension, + H.effectiveSquareBasisMatrix row column * + coefficients column) = _ + calc + (∑ column : Fin H.dimension, + H.effectiveSquareBasisMatrix row column * + coefficients column) = + ∑ column : Fin H.dimension, + ((if H.effectivePivotRowOption column = none then + ((H.effectiveGaussianState.system.check + pivot column).val : ℤ) * coefficients column + else 0) + + (if column = row then 2 * coefficients row else 0)) := by + apply Finset.sum_congr rfl + intro column _ + cases hcolumn : H.effectivePivotRowOption column with + | none => + have hne : column ≠ row := by + intro heq + subst column + simp only [hrow, reduceCtorEq] at hcolumn + simp only [effectiveSquareBasisMatrix, hrow, hcolumn, ZMod.natCast_val, ↓reduceIte, hne, + add_zero] + | some other => + by_cases heq : column = row + · subst column + simp only [effectiveSquareBasisMatrix, hrow, ↓reduceIte, reduceCtorEq, zero_add] + · simp only [effectiveSquareBasisMatrix, hrow, hcolumn, Ne.symm heq, ↓reduceIte, + zero_mul, reduceCtorEq, heq, + add_zero] + _ = (∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + ((H.effectiveGaussianState.system.check pivot column).val : ℤ) * + coefficients column + else 0) + 2 * coefficients row := by + rw [Finset.sum_add_distrib] + simp only [ZMod.natCast_val, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] + +theorem BinaryAffineSystem.effectiveGaussian_kernel_iff_graph_of_normal + (H : BinaryAffineSystem) + (hnormal : EffectiveBinaryGaussian.PrefixNormal + (List.finRange H.dimension).reverse H.effectiveGaussianState) + (hunique : ∀ (first second : Fin H.rowCount × Fin H.dimension), + first ∈ H.effectiveGaussianState.pivots → + second ∈ H.effectiveGaussianState.pivots → + first.1 = second.1 → first.2 = second.2) + (bits : Fin H.dimension → ZMod 2) : + H.effectiveGaussianState.system.check.mulVec bits = 0 ↔ + ∀ (pivotColumn : Fin H.dimension) + (pivotRow : Fin H.rowCount), + H.effectivePivotRowOption pivotColumn = some pivotRow → + bits pivotColumn = + ∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + H.effectiveGaussianState.system.check + pivotRow column * bits column + else 0 := by + classical + constructor + · intro hkernel pivotColumn pivotRow hpivot + have hrow := congrFun hkernel pivotRow + rw [H.effectiveReducedRow_mulVec + hnormal hunique bits pivotColumn pivotRow hpivot] at hrow + exact + (effective_binary_add_eq_zero_iff_eq + (bits pivotColumn) + (∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + H.effectiveGaussianState.system.check + pivotRow column * bits column + else 0)).mp (by simpa only [Pi.zero_apply] using hrow) + · intro hgraph + funext row + by_cases hrow : row.val < H.effectiveGaussianState.nextPivot + · obtain ⟨pivotColumn, hpivotMem⟩ := + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_complete hnormal row hrow + have hpivot := H.effectivePivotRow_eq_some_of_mem + hnormal pivotColumn row hpivotMem + have hrowFormula := H.effectiveReducedRow_mulVec + hnormal hunique bits pivotColumn row hpivot + rw [hrowFormula, hgraph pivotColumn row hpivot] + exact EffectiveBinaryGaussian.binary_add_self _ + · have hbelow : + H.effectiveGaussianState.nextPivot ≤ row.val := by omega + change + (∑ column : Fin H.dimension, + H.effectiveGaussianState.system.check row column * + bits column) = 0 + apply Finset.sum_eq_zero + intro column _ + have hzero := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.scanned_lower_zero hnormal + column (List.mem_reverse.mpr (List.mem_finRange column)) + row hbelow + simp only [hzero, zero_mul] + +/-- GapCVP reduction support. -/ +def BinaryAffineSystem.effectiveFreeLiftSum + (H : BinaryAffineSystem) (row : Fin H.rowCount) + (z : Fin H.dimension → ℤ) : ℤ := + ∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + ((H.effectiveGaussianState.system.check row column).val : ℤ) * + z column + else 0 + +theorem BinaryAffineSystem.effectiveFreeLiftSum_cast + (H : BinaryAffineSystem) (row : Fin H.rowCount) + (z : Fin H.dimension → ℤ) : + (H.effectiveFreeLiftSum row z : ZMod 2) = + ∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + H.effectiveGaussianState.system.check row column * + (z column : ZMod 2) + else 0 := by + classical + unfold BinaryAffineSystem.effectiveFreeLiftSum + rw [Int.cast_sum] + apply Finset.sum_congr rfl + intro column _ + by_cases hpivot : H.effectivePivotRowOption column = none + · simp only [hpivot, ↓reduceIte, Int.cast_mul] + congr 1 + exact_mod_cast ZMod.natCast_zmod_val + (H.effectiveGaussianState.system.check row column) + · simp only [hpivot, ↓reduceIte, Int.cast_zero] + +/-- GapCVP reduction support. -/ +def BinaryAffineSystem.effectiveBasisCoefficients + (H : BinaryAffineSystem) + (z : Fin H.dimension → ℤ) : Fin H.dimension → ℤ := + fun column => + match H.effectivePivotRowOption column with + | none => z column + | some row => + (z column - H.effectiveFreeLiftSum row z) / 2 + +theorem BinaryAffineSystem.effectiveBasis_two_dvd_of_normal + (H : BinaryAffineSystem) + (hnormal : EffectiveBinaryGaussian.PrefixNormal + (List.finRange H.dimension).reverse H.effectiveGaussianState) + (hunique : ∀ (first second : Fin H.rowCount × Fin H.dimension), + first ∈ H.effectiveGaussianState.pivots → + second ∈ H.effectiveGaussianState.pivots → + first.1 = second.1 → first.2 = second.2) + (z : Fin H.dimension → ℤ) (hz : H.InLattice z) + (column : Fin H.dimension) (row : Fin H.rowCount) + (hpivot : H.effectivePivotRowOption column = some row) : + (2 : ℤ) ∣ z column - H.effectiveFreeLiftSum row z := by + have hkernel := + (H.effectiveGaussian_signedKernel_iff z).mpr hz + have hgraph := + (H.effectiveGaussian_kernel_iff_graph_of_normal + hnormal hunique (binaryResidue z)).mp hkernel + have hbit := hgraph column row hpivot + apply (ZMod.intCast_zmod_eq_zero_iff_dvd + (z column - H.effectiveFreeLiftSum row z) 2).mp + rw [Int.cast_sub, H.effectiveFreeLiftSum_cast] + apply sub_eq_zero.mpr + exact hbit + +private theorem pairwise_pivot_rows_unique + {m n : ℕ} (pivots : List (Fin m × Fin n)) + (hpairwise : pivots.Pairwise (fun p q => p.1 ≠ q.1)) + (first second : Fin m × Fin n) + (hfirst : first ∈ pivots) (hsecond : second ∈ pivots) + (hrow : first.1 = second.1) : + first.2 = second.2 := by + induction pivots generalizing first second with + | nil => simp only [List.not_mem_nil] at hfirst + | cons head rest ih => + have hp := List.pairwise_cons.mp hpairwise + rcases List.mem_cons.mp hfirst with hfirst | hfirst + · subst first + rcases List.mem_cons.mp hsecond with hsecond | hsecond + · subst second + rfl + · exact (hp.1 second hsecond hrow).elim + · rcases List.mem_cons.mp hsecond with hsecond | hsecond + · subst second + exact (hp.1 first hfirst hrow.symm).elim + · exact ih hp.2 first second hfirst hsecond hrow + +theorem BinaryAffineSystem.effectiveBasis_mulVec_coefficients_of_normal + (H : BinaryAffineSystem) + (hnormal : EffectiveBinaryGaussian.PrefixNormal + (List.finRange H.dimension).reverse H.effectiveGaussianState) + (hunique : ∀ (first second : Fin H.rowCount × Fin H.dimension), + first ∈ H.effectiveGaussianState.pivots → + second ∈ H.effectiveGaussianState.pivots → + first.1 = second.1 → first.2 = second.2) + (z : Fin H.dimension → ℤ) (hz : H.InLattice z) : + H.effectiveSquareBasisMatrix.mulVec + (H.effectiveBasisCoefficients z) = z := by + classical + funext row + cases hrow : H.effectivePivotRowOption row with + | none => + rw [H.effectiveSquareBasisMatrix_mulVec_free + (H.effectiveBasisCoefficients z) row hrow] + simp only [effectiveBasisCoefficients, hrow] + | some pivot => + rw [H.effectiveSquareBasisMatrix_mulVec_pivot_full + (H.effectiveBasisCoefficients z) row pivot hrow] + have hsum : + (∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + ((H.effectiveGaussianState.system.check + pivot column).val : ℤ) * + H.effectiveBasisCoefficients z column + else 0) = H.effectiveFreeLiftSum pivot z := by + unfold BinaryAffineSystem.effectiveFreeLiftSum + apply Finset.sum_congr rfl + intro column _ + by_cases hcolumn : H.effectivePivotRowOption column = none + · simp only [hcolumn, ↓reduceIte, ZMod.natCast_val, effectiveBasisCoefficients] + · simp only [hcolumn, ↓reduceIte] + rw [hsum] + have hcoefficient : + H.effectiveBasisCoefficients z row = + (z row - H.effectiveFreeLiftSum pivot z) / 2 := by + simp only [effectiveBasisCoefficients, hrow] + rw [hcoefficient] + have hdvd := H.effectiveBasis_two_dvd_of_normal + hnormal hunique z hz row pivot hrow + have hdivision : + 2 * ((z row - H.effectiveFreeLiftSum pivot z) / 2) = + z row - H.effectiveFreeLiftSum pivot z := by + simpa only [mul_comm] using Int.ediv_mul_cancel hdvd + rw [hdivision] + omega + +theorem BinaryAffineSystem.effectiveBasis_mulVec_mem_lattice_of_normal + (H : BinaryAffineSystem) + (hnormal : EffectiveBinaryGaussian.PrefixNormal + (List.finRange H.dimension).reverse H.effectiveGaussianState) + (hunique : ∀ (first second : Fin H.rowCount × Fin H.dimension), + first ∈ H.effectiveGaussianState.pivots → + second ∈ H.effectiveGaussianState.pivots → + first.1 = second.1 → first.2 = second.2) + (coefficients : Fin H.dimension → ℤ) : + H.InLattice (H.effectiveSquareBasisMatrix.mulVec coefficients) := by + apply + (H.effectiveGaussian_signedKernel_iff + (H.effectiveSquareBasisMatrix.mulVec coefficients)).mp + apply + (H.effectiveGaussian_kernel_iff_graph_of_normal + hnormal hunique + (binaryResidue + (H.effectiveSquareBasisMatrix.mulVec coefficients))).mpr + intro pivotColumn pivotRow hpivot + have hvalue : + H.effectiveSquareBasisMatrix.mulVec coefficients pivotColumn = + H.effectiveFreeLiftSum pivotRow coefficients + + 2 * coefficients pivotColumn := by + simpa only [effectiveFreeLiftSum, ZMod.natCast_val] using + H.effectiveSquareBasisMatrix_mulVec_pivot_full coefficients pivotColumn pivotRow hpivot + change + ((H.effectiveSquareBasisMatrix.mulVec + coefficients pivotColumn : ℤ) : ZMod 2) = _ + rw [hvalue, Int.cast_add, Int.cast_mul] + have htwo : ((2 : ℤ) : ZMod 2) = 0 := by decide + rw [htwo, zero_mul, add_zero, + H.effectiveFreeLiftSum_cast] + apply Finset.sum_congr rfl + intro column _ + by_cases hcolumn : H.effectivePivotRowOption column = none + · simp only [hcolumn, ↓reduceIte] + congr 1 + change + (coefficients column : ZMod 2) = + ((H.effectiveSquareBasisMatrix.mulVec + coefficients column : ℤ) : ZMod 2) + rw [H.effectiveSquareBasisMatrix_mulVec_free + coefficients column hcolumn] + · simp only [hcolumn, ↓reduceIte] + +theorem BinaryAffineSystem.inLattice_iff_exists_effectiveBasis_of_normal + (H : BinaryAffineSystem) + (hnormal : EffectiveBinaryGaussian.PrefixNormal + (List.finRange H.dimension).reverse H.effectiveGaussianState) + (hunique : ∀ (first second : Fin H.rowCount × Fin H.dimension), + first ∈ H.effectiveGaussianState.pivots → + second ∈ H.effectiveGaussianState.pivots → + first.1 = second.1 → first.2 = second.2) + (z : Fin H.dimension → ℤ) : + H.InLattice z ↔ + ∃ coefficients : Fin H.dimension → ℤ, + H.effectiveSquareBasisMatrix.mulVec coefficients = z := by + constructor + · intro hz + exact ⟨H.effectiveBasisCoefficients z, + H.effectiveBasis_mulVec_coefficients_of_normal + hnormal hunique z hz⟩ + · rintro ⟨coefficients, rfl⟩ + exact H.effectiveBasis_mulVec_mem_lattice_of_normal + hnormal hunique coefficients + +theorem BinaryAffineSystem.effectivePivotRows_unique + (H : BinaryAffineSystem) + (first second : Fin H.rowCount × Fin H.dimension) + (hfirst : first ∈ H.effectiveGaussianState.pivots) + (hsecond : second ∈ H.effectiveGaussianState.pivots) + (hrow : first.1 = second.1) : first.2 = second.2 := by + apply pairwise_pivot_rows_unique + H.effectiveGaussianState.pivots + (EffectiveBinaryGaussian.eliminate_pivots_pairwise + H.effectiveGaussianSystem) + first second hfirst hsecond hrow + +theorem BinaryAffineSystem.inLattice_iff_exists_effectiveSquareBasisMatrix + (H : BinaryAffineSystem) (z : Fin H.dimension → ℤ) : + H.InLattice z ↔ + ∃ coefficients : Fin H.dimension → ℤ, + H.effectiveSquareBasisMatrix.mulVec coefficients = z := by + exact H.inLattice_iff_exists_effectiveBasis_of_normal + (EffectiveBinaryGaussian.eliminate_prefixNormal + H.effectiveGaussianSystem) + (fun first second hfirst hsecond hrow => + H.effectivePivotRows_unique + first second hfirst hsecond hrow) + z + +/-- GapCVP reduction support. -/ +def BinaryAffineSystem.effectiveReducedConsistent + (H : BinaryAffineSystem) : Bool := + decide (∀ row : Fin H.rowCount, + H.effectiveGaussianState.nextPivot ≤ row.val → + H.effectiveGaussianState.system.rhs row = 0) + +@[simp] theorem BinaryAffineSystem.effectiveReducedConsistent_iff + (H : BinaryAffineSystem) : + H.effectiveReducedConsistent = true ↔ + ∀ row : Fin H.rowCount, + H.effectiveGaussianState.nextPivot ≤ row.val → + H.effectiveGaussianState.system.rhs row = 0 := by + simp only [effectiveReducedConsistent, decide_eq_true_eq] + +theorem BinaryAffineSystem.effectiveAffineBits_satisfies + (H : BinaryAffineSystem) + (hconsistent : H.effectiveReducedConsistent = true) : + H.effectiveGaussianState.system.Satisfies + H.effectiveAffineBits := by + simp only [GapCVP.Core.EffectiveBinaryGaussian.System.Satisfies, decide_eq_true_eq] + classical + have hnormal := EffectiveBinaryGaussian.eliminate_prefixNormal + H.effectiveGaussianSystem + have hunique : + ∀ (first second : Fin H.rowCount × Fin H.dimension), + first ∈ H.effectiveGaussianState.pivots → + second ∈ H.effectiveGaussianState.pivots → + first.1 = second.1 → first.2 = second.2 := + fun first second hfirst hsecond hrow => + H.effectivePivotRows_unique + first second hfirst hsecond hrow + have hlower := + H.effectiveReducedConsistent_iff.mp hconsistent + funext row + by_cases hrow : row.val < H.effectiveGaussianState.nextPivot + · obtain ⟨pivotColumn, hmember⟩ := + GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.pivot_complete hnormal row hrow + have hpivot := H.effectivePivotRow_eq_some_of_mem + hnormal pivotColumn row hmember + rw [H.effectiveReducedRow_mulVec + hnormal hunique H.effectiveAffineBits pivotColumn row hpivot] + have hsum : + (∑ column : Fin H.dimension, + if H.effectivePivotRowOption column = none then + H.effectiveGaussianState.system.check row column * + H.effectiveAffineBits column + else 0) = 0 := by + apply Finset.sum_eq_zero + intro column _ + by_cases hcolumn : H.effectivePivotRowOption column = none + · simp only [hcolumn, ↓reduceIte, effectiveAffineBits, mul_zero] + · simp only [hcolumn, ↓reduceIte] + rw [hsum, add_zero] + simp only [effectiveAffineBits, hpivot] + · have hbelow : H.effectiveGaussianState.nextPivot ≤ row.val := by + omega + have hrhs : H.effectiveGaussianState.system.rhs row = 0 := + hlower row hbelow + rw [hrhs] + change + (∑ column : Fin H.dimension, + H.effectiveGaussianState.system.check row column * + H.effectiveAffineBits column) = 0 + apply Finset.sum_eq_zero + intro column _ + have hzero := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.scanned_lower_zero hnormal + column (List.mem_reverse.mpr (List.mem_finRange column)) + row hbelow + rw [show H.effectiveGaussianState.system.check row column = 0 + from hzero, zero_mul] + +theorem BinaryAffineSystem.effectiveAffineRepresentative_solves + (H : BinaryAffineSystem) + (hconsistent : H.effectiveReducedConsistent = true) : + H.Solves H.effectiveAffineRepresentative := by + apply + (H.effectiveGaussian_solves_iff + H.effectiveAffineRepresentative).mp + rw [H.effectiveAffineRepresentative_residue] + exact H.effectiveAffineBits_satisfies hconsistent + +theorem BinaryAffineSystem.effectiveReducedConsistent_iff_solvable + (H : BinaryAffineSystem) : + H.effectiveReducedConsistent = true ↔ + ∃ z : Fin H.dimension → ℤ, H.Solves z := by + constructor + · intro hconsistent + exact ⟨H.effectiveAffineRepresentative, + H.effectiveAffineRepresentative_solves hconsistent⟩ + · rintro ⟨z, hz⟩ + apply H.effectiveReducedConsistent_iff.mpr + intro row hbelow + have hnormal := EffectiveBinaryGaussian.eliminate_prefixNormal + H.effectiveGaussianSystem + have hsolution := + (H.effectiveGaussian_solves_iff z).mpr hz + have solution := hsolution + simp only [GapCVP.Core.EffectiveBinaryGaussian.System.Satisfies, + decide_eq_true_eq] at solution + have hroweq := congrFun solution row + have hzero : + H.effectiveGaussianState.system.check.mulVec + (binaryResidue z) row = 0 := by + change + (∑ column : Fin H.dimension, + H.effectiveGaussianState.system.check row column * + binaryResidue z column) = 0 + apply Finset.sum_eq_zero + intro column _ + have hentry := GapCVP.Core.EffectiveBinaryGaussian.PrefixNormal.scanned_lower_zero hnormal + column (List.mem_reverse.mpr (List.mem_finRange column)) + row hbelow + rw [show H.effectiveGaussianState.system.check row column = 0 + from hentry, zero_mul] + exact hroweq.symm.trans hzero + +theorem effectiveConstructionAInstance_solution_coset + (H : BinaryAffineSystem) + (hconsistent : H.effectiveReducedConsistent = true) + (z : Fin H.dimension → ℤ) : + H.Solves (H.effectiveAffineRepresentative - z) ↔ + ∃ coefficients : Fin H.dimension → ℤ, + H.effectiveSquareBasisMatrix.mulVec coefficients = z := by + rw [H.solves_sub_iff_inLattice + (H.effectiveAffineRepresentative_solves hconsistent)] + exact H.inLattice_iff_exists_effectiveSquareBasisMatrix z + +private theorem effectiveConstructionAInstance_squaredDistance_eq_integerSquaredNorm + (H : BinaryAffineSystem) (hdimension : 0 < H.dimension) + (v : Fin H.dimension → ℤ) + (radius : ℚ) (hradius : 0 < radius) + (coefficients : Fin H.dimension → ℤ) + (hcoefficients : + H.effectiveSquareBasisMatrix.mulVec coefficients = + H.effectiveAffineRepresentative - v) : + squaredDistance + (effectiveConstructionAInstance H hdimension radius hradius) + coefficients = (integerSquaredNorm v : ℝ) := by + classical + unfold squaredDistance integerSquaredNorm + change + (∑ i : Fin H.dimension, + (((H.effectiveAffineRepresentative i : ℚ) : ℝ) - + ∑ j : Fin H.dimension, + (H.effectiveSquareBasisMatrix i j : ℝ) * + (coefficients j : ℝ)) ^ 2) = + ((∑ i : Fin H.dimension, (v i).natAbs ^ 2 : ℕ) : ℝ) + push_cast + apply Finset.sum_congr rfl + intro i _ + have hrow : + (∑ j : Fin H.dimension, + (H.effectiveSquareBasisMatrix i j : ℝ) * + (coefficients j : ℝ)) = + ((H.effectiveAffineRepresentative i - v i : ℤ) : ℝ) := by + have hinteger := congrFun hcoefficients i + change + (∑ j : Fin H.dimension, + H.effectiveSquareBasisMatrix i j * coefficients j) = + H.effectiveAffineRepresentative i - v i at hinteger + exact_mod_cast hinteger + rw [hrow] + have habs : ((v i).natAbs : ℝ) = |(v i : ℝ)| := by + simpa only [Int.cast_natCast, Int.cast_abs] using + congrArg (fun value : ℤ => (value : ℝ)) + (Int.natCast_natAbs (v i)) + have hnorm : + ((v i).natAbs : ℝ) ^ 2 = (v i : ℝ) ^ 2 := by + rw [habs, sq_abs] + rw [hnorm, Int.cast_sub] + ring + +private theorem effectiveConstructionAInstance_squaredYes_iff_signedSolution + (H : BinaryAffineSystem) (hdimension : 0 < H.dimension) + (hconsistent : H.effectiveReducedConsistent = true) + (radius : ℚ) (hradius : 0 < radius) : + SquaredYes (effectiveConstructionAInstance H hdimension radius hradius) ↔ + ∃ v : Fin H.dimension → ℤ, H.Solves v ∧ + (integerSquaredNorm v : ℝ) ≤ (radius : ℝ) ^ 2 := by + simp only [GapCVP.Core.SquaredYes, decide_eq_true_eq] at * + constructor + · rintro ⟨coefficients, hshort⟩ + let v := H.effectiveAffineRepresentative - + H.effectiveSquareBasisMatrix.mulVec coefficients + have hv : H.Solves v := by + apply (effectiveConstructionAInstance_solution_coset + H hconsistent + (H.effectiveSquareBasisMatrix.mulVec coefficients)).mpr + exact ⟨coefficients, rfl⟩ + refine ⟨v, hv, ?_⟩ + have hbasis : + H.effectiveSquareBasisMatrix.mulVec coefficients = + H.effectiveAffineRepresentative - v := by + dsimp [v] + rw [sub_sub_cancel] + rw [← effectiveConstructionAInstance_squaredDistance_eq_integerSquaredNorm + H hdimension v radius hradius coefficients hbasis] + exact hshort + · rintro ⟨v, hv, hshort⟩ + have hcoset : + H.Solves + (H.effectiveAffineRepresentative - + (H.effectiveAffineRepresentative - v)) := by + simpa only [sub_sub_cancel] using hv + obtain ⟨coefficients, hcoefficients⟩ := + (effectiveConstructionAInstance_solution_coset H hconsistent + (H.effectiveAffineRepresentative - v)).mp hcoset + refine ⟨coefficients, ?_⟩ + rw [effectiveConstructionAInstance_squaredDistance_eq_integerSquaredNorm + H hdimension v radius hradius coefficients hcoefficients] + exact hshort + +private theorem squaredYes_of_metricYes + (I : GapCVPInstance) (hyes : I.IsYes) : + SquaredYes I := by + simp only [GapCVP.Core.SquaredYes, GapCVP.Core.GapCVPInstance.IsYes, decide_eq_true_eq] at * + obtain ⟨coefficients, hnearest⟩ := + exists_latticePoint_eq_latticeDistance I + refine ⟨coefficients, ?_⟩ + rw [squaredDistance_eq_dist_sq] + change I.latticeDistance ≤ (I.radius : ℝ) at hyes + rw [hnearest] at hyes + nlinarith [dist_nonneg (x := I.targetPoint) + (y := I.latticePoint coefficients)] + +theorem effectiveConstructionAInstance_yes_iff_signedSolution + (H : BinaryAffineSystem) (hdimension : 0 < H.dimension) + (hconsistent : H.effectiveReducedConsistent = true) + (radius : ℚ) (hradius : 0 < radius) : + (effectiveConstructionAInstance H hdimension radius hradius).IsYes ↔ + ∃ v : Fin H.dimension → ℤ, H.Solves v ∧ + (integerSquaredNorm v : ℝ) ≤ (radius : ℝ) ^ 2 := by + constructor + · intro hyes + exact + (effectiveConstructionAInstance_squaredYes_iff_signedSolution + H hdimension hconsistent radius hradius).mp + (squaredYes_of_metricYes _ hyes) + · intro hsolution + apply yes_of_squaredYes + exact + (effectiveConstructionAInstance_squaredYes_iff_signedSolution + H hdimension hconsistent radius hradius).mpr hsolution + +private theorem effectiveConstructionAInstance_squaredNoAt_iff_signedSolutionNorm + (H : BinaryAffineSystem) (hdimension : 0 < H.dimension) + (hconsistent : H.effectiveReducedConsistent = true) + (radius : ℚ) (hradius : 0 < radius) (exponent : ℝ) : + SquaredNoAt exponent + (effectiveConstructionAInstance H hdimension radius hradius) ↔ + ∀ v : Fin H.dimension → ℤ, H.Solves v → + (((H.dimension : ℝ) ^ exponent) * (radius : ℝ)) ^ 2 < + (integerSquaredNorm v : ℝ) := by + simp only [GapCVP.Core.SquaredNoAt, decide_eq_true_eq] at * + constructor + · intro hno v hv + have hcoset : + H.Solves + (H.effectiveAffineRepresentative - + (H.effectiveAffineRepresentative - v)) := by + simpa only [sub_sub_cancel] using hv + obtain ⟨coefficients, hcoefficients⟩ := + (effectiveConstructionAInstance_solution_coset H hconsistent + (H.effectiveAffineRepresentative - v)).mp hcoset + calc + (((H.dimension : ℝ) ^ exponent) * (radius : ℝ)) ^ 2 < + squaredDistance + (effectiveConstructionAInstance H hdimension radius hradius) + coefficients := hno coefficients + _ = (integerSquaredNorm v : ℝ) := + effectiveConstructionAInstance_squaredDistance_eq_integerSquaredNorm + H hdimension v radius hradius coefficients hcoefficients + · intro hno coefficients + let v := H.effectiveAffineRepresentative - + H.effectiveSquareBasisMatrix.mulVec coefficients + have hv : H.Solves v := by + apply (effectiveConstructionAInstance_solution_coset H hconsistent + (H.effectiveSquareBasisMatrix.mulVec coefficients)).mpr + exact ⟨coefficients, rfl⟩ + have hbasis : + H.effectiveSquareBasisMatrix.mulVec coefficients = + H.effectiveAffineRepresentative - v := by + dsimp [v] + rw [sub_sub_cancel] + calc + (((H.dimension : ℝ) ^ exponent) * (radius : ℝ)) ^ 2 < + (integerSquaredNorm v : ℝ) := hno v hv + _ = squaredDistance + (effectiveConstructionAInstance H hdimension radius hradius) + coefficients := + (effectiveConstructionAInstance_squaredDistance_eq_integerSquaredNorm + H hdimension v radius hradius coefficients hbasis).symm + +theorem effectiveConstructionAInstance_no_iff_signedSolutionNorm + (H : BinaryAffineSystem) (hdimension : 0 < H.dimension) + (hconsistent : H.effectiveReducedConsistent = true) + (radius : ℚ) (hradius : 0 < radius) (exponent : ℝ) : + (effectiveConstructionAInstance H hdimension radius hradius).IsNo exponent ↔ + ∀ v : Fin H.dimension → ℤ, H.Solves v → + (((H.dimension : ℝ) ^ exponent) * (radius : ℝ)) ^ 2 < + (integerSquaredNorm v : ℝ) := by + constructor + · intro hno + exact + (effectiveConstructionAInstance_squaredNoAt_iff_signedSolutionNorm + H hdimension hconsistent radius hradius exponent).mp + (squaredNoAt_of_metricNo exponent _ hno) + · intro hnorm + apply no_of_squaredNoAt exponent + exact + (effectiveConstructionAInstance_squaredNoAt_iff_signedSolutionNorm + H hdimension hconsistent radius hradius exponent).mpr hnorm + +end + +end Core + +namespace Factor400BinaryPhysicalWorkers + +open Turing GapCVP.SourceWholeOutputAssemblyTM GapCVP.CNFGuardedFiveFamilyTagDispatchTM + +/-- GapCVP reduction support. -/ +def factor400KeepFirstDropSecondWord : List Bool → List Bool + | [] => [] + | marker :: remaining => marker :: remaining.tail + +/-- GapCVP reduction support. -/ +noncomputable def factor400KeepFirstDropSecondComputable : + BitTM + factor400KeepFirstDropSecondWord := + keepFirstDropSecondComputable + +end Factor400BinaryPhysicalWorkers + +namespace BinaryDimensionTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceVariableFormulaDecoder GapCVP.OutputPolynomialCompositionClosure +open GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceAnchoredGridRecordFoldTM GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.Factor400BinarySourceTM + +/-- GapCVP reduction support. -/ +def sourceClauseCountUnary (input : List Bool) : List Bool := + ((variableClauseBodyOutput ∘ firstFieldSuffix) input).tail + +/-- GapCVP reduction support. -/ +noncomputable def sourceClauseCountUnaryComputable : + BitTM + sourceClauseCountUnary := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + variableFormulaBodyComputable dropHeadComputable + change + BitTM + (fun input : List Bool => + ((variableClauseBodyOutput ∘ firstFieldSuffix) input).tail) + exact hphysical + +@[simp] theorem sourceClauseCountUnary_valid + (formula : ThreeCNF) : + sourceClauseCountUnary (encodeThreeCNF formula) = + List.replicate formula.length true := by + simp only [sourceClauseCountUnary, Function.comp_apply, firstFieldSuffix_encodeThreeCNF, + variableClauseBodyOutput_valid, List.tail_cons] + +/-- GapCVP reduction support. -/ +def sourceInputLengthUnary (input : List Bool) : List Bool := + List.replicate input.length true + +/-- GapCVP reduction support. -/ +noncomputable def sourceInputLengthUnaryComputable : + BitTM + sourceInputLengthUnary := by + have hphysical := polynomialValueUnaryComputable Polynomial.X + change + BitTM + (fun input : List Bool => List.replicate input.length true) + simpa only [Polynomial.eval_X] using hphysical + +private def doublingAccumulator (input : List Bool) : List Bool := + firstFieldContents input + +private noncomputable def doublingAccumulatorComputable : + BitTM + doublingAccumulator := + firstFieldContentsComputable + +private def doublingTarget (input : List Bool) : List Bool := + firstFieldContents (firstFieldSuffix input) + +private noncomputable def doublingTargetComputable : + BitTM + doublingTarget := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + +private def doublingLessMarker (input : List Bool) : List Bool := + fourFamilyComputedUnaryLessBitOutput + doublingAccumulator doublingTarget input + +private noncomputable def doublingLessMarkerComputable : + BitTM + doublingLessMarker := + fourFamilyComputedUnaryLessBitComputable + doublingAccumulatorComputable doublingTargetComputable + +@[simp] private theorem doublingLessMarker_length (input : List Bool) : + (doublingLessMarker input).length = 1 := + fourFamilyComputedUnaryLessBitOutput_length + doublingAccumulator doublingTarget input + +private def doublingLessBit (input : List Bool) : Bool := + (doublingLessMarker input).headD false + +private theorem doublingLessMarker_eq (input : List Bool) : + doublingLessMarker input = [doublingLessBit input] := by + have hlength := doublingLessMarker_length input + cases hword : doublingLessMarker input with + | nil => simp only [hword, List.length_nil, zero_ne_one] at hlength + | cons bit remaining => + cases remaining with + | nil => simp only [doublingLessBit, hword, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] + | cons next tail => simp only [hword, List.length_cons, Nat.add_eq_right, + Nat.add_eq_zero_iff, List.length_eq_zero_iff, + one_ne_zero, and_false] at hlength + +private noncomputable def doublingLessSelectionComputable : + BitTM + (fun input : List Bool => doublingLessBit input :: input) := by + have hphysical := pointwiseAppendComputable + doublingLessMarkerComputable + (Turing.idComputableInPolyTime bitEncoding) + have heq : + (fun input : List Bool => + doublingLessMarker input ++ input) = + (fun input : List Bool => doublingLessBit input :: input) := by + funext input + simp only [doublingLessMarker_eq, List.cons_append, List.nil_append] + change + BitTM + (fun input : List Bool => doublingLessMarker input ++ input) + at hphysical + rwa [heq] at hphysical + +private def doublingExtra (input : List Bool) : List Bool := + if doublingLessBit input then doublingAccumulator input else [] + +private noncomputable def doublingExtraComputable : + BitTM + doublingExtra := + sourcePreservingConditionalComputable + doublingLessSelectionComputable doublingAccumulatorComputable [] + +private def guardedDoublingCandidate (input : List Bool) : List Bool := + doublingAccumulator input ++ doublingExtra input + +private noncomputable def guardedDoublingCandidateComputable : + BitTM + guardedDoublingCandidate := + pointwiseAppendComputable + doublingAccumulatorComputable doublingExtraComputable + +private def nextPowerStep (target current : ℕ) : ℕ := + if current < target then 2 * current else current + +private theorem guardedDoublingCandidate_valid + (current target : ℕ) (padding : List Bool) : + guardedDoublingCandidate + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding) = + List.replicate (nextPowerStep target current) true := by + have hacc : + doublingAccumulator + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding) = + List.replicate current true := by + simpa only [doublingAccumulator, List.append_assoc] using + firstFieldContents_valid + (List.replicate current true) + (lengthPrefixedWord (List.replicate target true) ++ padding) + have htarget : + doublingTarget + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding) = + List.replicate target true := by + change firstFieldContents + (firstFieldSuffix + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding)) = _ + rw [List.append_assoc, firstFieldSuffix_valid + (List.replicate current true) + (lengthPrefixedWord (List.replicate target true) ++ padding)] + exact firstFieldContents_valid + (List.replicate target true) padding + have hmarker : + doublingLessMarker + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding) = + [decide (current < target)] := by + exact fourFamilyComputedUnaryLessBitOutput_valid + doublingAccumulator doublingTarget _ current target hacc htarget + unfold guardedDoublingCandidate doublingExtra + rw [hacc] + have hbit : + doublingLessBit + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding) = + decide (current < target) := by + change + (doublingLessMarker + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ + padding)).headD false = _ + rw [hmarker] + rfl + rw [hbit] + by_cases hlt : current < target + · have hdouble : current + current = 2 * current := by omega + simp only [hlt, decide_true, ite_true, + nextPowerStep, List.replicate_append_replicate, hdouble] + · simp only [hlt, decide_false, Bool.false_eq_true, ↓reduceIte, List.append_nil, nextPowerStep] + +private theorem nextPowerStep_le_two_mul + (target current : ℕ) (hcurrent : current ≤ 2 * target) : + nextPowerStep target current ≤ 2 * target := by + unfold nextPowerStep + split <;> omega + +private def nextPowerAnchor (target : List Bool) : List Bool := + lengthPrefixedWord target ++ target ++ target + +private noncomputable def nextPowerAnchorComputable + {target : List Bool → List Bool} + (computer : BitTM target) : + BitTM + (fun input => nextPowerAnchor (target input)) := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + computer CLStructuralPrefixWriter.structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hprefix + (pointwiseAppendComputable computer computer) + change + BitTM + (fun input : List Bool => + lengthPrefixedWord (target input) ++ + target input ++ target input) + simpa only [Function.comp_apply, List.append_assoc] using hphysical + +private theorem nextPowerRotation_step + (target current : ℕ) + (hcurrent : current ≤ 2 * target) : + sourceAnchoredGridRecordRotationOutput guardedDoublingCandidate + (lengthPrefixedWord + (nextPowerAnchor (List.replicate target true)) ++ + lengthPrefixedWord (List.replicate current true)) = + lengthPrefixedWord + (nextPowerAnchor (List.replicate target true)) ++ + lengthPrefixedWord + (List.replicate (nextPowerStep target current) true) := by + let anchor := nextPowerAnchor (List.replicate target true) + let state := + lengthPrefixedWord anchor ++ + lengthPrefixedWord (List.replicate current true) + have hraw : + sourceAnchoredGridRawCandidate + guardedDoublingCandidate state = + List.replicate (nextPowerStep target current) true := by + change + guardedDoublingCandidate + (sourceAnchoredGridRankSourcePair state) = _ + have hrank : + firstFieldContents + (lengthPrefixedWord (List.replicate current true)) = + List.replicate current true := by + simpa only [List.append_nil] using + firstFieldContents_valid (List.replicate current true) [] + have hpair : + sourceAnchoredGridRankSourcePair state = + lengthPrefixedWord (List.replicate current true) ++ anchor := by + simp only [state, sourceAnchoredGridRankSourcePair, + firstFieldContents_valid, firstFieldSuffix_valid, + hrank] + rw [hpair] + simpa only [anchor, nextPowerAnchor, List.append_assoc] using + guardedDoublingCandidate_valid current target + (List.replicate target true ++ List.replicate target true) + have htarget : + nextPowerStep target current ≤ 2 * target := + nextPowerStep_le_two_mul target current hcurrent + have hfit : + (List.replicate (nextPowerStep target current) true).length ≤ + anchor.length := by + simp [anchor, nextPowerAnchor, + lengthPrefixedWord_length] + omega + have hselector : + sourceAnchoredGridCandidateSelector + guardedDoublingCandidate state = true := by + rw [sourceAnchoredGridCandidateSelector_eq, hraw] + have hcontents : firstFieldContents state = anchor := by + simp [state] + rw [hcontents] + exact decide_eq_true hfit + have hguard : + sourceAnchoredGridGuardedCandidate + guardedDoublingCandidate state = + List.replicate (nextPowerStep target current) true := by + simp [sourceAnchoredGridGuardedCandidate, + hselector, hraw] + have hrotation := + sourceAnchoredGridRecordRotationOutput_records + guardedDoublingCandidate anchor + (List.replicate current true) [] + simpa [state, anchor, hguard] using hrotation + +private theorem nextPowerRotation_iterate + (target current stages : ℕ) + (hcurrent : current ≤ 2 * target) : + ((sourceAnchoredGridRecordRotationOutput + guardedDoublingCandidate)^[stages]) + (lengthPrefixedWord + (nextPowerAnchor (List.replicate target true)) ++ + lengthPrefixedWord (List.replicate current true)) = + lengthPrefixedWord + (nextPowerAnchor (List.replicate target true)) ++ + lengthPrefixedWord + (List.replicate + (((nextPowerStep target)^[stages]) current) true) := by + induction stages generalizing current with + | zero => simp + | succ stages ih => + rw [Function.iterate_succ_apply, + nextPowerRotation_step target current hcurrent, + ih (nextPowerStep target current) + (nextPowerStep_le_two_mul target current hcurrent), + Function.iterate_succ_apply] + +private theorem nextPowerStep_iterate + (target stages : ℕ) : + ((nextPowerStep target)^[stages]) 1 = + 2 ^ min stages (Nat.clog 2 target) := by + induction stages with + | zero => simp only [Function.iterate_zero, id_eq, zero_le, inf_of_le_left, pow_zero] + | succ stages ih => + rw [Function.iterate_succ_apply', ih] + by_cases hlt : stages < Nat.clog 2 target + · have hpow : 2 ^ stages < target := + (Nat.lt_clog_iff_pow_lt (by norm_num : 1 < (2 : ℕ))).mp hlt + have hmin : min stages (Nat.clog 2 target) = stages := + Nat.min_eq_left (Nat.le_of_lt hlt) + have hminnext : + min (stages + 1) (Nat.clog 2 target) = stages + 1 := + Nat.min_eq_left (by omega) + rw [hmin, hminnext] + simp only [nextPowerStep, hpow, ↓reduceIte, pow_succ, Nat.mul_comm] + · have hle : Nat.clog 2 target ≤ stages := by omega + have hmin : + min stages (Nat.clog 2 target) = Nat.clog 2 target := + Nat.min_eq_right hle + have hminnext : + min (stages + 1) (Nat.clog 2 target) = + Nat.clog 2 target := + Nat.min_eq_right (by omega) + have hbound : target ≤ 2 ^ Nat.clog 2 target := + Nat.le_pow_clog (by norm_num : 1 < (2 : ℕ)) target + rw [hmin, hminnext] + simp only [nextPowerStep, Nat.not_lt_of_ge hbound, ↓reduceIte] + +private theorem nat_le_two_pow (n : ℕ) : n ≤ 2 ^ n := by + exact (Nat.lt_two_pow_self (n := n)).le + +private theorem nextPowerStep_iterate_target (target : ℕ) : + ((nextPowerStep target)^[target]) 1 = + 2 ^ Nat.clog 2 target := by + rw [nextPowerStep_iterate] + have hclog : Nat.clog 2 target ≤ target := + (Nat.clog_le_iff_le_pow + (by norm_num : 1 < (2 : ℕ))).mpr (nat_le_two_pow target) + rw [Nat.min_eq_right hclog] + +private def nextPowerFoldPreparation + (target : List Bool → List Bool) + (input : List Bool) : List Bool := + target input ++ false :: + (lengthPrefixedWord (nextPowerAnchor (target input)) ++ + lengthPrefixedWord [true]) + +private noncomputable def nextPowerFoldPreparationComputable + {target : List Bool → List Bool} + (computer : BitTM target) : + BitTM + (nextPowerFoldPreparation target) := by + have hanchor := GapCVP.TMComposition.computableInPolyTime + (nextPowerAnchorComputable computer) + CLStructuralPrefixWriter.structuralPrefixWriterComputable + have hseed := pointwiseAppendComputable hanchor + (SourceCanonicalFixedWordTuringTM.sourceFixedWordComputable + (lengthPrefixedWord [true])) + have hdelimited := GapCVP.TMComposition.computableInPolyTime + hseed (prependBitComputable false) + have hphysical := pointwiseAppendComputable computer hdelimited + change + BitTM + (fun input : List Bool => + target input ++ false :: + (lengthPrefixedWord (nextPowerAnchor (target input)) ++ + lengthPrefixedWord [true])) + simpa only [Function.comp_apply] using hphysical + +/-- GapCVP reduction support. -/ +def nextPowerUnaryOutput + (target : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + guardedDoublingCandidate) + (nextPowerFoldPreparation target input))) + +/-- GapCVP reduction support. -/ +noncomputable def nextPowerUnaryComputable + {target : List Bool → List Bool} + (computer : BitTM target) : + BitTM + (nextPowerUnaryOutput target) := by + have hprepared := GapCVP.TMComposition.computableInPolyTime + (nextPowerFoldPreparationComputable computer) + (sourceAnchoredGridRecordFoldComputable + guardedDoublingCandidateComputable) + have hdrop := GapCVP.TMComposition.computableInPolyTime + hprepared firstFieldSuffixComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hdrop firstFieldContentsComputable + change + BitTM + (fun input : List Bool => + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + guardedDoublingCandidate) + (nextPowerFoldPreparation target input)))) + exact hphysical + +theorem nextPowerUnaryOutput_valid + (target : List Bool → List Bool) + (input : List Bool) (n : ℕ) + (htarget : target input = List.replicate n true) + (hn : 0 < n) : + nextPowerUnaryOutput target input = + List.replicate (2 ^ Nat.clog 2 n) true := by + unfold nextPowerUnaryOutput nextPowerFoldPreparation + rw [htarget] + change + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + guardedDoublingCandidate) + (unaryBoundedFoldWord n + (lengthPrefixedWord + (nextPowerAnchor (List.replicate n true)) ++ + lengthPrefixedWord [true])))) = _ + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + have hone : 1 ≤ 2 * n := by omega + change + firstFieldContents + (firstFieldSuffix + (((sourceAnchoredGridRecordRotationOutput + guardedDoublingCandidate)^[n]) + (lengthPrefixedWord + (nextPowerAnchor (List.replicate n true)) ++ + lengthPrefixedWord (List.replicate 1 true)))) = _ + rw [nextPowerRotation_iterate n 1 n hone, + nextPowerStep_iterate_target] + rw [firstFieldSuffix_valid + (nextPowerAnchor (List.replicate n true)) + (lengthPrefixedWord + (List.replicate (2 ^ Nat.clog 2 n) true))] + simpa only [List.append_nil] using + firstFieldContents_valid + (List.replicate (2 ^ Nat.clog 2 n) true) [] + +private def unarySubtractionPreparation + (base subtract : List Bool → List Bool) + (input : List Bool) : List Bool := + subtract input ++ false :: base input + +private noncomputable def unarySubtractionPreparationComputable + {base subtract : List Bool → List Bool} + (hbase : BitTM base) + (hsubtract : BitTM subtract) : + BitTM + (unarySubtractionPreparation base subtract) := by + have hdelimited := GapCVP.TMComposition.computableInPolyTime + hbase (prependBitComputable false) + have hphysical := pointwiseAppendComputable + hsubtract hdelimited + change + BitTM + (fun input : List Bool => + subtract input ++ false :: base input) + exact hphysical + +/-- GapCVP reduction support. -/ +def unarySubtractionOutput + (base subtract : List Bool → List Bool) + (input : List Bool) : List Bool := + boundedRecordFoldOutput List.tail + (unarySubtractionPreparation base subtract input) + +private theorem dropHead_nonexpansive (state : List Bool) : + (state.tail).length ≤ state.length := by + cases state <;> simp + +/-- GapCVP reduction support. -/ +noncomputable def unarySubtractionComputable + {base subtract : List Bool → List Bool} + (hbase : BitTM base) + (hsubtract : BitTM subtract) : + BitTM + (unarySubtractionOutput base subtract) := by + have hworker := + nonexpansiveBoundedWorkerComputable + dropHeadComputable dropHead_nonexpansive + have hphysical := GapCVP.TMComposition.computableInPolyTime + (unarySubtractionPreparationComputable hbase hsubtract) + hworker + change + BitTM + (fun input : List Bool => + boundedRecordFoldOutput List.tail + (unarySubtractionPreparation base subtract input)) + exact hphysical + +private theorem tail_iterate_replicate + (count length : ℕ) : + ((List.tail^[count]) (List.replicate length true)) = + List.replicate (length - count) true := by + induction count generalizing length with + | zero => simp only [Function.iterate_zero, id_eq, tsub_zero] + | succ count ih => + rw [Function.iterate_succ_apply', ih] + cases hremaining : length - count with + | zero => + have hle : length ≤ count := + Nat.sub_eq_zero_iff_le.mp hremaining + have hnext : length - (count + 1) = 0 := by omega + simp only [List.replicate_zero, List.tail_nil, hnext] + | succ remaining => + have hnext : length - (count + 1) = remaining := by + omega + simp only [List.replicate_succ, List.tail_cons, hnext] + +theorem unarySubtractionOutput_valid + (base subtract : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hbase : base input = List.replicate first true) + (hsubtract : subtract input = List.replicate second true) : + unarySubtractionOutput base subtract input = + List.replicate (first - second) true := by + unfold unarySubtractionOutput unarySubtractionPreparation + rw [hbase, hsubtract] + change + boundedRecordFoldOutput List.tail + (unaryBoundedFoldWord second + (List.replicate first true)) = _ + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + exact tail_iterate_replicate second first + +end BinaryDimensionTM + +namespace SourceMixedRadixMaskSelectedSquareBasisIdentityAtomTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CNFEncodedClauseSort GapCVP.CNFGuardedFiveFamilyTagDispatchTM + +private def sourceQaryMaskSquarePairEqualityBit : List Bool → List Bool := + encodedOrderingEqualityBitWord ∘ + firstFieldSuffix ∘ sourcePreservingDelimitedPairComparisonWord + +private noncomputable def sourceQaryMaskSquarePairEqualityBitComputable : + BitTM + sourceQaryMaskSquarePairEqualityBit := by + have hcomparison := GapCVP.TMComposition.computableInPolyTime + sourcePreservingDelimitedPairComparisonComputable + firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hcomparison encodedOrderingEqualityBitComputable + +private theorem sourceQaryMaskSquarePairEqualityBit_eq + (input : List Bool) : + sourceQaryMaskSquarePairEqualityBit input = + [decide (delimitedPairWordOrdering input = .equal)] := by + unfold sourceQaryMaskSquarePairEqualityBit + simp only [Function.comp_apply, sourcePreservingDelimitedPairComparisonWord, + firstFieldSuffix_valid, + encodedOrderingEqualityBitWord_ordering] + +private theorem sourceQaryMaskSquarePairEqualityBit_valid + (first second original : List Bool) : + sourceQaryMaskSquarePairEqualityBit + (lengthPrefixedWord first ++ + lengthPrefixedWord second ++ original) = + [decide (first = second)] := by + rw [sourceQaryMaskSquarePairEqualityBit_eq, + delimitedPairWordOrdering_valid] + simp only [lexicographicEncodedWordOrdering_eq_equal_iff] + +end SourceMixedRadixMaskSelectedSquareBasisIdentityAtomTM + +namespace SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMixedRadixMaskSelectedSquareBasisIdentityAtomTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +def maskComputedWordEquality + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceQaryMaskSquarePairEqualityBit + (lengthPrefixedWord (first input) ++ + lengthPrefixedWord (second input)) + +/-- GapCVP reduction support. -/ +noncomputable def maskComputedWordEqualityComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (maskComputedWordEquality first second) := by + have hleft := GapCVP.TMComposition.computableInPolyTime + hfirst structuralPrefixWriterComputable + have hright := GapCVP.TMComposition.computableInPolyTime + hsecond structuralPrefixWriterComputable + exact GapCVP.TMComposition.computableInPolyTime + (pointwiseAppendComputable hleft hright) + sourceQaryMaskSquarePairEqualityBitComputable + +@[simp] theorem sourceQaryMaskSquareComputedWordEquality_valid + (first second : List Bool → List Bool) + (input : List Bool) : + maskComputedWordEquality first second input = + [decide (first input = second input)] := by + unfold maskComputedWordEquality + simpa only [List.append_nil] using sourceQaryMaskSquarePairEqualityBit_valid (first input) + (second input) [] + +end SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part10B.lean b/LeanPool/GapCVP/Part10B.lean new file mode 100644 index 000000000..0a27ada7f --- /dev/null +++ b/LeanPool/GapCVP/Part10B.lean @@ -0,0 +1,4419 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part10A + +/-! # GapCVP proof, part 10, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMixedRadixMaskSelectedSquareBasisIdentityAtomTM + +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM + +end SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM + +namespace SourceMixedRadixMaskSelectedRankTaggedLowerLeftSourceTM + +open Turing GapCVP.SourceOriginalSourcePreservingTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.CNFGuardedFiveFamilyTagDispatchTM + +private def sourceQaryMaskRankTaggedLowerLeftEqualitySelection + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + (maskComputedWordEquality first second input).headD + false :: input + +/-- GapCVP reduction support. -/ +noncomputable def + sourceQaryMaskRankTaggedLowerLeftEqualitySelectionComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (sourceQaryMaskRankTaggedLowerLeftEqualitySelection + first second) := by + have hmarker := maskComputedWordEqualityComputable + hfirst hsecond + have hpreserved := originalSourcePreservingComputable hmarker + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved keepFirstDropSecondComputable + have hequality : + (fun input : List Bool => keepFirstDropSecondWord + (originalSourcePreservingOutput + (maskComputedWordEquality first second) + input)) = + sourceQaryMaskRankTaggedLowerLeftEqualitySelection + first second := by + funext input + unfold originalSourcePreservingOutput + rw [sourceQaryMaskSquareComputedWordEquality_valid] + simp only [keepFirstDropSecondWord, List.cons_append, List.nil_append, List.tail_cons, + sourceQaryMaskRankTaggedLowerLeftEqualitySelection, + sourceQaryMaskSquareComputedWordEquality_valid, + List.headD_eq_head?_getD, List.head?_cons, Option.getD_some] + rw [← hequality] + exact hphysical + +end SourceMixedRadixMaskSelectedRankTaggedLowerLeftSourceTM + +namespace SourceNormalizedVariableRankScanTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.FormulaSemanticCert +open GapCVP.SourceTotalStructuralDecoder GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceVariableFormulaDecoder GapCVP.OutputPolynomialCompositionClosure +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceOriginalSourcePreservingTM GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceIndexedClauseLookupTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedLowerLeftSourceTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFGuardedFiveFamilyTagDispatchTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +private def sourceNormalizedVariableScanTargetWord : List Bool → List Bool := + firstFieldContents + +private noncomputable def sourceNormalizedVariableScanTargetWordComputable : + BitTM + sourceNormalizedVariableScanTargetWord := + firstFieldContentsComputable + +private def sourceNormalizedVariableScanCounterWord : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix + +private noncomputable def sourceNormalizedVariableScanCounterWordComputable : + BitTM + sourceNormalizedVariableScanCounterWord := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + +private def sourceNormalizedVariableScanPending : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +private noncomputable def sourceNormalizedVariableScanPendingComputable : + BitTM + sourceNormalizedVariableScanPending := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + +private def sourceNormalizedVariableScanCurrentWord : List Bool → List Bool := + firstFieldContents ∘ sourceNormalizedVariableScanPending + +private noncomputable def sourceNormalizedVariableScanCurrentWordComputable : + BitTM + sourceNormalizedVariableScanCurrentWord := + GapCVP.TMComposition.computableInPolyTime + sourceNormalizedVariableScanPendingComputable + firstFieldContentsComputable + +private def sourceNormalizedVariableScanEquality : List Bool → List Bool := + maskComputedWordEquality + sourceNormalizedVariableScanTargetWord + sourceNormalizedVariableScanCurrentWord + +private noncomputable def sourceNormalizedVariableScanEqualityComputable : + BitTM + sourceNormalizedVariableScanEquality := + maskComputedWordEqualityComputable + sourceNormalizedVariableScanTargetWordComputable + sourceNormalizedVariableScanCurrentWordComputable + +private def sourceNormalizedVariableScanAdvance + (input : List Bool) : List Bool := + lengthPrefixedWord + (sourceNormalizedVariableScanTargetWord input) ++ + (lengthPrefixedWord + (true :: sourceNormalizedVariableScanCounterWord input) ++ + literalSuffix (sourceNormalizedVariableScanPending input)) + +private noncomputable def sourceNormalizedVariableScanAdvanceComputable : + BitTM + sourceNormalizedVariableScanAdvance := by + have htarget := GapCVP.TMComposition.computableInPolyTime + sourceNormalizedVariableScanTargetWordComputable + structuralPrefixWriterComputable + have hcounterBit := GapCVP.TMComposition.computableInPolyTime + sourceNormalizedVariableScanCounterWordComputable + (prependBitComputable true) + have hcounter := GapCVP.TMComposition.computableInPolyTime + hcounterBit structuralPrefixWriterComputable + have hpending := GapCVP.TMComposition.computableInPolyTime + sourceNormalizedVariableScanPendingComputable literalSuffixComputable + exact pointwiseAppendComputable htarget + (pointwiseAppendComputable hcounter hpending) + +private def sourceNormalizedVariableScanEqualitySelection + (input : List Bool) : List Bool := + (sourceNormalizedVariableScanEquality input).headD false :: input + +private noncomputable def sourceNormalizedVariableScanEqualitySelectionComputable : + BitTM + sourceNormalizedVariableScanEqualitySelection := + sourceQaryMaskRankTaggedLowerLeftEqualitySelectionComputable + sourceNormalizedVariableScanTargetWordComputable + sourceNormalizedVariableScanCurrentWordComputable + +private def sourceNormalizedVariableScanMismatchMarker : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput sourceNormalizedVariableScanEquality + +private noncomputable def sourceNormalizedVariableScanMismatchMarkerComputable : + BitTM + sourceNormalizedVariableScanMismatchMarker := + fourFamilyBooleanNotOutputComputable + sourceNormalizedVariableScanEqualityComputable + +private def sourceNormalizedVariableScanMismatchSelection + (input : List Bool) : List Bool := + (sourceNormalizedVariableScanMismatchMarker input).headD false :: input + +private noncomputable def sourceNormalizedVariableScanMismatchSelectionComputable : + BitTM + sourceNormalizedVariableScanMismatchSelection := by + have hpreserved := originalSourcePreservingComputable + sourceNormalizedVariableScanMismatchMarkerComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved keepFirstDropSecondComputable + have hequality : + (fun input : List Bool => keepFirstDropSecondWord + (originalSourcePreservingOutput + sourceNormalizedVariableScanMismatchMarker input)) = + sourceNormalizedVariableScanMismatchSelection := by + funext input + unfold originalSourcePreservingOutput + sourceNormalizedVariableScanMismatchMarker + sourceNormalizedVariableScanEquality + rw [fourFamilyBooleanNotOutput_bit + (maskComputedWordEquality + sourceNormalizedVariableScanTargetWord + sourceNormalizedVariableScanCurrentWord) + input + (decide (sourceNormalizedVariableScanTargetWord input = + sourceNormalizedVariableScanCurrentWord input)) + (sourceQaryMaskSquareComputedWordEquality_valid + sourceNormalizedVariableScanTargetWord + sourceNormalizedVariableScanCurrentWord input)] + simp only [keepFirstDropSecondWord, List.cons_append, List.nil_append, List.tail_cons, + sourceNormalizedVariableScanMismatchSelection, sourceNormalizedVariableScanMismatchMarker, + sourceFourFamilyBooleanNotOutput, sourceNormalizedVariableScanEquality, + Function.comp_apply, + sourceQaryMaskSquareComputedWordEquality_valid, sourceFourFamilyBooleanNotWord_bit, + List.headD_eq_head?_getD, + List.head?_cons, Option.getD_some] + rw [← hequality] + exact hphysical + +private def sourceNormalizedVariableScanFoundBranch + (input : List Bool) : List Bool := + if (sourceNormalizedVariableScanEquality input).headD false then + input + else [] + +private noncomputable def sourceNormalizedVariableScanFoundBranchComputable : + BitTM + sourceNormalizedVariableScanFoundBranch := + sourcePreservingConditionalComputable + sourceNormalizedVariableScanEqualitySelectionComputable + (Turing.idComputableInPolyTime bitEncoding) [] + +private def sourceNormalizedVariableScanAdvanceBranch + (input : List Bool) : List Bool := + if (sourceNormalizedVariableScanMismatchMarker input).headD false then + sourceNormalizedVariableScanAdvance input + else [] + +private noncomputable def sourceNormalizedVariableScanAdvanceBranchComputable : + BitTM + sourceNormalizedVariableScanAdvanceBranch := + sourcePreservingConditionalComputable + sourceNormalizedVariableScanMismatchSelectionComputable + sourceNormalizedVariableScanAdvanceComputable [] + +private def sourceNormalizedVariableScanStep + (input : List Bool) : List Bool := + sourceNormalizedVariableScanFoundBranch input ++ + sourceNormalizedVariableScanAdvanceBranch input + +private noncomputable def sourceNormalizedVariableScanStepComputable : + BitTM + sourceNormalizedVariableScanStep := + pointwiseAppendComputable + sourceNormalizedVariableScanFoundBranchComputable + sourceNormalizedVariableScanAdvanceBranchComputable + +private theorem sourceNormalizedVariableScanStep_eq + (input : List Bool) : + sourceNormalizedVariableScanStep input = + if sourceNormalizedVariableScanTargetWord input = + sourceNormalizedVariableScanCurrentWord input then + input + else sourceNormalizedVariableScanAdvance input := by + unfold sourceNormalizedVariableScanStep + sourceNormalizedVariableScanFoundBranch + sourceNormalizedVariableScanAdvanceBranch + sourceNormalizedVariableScanMismatchMarker + sourceNormalizedVariableScanEquality + rw [sourceQaryMaskSquareComputedWordEquality_valid] + by_cases hequality : sourceNormalizedVariableScanTargetWord input = + sourceNormalizedVariableScanCurrentWord input + · simp only [hequality, decide_true, List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, + ↓reduceIte, + sourceFourFamilyBooleanNotOutput, Function.comp_apply, + sourceQaryMaskSquareComputedWordEquality_valid, + sourceFourFamilyBooleanNotWord_bit, Bool.not_true, Bool.false_eq_true, List.append_nil] + · simp only [hequality, decide_false, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some, + Bool.false_eq_true, ↓reduceIte, sourceFourFamilyBooleanNotOutput, Function.comp_apply, + sourceQaryMaskSquareComputedWordEquality_valid, sourceFourFamilyBooleanNotWord_bit, + Bool.not_false, List.nil_append] + +theorem sourceNormalizedVariableScanStructuralFieldAccounting + (input : List Bool) : + 2 * (firstFieldContents input).length + + (firstFieldSuffix input).length ≤ input.length := by + exact GapCVP.CNFAnnotatedSourceClauseBubblePassTM.annotatedStructuralFieldAccounting input + +private theorem sourceNormalizedVariableScanAdvance_length_le + (input : List Bool) : + (sourceNormalizedVariableScanAdvance input).length ≤ + input.length + 4 := by + have htarget := sourceNormalizedVariableScanStructuralFieldAccounting input + have hcounter := sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix input) + have hpending := sourceOriginalIndexedLiteralSuffix_length_le + (firstFieldSuffix (firstFieldSuffix input)) + unfold sourceNormalizedVariableScanAdvance + sourceNormalizedVariableScanTargetWord + sourceNormalizedVariableScanCounterWord + sourceNormalizedVariableScanPending + simp only [Function.comp_apply, List.length_append, + lengthPrefixedWord_length, List.length_cons] + omega + +private theorem sourceNormalizedVariableScanStep_length_le + (input : List Bool) : + (sourceNormalizedVariableScanStep input).length ≤ + input.length + 4 := by + rw [sourceNormalizedVariableScanStep_eq] + split_ifs + · omega + · exact sourceNormalizedVariableScanAdvance_length_le input + +private theorem sourceNormalizedVariableScanStep_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + sourceNormalizedVariableScanStep (5 * Polynomial.X) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate : ∀ number : ℕ, + ((sourceNormalizedVariableScanStep^[number]) seed).length ≤ + seed.length + 4 * number := by + intro number + induction number with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, Std.le_refl] + | succ number ih => + rw [Function.iterate_succ_apply'] + have hnext := sourceNormalizedVariableScanStep_length_le + ((sourceNormalizedVariableScanStep^[number]) seed) + omega + have hstate := hiterate stage + simp only [Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X] + omega + +private noncomputable def sourceNormalizedVariableScanFoldComputable : + BitTM + (boundedRecordFoldOutput sourceNormalizedVariableScanStep) := + boundedDependentRecordFoldComputable + sourceNormalizedVariableScanStepComputable + (5 * Polynomial.X) + sourceNormalizedVariableScanStep_polynomiallyBoundedFoldStates + +private def sourceNormalizedVariableScanState + (target : List Bool) (counter : ℕ) + (pending : List Bool) : List Bool := + lengthPrefixedWord target ++ + (lengthPrefixedWord (List.replicate counter true) ++ pending) + +private theorem sourceNormalizedVariableScanStep_literal + (target : List Bool) (counter : ℕ) + (literal : Literal) (pending : List Bool) : + sourceNormalizedVariableScanStep + (sourceNormalizedVariableScanState target counter + (encodeLiteral literal ++ pending)) = + if target = Computability.encodeNat literal.1 then + sourceNormalizedVariableScanState target counter + (encodeLiteral literal ++ pending) + else + sourceNormalizedVariableScanState target (counter + 1) + pending := by + have hcurrent : + firstFieldContents (encodeLiteral literal ++ pending) = + Computability.encodeNat literal.1 := by + simp only [encodeLiteral, List.append_assoc, List.cons_append, List.nil_append, + firstFieldContents_valid] + have hskip : + literalSuffix (encodeLiteral literal ++ pending) = pending := + literalSuffix_valid literal pending + rw [sourceNormalizedVariableScanStep_eq] + simp only [sourceNormalizedVariableScanTargetWord, sourceNormalizedVariableScanState, + firstFieldContents_valid, sourceNormalizedVariableScanCurrentWord, + sourceNormalizedVariableScanPending, + Function.comp_apply, firstFieldSuffix_valid, hcurrent, sourceNormalizedVariableScanAdvance, + sourceNormalizedVariableScanCounterWord, hskip, List.replicate_succ] + +private theorem sourceNormalizedVariableScanStep_iterate_fixed + (state : List Bool) + (hfixed : sourceNormalizedVariableScanStep state = state) + (count : ℕ) : + ((sourceNormalizedVariableScanStep^[count]) state) = state := by + induction count with + | zero => rfl + | succ count ih => + rw [Function.iterate_succ_apply, hfixed, ih] + +private theorem sourceNormalizedVariableScanLiteralCounter_valid + (target counter : ℕ) (literals : List Literal) : + sourceNormalizedVariableScanCounterWord + (((sourceNormalizedVariableScanStep^[literals.length]) + (sourceNormalizedVariableScanState + (Computability.encodeNat target) counter + (literals.flatMap encodeLiteral)))) = + List.replicate + (counter + (literals.map Prod.fst).idxOf target) true := by + induction literals generalizing counter with + | nil => + simp only [List.length_nil, List.flatMap_nil, + Function.iterate_zero, id_eq, List.map_nil, + List.idxOf_nil, Nat.add_zero] + change firstFieldContents + (firstFieldSuffix + (lengthPrefixedWord (Computability.encodeNat target) ++ + (lengthPrefixedWord (List.replicate counter true) ++ []))) = + List.replicate counter true + rw [firstFieldSuffix_valid] + simpa only [List.append_nil] using (firstFieldContents_valid (List.replicate counter true) + []) + | cons literal remaining ih => + simp only [List.length_cons, List.flatMap_cons] + rw [Function.iterate_succ_apply, + sourceNormalizedVariableScanStep_literal] + by_cases hequality : + Computability.encodeNat target = + Computability.encodeNat literal.1 + · have hvalue : target = literal.1 := by + simpa only [Computability.decode_encodeNat] using congrArg Computability.decodeNat + hequality + rw [ite_eq_left hequality] + have hfixed := sourceNormalizedVariableScanStep_literal + (Computability.encodeNat target) counter literal + (remaining.flatMap encodeLiteral) + rw [ite_eq_left hequality] at hfixed + rw [sourceNormalizedVariableScanStep_iterate_fixed _ hfixed] + simp only [sourceNormalizedVariableScanCounterWord, sourceNormalizedVariableScanState, + hvalue, + Function.comp_apply, firstFieldSuffix_valid, firstFieldContents_valid, List.map_cons, + List.idxOf_cons_self, + add_zero] + · have hvalue : target ≠ literal.1 := by + intro hequal + exact hequality (congrArg Computability.encodeNat hequal) + have hreverse : literal.1 ≠ target := Ne.symm hvalue + rw [ite_eq_right hequality, ih] + rw [List.map_cons, List.idxOf_cons_ne _ hreverse] + congr 1 + omega + +/-- GapCVP reduction support. -/ +def sourceNormalizedVariableLiteralList + (formula : ThreeCNF) : List Literal := + formula.flatMap (fun clause => + [clause 0, clause 1, clause 2]) + +private theorem sourceNormalizedVariableLiteralList_stream + (formula : ThreeCNF) : + (sourceNormalizedVariableLiteralList formula).flatMap + encodeLiteral = + formula.flatMap encodeThreeClause := by + induction formula with + | nil => rfl + | cons clause remaining ih => + simpa only [sourceNormalizedVariableLiteralList, Fin.isValue, List.flatMap_cons, + List.cons_append, + List.nil_append, encodeThreeClause, List.append_assoc, List.append_cancel_left_eq] using + congrArg + (fun suffix : List Bool => + encodeLiteral (clause 0) ++ encodeLiteral (clause 1) ++ encodeLiteral (clause 2) ++ + suffix) + ih + +private theorem sourceNormalizedVariableLiteralList_length + (formula : ThreeCNF) : + (sourceNormalizedVariableLiteralList formula).length = + 3 * formula.length := by + induction formula with + | nil => rfl + | cons clause remaining ih => + simp only [sourceNormalizedVariableLiteralList, Fin.isValue, List.length_flatMap, + List.length_cons, + List.length_nil, zero_add, Nat.reduceAdd, List.map_const', List.sum_replicate, + smul_eq_mul, List.flatMap_cons, + List.cons_append, List.nil_append] at ih ⊢ + omega + +theorem sourceNormalizedVariableLiteralList_variables + (formula : ThreeCNF) : + (sourceNormalizedVariableLiteralList formula).map Prod.fst = + formulaVariables formula := by + simp only [sourceNormalizedVariableLiteralList, Fin.isValue, List.map_flatMap, List.map_cons, + List.map_nil, + formulaVariables] + +/-- GapCVP reduction support. -/ +def sourceNormalizedVariableRankQuery + (variableIndex : ℕ) (formula : ThreeCNF) : List Bool := + lengthPrefixedWord (Computability.encodeNat variableIndex) ++ + encodeThreeCNF formula + +private def sourceNormalizedVariableRankOriginalSource : List Bool → List Bool := + firstFieldSuffix + +private noncomputable def sourceNormalizedVariableRankOriginalSourceComputable : + BitTM + sourceNormalizedVariableRankOriginalSource := + firstFieldSuffixComputable + +private def sourceNormalizedVariableRankFormulaBody : List Bool → List Bool := + firstFieldSuffix ∘ sourceNormalizedVariableRankOriginalSource + +private noncomputable def sourceNormalizedVariableRankFormulaBodyComputable : + BitTM + sourceNormalizedVariableRankFormulaBody := + GapCVP.TMComposition.computableInPolyTime + sourceNormalizedVariableRankOriginalSourceComputable + firstFieldSuffixComputable + +private def sourceNormalizedVariableRankClauseCount + (input : List Bool) : List Bool := + (variableClauseBodyOutput + (sourceNormalizedVariableRankFormulaBody input)).tail + +private noncomputable def sourceNormalizedVariableRankClauseCountComputable : + BitTM + sourceNormalizedVariableRankClauseCount := by + have hbody := GapCVP.TMComposition.computableInPolyTime + sourceNormalizedVariableRankFormulaBodyComputable + variableClauseBodyComputable + exact GapCVP.TMComposition.computableInPolyTime + hbody dropHeadComputable + +private def sourceNormalizedVariableRankLiteralCount + (input : List Bool) : List Bool := + sourceNormalizedVariableRankClauseCount input ++ + (sourceNormalizedVariableRankClauseCount input ++ + sourceNormalizedVariableRankClauseCount input) + +private noncomputable def sourceNormalizedVariableRankLiteralCountComputable : + BitTM + sourceNormalizedVariableRankLiteralCount := + pointwiseAppendComputable + sourceNormalizedVariableRankClauseCountComputable + (pointwiseAppendComputable + sourceNormalizedVariableRankClauseCountComputable + sourceNormalizedVariableRankClauseCountComputable) + +private def sourceNormalizedVariableRankSeed + (input : List Bool) : List Bool := + lengthPrefixedWord (firstFieldContents input) ++ + (lengthPrefixedWord [] ++ + sourceNormalizedVariableRankFormulaBody input) + +private noncomputable def sourceNormalizedVariableRankSeedComputable : + BitTM + sourceNormalizedVariableRankSeed := by + have htarget := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable structuralPrefixWriterComputable + have hpending := pointwiseAppendComputable + (sourceFixedWordComputable (lengthPrefixedWord [])) + sourceNormalizedVariableRankFormulaBodyComputable + exact pointwiseAppendComputable htarget hpending + +private def sourceNormalizedVariableRankScanPreparation + (input : List Bool) : List Bool := + sourceNormalizedVariableRankLiteralCount input ++ + false :: sourceNormalizedVariableRankSeed input + +private noncomputable def sourceNormalizedVariableRankScanPreparationComputable : + BitTM + sourceNormalizedVariableRankScanPreparation := by + have hseed := GapCVP.TMComposition.computableInPolyTime + sourceNormalizedVariableRankSeedComputable + (prependBitComputable false) + exact pointwiseAppendComputable + sourceNormalizedVariableRankLiteralCountComputable hseed + +/-- GapCVP reduction support. -/ +def sourceNormalizedVariableRankOutput : List Bool → List Bool := + sourceNormalizedVariableScanCounterWord ∘ + boundedRecordFoldOutput sourceNormalizedVariableScanStep ∘ + sourceNormalizedVariableRankScanPreparation + +/-- GapCVP reduction support. -/ +noncomputable def sourceNormalizedVariableRankComputable : + BitTM + sourceNormalizedVariableRankOutput := by + have hfold := GapCVP.TMComposition.computableInPolyTime + sourceNormalizedVariableRankScanPreparationComputable + sourceNormalizedVariableScanFoldComputable + exact GapCVP.TMComposition.computableInPolyTime + hfold sourceNormalizedVariableScanCounterWordComputable + +private theorem sourceNormalizedVariableRankScanPreparation_valid + (variableIndex : ℕ) (formula : ThreeCNF) : + sourceNormalizedVariableRankScanPreparation + (sourceNormalizedVariableRankQuery variableIndex formula) = + unaryBoundedFoldWord (3 * formula.length) + (sourceNormalizedVariableScanState + (Computability.encodeNat variableIndex) 0 + (formula.flatMap encodeThreeClause)) := by + simp only [sourceNormalizedVariableRankScanPreparation, sourceNormalizedVariableRankLiteralCount, + sourceNormalizedVariableRankClauseCount, sourceNormalizedVariableRankFormulaBody, + sourceNormalizedVariableRankOriginalSource, sourceNormalizedVariableRankQuery, + Function.comp_apply, + firstFieldSuffix_valid, firstFieldSuffix_encodeThreeCNF, variableClauseBodyOutput_valid, + List.tail_cons, + List.replicate_append_replicate, sourceNormalizedVariableRankSeed, firstFieldContents_valid, + unaryBoundedFoldWord, + sourceNormalizedVariableScanState, List.replicate_zero, List.append_cancel_right_eq, + List.replicate_inj, + Nat.add_eq_zero_iff, List.length_eq_zero_iff, and_self, or_true, and_true] + omega + +theorem sourceNormalizedVariableRankOutput_valid + (variableIndex : ℕ) (formula : ThreeCNF) : + sourceNormalizedVariableRankOutput + (sourceNormalizedVariableRankQuery variableIndex formula) = + List.replicate (variableRank formula variableIndex) true := by + unfold sourceNormalizedVariableRankOutput + rw [Function.comp_apply, Function.comp_apply, + sourceNormalizedVariableRankScanPreparation_valid] + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + rw [← sourceNormalizedVariableLiteralList_stream formula] + rw [← sourceNormalizedVariableLiteralList_length formula] + rw [sourceNormalizedVariableScanLiteralCounter_valid] + rw [sourceNormalizedVariableLiteralList_variables] + simp only [zero_add, variableRank] + +end SourceNormalizedVariableRankScanTM + +namespace BinaryCompactSourceFirstOccurrenceTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceIndexedClauseLookupTM +open GapCVP.SourceNormalizedVariableRankScanTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedLowerLeftSourceTM +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryDimensionTM + +/-- GapCVP reduction support. -/ +def compactFirstOccurrenceCounter : List Bool → List Bool := + firstFieldContents + +/-- GapCVP reduction support. -/ +noncomputable def compactFirstOccurrenceCounterComputable : + BitTM + compactFirstOccurrenceCounter := + firstFieldContentsComputable + +private def compactFirstOccurrenceOrdinalSuffix : List Bool → List Bool := + firstFieldSuffix + +private noncomputable def compactFirstOccurrenceOrdinalSuffixComputable : + BitTM + compactFirstOccurrenceOrdinalSuffix := + firstFieldSuffixComputable + +private def compactFirstOccurrenceOrdinal : List Bool → List Bool := + firstFieldContents ∘ compactFirstOccurrenceOrdinalSuffix + +private noncomputable def compactFirstOccurrenceOrdinalComputable : + BitTM + compactFirstOccurrenceOrdinal := + GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrenceOrdinalSuffixComputable + firstFieldContentsComputable + +private def compactFirstOccurrencePendingSuffix : List Bool → List Bool := + firstFieldSuffix ∘ compactFirstOccurrenceOrdinalSuffix + +private noncomputable def compactFirstOccurrencePendingSuffixComputable : + BitTM + compactFirstOccurrencePendingSuffix := + GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrenceOrdinalSuffixComputable + firstFieldSuffixComputable + +private def compactFirstOccurrencePending : List Bool → List Bool := + firstFieldContents ∘ compactFirstOccurrencePendingSuffix + +private noncomputable def compactFirstOccurrencePendingComputable : + BitTM + compactFirstOccurrencePending := + GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrencePendingSuffixComputable + firstFieldContentsComputable + +private def compactFirstOccurrenceOriginalSource : List Bool → List Bool := + firstFieldSuffix ∘ compactFirstOccurrencePendingSuffix + +private noncomputable def compactFirstOccurrenceOriginalSourceComputable : + BitTM + compactFirstOccurrenceOriginalSource := + GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrencePendingSuffixComputable + firstFieldSuffixComputable + +private def compactFirstOccurrenceCurrentVariable : List Bool → List Bool := + firstFieldContents ∘ compactFirstOccurrencePending + +private noncomputable def compactFirstOccurrenceCurrentVariableComputable : + BitTM + compactFirstOccurrenceCurrentVariable := + GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrencePendingComputable + firstFieldContentsComputable + +private def compactFirstOccurrenceCurrentRankQuery + (input : List Bool) : List Bool := + lengthPrefixedWord (compactFirstOccurrenceCurrentVariable input) ++ + compactFirstOccurrenceOriginalSource input + +private noncomputable def compactFirstOccurrenceCurrentRankQueryComputable : + BitTM + compactFirstOccurrenceCurrentRankQuery := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrenceCurrentVariableComputable + structuralPrefixWriterComputable + exact pointwiseAppendComputable hprefix + compactFirstOccurrenceOriginalSourceComputable + +private def compactFirstOccurrenceCurrentRawRank : List Bool → List Bool := + sourceNormalizedVariableRankOutput ∘ + compactFirstOccurrenceCurrentRankQuery + +private noncomputable def compactFirstOccurrenceCurrentRawRankComputable : + BitTM + compactFirstOccurrenceCurrentRawRank := + GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrenceCurrentRankQueryComputable + sourceNormalizedVariableRankComputable + +private def compactFirstOccurrenceNewMarker : List Bool → List Bool := + maskComputedWordEquality + compactFirstOccurrenceCurrentRawRank + compactFirstOccurrenceOrdinal + +private def compactFirstOccurrenceNewSelection + (input : List Bool) : List Bool := + (compactFirstOccurrenceNewMarker input).headD false :: input + +private noncomputable def compactFirstOccurrenceNewSelectionComputable : + BitTM + compactFirstOccurrenceNewSelection := by + exact sourceQaryMaskRankTaggedLowerLeftEqualitySelectionComputable + compactFirstOccurrenceCurrentRawRankComputable + compactFirstOccurrenceOrdinalComputable + +private def compactFirstOccurrenceIncrementBranch + (input : List Bool) : List Bool := + if (compactFirstOccurrenceNewMarker input).headD false then + [true] + else [] + +private noncomputable def compactFirstOccurrenceIncrementBranchComputable : + BitTM + compactFirstOccurrenceIncrementBranch := by + exact sourcePreservingConditionalComputable + compactFirstOccurrenceNewSelectionComputable + (sourceFixedWordComputable [true]) [] + +private def compactFirstOccurrenceNextCounter + (input : List Bool) : List Bool := + compactFirstOccurrenceCounter input ++ + compactFirstOccurrenceIncrementBranch input + +private noncomputable def compactFirstOccurrenceNextCounterComputable : + BitTM + compactFirstOccurrenceNextCounter := + pointwiseAppendComputable + compactFirstOccurrenceCounterComputable + compactFirstOccurrenceIncrementBranchComputable + +private theorem compactFirstOccurrenceNextCounter_eq + (input : List Bool) : + compactFirstOccurrenceNextCounter input = + if compactFirstOccurrenceCurrentRawRank input = + compactFirstOccurrenceOrdinal input then + compactFirstOccurrenceCounter input ++ [true] + else compactFirstOccurrenceCounter input := by + unfold compactFirstOccurrenceNextCounter + compactFirstOccurrenceIncrementBranch + compactFirstOccurrenceNewMarker + rw [sourceQaryMaskSquareComputedWordEquality_valid] + by_cases h : compactFirstOccurrenceCurrentRawRank input = + compactFirstOccurrenceOrdinal input + · simp only [h, decide_true, List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, + ↓reduceIte] + · simp only [h, decide_false, List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, + Bool.false_eq_true, + ↓reduceIte, List.append_nil] + +/-- GapCVP reduction support. -/ +def compactFirstOccurrenceScanStep + (input : List Bool) : List Bool := + lengthPrefixedWord (compactFirstOccurrenceNextCounter input) ++ + (lengthPrefixedWord + (true :: compactFirstOccurrenceOrdinal input) ++ + (lengthPrefixedWord + (literalSuffix (compactFirstOccurrencePending input)) ++ + compactFirstOccurrenceOriginalSource input)) + +private noncomputable def compactFirstOccurrenceScanStepComputable : + BitTM + compactFirstOccurrenceScanStep := by + have hcounter := GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrenceNextCounterComputable + structuralPrefixWriterComputable + have hordinalBit := GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrenceOrdinalComputable + (prependBitComputable true) + have hordinal := GapCVP.TMComposition.computableInPolyTime + hordinalBit structuralPrefixWriterComputable + have hpendingTail := GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrencePendingComputable literalSuffixComputable + have hpending := GapCVP.TMComposition.computableInPolyTime + hpendingTail structuralPrefixWriterComputable + exact pointwiseAppendComputable hcounter + (pointwiseAppendComputable hordinal + (pointwiseAppendComputable hpending + compactFirstOccurrenceOriginalSourceComputable)) + +private theorem compactFirstOccurrenceNextCounter_length_le + (input : List Bool) : + (compactFirstOccurrenceNextCounter input).length ≤ + (compactFirstOccurrenceCounter input).length + 1 := by + rw [compactFirstOccurrenceNextCounter_eq] + split_ifs <;> simp + +private theorem compactFirstOccurrenceScanStep_length_le + (input : List Bool) : + (compactFirstOccurrenceScanStep input).length ≤ input.length + 7 := by + have hcounter := + sourceNormalizedVariableScanStructuralFieldAccounting input + have hordinal := + sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix input) + have hpending := + sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix (firstFieldSuffix input)) + have htail := sourceOriginalIndexedLiteralSuffix_length_le + (firstFieldContents (firstFieldSuffix (firstFieldSuffix input))) + have hnext := compactFirstOccurrenceNextCounter_length_le input + simp only [compactFirstOccurrenceScanStep, + compactFirstOccurrenceCounter, + compactFirstOccurrenceOrdinal, + compactFirstOccurrenceOrdinalSuffix, + compactFirstOccurrencePending, + compactFirstOccurrencePendingSuffix, + compactFirstOccurrenceOriginalSource, + Function.comp_apply, List.length_append, + lengthPrefixedWord_length, List.length_cons] at * + omega + +private theorem compactFirstOccurrenceScanStep_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + compactFirstOccurrenceScanStep (9 * Polynomial.X) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate : ∀ number : ℕ, + ((compactFirstOccurrenceScanStep^[number]) seed).length ≤ + seed.length + 7 * number := by + intro number + induction number with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, Std.le_refl] + | succ number ih => + rw [Function.iterate_succ_apply'] + have hnext := compactFirstOccurrenceScanStep_length_le + ((compactFirstOccurrenceScanStep^[number]) seed) + omega + have hstageBound := hiterate stage + simp only [Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X] + omega + +/-- GapCVP reduction support. -/ +noncomputable def compactFirstOccurrenceScanFoldComputable : + BitTM + (boundedRecordFoldOutput compactFirstOccurrenceScanStep) := + boundedDependentRecordFoldComputable + compactFirstOccurrenceScanStepComputable + (9 * Polynomial.X) + compactFirstOccurrenceScanStep_polynomiallyBoundedFoldStates + +private def compactFirstOccurrenceLiteralCount + (input : List Bool) : List Bool := + sourceClauseCountUnary input ++ + (sourceClauseCountUnary input ++ sourceClauseCountUnary input) + +private noncomputable def compactFirstOccurrenceLiteralCountComputable : + BitTM + compactFirstOccurrenceLiteralCount := + pointwiseAppendComputable sourceClauseCountUnaryComputable + (pointwiseAppendComputable + sourceClauseCountUnaryComputable + sourceClauseCountUnaryComputable) + +/-- GapCVP reduction support. -/ +def compactFirstOccurrenceScanSeed + (input : List Bool) : List Bool := + lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ + (lengthPrefixedWord (firstFieldSuffix input) ++ input)) + +/-- GapCVP reduction support. -/ +noncomputable def compactFirstOccurrenceScanSeedComputable : + BitTM + compactFirstOccurrenceScanSeed := by + have hbody := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable structuralPrefixWriterComputable + have hrecord := pointwiseAppendComputable hbody + (Turing.idComputableInPolyTime bitEncoding) + have hprefix := prependWordComputable + (lengthPrefixedWord [] ++ lengthPrefixedWord []) + have hphysical := GapCVP.TMComposition.computableInPolyTime + hrecord hprefix + change BitTM + (fun input => lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ + (lengthPrefixedWord (firstFieldSuffix input) ++ input))) + simpa only [List.append_assoc, Function.comp_apply, id_eq, Function.comp_def] using hphysical + +private def compactFirstOccurrenceScanPreparation + (input : List Bool) : List Bool := + compactFirstOccurrenceLiteralCount input ++ + false :: compactFirstOccurrenceScanSeed input + +private noncomputable def compactFirstOccurrenceScanPreparationComputable : + BitTM + compactFirstOccurrenceScanPreparation := by + have hseed := GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrenceScanSeedComputable + (prependBitComputable false) + exact pointwiseAppendComputable + compactFirstOccurrenceLiteralCountComputable hseed + +/-- GapCVP reduction support. -/ +def compactSourceOccurringVariableCountUnary : List Bool → List Bool := + compactFirstOccurrenceCounter ∘ + boundedRecordFoldOutput compactFirstOccurrenceScanStep ∘ + compactFirstOccurrenceScanPreparation + +/-- GapCVP reduction support. -/ +noncomputable def compactSourceOccurringVariableCountUnaryComputable : + BitTM + compactSourceOccurringVariableCountUnary := by + have hfold := GapCVP.TMComposition.computableInPolyTime + compactFirstOccurrenceScanPreparationComputable + compactFirstOccurrenceScanFoldComputable + exact GapCVP.TMComposition.computableInPolyTime + hfold compactFirstOccurrenceCounterComputable + +end BinaryCompactSourceFirstOccurrenceTM + +namespace BinaryCompactRankPrefixIdentity + +open GapCVP.SourceMachineCert GapCVP.BinarySourceVariableCompaction + +private def firstOccurrenceAt (names : List ℕ) (index : ℕ) : Bool := + match names[index]? with + | none => false + | some name => decide (names.idxOf name = index) + +/-- GapCVP reduction support. -/ +def firstOccurrencePrefixCount (names : List ℕ) (bound : ℕ) : ℕ := + ((List.range bound).filter (firstOccurrenceAt names)).length + +private theorem firstOccurrencePrefixCount_succ + (names : List ℕ) (bound : ℕ) : + firstOccurrencePrefixCount names (bound + 1) = + firstOccurrencePrefixCount names bound + + if firstOccurrenceAt names bound then 1 else 0 := by + cases hfirst : firstOccurrenceAt names bound <;> + simp [firstOccurrencePrefixCount, List.range_succ, + List.filter_append, hfirst] + +private theorem firstOccurrenceAt_of_length_le + (names : List ℕ) (index : ℕ) (hindex : names.length ≤ index) : + firstOccurrenceAt names index = false := by + simp only [firstOccurrenceAt, List.getElem?_eq_none hindex] + +private theorem firstOccurrenceAt_of_lt + (names : List ℕ) (index : ℕ) (hindex : index < names.length) : + firstOccurrenceAt names index = + decide (names.idxOf (names[index]'hindex) = index) := by + simp only [firstOccurrenceAt, List.getElem?_eq_getElem hindex] + +private theorem not_mem_take_idxOf + (names : List ℕ) (name : ℕ) : + name ∉ names.take (names.idxOf name) := by + by_cases hname : name ∈ names + · intro hprefix + have hlt := + (List.mem_take_iff_idxOf_lt hname).mp hprefix + exact (Nat.lt_irrefl (names.idxOf name)) hlt + · intro hprefix + exact hname (List.mem_of_mem_take hprefix) + +private theorem idxOf_getElem_le + (names : List ℕ) (index : ℕ) (hindex : index < names.length) : + names.idxOf (names[index]'hindex) ≤ index := by + have hmem : (names[index]'hindex) ∈ names := List.getElem_mem hindex + have hprefix : + (names[index]'hindex) ∈ names.take (index + 1) := by + rw [List.take_succ_eq_append_getElem hindex] + exact List.mem_append_right _ (by simp only [List.mem_cons, List.not_mem_nil, or_false]) + have hlt := + (List.mem_take_iff_idxOf_lt hmem).mp hprefix + omega + +private theorem idxOf_getElem_eq_iff_not_mem_take + (names : List ℕ) (index : ℕ) (hindex : index < names.length) : + names.idxOf (names[index]'hindex) = index ↔ + (names[index]'hindex) ∉ names.take index := by + have hmem : (names[index]'hindex) ∈ names := List.getElem_mem hindex + have hle := idxOf_getElem_le names index hindex + rw [List.mem_take_iff_idxOf_lt hmem] + omega + +private theorem firstOccurrencePrefixCount_eq_eraseDups_take_length + (names : List ℕ) (bound : ℕ) : + firstOccurrencePrefixCount names bound = + (names.take bound).eraseDups.length := by + induction bound with + | zero => simp only [firstOccurrencePrefixCount, List.range_zero, List.filter_nil, + List.length_nil, List.take_zero, + List.eraseDups_nil] + | succ index ih => + rw [firstOccurrencePrefixCount_succ, ih] + by_cases hindex : index < names.length + · rw [List.take_succ_eq_append_getElem hindex, + List.eraseDups_append, List.length_append, + firstOccurrenceAt_of_lt names index hindex] + by_cases hseen : (names[index]'hindex) ∈ names.take index + · have hnotfirst : + names.idxOf (names[index]'hindex) ≠ index := by + intro hfirst + exact ((idxOf_getElem_eq_iff_not_mem_take + names index hindex).mp hfirst) hseen + simp only [hnotfirst, decide_false, Bool.false_eq_true, ↓reduceIte, add_zero, + List.removeAll, + List.elem_eq_contains, List.contains_eq_mem, hseen, decide_true, Bool.not_true, + not_false_eq_true, + List.filter_cons_of_neg, List.filter_nil, List.eraseDups_nil, List.length_nil] + · have hfirst : + names.idxOf (names[index]'hindex) = index := + (idxOf_getElem_eq_iff_not_mem_take + names index hindex).mpr hseen + simp only [hfirst, decide_true, ↓reduceIte, List.removeAll, List.elem_eq_contains, + List.contains_eq_mem, hseen, decide_false, Bool.not_false, List.filter_cons_of_pos, + List.filter_nil, List.eraseDups_cons, List.eraseDups_nil, List.length_cons, + List.length_nil, zero_add] + · have hlength : names.length ≤ index := Nat.le_of_not_gt hindex + rw [firstOccurrenceAt_of_length_le names index hlength] + have htake : names.take index = names := List.take_of_length_le hlength + have htakesucc : names.take (index + 1) = names := + List.take_of_length_le (Nat.le_trans hlength (Nat.le_add_right _ _)) + simp only [htake, Bool.false_eq_true, ↓reduceIte, add_zero, htakesucc] + +private theorem eraseDups_idxOf_eq_eraseDups_take_length + (names : List ℕ) (name : ℕ) : + names.eraseDups.idxOf name = + (names.take (names.idxOf name)).eraseDups.length := by + by_cases hname : name ∈ names + · have hindex : names.idxOf name < names.length := + List.idxOf_lt_length_of_mem hname + have hprefix : name ∉ names.take (names.idxOf name) := + not_mem_take_idxOf names name + have hsplit : + names = names.take (names.idxOf name) ++ + name :: names.drop (names.idxOf name + 1) := by + calc + names = names.take (names.idxOf name) ++ + names.drop (names.idxOf name) := + (List.take_append_drop (names.idxOf name) names).symm + _ = names.take (names.idxOf name) ++ + name :: names.drop (names.idxOf name + 1) := by + rw [List.drop_eq_getElem_cons hindex] + simp only [List.getElem_idxOf] + conv_lhs => rw [hsplit, List.eraseDups_append, List.idxOf_append] + simp only [List.mem_eraseDups, hprefix, ↓reduceIte, List.removeAll, List.elem_eq_contains, + List.contains_eq_mem, decide_false, Bool.not_false, List.filter_cons_of_pos, + List.eraseDups_cons, + List.filter_filter, List.idxOf_cons_self, zero_add] + · have hnotdup : name ∉ names.eraseDups := by + simpa only [List.mem_eraseDups] using hname + rw [List.idxOf_eq_length hname, List.take_length, + List.idxOf_eq_length hnotdup] + +theorem compactVariableRank_eq_firstOccurrencePrefixCount + (formula : ThreeCNF) (name : ℕ) : + compactVariableRank formula name = + firstOccurrencePrefixCount + (formulaVariables formula) (variableRank formula name) := by + unfold compactVariableRank occurringVariables variableRank + rw [firstOccurrencePrefixCount_eq_eraseDups_take_length] + exact eraseDups_idxOf_eq_eraseDups_take_length + (formulaVariables formula) name + +end BinaryCompactRankPrefixIdentity + +namespace BinaryCompactSourceFirstOccurrenceTM + +open GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceNormalizedVariableRankScanTM GapCVP.BinaryDimensionTM +open GapCVP.BinarySourceVariableCompaction GapCVP.BinaryCompactRankPrefixIdentity + +/-- GapCVP reduction support. -/ +def compactFirstOccurrenceValidState + (formula : ThreeCNF) (counter ordinal : ℕ) + (pending : List Literal) : List Bool := + lengthPrefixedWord (List.replicate counter true) ++ + (lengthPrefixedWord (List.replicate ordinal true) ++ + (lengthPrefixedWord (pending.flatMap encodeLiteral) ++ + encodeThreeCNF formula)) + +@[simp] theorem compactFirstOccurrenceValidState_counter + (formula : ThreeCNF) (counter ordinal : ℕ) + (pending : List Literal) : + compactFirstOccurrenceCounter + (compactFirstOccurrenceValidState formula counter ordinal pending) = + List.replicate counter true := by + simp only [compactFirstOccurrenceCounter, compactFirstOccurrenceValidState, + SourceFormulaStructuralDecoder.firstFieldContents_valid] + +@[simp] private theorem compactFirstOccurrenceValidState_ordinal + (formula : ThreeCNF) (counter ordinal : ℕ) + (pending : List Literal) : + compactFirstOccurrenceOrdinal + (compactFirstOccurrenceValidState formula counter ordinal pending) = + List.replicate ordinal true := by + simp only [compactFirstOccurrenceOrdinal, compactFirstOccurrenceOrdinalSuffix, + compactFirstOccurrenceValidState, Function.comp_apply, + SourceFormulaStructuralDecoder.firstFieldSuffix_valid, + SourceFormulaStructuralDecoder.firstFieldContents_valid] + +@[simp] private theorem compactFirstOccurrenceValidState_pending + (formula : ThreeCNF) (counter ordinal : ℕ) + (pending : List Literal) : + compactFirstOccurrencePending + (compactFirstOccurrenceValidState formula counter ordinal pending) = + pending.flatMap encodeLiteral := by + simp only [compactFirstOccurrencePending, compactFirstOccurrencePendingSuffix, + compactFirstOccurrenceOrdinalSuffix, compactFirstOccurrenceValidState, Function.comp_apply, + SourceFormulaStructuralDecoder.firstFieldSuffix_valid, + SourceFormulaStructuralDecoder.firstFieldContents_valid] + +@[simp] private theorem compactFirstOccurrenceValidState_originalSource + (formula : ThreeCNF) (counter ordinal : ℕ) + (pending : List Literal) : + compactFirstOccurrenceOriginalSource + (compactFirstOccurrenceValidState formula counter ordinal pending) = + encodeThreeCNF formula := by + simp only [compactFirstOccurrenceOriginalSource, compactFirstOccurrencePendingSuffix, + compactFirstOccurrenceOrdinalSuffix, compactFirstOccurrenceValidState, Function.comp_apply, + SourceFormulaStructuralDecoder.firstFieldSuffix_valid] + +@[simp] private theorem compactFirstOccurrenceValidState_currentVariable + (formula : ThreeCNF) (counter ordinal : ℕ) + (literal : Literal) (remaining : List Literal) : + compactFirstOccurrenceCurrentVariable + (compactFirstOccurrenceValidState + formula counter ordinal (literal :: remaining)) = + Computability.encodeNat literal.1 := by + simp only [compactFirstOccurrenceCurrentVariable, compactFirstOccurrencePending, + compactFirstOccurrencePendingSuffix, compactFirstOccurrenceOrdinalSuffix, + compactFirstOccurrenceValidState, + List.flatMap_cons, encodeLiteral, List.append_assoc, List.cons_append, List.nil_append, + Function.comp_apply, + SourceFormulaStructuralDecoder.firstFieldSuffix_valid, + SourceFormulaStructuralDecoder.firstFieldContents_valid] + +@[simp] private theorem compactFirstOccurrenceValidState_currentRankQuery + (formula : ThreeCNF) (counter ordinal : ℕ) + (literal : Literal) (remaining : List Literal) : + compactFirstOccurrenceCurrentRankQuery + (compactFirstOccurrenceValidState + formula counter ordinal (literal :: remaining)) = + sourceNormalizedVariableRankQuery literal.1 formula := by + simp only [compactFirstOccurrenceCurrentRankQuery, + compactFirstOccurrenceValidState_currentVariable, + compactFirstOccurrenceValidState_originalSource, sourceNormalizedVariableRankQuery] + +@[simp] private theorem compactFirstOccurrenceValidState_currentRawRank + (formula : ThreeCNF) (counter ordinal : ℕ) + (literal : Literal) (remaining : List Literal) : + compactFirstOccurrenceCurrentRawRank + (compactFirstOccurrenceValidState + formula counter ordinal (literal :: remaining)) = + List.replicate (variableRank formula literal.1) true := by + simp only [compactFirstOccurrenceCurrentRawRank, Function.comp_apply, + compactFirstOccurrenceValidState_currentRankQuery, sourceNormalizedVariableRankOutput_valid] + +private theorem compactFirstOccurrenceValidState_nextCounter + (formula : ThreeCNF) (counter ordinal : ℕ) + (literal : Literal) (remaining : List Literal) : + compactFirstOccurrenceNextCounter + (compactFirstOccurrenceValidState + formula counter ordinal (literal :: remaining)) = + List.replicate + (if variableRank formula literal.1 = ordinal + then counter + 1 else counter) true := by + rw [compactFirstOccurrenceNextCounter_eq, + compactFirstOccurrenceValidState_currentRawRank, + compactFirstOccurrenceValidState_ordinal, + compactFirstOccurrenceValidState_counter] + by_cases hfirst : variableRank formula literal.1 = ordinal + · simp only [hfirst, ↓reduceIte, SourceStructuralDecoder.replicate_true_append_cons, + List.append_nil, + List.replicate_succ] + · have hwords : + List.replicate (variableRank formula literal.1) true ≠ + List.replicate ordinal true := by + intro hequal + apply hfirst + simpa only [List.length_replicate] using congrArg List.length hequal + simp only [hwords, ↓reduceIte, hfirst] + +private theorem compactFirstOccurrenceValidState_step + (formula : ThreeCNF) (counter ordinal : ℕ) + (literal : Literal) (remaining : List Literal) : + compactFirstOccurrenceScanStep + (compactFirstOccurrenceValidState + formula counter ordinal (literal :: remaining)) = + compactFirstOccurrenceValidState formula + (if variableRank formula literal.1 = ordinal + then counter + 1 else counter) + (ordinal + 1) remaining := by + unfold compactFirstOccurrenceScanStep + rw [compactFirstOccurrenceValidState_nextCounter, + compactFirstOccurrenceValidState_ordinal, + compactFirstOccurrenceValidState_pending, + compactFirstOccurrenceValidState_originalSource] + simp only [List.flatMap_cons, SourceFormulaStructuralDecoder.literalSuffix_valid, + compactFirstOccurrenceValidState, List.replicate_succ] + +private theorem compactFirstOccurrenceLiteralCount_valid + (formula : ThreeCNF) : + compactFirstOccurrenceLiteralCount (encodeThreeCNF formula) = + List.replicate + (sourceNormalizedVariableLiteralList formula).length true := by + simp only [compactFirstOccurrenceLiteralCount, + sourceClauseCountUnary_valid] + rw [← List.replicate_add, ← List.replicate_add, + sourceNormalizedVariableLiteralList_length] + congr 1 + omega + +theorem compactFirstOccurrenceScanSeed_valid + (formula : ThreeCNF) : + compactFirstOccurrenceScanSeed (encodeThreeCNF formula) = + compactFirstOccurrenceValidState formula 0 0 + (sourceNormalizedVariableLiteralList formula) := by + simp only [compactFirstOccurrenceScanSeed, + SourceFormulaStructuralDecoder.firstFieldSuffix_encodeThreeCNF, + compactFirstOccurrenceValidState, List.replicate_zero, + sourceNormalizedVariableLiteralList_stream] + +private theorem compactFirstOccurrenceScanPreparation_valid + (formula : ThreeCNF) : + compactFirstOccurrenceScanPreparation (encodeThreeCNF formula) = + unaryBoundedFoldWord + (sourceNormalizedVariableLiteralList formula).length + (compactFirstOccurrenceValidState formula 0 0 + (sourceNormalizedVariableLiteralList formula)) := by + simp only [compactFirstOccurrenceScanPreparation, compactFirstOccurrenceLiteralCount_valid, + compactFirstOccurrenceScanSeed_valid, unaryBoundedFoldWord] + +theorem compactFirstOccurrenceValidState_iterate + (formula : ThreeCNF) (index : ℕ) + (hindex : index ≤ (sourceNormalizedVariableLiteralList formula).length) : + ((compactFirstOccurrenceScanStep^[index]) + (compactFirstOccurrenceValidState formula 0 0 + (sourceNormalizedVariableLiteralList formula))) = + compactFirstOccurrenceValidState formula + (firstOccurrencePrefixCount (formulaVariables formula) index) + index ((sourceNormalizedVariableLiteralList formula).drop index) := by + induction index with + | zero => simp only [Function.iterate_zero, id_eq, firstOccurrencePrefixCount, List.range_zero, + List.filter_nil, + List.length_nil, List.drop_zero] + | succ index ih => + have hlt : index < (sourceNormalizedVariableLiteralList formula).length := + Nat.lt_of_succ_le hindex + have hprev : index ≤ (sourceNormalizedVariableLiteralList formula).length := + Nat.le_of_lt hlt + have hnames : index < (formulaVariables formula).length := by + rw [← sourceNormalizedVariableLiteralList_variables] + simpa only [List.length_map] using hlt + have hname : + (formulaVariables formula)[index]'hnames = + ((sourceNormalizedVariableLiteralList formula)[index]'hlt).1 := by + have hget := congrArg + (fun names : List ℕ => names[index]?) + (sourceNormalizedVariableLiteralList_variables formula) + rw [List.getElem?_map, List.getElem?_eq_getElem hlt, + List.getElem?_eq_getElem hnames] at hget + simpa only [Option.map_some, Option.some.injEq] using hget.symm + have hcounter : + firstOccurrencePrefixCount (formulaVariables formula) (index + 1) = + firstOccurrencePrefixCount (formulaVariables formula) index + + if variableRank formula + ((sourceNormalizedVariableLiteralList formula)[index]'hlt).1 = + index then 1 else 0 := by + rw [firstOccurrencePrefixCount_succ, + firstOccurrenceAt_of_lt (formulaVariables formula) index hnames, + hname] + simp only [decide_eq_true_eq, variableRank, Nat.add_left_cancel_iff] + rfl + rw [Function.iterate_succ_apply'] + rw [ih hprev] + rw [List.drop_eq_getElem_cons hlt, + compactFirstOccurrenceValidState_step] + rw [hcounter] + split_ifs <;> simp + +theorem compactSourceOccurringVariableCountUnary_valid + (formula : ThreeCNF) : + compactSourceOccurringVariableCountUnary (encodeThreeCNF formula) = + List.replicate (occurringVariableCount formula) true := by + unfold compactSourceOccurringVariableCountUnary + rw [Function.comp_apply, Function.comp_apply, + compactFirstOccurrenceScanPreparation_valid] + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + rw [compactFirstOccurrenceValidState_iterate + formula (sourceNormalizedVariableLiteralList formula).length + (Nat.le_refl _)] + rw [compactFirstOccurrenceValidState_counter] + congr 1 + rw [firstOccurrencePrefixCount_eq_eraseDups_take_length, + sourceNormalizedVariableLiteralList_length, + ← formulaVariables_length, List.take_length] + rfl + +end BinaryCompactSourceFirstOccurrenceTM + +namespace BinaryExplicitAffineRows + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.GaussianXorWorker +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +def affineCellQuery + (row column : ℕ) (source : List Bool) : List Bool := + lengthPrefixedWord (List.replicate row true) ++ + lengthPrefixedWord (List.replicate column true) ++ source + +/-- GapCVP reduction support. -/ +def sourceExplicitAffineCellRow : List Bool → List Bool := + firstFieldContents + +/-- GapCVP reduction support. -/ +noncomputable def sourceExplicitAffineCellRowComputable : + BitTM + sourceExplicitAffineCellRow := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def sourceExplicitAffineCellColumn : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def sourceExplicitAffineCellColumnComputable : + BitTM + sourceExplicitAffineCellColumn := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def sourceExplicitAffineCellOriginalSource : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def sourceExplicitAffineCellOriginalSourceComputable : + BitTM + sourceExplicitAffineCellOriginalSource := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + +@[simp] theorem sourceExplicitAffineCellRow_query + (row column : ℕ) (source : List Bool) : + sourceExplicitAffineCellRow + (affineCellQuery row column source) = + List.replicate row true := by + simp only [sourceExplicitAffineCellRow, affineCellQuery, List.append_assoc, + firstFieldContents_valid] + +@[simp] theorem sourceExplicitAffineCellColumn_query + (row column : ℕ) (source : List Bool) : + sourceExplicitAffineCellColumn + (affineCellQuery row column source) = + List.replicate column true := by + simp only [sourceExplicitAffineCellColumn, affineCellQuery, List.append_assoc, + Function.comp_apply, + firstFieldSuffix_valid, firstFieldContents_valid] + +@[simp] theorem sourceExplicitAffineCellOriginalSource_query + (row column : ℕ) (source : List Bool) : + sourceExplicitAffineCellOriginalSource + (affineCellQuery row column source) = source := by + simp only [sourceExplicitAffineCellOriginalSource, affineCellQuery, List.append_assoc, + Function.comp_apply, + firstFieldSuffix_valid] + +/-- GapCVP reduction support. -/ +def sourceExplicitAffineXorBits + (first second : List Bool → List Bool) + (input : List Bool) : List Bool := + binaryGaussianXorHeadWord (first input ++ second input) + +/-- GapCVP reduction support. -/ +noncomputable def sourceExplicitAffineXorBitsComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (sourceExplicitAffineXorBits first second) := by + have hpair := pointwiseAppendComputable hfirst hsecond + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpair binaryGaussianXorHeadComputable + change BitTM + (fun input => binaryGaussianXorHeadWord + (first input ++ second input)) + simpa only [Function.comp_def] using hphysical + +theorem sourceExplicitAffineXorBits_valid + (first second : List Bool → List Bool) + (input : List Bool) (firstBit secondBit : Bool) + (hfirst : first input = [firstBit]) + (hsecond : second input = [secondBit]) : + sourceExplicitAffineXorBits first second input = + [Bool.xor firstBit secondBit] := by + simp only [sourceExplicitAffineXorBits, binaryGaussianXorHeadWord, hfirst, hsecond, + List.cons_append, + List.nil_append] + +end BinaryExplicitAffineRows + +namespace BinaryPhysicalWordRuntimeDegreeTM + +open Turing GapCVP.SourceFormulaStructuralDecoder GapCVP.CLStructuralNaturalBinaryWriter +open GapCVP.BinaryExplicitAffineRows + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryPhysicalWordRuntimeCompositionComputer + {first second : List Bool → List Bool} + (firstComputer : BitTM first) + (secondComputer : BitTM second) : + BitTM + (second ∘ first) := + GapCVP.TMComposition.computableInPolyTime + firstComputer secondComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryPhysicalWordNaturalWriterComputer : + BitTM + (fun input : List Bool => Computability.encodeNat input.length) := + structuralNaturalBinaryWriterComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryPhysicalWordDropHeadComputer : + BitTM List.tail := + dropHeadComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryPhysicalWordCellOriginalSourceComputer : + BitTM + sourceExplicitAffineCellOriginalSource := + sourceExplicitAffineCellOriginalSourceComputable + +end BinaryPhysicalWordRuntimeDegreeTM + +namespace BinaryPhysicalCellGridWordTM + +open Turing GapCVP.BinaryEncoding GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def physicalCellGridPrefixComputer : + BitTM + lengthPrefixedWord := + structuralPrefixWriterComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def physicalCellGridAppendComputer + {first second : List Bool → List Bool} + (firstComputer : BitTM first) + (secondComputer : BitTM second) : + BitTM + (fun input => first input ++ second input) := + pointwiseAppendComputable firstComputer secondComputer + +end BinaryPhysicalCellGridWordTM + +namespace BinaryRadiusTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceAnchoredGridRecordFoldTM GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CLStructuralAtomicNaturalWriter +open GapCVP.SourceLatticeStructuralRadiusNumerator GapCVP.SourceLatticeStructuralRationalRadius +open GapCVP.SourceLatticeStructuralRationalRadiusTM + +/-- GapCVP reduction support. -/ +def squareRootAccumulator (input : List Bool) : List Bool := + firstFieldContents input + +/-- GapCVP reduction support. -/ +noncomputable def squareRootAccumulatorComputable : + BitTM + squareRootAccumulator := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def squareRootTarget (input : List Bool) : List Bool := + firstFieldContents (firstFieldSuffix input) + +/-- GapCVP reduction support. -/ +noncomputable def squareRootTargetComputable : + BitTM + squareRootTarget := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + +private def squareRootAccumulatorSquared (input : List Bool) : List Bool := + List.replicate ((squareRootAccumulator input).length ^ 2) true + +private noncomputable def squareRootAccumulatorSquaredComputable : + BitTM + squareRootAccumulatorSquared := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + squareRootAccumulatorComputable + (polynomialValueUnaryComputable (Polynomial.X ^ 2)) + change + BitTM + (fun input : List Bool => + List.replicate ((squareRootAccumulator input).length ^ 2) true) + simpa only [Polynomial.eval_pow, Polynomial.eval_X, Function.comp_def] using hphysical + +private def squareRootLessMarker (input : List Bool) : List Bool := + fourFamilyComputedUnaryLessBitOutput + squareRootAccumulatorSquared squareRootTarget input + +private noncomputable def squareRootLessMarkerComputable : + BitTM + squareRootLessMarker := + fourFamilyComputedUnaryLessBitComputable + squareRootAccumulatorSquaredComputable squareRootTargetComputable + +@[simp] private theorem squareRootLessMarker_length (input : List Bool) : + (squareRootLessMarker input).length = 1 := + fourFamilyComputedUnaryLessBitOutput_length + squareRootAccumulatorSquared squareRootTarget input + +private def squareRootLessBit (input : List Bool) : Bool := + (squareRootLessMarker input).headD false + +private theorem squareRootLessMarker_eq (input : List Bool) : + squareRootLessMarker input = [squareRootLessBit input] := by + have hlength := squareRootLessMarker_length input + cases hword : squareRootLessMarker input with + | nil => simp only [hword, List.length_nil, zero_ne_one] at hlength + | cons bit remaining => + cases remaining with + | nil => simp only [squareRootLessBit, hword, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] + | cons next tail => simp only [hword, List.length_cons, Nat.add_eq_right, + Nat.add_eq_zero_iff, List.length_eq_zero_iff, + one_ne_zero, and_false] at hlength + +private noncomputable def squareRootLessSelectionComputable : + BitTM + (fun input : List Bool => squareRootLessBit input :: input) := by + have hphysical := pointwiseAppendComputable + squareRootLessMarkerComputable + (Turing.idComputableInPolyTime bitEncoding) + have heq : + (fun input : List Bool => + squareRootLessMarker input ++ input) = + (fun input : List Bool => squareRootLessBit input :: input) := by + funext input + simp only [squareRootLessMarker_eq, List.cons_append, List.nil_append] + change + BitTM + (fun input : List Bool => squareRootLessMarker input ++ input) + at hphysical + rwa [heq] at hphysical + +private def squareRootIncrement (input : List Bool) : List Bool := + if squareRootLessBit input then [true] else [] + +private noncomputable def squareRootIncrementComputable : + BitTM + squareRootIncrement := + sourcePreservingConditionalComputable + squareRootLessSelectionComputable + (SourceCanonicalFixedWordTuringTM.sourceFixedWordComputable + [true]) [] + +private def squareRootCandidate (input : List Bool) : List Bool := + squareRootAccumulator input ++ squareRootIncrement input + +private noncomputable def squareRootCandidateComputable : + BitTM + squareRootCandidate := + pointwiseAppendComputable + squareRootAccumulatorComputable squareRootIncrementComputable + +private def squareRootStep (target current : ℕ) : ℕ := + if current ^ 2 < target then current + 1 else current + +private theorem squareRootStep_le_target + (target current : ℕ) (hcurrent : current ≤ target) : + squareRootStep target current ≤ target := by + unfold squareRootStep + split + next hlt => + have hsq : current ≤ current * current := Nat.le_mul_self current + simp only [pow_two] at hlt + omega + next => exact hcurrent + +private theorem squareRootCandidate_valid + (current target : ℕ) (padding : List Bool) : + squareRootCandidate + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding) = + List.replicate (squareRootStep target current) true := by + let input := + lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding + have hacc : squareRootAccumulator input = + List.replicate current true := by + simp only [squareRootAccumulator, List.append_assoc, firstFieldContents_valid, input] + have htarget : squareRootTarget input = + List.replicate target true := by + simp only [squareRootTarget, List.append_assoc, firstFieldSuffix_valid, + firstFieldContents_valid, input] + have hsq : squareRootAccumulatorSquared input = + List.replicate (current ^ 2) true := by + simp only [squareRootAccumulatorSquared, hacc, List.length_replicate] + have hmarker : squareRootLessMarker input = + [decide (current ^ 2 < target)] := + fourFamilyComputedUnaryLessBitOutput_valid + squareRootAccumulatorSquared squareRootTarget input + (current ^ 2) target hsq htarget + have hbit : squareRootLessBit input = + decide (current ^ 2 < target) := by + simp only [squareRootLessBit, hmarker, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] + change squareRootCandidate input = _ + unfold squareRootCandidate squareRootIncrement + rw [hacc, hbit] + by_cases hlt : current ^ 2 < target + · simp only [hlt, decide_true, ↓reduceIte, SourceStructuralDecoder.replicate_true_append_cons, + List.append_nil, + ← List.replicate_succ, squareRootStep] + · simp only [hlt, decide_false, Bool.false_eq_true, ↓reduceIte, List.append_nil, squareRootStep] + +/-- GapCVP reduction support. -/ +def squareRootAnchor (target : List Bool) : List Bool := + lengthPrefixedWord target ++ target + +private noncomputable def squareRootAnchorComputable + {target : List Bool → List Bool} + (computer : BitTM target) : + BitTM + (fun input => squareRootAnchor (target input)) := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + computer CLStructuralPrefixWriter.structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hprefix computer + change + BitTM + (fun input : List Bool => + lengthPrefixedWord (target input) ++ target input) + exact hphysical + +private theorem squareRootRotation_step + (target current : ℕ) + (hcurrent : current ≤ target) : + sourceAnchoredGridRecordRotationOutput squareRootCandidate + (lengthPrefixedWord + (squareRootAnchor (List.replicate target true)) ++ + lengthPrefixedWord (List.replicate current true)) = + lengthPrefixedWord + (squareRootAnchor (List.replicate target true)) ++ + lengthPrefixedWord + (List.replicate (squareRootStep target current) true) := by + let anchor := squareRootAnchor (List.replicate target true) + let state := + lengthPrefixedWord anchor ++ + lengthPrefixedWord (List.replicate current true) + have hraw : + sourceAnchoredGridRawCandidate squareRootCandidate state = + List.replicate (squareRootStep target current) true := by + change squareRootCandidate + (sourceAnchoredGridRankSourcePair state) = _ + have hpair : + sourceAnchoredGridRankSourcePair state = + lengthPrefixedWord (List.replicate current true) ++ anchor := by + have hcontents : + firstFieldContents + (lengthPrefixedWord (List.replicate current true)) = + List.replicate current true := by + simpa only [List.append_nil] using + firstFieldContents_valid (List.replicate current true) [] + simp [state, sourceAnchoredGridRankSourcePair, hcontents] + rw [hpair] + simpa [anchor, squareRootAnchor, List.append_assoc] using + (squareRootCandidate_valid current target + (List.replicate target true)) + have hfit : + (List.replicate (squareRootStep target current) true).length ≤ + anchor.length := by + have hstep := squareRootStep_le_target target current hcurrent + simp [anchor, squareRootAnchor, lengthPrefixedWord_length] + omega + have hselector : + sourceAnchoredGridCandidateSelector + squareRootCandidate state = true := by + rw [sourceAnchoredGridCandidateSelector_eq, hraw] + have hcontents : firstFieldContents state = anchor := by + simp [state] + rw [hcontents] + exact decide_eq_true hfit + have hguard : + sourceAnchoredGridGuardedCandidate squareRootCandidate state = + List.replicate (squareRootStep target current) true := by + simp [sourceAnchoredGridGuardedCandidate, hselector, hraw] + have hrotation := sourceAnchoredGridRecordRotationOutput_records + squareRootCandidate anchor (List.replicate current true) [] + simpa [state, anchor, hguard] using hrotation + +private theorem squareRootRotation_iterate + (target current stages : ℕ) + (hcurrent : current ≤ target) : + ((sourceAnchoredGridRecordRotationOutput + squareRootCandidate)^[stages]) + (lengthPrefixedWord + (squareRootAnchor (List.replicate target true)) ++ + lengthPrefixedWord (List.replicate current true)) = + lengthPrefixedWord + (squareRootAnchor (List.replicate target true)) ++ + lengthPrefixedWord + (List.replicate + (((squareRootStep target)^[stages]) current) true) := by + induction stages generalizing current with + | zero => simp + | succ stages ih => + rw [Function.iterate_succ_apply, + squareRootRotation_step target current hcurrent, + ih (squareRootStep target current) + (squareRootStep_le_target target current hcurrent), + Function.iterate_succ_apply] + +private theorem square_lt_iff_lt_ceil_sqrt + (target current : ℕ) : + current ^ 2 < target ↔ + current < Nat.ceil (Real.sqrt (target : ℝ)) := by + constructor + · intro hsq + apply Nat.lt_ceil.mpr + apply (Real.lt_sqrt (by positivity)).mpr + exact_mod_cast hsq + · intro hroot + have hreal := Nat.lt_ceil.mp hroot + have hsq := (Real.lt_sqrt (by positivity)).mp hreal + exact_mod_cast hsq + +private theorem squareRootStep_iterate + (target stages : ℕ) : + ((squareRootStep target)^[stages]) 0 = + min stages (Nat.ceil (Real.sqrt (target : ℝ))) := by + induction stages with + | zero => simp only [Function.iterate_zero, id_eq, zero_le, inf_of_le_left] + | succ stages ih => + rw [Function.iterate_succ_apply', ih] + by_cases hlt : stages < Nat.ceil (Real.sqrt (target : ℝ)) + · have hmin : + min stages (Nat.ceil (Real.sqrt (target : ℝ))) = stages := + Nat.min_eq_left (Nat.le_of_lt hlt) + have hnext : + min (stages + 1) (Nat.ceil (Real.sqrt (target : ℝ))) = + stages + 1 := + Nat.min_eq_left (by omega) + have hsq : stages ^ 2 < target := + (square_lt_iff_lt_ceil_sqrt target stages).mpr hlt + simp only [squareRootStep, hmin, hsq, ↓reduceIte, hnext] + · have hle : Nat.ceil (Real.sqrt (target : ℝ)) ≤ stages := by + omega + have hmin : + min stages (Nat.ceil (Real.sqrt (target : ℝ))) = + Nat.ceil (Real.sqrt (target : ℝ)) := + Nat.min_eq_right hle + have hnext : + min (stages + 1) (Nat.ceil (Real.sqrt (target : ℝ))) = + Nat.ceil (Real.sqrt (target : ℝ)) := + Nat.min_eq_right (by omega) + have hsquare : + ¬ (Nat.ceil (Real.sqrt (target : ℝ))) ^ 2 < target := by + rw [square_lt_iff_lt_ceil_sqrt] + exact Nat.lt_irrefl _ + simp only [squareRootStep, hmin, hsquare, ↓reduceIte, hnext] + +private theorem ceil_sqrt_le_target (target : ℕ) : + Nat.ceil (Real.sqrt (target : ℝ)) ≤ target := by + apply Nat.ceil_le.mpr + apply (Real.sqrt_le_left (by positivity)).mpr + have hsq : target ≤ target ^ 2 := by + simpa only [pow_two] using Nat.le_mul_self target + exact_mod_cast hsq + +private theorem squareRootStep_iterate_target (target : ℕ) : + ((squareRootStep target)^[target]) 0 = + Nat.ceil (Real.sqrt (target : ℝ)) := by + rw [squareRootStep_iterate, + Nat.min_eq_right (ceil_sqrt_le_target target)] + +/-- GapCVP reduction support. -/ +def squareRootFoldPreparation + (target : List Bool → List Bool) + (input : List Bool) : List Bool := + target input ++ false :: + (lengthPrefixedWord (squareRootAnchor (target input)) ++ + lengthPrefixedWord []) + +/-- GapCVP reduction support. -/ +noncomputable def squareRootFoldPreparationComputable + {target : List Bool → List Bool} + (computer : BitTM target) : + BitTM + (squareRootFoldPreparation target) := by + have hanchor := GapCVP.TMComposition.computableInPolyTime + (squareRootAnchorComputable computer) + CLStructuralPrefixWriter.structuralPrefixWriterComputable + have hseed := pointwiseAppendComputable hanchor + (SourceCanonicalFixedWordTuringTM.sourceFixedWordComputable + (lengthPrefixedWord [])) + have hdelimited := GapCVP.TMComposition.computableInPolyTime + hseed (prependBitComputable false) + have hphysical := pointwiseAppendComputable computer hdelimited + change + BitTM + (fun input : List Bool => + target input ++ false :: + (lengthPrefixedWord (squareRootAnchor (target input)) ++ + lengthPrefixedWord [])) + exact hphysical + +private def ceilSquareRootUnaryOutput + (target : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput squareRootCandidate) + (squareRootFoldPreparation target input))) + +private noncomputable def ceilSquareRootUnaryComputable + {target : List Bool → List Bool} + (computer : BitTM target) : + BitTM + (ceilSquareRootUnaryOutput target) := by + have hfold := GapCVP.TMComposition.computableInPolyTime + (squareRootFoldPreparationComputable computer) + (sourceAnchoredGridRecordFoldComputable + squareRootCandidateComputable) + have hsuffix := GapCVP.TMComposition.computableInPolyTime + hfold firstFieldSuffixComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hsuffix firstFieldContentsComputable + change + BitTM + (fun input : List Bool => + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput squareRootCandidate) + (squareRootFoldPreparation target input)))) + exact hphysical + +private theorem ceilSquareRootUnaryOutput_valid + (target : List Bool → List Bool) + (input : List Bool) (weight : ℕ) + (hweight : target input = List.replicate weight true) : + ceilSquareRootUnaryOutput target input = + List.replicate (Nat.ceil (Real.sqrt (weight : ℝ))) true := by + unfold ceilSquareRootUnaryOutput squareRootFoldPreparation + rw [hweight] + change + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput squareRootCandidate) + (unaryBoundedFoldWord weight + (lengthPrefixedWord + (squareRootAnchor (List.replicate weight true)) ++ + lengthPrefixedWord [])))) = _ + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + change + firstFieldContents + (firstFieldSuffix + (((sourceAnchoredGridRecordRotationOutput + squareRootCandidate)^[weight]) + (lengthPrefixedWord + (squareRootAnchor (List.replicate weight true)) ++ + lengthPrefixedWord (List.replicate 0 true)))) = _ + rw [squareRootRotation_iterate weight 0 weight (Nat.zero_le _), + squareRootStep_iterate_target] + rw [firstFieldSuffix_valid] + simpa only [List.append_nil] using + firstFieldContents_valid + (List.replicate (Nat.ceil (Real.sqrt (weight : ℝ))) true) [] + +/-- GapCVP reduction support. -/ +def ceilSquareRootAtomicRationalOutput + (target : List Bool → List Bool) + (input : List Bool) : List Bool := + structuralAtomicNaturalWord + ((rationalRadiusUnaryOutput + (true :: ceilSquareRootUnaryOutput target input)).tail) + +/-- GapCVP reduction support. -/ +noncomputable def ceilSquareRootAtomicRationalComputable + {target : List Bool → List Bool} + (computer : BitTM target) : + BitTM + (ceilSquareRootAtomicRationalOutput target) := by + have hmarked := GapCVP.TMComposition.computableInPolyTime + (ceilSquareRootUnaryComputable computer) + (prependBitComputable true) + have hrational := GapCVP.TMComposition.computableInPolyTime + hmarked rationalRadiusUnaryComputable + have htail := GapCVP.TMComposition.computableInPolyTime + hrational radiusMarkerTailComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + htail structuralAtomicNaturalWriterComputable + change + BitTM + (fun input : List Bool => + structuralAtomicNaturalWord + ((rationalRadiusUnaryOutput + (true :: ceilSquareRootUnaryOutput target input)).tail)) + simpa only [Function.comp_def] using hphysical + +theorem ceilSquareRootAtomicRationalOutput_valid + (target : List Bool → List Bool) + (input : List Bool) (weight : ℕ) + (hweight : target input = List.replicate weight true) : + ceilSquareRootAtomicRationalOutput target input = + BinaryEncoding.encodeAtomic + (Nat.ceil (Real.sqrt (weight : ℝ)) : ℚ) := by + unfold ceilSquareRootAtomicRationalOutput + rw [ceilSquareRootUnaryOutput_valid target input weight hweight, + rationalRadiusUnaryOutput_marked] + simp only [List.tail_cons] + rw [structuralAtomicNaturalWord_eq_prefix, + sourceRationalNatCast_atomic] + simp only [List.length_replicate] + +end BinaryRadiusTM + +namespace GaussianPivotScheduleTM + +open Turing + +/-- GapCVP reduction support. -/ +def binaryGaussianPivotWord (candidates : List Bool) : List Bool := + match candidates.findIdx? id with + | none => [false] + | some index => true :: List.replicate index true + +@[simp] private theorem binaryGaussianPivotWord_found + (zeros : ℕ) (remaining : List Bool) : + binaryGaussianPivotWord + (List.replicate zeros false ++ true :: remaining) = + true :: List.replicate zeros true := by + have hfind : + (List.replicate zeros false ++ true :: remaining).findIdx? id = + some zeros := by + induction zeros with + | zero => simp only [List.replicate_zero, List.nil_append, List.findIdx?_cons, id_eq, + ↓reduceIte] + | succ zeros ih => + simp only [List.replicate_succ, List.cons_append, List.findIdx?_cons, id_eq, + Bool.false_eq_true, ↓reduceIte, + ih, Option.map_some] + simp only [binaryGaussianPivotWord, hfind] + +@[simp] private theorem binaryGaussianPivotWord_absent + (zeros : ℕ) : + binaryGaussianPivotWord (List.replicate zeros false) = [false] := by + have hfind : + (List.replicate zeros false).findIdx? id = none := by + induction zeros with + | zero => simp only [List.replicate_zero, List.findIdx?_nil] + | succ zeros ih => + simp only [List.replicate_succ, List.findIdx?_cons, id_eq, Bool.false_eq_true, ↓reduceIte, + ih, + Option.map_none] + simp only [binaryGaussianPivotWord, hfind] + +private def pivotPeek (stack : Fin 2) + (present absent : Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool)) : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + .peek stack (fun _ symbol => symbol) + (.branch (fun symbol => symbol.isSome) present absent) + +private def pivotGoto (phase : Fin 3) : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + .load (fun _ => none) (.goto (fun _ => phase)) + +private def pivotScanStatement : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + pivotPeek 0 + (.branch (fun candidate => candidate.getD false) + (.pop 0 (fun _ _ => none) + (.push 1 (fun _ => true) (pivotGoto 1))) + (.pop 0 (fun _ _ => none) + (.push 1 (fun _ => true) (pivotGoto 0)))) + (pivotGoto 2) + +private def pivotSuccessDrainStatement : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + pivotPeek 0 + (.pop 0 (fun _ _ => none) (pivotGoto 1)) + (.load (fun _ => none) .halt) + +private def pivotFailureStatement : + Turing.TM2.Stmt + (fun _ : Fin 2 => Bool) (Fin 3) (Option Bool) := + pivotPeek 1 + (.pop 1 (fun _ _ => none) (pivotGoto 2)) + (.push 1 (fun _ => false) (.load (fun _ => none) .halt)) + +private abbrev binaryGaussianPivotMachine : Turing.FinTM2 where + K := Fin 2 + k₀ := 0 + k₁ := 1 + Γ _ := Bool + Λ := Fin 3 + main := 0 + σ := Option Bool + initialState := none + m phase := + if phase = (0 : Fin 3) then pivotScanStatement + else if phase = (1 : Fin 3) then pivotSuccessDrainStatement + else pivotFailureStatement + +private def pivotConfiguration + (phase : Fin 3) (input output : List Bool) : + binaryGaussianPivotMachine.Cfg where + l := some phase + var := none + stk := ![input, output] + +private theorem binaryGaussianPivotMachine_init + (input : List Bool) : + Turing.initList binaryGaussianPivotMachine input = + pivotConfiguration 0 input [] := by + simp only [binaryGaussianPivotMachine, Fin.isValue, initList, eq_mpr_eq_cast, cast_eq, + dite_eq_ite, + pivotConfiguration] + congr 1 + funext stack + fin_cases stack <;> simp + +/-- Executes the `binaryGaussianPivotStepTac` machine-step simplifier. -/ +macro "binaryGaussianPivotStepTac" : tactic => + `(tactic| + (first + | rfl + | (simp [binaryGaussianPivotMachine, pivotConfiguration, + pivotPeek, pivotGoto, pivotScanStatement, + pivotSuccessDrainStatement, pivotFailureStatement, + Turing.haltList, Turing.FinTM2.step, + Turing.TM2.step, Turing.TM2.stepAux] <;> + try { congr 2; funext stack; fin_cases stack <;> + (first | rfl | simp [Function.update]) } <;> + try rfl))) + +private theorem pivot_scan_false + (input output : List Bool) : + binaryGaussianPivotMachine.step + (pivotConfiguration 0 (false :: input) output) = + some (pivotConfiguration 0 input (true :: output)) := by + binaryGaussianPivotStepTac + +private theorem pivot_scan_true + (input output : List Bool) : + binaryGaussianPivotMachine.step + (pivotConfiguration 0 (true :: input) output) = + some (pivotConfiguration 1 input (true :: output)) := by + binaryGaussianPivotStepTac + +private theorem pivot_scan_missing (output : List Bool) : + binaryGaussianPivotMachine.step + (pivotConfiguration 0 [] output) = + some (pivotConfiguration 2 [] output) := by + binaryGaussianPivotStepTac + +private theorem pivot_success_drain_step + (bit : Bool) (input output : List Bool) : + binaryGaussianPivotMachine.step + (pivotConfiguration 1 (bit :: input) output) = + some (pivotConfiguration 1 input output) := by + cases bit <;> binaryGaussianPivotStepTac + +private theorem pivot_success_finish (output : List Bool) : + binaryGaussianPivotMachine.step + (pivotConfiguration 1 [] output) = + some (Turing.haltList binaryGaussianPivotMachine output) := by + binaryGaussianPivotStepTac + +private theorem pivot_failure_drain_step + (bit : Bool) (output : List Bool) : + binaryGaussianPivotMachine.step + (pivotConfiguration 2 [] (bit :: output)) = + some (pivotConfiguration 2 [] output) := by + cases bit <;> binaryGaussianPivotStepTac + +private theorem pivot_failure_finish : + binaryGaussianPivotMachine.step + (pivotConfiguration 2 [] []) = + some (Turing.haltList binaryGaussianPivotMachine [false]) := by + binaryGaussianPivotStepTac + +private def pivot_successDrainTrace + (input output : List Bool) : + EvalsToInTime binaryGaussianPivotMachine.step (pivotConfiguration 1 input output) + (some (Turing.haltList binaryGaussianPivotMachine output)) + (input.length + 1) := by + induction input with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using + oneStep _ _ (pivot_success_finish output) + | cons bit input ih => + have first := oneStep _ _ (pivot_success_drain_step bit input output) + have full := EvalsToInTime.trans binaryGaussianPivotMachine.step _ _ _ _ _ first ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using full + +private def pivot_failureTrace + (output : List Bool) : + EvalsToInTime binaryGaussianPivotMachine.step (pivotConfiguration 2 [] output) + (some (Turing.haltList binaryGaussianPivotMachine [false])) + (output.length + 1) := by + induction output with + | nil => + simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using oneStep _ _ + pivot_failure_finish + | cons bit output ih => + have first := oneStep _ _ (pivot_failure_drain_step bit output) + have full := EvalsToInTime.trans binaryGaussianPivotMachine.step _ _ _ _ _ first ih + simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] + using full + +private def pivot_foundTrace + (zeros : ℕ) (remaining output : List Bool) : + EvalsToInTime binaryGaussianPivotMachine.step (pivotConfiguration 0 + (List.replicate zeros false ++ true :: remaining) output) + (some (Turing.haltList binaryGaussianPivotMachine + (true :: List.replicate zeros true ++ output))) + (zeros + remaining.length + 2) := by + induction zeros generalizing output with + | zero => + have first := oneStep _ _ (pivot_scan_true remaining output) + have rest := pivot_successDrainTrace remaining (true :: output) + have full := EvalsToInTime.trans binaryGaussianPivotMachine.step _ _ _ _ _ first rest + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, List.cons_append, + zero_add, + Nat.add_assoc, Nat.reduceAdd] using full + | succ zeros ih => + have first := oneStep _ _ (pivot_scan_false + (List.replicate zeros false ++ true :: remaining) output) + have rest := ih (true :: output) + have full := EvalsToInTime.trans binaryGaussianPivotMachine.step _ _ _ _ _ first rest + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, + Nat.add_left_comm, + Nat.add_assoc, Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] + using full + +private def pivot_absentTrace + (zeros : ℕ) (output : List Bool) : + EvalsToInTime binaryGaussianPivotMachine.step + (pivotConfiguration 0 (List.replicate zeros false) output) + (some (Turing.haltList binaryGaussianPivotMachine [false])) + (2 * zeros + output.length + 2) := by + induction zeros generalizing output with + | zero => + have first := oneStep _ _ (pivot_scan_missing output) + have rest := pivot_failureTrace output + have full := EvalsToInTime.trans binaryGaussianPivotMachine.step _ _ _ _ _ first rest + simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, mul_zero, zero_add, Nat.add_assoc, + Nat.reduceAdd] using full + | succ zeros ih => + have first := oneStep _ _ (pivot_scan_false (List.replicate zeros false) output) + have rest := ih (true :: output) + have full := EvalsToInTime.trans binaryGaussianPivotMachine.step _ _ _ _ _ first rest + have bounded := rebound (newBudget := 2 * (zeros + 1) + output.length + 2) + full (by simp only [List.length_cons, add_le_add_iff_right, Nat.reduceLeDiff, + Order.add_one_le_iff]; omega) + simpa only [FinTM2.step, Fin.isValue, List.replicate_succ] using bounded + +private inductive BinaryGaussianPivotInputShape (input : List Bool) : Type where + | found (zeros : ℕ) (remaining : List Bool) + (shape : input = List.replicate zeros false ++ true :: remaining) + | absent (shape : input = List.replicate input.length false) + +private def binaryGaussianPivotInputShape + (input : List Bool) : BinaryGaussianPivotInputShape input := by + induction input with + | nil => exact .absent rfl + | cons bit remaining ih => + cases bit with + | true => exact .found 0 remaining rfl + | false => + cases ih with + | found zeros tail hshape => + exact .found (zeros + 1) tail (by + change false :: remaining = + false :: (List.replicate zeros false ++ true :: tail) + exact congrArg (List.cons false) hshape) + | absent hshape => + exact .absent (by + change false :: remaining = + false :: List.replicate remaining.length false + exact congrArg (List.cons false) hshape) + +private def binaryGaussianPivot_totalTrace (input : List Bool) : + EvalsToInTime binaryGaussianPivotMachine.step (pivotConfiguration 0 input []) + (some (Turing.haltList binaryGaussianPivotMachine + (binaryGaussianPivotWord input))) + (2 * input.length + 3) := by + cases binaryGaussianPivotInputShape input with + | found zeros remaining hshape => + subst input + have full := pivot_foundTrace zeros remaining [] + simp only [List.append_nil] at full + rw [binaryGaussianPivotWord_found] + exact rebound full (by + simp only [List.length_append, List.length_replicate, + List.length_cons] + omega) + | absent hshape => + have hword : binaryGaussianPivotWord input = [false] := by + rw [hshape, binaryGaussianPivotWord_absent] + have full := pivot_absentTrace input.length [] + rw [← hshape] at full + rw [hword] + exact rebound full (by + simp only [List.length_nil, Nat.add_zero] + omega) + +/-- GapCVP reduction support. -/ +noncomputable def binaryGaussianPivotComputable : + BitTM + binaryGaussianPivotWord where + tm := binaryGaussianPivotMachine + inputAlphabet := Equiv.refl Bool + outputAlphabet := Equiv.refl Bool + time := 2 * Polynomial.X + 3 + outputsFun input := { + steps := (binaryGaussianPivot_totalTrace input).steps + evals_in_steps := by + simpa only [Option.bind_eq_bind, FinTM2.step, Fin.isValue, Equiv.invFun_as_coe, + Equiv.refl_symm, + Equiv.coe_refl, bitEncoding, id_eq, List.map_id_fun, binaryGaussianPivotMachine_init, + Option.map_some] using + (binaryGaussianPivot_totalTrace input).evals_in_steps + steps_le_m := by + have hsteps := (binaryGaussianPivot_totalTrace input).steps_le_m + simpa only [FinTM2.step, Fin.isValue, bitEncoding, id_eq, Polynomial.eval_add, + Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, ge_iff_le] using hsteps + } + +/-- GapCVP reduction support. -/ +def effectiveGaussianPivotCandidates + {m n : ℕ} (state : GapCVP.Core.EffectiveBinaryGaussian.State m n) + (column : Fin n) : List Bool := + (List.finRange m).map (fun row => + decide (state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2))) + +end GaussianPivotScheduleTM + +namespace GaussianPackedPivotColumnTM + +open Turing GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyMarkerRotationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM + +private theorem binaryGaussianPivotEligibilityWord_length + (input : List Bool) : + (sourceFourFamilyBooleanAndPairWord input).length = 1 := by + cases input with + | nil => rfl + | cons first remaining => + cases first with + | false => rfl + | true => + cases remaining with + | nil => rfl + | cons second remaining => + cases second <;> rfl + +/-- GapCVP reduction support. -/ +def binaryGaussianPackedPivotCandidateOutput : + List Bool → List Bool := + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + sourceFourFamilyBooleanAndPairWord) + +private noncomputable def binaryGaussianPackedPivotCandidateComputable : + BitTM + binaryGaussianPackedPivotCandidateOutput := + fourFamilyOriginalMarkerFoldComputable + sourceFourFamilyBooleanAndPairComputable + (fun input => (binaryGaussianPivotEligibilityWord_length input).le) + +/-- GapCVP reduction support. -/ +def binaryGaussianPackedPivotRowQuery + (eligible entry : Bool) (source : List Bool) : List Bool := + eligible :: entry :: source + +/-- GapCVP reduction support. -/ +def binaryGaussianPackedPivotColumnWord + (rows : List (Bool × Bool)) (source : List Bool) : List Bool := + unaryBoundedFoldWord rows.length + (sourceMixedRadixOriginalSourceQueryStream + (rows.map (fun row => + binaryGaussianPackedPivotRowQuery row.1 row.2 source))) + +@[simp] private theorem binaryGaussianPivotEligibilityWord_valid + (eligible entry : Bool) (source : List Bool) : + sourceFourFamilyBooleanAndPairWord + (binaryGaussianPackedPivotRowQuery eligible entry source) = + [eligible && entry] := by + cases eligible <;> cases entry <;> rfl + +@[simp] theorem binaryGaussianPackedPivotCandidateOutput_valid + (rows : List (Bool × Bool)) (source : List Bool) : + binaryGaussianPackedPivotCandidateOutput + (binaryGaussianPackedPivotColumnWord rows source) = + rows.map (fun row => row.1 && row.2) := by + unfold binaryGaussianPackedPivotCandidateOutput + binaryGaussianPackedPivotColumnWord + have h := boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries + sourceFourFamilyBooleanAndPairWord + (rows.map (fun row => + binaryGaussianPackedPivotRowQuery row.1 row.2 source)) [] + have hflatten : + rows.flatMap (fun row => [row.1 && row.2]) = + rows.map (fun row => row.1 && row.2) := by + calc + rows.flatMap (fun row => [row.1 && row.2]) = + (rows.map (fun row => row.1 && row.2)).flatMap + (fun bit => [bit]) := by + simp only [List.flatMap_map] + _ = rows.map (fun row => row.1 && row.2) := + List.flatMap_singleton' _ + calc + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + sourceFourFamilyBooleanAndPairWord) + (unaryBoundedFoldWord rows.length + (sourceMixedRadixOriginalSourceQueryStream + (rows.map (fun row => + binaryGaussianPackedPivotRowQuery row.1 row.2 source)))) = + rows.flatMap (fun row => [row.1 && row.2]) := by + simpa only [List.length_map, List.append_nil, fourFamilyOriginalMarkerStream, + List.flatMap_map, + binaryGaussianPivotEligibilityWord_valid, List.nil_append] using h + _ = rows.map (fun row => row.1 && row.2) := hflatten + +end GaussianPackedPivotColumnTM + +namespace GaussianAdaptivePivotStepTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceFourFamilyMarkerRotationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFlatAdjacentRecordSwapTM +open GapCVP.CNFFlatAdjacentConditionalSwapTM GapCVP.GaussianRowWorker + +/-- GapCVP reduction support. -/ +def binaryGaussianDynamicBranchOutput + (selector : List Bool → Bool) + (valid fallback : List Bool → List Bool) + (input : List Bool) : List Bool := + if selector input then valid input else fallback input + +/-- GapCVP reduction support. -/ +noncomputable def binaryGaussianDynamicBranchComputable + {selector : List Bool → Bool} + {valid fallback : List Bool → List Bool} + (selection : BitTM + (fun input => selector input :: input)) + (hvalid : BitTM valid) + (hfallback : BitTM fallback) : + BitTM + (binaryGaussianDynamicBranchOutput selector valid fallback) := by + have hmarker := GapCVP.TMComposition.computableInPolyTime + selection binaryGaussianFirstCellComputable + have hvalidPrefix := GapCVP.TMComposition.computableInPolyTime + hvalid structuralPrefixWriterComputable + have hfallbackPrefix := GapCVP.TMComposition.computableInPolyTime + hfallback structuralPrefixWriterComputable + have hbranches := pointwiseAppendComputable + hfallbackPrefix hvalidPrefix + have hselected := pointwiseAppendComputable + hmarker hbranches + have hswap := GapCVP.TMComposition.computableInPolyTime + hselected flatAdjacentConditionalSwapComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hswap firstFieldContentsComputable + convert hphysical using 1 + funext input + change + binaryGaussianDynamicBranchOutput selector valid fallback input = + firstFieldContents + (flatAdjacentConditionalSwapOutput + (binaryGaussianFirstCellWord (selector input :: input) ++ + (lengthPrefixedWord (fallback input) ++ + lengthPrefixedWord (valid input)))) + cases hdecision : selector input with + | false => + simp only [binaryGaussianDynamicBranchOutput, hdecision, Bool.false_eq_true, ↓reduceIte, + flatAdjacentConditionalSwapOutput, binaryGaussianFirstCellWord_valid, List.cons_append, + List.nil_append, + firstFieldContents_valid] + | true => + simp only [binaryGaussianDynamicBranchOutput, + hdecision, ↓reduceIte, binaryGaussianFirstCellWord_valid, + List.singleton_append, flatAdjacentConditionalSwapOutput] + have hswap := flatAdjacentRecordSwapOutput_records + (fallback input) (valid input) [] + simp only [List.append_nil] at hswap + rw [hswap] + simp only [firstFieldContents_valid] + +private theorem binaryGaussianFirstFieldSuffix_nonexpansive + (input : List Bool) : + (firstFieldSuffix input).length ≤ input.length := + sourceFourFamilyFirstFieldSuffix_length_le input + +private theorem binaryGaussianFirstFieldSuffix_polynomialStates : + PolynomiallyBoundedFoldStates firstFieldSuffix Polynomial.X := + GapCVP.Factor400BinarySourceTM.boundedFoldStates_of_nonexpansive + binaryGaussianFirstFieldSuffix_nonexpansive + +/-- GapCVP reduction support. -/ +def binaryGaussianIndexedBatchOutput : List Bool → List Bool := + firstFieldContents ∘ + boundedRecordFoldOutput firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def binaryGaussianIndexedBatchComputable : + BitTM + binaryGaussianIndexedBatchOutput := by + have hskip := boundedDependentRecordFoldComputable + firstFieldSuffixComputable Polynomial.X + binaryGaussianFirstFieldSuffix_polynomialStates + exact GapCVP.TMComposition.computableInPolyTime + hskip firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def binaryGaussianPivotBatchStream + (batches : List (List Bool)) : List Bool := + sourceMixedRadixOriginalSourceQueryStream batches + +private theorem binaryGaussian_skipBatchRecords + (batches : List (List Bool)) (suffix : List Bool) + (index : ℕ) (hindex : index ≤ batches.length) : + ((firstFieldSuffix^[index]) + (binaryGaussianPivotBatchStream batches ++ suffix)) = + binaryGaussianPivotBatchStream (batches.drop index) ++ suffix := by + induction index generalizing batches with + | zero => simp only [Function.iterate_zero, id_eq, List.drop_zero] + | succ index ih => + cases batches with + | nil => simp only [List.length_nil, nonpos_iff_eq_zero, Nat.add_eq_zero_iff, one_ne_zero, + and_false] at hindex + | cons batch remaining => + have hremaining : index ≤ remaining.length := by + simpa only [List.length_cons, add_le_add_iff_right] using hindex + rw [Function.iterate_succ_apply] + have hprefix : + binaryGaussianPivotBatchStream (batch :: remaining) ++ suffix = + lengthPrefixedWord batch ++ + (binaryGaussianPivotBatchStream remaining ++ suffix) := by + simp only [binaryGaussianPivotBatchStream, sourceMixedRadixOriginalSourceQueryStream, + List.flatMap_cons, + List.append_assoc] + rw [hprefix, firstFieldSuffix_valid] + rw [ih remaining hremaining] + simp only [List.drop_succ_cons] + +theorem binaryGaussianIndexedBatchOutput_valid + (batches : List (List Bool)) (suffix : List Bool) + (index : ℕ) (hindex : index < batches.length) : + binaryGaussianIndexedBatchOutput + (unaryBoundedFoldWord index + (binaryGaussianPivotBatchStream batches ++ suffix)) = + batches[index] := by + unfold binaryGaussianIndexedBatchOutput + boundedRecordFoldOutput + simp only [Function.comp_apply, parseUnaryBoundedFold_word] + rw [binaryGaussian_skipBatchRecords batches suffix index + (Nat.le_of_lt hindex)] + have hdrop : + batches.drop index = + batches[index] :: batches.drop (index + 1) := by + exact (List.cons_getElem_drop_succ + (l := batches) (n := index) (h := hindex)).symm + rw [hdrop] + change + firstFieldContents + ((lengthPrefixedWord batches[index] ++ + binaryGaussianPivotBatchStream + (batches.drop (index + 1))) ++ suffix) = + batches[index] + rw [List.append_assoc] + exact firstFieldContents_valid batches[index] + (binaryGaussianPivotBatchStream + (batches.drop (index + 1)) ++ suffix) + +end GaussianAdaptivePivotStepTM + +namespace BinaryGaussianStructuralAtomTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.BinaryStructuralRecordTM + +/-- GapCVP reduction support. -/ +def structuralRankUnary (query : List Bool) : List Bool := + firstFieldContents query + +/-- GapCVP reduction support. -/ +noncomputable def structuralRankUnaryComputable : + BitTM + structuralRankUnary := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def structuralRankOriginalSource (query : List Bool) : List Bool := + firstFieldSuffix (firstFieldSuffix query) + +/-- GapCVP reduction support. -/ +noncomputable def structuralRankOriginalSourceComputable : + BitTM + structuralRankOriginalSource := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + change + BitTM + (fun query : List Bool => + firstFieldSuffix (firstFieldSuffix query)) + change + BitTM + (fun query : List Bool => + firstFieldSuffix (firstFieldSuffix query)) + at hphysical + exact hphysical + +@[simp] theorem structuralRankUnary_query + (dimension : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : + structuralRankUnary + (constructiveStructuralRankQuery dimension input rank) = + List.replicate rank true := by + unfold structuralRankUnary constructiveStructuralRankQuery + exact firstFieldContents_valid + (List.replicate rank true) + (sourceQaryMaskDynamicGridBaseSource + (constructiveStructuralRecordWidth dimension) input) + +@[simp] theorem structuralRankOriginalSource_query + (dimension : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : + structuralRankOriginalSource + (constructiveStructuralRankQuery dimension input rank) = input := by + unfold structuralRankOriginalSource + constructiveStructuralRankQuery + sourceQaryMaskDynamicGridBaseSource + change + firstFieldSuffix + (firstFieldSuffix + (lengthPrefixedWord (List.replicate rank true) ++ + (lengthPrefixedWord + (constructiveStructuralRecordCountOutput dimension input) ++ + input))) = input + rw [firstFieldSuffix_valid + (List.replicate rank true) + (lengthPrefixedWord + (constructiveStructuralRecordCountOutput dimension input) ++ input)] + exact firstFieldSuffix_valid + (constructiveStructuralRecordCountOutput dimension input) input + +/-- GapCVP reduction support. -/ +def structuralRankLessBit + (bound : List Bool → List Bool) + (query : List Bool) : Bool := + (fourFamilyComputedUnaryLessBitOutput + structuralRankUnary bound query).headD false + +private theorem structuralRankLessMarker_eq + (bound : List Bool → List Bool) + (query : List Bool) : + fourFamilyComputedUnaryLessBitOutput + structuralRankUnary bound query = + [structuralRankLessBit bound query] := by + have hlength := fourFamilyComputedUnaryLessBitOutput_length + structuralRankUnary bound query + cases hword : fourFamilyComputedUnaryLessBitOutput + structuralRankUnary bound query with + | nil => simp only [hword, List.length_nil, zero_ne_one] at hlength + | cons bit remaining => + cases remaining with + | nil => simp only [structuralRankLessBit, hword, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] + | cons next tail => simp only [hword, List.length_cons, Nat.add_eq_right, + Nat.add_eq_zero_iff, List.length_eq_zero_iff, + one_ne_zero, and_false] at hlength + +/-- GapCVP reduction support. -/ +noncomputable def structuralRankLessSelectionComputable + {bound : List Bool → List Bool} + (hbound : BitTM bound) : + BitTM + (fun query : List Bool => + structuralRankLessBit bound query :: query) := by + have hmarker := fourFamilyComputedUnaryLessBitComputable + structuralRankUnaryComputable hbound + have hphysical := pointwiseAppendComputable hmarker + (Turing.idComputableInPolyTime bitEncoding) + have heq : + (fun query : List Bool => + fourFamilyComputedUnaryLessBitOutput + structuralRankUnary bound query ++ query) = + (fun query : List Bool => + structuralRankLessBit bound query :: query) := by + funext query + rw [structuralRankLessMarker_eq bound query] + rfl + change + BitTM + (fun query : List Bool => + fourFamilyComputedUnaryLessBitOutput + structuralRankUnary bound query ++ query) + at hphysical + rwa [heq] at hphysical + +theorem structuralRankLessBit_valid + (bound : List Bool → List Bool) + (query : List Bool) (rank ceiling : ℕ) + (hrank : structuralRankUnary query = List.replicate rank true) + (hbound : bound query = List.replicate ceiling true) : + structuralRankLessBit bound query = decide (rank < ceiling) := by + have hmarker := fourFamilyComputedUnaryLessBitOutput_valid + structuralRankUnary bound query rank ceiling hrank hbound + unfold structuralRankLessBit + rw [hmarker] + rfl + +/-- GapCVP reduction support. -/ +def structuralRankOneBound (_query : List Bool) : List Bool := + [true] + +/-- GapCVP reduction support. -/ +noncomputable def structuralRankOneBoundComputable : + BitTM + structuralRankOneBound := + SourceCanonicalFixedWordTuringTM.sourceFixedWordComputable [true] + +/-- GapCVP reduction support. -/ +def structuralRankTwoBound (_query : List Bool) : List Bool := + [true, true] + +/-- GapCVP reduction support. -/ +noncomputable def structuralRankTwoBoundComputable : + BitTM + structuralRankTwoBound := + SourceCanonicalFixedWordTuringTM.sourceFixedWordComputable + [true, true] + +theorem structuralRankOneDecision_query + (dimension : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : + structuralRankLessBit structuralRankOneBound + (constructiveStructuralRankQuery dimension input rank) = + decide (rank < 1) := + structuralRankLessBit_valid + structuralRankOneBound + (constructiveStructuralRankQuery dimension input rank) + rank 1 + (structuralRankUnary_query dimension input rank) rfl + +theorem structuralRankTwoDecision_query + (dimension : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : + structuralRankLessBit structuralRankTwoBound + (constructiveStructuralRankQuery dimension input rank) = + decide (rank < 2) := + structuralRankLessBit_valid + structuralRankTwoBound + (constructiveStructuralRankQuery dimension input rank) + rank 2 + (structuralRankUnary_query dimension input rank) rfl + +end BinaryGaussianStructuralAtomTM + +namespace BinaryGaussianStructuralRecordIndex + +open GapCVP.BinaryEncoding GapCVP.SourceWholeOutputAssemblyTM + +theorem sourceVectorStructuralRecords_getD + {α : Type*} [Encodable α] + (n : ℕ) (values : Fin n → α) (index : Fin n) : + (sourceVectorStructuralRecords n values).getD index.val [] = + encodeAtomic (values index) := by + have hindex : index.val < + (sourceVectorStructuralRecords n values).length := by + simpa only [sourceVectorStructuralRecords_length] using index.isLt + rw [List.getD_eq_getElem + (sourceVectorStructuralRecords n values) [] hindex] + simp only [sourceVectorStructuralRecords, List.getElem_ofFn, Fin.eta] + +private theorem sourceMatrixStructuralRecords_succ + (m n : ℕ) + (matrix : Fin (m + 1) → Fin n → ℤ) : + sourceMatrixStructuralRecords (m + 1) n matrix = + sourceVectorStructuralRecords n (matrix 0) ++ + sourceMatrixStructuralRecords m n + (fun row => matrix row.succ) := by + simp only [sourceMatrixStructuralRecords, sourceVectorStructuralRecords, List.ofFn_succ, + List.flatten_cons] + +theorem sourceMatrixStructuralRecords_getD + (m n : ℕ) (matrix : Fin m → Fin n → ℤ) + (row : Fin m) (column : Fin n) : + (sourceMatrixStructuralRecords m n matrix).getD + (row.val * n + column.val) [] = + encodeAtomic (matrix row column) := by + induction m with + | zero => exact Fin.elim0 row + | succ m ih => + refine Fin.cases ?_ (fun previous => ?_) row + · simp only [Fin.val_zero, Nat.zero_mul, Nat.zero_add] + rw [sourceMatrixStructuralRecords_succ] + have hcolumn : column.val < + (sourceVectorStructuralRecords n (matrix 0)).length := by + simpa only [sourceVectorStructuralRecords_length] using + column.isLt + rw [List.getD_append + (sourceVectorStructuralRecords n (matrix 0)) + (sourceMatrixStructuralRecords m n + (fun index => matrix index.succ)) + [] column.val hcolumn] + exact sourceVectorStructuralRecords_getD + n (matrix 0) column + · rw [sourceMatrixStructuralRecords_succ] + have hprefix : + (sourceVectorStructuralRecords n (matrix 0)).length ≤ + previous.succ.val * n + column.val := by + rw [sourceVectorStructuralRecords_length] + simp only [Fin.val_succ, Nat.succ_mul] + omega + rw [List.getD_append_right + (sourceVectorStructuralRecords n (matrix 0)) + (sourceMatrixStructuralRecords m n + (fun index => matrix index.succ)) + [] (previous.succ.val * n + column.val) hprefix] + rw [sourceVectorStructuralRecords_length] + have hindex : + previous.succ.val * n + column.val - n = + previous.val * n + column.val := by + simp only [Fin.val_succ, Nat.succ_mul] + omega + rw [hindex] + exact ih (fun index => matrix index.succ) + previous + +theorem sourceLatticeStructuralRecords_getD_dimension + (lattice : GapCVPInstance) : + (sourceLatticeStructuralRecords lattice).getD 0 [] = + encodeAtomic lattice.dimension := by + rfl + +theorem sourceLatticeStructuralRecords_getD_radius + (lattice : GapCVPInstance) : + (sourceLatticeStructuralRecords lattice).getD 1 [] = + encodeAtomic lattice.radius := by + rfl + +theorem sourceLatticeStructuralRecords_getD_target + (lattice : GapCVPInstance) + (index : Fin lattice.dimension) : + (sourceLatticeStructuralRecords lattice).getD + (2 + index.val) [] = + encodeAtomic (lattice.target index) := by + let vector := sourceVectorStructuralRecords + lattice.dimension lattice.target + let matrix := sourceMatrixStructuralRecords + lattice.dimension lattice.dimension (Matrix.of.symm lattice.basis) + have hsplit : sourceLatticeStructuralRecords lattice = + [encodeAtomic lattice.dimension, encodeAtomic lattice.radius] ++ + (vector ++ matrix) := by + simp only [sourceLatticeStructuralRecords, List.cons_append, List.nil_append, vector, matrix] + rw [hsplit] + have hprefix : + ([encodeAtomic lattice.dimension, + encodeAtomic lattice.radius] : List (List Bool)).length ≤ + 2 + index.val := by simp only [List.length_cons, List.length_nil, zero_add, Nat.reduceAdd, + le_add_iff_nonneg_right, zero_le] + rw [List.getD_append_right + [encodeAtomic lattice.dimension, encodeAtomic lattice.radius] + (vector ++ matrix) [] (2 + index.val) hprefix] + simp only [List.length_cons, List.length_nil, + Nat.reduceAdd, Nat.add_sub_cancel_left] + have hindex : index.val < vector.length := by + simp only [sourceVectorStructuralRecords_length, Fin.is_lt, vector] + rw [List.getD_append vector matrix [] index.val hindex] + exact sourceVectorStructuralRecords_getD + lattice.dimension lattice.target index + +theorem sourceLatticeStructuralRecords_getD_basis + (lattice : GapCVPInstance) + (row column : Fin lattice.dimension) : + (sourceLatticeStructuralRecords lattice).getD + (2 + lattice.dimension + + row.val * lattice.dimension + column.val) [] = + encodeAtomic (lattice.basis row column) := by + let vector := sourceVectorStructuralRecords + lattice.dimension lattice.target + let matrix := sourceMatrixStructuralRecords + lattice.dimension lattice.dimension (Matrix.of.symm lattice.basis) + have hsplit : sourceLatticeStructuralRecords lattice = + [encodeAtomic lattice.dimension, encodeAtomic lattice.radius] ++ + (vector ++ matrix) := by + simp only [sourceLatticeStructuralRecords, List.cons_append, List.nil_append, vector, matrix] + rw [hsplit] + have hprefix : + ([encodeAtomic lattice.dimension, + encodeAtomic lattice.radius] : List (List Bool)).length ≤ + 2 + lattice.dimension + + row.val * lattice.dimension + column.val := by + simp only [List.length_cons, List.length_nil] + omega + rw [List.getD_append_right + [encodeAtomic lattice.dimension, encodeAtomic lattice.radius] + (vector ++ matrix) [] + (2 + lattice.dimension + + row.val * lattice.dimension + column.val) hprefix] + have hfirst : + 2 + lattice.dimension + + row.val * lattice.dimension + column.val - + ([encodeAtomic lattice.dimension, + encodeAtomic lattice.radius] : List (List Bool)).length = + lattice.dimension + row.val * lattice.dimension + column.val := by + simp only [List.length_cons, List.length_nil] + omega + rw [hfirst] + have hvector : vector.length ≤ + lattice.dimension + row.val * lattice.dimension + column.val := by + simp only [vector, sourceVectorStructuralRecords_length] + omega + rw [List.getD_append_right vector matrix [] + (lattice.dimension + row.val * lattice.dimension + column.val) + hvector] + have hsecond : + lattice.dimension + row.val * lattice.dimension + column.val - + vector.length = + row.val * lattice.dimension + column.val := by + simp only [vector, sourceVectorStructuralRecords_length] + omega + rw [hsecond] + exact sourceMatrixStructuralRecords_getD + lattice.dimension lattice.dimension (Matrix.of.symm lattice.basis) + row column + +end BinaryGaussianStructuralRecordIndex + +namespace BinaryPhysicalRowBasisDivisionTM + +open Turing GapCVP.SourceStructuralTuringTM GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceMachineCert GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.SourceMixedRadixUnaryQuotientRemainderTM GapCVP.CNFCappedUnaryPairArithmeticTM + +private def sourcePhysicalComputedUnaryDivisionQuery + (dividend modulus : List Bool → List Bool) + (input : List Bool) : List Bool := + dividend input ++ false :: (modulus input ++ false :: input) + +private noncomputable def sourcePhysicalComputedUnaryDivisionQueryComputable + {dividend modulus : List Bool → List Bool} + (hdividend : BitTM dividend) + (hmodulus : BitTM modulus) : + BitTM + (sourcePhysicalComputedUnaryDivisionQuery dividend modulus) := by + have harchived := pointwiseAppendComputable + hmodulus (prependBitComputable false) + have hdelimiter := GapCVP.TMComposition.computableInPolyTime + harchived (prependBitComputable false) + exact pointwiseAppendComputable hdividend hdelimiter + +private theorem sourcePhysicalComputedUnaryDivisionQuery_valid + (dividend modulus : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hdividend : dividend input = List.replicate first true) + (hmodulus : modulus input = List.replicate second true) : + sourcePhysicalComputedUnaryDivisionQuery dividend modulus input = + sourceUnaryDivisionQuery first second input := by + simp only [sourcePhysicalComputedUnaryDivisionQuery, hdividend, hmodulus, + sourceUnaryDivisionQuery] + +private def sourcePhysicalComputedUnaryDivisionOutput + (dividend modulus : List Bool → List Bool) : List Bool → List Bool := + sourceUnaryDivisionOutput ∘ + sourcePhysicalComputedUnaryDivisionQuery dividend modulus + +private noncomputable def sourcePhysicalComputedUnaryDivisionComputable + {dividend modulus : List Bool → List Bool} + (hdividend : BitTM dividend) + (hmodulus : BitTM modulus) : + BitTM + (sourcePhysicalComputedUnaryDivisionOutput dividend modulus) := + GapCVP.TMComposition.computableInPolyTime + (sourcePhysicalComputedUnaryDivisionQueryComputable + hdividend hmodulus) + sourceUnaryDivisionComputable + +private theorem sourcePhysicalComputedUnaryDivisionOutput_valid + (dividend modulus : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hpositive : 0 < second) + (hdividend : dividend input = List.replicate first true) + (hmodulus : modulus input = List.replicate second true) : + sourcePhysicalComputedUnaryDivisionOutput dividend modulus input = + List.replicate (first / second) true ++ + false :: (List.replicate (first % second) true ++ + false :: sourceUnaryDivisionQuery first second input) := by + unfold sourcePhysicalComputedUnaryDivisionOutput + rw [Function.comp_apply, + sourcePhysicalComputedUnaryDivisionQuery_valid + dividend modulus input first second hdividend hmodulus] + exact sourceUnaryDivisionOutput_valid first second input hpositive + +/-- GapCVP reduction support. -/ +def sourcePhysicalComputedUnaryQuotient + (dividend modulus : List Bool → List Bool) + (input : List Bool) : List Bool := + (unaryPrefixOutput + (sourcePhysicalComputedUnaryDivisionOutput + dividend modulus input)).tail + +/-- GapCVP reduction support. -/ +noncomputable def sourcePhysicalComputedUnaryQuotientComputable + {dividend modulus : List Bool → List Bool} + (hdividend : BitTM dividend) + (hmodulus : BitTM modulus) : + BitTM + (sourcePhysicalComputedUnaryQuotient dividend modulus) := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + (sourcePhysicalComputedUnaryDivisionComputable + hdividend hmodulus) + unaryPrefixComputable) + dropHeadComputable + +theorem sourcePhysicalComputedUnaryQuotient_valid + (dividend modulus : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hpositive : 0 < second) + (hdividend : dividend input = List.replicate first true) + (hmodulus : modulus input = List.replicate second true) : + sourcePhysicalComputedUnaryQuotient dividend modulus input = + List.replicate (first / second) true := by + unfold sourcePhysicalComputedUnaryQuotient + rw [sourcePhysicalComputedUnaryDivisionOutput_valid + dividend modulus input first second hpositive hdividend hmodulus, + unaryPrefixOutput_replicate_delimiter] + rfl + +/-- GapCVP reduction support. -/ +def sourcePhysicalComputedUnaryRemainder + (dividend modulus : List Bool → List Bool) + (input : List Bool) : List Bool := + (unaryPrefixOutput + (unaryPrefixSuffixOutput + (sourcePhysicalComputedUnaryDivisionOutput + dividend modulus input))).tail + +/-- GapCVP reduction support. -/ +noncomputable def sourcePhysicalComputedUnaryRemainderComputable + {dividend modulus : List Bool → List Bool} + (hdividend : BitTM dividend) + (hmodulus : BitTM modulus) : + BitTM + (sourcePhysicalComputedUnaryRemainder dividend modulus) := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + (sourcePhysicalComputedUnaryDivisionComputable + hdividend hmodulus) + actualUnaryPrefixSuffixComputable) + unaryPrefixComputable) + dropHeadComputable + +theorem sourcePhysicalComputedUnaryRemainder_valid + (dividend modulus : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hpositive : 0 < second) + (hdividend : dividend input = List.replicate first true) + (hmodulus : modulus input = List.replicate second true) : + sourcePhysicalComputedUnaryRemainder dividend modulus input = + List.replicate (first % second) true := by + unfold sourcePhysicalComputedUnaryRemainder + rw [sourcePhysicalComputedUnaryDivisionOutput_valid + dividend modulus input first second hpositive hdividend hmodulus, + unaryPrefixSuffixOutput_valid, + unaryPrefixOutput_replicate_delimiter] + rfl + +end BinaryPhysicalRowBasisDivisionTM + +namespace GaussianPhysicalWordRankIndexTM + +open Turing GapCVP.BinaryDimensionTM GapCVP.BinaryGaussianStructuralAtomTM +open GapCVP.BinaryStructuralRecordTM GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +/-- GapCVP reduction support. -/ +def factor400PhysicalWordGaussianTargetCoordinateUnary : + List Bool → List Bool := + unarySubtractionOutput structuralRankUnary structuralRankTwoBound + +/-- GapCVP reduction support. -/ +noncomputable def factor400PhysicalWordGaussianTargetCoordinateComputable : + BitTM + factor400PhysicalWordGaussianTargetCoordinateUnary := + unarySubtractionComputable + structuralRankUnaryComputable structuralRankTwoBoundComputable + +theorem factor400PhysicalWordGaussianTargetCoordinateUnary_query + (dimension : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : + factor400PhysicalWordGaussianTargetCoordinateUnary + (constructiveStructuralRankQuery dimension input rank) = + List.replicate (rank - 2) true := by + exact unarySubtractionOutput_valid + structuralRankUnary structuralRankTwoBound + (constructiveStructuralRankQuery dimension input rank) + rank 2 (structuralRankUnary_query dimension input rank) rfl + +end GaussianPhysicalWordRankIndexTM + +namespace GaussianReducedConsistencyTM + +open Turing GapCVP.GaussianRowWorker GapCVP.GaussianPivotScheduleTM +open GapCVP.GaussianPackedPivotColumnTM GapCVP.SourceFourFamilyBooleanPredicateTM + +/-- GapCVP reduction support. -/ +def binaryGaussianReducedConsistencyWord : List Bool → List Bool := + sourceFourFamilyBooleanNotWord ∘ + binaryGaussianFirstCellWord ∘ + binaryGaussianPivotWord ∘ + binaryGaussianPackedPivotCandidateOutput + +/-- GapCVP reduction support. -/ +noncomputable def binaryGaussianReducedConsistencyComputable : + BitTM + binaryGaussianReducedConsistencyWord := by + have hpivot := GapCVP.TMComposition.computableInPolyTime + binaryGaussianPackedPivotCandidateComputable + binaryGaussianPivotComputable + have hfirst := GapCVP.TMComposition.computableInPolyTime + hpivot binaryGaussianFirstCellComputable + exact GapCVP.TMComposition.computableInPolyTime + hfirst sourceFourFamilyBooleanNotComputable + +private def effectiveGaussianReducedConsistencyRows + (system : GapCVP.Core.BinaryAffineSystem) : List (Bool × Bool) := + (List.finRange system.rowCount).map fun row => + (decide (system.effectiveGaussianState.nextPivot ≤ row.val), + decide (system.effectiveGaussianState.system.rhs row = + (1 : ZMod 2))) + +/-- GapCVP reduction support. -/ +def effectiveGaussianReducedConsistencyQuery + (system : GapCVP.Core.BinaryAffineSystem) + (source : List Bool) : List Bool := + binaryGaussianPackedPivotColumnWord + (effectiveGaussianReducedConsistencyRows system) source + +private def effectiveGaussianReducedInconsistencyBits + (system : GapCVP.Core.BinaryAffineSystem) : List Bool := + (effectiveGaussianReducedConsistencyRows system).map + (fun row => row.1 && row.2) + +private theorem effectiveGaussianReducedInconsistencyBits_find_none_iff + (system : GapCVP.Core.BinaryAffineSystem) : + (effectiveGaussianReducedInconsistencyBits system).findIdx? id = none ↔ + system.effectiveReducedConsistent = true := by + rw [List.findIdx?_eq_none_iff, + GapCVP.Core.BinaryAffineSystem.effectiveReducedConsistent_iff] + constructor + · intro hnone row hrow + have hpair : + (decide (system.effectiveGaussianState.nextPivot ≤ row.val), + decide (system.effectiveGaussianState.system.rhs row = + (1 : ZMod 2))) ∈ + effectiveGaussianReducedConsistencyRows system := by + apply List.mem_map.mpr + exact ⟨row, List.mem_finRange row, rfl⟩ + have hbit : + (decide (system.effectiveGaussianState.nextPivot ≤ row.val) && + decide (system.effectiveGaussianState.system.rhs row = + (1 : ZMod 2))) ∈ + effectiveGaussianReducedInconsistencyBits system := by + apply List.mem_map.mpr + exact ⟨_, hpair, rfl⟩ + have hfalse := hnone _ hbit + have hne : + system.effectiveGaussianState.system.rhs row ≠ + (1 : ZMod 2) := by + intro hone + simp only [hrow, decide_true, hone, Bool.and_self, id_eq, Bool.true_eq_false] at hfalse + exact GapCVP.Core.EffectiveBinaryGaussian.binary_eq_zero_of_ne_one + _ hne + · intro hconsistent bit hbit + obtain ⟨pair, hpair, rfl⟩ := List.mem_map.mp hbit + obtain ⟨row, _, hrow⟩ := List.mem_map.mp hpair + subst pair + by_cases heligible : + system.effectiveGaussianState.nextPivot ≤ row.val + · have hrhs := hconsistent row heligible + simp only [heligible, decide_true, hrhs, zero_ne_one, decide_false, Bool.and_false, id_eq] + · simp only [heligible, decide_false, Bool.false_and, id_eq] + +theorem binaryGaussianReducedConsistencyWord_effective + (system : GapCVP.Core.BinaryAffineSystem) + (source : List Bool) : + binaryGaussianReducedConsistencyWord + (effectiveGaussianReducedConsistencyQuery system source) = + [system.effectiveReducedConsistent] := by + change + sourceFourFamilyBooleanNotWord + (binaryGaussianFirstCellWord + (binaryGaussianPivotWord + (binaryGaussianPackedPivotCandidateOutput + (effectiveGaussianReducedConsistencyQuery + system source)))) = + [system.effectiveReducedConsistent] + simp only [effectiveGaussianReducedConsistencyQuery] + rw [binaryGaussianPackedPivotCandidateOutput_valid] + change + sourceFourFamilyBooleanNotWord + (binaryGaussianFirstCellWord + (binaryGaussianPivotWord + (effectiveGaussianReducedInconsistencyBits system))) = + [system.effectiveReducedConsistent] + cases hfind : + (effectiveGaussianReducedInconsistencyBits system).findIdx? id with + | none => + have hconsistent : system.effectiveReducedConsistent = true := + (effectiveGaussianReducedInconsistencyBits_find_none_iff + system).mp hfind + simp only [binaryGaussianPivotWord, hfind, binaryGaussianFirstCellWord_valid, + sourceFourFamilyBooleanNotWord_bit, Bool.not_false, hconsistent] + | some index => + have hnot : system.effectiveReducedConsistent ≠ true := by + intro hconsistent + have hnone := + (effectiveGaussianReducedInconsistencyBits_find_none_iff + system).mpr hconsistent + simp only [hfind, reduceCtorEq] at hnone + have hfalse : system.effectiveReducedConsistent = false := by + cases h : system.effectiveReducedConsistent with + | false => rfl + | true => exact (hnot h).elim + simp only [binaryGaussianPivotWord, hfind, binaryGaussianFirstCellWord_valid, + sourceFourFamilyBooleanNotWord_bit, Bool.not_true, hfalse] + +end GaussianReducedConsistencyTM + +namespace GaussianAdaptiveEliminationCorrectness + +open GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.GaussianPivotScheduleTM +open GapCVP.GaussianPackedPivotColumnTM + +theorem finRange_idxOfOption_eq_some + {count : ℕ} (row : Fin count) : + (List.finRange count).idxOf? row = some row.val := by + apply (List.idxOf?_eq_some_iff).mpr + have hposition : row.val < (List.finRange count).length := by + simpa only [List.length_finRange] using row.isLt + refine ⟨hposition, ?_, ?_⟩ + · simp only [List.getElem_finRange, Fin.cast_mk, Fin.eta] + · intro position hposition hequal + have hvalue := congrArg Fin.val hequal + simp only [List.getElem_finRange, Fin.cast_mk] at hvalue + omega + +private theorem effectiveGaussianPivotCandidates_findIdxOption + {m n : ℕ} (state : State m n) (column : Fin n) : + (effectiveGaussianPivotCandidates state column).findIdx? id = + (findPivotOption state column).map Fin.val := by + unfold effectiveGaussianPivotCandidates findPivotOption + rw [List.findIdx?_map, List.findIdx?_eq_bind_find?_idxOf?] + change + ((List.finRange m).find? + (fun row => decide + (state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2)))).bind + (fun row => (List.finRange m).idxOf? row) = + ((List.finRange m).find? + (fun row => decide + (state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2)))).map + Fin.val + cases (List.finRange m).find? + (fun row => decide + (state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2))) with + | none => rfl + | some row => + simpa only [Option.bind_some, Option.map_some] using finRange_idxOfOption_eq_some row + +theorem binaryGaussianPivotWord_effective + {m n : ℕ} (state : State m n) (column : Fin n) : + binaryGaussianPivotWord + (effectiveGaussianPivotCandidates state column) = + match findPivotOption state column with + | none => [false] + | some row => true :: List.replicate row.val true := by + unfold binaryGaussianPivotWord + rw [effectiveGaussianPivotCandidates_findIdxOption] + cases findPivotOption state column <;> rfl + +/-- GapCVP reduction support. -/ +def effectiveGaussianPackedCheckBits + {m n : ℕ} (state : State m n) : List Bool := + (List.finRange m).flatMap fun row => + (List.finRange n).map fun column => + decide (state.system.check row column = (1 : ZMod 2)) + +/-- GapCVP reduction support. -/ +def effectiveGaussianPackedRhsBits + {m n : ℕ} (state : State m n) : List Bool := + (List.finRange m).map fun row => + decide (state.system.rhs row = (1 : ZMod 2)) + +/-- GapCVP reduction support. -/ +def effectiveGaussianStatePivotRowOption + {m n : ℕ} (state : State m n) (column : Fin n) : Option (Fin m) := + (state.pivots.find? fun pivot => + decide (pivot.2 = column)).map Prod.fst + +/-- GapCVP reduction support. -/ +def effectiveGaussianStatePivotWord + {m n : ℕ} (state : State m n) (column : Fin n) : List Bool := + match effectiveGaussianStatePivotRowOption state column with + | none => [false] + | some row => true :: List.replicate row.val true + +/-- GapCVP reduction support. -/ +def effectiveGaussianStateReducedConsistencyRows + {m n : ℕ} (state : State m n) : List (Bool × Bool) := + (List.finRange m).map fun row => + (decide (state.nextPivot ≤ row.val), + decide (state.system.rhs row = (1 : ZMod 2))) + +/-- GapCVP reduction support. -/ +def effectiveGaussianStateReducedConsistencyQuery + {m n : ℕ} (state : State m n) (source : List Bool) : List Bool := + binaryGaussianPackedPivotColumnWord + (effectiveGaussianStateReducedConsistencyRows state) source + +theorem effectiveGaussianStatePivotRow_effective + (system : BinaryAffineSystem) (column : Fin system.dimension) : + effectiveGaussianStatePivotRowOption + system.effectiveGaussianState column = + system.effectivePivotRowOption column := by + rfl + +end GaussianAdaptiveEliminationCorrectness + +namespace BinaryPhysicalWordEntries + +open scoped BigOperators + +open GapCVP.Core + +attribute [local instance] Classical.propDecidable + +theorem binaryFieldParityMatrix_apply_basisCoordinate + {K : Type*} [Field K] [Algebra (ZMod 2) K] + {degree fieldRowCount dimension : ℕ} + (basis : Module.Basis (Fin degree) (ZMod 2) K) + (checks : Matrix (Fin fieldRowCount) (Fin dimension) K) + (row : Fin fieldRowCount) + (coordinate : Fin degree) + (column : Fin dimension) : + binaryFieldParityMatrix basis checks + (row, coordinate) column = + basis.equivFun (checks row column) coordinate := by + simp only [binaryFieldParityMatrix, binaryFieldParityLinearMap, binaryFieldVectorEquiv, + binaryFieldBitEmbedding, LinearMap.toMatrix'_apply, LinearMap.coe_comp, LinearEquiv.coe_coe, + LinearMap.coe_restrictScalars, Function.comp_apply, Matrix.mulVecBilin_apply, + LinearEquiv.trans_apply, + LinearEquiv.coe_curry_symm, Function.uncurry_apply_pair, LinearEquiv.piCongrRight_apply, + Matrix.mulVec, dotProduct, + LinearMap.pi_apply, LinearMap.coe_proj, Function.eval, Pi.single_apply, + Algebra.linearMap_apply, + MonoidWithZeroHom.map_ite_one_zero, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', + Finset.mem_univ, ↓reduceIte, + Module.Basis.equivFun_apply] + +end BinaryPhysicalWordEntries + +namespace BinarySourceFieldMultiplicationTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.BinaryModularReductionTM + +/-- GapCVP reduction support. -/ +def factor400BinarySourceFieldQuery + (lower left right source : List Bool) : List Bool := + lengthPrefixedWord lower ++ + lengthPrefixedWord left ++ + lengthPrefixedWord right ++ source + +/-- GapCVP reduction support. -/ +def factor400BinarySourceLowerBits : List Bool → List Bool := + firstFieldContents + +/-- GapCVP reduction support. -/ +def factor400BinarySourceLeftBits : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +def factor400BinarySourceRightBits : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +def factor400BinarySourceFieldSuffix : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def binarySourceLowerBitsComputable : + BitTM + factor400BinarySourceLowerBits := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +noncomputable def binarySourceLeftBitsComputable : + BitTM + factor400BinarySourceLeftBits := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +noncomputable def binarySourceRightBitsComputable : + BitTM + factor400BinarySourceRightBits := by + exact GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable) + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +noncomputable def factor400BinarySourceFieldSuffixComputable : + BitTM + factor400BinarySourceFieldSuffix := by + exact GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable) + firstFieldSuffixComputable + +@[simp] theorem factor400BinarySourceLowerBits_query + (lower left right source : List Bool) : + factor400BinarySourceLowerBits + (factor400BinarySourceFieldQuery lower left right source) = lower := by + simp only [factor400BinarySourceLowerBits, factor400BinarySourceFieldQuery, List.append_assoc, + firstFieldContents_valid] + +@[simp] theorem factor400BinarySourceLeftBits_query + (lower left right source : List Bool) : + factor400BinarySourceLeftBits + (factor400BinarySourceFieldQuery lower left right source) = left := by + simp only [factor400BinarySourceLeftBits, factor400BinarySourceFieldQuery, List.append_assoc, + Function.comp_apply, firstFieldSuffix_valid, firstFieldContents_valid] + +@[simp] theorem factor400BinarySourceRightBits_query + (lower left right source : List Bool) : + factor400BinarySourceRightBits + (factor400BinarySourceFieldQuery lower left right source) = right := by + simp only [factor400BinarySourceRightBits, factor400BinarySourceFieldQuery, List.append_assoc, + Function.comp_apply, firstFieldSuffix_valid, firstFieldContents_valid] + +@[simp] theorem factor400BinarySourceFieldSuffix_query + (lower left right source : List Bool) : + factor400BinarySourceFieldSuffix + (factor400BinarySourceFieldQuery lower left right source) = source := by + simp only [factor400BinarySourceFieldSuffix, factor400BinarySourceFieldQuery, List.append_assoc, + Function.comp_apply, firstFieldSuffix_valid] + +/-- GapCVP reduction support. -/ +def factor400BinarySourcePaddedWord + (degree : ℕ) (bits : List Bool) : + GapCVP.Core.EffectiveBinaryField.Word degree := + fun position => bits.getD position.val false + +@[simp] theorem factor400BinaryFiniteWordBits_length + {degree : ℕ} + (word : GapCVP.Core.EffectiveBinaryField.Word degree) : + (finiteWordBits word).length = degree := by + simp only [finiteWordBits, List.length_map, List.length_finRange] + +@[simp] theorem factor400BinarySourcePaddedWord_finiteWordBits + {degree : ℕ} + (word : GapCVP.Core.EffectiveBinaryField.Word degree) : + factor400BinarySourcePaddedWord degree (finiteWordBits word) = word := by + funext position + unfold factor400BinarySourcePaddedWord finiteWordBits + have hposition : position.val < + ((List.finRange degree).map word).length := by + simp only [List.length_map, List.length_finRange, Fin.is_lt] + rw [List.getD_eq_getElem _ false hposition] + simp only [List.getElem_map, List.getElem_finRange, Fin.cast_mk, Fin.eta] + +/-- GapCVP reduction support. -/ +def binarySourceMultiplyModWord + (input : List Bool) : List Bool := + match readLengthPrefixedWord input with + | none => [] + | some (lowerBits, lowerSuffix) => + match readLengthPrefixedWord lowerSuffix with + | none => [] + | some (leftBits, leftSuffix) => + match readLengthPrefixedWord leftSuffix with + | none => [] + | some (rightBits, _) => + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyMod + (factor400BinarySourcePaddedWord leftBits.length lowerBits) + (factor400BinarySourcePaddedWord leftBits.length leftBits) + (factor400BinarySourcePaddedWord leftBits.length rightBits)) + +theorem binarySourceMultiplyModWord_valid + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + binarySourceMultiplyModWord + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyMod lower left right) := by + simp only [binarySourceMultiplyModWord, factor400BinarySourceFieldQuery, List.append_assoc, + readLengthPrefixedWord_append] + rw [factor400BinaryFiniteWordBits_length left] + simp only [factor400BinarySourcePaddedWord_finiteWordBits] + +end BinarySourceFieldMultiplicationTM + +namespace BinaryPhysicalLagrangeProductFoldTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceMixedRadixPolynomialPaddedDescriptorFoldTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryModularReductionTM +open GapCVP.BinarySourceFieldMultiplicationTM + +private def sourcePhysicalLagrangeProductAnchor + (state : List Bool) : List Bool := + firstFieldContents state + +/-- GapCVP reduction support. -/ +def sourcePhysicalLagrangeProductAccumulator + (state : List Bool) : List Bool := + firstFieldContents (firstFieldSuffix state) + +private def sourcePhysicalLagrangeProductFactor + (state : List Bool) : List Bool := + firstFieldContents (firstFieldSuffix (firstFieldSuffix state)) + +private def sourcePhysicalLagrangeProductRemaining + (state : List Bool) : List Bool := + firstFieldSuffix + (firstFieldSuffix (firstFieldSuffix state)) + +private def sourcePhysicalLagrangeProductModulus + (state : List Bool) : List Bool := + firstFieldContents (sourcePhysicalLagrangeProductAnchor state) + +private def sourcePhysicalLagrangeProductOriginalSource + (state : List Bool) : List Bool := + firstFieldSuffix (sourcePhysicalLagrangeProductAnchor state) + +private noncomputable def sourcePhysicalLagrangeProductAnchorComputable : + BitTM + sourcePhysicalLagrangeProductAnchor := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +noncomputable def sourcePhysicalLagrangeProductAccumulatorComputable : + BitTM + sourcePhysicalLagrangeProductAccumulator := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + +private noncomputable def sourcePhysicalLagrangeProductFactorComputable : + BitTM + sourcePhysicalLagrangeProductFactor := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable) + firstFieldContentsComputable + +private noncomputable def sourcePhysicalLagrangeProductRemainingComputable : + BitTM + sourcePhysicalLagrangeProductRemaining := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable) + firstFieldSuffixComputable + +private noncomputable def sourcePhysicalLagrangeProductModulusComputable : + BitTM + sourcePhysicalLagrangeProductModulus := + GapCVP.TMComposition.computableInPolyTime + sourcePhysicalLagrangeProductAnchorComputable + firstFieldContentsComputable + +private noncomputable def sourcePhysicalLagrangeProductOriginalSourceComputable : + BitTM + sourcePhysicalLagrangeProductOriginalSource := + GapCVP.TMComposition.computableInPolyTime + sourcePhysicalLagrangeProductAnchorComputable + firstFieldSuffixComputable + +private def sourcePhysicalLagrangeProductFieldQuery + (state : List Bool) : List Bool := + factor400BinarySourceFieldQuery + (sourcePhysicalLagrangeProductModulus state) + (sourcePhysicalLagrangeProductAccumulator state) + (sourcePhysicalLagrangeProductFactor state) + (sourcePhysicalLagrangeProductOriginalSource state) + +private noncomputable def sourcePhysicalLagrangeProductFieldQueryComputable : + BitTM + sourcePhysicalLagrangeProductFieldQuery := by + have hprefixed + (worker : List Bool → List Bool) + (hworker : BitTM worker) : + BitTM + (fun input => lengthPrefixedWord (worker input)) := by + have h := GapCVP.TMComposition.computableInPolyTime + hworker structuralPrefixWriterComputable + simpa only [Function.comp_def] using h + have htail := pointwiseAppendComputable + (hprefixed sourcePhysicalLagrangeProductFactor + sourcePhysicalLagrangeProductFactorComputable) + sourcePhysicalLagrangeProductOriginalSourceComputable + have hmiddle := pointwiseAppendComputable + (hprefixed sourcePhysicalLagrangeProductAccumulator + sourcePhysicalLagrangeProductAccumulatorComputable) htail + have hfull := pointwiseAppendComputable + (hprefixed sourcePhysicalLagrangeProductModulus + sourcePhysicalLagrangeProductModulusComputable) hmiddle + change BitTM + (fun state => factor400BinarySourceFieldQuery + (sourcePhysicalLagrangeProductModulus state) + (sourcePhysicalLagrangeProductAccumulator state) + (sourcePhysicalLagrangeProductFactor state) + (sourcePhysicalLagrangeProductOriginalSource state)) + simpa only [factor400BinarySourceFieldQuery, List.append_assoc] using hfull + +private def sourcePhysicalLagrangeProductNext + (state : List Bool) : List Bool := + binarySourceMultiplyModWord + (sourcePhysicalLagrangeProductFieldQuery state) + +private noncomputable def sourcePhysicalLagrangeProductNextComputable + (multiplyComputer : BitTM binarySourceMultiplyModWord) : + BitTM + sourcePhysicalLagrangeProductNext := by + have h := GapCVP.TMComposition.computableInPolyTime + sourcePhysicalLagrangeProductFieldQueryComputable + multiplyComputer + change BitTM + (fun state => binarySourceMultiplyModWord + (sourcePhysicalLagrangeProductFieldQuery state)) + simpa only [Function.comp_def] using h + +private def sourcePhysicalLagrangeProductStep + (state : List Bool) : List Bool := + lengthPrefixedWord + (sourcePhysicalLagrangeProductAnchor state) ++ + lengthPrefixedWord + (sourcePhysicalLagrangeProductNext state) ++ + sourcePhysicalLagrangeProductRemaining state + +private noncomputable def sourcePhysicalLagrangeProductStepComputable + (multiplyComputer : BitTM binarySourceMultiplyModWord) : + BitTM + sourcePhysicalLagrangeProductStep := by + have hprefixed + (worker : List Bool → List Bool) + (hworker : BitTM worker) : + BitTM + (fun input => lengthPrefixedWord (worker input)) := by + have h := GapCVP.TMComposition.computableInPolyTime + hworker structuralPrefixWriterComputable + simpa only [Function.comp_def] using h + have htail := pointwiseAppendComputable + (hprefixed sourcePhysicalLagrangeProductNext + (sourcePhysicalLagrangeProductNextComputable multiplyComputer)) + sourcePhysicalLagrangeProductRemainingComputable + have hfull := pointwiseAppendComputable + (hprefixed sourcePhysicalLagrangeProductAnchor + sourcePhysicalLagrangeProductAnchorComputable) htail + change BitTM + (fun state => lengthPrefixedWord + (sourcePhysicalLagrangeProductAnchor state) ++ + lengthPrefixedWord + (sourcePhysicalLagrangeProductNext state) ++ + sourcePhysicalLagrangeProductRemaining state) + simpa only [List.append_assoc] using hfull + +private theorem sourcePhysicalLagrangeProductNext_length + (state : List Bool) : + (sourcePhysicalLagrangeProductNext state).length = + (sourcePhysicalLagrangeProductAccumulator state).length := by + simp only [sourcePhysicalLagrangeProductNext, binarySourceMultiplyModWord, + sourcePhysicalLagrangeProductFieldQuery, factor400BinarySourceFieldQuery, List.append_assoc, + readLengthPrefixedWord_append, finiteWordBits, List.length_map, List.length_finRange] + +@[simp] private theorem sourcePhysicalLagrangeProductStep_anchor + (state : List Bool) : + sourcePhysicalLagrangeProductAnchor + (sourcePhysicalLagrangeProductStep state) = + sourcePhysicalLagrangeProductAnchor state := by + simp only [sourcePhysicalLagrangeProductAnchor, sourcePhysicalLagrangeProductStep, + List.append_assoc, + firstFieldContents_valid] + +@[simp] private theorem sourcePhysicalLagrangeProductStep_accumulator + (state : List Bool) : + sourcePhysicalLagrangeProductAccumulator + (sourcePhysicalLagrangeProductStep state) = + sourcePhysicalLagrangeProductNext state := by + simp only [sourcePhysicalLagrangeProductAccumulator, sourcePhysicalLagrangeProductStep, + List.append_assoc, + firstFieldSuffix_valid, firstFieldContents_valid] + +@[simp] private theorem sourcePhysicalLagrangeProductStep_remaining + (state : List Bool) : + firstFieldSuffix + (firstFieldSuffix (sourcePhysicalLagrangeProductStep state)) = + sourcePhysicalLagrangeProductRemaining state := by + simp only [sourcePhysicalLagrangeProductStep, List.append_assoc, firstFieldSuffix_valid] + +private theorem sourcePhysicalLagrangeProduct_iterate_anchor + (state : List Bool) (stage : ℕ) : + sourcePhysicalLagrangeProductAnchor + (((sourcePhysicalLagrangeProductStep)^[stage]) state) = + sourcePhysicalLagrangeProductAnchor state := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq] + | succ stage ih => + rw [Function.iterate_succ_apply'] + simpa only [sourcePhysicalLagrangeProductStep_anchor] using ih + +private theorem sourcePhysicalLagrangeProduct_iterate_accumulator_length + (state : List Bool) (stage : ℕ) : + (sourcePhysicalLagrangeProductAccumulator + (((sourcePhysicalLagrangeProductStep)^[stage]) state)).length = + (sourcePhysicalLagrangeProductAccumulator state).length := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq] + | succ stage ih => + rw [Function.iterate_succ_apply', + sourcePhysicalLagrangeProductStep_accumulator, + sourcePhysicalLagrangeProductNext_length] + exact ih + +private theorem sourcePhysicalLagrangeProductSuffix_length_le + (state : List Bool) : + (firstFieldSuffix state).length ≤ state.length := + sourceMixedRadixPhysicalFirstFieldSuffix_length_le state + +private theorem sourcePhysicalLagrangeProduct_iterate_pending_length_le + (state : List Bool) (stage : ℕ) : + (firstFieldSuffix (firstFieldSuffix + (((sourcePhysicalLagrangeProductStep)^[stage]) state))).length ≤ + (firstFieldSuffix (firstFieldSuffix state)).length := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply', + sourcePhysicalLagrangeProductStep_remaining] + exact (sourcePhysicalLagrangeProductSuffix_length_le + (firstFieldSuffix + (firstFieldSuffix + (((sourcePhysicalLagrangeProductStep)^[stage]) state)))).trans ih + +private theorem sourcePhysicalLagrangeProduct_iterate_length_le + (state : List Bool) (stage : ℕ) : + (((sourcePhysicalLagrangeProductStep)^[stage]) state).length ≤ + 5 * state.length + 2 := by + cases stage with + | zero => simp only [Function.iterate_zero, id_eq]; omega + | succ stage => + rw [Function.iterate_succ_apply'] + let current := ((sourcePhysicalLagrangeProductStep)^[stage]) state + have hanchor := sourceMixedRadixPhysicalFirstFieldContents_length_le + state + have haccContents := + sourceMixedRadixPhysicalFirstFieldContents_length_le + (firstFieldSuffix state) + have haccSuffix := + sourcePhysicalLagrangeProductSuffix_length_le state + have hacc : + (sourcePhysicalLagrangeProductAccumulator state).length ≤ + state.length := by + exact haccContents.trans haccSuffix + have hpending₁ := + sourcePhysicalLagrangeProductSuffix_length_le state + have hpending₂ := + sourcePhysicalLagrangeProductSuffix_length_le + (firstFieldSuffix state) + have hpending : + (firstFieldSuffix (firstFieldSuffix current)).length ≤ + state.length := + (sourcePhysicalLagrangeProduct_iterate_pending_length_le + state stage).trans (hpending₂.trans hpending₁) + have hremaining := + (sourcePhysicalLagrangeProductSuffix_length_le + (firstFieldSuffix (firstFieldSuffix current))).trans hpending + have hcurrentAnchor := + sourcePhysicalLagrangeProduct_iterate_anchor state stage + have hcurrentAccumulator := + sourcePhysicalLagrangeProduct_iterate_accumulator_length + state stage + change (sourcePhysicalLagrangeProductStep current).length ≤ _ + simp only [sourcePhysicalLagrangeProductStep, + List.length_append, lengthPrefixedWord_length, + sourcePhysicalLagrangeProductNext_length] + change + (2 * (sourcePhysicalLagrangeProductAnchor current).length + 1) + + (2 * (sourcePhysicalLagrangeProductAccumulator current).length + 1) + + (firstFieldSuffix + (firstFieldSuffix (firstFieldSuffix current))).length ≤ + 5 * state.length + 2 + have hanchor' : + (sourcePhysicalLagrangeProductAnchor current).length ≤ + state.length := by + simpa only using hcurrentAnchor.symm ▸ hanchor + have hacc' : + (sourcePhysicalLagrangeProductAccumulator current).length ≤ + state.length := by + simpa only using hcurrentAccumulator.symm ▸ hacc + omega + +private def sourcePhysicalLagrangeProductStatePolynomial : Polynomial ℕ := + 5 * Polynomial.X + 2 + +private theorem sourcePhysicalLagrangeProduct_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates sourcePhysicalLagrangeProductStep + sourcePhysicalLagrangeProductStatePolynomial := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage _ + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + have hstage := sourcePhysicalLagrangeProduct_iterate_length_le + seed stage + change + (((sourcePhysicalLagrangeProductStep)^[stage]) seed).length ≤ + sourcePhysicalLagrangeProductStatePolynomial.eval input.length + simp only [sourcePhysicalLagrangeProductStatePolynomial, + Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + omega + +/-- GapCVP reduction support. -/ +def sourcePhysicalLagrangeProductFoldOutput : List Bool → List Bool := + boundedRecordFoldOutput sourcePhysicalLagrangeProductStep + +/-- GapCVP reduction support. -/ +noncomputable def sourcePhysicalLagrangeProductFoldComputable + (multiplyComputer : BitTM binarySourceMultiplyModWord) : + BitTM + sourcePhysicalLagrangeProductFoldOutput := + boundedDependentRecordFoldComputable + (sourcePhysicalLagrangeProductStepComputable multiplyComputer) + sourcePhysicalLagrangeProductStatePolynomial + sourcePhysicalLagrangeProduct_polynomiallyBoundedFoldStates + +/-- GapCVP reduction support. -/ +def sourcePhysicalLagrangePackedFactorWords + {degree : ℕ} + (factors : List (GapCVP.Core.EffectiveBinaryField.Word degree)) : + List Bool := + factors.flatMap + (fun factor => lengthPrefixedWord (finiteWordBits factor)) + +/-- GapCVP reduction support. -/ +def sourcePhysicalLagrangeProductSourceAnchor + {degree : ℕ} + (lower : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : List Bool := + lengthPrefixedWord (finiteWordBits lower) ++ source + +private def sourcePhysicalLagrangeProductSeed + {degree : ℕ} + (lower initial : GapCVP.Core.EffectiveBinaryField.Word degree) + (factors : List (GapCVP.Core.EffectiveBinaryField.Word degree)) + (source : List Bool) : List Bool := + lengthPrefixedWord + (sourcePhysicalLagrangeProductSourceAnchor lower source) ++ + lengthPrefixedWord (finiteWordBits initial) ++ + sourcePhysicalLagrangePackedFactorWords factors + +private theorem sourcePhysicalLagrangeProductStep_valid + {degree : ℕ} + (lower current factor : GapCVP.Core.EffectiveBinaryField.Word degree) + (source pending : List Bool) : + sourcePhysicalLagrangeProductStep + (lengthPrefixedWord + (sourcePhysicalLagrangeProductSourceAnchor lower source) ++ + lengthPrefixedWord (finiteWordBits current) ++ + lengthPrefixedWord (finiteWordBits factor) ++ pending) = + lengthPrefixedWord + (sourcePhysicalLagrangeProductSourceAnchor lower source) ++ + lengthPrefixedWord + (finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyMod + lower current factor)) ++ pending := by + simp only [sourcePhysicalLagrangeProductStep, sourcePhysicalLagrangeProductAnchor, + sourcePhysicalLagrangeProductSourceAnchor, List.append_assoc, firstFieldContents_valid, + sourcePhysicalLagrangeProductNext, sourcePhysicalLagrangeProductFieldQuery, + sourcePhysicalLagrangeProductModulus, + sourcePhysicalLagrangeProductAccumulator, firstFieldSuffix_valid, + sourcePhysicalLagrangeProductFactor, + sourcePhysicalLagrangeProductOriginalSource, binarySourceMultiplyModWord_valid, + sourcePhysicalLagrangeProductRemaining] + +private theorem sourcePhysicalLagrangeProduct_iterate_valid + {degree : ℕ} + (lower initial : GapCVP.Core.EffectiveBinaryField.Word degree) + (factors : List (GapCVP.Core.EffectiveBinaryField.Word degree)) + (source : List Bool) : + ((sourcePhysicalLagrangeProductStep)^[factors.length]) + (sourcePhysicalLagrangeProductSeed + lower initial factors source) = + lengthPrefixedWord + (sourcePhysicalLagrangeProductSourceAnchor lower source) ++ + lengthPrefixedWord + (finiteWordBits + (factors.foldl + (GapCVP.Core.EffectiveBinaryField.multiplyMod lower) + initial)) := by + induction factors generalizing initial with + | nil => + simp only [List.length_nil, sourcePhysicalLagrangeProductSeed, + sourcePhysicalLagrangePackedFactorWords, + List.flatMap_nil, List.append_nil, Function.iterate_zero, id_eq, List.foldl_nil] + | cons factor factors ih => + rw [List.length_cons, Function.iterate_succ_apply] + unfold sourcePhysicalLagrangeProductSeed + sourcePhysicalLagrangePackedFactorWords + simp only [List.flatMap_cons] + have hstate : + lengthPrefixedWord + (sourcePhysicalLagrangeProductSourceAnchor lower source) ++ + lengthPrefixedWord (finiteWordBits initial) ++ + (lengthPrefixedWord (finiteWordBits factor) ++ + factors.flatMap + (fun item => lengthPrefixedWord + (finiteWordBits item))) = + lengthPrefixedWord + (sourcePhysicalLagrangeProductSourceAnchor lower source) ++ + lengthPrefixedWord (finiteWordBits initial) ++ + lengthPrefixedWord (finiteWordBits factor) ++ + factors.flatMap + (fun item => lengthPrefixedWord + (finiteWordBits item)) := by + simp only [List.append_assoc] + rw [hstate] + rw [sourcePhysicalLagrangeProductStep_valid] + change + ((sourcePhysicalLagrangeProductStep)^[factors.length]) + (sourcePhysicalLagrangeProductSeed + lower + (GapCVP.Core.EffectiveBinaryField.multiplyMod + lower initial factor) + factors source) = _ + simpa only [List.foldl_cons] using ih (GapCVP.Core.EffectiveBinaryField.multiplyMod lower + initial factor) + +/-- GapCVP reduction support. -/ +def sourcePhysicalLagrangeProductFoldWord + {degree : ℕ} + (lower initial : GapCVP.Core.EffectiveBinaryField.Word degree) + (factors : List (GapCVP.Core.EffectiveBinaryField.Word degree)) + (source : List Bool) : List Bool := + unaryBoundedFoldWord factors.length + (sourcePhysicalLagrangeProductSeed lower initial factors source) + +theorem sourcePhysicalLagrangeProductFoldOutput_valid + {degree : ℕ} + (lower initial : GapCVP.Core.EffectiveBinaryField.Word degree) + (factors : List (GapCVP.Core.EffectiveBinaryField.Word degree)) + (source : List Bool) : + sourcePhysicalLagrangeProductFoldOutput + (sourcePhysicalLagrangeProductFoldWord + lower initial factors source) = + lengthPrefixedWord + (sourcePhysicalLagrangeProductSourceAnchor lower source) ++ + lengthPrefixedWord + (finiteWordBits + (factors.foldl + (GapCVP.Core.EffectiveBinaryField.multiplyMod lower) + initial)) := by + unfold sourcePhysicalLagrangeProductFoldOutput + sourcePhysicalLagrangeProductFoldWord + boundedRecordFoldOutput + rw [parseUnaryBoundedFold_word] + exact sourcePhysicalLagrangeProduct_iterate_valid + lower initial factors source + +end BinaryPhysicalLagrangeProductFoldTM + +namespace BinaryFieldInverseAlgebra + +open GapCVP.Core GapCVP.Core.EffectiveBinaryField Polynomial +open scoped BigOperators + +/-- GapCVP reduction support. -/ +def zeroWord (degree : ℕ) : EffectiveBinaryField.Word degree := + fun _ => false + +/-- GapCVP reduction support. -/ +def oneWord (degree : ℕ) : EffectiveBinaryField.Word degree := + fun bit => decide (bit.val = 0) + +theorem wordPolynomial_zeroWord (degree : ℕ) : + EffectiveBinaryField.wordPolynomial (zeroWord degree) = 0 := by + classical + apply Polynomial.ext + intro index + by_cases hindex : index < degree + · let bit : Fin degree := ⟨index, hindex⟩ + change + (EffectiveBinaryField.wordPolynomial + (zeroWord degree)).coeff bit.val = + (0 : (ZMod 2)[X]).coeff bit.val + rw [EffectiveBinaryField.wordPolynomial_coeff_fin] + simp only [bitValue, zeroWord, Bool.false_eq_true, ↓reduceIte, coeff_zero] + · rw [EffectiveBinaryField.wordPolynomial_coeff_eq_zero + (zeroWord degree) index (Nat.le_of_not_gt hindex)] + simp only [coeff_zero] + +private theorem wordPolynomial_oneWord + (degree : ℕ) (hdegree : 0 < degree) : + EffectiveBinaryField.wordPolynomial (oneWord degree) = 1 := by + classical + apply Polynomial.ext + intro index + by_cases hindex : index < degree + · let bit : Fin degree := ⟨index, hindex⟩ + change + (EffectiveBinaryField.wordPolynomial + (oneWord degree)).coeff bit.val = + (1 : (ZMod 2)[X]).coeff bit.val + rw [EffectiveBinaryField.wordPolynomial_coeff_fin] + simp only [bitValue, oneWord, decide_eq_true_eq, coeff_one] + · rw [EffectiveBinaryField.wordPolynomial_coeff_eq_zero + (oneWord degree) index (Nat.le_of_not_gt hindex)] + have hnonzero : index ≠ 0 := by + omega + simp only [coeff_one, hnonzero, ↓reduceIte] + +private theorem wordPolynomial_foldl_xorAt {d : ℕ} {α : Type} + (items : List α) (index : α → Fin d) (bit : α → Bool) + (word : Word d) : + wordPolynomial + (items.foldl (fun accumulator item => + xorAt accumulator (index item) (bit item)) word) = + wordPolynomial word + + (items.map fun item => + Polynomial.monomial (index item).val + (bitValue (bit item))).sum := by + induction items generalizing word with + | nil => simp only [List.foldl_nil, List.map_nil, List.sum_nil, add_zero] + | cons item rest ih => + simp only [List.foldl_cons, List.map_cons, List.sum_cons] + rw [ih (xorAt word (index item) (bit item)), + wordPolynomial_xorAt] + ac_rfl + +private theorem finRange_polynomial_sum {e : ℕ} + (f : Fin e → (ZMod 2)[X]) : + ((List.finRange e).map f).sum = ∑ i : Fin e, f i := by + rfl + +theorem wordPolynomial_shiftXor {e : ℕ} + (lower : Word e) (degree : ℕ) (word : Word (2 * e)) + (hdegree : e ≤ degree ∧ degree < 2 * e) : + wordPolynomial (shiftXor lower degree word) = + wordPolynomial word + + Polynomial.X ^ (degree - e) * wordPolynomial lower := by + classical + have hbound (i : Fin e) : degree - e + i.val < 2 * e := by + have hi := i.isLt + omega + let shiftedIndex : Fin e → Fin (2 * e) := + fun i => ⟨degree - e + i.val, hbound i⟩ + have hstep : + (fun (accumulator : Word (2 * e)) (i : Fin e) => + if h : degree - e + i.val < 2 * e then + xorAt accumulator ⟨degree - e + i.val, h⟩ (lower i) + else accumulator) = + (fun accumulator i => + xorAt accumulator (shiftedIndex i) (lower i)) := by + funext accumulator i + simp only [hbound i, ↓reduceDIte, shiftedIndex] + unfold shiftXor + rw [hstep, wordPolynomial_foldl_xorAt, + finRange_polynomial_sum] + congr 1 + simp only [X_pow_eq_monomial, wordPolynomial, Finset.mul_sum, monomial_mul_monomial, one_mul, + shiftedIndex] + +private theorem shiftXor_preserves_ge {e : ℕ} + (lower : Word e) (degree : ℕ) (word : Word (2 * e)) + (hdegree : e ≤ degree) + (index : Fin (2 * e)) (hindex : degree ≤ index.val) : + shiftXor lower degree word index = word index := by + unfold shiftXor + let step : Word (2 * e) → Fin e → Word (2 * e) := + fun accumulator i => + if h : degree - e + i.val < 2 * e then + xorAt accumulator ⟨degree - e + i.val, h⟩ (lower i) + else accumulator + change ((List.finRange e).foldl step word) index = word index + refine List.foldlRecOn (List.finRange e) step + (motive := fun accumulator => accumulator index = word index) + rfl ?_ + intro accumulator hacc i _ + dsimp [step] + split + · rename_i hbound + have hne : + index ≠ (⟨degree - e + i.val, hbound⟩ : Fin (2 * e)) := by + intro h + have hv := congrArg (fun j : Fin (2 * e) => j.val) h + change index.val = degree - e + i.val at hv + have hi := i.isLt + omega + simpa only [xorAt, hne, ↓reduceIte] using hacc + · exact hacc + +private theorem reduceAt_quotient {e : ℕ} + (lower : Word e) (degree : ℕ) (word : Word (2 * e)) : + (AdjoinRoot.mk (monicPolynomial lower)) + (wordPolynomial (reduceAt lower degree word)) = + (AdjoinRoot.mk (monicPolynomial lower)) + (wordPolynomial word) := by + unfold reduceAt + split + · rename_i hdegree + dsimp only + split + · rename_i hbit + let leading : Fin (2 * e) := ⟨degree, hdegree.2⟩ + have hpoly : + wordPolynomial + (shiftXor lower degree (xorAt word leading true)) = + wordPolynomial word + + Polynomial.X ^ (degree - e) * monicPolynomial lower := by + rw [wordPolynomial_shiftXor lower degree + (xorAt word leading true) hdegree, + wordPolynomial_xorAt] + simp only [leading, bitValue, ↓reduceIte, + ← Polynomial.X_pow_eq_monomial] + unfold monicPolynomial + rw [mul_add, ← pow_add, Nat.sub_add_cancel hdegree.1] + ring + rw [hpoly, map_add, map_mul, AdjoinRoot.mk_self, + mul_zero, add_zero] + · rfl + · rfl + +private theorem reduceAt_leading_zero {e : ℕ} + (lower : Word e) (degree : ℕ) (word : Word (2 * e)) + (hdegree : e ≤ degree ∧ degree < 2 * e) : + reduceAt lower degree word + (⟨degree, hdegree.2⟩ : Fin (2 * e)) = false := by + unfold reduceAt + rw [dite_eq_left hdegree] + by_cases hbit : word ⟨degree, hdegree.2⟩ = true + · simp only [hbit, ↓reduceIte] + rw [shiftXor_preserves_ge lower degree + (xorAt word ⟨degree, hdegree.2⟩ true) + hdegree.1 ⟨degree, hdegree.2⟩ (le_refl degree)] + simp only [xorAt, ↓reduceIte, hbit, bne_self_eq_false] + · simp only [hbit, Bool.false_eq_true, ↓reduceIte] + +private theorem reduceAt_preserves_above {e : ℕ} + (lower : Word e) (degree : ℕ) (word : Word (2 * e)) + (index : Fin (2 * e)) (habove : degree < index.val) : + reduceAt lower degree word index = word index := by + unfold reduceAt + split + · rename_i hdegree + dsimp only + split + · rename_i hbit + rw [shiftXor_preserves_ge lower degree + (xorAt word ⟨degree, hdegree.2⟩ true) + hdegree.1 index (Nat.le_of_lt habove)] + have hne : index ≠ (⟨degree, hdegree.2⟩ : Fin (2 * e)) := by + intro h + have hv := congrArg (fun j : Fin (2 * e) => j.val) h + change index.val = degree at hv + omega + simp only [xorAt, hne, ↓reduceIte] + · rfl + · rfl + +/-- GapCVP reduction support. -/ +def reducePrefix {e : ℕ} (lower : Word e) (count : ℕ) + (word : Word (2 * e)) : Word (2 * e) := + (List.range count).foldl + (fun accumulator offset => + reduceAt lower (2 * e - 1 - offset) accumulator) + word + +theorem reducePrefix_succ {e : ℕ} + (lower : Word e) (count : ℕ) (word : Word (2 * e)) : + reducePrefix lower (count + 1) word = + reduceAt lower (2 * e - 1 - count) + (reducePrefix lower count word) := by + simp only [reducePrefix, List.range_succ, List.foldl_append, List.foldl_cons, List.foldl_nil] + +private theorem reducePrefix_quotient {e : ℕ} + (lower : Word e) (count : ℕ) (word : Word (2 * e)) : + (AdjoinRoot.mk (monicPolynomial lower)) + (wordPolynomial (reducePrefix lower count word)) = + (AdjoinRoot.mk (monicPolynomial lower)) + (wordPolynomial word) := by + induction count with + | zero => rfl + | succ count ih => + rw [show count + 1 = Nat.succ count by omega] + rw [reducePrefix_succ] + exact (reduceAt_quotient lower (2 * e - 1 - count) + (reducePrefix lower count word)).trans ih + +private theorem reducePrefix_high_zero {e : ℕ} + (lower : Word e) (count : ℕ) (word : Word (2 * e)) + (hcount : count ≤ e) (index : Fin (2 * e)) + (hindex : 2 * e - count ≤ index.val) : + reducePrefix lower count word index = false := by + induction count generalizing word with + | zero => + have hi := index.isLt + simp only [tsub_zero] at hindex + omega + | succ count ih => + have hcount' : count < e := by omega + let degree := 2 * e - 1 - count + have hdegree : e ≤ degree ∧ degree < 2 * e := by + dsimp [degree] + omega + have hindex' : degree ≤ index.val := by + dsimp [degree] + omega + rw [reducePrefix_succ] + by_cases heq : index.val = degree + · have hfin : index = (⟨degree, hdegree.2⟩ : Fin (2 * e)) := + Fin.ext heq + rw [hfin] + exact reduceAt_leading_zero lower degree + (reducePrefix lower count word) hdegree + · have habove : degree < index.val := by omega + rw [reduceAt_preserves_above lower degree + (reducePrefix lower count word) index habove] + apply ih word + · omega + · dsimp [degree] at habove + omega + +private theorem reduceProduct_quotient {e : ℕ} + (lower : Word e) (word : Word (2 * e)) : + (AdjoinRoot.mk (monicPolynomial lower)) + (wordPolynomial (reduceProduct lower word)) = + (AdjoinRoot.mk (monicPolynomial lower)) + (wordPolynomial word) := + reducePrefix_quotient lower e word + +private theorem reduceProduct_high_zero {e : ℕ} + (lower : Word e) (word : Word (2 * e)) + (index : Fin (2 * e)) (hindex : e ≤ index.val) : + reduceProduct lower word index = false := by + apply reducePrefix_high_zero lower e word (le_refl e) index + omega + +/-- GapCVP reduction support. -/ +def truncateWord {e : ℕ} (word : Word (2 * e)) : Word e := + fun i => word ⟨i.val, by + have hi := i.isLt + omega⟩ + +private theorem wordPolynomial_truncateWord {e : ℕ} + (word : Word (2 * e)) + (hzero : ∀ index : Fin (2 * e), + e ≤ index.val → word index = false) : + wordPolynomial (truncateWord word) = wordPolynomial word := by + classical + apply Polynomial.ext + intro k + by_cases hk : k < e + · let low : Fin e := ⟨k, hk⟩ + let high : Fin (2 * e) := ⟨k, by omega⟩ + change + (wordPolynomial (truncateWord word)).coeff low.val = + (wordPolynomial word).coeff high.val + rw [wordPolynomial_coeff_fin, wordPolynomial_coeff_fin] + rfl + · have hlarge : e ≤ k := Nat.le_of_not_gt hk + rw [wordPolynomial_coeff_eq_zero _ k hlarge] + by_cases hk' : k < 2 * e + · let index : Fin (2 * e) := ⟨k, hk'⟩ + have hz := hzero index hlarge + have hc := wordPolynomial_coeff_fin word index + change 0 = (wordPolynomial word).coeff index.val + rw [hc, hz] + decide + · have hlarge' : 2 * e ≤ k := Nat.le_of_not_gt hk' + rw [wordPolynomial_coeff_eq_zero word k hlarge'] + +private theorem multiplyMod_quotient {degree : ℕ} + (lower left right : Word degree) : + (AdjoinRoot.mk (monicPolynomial lower)) + (wordPolynomial (multiplyMod lower left right)) = + (AdjoinRoot.mk (monicPolynomial lower)) (wordPolynomial left) * + (AdjoinRoot.mk (monicPolynomial lower)) (wordPolynomial right) := by + change + (AdjoinRoot.mk (monicPolynomial lower)) + (wordPolynomial + (truncateWord (reduceProduct lower (multiplyWords left right)))) = _ + rw [wordPolynomial_truncateWord + (reduceProduct lower (multiplyWords left right)) + (reduceProduct_high_zero lower (multiplyWords left right)), + reduceProduct_quotient, wordPolynomial_multiplyWords, map_mul] + +private theorem wordElement_multiplyMod {degree : ℕ} + (left right : Word degree) : + GapCVP.BinaryFieldBasis.wordElement + (multiplyMod (irreducibleWord degree) left right) = + GapCVP.BinaryFieldBasis.wordElement left * + GapCVP.BinaryFieldBasis.wordElement right := by + change + (AdjoinRoot.mk (monicPolynomial (irreducibleWord degree))) + (wordPolynomial + (multiplyMod (irreducibleWord degree) left right)) = + (AdjoinRoot.mk (monicPolynomial (irreducibleWord degree))) + (wordPolynomial left) * + (AdjoinRoot.mk (monicPolynomial (irreducibleWord degree))) + (wordPolynomial right) + exact multiplyMod_quotient (irreducibleWord degree) left right + +/-- GapCVP reduction support. -/ +noncomputable def sourceWordValue + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (word : Word + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) : + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength formula := + extensionAlgEquivGaloisField + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula)) + (GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + encodingLength formula)) + (GapCVP.BinaryFieldBasis.wordElement word) + +private theorem wordElement_oneWord + (degree : ℕ) (hdegree : 0 < degree) : + GapCVP.BinaryFieldBasis.wordElement + (oneWord degree) = 1 := by + unfold GapCVP.BinaryFieldBasis.wordElement + rw [wordPolynomial_oneWord degree hdegree, map_one] + +theorem sourceWordValue_oneWord + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) : + sourceWordValue encodingLength formula + (oneWord + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) = 1 := by + unfold sourceWordValue + rw [wordElement_oneWord _ + (GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + encodingLength formula)), map_one] + +theorem sourceWordValue_multiplyMod + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (left right : Word + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) : + sourceWordValue encodingLength formula + (multiplyMod + (irreducibleWord + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) + left right) = + sourceWordValue encodingLength formula left * + sourceWordValue encodingLength formula right := by + unfold sourceWordValue + rw [wordElement_multiplyMod, map_mul] + +/-- GapCVP reduction support. -/ +def sourceWordPow {degree : ℕ} + (word : Word degree) : ℕ → Word degree + | 0 => oneWord degree + | n + 1 => multiplyMod (irreducibleWord degree) + (sourceWordPow word n) word + +theorem sourceWordValue_sourceWordPow + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (word : Word + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) + (power : ℕ) : + sourceWordValue encodingLength formula (sourceWordPow word power) = + sourceWordValue encodingLength formula word ^ power := by + induction power with + | zero => + simpa only [sourceWordPow, pow_zero] using sourceWordValue_oneWord encodingLength formula + | succ power ih => + rw [sourceWordPow, sourceWordValue_multiplyMod, ih, pow_succ] + +/-- GapCVP reduction support. -/ +def sourceInverseWord {degree : ℕ} + (word : Word degree) : Word degree := + sourceWordPow word ((2 ^ degree - 2)) + +theorem sourceWordValue_sourceInverseWord + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (word : Word + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) + (hnonzero : sourceWordValue encodingLength formula word ≠ 0) : + sourceWordValue encodingLength formula (sourceInverseWord word) = + (sourceWordValue encodingLength formula word)⁻¹ := by + rw [sourceInverseWord, sourceWordValue_sourceWordPow] + let degree := GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula) + have hdegree : 0 < degree := + GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + encodingLength formula) + have hq : 2 ≤ 2 ^ degree := by + calc + 2 = 2 ^ (1 : ℕ) := by norm_num + _ ≤ 2 ^ degree := + Nat.pow_le_pow_right (by norm_num) (by omega) + apply mul_left_cancel₀ hnonzero + rw [mul_inv_cancel₀ hnonzero] + calc + sourceWordValue encodingLength formula word * + sourceWordValue encodingLength formula word ^ + (2 ^ degree - 2) = + sourceWordValue encodingLength formula word ^ + (2 ^ degree - 1) := by + rw [mul_comm, ← pow_succ] + congr 1 + omega + _ = 1 := by + have hfermat := FiniteField.pow_card_sub_one_eq_one + (sourceWordValue encodingLength formula word) hnonzero + have hcard := GapCVP.Core.sourceFiniteField_card + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + encodingLength formula) + rw [hcard] at hfermat + exact hfermat + +end BinaryFieldInverseAlgebra + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part11.lean b/LeanPool/GapCVP/Part11.lean new file mode 100644 index 000000000..ed61db72c --- /dev/null +++ b/LeanPool/GapCVP/Part11.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part11C + +/-! # GapCVP proof, part 11 -/ diff --git a/LeanPool/GapCVP/Part11A.lean b/LeanPool/GapCVP/Part11A.lean new file mode 100644 index 000000000..5af253725 --- /dev/null +++ b/LeanPool/GapCVP/Part11A.lean @@ -0,0 +1,399 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part10 +import Mathlib.Analysis.SpecialFunctions.Pow.NthRootLemmas +import Mathlib.InformationTheory.Hamming + +/-! # GapCVP proof, part 11 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace BinaryPhysicalLagrangeCoefficientTM + +open Turing GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows +open GapCVP.BinarySourceFieldMultiplicationTM GapCVP.BinaryModularReductionTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM + +/-- GapCVP reduction support. -/ +structure SourcePhysicalLagrangeWordComputer where + /-- GapCVP reduction support. -/ + output : List Bool → List Bool + /-- GapCVP reduction support. -/ + computer : BitTM output + +private abbrev sourcePhysicalLagrangeOriginalSource : List Bool → List Bool := + sourceExplicitAffineCellOriginalSource + +private noncomputable def sourcePhysicalLagrangeOriginalSourceComputable : + BitTM + sourcePhysicalLagrangeOriginalSource := + sourceExplicitAffineCellOriginalSourceComputable + +/-- GapCVP reduction support. -/ +def sourcePhysicalLagrangePrefixedOutput + (worker : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + lengthPrefixedWord (worker.output input) + +/-- GapCVP reduction support. -/ +noncomputable def sourcePhysicalLagrangePrefixedComputable + (worker : SourcePhysicalLagrangeWordComputer) : + BitTM + (sourcePhysicalLagrangePrefixedOutput worker) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + worker.computer structuralPrefixWriterComputable + change BitTM + (fun input => lengthPrefixedWord (worker.output input)) + simpa only [Function.comp_def] using hphysical + +private def sourcePhysicalLagrangeMultiplyQuery + (lower left right : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + factor400BinarySourceFieldQuery + (lower.output input) (left.output input) (right.output input) + (sourcePhysicalLagrangeOriginalSource input) + +private noncomputable def sourcePhysicalLagrangeMultiplyQueryComputable + (lower left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (sourcePhysicalLagrangeMultiplyQuery lower left right) := by + have hright := pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable right) + sourcePhysicalLagrangeOriginalSourceComputable + have hmiddle := pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable left) hright + have hcomplete := pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable lower) hmiddle + change BitTM + (fun input => factor400BinarySourceFieldQuery + (lower.output input) (left.output input) (right.output input) + (sourcePhysicalLagrangeOriginalSource input)) + simpa only [factor400BinarySourceFieldQuery, List.append_assoc, + sourcePhysicalLagrangePrefixedOutput] using + hcomplete + +/-- GapCVP reduction support. -/ +def sourcePhysicalLagrangeMultiplyWord + (lower left right : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + binarySourceMultiplyModWord + (sourcePhysicalLagrangeMultiplyQuery lower left right input) + +/-- GapCVP reduction support. -/ +noncomputable def sourcePhysicalLagrangeMultiplyComputable + (multiplyComputer : BitTM binarySourceMultiplyModWord) + (lower left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (sourcePhysicalLagrangeMultiplyWord lower left right) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (sourcePhysicalLagrangeMultiplyQueryComputable lower left right) + multiplyComputer + change BitTM + (fun input => binarySourceMultiplyModWord + (sourcePhysicalLagrangeMultiplyQuery lower left right input)) + simpa only [Function.comp_def] using hphysical + +theorem sourcePhysicalLagrangeMultiplyWord_valid + {degree : ℕ} + (lowerWord leftWord rightWord : + GapCVP.Core.EffectiveBinaryField.Word degree) + (lower left right : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (source : List Bool) + (hlower : lower.output + (affineCellQuery row column source) = + finiteWordBits lowerWord) + (hleft : left.output + (affineCellQuery row column source) = + finiteWordBits leftWord) + (hright : right.output + (affineCellQuery row column source) = + finiteWordBits rightWord) : + sourcePhysicalLagrangeMultiplyWord lower left right + (affineCellQuery row column source) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyMod + lowerWord leftWord rightWord) := by + unfold sourcePhysicalLagrangeMultiplyWord + sourcePhysicalLagrangeMultiplyQuery + rw [hlower, hleft, hright] + change binarySourceMultiplyModWord + (factor400BinarySourceFieldQuery + (finiteWordBits lowerWord) + (finiteWordBits leftWord) + (finiteWordBits rightWord) + (sourceExplicitAffineCellOriginalSource + (affineCellQuery row column source))) = _ + rw [sourceExplicitAffineCellOriginalSource_query] + exact binarySourceMultiplyModWord_valid + lowerWord leftWord rightWord source + +end BinaryPhysicalLagrangeCoefficientTM + +namespace BinaryFieldInverseTM + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceFieldMultiplicationTM + +/-- GapCVP reduction support. -/ +def binarySourceFieldInverseQuery + (lower operand source : List Bool) : List Bool := + lengthPrefixedWord lower ++ lengthPrefixedWord operand ++ source + +/-- GapCVP reduction support. -/ +def binarySourceFieldInverseSource + (input : List Bool) : List Bool := + firstFieldSuffix (firstFieldSuffix input) + +/-- GapCVP reduction support. -/ +noncomputable def factor400BinarySourceFieldInverseSourceComputable : + BitTM + binarySourceFieldInverseSource := by + have h := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + change BitTM + (fun input : List Bool => firstFieldSuffix (firstFieldSuffix input)) + exact h + +@[simp] theorem factor400BinarySourceFieldInverseSource_query + (lower operand source : List Bool) : + binarySourceFieldInverseSource + (binarySourceFieldInverseQuery lower operand source) = source := by + simp only [binarySourceFieldInverseSource, binarySourceFieldInverseQuery, List.append_assoc, + firstFieldSuffix_valid] + +private def binarySourceFieldPowerPreparation + (input : List Bool) : List Bool := + factor400BinarySourceFieldQuery + (factor400BinarySourceLeftBits input) + (factor400BinarySourceLowerBits input) + (factor400BinarySourceRightBits input) + (factor400BinarySourceFieldSuffix input) + +private noncomputable def factor400BinarySourceFieldPowerPreparationComputable : + BitTM + binarySourceFieldPowerPreparation := by + have hlower := GapCVP.TMComposition.computableInPolyTime + binarySourceLeftBitsComputable + structuralPrefixWriterComputable + have haccumulator := GapCVP.TMComposition.computableInPolyTime + binarySourceLowerBitsComputable + structuralPrefixWriterComputable + have hoperand := GapCVP.TMComposition.computableInPolyTime + binarySourceRightBitsComputable + structuralPrefixWriterComputable + have htail := pointwiseAppendComputable + hoperand factor400BinarySourceFieldSuffixComputable + have hright := pointwiseAppendComputable haccumulator htail + have hcomplete := pointwiseAppendComputable hlower hright + change BitTM + (fun input => + lengthPrefixedWord (factor400BinarySourceLeftBits input) ++ + lengthPrefixedWord (factor400BinarySourceLowerBits input) ++ + lengthPrefixedWord (factor400BinarySourceRightBits input) ++ + factor400BinarySourceFieldSuffix input) + simpa only [List.append_assoc, Function.comp_apply] using hcomplete + +@[simp] private theorem factor400BinarySourceFieldPowerPreparation_query + (accumulator lower operand source : List Bool) : + binarySourceFieldPowerPreparation + (factor400BinarySourceFieldQuery + accumulator lower operand source) = + factor400BinarySourceFieldQuery + lower accumulator operand source := by + simp only [binarySourceFieldPowerPreparation, factor400BinarySourceLeftBits_query, + factor400BinarySourceLowerBits_query, factor400BinarySourceRightBits_query, + factor400BinarySourceFieldSuffix_query] + +/-- GapCVP reduction support. -/ +def binarySourceFieldPowerCandidate + (input : List Bool) : List Bool := + binarySourceMultiplyModWord + (binarySourceFieldPowerPreparation input) + +/-- GapCVP reduction support. -/ +noncomputable def factor400BinarySourceFieldPowerCandidateComputable + (multiplyComputer : + BitTM + binarySourceMultiplyModWord) : + BitTM + binarySourceFieldPowerCandidate := by + have h := GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceFieldPowerPreparationComputable multiplyComputer + change BitTM + (fun input : List Bool => + binarySourceMultiplyModWord + (binarySourceFieldPowerPreparation input)) + exact h + +private theorem factor400BinarySourceFieldPowerCandidate_valid + {degree : ℕ} + (lower current operand : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + binarySourceFieldPowerCandidate + (factor400BinarySourceFieldQuery + (finiteWordBits current) + (finiteWordBits lower) + (finiteWordBits operand) source) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyMod + lower current operand) := by + unfold binarySourceFieldPowerCandidate + rw [factor400BinarySourceFieldPowerPreparation_query] + exact binarySourceMultiplyModWord_valid + lower current operand source + +end + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceAnchoredGridRecordFoldTM GapCVP.BinaryModularReductionTM +open GapCVP.BinarySourceFieldMultiplicationTM + +/-- GapCVP reduction support. -/ +def sourceFieldPowerStep {degree : ℕ} + (lower operand : GapCVP.Core.EffectiveBinaryField.Word degree) + (current : GapCVP.Core.EffectiveBinaryField.Word degree) : + GapCVP.Core.EffectiveBinaryField.Word degree := + GapCVP.Core.EffectiveBinaryField.multiplyMod lower current operand + +/-- GapCVP reduction support. -/ +def sourceFieldPowerIterate {degree : ℕ} + (lower operand : GapCVP.Core.EffectiveBinaryField.Word degree) + (steps : ℕ) : GapCVP.Core.EffectiveBinaryField.Word degree := + ((sourceFieldPowerStep lower operand)^[steps]) operand + +private theorem factor400BinarySourceFieldPowerRotation_step + {degree : ℕ} + (lower current operand : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + let anchor := + binarySourceFieldInverseQuery + (finiteWordBits lower) (finiteWordBits operand) source + sourceAnchoredGridRecordRotationOutput + binarySourceFieldPowerCandidate + (lengthPrefixedWord anchor ++ + lengthPrefixedWord (finiteWordBits current)) = + lengthPrefixedWord anchor ++ + lengthPrefixedWord + (finiteWordBits (sourceFieldPowerStep lower operand current)) := by + dsimp + let anchor := + binarySourceFieldInverseQuery + (finiteWordBits lower) (finiteWordBits operand) source + let state := + lengthPrefixedWord anchor ++ + lengthPrefixedWord (finiteWordBits current) + have hpair : + sourceAnchoredGridRankSourcePair state = + factor400BinarySourceFieldQuery + (finiteWordBits current) + (finiteWordBits lower) + (finiteWordBits operand) source := by + unfold sourceAnchoredGridRankSourcePair + dsimp only [state] + rw [firstFieldSuffix_valid anchor + (lengthPrefixedWord (finiteWordBits current))] + rw [firstFieldContents_valid anchor + (lengthPrefixedWord (finiteWordBits current))] + have hcurrent : + firstFieldContents + (lengthPrefixedWord (finiteWordBits current)) = + finiteWordBits current := by + simpa only [List.append_nil] using + firstFieldContents_valid (finiteWordBits current) [] + rw [hcurrent] + simp only [anchor, factor400BinarySourceFieldQuery, + binarySourceFieldInverseQuery, List.append_assoc] + have hraw : + sourceAnchoredGridRawCandidate + binarySourceFieldPowerCandidate state = + finiteWordBits (sourceFieldPowerStep lower operand current) := by + unfold sourceAnchoredGridRawCandidate + rw [hpair] + simpa only [sourceFieldPowerStep] using + factor400BinarySourceFieldPowerCandidate_valid + lower current operand source + have hfit : + (finiteWordBits (sourceFieldPowerStep lower operand current)).length ≤ + anchor.length := by + simp only [anchor, binarySourceFieldInverseQuery, + List.length_append, lengthPrefixedWord_length, + finiteWordBits, List.length_map, List.length_finRange] + omega + have hselector : + sourceAnchoredGridCandidateSelector + binarySourceFieldPowerCandidate state = true := by + have hanchor : firstFieldContents state = anchor := by + dsimp only [state] + exact firstFieldContents_valid anchor + (lengthPrefixedWord (finiteWordBits current)) + rw [sourceAnchoredGridCandidateSelector_eq, hraw, hanchor] + exact decide_eq_true hfit + have hguard : + sourceAnchoredGridGuardedCandidate + binarySourceFieldPowerCandidate state = + finiteWordBits (sourceFieldPowerStep lower operand current) := by + simp only [sourceAnchoredGridGuardedCandidate, hselector, hraw, + ite_true] + have hrotation := + sourceAnchoredGridRecordRotationOutput_records + binarySourceFieldPowerCandidate anchor + (finiteWordBits current) [] + simp only [List.append_nil] at hrotation + have hguardRecords : + sourceAnchoredGridGuardedCandidate + binarySourceFieldPowerCandidate + (lengthPrefixedWord anchor ++ + lengthPrefixedWord (finiteWordBits current)) = + finiteWordBits (sourceFieldPowerStep lower operand current) := by + exact hguard + rw [hguardRecords] at hrotation + exact hrotation + +theorem factor400BinarySourceFieldPowerRotation_iterate + {degree : ℕ} + (lower current operand : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) (steps : ℕ) : + let anchor := + binarySourceFieldInverseQuery + (finiteWordBits lower) (finiteWordBits operand) source + ((sourceAnchoredGridRecordRotationOutput + binarySourceFieldPowerCandidate)^[steps]) + (lengthPrefixedWord anchor ++ + lengthPrefixedWord (finiteWordBits current)) = + lengthPrefixedWord anchor ++ + lengthPrefixedWord + (finiteWordBits + (((sourceFieldPowerStep lower operand)^[steps]) current)) := by + dsimp + induction steps generalizing current with + | zero => simp only [Function.iterate_zero, id_eq] + | succ steps ih => + rw [Function.iterate_succ_apply, + factor400BinarySourceFieldPowerRotation_step + lower current operand source, + ih (sourceFieldPowerStep lower operand current), + Function.iterate_succ_apply] + +end + +end BinaryFieldInverseTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part11B.lean b/LeanPool/GapCVP/Part11B.lean new file mode 100644 index 000000000..d55762654 --- /dev/null +++ b/LeanPool/GapCVP/Part11B.lean @@ -0,0 +1,2003 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part11A + +/-! # GapCVP proof, part 11, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace BinaryFieldInverseTM + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder + +open GapCVP.SourceAnchoredGridRecordFoldTM GapCVP.BinaryModularReductionTM + +open GapCVP.BinarySourceFieldMultiplicationTM + +end + +end BinaryFieldInverseTM + +namespace BinarySourceConvolutionTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceStructuralTuringTM GapCVP.SourceMachineCert +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceMixedRadixDimensionRowMajorIndexTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.SourceFourFamilyMarkerRotationTM +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.CNFCappedUnaryPairArithmeticTM +open GapCVP.CNFBoundedRecordFoldTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFGuardedFiveFamilyTagDispatchTM GapCVP.CLStructuralPrefixWriter +open GapCVP.BinaryCoefficientTM GapCVP.BinarySourceFieldMultiplicationTM + +/-- GapCVP reduction support. -/ +def factor400BinarySourceSkipFields : + ℕ → (List Bool → List Bool) + | 0 => id + | count + 1 => firstFieldSuffix ∘ + factor400BinarySourceSkipFields count + +/-- GapCVP reduction support. -/ +noncomputable def binarySourceSkipFieldsComputable + (count : ℕ) : + BitTM + (factor400BinarySourceSkipFields count) := by + induction count with + | zero => + exact Turing.idComputableInPolyTime bitEncoding + | succ count ih => + exact GapCVP.TMComposition.computableInPolyTime + ih firstFieldSuffixComputable + +private def binarySourceCoefficientDegreeUnary + (input : List Bool) : List Bool := + List.replicate (factor400BinarySourceLeftBits input).length true + +private noncomputable def factor400BinarySourceCoefficientDegreeUnaryComputable : + BitTM + binarySourceCoefficientDegreeUnary := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + binarySourceLeftBitsComputable + (polynomialValueUnaryComputable Polynomial.X) + change BitTM + (fun input => List.replicate + (factor400BinarySourceLeftBits input).length true) + simpa only [Polynomial.eval_X, Function.comp_def] using hphysical + +private def binarySourceConvolutionPairWidthOutput + (input : List Bool) : List Bool := + List.replicate + ((factor400BinarySourceLeftBits input).length ^ 2) true + +private noncomputable def factor400BinarySourceConvolutionPairWidthComputable : + BitTM + binarySourceConvolutionPairWidthOutput := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + binarySourceLeftBitsComputable + (polynomialValueUnaryComputable (Polynomial.X ^ 2)) + change BitTM + (fun input => List.replicate + ((factor400BinarySourceLeftBits input).length ^ 2) true) + simpa only [Polynomial.eval_pow, Polynomial.eval_X, Function.comp_def] using hphysical + +private def binarySourceConvolutionCoefficientQuery + (coefficient : ℕ) (source : List Bool) : List Bool := + lengthPrefixedWord (List.replicate coefficient true) ++ source + +private def binarySourceConvolutionPairRawSource : + List Bool → List Bool := + factor400BinarySourceSkipFields 3 + +private noncomputable def binarySourceConvolutionPairRawSourceComputable : + BitTM + binarySourceConvolutionPairRawSource := + binarySourceSkipFieldsComputable 3 + +private def factor400BinarySourceConvolutionPairDegreeUnary : + List Bool → List Bool := + binarySourceCoefficientDegreeUnary ∘ + binarySourceConvolutionPairRawSource + +private noncomputable def factor400BinarySourceConvolutionPairDegreeUnaryComputable : + BitTM + factor400BinarySourceConvolutionPairDegreeUnary := + GapCVP.TMComposition.computableInPolyTime + binarySourceConvolutionPairRawSourceComputable + factor400BinarySourceCoefficientDegreeUnaryComputable + +private def binarySourceConvolutionPairRankUnary : + List Bool → List Bool := + firstFieldContents + +private noncomputable def factor400BinarySourceConvolutionPairRankUnaryComputable : + BitTM + binarySourceConvolutionPairRankUnary := + firstFieldContentsComputable + +private def binarySourceConvolutionPairDivisionQuery + (input : List Bool) : List Bool := + binarySourceConvolutionPairRankUnary input ++ false :: + (factor400BinarySourceConvolutionPairDegreeUnary input ++ false :: + binarySourceConvolutionPairRawSource input) + +private noncomputable def factor400BinarySourceConvolutionPairDivisionQueryComputable : + BitTM + binarySourceConvolutionPairDivisionQuery := by + have hsource := GapCVP.TMComposition.computableInPolyTime + binarySourceConvolutionPairRawSourceComputable + (prependBitComputable false) + have hdegree := pointwiseAppendComputable + factor400BinarySourceConvolutionPairDegreeUnaryComputable hsource + have hseparator := GapCVP.TMComposition.computableInPolyTime + hdegree (prependBitComputable false) + exact pointwiseAppendComputable + factor400BinarySourceConvolutionPairRankUnaryComputable hseparator + +private def binarySourceConvolutionPairOdometer : + List Bool → List Bool := + sourceMixedRadixRowMajorPairOutput ∘ + binarySourceConvolutionPairDivisionQuery + +private noncomputable def factor400BinarySourceConvolutionPairOdometerComputable : + BitTM + binarySourceConvolutionPairOdometer := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceConvolutionPairDivisionQueryComputable + sourceMixedRadixRowMajorPairComputable + +private def binarySourceConvolutionPairFirstUnary + (input : List Bool) : List Bool := + (unaryPrefixOutput + (binarySourceConvolutionPairOdometer input)).tail + +private noncomputable def factor400BinarySourceConvolutionPairFirstUnaryComputable : + BitTM + binarySourceConvolutionPairFirstUnary := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceConvolutionPairOdometerComputable + unaryPrefixComputable + exact GapCVP.TMComposition.computableInPolyTime + hprefix dropHeadComputable + +private def binarySourceConvolutionPairSecondUnary + (input : List Bool) : List Bool := + (unaryPrefixOutput + (unaryPrefixSuffixOutput + (binarySourceConvolutionPairOdometer input))).tail + +private noncomputable def factor400BinarySourceConvolutionPairSecondUnaryComputable : + BitTM + binarySourceConvolutionPairSecondUnary := by + have hsuffix := GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceConvolutionPairOdometerComputable + actualUnaryPrefixSuffixComputable + have hprefix := GapCVP.TMComposition.computableInPolyTime + hsuffix unaryPrefixComputable + exact GapCVP.TMComposition.computableInPolyTime + hprefix dropHeadComputable + +private def binarySourceConvolutionPairLeftWord : + List Bool → List Bool := + factor400BinarySourceLeftBits ∘ + binarySourceConvolutionPairRawSource + +private noncomputable def factor400BinarySourceConvolutionPairLeftWordComputable : + BitTM + binarySourceConvolutionPairLeftWord := + GapCVP.TMComposition.computableInPolyTime + binarySourceConvolutionPairRawSourceComputable + binarySourceLeftBitsComputable + +private def binarySourceConvolutionPairRightWord : + List Bool → List Bool := + factor400BinarySourceRightBits ∘ + binarySourceConvolutionPairRawSource + +private noncomputable def factor400BinarySourceConvolutionPairRightWordComputable : + BitTM + binarySourceConvolutionPairRightWord := + GapCVP.TMComposition.computableInPolyTime + binarySourceConvolutionPairRawSourceComputable + binarySourceRightBitsComputable + +private def binarySourceConvolutionPairLeftBit : + List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + binarySourceConvolutionPairFirstUnary + binarySourceConvolutionPairLeftWord + +private noncomputable def factor400BinarySourceConvolutionPairLeftBitComputable : + BitTM + binarySourceConvolutionPairLeftBit := + fiveOriginalDynamicBitComputable + factor400BinarySourceConvolutionPairFirstUnaryComputable + factor400BinarySourceConvolutionPairLeftWordComputable + +private def binarySourceConvolutionPairRightBit : + List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + binarySourceConvolutionPairSecondUnary + binarySourceConvolutionPairRightWord + +private noncomputable def factor400BinarySourceConvolutionPairRightBitComputable : + BitTM + binarySourceConvolutionPairRightBit := + fiveOriginalDynamicBitComputable + factor400BinarySourceConvolutionPairSecondUnaryComputable + factor400BinarySourceConvolutionPairRightWordComputable + +private def binarySourceConvolutionPairCoefficientUnary : + List Bool → List Bool := + firstFieldContents ∘ factor400BinarySourceSkipFields 2 + +private noncomputable def factor400BinarySourceConvolutionPairCoefficientUnaryComputable : + BitTM + binarySourceConvolutionPairCoefficientUnary := + GapCVP.TMComposition.computableInPolyTime + (binarySourceSkipFieldsComputable 2) + firstFieldContentsComputable + +private def binarySourceConvolutionPairSumUnary : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + binarySourceConvolutionPairFirstUnary + binarySourceConvolutionPairSecondUnary + +private noncomputable def factor400BinarySourceConvolutionPairSumUnaryComputable : + BitTM + binarySourceConvolutionPairSumUnary := + fourFamilyComputedUnarySumComputable + factor400BinarySourceConvolutionPairFirstUnaryComputable + factor400BinarySourceConvolutionPairSecondUnaryComputable + +private def binarySourceConvolutionPairMatchInput + (input : List Bool) : List Bool := + lengthPrefixedWord + (binarySourceConvolutionPairSumUnary input) ++ + lengthPrefixedWord + (binarySourceConvolutionPairCoefficientUnary input) + +private noncomputable def factor400BinarySourceConvolutionPairMatchInputComputable : + BitTM + binarySourceConvolutionPairMatchInput := by + have hleft := GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceConvolutionPairSumUnaryComputable + structuralPrefixWriterComputable + have hright := GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceConvolutionPairCoefficientUnaryComputable + structuralPrefixWriterComputable + exact pointwiseAppendComputable hleft hright + +private def binarySourceConvolutionEqualOrderingBit + (input : List Bool) : List Bool := + fixedDelimitedWordEqualityBitWord [true, false] + (lengthPrefixedWord input) + +private noncomputable def factor400BinarySourceConvolutionEqualOrderingBitComputable : + BitTM + binarySourceConvolutionEqualOrderingBit := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + structuralPrefixWriterComputable + (fixedDelimitedWordEqualityBitComputable [true, false]) + exact hphysical + +private def binarySourceConvolutionPairMatchBit : + List Bool → List Bool := + binarySourceConvolutionEqualOrderingBit ∘ + fourFamilyNaturalOrderingBitsOutput ∘ + fourFamilyDelimitedUnaryComparisonInput ∘ + binarySourceConvolutionPairMatchInput + +private noncomputable def factor400BinarySourceConvolutionPairMatchBitComputable : + BitTM + binarySourceConvolutionPairMatchBit := by + exact GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceConvolutionPairMatchInputComputable + sourceFourFamilyDelimitedUnaryComparisonInputComputable) + sourceFourFamilyNaturalOrderingBitsComputable) + factor400BinarySourceConvolutionEqualOrderingBitComputable + +private def factor400BinarySourceConvolutionPairProductTail + (input : List Bool) : List Bool := + binarySourceConvolutionPairLeftBit input ++ + binarySourceConvolutionPairRightBit input + +private noncomputable def factor400BinarySourceConvolutionPairProductTailComputable : + BitTM + factor400BinarySourceConvolutionPairProductTail := + pointwiseAppendComputable + factor400BinarySourceConvolutionPairLeftBitComputable + factor400BinarySourceConvolutionPairRightBitComputable + +private def factor400BinarySourceConvolutionPairProductQuery + (input : List Bool) : List Bool := + binarySourceConvolutionPairMatchBit input ++ + factor400BinarySourceConvolutionPairProductTail input + +private noncomputable def factor400BinarySourceConvolutionPairProductQueryComputable : + BitTM + factor400BinarySourceConvolutionPairProductQuery := + pointwiseAppendComputable + factor400BinarySourceConvolutionPairMatchBitComputable + factor400BinarySourceConvolutionPairProductTailComputable + +private def factor400BinarySourceConvolutionCoefficientRawSource : + List Bool → List Bool := + firstFieldSuffix + +private def binarySourceConvolutionCoefficientPairWidthOutput : + List Bool → List Bool := + binarySourceConvolutionPairWidthOutput ∘ + factor400BinarySourceConvolutionCoefficientRawSource + +private noncomputable def factor400BinarySourceConvolutionCoefficientPairWidthComputable : + BitTM + binarySourceConvolutionCoefficientPairWidthOutput := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable + factor400BinarySourceConvolutionPairWidthComputable + +private noncomputable def binarySourceConvolutionPairWidth : + SourceQaryMaskDynamicGridWidth where + output := binarySourceConvolutionCoefficientPairWidthOutput + computer := factor400BinarySourceConvolutionCoefficientPairWidthComputable + +private def binarySourceConvolutionPairCatalogue : + List Bool → List Bool := + maskDynamicGridCandidateCatalogueOutput + binarySourceConvolutionPairWidth + factor400BinarySourceConvolutionPairProductQueryComputable + +private noncomputable def factor400BinarySourceConvolutionPairCatalogueComputable : + BitTM + binarySourceConvolutionPairCatalogue := + maskDynamicGridCandidateCatalogueComputable + binarySourceConvolutionPairWidth + factor400BinarySourceConvolutionPairProductQueryComputable + +private def binarySourceConvolutionCoefficientPackedQuery + (input : List Bool) : List Bool := + binarySourceConvolutionCoefficientPairWidthOutput input ++ + false :: + (binarySourceConvolutionPairCatalogue input ++ + (binarySourceConvolutionCoefficientPairWidthOutput input ++ + [false, false])) + +private noncomputable def factor400BinarySourceConvolutionCoefficientPackedQueryComputable : + BitTM + binarySourceConvolutionCoefficientPackedQuery := by + have hparity := pointwiseAppendComputable + factor400BinarySourceConvolutionCoefficientPairWidthComputable + (sourceFixedWordComputable [false, false]) + have hrecords := pointwiseAppendComputable + factor400BinarySourceConvolutionPairCatalogueComputable hparity + have hdelimited := GapCVP.TMComposition.computableInPolyTime + hrecords (prependBitComputable false) + exact pointwiseAppendComputable + factor400BinarySourceConvolutionCoefficientPairWidthComputable + hdelimited + +private def binarySourceConvolutionCoefficientBit : + List Bool → List Bool := + convolutionCoefficientOutput ∘ + binarySourceConvolutionCoefficientPackedQuery + +private noncomputable def factor400BinarySourceConvolutionCoefficientBitComputable : + BitTM + binarySourceConvolutionCoefficientBit := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceConvolutionCoefficientPackedQueryComputable + convolutionCoefficientComputable + +private def binarySourceRawConvolutionWidthOutput + (input : List Bool) : List Bool := + List.replicate + (2 * (factor400BinarySourceLeftBits input).length) true + +private noncomputable def factor400BinarySourceRawConvolutionWidthComputable : + BitTM + binarySourceRawConvolutionWidthOutput := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + binarySourceLeftBitsComputable + (polynomialValueUnaryComputable (2 * Polynomial.X)) + change BitTM + (fun input => List.replicate + (2 * (factor400BinarySourceLeftBits input).length) true) + simpa only [Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X, Function.comp_def] + using hphysical + +private noncomputable def binarySourceRawConvolutionWidth : + SourceQaryMaskDynamicGridWidth where + output := binarySourceRawConvolutionWidthOutput + computer := factor400BinarySourceRawConvolutionWidthComputable + +private def factor400BinarySourceRawConvolutionRankSource : + List Bool → List Bool := + factor400BinarySourceSkipFields 2 + +private noncomputable def factor400BinarySourceRawConvolutionRankSourceComputable : + BitTM + factor400BinarySourceRawConvolutionRankSource := + binarySourceSkipFieldsComputable 2 + +private def binarySourceRawConvolutionCoefficientInput + (input : List Bool) : List Bool := + lengthPrefixedWord (firstFieldContents input) ++ + factor400BinarySourceRawConvolutionRankSource input + +private noncomputable def factor400BinarySourceRawConvolutionCoefficientInputComputable : + BitTM + binarySourceRawConvolutionCoefficientInput := by + have hrank := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable structuralPrefixWriterComputable + exact pointwiseAppendComputable hrank + factor400BinarySourceRawConvolutionRankSourceComputable + +private def binarySourceRawConvolutionCoefficientCandidate : + List Bool → List Bool := + binarySourceConvolutionCoefficientBit ∘ + binarySourceRawConvolutionCoefficientInput + +private noncomputable def factor400BinarySourceRawConvolutionCoefficientCandidateComputable : + BitTM + binarySourceRawConvolutionCoefficientCandidate := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceRawConvolutionCoefficientInputComputable + factor400BinarySourceConvolutionCoefficientBitComputable + +private def binarySourceRawConvolutionCoefficientCatalogue : + List Bool → List Bool := + maskDynamicGridCandidateCatalogueOutput + binarySourceRawConvolutionWidth + factor400BinarySourceRawConvolutionCoefficientCandidateComputable + +private noncomputable def factor400BinarySourceRawConvolutionCoefficientCatalogueComputable : + BitTM + binarySourceRawConvolutionCoefficientCatalogue := + maskDynamicGridCandidateCatalogueComputable + binarySourceRawConvolutionWidth + factor400BinarySourceRawConvolutionCoefficientCandidateComputable + +private def binarySourceRawConvolutionPackedOutput + (input : List Bool) : List Bool := + binarySourceRawConvolutionWidthOutput input ++ false :: + binarySourceRawConvolutionCoefficientCatalogue input + +private noncomputable def factor400BinarySourceRawConvolutionPackedOutputComputable : + BitTM + binarySourceRawConvolutionPackedOutput := by + have hrecords := GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceRawConvolutionCoefficientCatalogueComputable + (prependBitComputable false) + exact pointwiseAppendComputable + factor400BinarySourceRawConvolutionWidthComputable hrecords + +private theorem factor400BinarySourceRawConvolutionHeadMarker_length + (input : List Bool) : + (fiveFamilyOriginalHeadBitWord input).length ≤ 1 := by + simp only [fiveFamilyOriginalHeadBitWord_eq, List.headD_eq_head?_getD, List.length_cons, + List.length_nil, + zero_add, Std.le_refl] + +/-- GapCVP reduction support. -/ +def binarySourceRawConvolutionWord : + List Bool → List Bool := + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + fiveFamilyOriginalHeadBitWord) ∘ + binarySourceRawConvolutionPackedOutput + +/-- GapCVP reduction support. -/ +noncomputable def factor400BinarySourceRawConvolutionComputable : + BitTM + binarySourceRawConvolutionWord := by + have hfold := fourFamilyOriginalMarkerFoldComputable + fiveFamilyOriginalHeadBitComputable + factor400BinarySourceRawConvolutionHeadMarker_length + exact GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceRawConvolutionPackedOutputComputable hfold + +end BinarySourceConvolutionTM + +namespace BinarySourceConvolutionCorrectness + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceStructuralTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceMixedRadixUnaryQuotientRemainderTM +open GapCVP.SourceMixedRadixDimensionRowMajorIndexTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.CNFCappedUnaryPairArithmeticTM GapCVP.CNFEncodedClauseSort +open GapCVP.CNFNaturalOrderComparator GapCVP.CNFNaturalOrderTotalComparator +open GapCVP.CNFGuardedFiveFamilyTagDispatchTM GapCVP.BinaryCoefficientTM +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceFieldMultiplicationTM +open GapCVP.BinarySourceConvolutionTM + +private def binarySourceConvolutionPhysicalPairQuery + (rank : ℕ) (width : List Bool) (coefficient : ℕ) + (raw : List Bool) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord width ++ + lengthPrefixedWord (List.replicate coefficient true) ++ raw + +@[simp] private theorem factor400BinarySourceConvolutionPairRawSource_query + (rank : ℕ) (width : List Bool) (coefficient : ℕ) + (raw : List Bool) : + binarySourceConvolutionPairRawSource + (binarySourceConvolutionPhysicalPairQuery + rank width coefficient raw) = raw := by + simp only [binarySourceConvolutionPairRawSource, factor400BinarySourceSkipFields, + CompTriple.comp_eq, + binarySourceConvolutionPhysicalPairQuery, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid] + +@[simp] private theorem factor400BinarySourceConvolutionPairRankUnary_query + (rank : ℕ) (width : List Bool) (coefficient : ℕ) + (raw : List Bool) : + binarySourceConvolutionPairRankUnary + (binarySourceConvolutionPhysicalPairQuery + rank width coefficient raw) = + List.replicate rank true := by + simp only [binarySourceConvolutionPairRankUnary, binarySourceConvolutionPhysicalPairQuery, + List.append_assoc, + firstFieldContents_valid] + +@[simp] private theorem factor400BinarySourceConvolutionPairCoefficientUnary_query + (rank : ℕ) (width : List Bool) (coefficient : ℕ) + (raw : List Bool) : + binarySourceConvolutionPairCoefficientUnary + (binarySourceConvolutionPhysicalPairQuery + rank width coefficient raw) = + List.replicate coefficient true := by + simp only [binarySourceConvolutionPairCoefficientUnary, factor400BinarySourceSkipFields, + CompTriple.comp_eq, + binarySourceConvolutionPhysicalPairQuery, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid, + firstFieldContents_valid] + +@[simp] private theorem factor400BinarySourceCoefficientDegreeUnary_query + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + binarySourceCoefficientDegreeUnary + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) = + List.replicate degree true := by + simp only [binarySourceCoefficientDegreeUnary, factor400BinarySourceLeftBits_query, + factor400BinaryFiniteWordBits_length] + +@[simp] private theorem factor400BinarySourceConvolutionPairWidthOutput_query + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + binarySourceConvolutionPairWidthOutput + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) = + List.replicate (degree ^ 2) true := by + simp only [binarySourceConvolutionPairWidthOutput, factor400BinarySourceLeftBits_query, + factor400BinaryFiniteWordBits_length] + +@[simp] private theorem factor400BinarySourceConvolutionPairDivisionQuery_query + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairDivisionQuery + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + sourceUnaryDivisionQuery rank degree + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) := by + simp only [binarySourceConvolutionPairDivisionQuery, + factor400BinarySourceConvolutionPairRankUnary_query, + factor400BinarySourceConvolutionPairDegreeUnary, Function.comp_apply, + factor400BinarySourceConvolutionPairRawSource_query, + factor400BinarySourceCoefficientDegreeUnary_query, + sourceUnaryDivisionQuery] + +private theorem factor400BinarySourceConvolutionPairOdometer_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairOdometer + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + List.replicate (rank / degree) true ++ false :: + (List.replicate (rank % degree) true ++ false :: + sourceUnaryDivisionQuery rank degree + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) := by + unfold binarySourceConvolutionPairOdometer + rw [Function.comp_apply, + factor400BinarySourceConvolutionPairDivisionQuery_query, + sourceMixedRadixRowMajorPairOutput_valid rank degree _ hdegree] + +private theorem factor400BinarySourceConvolutionPairFirstUnary_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairFirstUnary + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + List.replicate (rank / degree) true := by + unfold binarySourceConvolutionPairFirstUnary + rw [factor400BinarySourceConvolutionPairOdometer_query + hdegree lower left right source width coefficient rank, + unaryPrefixOutput_replicate_delimiter] + rfl + +private theorem factor400BinarySourceConvolutionPairSecondUnary_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairSecondUnary + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + List.replicate (rank % degree) true := by + unfold binarySourceConvolutionPairSecondUnary + rw [factor400BinarySourceConvolutionPairOdometer_query + hdegree lower left right source width coefficient rank, + unaryPrefixSuffixOutput_valid, + unaryPrefixOutput_replicate_delimiter] + rfl + +theorem factor400BinaryFiniteWordBits_drop_head + {degree : ℕ} + (word : GapCVP.Core.EffectiveBinaryField.Word degree) + (position : ℕ) (hposition : position < degree) : + ((finiteWordBits word).drop position).headD false = + word ⟨position, hposition⟩ := by + have hlength : position < (finiteWordBits word).length := by + simpa only [factor400BinaryFiniteWordBits_length] using hposition + rw [List.drop_eq_getElem_cons hlength] + simp only [finiteWordBits, List.getElem_map, List.getElem_finRange, Fin.cast_mk, + List.headD_eq_head?_getD, + List.head?_cons, Option.getD_some] + +@[simp] private theorem factor400BinarySourceConvolutionPairLeftWord_query + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairLeftWord + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + finiteWordBits left := by + simp only [binarySourceConvolutionPairLeftWord, Function.comp_apply, + factor400BinarySourceConvolutionPairRawSource_query, factor400BinarySourceLeftBits_query] + +@[simp] private theorem factor400BinarySourceConvolutionPairRightWord_query + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairRightWord + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + finiteWordBits right := by + simp only [binarySourceConvolutionPairRightWord, Function.comp_apply, + factor400BinarySourceConvolutionPairRawSource_query, factor400BinarySourceRightBits_query] + +private theorem factor400BinarySourceConvolutionPairLeftBit_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) + (hrank : rank < degree ^ 2) : + binarySourceConvolutionPairLeftBit + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + [left ⟨rank / degree, by + apply (Nat.div_lt_iff_lt_mul hdegree).2 + simpa only [pow_two] using hrank⟩] := by + let input := binarySourceConvolutionPhysicalPairQuery + rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) + have hfirst := factor400BinarySourceConvolutionPairFirstUnary_query + hdegree lower left right source width coefficient rank + have hlookup := fiveOriginalDynamicBitWord_valid + binarySourceConvolutionPairFirstUnary + binarySourceConvolutionPairLeftWord + input (rank / degree) hfirst + unfold binarySourceConvolutionPairLeftBit + change fiveFamilyOriginalDynamicBitWord + binarySourceConvolutionPairFirstUnary + binarySourceConvolutionPairLeftWord input = _ + rw [hlookup, + factor400BinarySourceConvolutionPairLeftWord_query] + congr 1 + exact factor400BinaryFiniteWordBits_drop_head + left (rank / degree) + ((Nat.div_lt_iff_lt_mul hdegree).2 + (by simpa only [pow_two] using hrank)) + +private theorem factor400BinarySourceConvolutionPairRightBit_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairRightBit + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + [right ⟨rank % degree, Nat.mod_lt rank hdegree⟩] := by + let input := binarySourceConvolutionPhysicalPairQuery + rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) + have hsecond := factor400BinarySourceConvolutionPairSecondUnary_query + hdegree lower left right source width coefficient rank + have hlookup := fiveOriginalDynamicBitWord_valid + binarySourceConvolutionPairSecondUnary + binarySourceConvolutionPairRightWord + input (rank % degree) hsecond + unfold binarySourceConvolutionPairRightBit + change fiveFamilyOriginalDynamicBitWord + binarySourceConvolutionPairSecondUnary + binarySourceConvolutionPairRightWord input = _ + rw [hlookup, + factor400BinarySourceConvolutionPairRightWord_query] + congr 1 + exact factor400BinaryFiniteWordBits_drop_head + right (rank % degree) (Nat.mod_lt rank hdegree) + +@[simp] private theorem factor400BinarySourceConvolutionEqualOrderingBit_ordering + (outcome : EncodedWordOrdering) : + binarySourceConvolutionEqualOrderingBit + (encodedWordOrderingWord outcome) = + [decide (outcome = .equal)] := by + unfold binarySourceConvolutionEqualOrderingBit + rw [fixedDelimitedWordEqualityBitWord_eq] + have hselector := fixedDelimitedWordEqualitySelector_valid + [true, false] (encodedWordOrderingWord outcome) [] + simp only [List.append_nil] at hselector + rw [hselector] + cases outcome <;> rfl + +private theorem factor400BinarySourceConvolutionPairSumUnary_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairSumUnary + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + List.replicate (rank / degree + rank % degree) true := by + unfold binarySourceConvolutionPairSumUnary + apply fourFamilyComputedUnarySumOutput_valid + binarySourceConvolutionPairFirstUnary + binarySourceConvolutionPairSecondUnary + _ (rank / degree) (rank % degree) + · exact factor400BinarySourceConvolutionPairFirstUnary_query + hdegree lower left right source width coefficient rank + · exact factor400BinarySourceConvolutionPairSecondUnary_query + hdegree lower left right source width coefficient rank + +private theorem factor400BinarySourceConvolutionPairMatchInput_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairMatchInput + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + lengthPrefixedWord + (List.replicate (rank / degree + rank % degree) true) ++ + lengthPrefixedWord + (List.replicate coefficient true) := by + unfold binarySourceConvolutionPairMatchInput + rw [factor400BinarySourceConvolutionPairSumUnary_query + hdegree lower left right source width coefficient rank, + factor400BinarySourceConvolutionPairCoefficientUnary_query] + +private theorem factor400BinarySourceConvolutionPairMatchBit_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) : + binarySourceConvolutionPairMatchBit + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + [decide (rank / degree + rank % degree = coefficient)] := by + unfold binarySourceConvolutionPairMatchBit + simp only [Function.comp_apply] + rw [factor400BinarySourceConvolutionPairMatchInput_query + hdegree lower left right source width coefficient rank] + rw [show lengthPrefixedWord + (List.replicate (rank / degree + rank % degree) true) ++ + lengthPrefixedWord (List.replicate coefficient true) = + lengthPrefixedWord + (List.replicate (rank / degree + rank % degree) true) ++ + lengthPrefixedWord (List.replicate coefficient true) ++ [] by + simp only [List.append_nil]] + rw [sourceFourFamilyDelimitedUnaryComparisonInput_valid] + unfold fourFamilyNaturalOrderingBitsOutput + rw [show lengthPrefixedWord + (Computability.encodeNat (rank / degree + rank % degree)) ++ + lengthPrefixedWord (Computability.encodeNat coefficient) = + lengthPrefixedWord + (Computability.encodeNat (rank / degree + rank % degree)) ++ + lengthPrefixedWord (Computability.encodeNat coefficient) ++ [] by + simp only [List.append_nil]] + rw [sourcePreservingNaturalComparison_valid + (Computability.encodeNat (rank / degree + rank % degree)) + (Computability.encodeNat coefficient) [], + firstFieldSuffix_valid, + factor400BinarySourceConvolutionEqualOrderingBit_ordering, + littleEndianNaturalOrdering_encodeNat] + split_ifs <;> simp_all <;> omega + +private theorem factor400BinarySourceConvolutionPairProductQuery_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source width : List Bool) (coefficient rank : ℕ) + (hrank : rank < degree ^ 2) : + factor400BinarySourceConvolutionPairProductQuery + (binarySourceConvolutionPhysicalPairQuery rank width coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + [decide (rank / degree + rank % degree = coefficient), + left ⟨rank / degree, by + apply (Nat.div_lt_iff_lt_mul hdegree).2 + simpa only [pow_two] using hrank⟩, + right ⟨rank % degree, Nat.mod_lt rank hdegree⟩] := by + unfold factor400BinarySourceConvolutionPairProductQuery + factor400BinarySourceConvolutionPairProductTail + rw [factor400BinarySourceConvolutionPairMatchBit_query + hdegree lower left right source width coefficient rank, + factor400BinarySourceConvolutionPairLeftBit_query + hdegree lower left right source width coefficient rank hrank, + factor400BinarySourceConvolutionPairRightBit_query + hdegree lower left right source width coefficient rank] + rfl + +theorem factor400BinarySourceConvolution_range_mul_flatMap + (outer inner : ℕ) : + List.range (outer * inner) = + (List.range outer).flatMap + (fun row => (List.range inner).map + (fun column => row * inner + column)) := by + induction outer with + | zero => simp only [zero_mul, List.range_zero, List.flatMap_nil] + | succ outer ih => + rw [Nat.succ_mul, List.range_add, ih, List.range_succ] + simp only [List.flatMap_append, List.flatMap_cons, List.flatMap_nil, List.append_nil] + +@[simp] theorem + factor400BinarySourceConvolutionCoefficientPairWidthOutput_query + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (coefficient : ℕ) (source : List Bool) : + binarySourceConvolutionCoefficientPairWidthOutput + (binarySourceConvolutionCoefficientQuery coefficient + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + List.replicate (degree ^ 2) true := by + simp only [binarySourceConvolutionCoefficientPairWidthOutput, + factor400BinarySourceConvolutionCoefficientRawSource, + binarySourceConvolutionCoefficientQuery, Function.comp_apply, + firstFieldSuffix_valid, factor400BinarySourceConvolutionPairWidthOutput_query] + +private theorem factor400BinarySourceConvolutionPairCatalogue_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (coefficient : Fin (2 * degree)) (source : List Bool) : + binarySourceConvolutionPairCatalogue + (binarySourceConvolutionCoefficientQuery coefficient.val + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + sourceMixedRadixOriginalSourceQueryStream + (wordConvolutionQueries left right coefficient) := by + let raw := factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source + let input := binarySourceConvolutionCoefficientQuery + coefficient.val raw + have hwidth : binarySourceConvolutionPairWidth.output input = + List.replicate (degree ^ 2) true := by + exact factor400BinarySourceConvolutionCoefficientPairWidthOutput_query + lower left right coefficient.val source + have hcatalogue := maskDynamicGridCandidateCatalogueOutput_valid + binarySourceConvolutionPairWidth + factor400BinarySourceConvolutionPairProductQueryComputable + input (degree ^ 2) hwidth + change binarySourceConvolutionPairCatalogue input = _ + unfold binarySourceConvolutionPairCatalogue + rw [hcatalogue] + rw [pow_two, factor400BinarySourceConvolution_range_mul_flatMap] + have hfin : List.range degree = + (List.finRange degree).map (fun index => index.val) := + List.map_coe_finRange_eq_range.symm + simp_rw [hfin] + simp only [List.flatMap_map] + unfold sourceMixedRadixOriginalSourceQueryStream + wordConvolutionQueries + simp only [List.flatMap_assoc, List.flatMap_map] + apply List.flatMap_congr + intro row _ + apply List.flatMap_congr + intro column _ + have hrank : row.val * degree + column.val < degree ^ 2 := by + have hrow := row.isLt + have hcolumn := column.isLt + nlinarith + have hdiv : (row.val * degree + column.val) / degree = row.val := by + simpa only [Nat.mul_comm, Nat.div_eq_of_lt column.isLt, add_zero] using + Nat.mul_add_div hdegree row.val column.val + have hmod : (row.val * degree + column.val) % degree = column.val := by + exact Nat.mul_add_mod_of_lt column.isLt + have hquery := factor400BinarySourceConvolutionPairProductQuery_query + hdegree lower left right source (List.replicate (degree ^ 2) true) + coefficient.val (row.val * degree + column.val) hrank + have hbase : + lengthPrefixedWord + (List.replicate (row.val * degree + column.val) true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceConvolutionPairWidth input = + binarySourceConvolutionPhysicalPairQuery + (row.val * degree + column.val) + (List.replicate (degree ^ 2) true) + coefficient.val raw := by + unfold sourceQaryMaskDynamicGridBaseSource + rw [hwidth] + simp only [binarySourceConvolutionCoefficientQuery, binarySourceConvolutionPhysicalPairQuery, + List.append_assoc, input, raw] + rw [hbase, hquery] + simp only [hdiv, hmod] + +private theorem factor400BinarySourceConvolutionCoefficientPackedQuery_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (coefficient : Fin (2 * degree)) (source : List Bool) : + binarySourceConvolutionCoefficientPackedQuery + (binarySourceConvolutionCoefficientQuery coefficient.val + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + wordConvolutionCoefficientQuery left right coefficient := by + unfold binarySourceConvolutionCoefficientPackedQuery + simp only [factor400BinarySourceConvolutionCoefficientPairWidthOutput_query] + rw [factor400BinarySourceConvolutionPairCatalogue_query + hdegree lower left right coefficient source] + unfold wordConvolutionCoefficientQuery convolutionCoefficientQuery + unaryBoundedFoldWord + rw [wordConvolutionQueries_length] + simp only [pow_two] + +private theorem factor400BinarySourceConvolutionCoefficientBit_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (coefficient : Fin (2 * degree)) (source : List Bool) : + binarySourceConvolutionCoefficientBit + (binarySourceConvolutionCoefficientQuery coefficient.val + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + [GapCVP.Core.EffectiveBinaryField.multiplyWords + left right coefficient] := by + unfold binarySourceConvolutionCoefficientBit + rw [Function.comp_apply, + factor400BinarySourceConvolutionCoefficientPackedQuery_query + hdegree lower left right coefficient source, + convolutionCoefficientOutput_word] + +@[simp] private theorem factor400BinarySourceRawConvolutionWidthOutput_query + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + binarySourceRawConvolutionWidthOutput + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) = + List.replicate (2 * degree) true := by + simp only [binarySourceRawConvolutionWidthOutput, factor400BinarySourceLeftBits_query, + factor400BinaryFiniteWordBits_length] + +@[simp] private theorem factor400BinarySourceRawConvolutionCoefficientInput_query + (rank : ℕ) (raw : List Bool) : + binarySourceRawConvolutionCoefficientInput + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceRawConvolutionWidth raw) = + binarySourceConvolutionCoefficientQuery rank raw := by + simp only [binarySourceRawConvolutionCoefficientInput, sourceQaryMaskDynamicGridBaseSource, + firstFieldContents_valid, factor400BinarySourceRawConvolutionRankSource, + factor400BinarySourceSkipFields, + CompTriple.comp_eq, Function.comp_apply, firstFieldSuffix_valid, + binarySourceConvolutionCoefficientQuery] + +end + +section + +open Turing GapCVP.BinaryEncoding GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM +open GapCVP.SourceFourFamilyMarkerRotationTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceFieldMultiplicationTM +open GapCVP.BinarySourceConvolutionTM + +private theorem factor400BinarySourceRawConvolutionCoefficientCatalogue_width + (raw : List Bool) (count : ℕ) + (hwidth : binarySourceRawConvolutionWidth.output raw = + List.replicate count true) : + binarySourceRawConvolutionCoefficientCatalogue raw = + (List.range count).flatMap fun rank => + lengthPrefixedWord + (binarySourceRawConvolutionCoefficientCandidate + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceRawConvolutionWidth raw)) := by + exact maskDynamicGridCandidateCatalogueOutput_valid + binarySourceRawConvolutionWidth + factor400BinarySourceRawConvolutionCoefficientCandidateComputable + raw count hwidth + +private theorem factor400BinarySourceRawConvolutionCoefficientCandidate_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (coefficient : Fin (2 * degree)) (source : List Bool) : + binarySourceRawConvolutionCoefficientCandidate + (lengthPrefixedWord (List.replicate coefficient.val true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceRawConvolutionWidth + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source)) = + [GapCVP.Core.EffectiveBinaryField.multiplyWords + left right coefficient] := by + unfold binarySourceRawConvolutionCoefficientCandidate + rw [Function.comp_apply, + factor400BinarySourceRawConvolutionCoefficientInput_query] + exact factor400BinarySourceConvolutionCoefficientBit_query + hdegree lower left right coefficient source + +private theorem factor400BinarySourceRawConvolutionCoefficientCatalogue_query + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + binarySourceRawConvolutionCoefficientCatalogue + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) = + sourceMixedRadixOriginalSourceQueryStream + ((List.finRange (2 * degree)).map fun coefficient => + [GapCVP.Core.EffectiveBinaryField.multiplyWords + left right coefficient]) := by + let raw := factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source + have hwidth : binarySourceRawConvolutionWidth.output raw = + List.replicate (2 * degree) true := + factor400BinarySourceRawConvolutionWidthOutput_query + lower left right source + change binarySourceRawConvolutionCoefficientCatalogue raw = _ + rw [factor400BinarySourceRawConvolutionCoefficientCatalogue_width + raw (2 * degree) hwidth] + have hfin : List.range (2 * degree) = + (List.finRange (2 * degree)).map + (fun coefficient => coefficient.val) := + List.map_coe_finRange_eq_range.symm + rw [hfin] + unfold sourceMixedRadixOriginalSourceQueryStream + simp only [List.flatMap_map] + apply List.flatMap_congr + intro coefficient _ + exact congrArg lengthPrefixedWord + (factor400BinarySourceRawConvolutionCoefficientCandidate_query + hdegree lower left right coefficient source) + +private theorem factor400BinarySourceRawConvolutionWord_valid_of_pos + {degree : ℕ} + (hdegree : 0 < degree) + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + binarySourceRawConvolutionWord + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyWords left right) := by + let queries : List (List Bool) := + (List.finRange (2 * degree)).map fun coefficient => + [GapCVP.Core.EffectiveBinaryField.multiplyWords + left right coefficient] + unfold binarySourceRawConvolutionWord + binarySourceRawConvolutionPackedOutput + rw [Function.comp_apply, + factor400BinarySourceRawConvolutionWidthOutput_query + lower left right source, + factor400BinarySourceRawConvolutionCoefficientCatalogue_query + hdegree lower left right source] + have hfold := boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries + fiveFamilyOriginalHeadBitWord queries [] + calc + _ = fourFamilyOriginalMarkerStream + fiveFamilyOriginalHeadBitWord queries := by + simpa only [unaryBoundedFoldWord, List.length_map, List.length_finRange, List.append_nil, + List.nil_append, + queries] using hfold + _ = _ := by + unfold fourFamilyOriginalMarkerStream finiteWordBits + dsimp [queries] + rw [List.flatMap_map] + simp_rw [fiveFamilyOriginalHeadBitWord_eq] + change + (List.finRange (2 * degree)).flatMap + (fun coefficient => + [GapCVP.Core.EffectiveBinaryField.multiplyWords + left right coefficient]) = + (List.finRange (2 * degree)).map + (GapCVP.Core.EffectiveBinaryField.multiplyWords left right) + calc + _ = ((List.finRange (2 * degree)).map + (GapCVP.Core.EffectiveBinaryField.multiplyWords left right)).flatMap + (fun bit => [bit]) := by + rw [List.flatMap_map] + _ = _ := List.flatMap_singleton' _ + +theorem factor400BinarySourceRawConvolutionWord_valid + {degree : ℕ} + (lower left right : GapCVP.Core.EffectiveBinaryField.Word degree) + (source : List Bool) : + binarySourceRawConvolutionWord + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyWords left right) := by + cases degree with + | zero => + let raw := factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source + have hwidth : binarySourceRawConvolutionWidth.output raw = + List.replicate 0 true := by + change binarySourceRawConvolutionWidthOutput + (factor400BinarySourceFieldQuery + (finiteWordBits lower) + (finiteWordBits left) + (finiteWordBits right) source) = [] + exact factor400BinarySourceRawConvolutionWidthOutput_query + lower left right source + have hcatalogue : + binarySourceRawConvolutionCoefficientCatalogue raw = [] := by + rw [factor400BinarySourceRawConvolutionCoefficientCatalogue_width + raw 0 hwidth] + rfl + change binarySourceRawConvolutionWord raw = _ + unfold binarySourceRawConvolutionWord + binarySourceRawConvolutionPackedOutput + change binarySourceRawConvolutionWidthOutput raw = [] + at hwidth + rw [Function.comp_apply, hwidth, hcatalogue] + simp only [boundedRecordFoldOutput, List.nil_append, parseUnaryBoundedFold, + Function.iterate_zero, id_eq, + finiteWordBits, Nat.mul_zero, List.finRange_zero, List.map_nil] + | succ degree => + exact factor400BinarySourceRawConvolutionWord_valid_of_pos + (Nat.zero_lt_succ degree) lower left right source + +end + +end BinarySourceConvolutionCorrectness + +namespace BinarySourceFieldMultiplicationTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryModularReductionTM +open GapCVP.BinarySourceConvolutionTM + +private noncomputable def binarySourceFieldOperandDegreeWidth : + SourceQaryMaskDynamicGridWidth where + output := binarySourceCoefficientDegreeUnary + computer := factor400BinarySourceCoefficientDegreeUnaryComputable + +private def binarySourceDegreePaddedBitSource + (field : List Bool → List Bool) : List Bool → List Bool := + field ∘ factor400BinarySourceSkipFields 2 + +private noncomputable def factor400BinarySourceDegreePaddedBitSourceComputable + {field : List Bool → List Bool} + (computer : BitTM field) : + BitTM + (binarySourceDegreePaddedBitSource field) := + GapCVP.TMComposition.computableInPolyTime + (binarySourceSkipFieldsComputable 2) computer + +private def factor400BinarySourceDegreePaddedBitWord + (field : List Bool → List Bool) : List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + firstFieldContents (binarySourceDegreePaddedBitSource field) + +private noncomputable def factor400BinarySourceDegreePaddedBitComputable + {field : List Bool → List Bool} + (computer : BitTM field) : + BitTM + (factor400BinarySourceDegreePaddedBitWord field) := + fiveOriginalDynamicBitComputable + firstFieldContentsComputable + (factor400BinarySourceDegreePaddedBitSourceComputable computer) + +@[simp] private theorem factor400BinarySourceDegreePaddedBitWord_query + (field : List Bool → List Bool) + (input : List Bool) (rank : ℕ) : + factor400BinarySourceDegreePaddedBitWord field + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceFieldOperandDegreeWidth input) = + [(field input).getD rank false] := by + let query := lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceFieldOperandDegreeWidth input + have hindex : firstFieldContents query = + List.replicate rank true := by + simp only [firstFieldContents_valid, query] + unfold factor400BinarySourceDegreePaddedBitWord + rw [fiveOriginalDynamicBitWord_valid + firstFieldContents + (binarySourceDegreePaddedBitSource field) + query rank hindex] + simp only [binarySourceDegreePaddedBitSource, factor400BinarySourceSkipFields, + CompTriple.comp_eq, + sourceQaryMaskDynamicGridBaseSource, Function.comp_apply, firstFieldSuffix_valid, + List.headD_eq_head?_getD, + List.head?_drop, List.getD_eq_getElem?_getD, query] + +private def binarySourceDegreePaddedFieldBits + {field : List Bool → List Bool} + (computer : BitTM field) : List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + binarySourceFieldOperandDegreeWidth + (factor400BinarySourceDegreePaddedBitComputable computer) + +private noncomputable def binarySourceDegreePaddedFieldComputable + {field : List Bool → List Bool} + (computer : BitTM field) : + BitTM + (binarySourceDegreePaddedFieldBits computer) := + maskDynamicGridRecordCatalogueComputable + binarySourceFieldOperandDegreeWidth + (factor400BinarySourceDegreePaddedBitComputable computer) + +private theorem factor400BinarySourceDegreePaddedFieldBits_eq + {field : List Bool → List Bool} + (computer : BitTM field) + (input : List Bool) : + binarySourceDegreePaddedFieldBits computer input = + finiteWordBits + (factor400BinarySourcePaddedWord + (factor400BinarySourceLeftBits input).length (field input)) := by + let degree := (factor400BinarySourceLeftBits input).length + have hwidth : + binarySourceFieldOperandDegreeWidth.output input = + List.replicate degree true := by + rfl + unfold binarySourceDegreePaddedFieldBits + rw [maskDynamicGridRecordCatalogueOutput_valid + binarySourceFieldOperandDegreeWidth + (factor400BinarySourceDegreePaddedBitComputable computer) + input degree hwidth] + simp_rw [factor400BinarySourceDegreePaddedBitWord_query] + have hfin : List.range degree = + (List.finRange degree).map (fun index => index.val) := + List.map_coe_finRange_eq_range.symm + rw [hfin, List.flatMap_map] + change + (List.finRange degree).flatMap + (fun index => [(field input).getD index.val false]) = + (List.finRange degree).map + (fun index => (field input).getD index.val false) + calc + _ = ((List.finRange degree).map + (fun index => (field input).getD index.val false)).flatMap + (fun bit => [bit]) := by + rw [List.flatMap_map] + _ = _ := List.flatMap_singleton' _ + +private def binarySourceNormalizedFieldQuery + (input : List Bool) : List Bool := + factor400BinarySourceFieldQuery + (binarySourceDegreePaddedFieldBits + binarySourceLowerBitsComputable input) + (binarySourceDegreePaddedFieldBits + binarySourceLeftBitsComputable input) + (binarySourceDegreePaddedFieldBits + binarySourceRightBitsComputable input) + input + +private noncomputable def factor400BinarySourceNormalizedFieldQueryComputable : + BitTM + binarySourceNormalizedFieldQuery := by + have hlower := GapCVP.TMComposition.computableInPolyTime + (binarySourceDegreePaddedFieldComputable + binarySourceLowerBitsComputable) + structuralPrefixWriterComputable + have hleft := GapCVP.TMComposition.computableInPolyTime + (binarySourceDegreePaddedFieldComputable + binarySourceLeftBitsComputable) + structuralPrefixWriterComputable + have hright := GapCVP.TMComposition.computableInPolyTime + (binarySourceDegreePaddedFieldComputable + binarySourceRightBitsComputable) + structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hlower + (pointwiseAppendComputable hleft + (pointwiseAppendComputable hright + (Turing.idComputableInPolyTime bitEncoding))) + change BitTM + (fun input => + lengthPrefixedWord + (binarySourceDegreePaddedFieldBits + binarySourceLowerBitsComputable input) ++ + lengthPrefixedWord + (binarySourceDegreePaddedFieldBits + binarySourceLeftBitsComputable input) ++ + lengthPrefixedWord + (binarySourceDegreePaddedFieldBits + binarySourceRightBitsComputable input) ++ input) + simpa only [Function.comp_apply, id_eq, List.append_assoc] + using hphysical + +end BinarySourceFieldMultiplicationTM + +namespace BinarySourceModularReductionFoldTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.BinaryDimensionTM GapCVP.BinaryModularReductionTM +open GapCVP.BinarySourceFieldMultiplicationTM + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularReductionQuery + (lower product source : List Bool) : List Bool := + lengthPrefixedWord lower ++ lengthPrefixedWord product ++ source + +private def binarySourceModularReductionLowerBits : + List Bool → List Bool := + firstFieldContents + +private noncomputable def factor400BinarySourceModularReductionLowerBitsComputable : + BitTM + binarySourceModularReductionLowerBits := + firstFieldContentsComputable + +private def binarySourceModularReductionProductBits : + List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix + +private noncomputable def factor400BinarySourceModularReductionProductBitsComputable : + BitTM + binarySourceModularReductionProductBits := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + +private def binarySourceModularReductionOriginalSource : + List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +private noncomputable def factor400BinarySourceModularReductionOriginalSourceComputable : + BitTM + binarySourceModularReductionOriginalSource := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + +@[simp] private theorem factor400BinarySourceModularReductionLowerBits_query + (lower product source : List Bool) : + binarySourceModularReductionLowerBits + (binarySourceModularReductionQuery lower product source) = + lower := by + simp only [binarySourceModularReductionLowerBits, + binarySourceModularReductionQuery, + List.append_assoc, firstFieldContents_valid] + +@[simp] private theorem factor400BinarySourceModularReductionProductBits_query + (lower product source : List Bool) : + binarySourceModularReductionProductBits + (binarySourceModularReductionQuery lower product source) = + product := by + simp only [binarySourceModularReductionProductBits, + Function.comp_apply, binarySourceModularReductionQuery, + List.append_assoc, firstFieldSuffix_valid, firstFieldContents_valid] + +@[simp] private theorem factor400BinarySourceModularReductionOriginalSource_query + (lower product source : List Bool) : + binarySourceModularReductionOriginalSource + (binarySourceModularReductionQuery lower product source) = + source := by + simp only [binarySourceModularReductionOriginalSource, + Function.comp_apply, binarySourceModularReductionQuery, + List.append_assoc, firstFieldSuffix_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularReductionDegreeUnary : + List Bool → List Bool := + sourceInputLengthUnary ∘ + binarySourceModularReductionLowerBits + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularReductionDegreeUnaryComputable : + BitTM + binarySourceModularReductionDegreeUnary := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularReductionLowerBitsComputable + sourceInputLengthUnaryComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem factor400BinarySourceModularReductionDegreeUnary_valid + {degree : ℕ} + (lower : GapCVP.Core.EffectiveBinaryField.Word degree) + (product source : List Bool) : + binarySourceModularReductionDegreeUnary + (binarySourceModularReductionQuery + (finiteWordBits lower) product source) = + List.replicate degree true := by + simp only [binarySourceModularReductionDegreeUnary, + Function.comp_apply, + factor400BinarySourceModularReductionLowerBits_query, + sourceInputLengthUnary, + factor400BinaryFiniteWordBits_length] + +private def factor400BinarySourceModularReductionPrefixedLower : + List Bool → List Bool := + (fun word : List Bool => lengthPrefixedWord word) ∘ + binarySourceModularReductionLowerBits + +private noncomputable def factor400BinarySourceModularReductionPrefixedLowerComputable : + BitTM + factor400BinarySourceModularReductionPrefixedLower := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularReductionLowerBitsComputable + structuralPrefixWriterComputable + +private def factor400BinarySourceModularReductionPrefixedProduct : + List Bool → List Bool := + (fun word : List Bool => lengthPrefixedWord word) ∘ + binarySourceModularReductionProductBits + +private noncomputable def factor400BinarySourceModularReductionPrefixedProductComputable : + BitTM + factor400BinarySourceModularReductionPrefixedProduct := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularReductionProductBitsComputable + structuralPrefixWriterComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularReductionInitialState + (lower product source : List Bool) : List Bool := + lengthPrefixedWord [] ++ + (lengthPrefixedWord lower ++ + (lengthPrefixedWord product ++ source)) + +private def binarySourceModularReductionSeed + (input : List Bool) : List Bool := + lengthPrefixedWord [] ++ + (factor400BinarySourceModularReductionPrefixedLower input ++ + (factor400BinarySourceModularReductionPrefixedProduct input ++ + binarySourceModularReductionOriginalSource input)) + +private noncomputable def factor400BinarySourceModularReductionSeedComputable : + BitTM + binarySourceModularReductionSeed := + pointwiseAppendComputable + (sourceFixedWordComputable (lengthPrefixedWord [])) + (pointwiseAppendComputable + factor400BinarySourceModularReductionPrefixedLowerComputable + (pointwiseAppendComputable + factor400BinarySourceModularReductionPrefixedProductComputable + factor400BinarySourceModularReductionOriginalSourceComputable)) + +@[simp] private theorem factor400BinarySourceModularReductionSeed_query + (lower product source : List Bool) : + binarySourceModularReductionSeed + (binarySourceModularReductionQuery lower product source) = + binarySourceModularReductionInitialState + lower product source := by + simp only [binarySourceModularReductionSeed, + factor400BinarySourceModularReductionPrefixedLower, + factor400BinarySourceModularReductionPrefixedProduct, + Function.comp_apply, + factor400BinarySourceModularReductionLowerBits_query, + factor400BinarySourceModularReductionProductBits_query, + factor400BinarySourceModularReductionOriginalSource_query, + binarySourceModularReductionInitialState] + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularReductionFoldPreparation + (input : List Bool) : List Bool := + binarySourceModularReductionDegreeUnary input ++ false :: + binarySourceModularReductionSeed input + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularReductionFoldPreparationComputable : + BitTM + binarySourceModularReductionFoldPreparation := + pointwiseAppendComputable + factor400BinarySourceModularReductionDegreeUnaryComputable + (GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularReductionSeedComputable + (prependBitComputable false)) + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem factor400BinarySourceModularReductionFoldPreparation_valid + {degree : ℕ} + (lower : GapCVP.Core.EffectiveBinaryField.Word degree) + (product : GapCVP.Core.EffectiveBinaryField.Word (2 * degree)) + (source : List Bool) : + binarySourceModularReductionFoldPreparation + (binarySourceModularReductionQuery + (finiteWordBits lower) (finiteWordBits product) source) = + unaryBoundedFoldWord degree + (binarySourceModularReductionInitialState + (finiteWordBits lower) (finiteWordBits product) source) := by + rw [binarySourceModularReductionFoldPreparation, + factor400BinarySourceModularReductionDegreeUnary_valid, + factor400BinarySourceModularReductionSeed_query] + rfl + +end BinarySourceModularReductionFoldTM + +namespace BinarySourceFieldMultiplicationTM + +open Turing GapCVP.BinaryEncoding GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryModularReductionTM +open GapCVP.BinarySourceConvolutionTM GapCVP.BinarySourceConvolutionCorrectness +open GapCVP.BinarySourceModularReductionFoldTM + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceProductReductionQuery + (input : List Bool) : List Bool := + binarySourceModularReductionQuery + (binarySourceDegreePaddedFieldBits + binarySourceLowerBitsComputable input) + (binarySourceRawConvolutionWord + (binarySourceNormalizedFieldQuery input)) + input + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceProductReductionQueryComputable : + BitTM + binarySourceProductReductionQuery := by + have hlower := GapCVP.TMComposition.computableInPolyTime + (binarySourceDegreePaddedFieldComputable + binarySourceLowerBitsComputable) + structuralPrefixWriterComputable + have hproduct := GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceNormalizedFieldQueryComputable + factor400BinarySourceRawConvolutionComputable) + structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hlower + (pointwiseAppendComputable hproduct + (Turing.idComputableInPolyTime bitEncoding)) + change BitTM + (fun input => + lengthPrefixedWord + (binarySourceDegreePaddedFieldBits + binarySourceLowerBitsComputable input) ++ + lengthPrefixedWord + (binarySourceRawConvolutionWord + (binarySourceNormalizedFieldQuery input)) ++ input) + simpa only [Function.comp_apply, id_eq, List.append_assoc] + using hphysical + +@[simp] private theorem factor400BinarySourceDegreePaddedLowerBits_query + (lower left right source : List Bool) : + binarySourceDegreePaddedFieldBits + binarySourceLowerBitsComputable + (factor400BinarySourceFieldQuery lower left right source) = + finiteWordBits + (factor400BinarySourcePaddedWord left.length lower) := by + calc + _ = finiteWordBits + (factor400BinarySourcePaddedWord + (factor400BinarySourceLeftBits + (factor400BinarySourceFieldQuery + lower left right source)).length + (factor400BinarySourceLowerBits + (factor400BinarySourceFieldQuery + lower left right source))) := + factor400BinarySourceDegreePaddedFieldBits_eq + binarySourceLowerBitsComputable + (factor400BinarySourceFieldQuery lower left right source) + _ = _ := by + rw [factor400BinarySourceLeftBits_query, + factor400BinarySourceLowerBits_query] + +@[simp] private theorem factor400BinarySourceDegreePaddedLeftBits_query + (lower left right source : List Bool) : + binarySourceDegreePaddedFieldBits + binarySourceLeftBitsComputable + (factor400BinarySourceFieldQuery lower left right source) = + finiteWordBits + (factor400BinarySourcePaddedWord left.length left) := by + calc + _ = finiteWordBits + (factor400BinarySourcePaddedWord + (factor400BinarySourceLeftBits + (factor400BinarySourceFieldQuery + lower left right source)).length + (factor400BinarySourceLeftBits + (factor400BinarySourceFieldQuery + lower left right source))) := + factor400BinarySourceDegreePaddedFieldBits_eq + binarySourceLeftBitsComputable + (factor400BinarySourceFieldQuery lower left right source) + _ = _ := by + rw [factor400BinarySourceLeftBits_query] + +@[simp] private theorem factor400BinarySourceDegreePaddedRightBits_query + (lower left right source : List Bool) : + binarySourceDegreePaddedFieldBits + binarySourceRightBitsComputable + (factor400BinarySourceFieldQuery lower left right source) = + finiteWordBits + (factor400BinarySourcePaddedWord left.length right) := by + calc + _ = finiteWordBits + (factor400BinarySourcePaddedWord + (factor400BinarySourceLeftBits + (factor400BinarySourceFieldQuery + lower left right source)).length + (factor400BinarySourceRightBits + (factor400BinarySourceFieldQuery + lower left right source))) := + factor400BinarySourceDegreePaddedFieldBits_eq + binarySourceRightBitsComputable + (factor400BinarySourceFieldQuery lower left right source) + _ = _ := by + rw [factor400BinarySourceLeftBits_query, + factor400BinarySourceRightBits_query] + +private theorem factor400BinarySourceNormalizedFieldQuery_query + (lower left right source : List Bool) : + binarySourceNormalizedFieldQuery + (factor400BinarySourceFieldQuery lower left right source) = + factor400BinarySourceFieldQuery + (finiteWordBits + (factor400BinarySourcePaddedWord left.length lower)) + (finiteWordBits + (factor400BinarySourcePaddedWord left.length left)) + (finiteWordBits + (factor400BinarySourcePaddedWord left.length right)) + (factor400BinarySourceFieldQuery lower left right source) := by + unfold binarySourceNormalizedFieldQuery + rw [factor400BinarySourceDegreePaddedLowerBits_query, + factor400BinarySourceDegreePaddedLeftBits_query, + factor400BinarySourceDegreePaddedRightBits_query] + +private theorem factor400BinarySourceNormalizedRawConvolution_query + (lower left right source : List Bool) : + binarySourceRawConvolutionWord + (binarySourceNormalizedFieldQuery + (factor400BinarySourceFieldQuery lower left right source)) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyWords + (factor400BinarySourcePaddedWord left.length left) + (factor400BinarySourcePaddedWord left.length right)) := by + rw [factor400BinarySourceNormalizedFieldQuery_query, + factor400BinarySourceRawConvolutionWord_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem factor400BinarySourceProductReductionQuery_query + (lower left right source : List Bool) : + binarySourceProductReductionQuery + (factor400BinarySourceFieldQuery lower left right source) = + binarySourceModularReductionQuery + (finiteWordBits + (factor400BinarySourcePaddedWord left.length lower)) + (finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyWords + (factor400BinarySourcePaddedWord left.length left) + (factor400BinarySourcePaddedWord left.length right))) + (factor400BinarySourceFieldQuery lower left right source) := by + unfold binarySourceProductReductionQuery + rw [factor400BinarySourceDegreePaddedLowerBits_query, + factor400BinarySourceNormalizedRawConvolution_query] + +end BinarySourceFieldMultiplicationTM + +namespace BinarySourceModularDegreeStepTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryDimensionTM +open GapCVP.BinarySourceConvolutionTM GapCVP.BinaryModularReductionTM + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularDegreeState + (offset : ℕ) (lower current source : List Bool) : List Bool := + lengthPrefixedWord (List.replicate offset true) ++ + lengthPrefixedWord lower ++ + lengthPrefixedWord current ++ source + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularOffsetUnary : List Bool → List Bool := + firstFieldContents + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularOffsetUnaryComputable : + BitTM + binarySourceModularOffsetUnary := + firstFieldContentsComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularLowerWord : List Bool → List Bool := + firstFieldContents ∘ factor400BinarySourceSkipFields 1 + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularLowerWordComputable : + BitTM + binarySourceModularLowerWord := + GapCVP.TMComposition.computableInPolyTime + (binarySourceSkipFieldsComputable 1) + firstFieldContentsComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularCurrentWord : List Bool → List Bool := + firstFieldContents ∘ factor400BinarySourceSkipFields 2 + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularCurrentWordComputable : + BitTM + binarySourceModularCurrentWord := + GapCVP.TMComposition.computableInPolyTime + (binarySourceSkipFieldsComputable 2) + firstFieldContentsComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularOriginalSource : List Bool → List Bool := + factor400BinarySourceSkipFields 3 + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularOriginalSourceComputable : + BitTM + binarySourceModularOriginalSource := + binarySourceSkipFieldsComputable 3 + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem factor400BinarySourceModularOffsetUnary_state + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularOffsetUnary + (binarySourceModularDegreeState offset lower current source) = + List.replicate offset true := by + simp only [binarySourceModularOffsetUnary, binarySourceModularDegreeState, List.append_assoc, + firstFieldContents_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem factor400BinarySourceModularLowerWord_state + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularLowerWord + (binarySourceModularDegreeState offset lower current source) = + lower := by + simp only [binarySourceModularLowerWord, factor400BinarySourceSkipFields, CompTriple.comp_eq, + binarySourceModularDegreeState, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid, + firstFieldContents_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem factor400BinarySourceModularCurrentWord_state + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularCurrentWord + (binarySourceModularDegreeState offset lower current source) = + current := by + simp only [binarySourceModularCurrentWord, factor400BinarySourceSkipFields, CompTriple.comp_eq, + binarySourceModularDegreeState, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid, + firstFieldContents_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem factor400BinarySourceModularOriginalSource_state + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularOriginalSource + (binarySourceModularDegreeState offset lower current source) = + source := by + simp only [binarySourceModularOriginalSource, factor400BinarySourceSkipFields, + CompTriple.comp_eq, + binarySourceModularDegreeState, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularLowerDegreeUnary + (input : List Bool) : List Bool := + sourceInputLengthUnary (binarySourceModularLowerWord input) + +private noncomputable def factor400BinarySourceModularLowerDegreeUnaryComputable : + BitTM + binarySourceModularLowerDegreeUnary := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularLowerWordComputable + sourceInputLengthUnaryComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularCurrentWidthUnary + (input : List Bool) : List Bool := + sourceInputLengthUnary (binarySourceModularCurrentWord input) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularCurrentWidthUnaryComputable : + BitTM + binarySourceModularCurrentWidthUnary := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularCurrentWordComputable + sourceInputLengthUnaryComputable + +private def binarySourceModularLastDegreeUnary + (input : List Bool) : List Bool := + (binarySourceModularCurrentWidthUnary input).tail + +private noncomputable def factor400BinarySourceModularLastDegreeUnaryComputable : + BitTM + binarySourceModularLastDegreeUnary := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularCurrentWidthUnaryComputable + dropHeadComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularDescendingDegreeUnary : + List Bool → List Bool := + unarySubtractionOutput + binarySourceModularLastDegreeUnary + binarySourceModularOffsetUnary + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularDescendingDegreeUnaryComputable : + BitTM + binarySourceModularDescendingDegreeUnary := + unarySubtractionComputable + factor400BinarySourceModularLastDegreeUnaryComputable + factor400BinarySourceModularOffsetUnaryComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularShiftStartUnary : List Bool → List Bool := + unarySubtractionOutput + binarySourceModularDescendingDegreeUnary + binarySourceModularLowerDegreeUnary + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularShiftStartUnaryComputable : + BitTM + binarySourceModularShiftStartUnary := + unarySubtractionComputable + factor400BinarySourceModularDescendingDegreeUnaryComputable + factor400BinarySourceModularLowerDegreeUnaryComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def binarySourceModularLeadingGate : List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + binarySourceModularDescendingDegreeUnary + binarySourceModularCurrentWord + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def factor400BinarySourceModularLeadingGateComputable : + BitTM + binarySourceModularLeadingGate := + fiveOriginalDynamicBitComputable + factor400BinarySourceModularDescendingDegreeUnaryComputable + factor400BinarySourceModularCurrentWordComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem factor400BinarySourceModularLowerDegreeUnary_state + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularLowerDegreeUnary + (binarySourceModularDegreeState offset lower current source) = + List.replicate lower.length true := by + simp only [binarySourceModularLowerDegreeUnary, sourceInputLengthUnary, + factor400BinarySourceModularLowerWord_state] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem factor400BinarySourceModularDescendingDegreeUnary_state + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularDescendingDegreeUnary + (binarySourceModularDegreeState offset lower current source) = + List.replicate (current.length - 1 - offset) true := by + unfold binarySourceModularDescendingDegreeUnary + apply unarySubtractionOutput_valid + binarySourceModularLastDegreeUnary + binarySourceModularOffsetUnary + (binarySourceModularDegreeState offset lower current source) + (current.length - 1) offset + · simp only [binarySourceModularLastDegreeUnary, binarySourceModularCurrentWidthUnary, + sourceInputLengthUnary, + factor400BinarySourceModularCurrentWord_state, List.tail_replicate] + · simp only [factor400BinarySourceModularOffsetUnary_state] + +end BinarySourceModularDegreeStepTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part11C.lean b/LeanPool/GapCVP/Part11C.lean new file mode 100644 index 000000000..f615523e3 --- /dev/null +++ b/LeanPool/GapCVP/Part11C.lean @@ -0,0 +1,5669 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part11B + +/-! # GapCVP proof, part 11, continuation 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace BinarySourceModularDegreeStepTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder + +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM + +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.SourceFourFamilyBooleanPredicateTM + +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM + +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryDimensionTM + +open GapCVP.BinarySourceConvolutionTM GapCVP.BinaryModularReductionTM + +private noncomputable def binarySourceModularCurrentWidth : + SourceQaryMaskDynamicGridWidth where + output := binarySourceModularCurrentWidthUnary + computer := factor400BinarySourceModularCurrentWidthUnaryComputable + +private def binarySourceModularCellRankUnary : List Bool → List Bool := + firstFieldContents + +private noncomputable def binarySourceModularCellRankUnaryComputable : + BitTM + binarySourceModularCellRankUnary := + firstFieldContentsComputable + +private def binarySourceModularCellState : List Bool → List Bool := + factor400BinarySourceSkipFields 2 + +private noncomputable def factor400BinarySourceModularCellStateComputable : + BitTM + binarySourceModularCellState := + binarySourceSkipFieldsComputable 2 + +private def binarySourceModularCellLift + (worker : List Bool → List Bool) : List Bool → List Bool := + worker ∘ binarySourceModularCellState + +private noncomputable def binarySourceModularCellLiftComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (binarySourceModularCellLift worker) := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularCellStateComputable computer + +private def binarySourceModularCellShiftStart : List Bool → List Bool := + binarySourceModularCellLift + binarySourceModularShiftStartUnary + +private noncomputable def factor400BinarySourceModularCellShiftStartComputable : + BitTM + binarySourceModularCellShiftStart := + binarySourceModularCellLiftComputable + factor400BinarySourceModularShiftStartUnaryComputable + +private def binarySourceModularCellLowerIndex : List Bool → List Bool := + unarySubtractionOutput + binarySourceModularCellRankUnary + binarySourceModularCellShiftStart + +private noncomputable def factor400BinarySourceModularCellLowerIndexComputable : + BitTM + binarySourceModularCellLowerIndex := + unarySubtractionComputable + binarySourceModularCellRankUnaryComputable + factor400BinarySourceModularCellShiftStartComputable + +private def binarySourceModularCellLowerWord : List Bool → List Bool := + binarySourceModularCellLift + binarySourceModularLowerWord + +private noncomputable def factor400BinarySourceModularCellLowerWordComputable : + BitTM + binarySourceModularCellLowerWord := + binarySourceModularCellLiftComputable + factor400BinarySourceModularLowerWordComputable + +private def binarySourceModularCellLowerBit : List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + binarySourceModularCellLowerIndex + binarySourceModularCellLowerWord + +private noncomputable def factor400BinarySourceModularCellLowerBitComputable : + BitTM + binarySourceModularCellLowerBit := + fiveOriginalDynamicBitComputable + factor400BinarySourceModularCellLowerIndexComputable + factor400BinarySourceModularCellLowerWordComputable + +private def binarySourceModularCellBelowShift : List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + binarySourceModularCellRankUnary + binarySourceModularCellShiftStart + +private noncomputable def factor400BinarySourceModularCellBelowShiftComputable : + BitTM + binarySourceModularCellBelowShift := + fourFamilyComputedUnaryLessBitComputable + binarySourceModularCellRankUnaryComputable + factor400BinarySourceModularCellShiftStartComputable + +private def binarySourceModularCellAtOrAboveShift : + List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + binarySourceModularCellBelowShift + +private noncomputable def factor400BinarySourceModularCellAtOrAboveShiftComputable : + BitTM + binarySourceModularCellAtOrAboveShift := + fourFamilyBooleanNotOutputComputable + factor400BinarySourceModularCellBelowShiftComputable + +private def binarySourceModularCellShiftedLowerBit : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + binarySourceModularCellAtOrAboveShift + binarySourceModularCellLowerBit + +private noncomputable def factor400BinarySourceModularCellShiftedLowerBitComputable : + BitTM + binarySourceModularCellShiftedLowerBit := + fourFamilyBooleanAndComputable + factor400BinarySourceModularCellAtOrAboveShiftComputable + factor400BinarySourceModularCellLowerBitComputable + +private def binarySourceModularCellDescendingDegree : + List Bool → List Bool := + binarySourceModularCellLift + binarySourceModularDescendingDegreeUnary + +private noncomputable def factor400BinarySourceModularCellDescendingDegreeComputable : + BitTM + binarySourceModularCellDescendingDegree := + binarySourceModularCellLiftComputable + factor400BinarySourceModularDescendingDegreeUnaryComputable + +private def binarySourceModularCellRankLessDegree : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + binarySourceModularCellRankUnary + binarySourceModularCellDescendingDegree + +private noncomputable def factor400BinarySourceModularCellRankLessDegreeComputable : + BitTM + binarySourceModularCellRankLessDegree := + fourFamilyComputedUnaryLessBitComputable + binarySourceModularCellRankUnaryComputable + factor400BinarySourceModularCellDescendingDegreeComputable + +private def binarySourceModularCellDegreeLessRank : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + binarySourceModularCellDescendingDegree + binarySourceModularCellRankUnary + +private noncomputable def factor400BinarySourceModularCellDegreeLessRankComputable : + BitTM + binarySourceModularCellDegreeLessRank := + fourFamilyComputedUnaryLessBitComputable + factor400BinarySourceModularCellDescendingDegreeComputable + binarySourceModularCellRankUnaryComputable + +private def binarySourceModularCellLeadingMask : + List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + (sourceFourFamilyBooleanOrOutput + binarySourceModularCellRankLessDegree + binarySourceModularCellDegreeLessRank) + +private noncomputable def factor400BinarySourceModularCellLeadingMaskComputable : + BitTM + binarySourceModularCellLeadingMask := + fourFamilyBooleanNotOutputComputable + (sourceFourFamilyBooleanOrComputable + factor400BinarySourceModularCellRankLessDegreeComputable + factor400BinarySourceModularCellDegreeLessRankComputable) + +private def binarySourceModularCellMask : List Bool → List Bool := + sourceFourFamilyBooleanOrOutput + binarySourceModularCellLeadingMask + binarySourceModularCellShiftedLowerBit + +private noncomputable def factor400BinarySourceModularCellMaskComputable : + BitTM + binarySourceModularCellMask := + sourceFourFamilyBooleanOrComputable + factor400BinarySourceModularCellLeadingMaskComputable + factor400BinarySourceModularCellShiftedLowerBitComputable + +private def binarySourceModularCellCurrentWord : List Bool → List Bool := + binarySourceModularCellLift + binarySourceModularCurrentWord + +private noncomputable def factor400BinarySourceModularCellCurrentWordComputable : + BitTM + binarySourceModularCellCurrentWord := + binarySourceModularCellLiftComputable + factor400BinarySourceModularCurrentWordComputable + +private def binarySourceModularCellDestination : + List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + binarySourceModularCellRankUnary + binarySourceModularCellCurrentWord + +private noncomputable def factor400BinarySourceModularCellDestinationComputable : + BitTM + binarySourceModularCellDestination := + fiveOriginalDynamicBitComputable + binarySourceModularCellRankUnaryComputable + factor400BinarySourceModularCellCurrentWordComputable + +private def binarySourceModularCellLeadingGate : + List Bool → List Bool := + binarySourceModularCellLift + binarySourceModularLeadingGate + +private noncomputable def factor400BinarySourceModularCellLeadingGateComputable : + BitTM + binarySourceModularCellLeadingGate := + binarySourceModularCellLiftComputable + factor400BinarySourceModularLeadingGateComputable + +private def binarySourceModularPackedCell + (input : List Bool) : List Bool := + binarySourceModularCellLeadingGate input ++ + (binarySourceModularCellMask input ++ + binarySourceModularCellDestination input) + +private noncomputable def binarySourceModularPackedCellComputable : + BitTM + binarySourceModularPackedCell := + pointwiseAppendComputable + factor400BinarySourceModularCellLeadingGateComputable + (pointwiseAppendComputable + factor400BinarySourceModularCellMaskComputable + factor400BinarySourceModularCellDestinationComputable) + +private def binarySourceModularPackedCellCatalogue : + List Bool → List Bool := + maskDynamicGridCandidateCatalogueOutput + binarySourceModularCurrentWidth + binarySourceModularPackedCellComputable + +private noncomputable def factor400BinarySourceModularPackedCellCatalogueComputable : + BitTM + binarySourceModularPackedCellCatalogue := + maskDynamicGridCandidateCatalogueComputable + binarySourceModularCurrentWidth + binarySourceModularPackedCellComputable + +private def binarySourceModularPackedRow + (input : List Bool) : List Bool := + binarySourceModularCurrentWidthUnary input ++ false :: + binarySourceModularPackedCellCatalogue input + +private noncomputable def factor400BinarySourceModularPackedRowComputable : + BitTM + binarySourceModularPackedRow := by + have hcatalogue := GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularPackedCellCatalogueComputable + (prependBitComputable false) + exact pointwiseAppendComputable + factor400BinarySourceModularCurrentWidthUnaryComputable hcatalogue + +private def binarySourceModularReducedCurrentWord : + List Bool → List Bool := + modularReductionWordRowOutput ∘ binarySourceModularPackedRow + +private noncomputable def factor400BinarySourceModularReducedCurrentWordComputable : + BitTM + binarySourceModularReducedCurrentWord := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularPackedRowComputable + modularReductionWordRowComputable + +private def binarySourceModularNextOffsetUnary + (input : List Bool) : List Bool := + true :: binarySourceModularOffsetUnary input + +private noncomputable def factor400BinarySourceModularNextOffsetUnaryComputable : + BitTM + binarySourceModularNextOffsetUnary := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularOffsetUnaryComputable + (prependBitComputable true) + +private noncomputable def factor400BinarySourceModularPrefixComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (fun input => lengthPrefixedWord (worker input)) := + GapCVP.TMComposition.computableInPolyTime + computer structuralPrefixWriterComputable + +private def binarySourceModularDegreeStepOutput + (input : List Bool) : List Bool := + lengthPrefixedWord (binarySourceModularNextOffsetUnary input) ++ + (lengthPrefixedWord (binarySourceModularLowerWord input) ++ + (lengthPrefixedWord + (binarySourceModularReducedCurrentWord input) ++ + binarySourceModularOriginalSource input)) + +private noncomputable def factor400BinarySourceModularDegreeStepComputable : + BitTM + binarySourceModularDegreeStepOutput := + pointwiseAppendComputable + (factor400BinarySourceModularPrefixComputable + factor400BinarySourceModularNextOffsetUnaryComputable) + (pointwiseAppendComputable + (factor400BinarySourceModularPrefixComputable + factor400BinarySourceModularLowerWordComputable) + (pointwiseAppendComputable + (factor400BinarySourceModularPrefixComputable + factor400BinarySourceModularReducedCurrentWordComputable) + factor400BinarySourceModularOriginalSourceComputable)) + +end BinarySourceModularDegreeStepTM + +namespace BinarySourceModularDegreeStepCorrectness + +open Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.SourceFormulaStructuralDecoder GapCVP.FormulaSemanticCert +open GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.SourceFourFamilyMarkerRotationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryDimensionTM +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceConvolutionTM +open GapCVP.BinarySourceModularDegreeStepTM + +private theorem factor400BinarySourceModularReductionMarkerStream_length + (queries : List (List Bool)) : + (fourFamilyOriginalMarkerStream + modularReductionCellOutput queries).length = queries.length := by + induction queries with + | nil => + simp only [fourFamilyOriginalMarkerStream, List.flatMap_nil, List.length_nil] + | cons query remaining ih => + change + (modularReductionCellOutput query ++ + fourFamilyOriginalMarkerStream + modularReductionCellOutput remaining).length = + (query :: remaining).length + rw [List.length_append, modularReductionCellOutput_length, + ih, List.length_cons] + omega + +private theorem factor400BinarySourceModularReducedCurrentWord_length + (input : List Bool) : + (binarySourceModularReducedCurrentWord input).length = + (binarySourceModularCurrentWord input).length := by + let count := (binarySourceModularCurrentWord input).length + let queries : List (List Bool) := + (List.range count).map fun rank => + binarySourceModularPackedCell + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceModularCurrentWidth input) + have hwidth : + binarySourceModularCurrentWidth.output input = + List.replicate count true := by + rfl + have hcatalogue := + maskDynamicGridCandidateCatalogueOutput_valid + binarySourceModularCurrentWidth + binarySourceModularPackedCellComputable + input count hwidth + have hqueries : queries.length = count := by + simp only [List.length_map, List.length_range, queries] + have hrow : + binarySourceModularPackedRow input = + unaryBoundedFoldWord queries.length + (sourceMixedRadixOriginalSourceQueryStream queries ++ []) := by + unfold binarySourceModularPackedRow + binarySourceModularPackedCellCatalogue + rw [hcatalogue] + change + sourceInputLengthUnary + (binarySourceModularCurrentWord input) ++ + false :: + (List.range count).flatMap + (fun rank => lengthPrefixedWord + (binarySourceModularPackedCell + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceModularCurrentWidth input))) = _ + simp only [sourceInputLengthUnary, unaryBoundedFoldWord, List.length_map, List.length_range, + sourceMixedRadixOriginalSourceQueryStream, List.flatMap_map, List.append_nil, count, + queries] + unfold binarySourceModularReducedCurrentWord + simp only [Function.comp_apply] + rw [hrow] + unfold modularReductionWordRowOutput + rw [boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries + modularReductionCellOutput queries []] + simpa only [List.nil_append, hqueries] + using factor400BinarySourceModularReductionMarkerStream_length queries + +private def binarySourceModularStateFieldValidityAt + (position : ℕ) : List Bool → List Bool := + fiveFamilyOriginalHeadBitWord ∘ payloadDecodeOutput ∘ + factor400BinarySourceSkipFields position + +private noncomputable def factor400BinarySourceModularStateFieldValidityAtComputable + (position : ℕ) : + BitTM + (binarySourceModularStateFieldValidityAt position) := by + exact GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + (binarySourceSkipFieldsComputable position) + payloadDecoderComputable) + fiveFamilyOriginalHeadBitComputable + +private def binarySourceModularStateValid + (input : List Bool) : Bool := + (payloadDecodeOutput + (factor400BinarySourceSkipFields 0 input)).headD false && + ((payloadDecodeOutput + (factor400BinarySourceSkipFields 1 input)).headD false && + (payloadDecodeOutput + (factor400BinarySourceSkipFields 2 input)).headD false) + +private def factor400BinarySourceModularStateValidityWord : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (binarySourceModularStateFieldValidityAt 0) + (sourceFourFamilyBooleanAndOutput + (binarySourceModularStateFieldValidityAt 1) + (binarySourceModularStateFieldValidityAt 2)) + +@[simp] private theorem factor400BinarySourceModularStateValidityWord_eq + (input : List Bool) : + factor400BinarySourceModularStateValidityWord input = + [binarySourceModularStateValid input] := by + simp only [factor400BinarySourceModularStateValidityWord, sourceFourFamilyBooleanAndOutput, + binarySourceModularStateFieldValidityAt, Function.comp_apply, + fiveFamilyOriginalHeadBitWord_eq, + List.headD_eq_head?_getD, List.cons_append, List.nil_append, + sourceFourFamilyBooleanAndPairWord_bits, + binarySourceModularStateValid] + +private noncomputable def factor400BinarySourceModularStateValidityWordComputable : + BitTM + factor400BinarySourceModularStateValidityWord := + fourFamilyBooleanAndComputable + (factor400BinarySourceModularStateFieldValidityAtComputable 0) + (fourFamilyBooleanAndComputable + (factor400BinarySourceModularStateFieldValidityAtComputable 1) + (factor400BinarySourceModularStateFieldValidityAtComputable 2)) + +private noncomputable def factor400BinarySourceModularStateSelectionComputable : + BitTM + (fun input => + binarySourceModularStateValid input :: input) := by + have hphysical := pointwiseAppendComputable + factor400BinarySourceModularStateValidityWordComputable + (Turing.idComputableInPolyTime bitEncoding) + simpa only [factor400BinarySourceModularStateValidityWord_eq, id_eq, List.cons_append, + List.nil_append] using + hphysical + +private def binarySourceModularGuardedDegreeStepOutput + (input : List Bool) : List Bool := + if binarySourceModularStateValid input then + binarySourceModularDegreeStepOutput input + else + [] + +private noncomputable def factor400BinarySourceModularGuardedDegreeStepComputable : + BitTM + binarySourceModularGuardedDegreeStepOutput := by + exact sourcePreservingConditionalComputable + factor400BinarySourceModularStateSelectionComputable + factor400BinarySourceModularDegreeStepComputable [] + +private theorem factor400BinarySourceModularStateValid_reconstruct + (input : List Bool) + (hvalid : binarySourceModularStateValid input = true) : + ∃ (offset lower current source : List Bool), + input = lengthPrefixedWord offset ++ + (lengthPrefixedWord lower ++ + (lengthPrefixedWord current ++ source)) := by + cases hfirst : readLengthPrefixedWord input with + | none => + simp only [binarySourceModularStateValid, payloadDecodeOutput, + factor400BinarySourceSkipFields, id_eq, hfirst, + List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, Function.comp_apply, + CompTriple.comp_eq, + Bool.false_and, Bool.false_eq_true] at hvalid + | some parsed => + obtain ⟨offset, firstSuffix⟩ := parsed + cases hsecond : readLengthPrefixedWord firstSuffix with + | none => + simp only [binarySourceModularStateValid, payloadDecodeOutput, + factor400BinarySourceSkipFields, id_eq, hfirst, + List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, Function.comp_apply, + firstFieldSuffix, hsecond, + CompTriple.comp_eq, Bool.false_and, Bool.and_false, Bool.false_eq_true] at hvalid + | some parsed => + obtain ⟨lower, secondSuffix⟩ := parsed + cases hthird : readLengthPrefixedWord secondSuffix with + | none => + simp only [binarySourceModularStateValid, payloadDecodeOutput, + factor400BinarySourceSkipFields, id_eq, hfirst, + List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, Function.comp_apply, + firstFieldSuffix, hsecond, + CompTriple.comp_eq, hthird, Bool.and_false, Bool.false_eq_true] at hvalid + | some parsed => + obtain ⟨current, source⟩ := parsed + refine ⟨offset, lower, current, source, ?_⟩ + have hshapeFirst := readLengthPrefixedWord_some_reconstruct + input offset firstSuffix hfirst + have hshapeSecond := readLengthPrefixedWord_some_reconstruct + firstSuffix lower secondSuffix hsecond + have hshapeThird := readLengthPrefixedWord_some_reconstruct + secondSuffix current source hthird + calc + input = lengthPrefixedWord offset ++ firstSuffix := + hshapeFirst + _ = lengthPrefixedWord offset ++ + (lengthPrefixedWord lower ++ secondSuffix) := by + rw [hshapeSecond] + _ = lengthPrefixedWord offset ++ + (lengthPrefixedWord lower ++ + (lengthPrefixedWord current ++ source)) := by + rw [hshapeThird] + +private theorem factor400BinarySourceModularGuardedDegreeStepOutput_length_le + (input : List Bool) : + (binarySourceModularGuardedDegreeStepOutput input).length ≤ + input.length + 2 := by + unfold binarySourceModularGuardedDegreeStepOutput + split_ifs with hvalid + · obtain ⟨offset, lower, current, source, hshape⟩ := + factor400BinarySourceModularStateValid_reconstruct input hvalid + subst input + simp only [binarySourceModularDegreeStepOutput, + List.length_append, lengthPrefixedWord_length] + rw [factor400BinarySourceModularReducedCurrentWord_length] + simp only [binarySourceModularNextOffsetUnary, binarySourceModularOffsetUnary, + firstFieldContents_valid, + List.length_cons, binarySourceModularLowerWord, factor400BinarySourceSkipFields, + CompTriple.comp_eq, + Function.comp_apply, firstFieldSuffix_valid, binarySourceModularCurrentWord, + binarySourceModularOriginalSource] + omega + · simp only [List.length_nil, le_add_iff_nonneg_left, zero_le] + +end BinarySourceModularDegreeStepCorrectness + +namespace BinarySourceModularDegreeStepSemanticSourceLemmas + +open GapCVP.BinaryEncoding GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryDimensionTM +open GapCVP.BinarySourceConvolutionTM GapCVP.BinarySourceModularDegreeStepTM + +private def binarySourceModularPhysicalCellQuery + (rank : ℕ) (state : List Bool) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceModularCurrentWidth state + +@[simp] private theorem factor400BinarySourceModularCellRankUnary_query + (rank : ℕ) (state : List Bool) : + binarySourceModularCellRankUnary + (binarySourceModularPhysicalCellQuery rank state) = + List.replicate rank true := by + simp only [binarySourceModularCellRankUnary, binarySourceModularPhysicalCellQuery, + SourceFormulaStructuralDecoder.firstFieldContents_valid] + +@[simp] private theorem factor400BinarySourceModularCellState_query + (rank : ℕ) (state : List Bool) : + binarySourceModularCellState + (binarySourceModularPhysicalCellQuery rank state) = + state := by + simp only [binarySourceModularCellState, factor400BinarySourceSkipFields, CompTriple.comp_eq, + binarySourceModularPhysicalCellQuery, sourceQaryMaskDynamicGridBaseSource, + Function.comp_apply, + SourceFormulaStructuralDecoder.firstFieldSuffix_valid] + +@[simp] private theorem factor400BinarySourceModularCellLift_query + (worker : List Bool → List Bool) + (rank : ℕ) (state : List Bool) : + binarySourceModularCellLift worker + (binarySourceModularPhysicalCellQuery rank state) = + worker state := by + simp only [binarySourceModularCellLift, Function.comp_apply, + factor400BinarySourceModularCellState_query] + +@[simp] private theorem factor400BinarySourceModularShiftStartUnary_degreeState + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularShiftStartUnary + (binarySourceModularDegreeState + offset lower current source) = + List.replicate + (current.length - 1 - offset - lower.length) true := by + unfold binarySourceModularShiftStartUnary + apply unarySubtractionOutput_valid + binarySourceModularDescendingDegreeUnary + binarySourceModularLowerDegreeUnary + (binarySourceModularDegreeState + offset lower current source) + (current.length - 1 - offset) lower.length + · exact factor400BinarySourceModularDescendingDegreeUnary_state + offset lower current source + · exact factor400BinarySourceModularLowerDegreeUnary_state + offset lower current source + +@[simp] private theorem factor400BinarySourceModularCellLowerIndex_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellLowerIndex + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + List.replicate + (rank - (current.length - 1 - offset - lower.length)) true := by + unfold binarySourceModularCellLowerIndex + apply unarySubtractionOutput_valid + binarySourceModularCellRankUnary + binarySourceModularCellShiftStart + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + rank (current.length - 1 - offset - lower.length) + · exact factor400BinarySourceModularCellRankUnary_query rank _ + · simp only [binarySourceModularCellShiftStart, factor400BinarySourceModularCellLift_query, + factor400BinarySourceModularShiftStartUnary_degreeState] + +private theorem factor400BinarySourceModularLeadingGate_degreeState + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularLeadingGate + (binarySourceModularDegreeState + offset lower current source) = + [(current.drop (current.length - 1 - offset)).headD false] := by + unfold binarySourceModularLeadingGate + rw [fiveOriginalDynamicBitWord_valid + binarySourceModularDescendingDegreeUnary + binarySourceModularCurrentWord + (binarySourceModularDegreeState + offset lower current source) + (current.length - 1 - offset) + (factor400BinarySourceModularDescendingDegreeUnary_state + offset lower current source)] + simp only [factor400BinarySourceModularCurrentWord_state, List.headD_eq_head?_getD, + List.head?_drop] + +private theorem factor400BinarySourceModularCellDestination_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellDestination + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [(current.drop rank).headD false] := by + unfold binarySourceModularCellDestination + rw [fiveOriginalDynamicBitWord_valid + binarySourceModularCellRankUnary + binarySourceModularCellCurrentWord + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) rank + (factor400BinarySourceModularCellRankUnary_query rank _)] + simp only [binarySourceModularCellCurrentWord, factor400BinarySourceModularCellLift_query, + factor400BinarySourceModularCurrentWord_state, List.headD_eq_head?_getD, List.head?_drop] + +private theorem factor400BinarySourceModularCellLowerBit_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellLowerBit + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [(lower.drop + (rank - (current.length - 1 - offset - lower.length))).headD false] := by + unfold binarySourceModularCellLowerBit + rw [fiveOriginalDynamicBitWord_valid + binarySourceModularCellLowerIndex + binarySourceModularCellLowerWord + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + (rank - (current.length - 1 - offset - lower.length)) + (factor400BinarySourceModularCellLowerIndex_query + rank offset lower current source)] + simp only [binarySourceModularCellLowerWord, factor400BinarySourceModularCellLift_query, + factor400BinarySourceModularLowerWord_state, List.headD_eq_head?_getD, List.head?_drop] + +private theorem factor400BinarySourceModularCellBelowShift_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellBelowShift + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [decide (rank < current.length - 1 - offset - lower.length)] := by + unfold binarySourceModularCellBelowShift + apply fourFamilyComputedUnaryLessBitOutput_valid + binarySourceModularCellRankUnary + binarySourceModularCellShiftStart + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + rank (current.length - 1 - offset - lower.length) + · exact factor400BinarySourceModularCellRankUnary_query rank _ + · simp only [binarySourceModularCellShiftStart, factor400BinarySourceModularCellLift_query, + factor400BinarySourceModularShiftStartUnary_degreeState] + +private theorem factor400BinarySourceModularCellAtOrAboveShift_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellAtOrAboveShift + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [decide (current.length - 1 - offset - lower.length ≤ rank)] := by + unfold binarySourceModularCellAtOrAboveShift + rw [fourFamilyBooleanNotOutput_bit + binarySourceModularCellBelowShift + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + (decide (rank < current.length - 1 - offset - lower.length)) + (factor400BinarySourceModularCellBelowShift_query + rank offset lower current source)] + apply congrArg (fun bit : Bool => [bit]) + by_cases hlt : rank < current.length - 1 - offset - lower.length + · have hnot : + ¬ current.length - 1 - offset - lower.length ≤ rank := by + omega + simp only [hlt, decide_true, Bool.not_true, hnot, decide_false] + · have hle : + current.length - 1 - offset - lower.length ≤ rank := by + omega + simp only [hlt, decide_false, Bool.not_false, hle, decide_true] + +private theorem factor400BinarySourceModularCellShiftedLowerBit_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellShiftedLowerBit + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [decide (current.length - 1 - offset - lower.length ≤ rank) && + (lower.drop + (rank - (current.length - 1 - offset - lower.length))).headD false] := by + unfold binarySourceModularCellShiftedLowerBit + apply fourFamilyBooleanAndOutput_bits + binarySourceModularCellAtOrAboveShift + binarySourceModularCellLowerBit + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + (decide (current.length - 1 - offset - lower.length ≤ rank)) + ((lower.drop + (rank - (current.length - 1 - offset - lower.length))).headD false) + · exact factor400BinarySourceModularCellAtOrAboveShift_query + rank offset lower current source + · exact factor400BinarySourceModularCellLowerBit_query + rank offset lower current source + +private theorem factor400BinarySourceModularCellRankLessDegree_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellRankLessDegree + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [decide (rank < current.length - 1 - offset)] := by + unfold binarySourceModularCellRankLessDegree + apply fourFamilyComputedUnaryLessBitOutput_valid + binarySourceModularCellRankUnary + binarySourceModularCellDescendingDegree + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + rank (current.length - 1 - offset) + · exact factor400BinarySourceModularCellRankUnary_query rank _ + · simp only [binarySourceModularCellDescendingDegree, factor400BinarySourceModularCellLift_query, + factor400BinarySourceModularDescendingDegreeUnary_state] + +private theorem factor400BinarySourceModularCellDegreeLessRank_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellDegreeLessRank + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [decide (current.length - 1 - offset < rank)] := by + unfold binarySourceModularCellDegreeLessRank + apply fourFamilyComputedUnaryLessBitOutput_valid + binarySourceModularCellDescendingDegree + binarySourceModularCellRankUnary + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + (current.length - 1 - offset) rank + · simp only [binarySourceModularCellDescendingDegree, factor400BinarySourceModularCellLift_query, + factor400BinarySourceModularDescendingDegreeUnary_state] + · exact factor400BinarySourceModularCellRankUnary_query rank _ + +private theorem factor400BinarySourceModularCellLeadingMask_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellLeadingMask + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [decide (rank = current.length - 1 - offset)] := by + unfold binarySourceModularCellLeadingMask + have hor := fourFamilyBooleanOrOutput_bits + binarySourceModularCellRankLessDegree + binarySourceModularCellDegreeLessRank + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + (decide (rank < current.length - 1 - offset)) + (decide (current.length - 1 - offset < rank)) + (factor400BinarySourceModularCellRankLessDegree_query + rank offset lower current source) + (factor400BinarySourceModularCellDegreeLessRank_query + rank offset lower current source) + rw [fourFamilyBooleanNotOutput_bit + (sourceFourFamilyBooleanOrOutput + binarySourceModularCellRankLessDegree + binarySourceModularCellDegreeLessRank) + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + (decide (rank < current.length - 1 - offset) || + decide (current.length - 1 - offset < rank)) hor] + apply congrArg (fun bit : Bool => [bit]) + by_cases heq : rank = current.length - 1 - offset + · subst rank + simp only [lt_self_iff_false, decide_false, Bool.or_self, Bool.not_false, decide_true] + · by_cases hlt : rank < current.length - 1 - offset + · have hnot : ¬ current.length - 1 - offset < rank := by + omega + simp only [hlt, decide_true, hnot, decide_false, Bool.or_false, Bool.not_true, heq] + · have hgt : current.length - 1 - offset < rank := by + omega + simp only [hlt, decide_false, hgt, decide_true, Bool.or_true, Bool.not_true, heq] + +private theorem factor400BinarySourceModularCellMask_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellMask + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [decide (rank = current.length - 1 - offset) || + (decide (current.length - 1 - offset - lower.length ≤ rank) && + (lower.drop + (rank - (current.length - 1 - offset - lower.length))).headD false)] := by + unfold binarySourceModularCellMask + apply fourFamilyBooleanOrOutput_bits + binarySourceModularCellLeadingMask + binarySourceModularCellShiftedLowerBit + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) + (decide (rank = current.length - 1 - offset)) + (decide (current.length - 1 - offset - lower.length ≤ rank) && + (lower.drop + (rank - (current.length - 1 - offset - lower.length))).headD false) + · exact factor400BinarySourceModularCellLeadingMask_query + rank offset lower current source + · exact factor400BinarySourceModularCellShiftedLowerBit_query + rank offset lower current source + +private theorem factor400BinarySourceModularCellLeadingGate_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularCellLeadingGate + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [(current.drop (current.length - 1 - offset)).headD false] := by + unfold binarySourceModularCellLeadingGate + rw [factor400BinarySourceModularCellLift_query] + exact factor400BinarySourceModularLeadingGate_degreeState + offset lower current source + +private theorem factor400BinarySourceModularPackedCell_query + (rank offset : ℕ) (lower current source : List Bool) : + binarySourceModularPackedCell + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState + offset lower current source)) = + [(current.drop (current.length - 1 - offset)).headD false, + decide (rank = current.length - 1 - offset) || + (decide (current.length - 1 - offset - lower.length ≤ rank) && + (lower.drop + (rank - + (current.length - 1 - offset - lower.length))).headD false), + (current.drop rank).headD false] := by + unfold binarySourceModularPackedCell + rw [factor400BinarySourceModularCellLeadingGate_query, + factor400BinarySourceModularCellMask_query, + factor400BinarySourceModularCellDestination_query] + rfl + +end BinarySourceModularDegreeStepSemanticSourceLemmas + +namespace BinarySourceModularDegreeStepSemanticCoefficientLemmas + +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinarySourceModularDegreeStepTM +open GapCVP.BinarySourceModularDegreeStepSemanticSourceLemmas GapCVP.Core.EffectiveBinaryField + +theorem binarySourceModularFiniteWordBits_drop_head + {degree : ℕ} + (word : Word degree) + (rank : ℕ) (hrank : rank < degree) : + ((finiteWordBits word).drop rank).headD false = + word ⟨rank, hrank⟩ := by + exact GapCVP.BinarySourceConvolutionCorrectness.factor400BinaryFiniteWordBits_drop_head + word rank hrank + +private theorem factor400BinarySourceModularShiftXor_coefficient + {degree : ℕ} + (lower : Word degree) (position : ℕ) + (word : Word (2 * degree)) + (hposition : degree ≤ position ∧ position < 2 * degree) + (rank : Fin (2 * degree)) : + shiftXor lower position word rank = + Bool.xor + (decide (position - degree ≤ rank.val) && + ((finiteWordBits lower).drop + (rank.val - (position - degree))).headD false) + (word rank) := by + have hcoefficient := + congrArg + (fun polynomial : Polynomial (ZMod 2) => + polynomial.coeff rank.val) + (wordPolynomial_shiftXor lower position word hposition) + simp only [Polynomial.coeff_add, + GapCVP.Core.EffectiveBinaryField.wordPolynomial_coeff_fin, + Polynomial.coeff_X_pow_mul'] at hcoefficient + by_cases hshift : position - degree ≤ rank.val + · by_cases hlower : rank.val - (position - degree) < degree + · have hlowcoefficient : + (GapCVP.Core.EffectiveBinaryField.wordPolynomial lower).coeff + (rank.val - (position - degree)) = + GapCVP.Core.EffectiveBinaryField.bitValue + (lower ⟨rank.val - (position - degree), hlower⟩) := + GapCVP.Core.EffectiveBinaryField.wordPolynomial_coeff_fin + lower ⟨rank.val - (position - degree), hlower⟩ + rw [ite_eq_left hshift, hlowcoefficient] at hcoefficient + rw [binarySourceModularFiniteWordBits_drop_head + lower _ hlower] + apply GapCVP.Core.EffectiveBinaryField.bitValue_injective + simpa only [hshift, decide_true, Bool.true_and, bitValue_xor, add_comm] using hcoefficient + · have hlarge : degree ≤ rank.val - (position - degree) := + Nat.le_of_not_gt hlower + rw [ite_eq_left hshift, + GapCVP.Core.EffectiveBinaryField.wordPolynomial_coeff_eq_zero + lower _ hlarge] at hcoefficient + have hdrop : + (finiteWordBits lower).drop + (rank.val - (position - degree)) = [] := by + apply List.drop_eq_nil_of_le + simpa only [finiteWordBits, List.length_map, List.length_finRange] using hlarge + rw [hdrop] + apply GapCVP.Core.EffectiveBinaryField.bitValue_injective + simpa only [hshift, decide_true, List.headD_eq_head?_getD, List.head?_nil, Option.getD_none, + Bool.and_false, + Bool.false_bne, add_zero] using hcoefficient + · rw [ite_eq_right hshift] at hcoefficient + apply GapCVP.Core.EffectiveBinaryField.bitValue_injective + simpa only [hshift, decide_false, List.headD_eq_head?_getD, List.head?_drop, Bool.false_and, + Bool.false_bne, + add_zero] using hcoefficient + +private theorem factor400BinarySourceModularPhysicalCellOutput_query + {degree : ℕ} + (lower : Word degree) + (current : Word (2 * degree)) + (source : List Bool) (offset : ℕ) + (hoffset : offset < degree) + (rank : ℕ) (hrank : rank < 2 * degree) : + modularReductionCellOutput + (binarySourceModularPackedCell + (binarySourceModularPhysicalCellQuery rank + (binarySourceModularDegreeState offset + (finiteWordBits lower) (finiteWordBits current) source))) = + [reduceAt lower (2 * degree - 1 - offset) + current (⟨rank, hrank⟩ : Fin (2 * degree))] := by + have hposition : + degree ≤ 2 * degree - 1 - offset ∧ + 2 * degree - 1 - offset < 2 * degree := by + omega + have hcurrent : (finiteWordBits current).length = 2 * degree := by + simp only [finiteWordBits, List.length_map, List.length_finRange] + have hlower : (finiteWordBits lower).length = degree := by + simp only [finiteWordBits, List.length_map, List.length_finRange] + rw [factor400BinarySourceModularPackedCell_query, + modularReductionCellOutput_valid] + simp only [hcurrent, hlower] + rw [binarySourceModularFiniteWordBits_drop_head + current (2 * degree - 1 - offset) hposition.2, + binarySourceModularFiniteWordBits_drop_head + current rank hrank] + apply congrArg (fun bit : Bool => [bit]) + unfold reduceAt + rw [dite_eq_left hposition] + let leading : Fin (2 * degree) := + ⟨2 * degree - 1 - offset, hposition.2⟩ + change + Bool.xor + (current leading && + (decide (rank = leading.val) || + (decide (leading.val - degree ≤ rank) && + ((finiteWordBits lower).drop + (rank - (leading.val - degree))).headD false))) + (current (⟨rank, hrank⟩ : Fin (2 * degree))) = + (if current leading then + shiftXor lower leading.val + (xorAt current leading true) + else + current) (⟨rank, hrank⟩ : Fin (2 * degree)) + cases hleading : current leading with + | false => + simp only [tsub_le_iff_right, List.headD_eq_head?_getD, List.head?_drop, Bool.false_and, + Bool.false_bne, + Bool.false_eq_true, ↓reduceIte] + | true => + simp only [Bool.true_and, ↓reduceIte] + rw [factor400BinarySourceModularShiftXor_coefficient + lower leading.val (xorAt current leading true) + (by simpa only [leading] using hposition) + (⟨rank, hrank⟩ : Fin (2 * degree))] + by_cases hrankLeading : rank = leading.val + · have hindex : + (⟨rank, hrank⟩ : Fin (2 * degree)) = leading := by + apply Fin.ext + exact hrankLeading + have hshift : leading.val - degree ≤ leading.val := by + omega + have hdifference : + leading.val - (leading.val - degree) = degree := by + have hbound : degree ≤ leading.val := by + simpa only [leading] using hposition.1 + omega + have hdrop : + (finiteWordBits lower).drop + (leading.val - (leading.val - degree)) = [] := by + rw [hdifference] + apply List.drop_eq_nil_of_le + simp only [finiteWordBits, List.length_map, List.length_finRange, Std.le_refl] + simp only [hrankLeading, decide_true, hshift, hdrop, List.headD_eq_head?_getD, + List.head?_nil, + Option.getD_none, Bool.and_false, Bool.or_false, Fin.eta, hleading, bne_self_eq_false, + xorAt, ↓reduceIte] + · have hindex : + (⟨rank, hrank⟩ : Fin (2 * degree)) ≠ leading := by + intro heq + exact hrankLeading + (congrArg (fun bit : Fin (2 * degree) => bit.val) heq) + simp only [hrankLeading, decide_false, tsub_le_iff_right, List.headD_eq_head?_getD, + List.head?_drop, + Bool.false_or, xorAt, hindex, ↓reduceIte] + +end BinarySourceModularDegreeStepSemanticCoefficientLemmas + +namespace BinarySourceModularDegreeStepPhysicalCellCorrectness + +open GapCVP.BinaryEncoding GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceFourFamilyMarkerRotationTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM GapCVP.BinaryDimensionTM +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceModularDegreeStepTM +open GapCVP.BinarySourceModularDegreeStepSemanticSourceLemmas +open GapCVP.BinarySourceModularDegreeStepSemanticCoefficientLemmas + +theorem binarySourceModularFiniteWordBits_drop_head + {degree : ℕ} + (word : GapCVP.Core.EffectiveBinaryField.Word degree) + (rank : ℕ) (hrank : rank < degree) : + ((finiteWordBits word).drop rank).headD false = + word ⟨rank, hrank⟩ := by + exact GapCVP.BinarySourceConvolutionCorrectness.factor400BinaryFiniteWordBits_drop_head + word rank hrank + +private theorem factor400BinarySourceModularReducedCurrentWord_markerStream + (input : List Bool) : + binarySourceModularReducedCurrentWord input = + fourFamilyOriginalMarkerStream modularReductionCellOutput + ((List.range + (binarySourceModularCurrentWord input).length).map + fun rank => + binarySourceModularPackedCell + (binarySourceModularPhysicalCellQuery rank input)) := by + let count := (binarySourceModularCurrentWord input).length + let queries : List (List Bool) := + (List.range count).map fun rank => + binarySourceModularPackedCell + (binarySourceModularPhysicalCellQuery rank input) + have hwidth : + binarySourceModularCurrentWidth.output input = + List.replicate count true := by + rfl + have hcatalogue := + maskDynamicGridCandidateCatalogueOutput_valid + binarySourceModularCurrentWidth + binarySourceModularPackedCellComputable + input count hwidth + have hrow : + binarySourceModularPackedRow input = + unaryBoundedFoldWord queries.length + (sourceMixedRadixOriginalSourceQueryStream queries ++ []) := by + unfold binarySourceModularPackedRow + binarySourceModularPackedCellCatalogue + rw [hcatalogue] + change + sourceInputLengthUnary + (binarySourceModularCurrentWord input) ++ + false :: + (List.range count).flatMap + (fun rank => lengthPrefixedWord + (binarySourceModularPackedCell + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + binarySourceModularCurrentWidth input))) = _ + simp only [sourceInputLengthUnary, unaryBoundedFoldWord, binarySourceModularPhysicalCellQuery, + List.length_map, List.length_range, sourceMixedRadixOriginalSourceQueryStream, + List.flatMap_map, List.append_nil, + count, queries] + unfold binarySourceModularReducedCurrentWord + simp only [Function.comp_apply] + rw [hrow] + unfold modularReductionWordRowOutput + rw [boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries + modularReductionCellOutput queries []] + simp only [List.nil_append, queries, count] + +private theorem factor400BinarySourceModular_reconstruct_drop_head_range + (bits : List Bool) : + (List.range bits.length).map + (fun rank => (bits.drop rank).headD false) = bits := by + apply List.ext_getElem + · simp only [List.headD_eq_head?_getD, List.head?_drop, List.length_map, List.length_range] + · intro rank hleft hright + simp only [List.headD_eq_head?_getD, List.head?_drop, List.getElem_map, List.getElem_range] + rw [List.getElem?_eq_getElem hright] + rfl + +private theorem factor400BinarySourceModularReducedCurrentWord_state_valid + {degree : ℕ} + (lower : GapCVP.Core.EffectiveBinaryField.Word degree) + (current : GapCVP.Core.EffectiveBinaryField.Word (2 * degree)) + (source : List Bool) + (offset : ℕ) + (hoffset : offset < degree) : + binarySourceModularReducedCurrentWord + (binarySourceModularDegreeState offset + (finiteWordBits lower) (finiteWordBits current) source) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.reduceAt + lower (2 * degree - 1 - offset) current) := by + have hcurrent : (finiteWordBits current).length = 2 * degree := by + simp only [finiteWordBits, List.length_map, List.length_finRange] + have hreduced : + (finiteWordBits + (GapCVP.Core.EffectiveBinaryField.reduceAt + lower (2 * degree - 1 - offset) current)).length = + 2 * degree := by + simp only [finiteWordBits, List.length_map, List.length_finRange] + rw [factor400BinarySourceModularReducedCurrentWord_markerStream, + factor400BinarySourceModularCurrentWord_state] + unfold fourFamilyOriginalMarkerStream + rw [List.flatMap_map, hcurrent, + ← factor400BinarySourceModular_reconstruct_drop_head_range + (finiteWordBits + (GapCVP.Core.EffectiveBinaryField.reduceAt + lower (2 * degree - 1 - offset) current)), + hreduced, List.map_eq_flatMap] + apply List.flatMap_congr + intro rank hrank + have hposition : rank < 2 * degree := List.mem_range.mp hrank + rw [factor400BinarySourceModularPhysicalCellOutput_query + lower current source offset hoffset rank hposition, + binarySourceModularFiniteWordBits_drop_head + (GapCVP.Core.EffectiveBinaryField.reduceAt + lower (2 * degree - 1 - offset) current) rank hposition] + +end BinarySourceModularDegreeStepPhysicalCellCorrectness + +namespace BinarySourceModularDegreeStepSemanticCorrectness + +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceConvolutionTM +open GapCVP.BinarySourceModularDegreeStepTM GapCVP.BinarySourceModularDegreeStepCorrectness +open GapCVP.BinarySourceModularDegreeStepPhysicalCellCorrectness + +@[simp] private theorem factor400BinarySourceModularStateValid_degreeState + (offset : ℕ) (lower current source : List Bool) : + binarySourceModularStateValid + (binarySourceModularDegreeState + offset lower current source) = true := by + simp only [binarySourceModularStateValid, factor400BinarySourceSkipFields, + binarySourceModularDegreeState, + List.append_assoc, id_eq, SourceTotalStructuralDecoder.payloadDecodeOutput_valid, + List.headD_eq_head?_getD, + List.head?_cons, Option.getD_some, Function.comp_apply, + SourceFormulaStructuralDecoder.firstFieldSuffix_valid, + CompTriple.comp_eq, Bool.and_self] + +private theorem factor400BinarySourceModularGuardedDegreeStepOutput_valid + {degree : ℕ} + (lower : GapCVP.Core.EffectiveBinaryField.Word degree) + (current : GapCVP.Core.EffectiveBinaryField.Word (2 * degree)) + (source : List Bool) (offset : ℕ) + (hoffset : offset < degree) : + binarySourceModularGuardedDegreeStepOutput + (binarySourceModularDegreeState offset + (finiteWordBits lower) (finiteWordBits current) source) = + binarySourceModularDegreeState (offset + 1) + (finiteWordBits lower) + (finiteWordBits + (GapCVP.Core.EffectiveBinaryField.reduceAt lower + (2 * degree - 1 - offset) current)) source := by + unfold binarySourceModularGuardedDegreeStepOutput + rw [factor400BinarySourceModularStateValid_degreeState] + simp only [ite_true, + binarySourceModularDegreeStepOutput, + binarySourceModularNextOffsetUnary, + factor400BinarySourceModularOffsetUnary_state, + factor400BinarySourceModularLowerWord_state, + factor400BinarySourceModularOriginalSource_state] + rw [factor400BinarySourceModularReducedCurrentWord_state_valid + lower current source offset hoffset] + simp only [binarySourceModularDegreeState, List.replicate_succ, List.append_assoc] + +end BinarySourceModularDegreeStepSemanticCorrectness + +namespace BinarySourceModularReductionFoldTM + +open Turing GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceTotalStructuralDecoder GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryModularReductionTM +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinarySourceFieldMultiplicationTM +open GapCVP.BinarySourceModularDegreeStepTM GapCVP.BinarySourceModularDegreeStepCorrectness +open GapCVP.BinarySourceModularDegreeStepSemanticCorrectness + +private theorem factor400BinarySourceModularDegree_iterate_length_le + (state : List Bool) (stage : ℕ) : + (((binarySourceModularGuardedDegreeStepOutput)^[stage]) state).length ≤ + state.length + 2 * stage := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have hstep := factor400BinarySourceModularGuardedDegreeStepOutput_length_le + (((binarySourceModularGuardedDegreeStepOutput)^[stage]) state) + omega + +private def factor400BinarySourceModularReductionStatePolynomial : Polynomial ℕ := + 3 * Polynomial.X + +private theorem factor400BinarySourceModularReduction_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + binarySourceModularGuardedDegreeStepOutput + factor400BinarySourceModularReductionStatePolynomial := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have hreconstruct := parseUnaryBoundedFold_eq_word + input count seed hparse + have hseed : seed.length ≤ input.length := by + rw [hreconstruct] + simp only [unaryBoundedFoldWord, List.length_append, + List.length_replicate, List.length_cons] + omega + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate := factor400BinarySourceModularDegree_iterate_length_le + seed stage + simp only [factor400BinarySourceModularReductionStatePolynomial, + Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X] + omega + +private def factor400BinarySourceModularReductionFoldOutput : + List Bool → List Bool := + boundedRecordFoldOutput binarySourceModularGuardedDegreeStepOutput + +private noncomputable def factor400BinarySourceModularReductionFoldComputable : + BitTM + factor400BinarySourceModularReductionFoldOutput := + boundedDependentRecordFoldComputable + factor400BinarySourceModularGuardedDegreeStepComputable + factor400BinarySourceModularReductionStatePolynomial + factor400BinarySourceModularReduction_polynomiallyBoundedFoldStates + +private def factor400BinarySourceModularReductionCurrentOutput : + List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ firstFieldSuffix + +private noncomputable def factor400BinarySourceModularReductionCurrentComputable : + BitTM + factor400BinarySourceModularReductionCurrentOutput := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable) + firstFieldContentsComputable + +private def binarySourceModularReductionWord : + List Bool → List Bool := + factor400BinarySourceModularReductionCurrentOutput ∘ + factor400BinarySourceModularReductionFoldOutput ∘ + binarySourceModularReductionFoldPreparation + +private noncomputable def factor400BinarySourceModularReductionComputable : + BitTM + binarySourceModularReductionWord := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularReductionFoldPreparationComputable + factor400BinarySourceModularReductionFoldComputable) + factor400BinarySourceModularReductionCurrentComputable + +@[simp] private theorem factor400BinarySourceModularReductionInitialState_degreeState + (lower current source : List Bool) : + binarySourceModularReductionInitialState + lower current source = + binarySourceModularDegreeState 0 lower current source := by + simp only [binarySourceModularReductionInitialState, + binarySourceModularDegreeState, + List.replicate_zero, List.append_assoc] + +private theorem factor400BinarySourceModularReduction_iterate_valid + {degree : ℕ} + (lower : GapCVP.Core.EffectiveBinaryField.Word degree) + (product : GapCVP.Core.EffectiveBinaryField.Word (2 * degree)) + (source : List Bool) (stage : ℕ) (hstage : stage ≤ degree) : + ((binarySourceModularGuardedDegreeStepOutput^[stage]) + (binarySourceModularReductionInitialState + (finiteWordBits lower) (finiteWordBits product) source)) = + binarySourceModularDegreeState stage + (finiteWordBits lower) + (finiteWordBits (reducePrefix lower stage product)) source := by + induction stage with + | zero => + simpa only [Function.iterate_zero, id_eq, + reducePrefix, List.range_zero, List.foldl_nil] using + factor400BinarySourceModularReductionInitialState_degreeState + (finiteWordBits lower) (finiteWordBits product) source + | succ stage ih => + have hprevious : stage ≤ degree := by omega + have hactive : stage < degree := by omega + rw [Function.iterate_succ_apply', ih hprevious] + rw [factor400BinarySourceModularGuardedDegreeStepOutput_valid + lower (reducePrefix lower stage product) source stage hactive] + rw [← reducePrefix_succ] + +@[simp] private theorem factor400BinarySourceModularReductionWord_valid + {degree : ℕ} + (lower : GapCVP.Core.EffectiveBinaryField.Word degree) + (product : GapCVP.Core.EffectiveBinaryField.Word (2 * degree)) + (source : List Bool) : + binarySourceModularReductionWord + (binarySourceModularReductionQuery + (finiteWordBits lower) (finiteWordBits product) source) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.reduceProduct lower product) := by + unfold binarySourceModularReductionWord + factor400BinarySourceModularReductionFoldOutput + factor400BinarySourceModularReductionCurrentOutput + simp only [Function.comp_apply, + factor400BinarySourceModularReductionFoldPreparation_valid, + boundedRecordFoldOutput, parseUnaryBoundedFold_word] + rw [factor400BinarySourceModularReduction_iterate_valid + lower product source degree (le_refl degree)] + simp only [binarySourceModularDegreeState, + List.append_assoc, firstFieldSuffix_valid, + firstFieldContents_valid] + rfl + +private theorem factor400BinarySourceModularReductionFiniteWordBits_take + {degree : ℕ} + (word : GapCVP.Core.EffectiveBinaryField.Word (2 * degree)) : + (finiteWordBits word).take degree = + finiteWordBits (truncateWord word) := by + apply List.ext_getElem + · simp only [finiteWordBits, List.length_take, List.length_map, List.length_finRange, + inf_eq_left] + omega + · intro index hleft hright + simp only [finiteWordBits, List.getElem_take, List.getElem_map, List.getElem_finRange, + Fin.cast_mk, + truncateWord] + +private def factor400BinarySourceModularReductionLowPreparation + (input : List Bool) : List Bool := + binarySourceModularReductionDegreeUnary input ++ false :: + binarySourceModularReductionWord input + +private noncomputable def factor400BinarySourceModularReductionLowPreparationComputable : + BitTM + factor400BinarySourceModularReductionLowPreparation := + pointwiseAppendComputable + factor400BinarySourceModularReductionDegreeUnaryComputable + (GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularReductionComputable + (prependBitComputable false)) + +private def binarySourceModularReductionLowWord : + List Bool → List Bool := + firstFieldContents ∘ + factor400BinarySourceModularReductionLowPreparation + +private noncomputable def factor400BinarySourceModularReductionLowComputable : + BitTM + binarySourceModularReductionLowWord := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceModularReductionLowPreparationComputable + firstFieldContentsComputable + +@[simp] private theorem factor400BinarySourceModularReductionLowWord_valid + {degree : ℕ} + (lower : GapCVP.Core.EffectiveBinaryField.Word degree) + (product : GapCVP.Core.EffectiveBinaryField.Word (2 * degree)) + (source : List Bool) : + binarySourceModularReductionLowWord + (binarySourceModularReductionQuery + (finiteWordBits lower) (finiteWordBits product) source) = + finiteWordBits + (truncateWord + (GapCVP.Core.EffectiveBinaryField.reduceProduct lower product)) := by + unfold binarySourceModularReductionLowWord + factor400BinarySourceModularReductionLowPreparation + simp only [Function.comp_apply, + factor400BinarySourceModularReductionDegreeUnary_valid, + factor400BinarySourceModularReductionWord_valid] + have hlength : + degree ≤ + (finiteWordBits + (GapCVP.Core.EffectiveBinaryField.reduceProduct lower product)).length := by + simp only [factor400BinaryFiniteWordBits_length] + omega + rw [validInput_reconstruct degree + (finiteWordBits + (GapCVP.Core.EffectiveBinaryField.reduceProduct lower product)) + hlength] + rw [firstFieldContents_valid] + exact factor400BinarySourceModularReductionFiniteWordBits_take + (GapCVP.Core.EffectiveBinaryField.reduceProduct lower product) + +end BinarySourceModularReductionFoldTM + +namespace BinarySourceFieldMultiplicationTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDecoder +open GapCVP.SourceFormulaStructuralDecoder GapCVP.OutputPolynomialCompositionClosure +open GapCVP.BinarySourceConvolutionTM GapCVP.BinarySourceModularDegreeStepCorrectness +open GapCVP.BinarySourceModularReductionFoldTM GapCVP.BinaryModularReductionTM + +private def binarySourceMultiplyModValidBranch : + List Bool → List Bool := + binarySourceModularReductionLowWord ∘ + binarySourceProductReductionQuery + +private noncomputable def factor400BinarySourceMultiplyModValidBranchComputable : + BitTM + binarySourceMultiplyModValidBranch := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceProductReductionQueryComputable + factor400BinarySourceModularReductionLowComputable + +private theorem factor400BinarySourceMultiplyModValidBranch_query + (lower left right source : List Bool) : + binarySourceMultiplyModValidBranch + (factor400BinarySourceFieldQuery lower left right source) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyMod + (factor400BinarySourcePaddedWord left.length lower) + (factor400BinarySourcePaddedWord left.length left) + (factor400BinarySourcePaddedWord left.length right)) := by + unfold binarySourceMultiplyModValidBranch + rw [Function.comp_apply, + factor400BinarySourceProductReductionQuery_query, + factor400BinarySourceModularReductionLowWord_valid] + rfl + +private theorem factor400BinarySourceMultiplyModWord_eq_physical + (input : List Bool) : + binarySourceMultiplyModWord input = + if binarySourceModularStateValid input then + binarySourceMultiplyModValidBranch input + else + [] := by + cases hvalid : binarySourceModularStateValid input with + | false => + simp only [Bool.false_eq_true, ↓reduceIte] + unfold binarySourceMultiplyModWord + cases hfirst : readLengthPrefixedWord input with + | none => rfl + | some parsed => + obtain ⟨lower, firstSuffix⟩ := parsed + cases hsecond : readLengthPrefixedWord firstSuffix with + | none => simp only [hsecond] + | some parsed => + obtain ⟨left, secondSuffix⟩ := parsed + cases hthird : readLengthPrefixedWord secondSuffix with + | none => simp only [hsecond, hthird] + | some parsed => + obtain ⟨right, source⟩ := parsed + simp only [binarySourceModularStateValid, payloadDecodeOutput, + factor400BinarySourceSkipFields, id_eq, hfirst, + List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, + Function.comp_apply, firstFieldSuffix, hsecond, + CompTriple.comp_eq, hthird, Bool.and_self, Bool.true_eq_false] at hvalid + | true => + simp only [↓reduceIte] + obtain ⟨lower, left, right, source, hshape⟩ := + factor400BinarySourceModularStateValid_reconstruct input hvalid + have hquery : + input = factor400BinarySourceFieldQuery + lower left right source := by + simpa only [factor400BinarySourceFieldQuery, List.append_assoc] using hshape + rw [hquery, factor400BinarySourceMultiplyModValidBranch_query] + simp only [binarySourceMultiplyModWord, factor400BinarySourceFieldQuery, List.append_assoc, + readLengthPrefixedWord_append] + +/-- GapCVP reduction support. -/ +noncomputable def binarySourceMultiplyModComputable : + BitTM + binarySourceMultiplyModWord := by + have hphysical := sourcePreservingConditionalComputable + factor400BinarySourceModularStateSelectionComputable + factor400BinarySourceMultiplyModValidBranchComputable [] + convert hphysical using 1 + funext input + exact factor400BinarySourceMultiplyModWord_eq_physical input + +end BinarySourceFieldMultiplicationTM + +namespace BinaryFieldInverseTM + +open Turing GapCVP.BinaryFieldInverseAlgebra + +theorem sourceWordValue_sourceFieldPowerIterate + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (operand : + GapCVP.Core.EffectiveBinaryField.Word + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) + (steps : ℕ) : + sourceWordValue encodingLength formula + (sourceFieldPowerIterate + (GapCVP.Core.EffectiveBinaryField.irreducibleWord + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) + operand steps) = + sourceWordValue encodingLength formula operand ^ (steps + 1) := by + induction steps with + | zero => simp only [sourceFieldPowerIterate, Function.iterate_zero, id_eq, zero_add, pow_one] + | succ steps ih => + unfold sourceFieldPowerIterate at ih ⊢ + rw [Function.iterate_succ_apply', + sourceFieldPowerStep, sourceWordValue_multiplyMod, ih] + rw [pow_succ] + ring + +end BinaryFieldInverseTM + +namespace GaussianSourceConsistencyBridge + +open Turing GapCVP.Factor400BinaryPhysicalWorkers GapCVP.GaussianRowWorker +open GapCVP.GaussianPivotScheduleTM GapCVP.GaussianPackedPivotColumnTM +open GapCVP.GaussianReducedConsistencyTM GapCVP.SourceOriginalSourcePreservingTM +open GapCVP.SourceFourFamilyBooleanPredicateTM + +/-- GapCVP reduction support. -/ +def binaryGaussianMalformedReducedState : List Bool := + binaryGaussianPackedPivotColumnWord [(true, true)] [] + +@[simp] private theorem binaryGaussianMalformedReducedState_inconsistent : + binaryGaussianReducedConsistencyWord + binaryGaussianMalformedReducedState = [false] := by + change + sourceFourFamilyBooleanNotWord + (binaryGaussianFirstCellWord + (binaryGaussianPivotWord + (binaryGaussianPackedPivotCandidateOutput + (binaryGaussianPackedPivotColumnWord + [(true, true)] [])))) = [false] + rw [binaryGaussianPackedPivotCandidateOutput_valid] + rfl + +/-- GapCVP reduction support. -/ +def binaryGaussianSourceConsistencyGuard + (system : List Bool → Option GapCVP.Core.BinaryAffineSystem) + (input : List Bool) : Bool := + match system input with + | none => false + | some actual => actual.effectiveReducedConsistent + +/-- GapCVP reduction support. -/ +def binaryGaussianExpectedReducedSourceState + (system : List Bool → Option GapCVP.Core.BinaryAffineSystem) + (input : List Bool) : List Bool := + match system input with + | none => binaryGaussianMalformedReducedState + | some actual => + effectiveGaussianReducedConsistencyQuery actual input + +/-- GapCVP reduction support. -/ +structure BinaryGaussianExactSourceInitializer + (system : List Bool → Option GapCVP.Core.BinaryAffineSystem) where + /-- GapCVP reduction support. -/ + output : List Bool → List Bool + /-- GapCVP reduction support. -/ + computer : BitTM output + output_eq : ∀ input : List Bool, + output input = binaryGaussianExpectedReducedSourceState system input + +private def binaryGaussianExactSourceConsistencyWord + {system : List Bool → Option GapCVP.Core.BinaryAffineSystem} + (initializer : BinaryGaussianExactSourceInitializer system) : + List Bool → List Bool := + binaryGaussianReducedConsistencyWord ∘ initializer.output + +private noncomputable def binaryGaussianExactSourceConsistencyWordComputable + {system : List Bool → Option GapCVP.Core.BinaryAffineSystem} + (initializer : BinaryGaussianExactSourceInitializer system) : + BitTM + (binaryGaussianExactSourceConsistencyWord initializer) := + GapCVP.TMComposition.computableInPolyTime + initializer.computer binaryGaussianReducedConsistencyComputable + +private theorem binaryGaussianExactSourceConsistencyWord_eq + {system : List Bool → Option GapCVP.Core.BinaryAffineSystem} + (initializer : BinaryGaussianExactSourceInitializer system) + (input : List Bool) : + binaryGaussianExactSourceConsistencyWord initializer input = + [binaryGaussianSourceConsistencyGuard system input] := by + simp only [binaryGaussianExactSourceConsistencyWord, + Function.comp_apply, initializer.output_eq] + cases hsystem : system input with + | none => + simp only [binaryGaussianExpectedReducedSourceState, hsystem, + binaryGaussianMalformedReducedState_inconsistent, binaryGaussianSourceConsistencyGuard] + | some actual => + simp only [binaryGaussianExpectedReducedSourceState, + binaryGaussianSourceConsistencyGuard, hsystem] + exact binaryGaussianReducedConsistencyWord_effective + actual input + +/-- GapCVP reduction support. -/ +noncomputable def binaryGaussianExactSourceConsistencyComputable + {system : List Bool → Option GapCVP.Core.BinaryAffineSystem} + (initializer : BinaryGaussianExactSourceInitializer system) : + BitTM + (fun input => binaryGaussianSourceConsistencyGuard system input :: input) := by + have hpreserved := originalSourcePreservingComputable + (binaryGaussianExactSourceConsistencyWordComputable initializer) + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved factor400KeepFirstDropSecondComputable + convert hphysical using 1 + funext input + change + binaryGaussianSourceConsistencyGuard system input :: input = + factor400KeepFirstDropSecondWord + (originalSourcePreservingOutput + (binaryGaussianExactSourceConsistencyWord initializer) input) + rw [originalSourcePreservingOutput, + binaryGaussianExactSourceConsistencyWord_eq initializer input] + simp only [factor400KeepFirstDropSecondWord, List.cons_append, List.nil_append, List.tail_cons] + +end GaussianSourceConsistencyBridge + +namespace BinaryPhysicalWordPackedMatrixTM + +open Turing GapCVP.BinaryEncoding GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM + +/-- GapCVP reduction support. -/ +def sourcePhysicalWordPackedCheckBits + (system : GapCVP.Core.BinaryAffineSystem) : List Bool := + (List.finRange system.rowCount).flatMap fun row => + (List.finRange system.dimension).map fun column => + decide (system.check row column = (1 : ZMod 2)) + +/-- GapCVP reduction support. -/ +def sourcePhysicalWordPackedRhsBits + (system : GapCVP.Core.BinaryAffineSystem) : List Bool := + (List.finRange system.rowCount).map fun row => + decide (system.rightHandSide row = (1 : ZMod 2)) + +/-- GapCVP reduction support. -/ +def sourcePhysicalWordPackedQueryPreparation + (queries : List (List Bool)) (input : List Bool) : List Bool := + unaryBoundedFoldWord queries.length + (sourceMixedRadixOriginalSourceQueryStream queries ++ + lengthPrefixedWord input) + +theorem sourcePhysicalWordPackedFlatMap_singleton + {α : Type} (values : List α) (bit : α → Bool) : + values.flatMap (fun value => [bit value]) = values.map bit := by + calc + values.flatMap (fun value => [bit value]) = + (values.map bit).flatMap (fun value => [value]) := by + simp only [List.flatMap_map] + _ = values.map bit := List.flatMap_singleton' _ + +end BinaryPhysicalWordPackedMatrixTM + +namespace GaussianAdaptivePackedTraceCorrectness + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder GapCVP.BinaryPhysicalWordPackedMatrixTM +open GapCVP.GaussianAdaptiveEliminationCorrectness GapCVP.GaussianAdaptivePivotStepTM + +theorem sourcePhysicalWordPackedCheckBits_eq_effective_initial + (system : BinaryAffineSystem) : + sourcePhysicalWordPackedCheckBits system = + effectiveGaussianPackedCheckBits + (initialState system.effectiveGaussianSystem) := by + rfl + +theorem sourcePhysicalWordPackedRhsBits_eq_effective_initial + (system : BinaryAffineSystem) : + sourcePhysicalWordPackedRhsBits system = + effectiveGaussianPackedRhsBits + (initialState system.effectiveGaussianSystem) := by + rfl + +/-- GapCVP reduction support. -/ +def effectiveGaussianPackedPivotCatalogue + {m n : ℕ} (state : State m n) : List Bool := + binaryGaussianPivotBatchStream + ((List.finRange n).map + (effectiveGaussianStatePivotWord state)) + +/-- GapCVP reduction support. -/ +def effectiveGaussianPackedStateWord + {m n : ℕ} (state : State m n) (source : List Bool) : List Bool := + lengthPrefixedWord (effectiveGaussianPackedCheckBits state) ++ + lengthPrefixedWord (effectiveGaussianPackedRhsBits state) ++ + lengthPrefixedWord (List.replicate state.nextPivot true) ++ + lengthPrefixedWord (effectiveGaussianPackedPivotCatalogue state) ++ + source + +/-- GapCVP reduction support. -/ +def gaussianPackedStateCheckBits : List Bool → List Bool := + firstFieldContents + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedStateCheckBitsComputable : + BitTM + gaussianPackedStateCheckBits := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def gaussianPackedStateRhsBits : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedStateRhsBitsComputable : + BitTM + gaussianPackedStateRhsBits := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def gaussianPackedInitialOriginalSource : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedInitialOriginalSourceComputable : + BitTM + gaussianPackedInitialOriginalSource := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + +theorem gaussianPackedStateCheckBits_matrixWord + (checks rhs source : List Bool) : + gaussianPackedStateCheckBits + (lengthPrefixedWord checks ++ + lengthPrefixedWord rhs ++ source) = checks := by + simp only [gaussianPackedStateCheckBits, List.append_assoc, firstFieldContents_valid] + +theorem gaussianPackedStateRhsBits_matrixWord + (checks rhs source : List Bool) : + gaussianPackedStateRhsBits + (lengthPrefixedWord checks ++ + lengthPrefixedWord rhs ++ source) = rhs := by + simp only [gaussianPackedStateRhsBits, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid, + firstFieldContents_valid] + +theorem gaussianPackedInitialOriginalSource_matrixWord + (checks rhs source : List Bool) : + gaussianPackedInitialOriginalSource + (lengthPrefixedWord checks ++ + lengthPrefixedWord rhs ++ source) = source := by + simp only [gaussianPackedInitialOriginalSource, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid] + +@[simp] theorem effectiveGaussianPackedPivotCatalogue_initial + {m n : ℕ} (system : System m n) : + effectiveGaussianPackedPivotCatalogue + (initialState system) = + binaryGaussianPivotBatchStream + (List.replicate n [false]) := by + have hpivot (column : Fin n) : + effectiveGaussianStatePivotWord + (initialState system) column = [false] := by + rfl + have hmap : + (List.finRange n).map + (effectiveGaussianStatePivotWord (initialState system)) = + List.replicate n [false] := by + calc + (List.finRange n).map + (effectiveGaussianStatePivotWord (initialState system)) = + (List.finRange n).map + (fun _ : Fin n => [false]) := by + exact congrArg (List.map · (List.finRange n)) + (funext hpivot) + _ = List.replicate n [false] := by + simp only [List.map_const', List.length_finRange] + exact congrArg binaryGaussianPivotBatchStream hmap + +end GaussianAdaptivePackedTraceCorrectness + +namespace GaussianPhysicalWordReducedAtomTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.GaussianAdaptiveEliminationCorrectness +open GapCVP.Factor400BinaryEffectiveBasisSerializerTM GapCVP.SourceWholeOutputAssemblyTM + +private def effectiveGaussianStateTargetTag + {m n : ℕ} (state : State m n) (column : Fin n) : List Bool := + match effectiveGaussianStatePivotRowOption state column with + | none => [false] + | some row => [decide (state.system.rhs row = (1 : ZMod 2))] + +/-- GapCVP reduction support. -/ +def effectiveGaussianStateBasisTag + {m n : ℕ} (state : State m n) + (row column : Fin n) : List Bool := + match effectiveGaussianStatePivotRowOption state row, + effectiveGaussianStatePivotRowOption state column with + | some pivot, none => + [decide (state.system.check pivot column = (1 : ZMod 2)), false] + | some _, some _ => + if row = column then [true, true] else [false, false] + | none, none => + if row = column then [true, false] else [false, false] + | none, some _ => [false, false] + +private theorem effectiveGaussianStateTargetTag_effective_atom + (system : BinaryAffineSystem) (column : Fin system.dimension) : + effectiveTargetPackedAtom + (effectiveGaussianStateTargetTag + system.effectiveGaussianState column) = + encodeAtomic + ((system.effectiveAffineRepresentative column : ℤ) : ℚ) := by + unfold effectiveGaussianStateTargetTag + rw [effectiveGaussianStatePivotRow_effective] + cases hpivot : system.effectivePivotRowOption column with + | none => + simp only [effectiveTargetPackedAtom_false, BinaryAffineSystem.effectiveAffineRepresentative, + BinaryAffineSystem.effectiveAffineBits, hpivot, ZMod.val_zero, CharP.cast_eq_zero, + Int.cast_zero] + | some row => + rcases effectiveBinary_eq_zero_or_one + (system.effectiveGaussianState.system.rhs row) with hzero | hone + · simp only [hzero, zero_ne_one, decide_false, effectiveTargetPackedAtom_false, + BinaryAffineSystem.effectiveAffineRepresentative, + BinaryAffineSystem.effectiveAffineBits, hpivot, ZMod.val_zero, + CharP.cast_eq_zero, Int.cast_zero] + · have hrepresentative : + system.effectiveAffineRepresentative column = (1 : ℤ) := by + change ((system.effectiveAffineBits column).val : ℤ) = 1 + simp only [BinaryAffineSystem.effectiveAffineBits, + hpivot, hone, ZMod.val_one, Nat.cast_one] + simp only [hone, decide_true, effectiveTargetPackedAtom_true, hrepresentative, + Int.cast_one] + +private theorem effectiveGaussianStateBasisTag_effective_atom + (system : BinaryAffineSystem) + (row column : Fin system.dimension) : + effectiveBasisPackedAtom + (effectiveGaussianStateBasisTag + system.effectiveGaussianState row column) = + encodeAtomic (system.effectiveSquareBasisMatrix row column) := by + unfold effectiveGaussianStateBasisTag + rw [effectiveGaussianStatePivotRow_effective, + effectiveGaussianStatePivotRow_effective] + cases hrow : system.effectivePivotRowOption row with + | none => + cases hcolumn : system.effectivePivotRowOption column with + | none => + by_cases hdiagonal : row = column + · simp only [hdiagonal, ↓reduceIte, effectiveBasisPackedAtom_one, + BinaryAffineSystem.effectiveSquareBasisMatrix, + hcolumn] + · simp only [hdiagonal, ↓reduceIte, effectiveBasisPackedAtom_zero, + BinaryAffineSystem.effectiveSquareBasisMatrix, hrow, hcolumn] + | some pivot => + simp only [effectiveBasisPackedAtom_zero, BinaryAffineSystem.effectiveSquareBasisMatrix, + hrow, hcolumn] + | some pivot => + cases hcolumn : system.effectivePivotRowOption column with + | none => + rcases effectiveBinary_eq_zero_or_one + (system.effectiveGaussianState.system.check pivot column) + with hzero | hone + · simp only [hzero, zero_ne_one, decide_false, effectiveBasisPackedAtom_zero, + BinaryAffineSystem.effectiveSquareBasisMatrix, hrow, hcolumn, ZMod.val_zero, + CharP.cast_eq_zero] + · have hentry : + system.effectiveSquareBasisMatrix row column = + (1 : ℤ) := by + simp only [BinaryAffineSystem.effectiveSquareBasisMatrix, + hrow, hcolumn, hone, ZMod.val_one, Nat.cast_one] + simp only [hone, decide_true, effectiveBasisPackedAtom_one, hentry] + | some other => + by_cases hdiagonal : row = column + · simp only [hdiagonal, ↓reduceIte, effectiveBasisPackedAtom_two, + BinaryAffineSystem.effectiveSquareBasisMatrix, + hcolumn] + · simp only [hdiagonal, ↓reduceIte, effectiveBasisPackedAtom_zero, + BinaryAffineSystem.effectiveSquareBasisMatrix, hrow, hcolumn] + +end GaussianPhysicalWordReducedAtomTM + +namespace GaussianPackedStateTargetAtomTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert GapCVP.GaussianRowWorker +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianAdaptiveEliminationCorrectness +open GapCVP.GaussianAdaptivePackedTraceCorrectness GapCVP.GaussianPhysicalWordReducedAtomTM +open GapCVP.Factor400BinaryEffectiveBasisSerializerTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.SourceFourFamilyBooleanPredicateTM + +/-- GapCVP reduction support. -/ +def gaussianPackedIndexedStateWord + (index : ℕ) (state : List Bool) : List Bool := + lengthPrefixedWord (List.replicate index true) ++ state + +private def gaussianPackedIndexedColumnUnary : List Bool → List Bool := + firstFieldContents + +private noncomputable def gaussianPackedIndexedColumnUnaryComputable : + BitTM + gaussianPackedIndexedColumnUnary := + firstFieldContentsComputable + +private def gaussianPackedIndexedState : List Bool → List Bool := + firstFieldSuffix + +private noncomputable def gaussianPackedIndexedStateComputable : + BitTM + gaussianPackedIndexedState := + firstFieldSuffixComputable + +@[simp] private theorem gaussianPackedIndexedColumnUnary_word + (index : ℕ) (state : List Bool) : + gaussianPackedIndexedColumnUnary + (gaussianPackedIndexedStateWord index state) = + List.replicate index true := by + exact firstFieldContents_valid + (List.replicate index true) state + +@[simp] private theorem gaussianPackedIndexedState_word + (index : ℕ) (state : List Bool) : + gaussianPackedIndexedState + (gaussianPackedIndexedStateWord index state) = state := by + exact firstFieldSuffix_valid + (List.replicate index true) state + +private def gaussianPackedStatePivotRecords : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ + firstFieldSuffix ∘ firstFieldSuffix + +private noncomputable def gaussianPackedStatePivotRecordsComputable : + BitTM + gaussianPackedStatePivotRecords := by + have hone := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + have hthree := GapCVP.TMComposition.computableInPolyTime + hone firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hthree firstFieldContentsComputable + +@[simp] private theorem gaussianPackedStatePivotRecords_word + {m n : ℕ} (state : State m n) (source : List Bool) : + gaussianPackedStatePivotRecords + (effectiveGaussianPackedStateWord state source) = + effectiveGaussianPackedPivotCatalogue state := by + simp only [gaussianPackedStatePivotRecords, effectiveGaussianPackedStateWord, List.append_assoc, + Function.comp_apply, firstFieldSuffix_valid, firstFieldContents_valid] + +private def gaussianPackedIndexedRhsBits : List Bool → List Bool := + gaussianPackedStateRhsBits ∘ gaussianPackedIndexedState + +private noncomputable def gaussianPackedIndexedRhsBitsComputable : + BitTM + gaussianPackedIndexedRhsBits := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedIndexedStateComputable + gaussianPackedStateRhsBitsComputable + +private def gaussianPackedIndexedPivotQuery + (input : List Bool) : List Bool := + gaussianPackedIndexedColumnUnary input ++ + false :: gaussianPackedStatePivotRecords + (gaussianPackedIndexedState input) + +private noncomputable def gaussianPackedIndexedPivotQueryComputable : + BitTM + gaussianPackedIndexedPivotQuery := by + have hstate := GapCVP.TMComposition.computableInPolyTime + gaussianPackedIndexedStateComputable + gaussianPackedStatePivotRecordsComputable + have hsuffix := GapCVP.TMComposition.computableInPolyTime + hstate (prependBitComputable false) + exact pointwiseAppendComputable + gaussianPackedIndexedColumnUnaryComputable hsuffix + +private def gaussianPackedIndexedPivotOutput : List Bool → List Bool := + binaryGaussianIndexedBatchOutput ∘ gaussianPackedIndexedPivotQuery + +private noncomputable def gaussianPackedIndexedPivotComputable : + BitTM + gaussianPackedIndexedPivotOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedIndexedPivotQueryComputable + binaryGaussianIndexedBatchComputable + +private theorem gaussianPackedIndexedPivotOutput_word + {m n : ℕ} (state : State m n) + (column : Fin n) (source : List Bool) : + gaussianPackedIndexedPivotOutput + (gaussianPackedIndexedStateWord column.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianStatePivotWord state column := by + let records := (List.finRange n).map + (effectiveGaussianStatePivotWord state) + have hindex : column.val < records.length := by + simp only [List.length_map, List.length_finRange, Fin.is_lt, records] + unfold gaussianPackedIndexedPivotOutput + rw [Function.comp_apply] + unfold gaussianPackedIndexedPivotQuery + rw [gaussianPackedIndexedColumnUnary_word, + gaussianPackedIndexedState_word, + gaussianPackedStatePivotRecords_word] + change + binaryGaussianIndexedBatchOutput + (List.replicate column.val true ++ + false :: binaryGaussianPivotBatchStream records) = + effectiveGaussianStatePivotWord state column + have hselect := binaryGaussianIndexedBatchOutput_valid + records [] column.val hindex + simp only [List.append_nil] at hselect + change + binaryGaussianIndexedBatchOutput + (List.replicate column.val true ++ + false :: binaryGaussianPivotBatchStream records) = + records[column.val] at hselect + rw [hselect] + simp only [List.getElem_map, List.getElem_finRange, Fin.cast_mk, Fin.eta, records] + +private def gaussianPackedIndexedPivotRowUnary : List Bool → List Bool := + List.tail ∘ gaussianPackedIndexedPivotOutput + +private noncomputable def gaussianPackedIndexedPivotRowUnaryComputable : + BitTM + gaussianPackedIndexedPivotRowUnary := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedIndexedPivotComputable dropHeadComputable + +private def gaussianPackedIndexedPivotPresentWord : List Bool → List Bool := + binaryGaussianFirstCellWord ∘ gaussianPackedIndexedPivotOutput + +private noncomputable def gaussianPackedIndexedPivotPresentComputable : + BitTM + gaussianPackedIndexedPivotPresentWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedIndexedPivotComputable + binaryGaussianFirstCellComputable + +private def gaussianPackedIndexedPivotRhsBit : List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + gaussianPackedIndexedPivotRowUnary gaussianPackedIndexedRhsBits + +private noncomputable def gaussianPackedIndexedPivotRhsBitComputable : + BitTM + gaussianPackedIndexedPivotRhsBit := + fiveOriginalDynamicBitComputable + gaussianPackedIndexedPivotRowUnaryComputable + gaussianPackedIndexedRhsBitsComputable + +/-- GapCVP reduction support. -/ +def gaussianPackedIndexedTargetBit : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + gaussianPackedIndexedPivotPresentWord + gaussianPackedIndexedPivotRhsBit + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedIndexedTargetBitComputable : + BitTM + gaussianPackedIndexedTargetBit := + fourFamilyBooleanAndComputable + gaussianPackedIndexedPivotPresentComputable + gaussianPackedIndexedPivotRhsBitComputable + +/-- GapCVP reduction support. -/ +def gaussianPackedIndexedTargetAtom : List Bool → List Bool := + effectiveTargetPackedAtom ∘ gaussianPackedIndexedTargetBit + +private noncomputable def gaussianPackedIndexedTargetAtomComputable : + BitTM + gaussianPackedIndexedTargetAtom := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedIndexedTargetBitComputable + effectiveTargetPackedAtomComputable + +private theorem effectiveGaussianPackedRhsBits_drop_head + {m n : ℕ} (state : State m n) (row : Fin m) : + ((effectiveGaussianPackedRhsBits state).drop row.val).headD false = + decide (state.system.rhs row = (1 : ZMod 2)) := by + have hindex : row.val < (effectiveGaussianPackedRhsBits state).length := by + simp only [effectiveGaussianPackedRhsBits, List.length_map, List.length_finRange, Fin.is_lt] + rw [List.drop_eq_getElem_cons hindex] + simp only [effectiveGaussianPackedRhsBits, List.getElem_map, List.getElem_finRange, Fin.cast_mk, + Fin.eta, + List.headD_eq_head?_getD, List.head?_cons, Option.getD_some] + +theorem gaussianPackedIndexedTargetAtom_effective + (system : BinaryAffineSystem) + (column : Fin system.dimension) (source : List Bool) : + gaussianPackedIndexedTargetAtom + (gaussianPackedIndexedStateWord column.val + (effectiveGaussianPackedStateWord + system.effectiveGaussianState source)) = + encodeAtomic + ((system.effectiveAffineRepresentative column : ℤ) : ℚ) := by + let state := system.effectiveGaussianState + let input := gaussianPackedIndexedStateWord column.val + (effectiveGaussianPackedStateWord state source) + have hpivot := gaussianPackedIndexedPivotOutput_word + state column source + have hrhsSource : gaussianPackedIndexedRhsBits input = + effectiveGaussianPackedRhsBits state := by + unfold gaussianPackedIndexedRhsBits + rw [Function.comp_apply] + unfold gaussianPackedStateRhsBits + rw [Function.comp_apply] + rw [show gaussianPackedIndexedState input = + effectiveGaussianPackedStateWord state source by + exact gaussianPackedIndexedState_word + column.val (effectiveGaussianPackedStateWord state source)] + unfold effectiveGaussianPackedStateWord + simp only [List.append_assoc] + rw [firstFieldSuffix_valid] + exact firstFieldContents_valid + (effectiveGaussianPackedRhsBits state) + (lengthPrefixedWord (List.replicate state.nextPivot true) ++ + (lengthPrefixedWord (effectiveGaussianPackedPivotCatalogue state) ++ + source)) + unfold gaussianPackedIndexedTargetAtom + rw [Function.comp_apply] + change + effectiveTargetPackedAtom + (gaussianPackedIndexedTargetBit input) = _ + cases hpivotRow : effectiveGaussianStatePivotRowOption state column with + | none => + have hpivotWord : gaussianPackedIndexedPivotOutput input = + [false] := by + simpa only [effectiveGaussianStatePivotWord, hpivotRow, input] using hpivot + have hrow : gaussianPackedIndexedPivotRowUnary input = + List.replicate 0 true := by + simp only [gaussianPackedIndexedPivotRowUnary, Function.comp_apply, hpivotWord, + List.tail_cons, + List.replicate_zero] + have hread := fiveOriginalDynamicBitWord_valid + gaussianPackedIndexedPivotRowUnary + gaussianPackedIndexedRhsBits input 0 hrow + have hpresent : gaussianPackedIndexedPivotPresentWord input = + [false] := by + simp only [gaussianPackedIndexedPivotPresentWord, Function.comp_apply, hpivotWord, + binaryGaussianFirstCellWord_valid] + have hbit := fourFamilyBooleanAndOutput_bits + gaussianPackedIndexedPivotPresentWord + gaussianPackedIndexedPivotRhsBit input false + ((gaussianPackedIndexedRhsBits input).headD false) + hpresent hread + rw [show gaussianPackedIndexedTargetBit input = + sourceFourFamilyBooleanAndOutput + gaussianPackedIndexedPivotPresentWord + gaussianPackedIndexedPivotRhsBit input from rfl, hbit] + have hpure : system.effectivePivotRowOption column = none := by + simpa only [state, + effectiveGaussianStatePivotRow_effective] using hpivotRow + simp only [List.headD_eq_head?_getD, Bool.false_and, effectiveTargetPackedAtom_false, + BinaryAffineSystem.effectiveAffineRepresentative, BinaryAffineSystem.effectiveAffineBits, + hpure, ZMod.val_zero, + CharP.cast_eq_zero, Int.cast_zero] + | some row => + have hpivotWord : gaussianPackedIndexedPivotOutput input = + true :: List.replicate row.val true := by + simpa only [effectiveGaussianStatePivotWord, hpivotRow, input] using hpivot + have hrow : gaussianPackedIndexedPivotRowUnary input = + List.replicate row.val true := by + simp only [gaussianPackedIndexedPivotRowUnary, Function.comp_apply, hpivotWord, + List.tail_cons] + have hread := fiveOriginalDynamicBitWord_valid + gaussianPackedIndexedPivotRowUnary + gaussianPackedIndexedRhsBits input row.val hrow + rw [hrhsSource, effectiveGaussianPackedRhsBits_drop_head] + at hread + have hpresent : gaussianPackedIndexedPivotPresentWord input = + [true] := by + simp only [gaussianPackedIndexedPivotPresentWord, Function.comp_apply, hpivotWord, + binaryGaussianFirstCellWord_valid] + have hbit := fourFamilyBooleanAndOutput_bits + gaussianPackedIndexedPivotPresentWord + gaussianPackedIndexedPivotRhsBit input true + (decide (state.system.rhs row = (1 : ZMod 2))) + hpresent hread + rw [show gaussianPackedIndexedTargetBit input = + sourceFourFamilyBooleanAndOutput + gaussianPackedIndexedPivotPresentWord + gaussianPackedIndexedPivotRhsBit input from rfl, hbit] + change + effectiveTargetPackedAtom + [decide (state.system.rhs row = (1 : ZMod 2))] = _ + have htag : effectiveGaussianStateTargetTag state column = + [decide (state.system.rhs row = (1 : ZMod 2))] := by + simp only [effectiveGaussianStateTargetTag, hpivotRow] + rw [← htag] + exact effectiveGaussianStateTargetTag_effective_atom + system column + +end GaussianPackedStateTargetAtomTM + +namespace GaussianAdaptivePhysicalStateCellTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.SourceMachineCert +open GapCVP.SourceStructuralTuringTM GapCVP.SourceFormulaStructuralDecoder +open GapCVP.BinaryDimensionTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.SourceMixedRadixUnaryQuotientRemainderTM +open GapCVP.GaussianAdaptiveEliminationCorrectness GapCVP.GaussianAdaptivePackedTraceCorrectness + +/-- GapCVP reduction support. -/ +def gaussianDenseStateCheckLengthUnary : List Bool → List Bool := + sourceInputLengthUnary ∘ gaussianPackedStateCheckBits + +private noncomputable def gaussianDenseStateCheckLengthUnaryComputable : + BitTM + gaussianDenseStateCheckLengthUnary := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedStateCheckBitsComputable + sourceInputLengthUnaryComputable + +/-- GapCVP reduction support. -/ +def gaussianDenseStateRowCountUnary : List Bool → List Bool := + sourceInputLengthUnary ∘ gaussianPackedStateRhsBits + +/-- GapCVP reduction support. -/ +noncomputable def gaussianDenseStateRowCountUnaryComputable : + BitTM + gaussianDenseStateRowCountUnary := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedStateRhsBitsComputable + sourceInputLengthUnaryComputable + +/-- GapCVP reduction support. -/ +def gaussianDenseStateDimensionDivisionQuery + (input : List Bool) : List Bool := + gaussianDenseStateCheckLengthUnary input ++ + false :: (gaussianDenseStateRowCountUnary input ++ + false :: input) + +private noncomputable def gaussianDenseStateDimensionDivisionQueryComputable : + BitTM + gaussianDenseStateDimensionDivisionQuery := by + have hsource := prependBitComputable false + have hmodulus := pointwiseAppendComputable + gaussianDenseStateRowCountUnaryComputable hsource + have hdelimited := GapCVP.TMComposition.computableInPolyTime + hmodulus (prependBitComputable false) + have hphysical := pointwiseAppendComputable + gaussianDenseStateCheckLengthUnaryComputable hdelimited + change BitTM + (fun input => gaussianDenseStateCheckLengthUnary input ++ + false :: (gaussianDenseStateRowCountUnary input ++ + false :: input)) + simpa only [Function.comp_apply] using hphysical + +/-- GapCVP reduction support. -/ +def gaussianDenseStateDimensionUnary : List Bool → List Bool := + List.tail ∘ unaryPrefixOutput ∘ sourceUnaryDivisionOutput ∘ + gaussianDenseStateDimensionDivisionQuery + +/-- GapCVP reduction support. -/ +noncomputable def gaussianDenseStateDimensionUnaryComputable : + BitTM + gaussianDenseStateDimensionUnary := by + have hdivision := GapCVP.TMComposition.computableInPolyTime + gaussianDenseStateDimensionDivisionQueryComputable + sourceUnaryDivisionComputable + have hprefix := GapCVP.TMComposition.computableInPolyTime + hdivision unaryPrefixComputable + exact GapCVP.TMComposition.computableInPolyTime + hprefix dropHeadComputable + +@[simp] theorem effectiveGaussianPackedCheckBits_length + {m n : ℕ} (state : State m n) : + (effectiveGaussianPackedCheckBits state).length = m * n := by + simp only [effectiveGaussianPackedCheckBits, List.length_flatMap, List.length_map, + List.length_finRange, + List.map_const', List.sum_replicate, smul_eq_mul] + +@[simp] theorem effectiveGaussianPackedRhsBits_length + {m n : ℕ} (state : State m n) : + (effectiveGaussianPackedRhsBits state).length = m := by + simp only [effectiveGaussianPackedRhsBits, List.length_map, List.length_finRange] + +@[simp] theorem gaussianDenseStateRowCountUnary_effective + {m n : ℕ} (state : State m n) (source : List Bool) : + gaussianDenseStateRowCountUnary + (effectiveGaussianPackedStateWord state source) = + List.replicate m true := by + unfold gaussianDenseStateRowCountUnary + gaussianPackedStateRhsBits + simp only [effectiveGaussianPackedStateWord, List.append_assoc, Function.comp_apply, + sourceInputLengthUnary, + firstFieldSuffix_valid, firstFieldContents_valid, effectiveGaussianPackedRhsBits_length] + +@[simp] private theorem gaussianDenseStateCheckLengthUnary_effective + {m n : ℕ} (state : State m n) (source : List Bool) : + gaussianDenseStateCheckLengthUnary + (effectiveGaussianPackedStateWord state source) = + List.replicate (m * n) true := by + unfold gaussianDenseStateCheckLengthUnary + gaussianPackedStateCheckBits + simp only [effectiveGaussianPackedStateWord, List.append_assoc, Function.comp_apply, + sourceInputLengthUnary, + firstFieldContents_valid, effectiveGaussianPackedCheckBits_length] + +theorem gaussianDenseStateDimensionUnary_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (hrows : 0 < m) : + gaussianDenseStateDimensionUnary + (effectiveGaussianPackedStateWord state source) = + List.replicate n true := by + let word := effectiveGaussianPackedStateWord state source + have hcheck : gaussianDenseStateCheckLengthUnary word = + List.replicate (m * n) true := + gaussianDenseStateCheckLengthUnary_effective state source + have hrhs : gaussianDenseStateRowCountUnary word = + List.replicate m true := + gaussianDenseStateRowCountUnary_effective state source + have hquery : gaussianDenseStateDimensionDivisionQuery word = + sourceUnaryDivisionQuery (m * n) m word := by + simp only [gaussianDenseStateDimensionDivisionQuery, hcheck, hrhs, sourceUnaryDivisionQuery] + unfold gaussianDenseStateDimensionUnary + simp only [Function.comp_apply] + rw [hquery, sourceUnaryDivisionOutput_valid + (m * n) m word hrows] + rw [unaryPrefixOutput_replicate_delimiter] + simp only [List.tail_cons] + rw [Nat.mul_div_cancel_left n hrows] + +end GaussianAdaptivePhysicalStateCellTM + +namespace GaussianAdaptivePackedStateLookupTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian +open GapCVP.SourceFormulaStructuralDecoder GapCVP.OutputBoundedDependentRecordFold +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM GapCVP.BinaryExplicitAffineRows +open GapCVP.GaussianAdaptiveEliminationCorrectness GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianAdaptivePhysicalStateCellTM GapCVP.GaussianAdaptivePivotStepTM + +private def gaussianPackedCellDimensionUnary : List Bool → List Bool := + gaussianDenseStateDimensionUnary ∘ + sourceExplicitAffineCellOriginalSource + +private noncomputable def gaussianPackedCellDimensionUnaryComputable : + BitTM + gaussianPackedCellDimensionUnary := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + gaussianDenseStateDimensionUnaryComputable + +private def gaussianPackedCellCheckBits : List Bool → List Bool := + gaussianPackedStateCheckBits ∘ + sourceExplicitAffineCellOriginalSource + +private noncomputable def gaussianPackedCellCheckBitsComputable : + BitTM + gaussianPackedCellCheckBits := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + gaussianPackedStateCheckBitsComputable + +private def gaussianPackedCellRhsBits : List Bool → List Bool := + gaussianPackedStateRhsBits ∘ + sourceExplicitAffineCellOriginalSource + +private noncomputable def gaussianPackedCellRhsBitsComputable : + BitTM + gaussianPackedCellRhsBits := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + gaussianPackedStateRhsBitsComputable + +private def gaussianPackedCellRowOffsetUnary : List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + sourceExplicitAffineCellRow gaussianPackedCellDimensionUnary + +private noncomputable def gaussianPackedCellRowOffsetUnaryComputable : + BitTM + gaussianPackedCellRowOffsetUnary := + fourFamilyComputedUnaryProductComputable + sourceExplicitAffineCellRowComputable + gaussianPackedCellDimensionUnaryComputable + +private def gaussianPackedCellFlatIndexUnary : List Bool → List Bool := + fourFamilyComputedUnarySumOutput + gaussianPackedCellRowOffsetUnary sourceExplicitAffineCellColumn + +private noncomputable def gaussianPackedCellFlatIndexUnaryComputable : + BitTM + gaussianPackedCellFlatIndexUnary := + fourFamilyComputedUnarySumComputable + gaussianPackedCellRowOffsetUnaryComputable + sourceExplicitAffineCellColumnComputable + +/-- GapCVP reduction support. -/ +def gaussianPackedStateCheckCellWord : List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + gaussianPackedCellFlatIndexUnary gaussianPackedCellCheckBits + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedStateCheckCellComputable : + BitTM + gaussianPackedStateCheckCellWord := + fiveOriginalDynamicBitComputable + gaussianPackedCellFlatIndexUnaryComputable + gaussianPackedCellCheckBitsComputable + +/-- GapCVP reduction support. -/ +def gaussianPackedStateRhsCellWord : List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + sourceExplicitAffineCellRow gaussianPackedCellRhsBits + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedStateRhsCellComputable : + BitTM + gaussianPackedStateRhsCellWord := + fiveOriginalDynamicBitComputable + sourceExplicitAffineCellRowComputable + gaussianPackedCellRhsBitsComputable + +private theorem gaussianPackedCellDimensionUnary_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : ℕ) (hrows : 0 < m) : + gaussianPackedCellDimensionUnary + (affineCellQuery row column + (effectiveGaussianPackedStateWord state source)) = + List.replicate n true := by + unfold gaussianPackedCellDimensionUnary + simp only [Function.comp_apply, + sourceExplicitAffineCellOriginalSource_query] + exact gaussianDenseStateDimensionUnary_effective + state source hrows + +private theorem gaussianPackedCellCheckBits_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : ℕ) : + gaussianPackedCellCheckBits + (affineCellQuery row column + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianPackedCheckBits state := by + unfold gaussianPackedCellCheckBits gaussianPackedStateCheckBits + simp only [effectiveGaussianPackedStateWord, List.append_assoc, Function.comp_apply, + sourceExplicitAffineCellOriginalSource_query, firstFieldContents_valid] + +private theorem gaussianPackedCellRhsBits_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : ℕ) : + gaussianPackedCellRhsBits + (affineCellQuery row column + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianPackedRhsBits state := by + unfold gaussianPackedCellRhsBits gaussianPackedStateRhsBits + simp only [effectiveGaussianPackedStateWord, List.append_assoc, Function.comp_apply, + sourceExplicitAffineCellOriginalSource_query, firstFieldSuffix_valid, + firstFieldContents_valid] + +private theorem gaussianPackedCellRowOffsetUnary_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : ℕ) (hrows : 0 < m) : + gaussianPackedCellRowOffsetUnary + (affineCellQuery row column + (effectiveGaussianPackedStateWord state source)) = + List.replicate (row * n) true := by + apply fourFamilyComputedUnaryProductOutput_valid + sourceExplicitAffineCellRow gaussianPackedCellDimensionUnary + (affineCellQuery row column + (effectiveGaussianPackedStateWord state source)) row n + · exact sourceExplicitAffineCellRow_query + row column (effectiveGaussianPackedStateWord state source) + · exact gaussianPackedCellDimensionUnary_query + state source row column hrows + +private theorem gaussianPackedCellFlatIndexUnary_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : ℕ) (hrows : 0 < m) : + gaussianPackedCellFlatIndexUnary + (affineCellQuery row column + (effectiveGaussianPackedStateWord state source)) = + List.replicate (row * n + column) true := by + apply fourFamilyComputedUnarySumOutput_valid + gaussianPackedCellRowOffsetUnary + sourceExplicitAffineCellColumn + (affineCellQuery row column + (effectiveGaussianPackedStateWord state source)) + (row * n) column + · exact gaussianPackedCellRowOffsetUnary_query + state source row column hrows + · exact sourceExplicitAffineCellColumn_query + row column (effectiveGaussianPackedStateWord state source) + +private theorem gaussianDenseRowMajorBits_getD + {m n : ℕ} (entry : Fin m → Fin n → Bool) + (row : Fin m) (column : Fin n) : + ((List.finRange m).flatMap fun index => + (List.finRange n).map (entry index)).getD + (row.val * n + column.val) false = + entry row column := by + induction m with + | zero => exact Fin.elim0 row + | succ m ih => + have hsplit : + (List.finRange (m + 1)).flatMap + (fun index => + (List.finRange n).map (entry index)) = + (List.finRange n).map (entry 0) ++ + (List.finRange m).flatMap + (fun index => + (List.finRange n).map + (entry index.succ)) := by + rw [List.finRange_succ] + simp only [List.flatMap_cons, List.flatMap_map] + refine Fin.cases ?_ (fun previous => ?_) row + · simp only [Fin.val_zero, Nat.zero_mul, Nat.zero_add] + rw [hsplit] + have hcolumn : + column.val < + ((List.finRange n).map (entry 0)).length := by + simpa only [List.length_map, List.length_finRange] + using column.isLt + rw [List.getD_append + ((List.finRange n).map (entry 0)) + ((List.finRange m).flatMap + (fun index => + (List.finRange n).map (entry index.succ))) + false column.val hcolumn] + rw [List.getD_eq_getElem + ((List.finRange n).map (entry 0)) false hcolumn] + simp only [List.getElem_map, List.getElem_finRange, Fin.cast_mk, Fin.eta] + · rw [hsplit] + have hprefix : + ((List.finRange n).map (entry 0)).length ≤ + previous.succ.val * n + column.val := by + simp only [List.length_map, List.length_finRange, + Fin.val_succ, Nat.succ_mul] + omega + rw [List.getD_append_right + ((List.finRange n).map (entry 0)) + ((List.finRange m).flatMap + (fun index => + (List.finRange n).map (entry index.succ))) + false (previous.succ.val * n + column.val) hprefix] + simp only [List.length_map, List.length_finRange] + have hoffset : + previous.succ.val * n + column.val - n = + previous.val * n + column.val := by + simp only [Fin.val_succ, Nat.succ_mul] + omega + rw [hoffset] + exact ih (fun index => entry index.succ) previous + +theorem gaussianPackedStateCheckCellWord_query + {m n : ℕ} (state : State m n) + (source : List Bool) + (row : Fin m) (column : Fin n) (hrows : 0 < m) : + gaussianPackedStateCheckCellWord + (affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source)) = + [decide (state.system.check row column = (1 : ZMod 2))] := by + let query := affineCellQuery + row.val column.val + (effectiveGaussianPackedStateWord state source) + have hindex : gaussianPackedCellFlatIndexUnary query = + List.replicate (row.val * n + column.val) true := + gaussianPackedCellFlatIndexUnary_query + state source row.val column.val hrows + have hbits : gaussianPackedCellCheckBits query = + effectiveGaussianPackedCheckBits state := + gaussianPackedCellCheckBits_query + state source row.val column.val + have hread := fiveOriginalDynamicBitWord_valid + gaussianPackedCellFlatIndexUnary gaussianPackedCellCheckBits + query (row.val * n + column.val) hindex + change gaussianPackedStateCheckCellWord query = _ + unfold gaussianPackedStateCheckCellWord + rw [hread, hbits] + have hlt : + row.val * n + column.val < + (effectiveGaussianPackedCheckBits state).length := by + rw [effectiveGaussianPackedCheckBits_length] + calc + row.val * n + column.val < row.val * n + n := + Nat.add_lt_add_left column.isLt _ + _ = (row.val + 1) * n := by + simp only [Nat.add_mul, one_mul] + _ ≤ m * n := + Nat.mul_le_mul_right n + (Nat.succ_le_of_lt row.isLt) + rw [List.drop_eq_getElem_cons hlt] + simp only [List.headD_cons] + apply congrArg (fun bit : Bool => [bit]) + rw [← List.getD_eq_getElem + (effectiveGaussianPackedCheckBits state) false hlt] + exact gaussianDenseRowMajorBits_getD + (fun current col => + decide (state.system.check current col = (1 : ZMod 2))) + row column + +theorem gaussianPackedStateRhsCellWord_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row : Fin m) (column : ℕ) : + gaussianPackedStateRhsCellWord + (affineCellQuery row.val column + (effectiveGaussianPackedStateWord state source)) = + [decide (state.system.rhs row = (1 : ZMod 2))] := by + let query := affineCellQuery + row.val column (effectiveGaussianPackedStateWord state source) + have hindex : sourceExplicitAffineCellRow query = + List.replicate row.val true := + sourceExplicitAffineCellRow_query + row.val column (effectiveGaussianPackedStateWord state source) + have hbits : gaussianPackedCellRhsBits query = + effectiveGaussianPackedRhsBits state := + gaussianPackedCellRhsBits_query + state source row.val column + have hread := fiveOriginalDynamicBitWord_valid + sourceExplicitAffineCellRow gaussianPackedCellRhsBits + query row.val hindex + change gaussianPackedStateRhsCellWord query = _ + unfold gaussianPackedStateRhsCellWord + rw [hread, hbits] + have hlt : + row.val < (effectiveGaussianPackedRhsBits state).length := by + simpa only [effectiveGaussianPackedRhsBits_length] + using row.isLt + rw [List.drop_eq_getElem_cons hlt] + simp only [effectiveGaussianPackedRhsBits, List.getElem_map, List.getElem_finRange, Fin.cast_mk, + Fin.eta, + List.headD_eq_head?_getD, List.head?_cons, Option.getD_some] + +private def gaussianPackedCellPivotCatalogue : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ firstFieldSuffix ∘ + firstFieldSuffix ∘ sourceExplicitAffineCellOriginalSource + +private noncomputable def gaussianPackedCellPivotCatalogueComputable : + BitTM + gaussianPackedCellPivotCatalogue := by + have hfirst := GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + firstFieldSuffixComputable + have hsecond := GapCVP.TMComposition.computableInPolyTime + hfirst firstFieldSuffixComputable + have hthird := GapCVP.TMComposition.computableInPolyTime + hsecond firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hthird firstFieldContentsComputable + +private def gaussianPackedCellPivotSelectionInput + (input : List Bool) : List Bool := + sourceExplicitAffineCellRow input ++ + false :: gaussianPackedCellPivotCatalogue input + +private noncomputable def gaussianPackedCellPivotSelectionInputComputable : + BitTM + gaussianPackedCellPivotSelectionInput := by + have htail := GapCVP.TMComposition.computableInPolyTime + gaussianPackedCellPivotCatalogueComputable + (SourceMachineCert.prependBitComputable false) + have hphysical := pointwiseAppendComputable + sourceExplicitAffineCellRowComputable htail + change BitTM + (fun input => sourceExplicitAffineCellRow input ++ + false :: gaussianPackedCellPivotCatalogue input) + simpa only [Function.comp_apply] using hphysical + +/-- GapCVP reduction support. -/ +def gaussianPackedStatePivotCellWord : List Bool → List Bool := + binaryGaussianIndexedBatchOutput ∘ + gaussianPackedCellPivotSelectionInput + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedStatePivotCellComputable : + BitTM + gaussianPackedStatePivotCellWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedCellPivotSelectionInputComputable + binaryGaussianIndexedBatchComputable + +@[simp] private theorem gaussianPackedCellPivotCatalogue_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : ℕ) : + gaussianPackedCellPivotCatalogue + (affineCellQuery row column + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianPackedPivotCatalogue state := by + unfold gaussianPackedCellPivotCatalogue + effectiveGaussianPackedStateWord + simp only [List.append_assoc, Function.comp_apply, sourceExplicitAffineCellOriginalSource_query, + firstFieldSuffix_valid, firstFieldContents_valid] + +theorem gaussianPackedStatePivotCellWord_query + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) : + gaussianPackedStatePivotCellWord + (affineCellQuery column.val 0 + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianStatePivotWord state column := by + let trace := + (List.finRange n).map + (effectiveGaussianStatePivotWord state) + have hindex : column.val < trace.length := by + simpa only [trace, List.length_map, List.length_finRange] + using column.isLt + unfold gaussianPackedStatePivotCellWord + gaussianPackedCellPivotSelectionInput + simp only [Function.comp_apply, + sourceExplicitAffineCellRow_query, + gaussianPackedCellPivotCatalogue_query] + change + binaryGaussianIndexedBatchOutput + (unaryBoundedFoldWord column.val + (binaryGaussianPivotBatchStream trace)) = + effectiveGaussianStatePivotWord state column + have hread := binaryGaussianIndexedBatchOutput_valid + trace [] column.val hindex + simpa [trace] using hread + +end GaussianAdaptivePackedStateLookupTM + +namespace GaussianPackedStateBasisAtomTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.BinaryExplicitAffineRows GapCVP.GaussianRowWorker +open GapCVP.GaussianAdaptiveEliminationCorrectness GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianAdaptivePackedStateLookupTM GapCVP.GaussianPackedStateTargetAtomTM +open GapCVP.GaussianPhysicalWordReducedAtomTM GapCVP.Factor400BinaryEffectiveBasisSerializerTM +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceFourFamilyDiagonalMembershipPredicateTM + +/-- GapCVP reduction support. -/ +def gaussianPackedIndexedBasisStateWord + (row column : ℕ) (state : List Bool) : List Bool := + affineCellQuery row column state + +private def gaussianPackedBasisRowPivotQuery (input : List Bool) : List Bool := + lengthPrefixedWord (sourceExplicitAffineCellRow input) ++ + sourceExplicitAffineCellOriginalSource input + +private noncomputable def gaussianPackedBasisRowPivotQueryComputable : + BitTM + gaussianPackedBasisRowPivotQuery := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellRowComputable structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable + hprefix sourceExplicitAffineCellOriginalSourceComputable + change BitTM + (fun input => lengthPrefixedWord + (sourceExplicitAffineCellRow input) ++ + sourceExplicitAffineCellOriginalSource input) + simpa only [Function.comp_apply] using hphysical + +private def gaussianPackedBasisColumnPivotQuery (input : List Bool) : List Bool := + lengthPrefixedWord (sourceExplicitAffineCellColumn input) ++ + sourceExplicitAffineCellOriginalSource input + +private noncomputable def gaussianPackedBasisColumnPivotQueryComputable : + BitTM + gaussianPackedBasisColumnPivotQuery := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellColumnComputable structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable + hprefix sourceExplicitAffineCellOriginalSourceComputable + change BitTM + (fun input => lengthPrefixedWord + (sourceExplicitAffineCellColumn input) ++ + sourceExplicitAffineCellOriginalSource input) + simpa only [Function.comp_apply] using hphysical + +@[simp] private theorem gaussianPackedBasisRowPivotQuery_query + (row column : ℕ) (state : List Bool) : + gaussianPackedBasisRowPivotQuery + (affineCellQuery row column state) = + gaussianPackedIndexedStateWord row state := by + simp only [gaussianPackedBasisRowPivotQuery, sourceExplicitAffineCellRow_query, + sourceExplicitAffineCellOriginalSource_query, gaussianPackedIndexedStateWord] + +@[simp] private theorem gaussianPackedBasisColumnPivotQuery_query + (row column : ℕ) (state : List Bool) : + gaussianPackedBasisColumnPivotQuery + (affineCellQuery row column state) = + gaussianPackedIndexedStateWord column state := by + simp only [gaussianPackedBasisColumnPivotQuery, sourceExplicitAffineCellColumn_query, + sourceExplicitAffineCellOriginalSource_query, gaussianPackedIndexedStateWord] + +private def gaussianPackedBasisRowPivotWord : List Bool → List Bool := + gaussianPackedIndexedPivotOutput ∘ gaussianPackedBasisRowPivotQuery + +private noncomputable def gaussianPackedBasisRowPivotComputable : + BitTM + gaussianPackedBasisRowPivotWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedBasisRowPivotQueryComputable + gaussianPackedIndexedPivotComputable + +private def gaussianPackedBasisColumnPivotWord : List Bool → List Bool := + gaussianPackedIndexedPivotOutput ∘ gaussianPackedBasisColumnPivotQuery + +private noncomputable def gaussianPackedBasisColumnPivotComputable : + BitTM + gaussianPackedBasisColumnPivotWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedBasisColumnPivotQueryComputable + gaussianPackedIndexedPivotComputable + +private def gaussianPackedBasisRowPresentWord : List Bool → List Bool := + binaryGaussianFirstCellWord ∘ gaussianPackedBasisRowPivotWord + +private noncomputable def gaussianPackedBasisRowPresentComputable : + BitTM + gaussianPackedBasisRowPresentWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedBasisRowPivotComputable binaryGaussianFirstCellComputable + +private def gaussianPackedBasisColumnPresentWord : List Bool → List Bool := + binaryGaussianFirstCellWord ∘ gaussianPackedBasisColumnPivotWord + +private noncomputable def gaussianPackedBasisColumnPresentComputable : + BitTM + gaussianPackedBasisColumnPresentWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedBasisColumnPivotComputable binaryGaussianFirstCellComputable + +private def gaussianPackedBasisPivotRowUnary : List Bool → List Bool := + List.tail ∘ gaussianPackedBasisRowPivotWord + +private noncomputable def gaussianPackedBasisPivotRowUnaryComputable : + BitTM + gaussianPackedBasisPivotRowUnary := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedBasisRowPivotComputable + dropHeadComputable + +private def gaussianPackedBasisDiagonalWord : List Bool → List Bool := + fourFamilyComputedUnaryEqBitOutput + sourceExplicitAffineCellRow sourceExplicitAffineCellColumn + +private noncomputable def gaussianPackedBasisDiagonalComputable : + BitTM + gaussianPackedBasisDiagonalWord := + fourFamilyComputedUnaryEqBitComputable + sourceExplicitAffineCellRowComputable + sourceExplicitAffineCellColumnComputable + +private def gaussianPackedBasisCoefficientQuery + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPackedBasisPivotRowUnary input) ++ + (lengthPrefixedWord (sourceExplicitAffineCellColumn input) ++ + sourceExplicitAffineCellOriginalSource input) + +private noncomputable def gaussianPackedBasisCoefficientQueryComputable : + BitTM + gaussianPackedBasisCoefficientQuery := by + have hrow := GapCVP.TMComposition.computableInPolyTime + gaussianPackedBasisPivotRowUnaryComputable + structuralPrefixWriterComputable + have hcolumn := GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellColumnComputable + structuralPrefixWriterComputable + have htail := pointwiseAppendComputable + hcolumn sourceExplicitAffineCellOriginalSourceComputable + have hphysical := pointwiseAppendComputable hrow htail + change BitTM + (fun input => + lengthPrefixedWord (gaussianPackedBasisPivotRowUnary input) ++ + (lengthPrefixedWord (sourceExplicitAffineCellColumn input) ++ + sourceExplicitAffineCellOriginalSource input)) + simpa only [Function.comp_apply] using hphysical + +private def gaussianPackedBasisCoefficientWord : List Bool → List Bool := + gaussianPackedStateCheckCellWord ∘ gaussianPackedBasisCoefficientQuery + +private noncomputable def gaussianPackedBasisCoefficientComputable : + BitTM + gaussianPackedBasisCoefficientWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedBasisCoefficientQueryComputable + gaussianPackedStateCheckCellComputable + +private def gaussianPackedBasisBothPivotWord : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + gaussianPackedBasisRowPresentWord + gaussianPackedBasisColumnPresentWord + +private noncomputable def gaussianPackedBasisBothPivotComputable : + BitTM + gaussianPackedBasisBothPivotWord := + fourFamilyBooleanAndComputable + gaussianPackedBasisRowPresentComputable + gaussianPackedBasisColumnPresentComputable + +private def gaussianPackedBasisRowFreeWord : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput gaussianPackedBasisRowPresentWord + +private noncomputable def gaussianPackedBasisRowFreeComputable : + BitTM + gaussianPackedBasisRowFreeWord := + fourFamilyBooleanNotOutputComputable + gaussianPackedBasisRowPresentComputable + +private def gaussianPackedBasisColumnFreeWord : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput gaussianPackedBasisColumnPresentWord + +private noncomputable def gaussianPackedBasisColumnFreeComputable : + BitTM + gaussianPackedBasisColumnFreeWord := + fourFamilyBooleanNotOutputComputable + gaussianPackedBasisColumnPresentComputable + +private def gaussianPackedBasisBothFreeWord : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + gaussianPackedBasisRowFreeWord gaussianPackedBasisColumnFreeWord + +private noncomputable def gaussianPackedBasisBothFreeComputable : + BitTM + gaussianPackedBasisBothFreeWord := + fourFamilyBooleanAndComputable + gaussianPackedBasisRowFreeComputable + gaussianPackedBasisColumnFreeComputable + +private def gaussianPackedBasisMatchingKindWord : List Bool → List Bool := + sourceFourFamilyBooleanOrOutput + gaussianPackedBasisBothPivotWord gaussianPackedBasisBothFreeWord + +private noncomputable def gaussianPackedBasisMatchingKindComputable : + BitTM + gaussianPackedBasisMatchingKindWord := + sourceFourFamilyBooleanOrComputable + gaussianPackedBasisBothPivotComputable + gaussianPackedBasisBothFreeComputable + +private def gaussianPackedBasisDiagonalNonzeroWord : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + gaussianPackedBasisDiagonalWord gaussianPackedBasisMatchingKindWord + +private noncomputable def gaussianPackedBasisDiagonalNonzeroComputable : + BitTM + gaussianPackedBasisDiagonalNonzeroWord := + fourFamilyBooleanAndComputable + gaussianPackedBasisDiagonalComputable + gaussianPackedBasisMatchingKindComputable + +private def gaussianPackedBasisPivotFreeCoefficientWord : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput gaussianPackedBasisRowPresentWord + (sourceFourFamilyBooleanAndOutput + gaussianPackedBasisColumnFreeWord gaussianPackedBasisCoefficientWord) + +private noncomputable def gaussianPackedBasisPivotFreeCoefficientComputable : + BitTM + gaussianPackedBasisPivotFreeCoefficientWord := + fourFamilyBooleanAndComputable + gaussianPackedBasisRowPresentComputable + (fourFamilyBooleanAndComputable + gaussianPackedBasisColumnFreeComputable + gaussianPackedBasisCoefficientComputable) + +private def gaussianPackedBasisFirstBit : List Bool → List Bool := + sourceFourFamilyBooleanOrOutput + gaussianPackedBasisDiagonalNonzeroWord + gaussianPackedBasisPivotFreeCoefficientWord + +private noncomputable def gaussianPackedBasisFirstBitComputable : + BitTM + gaussianPackedBasisFirstBit := + sourceFourFamilyBooleanOrComputable + gaussianPackedBasisDiagonalNonzeroComputable + gaussianPackedBasisPivotFreeCoefficientComputable + +private def gaussianPackedBasisSecondBit : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + gaussianPackedBasisBothPivotWord gaussianPackedBasisDiagonalWord + +private noncomputable def gaussianPackedBasisSecondBitComputable : + BitTM + gaussianPackedBasisSecondBit := + fourFamilyBooleanAndComputable + gaussianPackedBasisBothPivotComputable + gaussianPackedBasisDiagonalComputable + +/-- GapCVP reduction support. -/ +def gaussianPackedIndexedBasisTag + (input : List Bool) : List Bool := + gaussianPackedBasisFirstBit input ++ gaussianPackedBasisSecondBit input + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedIndexedBasisTagComputable : + BitTM + gaussianPackedIndexedBasisTag := + pointwiseAppendComputable + gaussianPackedBasisFirstBitComputable + gaussianPackedBasisSecondBitComputable + +/-- GapCVP reduction support. -/ +def gaussianPackedIndexedBasisAtom : List Bool → List Bool := + effectiveBasisPackedAtom ∘ gaussianPackedIndexedBasisTag + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPackedIndexedBasisAtomComputable : + BitTM + gaussianPackedIndexedBasisAtom := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedIndexedBasisTagComputable + effectiveBasisPackedAtomComputable + +private theorem gaussianPackedBasisCoefficientWord_singleton + (input : List Bool) : + gaussianPackedBasisCoefficientWord input = + [(gaussianPackedBasisCoefficientWord input).headD false] := by + unfold gaussianPackedBasisCoefficientWord + simp only [Function.comp_apply] + unfold gaussianPackedStateCheckCellWord + fiveFamilyOriginalDynamicBitWord + rw [fiveFamilyOriginalHeadBitWord_eq] + simp only [List.headD_cons] + +private theorem gaussianPackedBasisRowPivotWord_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : Fin n) : + gaussianPackedBasisRowPivotWord + (affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianStatePivotWord state row := by + unfold gaussianPackedBasisRowPivotWord + rw [Function.comp_apply, gaussianPackedBasisRowPivotQuery_query] + exact gaussianPackedIndexedPivotOutput_word state row source + +private theorem gaussianPackedBasisColumnPivotWord_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : Fin n) : + gaussianPackedBasisColumnPivotWord + (affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianStatePivotWord state column := by + unfold gaussianPackedBasisColumnPivotWord + rw [Function.comp_apply, gaussianPackedBasisColumnPivotQuery_query] + exact gaussianPackedIndexedPivotOutput_word state column source + +private theorem gaussianPackedBasisRowPresentWord_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : Fin n) : + gaussianPackedBasisRowPresentWord + (affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source)) = + [(effectiveGaussianStatePivotRowOption state row).isSome] := by + unfold gaussianPackedBasisRowPresentWord + rw [Function.comp_apply, + gaussianPackedBasisRowPivotWord_query state source row column] + cases hpivot : effectiveGaussianStatePivotRowOption state row <;> + simp [effectiveGaussianStatePivotWord, hpivot] + +private theorem gaussianPackedBasisColumnPresentWord_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : Fin n) : + gaussianPackedBasisColumnPresentWord + (affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source)) = + [(effectiveGaussianStatePivotRowOption state column).isSome] := by + unfold gaussianPackedBasisColumnPresentWord + rw [Function.comp_apply, + gaussianPackedBasisColumnPivotWord_query state source row column] + cases hpivot : effectiveGaussianStatePivotRowOption state column <;> + simp [effectiveGaussianStatePivotWord, hpivot] + +private theorem gaussianPackedBasisDiagonalWord_query + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : Fin n) : + gaussianPackedBasisDiagonalWord + (affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source)) = + [decide (row.val = column.val)] := by + exact fourFamilyComputedUnaryEqBitOutput_valid + sourceExplicitAffineCellRow sourceExplicitAffineCellColumn + (affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source)) + row.val column.val + (sourceExplicitAffineCellRow_query row.val column.val + (effectiveGaussianPackedStateWord state source)) + (sourceExplicitAffineCellColumn_query row.val column.val + (effectiveGaussianPackedStateWord state source)) + +private theorem gaussianPackedBasisCoefficientWord_query_pivot + {m n : ℕ} (state : State m n) + (source : List Bool) (row column : Fin n) (pivot : Fin m) + (hpivot : effectiveGaussianStatePivotRowOption state row = some pivot) : + gaussianPackedBasisCoefficientWord + (affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source)) = + [decide (state.system.check pivot column = (1 : ZMod 2))] := by + let input := affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source) + have hrow : gaussianPackedBasisPivotRowUnary input = + List.replicate pivot.val true := by + unfold gaussianPackedBasisPivotRowUnary + rw [Function.comp_apply, + gaussianPackedBasisRowPivotWord_query state source row column] + simp only [effectiveGaussianStatePivotWord, hpivot, List.tail_cons] + have hquery : gaussianPackedBasisCoefficientQuery input = + affineCellQuery pivot.val column.val + (effectiveGaussianPackedStateWord state source) := by + unfold gaussianPackedBasisCoefficientQuery + affineCellQuery + rw [hrow, sourceExplicitAffineCellColumn_query, + sourceExplicitAffineCellOriginalSource_query] + simp only [List.append_assoc] + have hrows : 0 < m := by + have hlt := pivot.isLt + omega + unfold gaussianPackedBasisCoefficientWord + rw [Function.comp_apply, hquery] + exact gaussianPackedStateCheckCellWord_query + state source pivot column hrows + +private theorem gaussianPackedBasisFirstBit_bits + (input : List Bool) (rowPivot columnPivot diagonal coefficient : Bool) + (hrow : gaussianPackedBasisRowPresentWord input = [rowPivot]) + (hcolumn : gaussianPackedBasisColumnPresentWord input = [columnPivot]) + (hdiagonal : gaussianPackedBasisDiagonalWord input = [diagonal]) + (hcoefficient : gaussianPackedBasisCoefficientWord input = [coefficient]) : + gaussianPackedBasisFirstBit input = + [((diagonal && + ((rowPivot && columnPivot) || + ((!rowPivot) && (!columnPivot)))) || + (rowPivot && ((!columnPivot) && coefficient)))] := by + have hboth := fourFamilyBooleanAndOutput_bits + gaussianPackedBasisRowPresentWord gaussianPackedBasisColumnPresentWord + input rowPivot columnPivot hrow hcolumn + have hrowFree := fourFamilyBooleanNotOutput_bit + gaussianPackedBasisRowPresentWord input rowPivot hrow + have hcolumnFree := fourFamilyBooleanNotOutput_bit + gaussianPackedBasisColumnPresentWord input columnPivot hcolumn + have hfree := fourFamilyBooleanAndOutput_bits + gaussianPackedBasisRowFreeWord gaussianPackedBasisColumnFreeWord + input (!rowPivot) (!columnPivot) hrowFree hcolumnFree + have hkind := fourFamilyBooleanOrOutput_bits + gaussianPackedBasisBothPivotWord gaussianPackedBasisBothFreeWord + input (rowPivot && columnPivot) + ((!rowPivot) && (!columnPivot)) hboth hfree + have hnonzero := fourFamilyBooleanAndOutput_bits + gaussianPackedBasisDiagonalWord gaussianPackedBasisMatchingKindWord + input diagonal + ((rowPivot && columnPivot) || + ((!rowPivot) && (!columnPivot))) hdiagonal hkind + have hcolumnCoefficient := fourFamilyBooleanAndOutput_bits + gaussianPackedBasisColumnFreeWord gaussianPackedBasisCoefficientWord + input (!columnPivot) coefficient hcolumnFree hcoefficient + have hpivotCoefficient := fourFamilyBooleanAndOutput_bits + gaussianPackedBasisRowPresentWord + (sourceFourFamilyBooleanAndOutput + gaussianPackedBasisColumnFreeWord gaussianPackedBasisCoefficientWord) + input rowPivot ((!columnPivot) && coefficient) + hrow hcolumnCoefficient + exact fourFamilyBooleanOrOutput_bits + gaussianPackedBasisDiagonalNonzeroWord + gaussianPackedBasisPivotFreeCoefficientWord input + (diagonal && + ((rowPivot && columnPivot) || + ((!rowPivot) && (!columnPivot)))) + (rowPivot && ((!columnPivot) && coefficient)) + hnonzero hpivotCoefficient + +private theorem gaussianPackedBasisSecondBit_bits + (input : List Bool) (rowPivot columnPivot diagonal : Bool) + (hrow : gaussianPackedBasisRowPresentWord input = [rowPivot]) + (hcolumn : gaussianPackedBasisColumnPresentWord input = [columnPivot]) + (hdiagonal : gaussianPackedBasisDiagonalWord input = [diagonal]) : + gaussianPackedBasisSecondBit input = + [(rowPivot && columnPivot) && diagonal] := by + have hboth := fourFamilyBooleanAndOutput_bits + gaussianPackedBasisRowPresentWord gaussianPackedBasisColumnPresentWord + input rowPivot columnPivot hrow hcolumn + exact fourFamilyBooleanAndOutput_bits + gaussianPackedBasisBothPivotWord gaussianPackedBasisDiagonalWord + input (rowPivot && columnPivot) diagonal hboth hdiagonal + +theorem gaussianPackedIndexedBasisTag_state + {m n : ℕ} (state : State m n) + (row column : Fin n) (source : List Bool) : + gaussianPackedIndexedBasisTag + (gaussianPackedIndexedBasisStateWord row.val column.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianStateBasisTag state row column := by + let input := affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source) + change gaussianPackedBasisFirstBit input ++ + gaussianPackedBasisSecondBit input = + effectiveGaussianStateBasisTag state row column + have hrow := gaussianPackedBasisRowPresentWord_query + state source row column + have hcolumn := gaussianPackedBasisColumnPresentWord_query + state source row column + have hdiagonal := gaussianPackedBasisDiagonalWord_query + state source row column + have harbitrary := gaussianPackedBasisCoefficientWord_singleton input + cases hpivotRow : effectiveGaussianStatePivotRowOption state row with + | none => + cases hpivotColumn : effectiveGaussianStatePivotRowOption state column with + | none => + have hfirst := gaussianPackedBasisFirstBit_bits input + false false (decide (row.val = column.val)) + ((gaussianPackedBasisCoefficientWord input).headD false) + (by simpa only [hpivotRow, Option.isSome_none, input] using hrow) + (by simpa only [hpivotColumn, Option.isSome_none, input] using hcolumn) + (by simpa only [input] using hdiagonal) harbitrary + have hsecond := gaussianPackedBasisSecondBit_bits input + false false (decide (row.val = column.val)) + (by simpa only [hpivotRow, Option.isSome_none, input] using hrow) + (by simpa only [hpivotColumn, Option.isSome_none, input] using hcolumn) + (by simpa only [input] using hdiagonal) + rw [hfirst, hsecond] + unfold effectiveGaussianStateBasisTag + rw [hpivotRow, hpivotColumn] + by_cases hval : row.val = column.val + · have heq : row = column := Fin.ext hval + simp only [heq, decide_true, Bool.and_self, Bool.not_false, Bool.or_true, + List.headD_eq_head?_getD, + Bool.true_and, Bool.false_and, Bool.or_false, Bool.and_true, List.cons_append, + List.nil_append, ↓reduceIte] + · have heq : row ≠ column := by + intro h + exact hval (congrArg Fin.val h) + simp only [hval, decide_false, Bool.and_self, Bool.not_false, Bool.or_true, + Bool.and_true, + List.headD_eq_head?_getD, Bool.true_and, Bool.false_and, Bool.or_self, + List.cons_append, List.nil_append, heq, + ↓reduceIte] + | some pivot => + have hfirst := gaussianPackedBasisFirstBit_bits input + false true (decide (row.val = column.val)) + ((gaussianPackedBasisCoefficientWord input).headD false) + (by simpa only [hpivotRow, Option.isSome_none, input] using hrow) + (by simpa only [hpivotColumn, Option.isSome_some, input] using hcolumn) + (by simpa only [input] using hdiagonal) harbitrary + have hsecond := gaussianPackedBasisSecondBit_bits input + false true (decide (row.val = column.val)) + (by simpa only [hpivotRow, Option.isSome_none, input] using hrow) + (by simpa only [hpivotColumn, Option.isSome_some, input] using hcolumn) + (by simpa only [input] using hdiagonal) + rw [hfirst, hsecond] + unfold effectiveGaussianStateBasisTag + rw [hpivotRow, hpivotColumn] + simp only [Bool.and_true, Bool.not_false, Bool.not_true, Bool.and_false, Bool.or_self, + List.headD_eq_head?_getD, Bool.false_and, Bool.and_self, List.cons_append, + List.nil_append] + | some pivot => + cases hpivotColumn : effectiveGaussianStatePivotRowOption state column with + | none => + have hcoefficient := + gaussianPackedBasisCoefficientWord_query_pivot + state source row column pivot hpivotRow + have hfirst := gaussianPackedBasisFirstBit_bits input + true false (decide (row.val = column.val)) + (decide (state.system.check pivot column = (1 : ZMod 2))) + (by simpa only [hpivotRow, Option.isSome_some, input] using hrow) + (by simpa only [hpivotColumn, Option.isSome_none, input] using hcolumn) + (by simpa only [input] using hdiagonal) + (by simpa only [input] using hcoefficient) + have hsecond := gaussianPackedBasisSecondBit_bits input + true false (decide (row.val = column.val)) + (by simpa only [hpivotRow, Option.isSome_some, input] using hrow) + (by simpa only [hpivotColumn, Option.isSome_none, input] using hcolumn) + (by simpa only [input] using hdiagonal) + rw [hfirst, hsecond] + unfold effectiveGaussianStateBasisTag + rw [hpivotRow, hpivotColumn] + simp only [Bool.and_false, Bool.not_true, Bool.not_false, Bool.and_true, Bool.or_self, + Bool.true_and, + Bool.false_or, Bool.false_and, List.cons_append, List.nil_append] + | some other => + have hfirst := gaussianPackedBasisFirstBit_bits input + true true (decide (row.val = column.val)) + ((gaussianPackedBasisCoefficientWord input).headD false) + (by simpa only [hpivotRow, Option.isSome_some, input] using hrow) + (by simpa only [hpivotColumn, Option.isSome_some, input] using hcolumn) + (by simpa only [input] using hdiagonal) harbitrary + have hsecond := gaussianPackedBasisSecondBit_bits input + true true (decide (row.val = column.val)) + (by simpa only [hpivotRow, Option.isSome_some, input] using hrow) + (by simpa only [hpivotColumn, Option.isSome_some, input] using hcolumn) + (by simpa only [input] using hdiagonal) + rw [hfirst, hsecond] + unfold effectiveGaussianStateBasisTag + rw [hpivotRow, hpivotColumn] + by_cases hval : row.val = column.val + · have heq : row = column := Fin.ext hval + simp only [heq, decide_true, Bool.and_self, Bool.not_true, Bool.or_false, + List.headD_eq_head?_getD, + Bool.false_and, Bool.and_false, List.cons_append, List.nil_append, ↓reduceIte] + · have heq : row ≠ column := by + intro h + exact hval (congrArg Fin.val h) + simp only [hval, decide_false, Bool.and_self, Bool.not_true, Bool.or_false, + Bool.and_true, + List.headD_eq_head?_getD, Bool.false_and, Bool.and_false, Bool.or_self, + List.cons_append, List.nil_append, heq, + ↓reduceIte] + +theorem gaussianPackedIndexedBasisAtom_effective + (system : BinaryAffineSystem) + (row column : Fin system.dimension) (source : List Bool) : + gaussianPackedIndexedBasisAtom + (gaussianPackedIndexedBasisStateWord row.val column.val + (effectiveGaussianPackedStateWord + system.effectiveGaussianState source)) = + encodeAtomic (system.effectiveSquareBasisMatrix row column) := by + unfold gaussianPackedIndexedBasisAtom + rw [Function.comp_apply, + gaussianPackedIndexedBasisTag_state] + exact effectiveGaussianStateBasisTag_effective_atom + system row column + +end GaussianPackedStateBasisAtomTM + +namespace Factor400FinitePNormCorollary + +open scoped BigOperators ENNReal + +/-- GapCVP reduction support. -/ +def finitePNorm (p : ℚ) {n : ℕ} (x : Fin n → ℝ) : ℝ := + (∑ i : Fin n, |x i| ^ (p : ℝ)) ^ ((p : ℝ)⁻¹) + +theorem finitePNorm_nonneg (p : ℚ) {n : ℕ} (x : Fin n → ℝ) : + 0 ≤ finitePNorm p x := by + unfold finitePNorm + exact Real.rpow_nonneg (Finset.sum_nonneg fun _ _ => + Real.rpow_nonneg (abs_nonneg _) _) _ + +theorem finitePNorm_rpow (p : ℚ) (hp : 0 < p) + {n : ℕ} (x : Fin n → ℝ) : + finitePNorm p x ^ (p : ℝ) = + ∑ i : Fin n, |x i| ^ (p : ℝ) := by + have hp_real : (0 : ℝ) < (p : ℝ) := by exact_mod_cast hp + unfold finitePNorm + exact Real.rpow_inv_rpow + (Finset.sum_nonneg fun _ _ => Real.rpow_nonneg (abs_nonneg _) _) + hp_real.ne' + +/-- GapCVP reduction support. -/ +def finitePLatticeDiscrepancy (I : GapCVPInstance) + (z : Fin I.dimension → ℤ) : Fin I.dimension → ℝ := fun i => + (I.target i : ℝ) - + ∑ j : Fin I.dimension, (I.basis i j : ℝ) * (z j : ℝ) + +/-- GapCVP reduction support. -/ +def finitePLatticeDistance (p : ℚ) (I : GapCVPInstance) + (z : Fin I.dimension → ℤ) : ℝ := + finitePNorm p (finitePLatticeDiscrepancy I z) + +/-- GapCVP reduction support. -/ +def finitePGapFactor (p : ℚ) (I : GapCVPInstance) : ℝ := + (I.dimension : ℝ) ^ (((200 : ℝ) * (p : ℝ))⁻¹) + +private theorem finitePGapFactor_one_le (p : ℚ) (hp : 1 ≤ p) + {I : GapCVPInstance} (hdimension : 0 < I.dimension) : + 1 ≤ finitePGapFactor p I := by + unfold finitePGapFactor + apply Real.one_le_rpow + · exact_mod_cast hdimension + · have hp_real : (0 : ℝ) < (p : ℝ) := by + have : (0 : ℚ) < p := lt_of_lt_of_le (by norm_num) hp + exact_mod_cast this + exact inv_nonneg.mpr (mul_nonneg (by norm_num) hp_real.le) + +/-- GapCVP reduction support. -/ +def finitePRadiusScale (p : ℚ) : ℕ := + Nat.ceil (4 * p) + +theorem finitePRadiusScale_pos (p : ℚ) (hp : 1 ≤ p) : + 0 < finitePRadiusScale p := by + apply Nat.ceil_pos.mpr + have hp_pos : (0 : ℚ) < p := lt_of_lt_of_le (by norm_num) hp + exact mul_pos (by norm_num) hp_pos + +private def finitePCeilingRoot (a value : ℕ) : ℕ := + let root := Nat.nthRoot a value + if root ^ a = value then root else root + 1 + +/-- GapCVP reduction support. -/ +def finitePRadiusNumerator (p : ℚ) (R : ℕ) : ℕ := + finitePCeilingRoot p.num.natAbs + (finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) + +/-- GapCVP reduction support. -/ +def finitePRadius (p : ℚ) (R : ℕ) : ℚ := + (finitePRadiusNumerator p R : ℚ) / (finitePRadiusScale p : ℚ) + +/-- GapCVP reduction support. -/ +def finitePSignedBinarySupport {n : ℕ} (z : Fin n → ℤ) : Finset (Fin n) := + Finset.univ.filter fun i => (z i : ZMod 2) ≠ 0 + +theorem finitePSignedBinarySupport_card_le_power_sum + (p : ℚ) (hp : 1 ≤ p) {n : ℕ} (z : Fin n → ℤ) : + ((finitePSignedBinarySupport z).card : ℝ) ≤ + ∑ i : Fin n, |(z i : ℝ)| ^ (p : ℝ) := by + have hp_real : (0 : ℝ) ≤ (p : ℝ) := by + have : (0 : ℚ) ≤ p := le_trans (by norm_num) hp + exact_mod_cast this + calc + ((finitePSignedBinarySupport z).card : ℝ) = + ∑ _i ∈ finitePSignedBinarySupport z, (1 : ℝ) := by simp only [Finset.sum_const, + nsmul_eq_mul, mul_one] + _ ≤ ∑ i ∈ finitePSignedBinarySupport z, + |(z i : ℝ)| ^ (p : ℝ) := by + apply Finset.sum_le_sum + intro i hi + have hparity : (z i : ZMod 2) ≠ 0 := + (Finset.mem_filter.mp hi).2 + have hne : z i ≠ 0 := by + intro hzero + apply hparity + simp only [hzero, Int.cast_zero] + have hone : (1 : ℝ) ≤ |(z i : ℝ)| := by + exact_mod_cast Int.one_le_abs hne + exact Real.one_le_rpow hone hp_real + _ ≤ ∑ i : Fin n, |(z i : ℝ)| ^ (p : ℝ) := by + apply Finset.sum_le_sum_of_subset_of_nonneg + · exact Finset.filter_subset _ _ + · intro i _ _ + exact Real.rpow_nonneg (abs_nonneg _) _ + +/-- GapCVP reduction support. -/ +def finitePGapCVPPromise (p : ℚ) (hp : 1 ≤ p) : PromiseProblem where + yes bits := + @decide ( + ∃ I : GapCVPInstance, + (binaryFinEncoding GapCVPInstance).encode I = bits ∧ + gapCVPWellFormed I ∧ + ∃ z : Fin I.dimension → ℤ, + finitePLatticeDistance p I z ≤ (I.radius : ℝ) + ) (Classical.propDecidable _) + no bits := + @decide ( + ∃ I : GapCVPInstance, + (binaryFinEncoding GapCVPInstance).encode I = bits ∧ + gapCVPWellFormed I ∧ + ∀ z : Fin I.dimension → ℤ, + finitePGapFactor p I * (I.radius : ℝ) < + finitePLatticeDistance p I z + ) (Classical.propDecidable _) + disjoint bits hyes hno := by + simp only [decide_eq_true_eq] at hyes hno + obtain ⟨I, hI, hwell, z, hz⟩ := hyes + have well := hwell + simp only [GapCVP.gapCVPWellFormed, decide_eq_true_eq] at well + obtain ⟨J, hJ, _, hfar⟩ := hno + have heq : I = J := + (binaryFinEncoding GapCVPInstance).encode_injective + (hI.trans hJ.symm) + subst J + have hfactor := finitePGapFactor_one_le p hp well.1 + have hradius : 0 < (I.radius : ℝ) := by + exact_mod_cast well.2.2 + have hscaled : + (I.radius : ℝ) ≤ finitePGapFactor p I * (I.radius : ℝ) := by + nlinarith + exact (not_le_of_gt (hfar z)) (hz.trans hscaled) + +end Factor400FinitePNormCorollary + +namespace Factor400FinitePRadiusArithmetic + +open GapCVP.Factor400FinitePNormCorollary + +theorem finitePExponent_num_pos (p : ℚ) (hp : 1 ≤ p) : + 0 < p.num.natAbs := by + have hp' : 0 < p := lt_of_lt_of_le (by norm_num) hp + exact Int.natAbs_pos.mpr (Rat.num_pos.mpr hp').ne' + +theorem finitePExponent_cast (p : ℚ) (hp : 1 ≤ p) : + (p : ℝ) = (p.num.natAbs : ℝ) / (p.den : ℝ) := by + rw [Rat.cast_def] + have hp' : 0 < p := lt_of_lt_of_le (by norm_num) hp + have hnum : 0 ≤ p.num := (Rat.num_pos.mpr hp').le + have habs : (p.num.natAbs : ℤ) = p.num := + Int.natAbs_of_nonneg hnum + congr 1 + simpa only [Int.cast_natCast] using + congrArg (fun value : ℤ => (value : ℝ)) habs.symm + +theorem four_mul_le_finitePRadiusScale (p : ℚ) : + 4 * (p : ℝ) ≤ (finitePRadiusScale p : ℝ) := by + have hceil : 4 * p ≤ (finitePRadiusScale p : ℚ) := by + exact Nat.le_ceil (4 * p) + exact_mod_cast hceil + +private theorem finitePCeilingRoot_spec (a value : ℕ) (ha : 0 < a) : + value ≤ finitePCeilingRoot a value ^ a := by + simp only [finitePCeilingRoot] + split_ifs with hexact + · exact hexact.symm.le + · exact (Nat.lt_pow_nthRoot_add_one ha.ne' value).le + +private theorem finitePCeilingRoot_minimal + (a value candidate : ℕ) (ha : 0 < a) + (hcandidate : value ≤ candidate ^ a) : + finitePCeilingRoot a value ≤ candidate := by + simp only [finitePCeilingRoot] + split_ifs with hexact + · apply (Nat.pow_left_strictMono ha.ne').le_iff_le.mp + exact hexact.le.trans hcandidate + · have hfloor : Nat.nthRoot a value ^ a ≤ value := + Nat.pow_nthRoot_le (Or.inl ha.ne') + have hstrict : Nat.nthRoot a value ^ a < value := + lt_of_le_of_ne hfloor hexact + have hroot : Nat.nthRoot a value < candidate := + (Nat.pow_left_strictMono ha.ne').lt_iff_lt.mp + (hstrict.trans_le hcandidate) + omega + +theorem finitePCeilingRoot_le_nthRoot_add_one (a value : ℕ) : + finitePCeilingRoot a value ≤ Nat.nthRoot a value + 1 := by + simp only [finitePCeilingRoot] + split_ifs <;> omega + +theorem finitePRadiusNumerator_spec (p : ℚ) (hp : 1 ≤ p) (R : ℕ) : + finitePRadiusScale p ^ p.num.natAbs * R ^ p.den ≤ + finitePRadiusNumerator p R ^ p.num.natAbs := by + exact finitePCeilingRoot_spec p.num.natAbs + (finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) + (finitePExponent_num_pos p hp) + +private theorem finitePRadiusNumerator_pos + (p : ℚ) (hp : 1 ≤ p) (R : ℕ) (hR : 0 < R) : + 0 < finitePRadiusNumerator p R := by + have hscale := finitePRadiusScale_pos p hp + have hvalue : + 0 < finitePRadiusScale p ^ p.num.natAbs * R ^ p.den := + Nat.mul_pos (pow_pos hscale _) (pow_pos hR _) + have hpower : 0 < finitePRadiusNumerator p R ^ p.num.natAbs := + hvalue.trans_le (finitePRadiusNumerator_spec p hp R) + exact Nat.pos_of_ne_zero fun hzero => by + simp only [hzero, ne_eq, (finitePExponent_num_pos p hp).ne', not_false_eq_true, zero_pow, + lt_self_iff_false] at hpower + +theorem finitePRadius_pos + (p : ℚ) (hp : 1 ≤ p) (R : ℕ) (hR : 0 < R) : + 0 < finitePRadius p R := by + unfold finitePRadius + exact div_pos (by exact_mod_cast finitePRadiusNumerator_pos p hp R hR) + (by exact_mod_cast finitePRadiusScale_pos p hp) + +theorem finitePRadius_cast (p : ℚ) (R : ℕ) : + (finitePRadius p R : ℝ) = + (finitePRadiusNumerator p R : ℝ) / + (finitePRadiusScale p : ℝ) := by + simp only [finitePRadius, Rat.cast_div, Rat.cast_natCast] + +end Factor400FinitePRadiusArithmetic + +namespace Factor400BinaryCodeDecodingCorollary + +open scoped BigOperators + +open GapCVP.Factor400BinaryConstructiveSourcePlaces + +/-- GapCVP reduction support. -/ +def binaryWordLift {n : ℕ} (word : Fin n → ZMod 2) : Fin n → ℤ := + fun index => ((word index).val : ℤ) + +@[simp] theorem binaryResidue_binaryWordLift + {n : ℕ} (word : Fin n → ZMod 2) : + GapCVP.Core.binaryResidue (binaryWordLift word) = word := by + funext index + exact_mod_cast ZMod.natCast_zmod_val (word index) + +/-- GapCVP reduction support. -/ +noncomputable def sourceBinaryDecodingRadius + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) : ℕ := + (formula.clauses.length + 1) * + (sourceFormulaGrid encodingLength formula).card + +theorem sourceBinaryDecodingRadius_pos + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) : + 0 < sourceBinaryDecodingRadius encodingLength formula := by + unfold sourceBinaryDecodingRadius + exact Nat.mul_pos (Nat.zero_lt_succ formula.clauses.length) + (sourceFormulaGrid_card_pos encodingLength formula) + +private theorem sourceBinaryDecodingRadius_le_size_mul_field + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) : + sourceBinaryDecodingRadius encodingLength formula ≤ + GapCVP.Core.sourceSizeParameter encodingLength formula * + Fintype.card (sourceFormulaField encodingLength formula) := by + unfold sourceBinaryDecodingRadius + have hclauses : formula.clauses.length + 1 ≤ + GapCVP.Core.sourceSizeParameter encodingLength formula := by + simp only [GapCVP.Core.sourceSizeParameter] + omega + have hgrid : + (sourceFormulaGrid encodingLength formula).card ≤ + Fintype.card (sourceFormulaField encodingLength formula) := + Finset.card_le_card (Finset.subset_univ _) + exact Nat.mul_le_mul hclauses hgrid + +/-- GapCVP reduction support. -/ +noncomputable def binaryCodeGapFactor (blockLength : ℕ) : ℝ := + (blockLength : ℝ) ^ ((1 : ℝ) / 200) + +private theorem binaryCodeGapFactor_eq_factor400_sq (blockLength : ℕ) : + binaryCodeGapFactor blockLength = + GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + blockLength ^ 2 := by + exact + (GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400_sq + blockLength).symm + +theorem sourceBinaryDecoding_scaledNorm_support + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (vector : Fin (sourceFormulaDimension encodingLength formula) → ℤ) + (hshort : (GapCVP.Core.integerSquaredNorm vector : ℝ) ≤ + 2 * binaryCodeGapFactor + (sourceFormulaDimension encodingLength formula) * + (sourceBinaryDecodingRadius encodingLength formula : ℝ)) : + 10 * GapCVP.Core.integerSquaredNorm vector ≤ + Fintype.card (sourceFormulaField encodingLength formula) * + GapCVP.Core.sourceSizeParameter encodingLength formula ^ 4 := by + let N := GapCVP.Core.sourceSizeParameter encodingLength formula + let q := Fintype.card (sourceFormulaField encodingLength formula) + let factor := binaryCodeGapFactor + (sourceFormulaDimension encodingLength formula) + have hq : 0 < q := by + dsimp [q] + exact Fintype.card_pos_iff.mpr ⟨0⟩ + have hqreal : (0 : ℝ) < (q : ℝ) := by + exact_mod_cast hq + have hfactor : 0 ≤ factor := by + dsimp [factor, binaryCodeGapFactor] + positivity + have hweight : + (sourceBinaryDecodingRadius encodingLength formula : ℝ) ≤ + (N : ℝ) * (q : ℝ) := by + exact_mod_cast + sourceBinaryDecodingRadius_le_size_mul_field encodingLength formula + have hmargin : (80 : ℝ) * factor * (N : ℝ) < (N : ℝ) ^ 4 := by + simpa [N, factor, binaryCodeGapFactor_eq_factor400_sq] using + sourceFormula_gapFactor400_eighty_mul_size_lt_fourth_power + encodingLength formula + have hmarginSmall : (20 : ℝ) * factor * (N : ℝ) < + (N : ℝ) ^ 4 := by + have hN : (0 : ℝ) ≤ (N : ℝ) := by positivity + linarith [mul_nonneg hfactor hN] + have hstrict : + ((10 * GapCVP.Core.integerSquaredNorm vector : ℕ) : ℝ) < + ((q * N ^ 4 : ℕ) : ℝ) := by + calc + ((10 * GapCVP.Core.integerSquaredNorm vector : ℕ) : ℝ) = + 10 * (GapCVP.Core.integerSquaredNorm vector : ℝ) := by + push_cast + ring + _ ≤ 10 * (2 * factor * + (sourceBinaryDecodingRadius encodingLength formula : ℝ)) := by + gcongr + _ ≤ 10 * (2 * factor * ((N : ℝ) * (q : ℝ))) := by + gcongr + _ = (20 * factor * (N : ℝ)) * (q : ℝ) := by ring + _ < (N : ℝ) ^ 4 * (q : ℝ) := + mul_lt_mul_of_pos_right hmarginSmall hqreal + _ = ((q * N ^ 4 : ℕ) : ℝ) := by + push_cast + ring + exact Nat.le_of_lt (by exact_mod_cast hstrict) + +end Factor400BinaryCodeDecodingCorollary + +namespace Factor400FinitePRadiusSourceTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceAnchoredGridRecordFoldTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryRadiusTM +open GapCVP.Factor400FinitePNormCorollary GapCVP.Factor400FinitePRadiusArithmetic + +private def finitePNthRootAccumulatorPower (a : ℕ) + (input : List Bool) : List Bool := + List.replicate ((squareRootAccumulator input).length ^ a) true + +private noncomputable def finitePNthRootAccumulatorPowerComputable (a : ℕ) : + BitTM + (finitePNthRootAccumulatorPower a) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + squareRootAccumulatorComputable + (polynomialValueUnaryComputable (Polynomial.X ^ a)) + change BitTM + (fun input : List Bool => + List.replicate ((squareRootAccumulator input).length ^ a) true) + simpa only [Polynomial.eval_pow, Polynomial.eval_X, Function.comp_def] using hphysical + +private def finitePNthRootLessMarker (a : ℕ) + (input : List Bool) : List Bool := + fourFamilyComputedUnaryLessBitOutput + (finitePNthRootAccumulatorPower a) squareRootTarget input + +private noncomputable def finitePNthRootLessMarkerComputable (a : ℕ) : + BitTM + (finitePNthRootLessMarker a) := + fourFamilyComputedUnaryLessBitComputable + (finitePNthRootAccumulatorPowerComputable a) + squareRootTargetComputable + +private theorem finitePNthRootLessMarker_length (a : ℕ) (input : List Bool) : + (finitePNthRootLessMarker a input).length = 1 := + fourFamilyComputedUnaryLessBitOutput_length + (finitePNthRootAccumulatorPower a) squareRootTarget input + +private def finitePNthRootLessBit (a : ℕ) (input : List Bool) : Bool := + (finitePNthRootLessMarker a input).headD false + +private theorem finitePNthRootLessMarker_eq (a : ℕ) (input : List Bool) : + finitePNthRootLessMarker a input = + [finitePNthRootLessBit a input] := by + have hlength := finitePNthRootLessMarker_length a input + cases hword : finitePNthRootLessMarker a input with + | nil => simp only [hword, List.length_nil, zero_ne_one] at hlength + | cons bit remaining => + cases remaining with + | nil => simp only [finitePNthRootLessBit, hword, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] + | cons next tail => simp only [hword, List.length_cons, Nat.add_eq_right, + Nat.add_eq_zero_iff, List.length_eq_zero_iff, + one_ne_zero, and_false] at hlength + +private noncomputable def finitePNthRootLessSelectionComputable (a : ℕ) : + BitTM + (fun input : List Bool => finitePNthRootLessBit a input :: input) := by + have hphysical := pointwiseAppendComputable + (finitePNthRootLessMarkerComputable a) + (Turing.idComputableInPolyTime bitEncoding) + have heq : + (fun input : List Bool => + finitePNthRootLessMarker a input ++ input) = + (fun input : List Bool => finitePNthRootLessBit a input :: input) := by + funext input + simp only [finitePNthRootLessMarker_eq, List.cons_append, List.nil_append] + change BitTM + (fun input : List Bool => + finitePNthRootLessMarker a input ++ input) at hphysical + rwa [heq] at hphysical + +private def finitePNthRootIncrement (a : ℕ) (input : List Bool) : List Bool := + if finitePNthRootLessBit a input then [true] else [] + +private noncomputable def finitePNthRootIncrementComputable (a : ℕ) : + BitTM + (finitePNthRootIncrement a) := + sourcePreservingConditionalComputable + (finitePNthRootLessSelectionComputable a) + (SourceCanonicalFixedWordTuringTM.sourceFixedWordComputable + [true]) [] + +private def finitePNthRootCandidate (a : ℕ) (input : List Bool) : List Bool := + squareRootAccumulator input ++ finitePNthRootIncrement a input + +private noncomputable def finitePNthRootCandidateComputable (a : ℕ) : + BitTM + (finitePNthRootCandidate a) := + pointwiseAppendComputable squareRootAccumulatorComputable + (finitePNthRootIncrementComputable a) + +private def finitePNthRootStep (a target current : ℕ) : ℕ := + if current ^ a < target then current + 1 else current + +private theorem finitePNthRootStep_le_target + (a target current : ℕ) (ha : 0 < a) + (hcurrent : current ≤ target) : + finitePNthRootStep a target current ≤ target := by + unfold finitePNthRootStep + split + next hlt => + have hself : current ≤ current ^ a := + Nat.le_self_pow ha.ne' current + omega + next => exact hcurrent + +private theorem finitePNthRootCandidate_valid + (a current target : ℕ) (padding : List Bool) : + finitePNthRootCandidate a + (lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding) = + List.replicate (finitePNthRootStep a target current) true := by + let input := + lengthPrefixedWord (List.replicate current true) ++ + lengthPrefixedWord (List.replicate target true) ++ padding + have hacc : squareRootAccumulator input = + List.replicate current true := by + simp only [squareRootAccumulator, List.append_assoc, firstFieldContents_valid, input] + have htarget : squareRootTarget input = + List.replicate target true := by + simp only [squareRootTarget, List.append_assoc, firstFieldSuffix_valid, + firstFieldContents_valid, input] + have hpower : finitePNthRootAccumulatorPower a input = + List.replicate (current ^ a) true := by + simp only [finitePNthRootAccumulatorPower, hacc, List.length_replicate] + have hmarker : finitePNthRootLessMarker a input = + [decide (current ^ a < target)] := + fourFamilyComputedUnaryLessBitOutput_valid + (finitePNthRootAccumulatorPower a) squareRootTarget input + (current ^ a) target hpower htarget + have hbit : finitePNthRootLessBit a input = + decide (current ^ a < target) := by + simp only [finitePNthRootLessBit, hmarker, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] + change finitePNthRootCandidate a input = _ + unfold finitePNthRootCandidate finitePNthRootIncrement + rw [hacc, hbit] + by_cases hlt : current ^ a < target + · simp only [hlt, decide_true, ↓reduceIte, SourceStructuralDecoder.replicate_true_append_cons, + List.append_nil, + ← List.replicate_succ, finitePNthRootStep] + · simp only [hlt, decide_false, Bool.false_eq_true, ↓reduceIte, List.append_nil, + finitePNthRootStep] + +private theorem finitePNthRootRotation_step + (a target current : ℕ) (ha : 0 < a) + (hcurrent : current ≤ target) : + sourceAnchoredGridRecordRotationOutput (finitePNthRootCandidate a) + (lengthPrefixedWord + (squareRootAnchor (List.replicate target true)) ++ + lengthPrefixedWord (List.replicate current true)) = + lengthPrefixedWord + (squareRootAnchor (List.replicate target true)) ++ + lengthPrefixedWord + (List.replicate (finitePNthRootStep a target current) true) := by + let anchor := squareRootAnchor (List.replicate target true) + let state := + lengthPrefixedWord anchor ++ + lengthPrefixedWord (List.replicate current true) + have hraw : + sourceAnchoredGridRawCandidate + (finitePNthRootCandidate a) state = + List.replicate (finitePNthRootStep a target current) true := by + change finitePNthRootCandidate a + (sourceAnchoredGridRankSourcePair state) = _ + have hpair : + sourceAnchoredGridRankSourcePair state = + lengthPrefixedWord (List.replicate current true) ++ anchor := by + have hcontents : firstFieldContents + (lengthPrefixedWord (List.replicate current true)) = + List.replicate current true := by + simpa only [List.append_nil] using + firstFieldContents_valid (List.replicate current true) [] + simp [state, sourceAnchoredGridRankSourcePair, hcontents] + rw [hpair] + simpa [anchor, squareRootAnchor, List.append_assoc] using + finitePNthRootCandidate_valid a current target + (List.replicate target true) + have hfit : + (List.replicate + (finitePNthRootStep a target current) true).length ≤ + anchor.length := by + have hstep := finitePNthRootStep_le_target + a target current ha hcurrent + simp [anchor, squareRootAnchor, lengthPrefixedWord_length] + omega + have hselector : + sourceAnchoredGridCandidateSelector + (finitePNthRootCandidate a) state = true := by + rw [sourceAnchoredGridCandidateSelector_eq, hraw] + have hcontents : firstFieldContents state = anchor := by + simp [state] + rw [hcontents] + exact decide_eq_true hfit + have hguard : + sourceAnchoredGridGuardedCandidate + (finitePNthRootCandidate a) state = + List.replicate (finitePNthRootStep a target current) true := by + simp [sourceAnchoredGridGuardedCandidate, hselector, hraw] + have hrotation := sourceAnchoredGridRecordRotationOutput_records + (finitePNthRootCandidate a) anchor + (List.replicate current true) [] + simpa [state, anchor, hguard] using hrotation + +private theorem finitePNthRootRotation_iterate + (a target current stages : ℕ) (ha : 0 < a) + (hcurrent : current ≤ target) : + ((sourceAnchoredGridRecordRotationOutput + (finitePNthRootCandidate a))^[stages]) + (lengthPrefixedWord + (squareRootAnchor (List.replicate target true)) ++ + lengthPrefixedWord (List.replicate current true)) = + lengthPrefixedWord + (squareRootAnchor (List.replicate target true)) ++ + lengthPrefixedWord + (List.replicate + (((finitePNthRootStep a target)^[stages]) current) true) := by + induction stages generalizing current with + | zero => simp + | succ stages ih => + rw [Function.iterate_succ_apply, + finitePNthRootRotation_step a target current ha hcurrent, + ih (finitePNthRootStep a target current) + (finitePNthRootStep_le_target a target current ha hcurrent), + Function.iterate_succ_apply] + +private theorem finitePNthRoot_power_lt_iff + (a target current : ℕ) (ha : 0 < a) : + current ^ a < target ↔ + current < finitePCeilingRoot a target := by + constructor + · intro hpower + by_contra hnot + have hroot : finitePCeilingRoot a target ≤ current := + Nat.le_of_not_gt hnot + have hbound : target ≤ current ^ a := + (finitePCeilingRoot_spec a target ha).trans + (Nat.pow_le_pow_left hroot a) + exact (Nat.not_le_of_gt hpower) hbound + · intro hroot + by_contra hnot + have hbound : target ≤ current ^ a := Nat.le_of_not_gt hnot + have hminimum := finitePCeilingRoot_minimal + a target current ha hbound + exact (Nat.not_le_of_gt hroot) hminimum + +private theorem finitePNthRootStep_iterate + (a target stages : ℕ) (ha : 0 < a) : + ((finitePNthRootStep a target)^[stages]) 0 = + min stages (finitePCeilingRoot a target) := by + induction stages with + | zero => simp only [Function.iterate_zero, id_eq, zero_le, inf_of_le_left] + | succ stages ih => + rw [Function.iterate_succ_apply', ih] + by_cases hlt : stages < finitePCeilingRoot a target + · have hmin : + min stages (finitePCeilingRoot a target) = stages := + Nat.min_eq_left (Nat.le_of_lt hlt) + have hnext : + min (stages + 1) (finitePCeilingRoot a target) = + stages + 1 := + Nat.min_eq_left (by omega) + have hpower : stages ^ a < target := + (finitePNthRoot_power_lt_iff a target stages ha).mpr hlt + simp only [finitePNthRootStep, hmin, hpower, ↓reduceIte, hnext] + · have hle : finitePCeilingRoot a target ≤ stages := by + omega + have hmin : + min stages (finitePCeilingRoot a target) = + finitePCeilingRoot a target := + Nat.min_eq_right hle + have hnext : + min (stages + 1) (finitePCeilingRoot a target) = + finitePCeilingRoot a target := + Nat.min_eq_right (by omega) + have hpower : + ¬ finitePCeilingRoot a target ^ a < target := by + exact Nat.not_lt_of_ge + (finitePCeilingRoot_spec a target ha) + simp only [finitePNthRootStep, hmin, hpower, ↓reduceIte, hnext] + +private theorem finitePCeilingRoot_le_target + (a target : ℕ) (ha : 0 < a) : + finitePCeilingRoot a target ≤ target := + finitePCeilingRoot_minimal a target target ha + (Nat.le_self_pow ha.ne' target) + +private theorem finitePNthRootStep_iterate_target + (a target : ℕ) (ha : 0 < a) : + ((finitePNthRootStep a target)^[target]) 0 = + finitePCeilingRoot a target := by + rw [finitePNthRootStep_iterate a target target ha, + Nat.min_eq_right (finitePCeilingRoot_le_target a target ha)] + +/-- GapCVP reduction support. -/ +def finitePNthRootUnaryOutput + (a : ℕ) (target : List Bool → List Bool) + (input : List Bool) : List Bool := + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (finitePNthRootCandidate a)) + (squareRootFoldPreparation target input))) + +/-- GapCVP reduction support. -/ +noncomputable def finitePNthRootUnaryComputable + (a : ℕ) {target : List Bool → List Bool} + (computer : BitTM target) : + BitTM + (finitePNthRootUnaryOutput a target) := by + have hfold := GapCVP.TMComposition.computableInPolyTime + (squareRootFoldPreparationComputable computer) + (sourceAnchoredGridRecordFoldComputable + (finitePNthRootCandidateComputable a)) + have hsuffix := GapCVP.TMComposition.computableInPolyTime + hfold firstFieldSuffixComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hsuffix firstFieldContentsComputable + change BitTM + (fun input : List Bool => + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (finitePNthRootCandidate a)) + (squareRootFoldPreparation target input)))) + exact hphysical + +theorem finitePNthRootUnaryOutput_valid + (a : ℕ) (ha : 0 < a) + (target : List Bool → List Bool) + (input : List Bool) (value : ℕ) + (hvalue : target input = List.replicate value true) : + finitePNthRootUnaryOutput a target input = + List.replicate (finitePCeilingRoot a value) true := by + unfold finitePNthRootUnaryOutput squareRootFoldPreparation + rw [hvalue] + change + firstFieldContents + (firstFieldSuffix + (boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + (finitePNthRootCandidate a)) + (unaryBoundedFoldWord value + (lengthPrefixedWord + (squareRootAnchor (List.replicate value true)) ++ + lengthPrefixedWord [])))) = _ + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + change + firstFieldContents + (firstFieldSuffix + (((sourceAnchoredGridRecordRotationOutput + (finitePNthRootCandidate a))^[value]) + (lengthPrefixedWord + (squareRootAnchor (List.replicate value true)) ++ + lengthPrefixedWord (List.replicate 0 true)))) = _ + rw [finitePNthRootRotation_iterate + a value 0 value ha (Nat.zero_le _), + finitePNthRootStep_iterate_target a value ha, + firstFieldSuffix_valid] + simpa only [List.append_nil] using + firstFieldContents_valid + (List.replicate (finitePCeilingRoot a value) true) [] + +end Factor400FinitePRadiusSourceTM + +namespace Factor400FinitePRadiusRationalAtomTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceStructuralTuringTM +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputPolynomialCompositionClosure +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixUnaryQuotientRemainderTM GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFCappedUnaryPairArithmeticTM +open GapCVP.CNFUnaryPairIndexTM GapCVP.CNFUnaryPairIndexTotalRuntimeCert +open GapCVP.CLStructuralAtomicNaturalWriter + +private def computedUnaryDivisionQuery + (dividend modulus : List Bool → List Bool) + (input : List Bool) : List Bool := + dividend input ++ false :: (modulus input ++ false :: input) + +private noncomputable def computedUnaryDivisionQueryComputable + {dividend modulus : List Bool → List Bool} + (hdividend : BitTM dividend) + (hmodulus : BitTM modulus) : + BitTM + (computedUnaryDivisionQuery dividend modulus) := by + have hsource := GapCVP.TMComposition.computableInPolyTime + (Turing.idComputableInPolyTime bitEncoding) + (prependBitComputable false) + have hsecond := pointwiseAppendComputable hmodulus hsource + have hseparator := GapCVP.TMComposition.computableInPolyTime + hsecond (prependBitComputable false) + have hphysical := pointwiseAppendComputable + hdividend hseparator + change BitTM + (fun input : List Bool => + dividend input ++ false :: (modulus input ++ false :: input)) + simpa only [Function.comp_apply, id_eq] using hphysical + +private def computedUnaryDivisionOutput + (dividend modulus : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceUnaryDivisionOutput + (computedUnaryDivisionQuery dividend modulus input) + +private noncomputable def computedUnaryDivisionComputable + {dividend modulus : List Bool → List Bool} + (hdividend : BitTM dividend) + (hmodulus : BitTM modulus) : + BitTM + (computedUnaryDivisionOutput dividend modulus) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (computedUnaryDivisionQueryComputable hdividend hmodulus) + sourceUnaryDivisionComputable + change BitTM + (fun input : List Bool => sourceUnaryDivisionOutput + (computedUnaryDivisionQuery dividend modulus input)) + simpa only [Function.comp_def] using hphysical + +private theorem computedUnaryDivisionOutput_valid + (dividend modulus : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hfirst : dividend input = List.replicate first true) + (hsecond : modulus input = List.replicate second true) + (hpositive : 0 < second) : + computedUnaryDivisionOutput dividend modulus input = + List.replicate (first / second) true ++ + false :: (List.replicate (first % second) true ++ + false :: sourceUnaryDivisionQuery first second input) := by + unfold computedUnaryDivisionOutput computedUnaryDivisionQuery + rw [hfirst, hsecond] + exact sourceUnaryDivisionOutput_valid first second input hpositive + +private def computedUnaryQuotient + (dividend modulus : List Bool → List Bool) + (input : List Bool) : List Bool := + (unaryPrefixOutput + (computedUnaryDivisionOutput dividend modulus input)).tail + +private noncomputable def computedUnaryQuotientComputable + {dividend modulus : List Bool → List Bool} + (hdividend : BitTM dividend) + (hmodulus : BitTM modulus) : + BitTM + (computedUnaryQuotient dividend modulus) := by + have hscan := GapCVP.TMComposition.computableInPolyTime + (computedUnaryDivisionComputable hdividend hmodulus) + unaryPrefixComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hscan dropHeadComputable + change BitTM + (fun input : List Bool => + (unaryPrefixOutput + (computedUnaryDivisionOutput dividend modulus input)).tail) + simpa only [Function.comp_def] using hphysical + +private theorem computedUnaryQuotient_valid + (dividend modulus : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hfirst : dividend input = List.replicate first true) + (hsecond : modulus input = List.replicate second true) + (hpositive : 0 < second) : + computedUnaryQuotient dividend modulus input = + List.replicate (first / second) true := by + unfold computedUnaryQuotient + rw [computedUnaryDivisionOutput_valid + dividend modulus input first second hfirst hsecond hpositive] + rw [unaryPrefixOutput_replicate_delimiter] + rfl + +private def computedUnaryRemainder + (dividend modulus : List Bool → List Bool) + (input : List Bool) : List Bool := + (unaryPrefixOutput + (unaryPrefixSuffixOutput + (computedUnaryDivisionOutput dividend modulus input))).tail + +private noncomputable def computedUnaryRemainderComputable + {dividend modulus : List Bool → List Bool} + (hdividend : BitTM dividend) + (hmodulus : BitTM modulus) : + BitTM + (computedUnaryRemainder dividend modulus) := by + have hsuffix := GapCVP.TMComposition.computableInPolyTime + (computedUnaryDivisionComputable hdividend hmodulus) + actualUnaryPrefixSuffixComputable + have hscan := GapCVP.TMComposition.computableInPolyTime + hsuffix unaryPrefixComputable + have hphysical := GapCVP.TMComposition.computableInPolyTime + hscan dropHeadComputable + change BitTM + (fun input : List Bool => + (unaryPrefixOutput + (unaryPrefixSuffixOutput + (computedUnaryDivisionOutput dividend modulus input))).tail) + simpa only [Function.comp_def] using hphysical + +private theorem computedUnaryRemainder_valid + (dividend modulus : List Bool → List Bool) + (input : List Bool) (first second : ℕ) + (hfirst : dividend input = List.replicate first true) + (hsecond : modulus input = List.replicate second true) + (hpositive : 0 < second) : + computedUnaryRemainder dividend modulus input = + List.replicate (first % second) true := by + unfold computedUnaryRemainder + rw [computedUnaryDivisionOutput_valid + dividend modulus input first second hfirst hsecond hpositive] + rw [unaryPrefixSuffixOutput_valid, + unaryPrefixOutput_replicate_delimiter] + rfl + +private def fixedUnaryLessMarker + (operand : List Bool → List Bool) + (cutoff : ℕ) (input : List Bool) : List Bool := + fourFamilyComputedUnaryLessBitOutput operand + (fun _ : List Bool => List.replicate cutoff true) input + +private noncomputable def fixedUnaryLessMarkerComputable + {operand : List Bool → List Bool} + (computer : BitTM operand) + (cutoff : ℕ) : + BitTM + (fixedUnaryLessMarker operand cutoff) := by + exact fourFamilyComputedUnaryLessBitComputable + computer (sourceFixedWordComputable (List.replicate cutoff true)) + +private def fixedUnaryLessBit + (operand : List Bool → List Bool) + (cutoff : ℕ) (input : List Bool) : Bool := + (fixedUnaryLessMarker operand cutoff input).headD false + +private theorem fixedUnaryLessMarker_eq + (operand : List Bool → List Bool) + (cutoff : ℕ) (input : List Bool) : + fixedUnaryLessMarker operand cutoff input = + [fixedUnaryLessBit operand cutoff input] := by + have hlength := fourFamilyComputedUnaryLessBitOutput_length + operand (fun _ : List Bool => List.replicate cutoff true) input + change (fixedUnaryLessMarker operand cutoff input).length = 1 + at hlength + cases hword : fixedUnaryLessMarker operand cutoff input with + | nil => simp only [hword, List.length_nil, zero_ne_one] at hlength + | cons bit remaining => + cases remaining with + | nil => simp only [fixedUnaryLessBit, hword, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] + | cons next tail => simp only [hword, List.length_cons, Nat.add_eq_right, + Nat.add_eq_zero_iff, List.length_eq_zero_iff, + one_ne_zero, and_false] at hlength + +private theorem fixedUnaryLessBit_valid + (operand : List Bool → List Bool) + (cutoff : ℕ) (input : List Bool) (value : ℕ) + (hvalue : operand input = List.replicate value true) : + fixedUnaryLessBit operand cutoff input = + decide (value < cutoff) := by + have hmarker := fourFamilyComputedUnaryLessBitOutput_valid + operand (fun _ : List Bool => List.replicate cutoff true) + input value cutoff hvalue rfl + simpa only [fixedUnaryLessBit, fixedUnaryLessMarker, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some] using congrArg (fun word : List Bool => word.headD false) hmarker + +@[irreducible] private noncomputable def fixedUnaryLessSelectionComputable + {operand : List Bool → List Bool} + (computer : BitTM operand) + (cutoff : ℕ) : + BitTM + (fun input : List Bool => + fixedUnaryLessBit operand cutoff input :: input) := by + have hphysical := pointwiseAppendComputable + (fixedUnaryLessMarkerComputable computer cutoff) + (Turing.idComputableInPolyTime bitEncoding) + have heq : + (fun input : List Bool => + fixedUnaryLessMarker operand cutoff input ++ input) = + (fun input : List Bool => + fixedUnaryLessBit operand cutoff input :: input) := by + funext input + simp only [fixedUnaryLessMarker_eq, List.cons_append, List.nil_append] + change BitTM + (fun input : List Bool => + fixedUnaryLessMarker operand cutoff input ++ input) at hphysical + rwa [heq] at hphysical + +private def fixedGcdLookup + (modulus : ℕ) (residue : List Bool → List Bool) : + ℕ → List Bool → List Bool + | 0 => fun _ => List.replicate (Nat.gcd 0 modulus) true + | stages + 1 => fun input => + if fixedUnaryLessBit residue stages.succ input then + fixedGcdLookup modulus residue stages input + else + List.replicate (Nat.gcd stages.succ modulus) true + +@[irreducible] private noncomputable def fixedGcdLookupSuccComputable + (modulus : ℕ) {residue : List Bool → List Bool} + (computer : BitTM residue) + (stages : ℕ) + (previous : BitTM + (fixedGcdLookup modulus residue stages)) : + BitTM + (fixedGcdLookup modulus residue stages.succ) := + sourcePreservingConditionalComputable + (selector := fixedUnaryLessBit residue stages.succ) + (valid := fixedGcdLookup modulus residue stages) + (fixedUnaryLessSelectionComputable + (operand := residue) computer stages.succ) + previous (List.replicate (Nat.gcd stages.succ modulus) true) + +@[irreducible] private noncomputable def fixedGcdLookupComputable + (modulus : ℕ) {residue : List Bool → List Bool} + (computer : BitTM residue) + (stages : ℕ) : + BitTM + (fixedGcdLookup modulus residue stages) := + match stages with + | 0 => sourceFixedWordComputable + (List.replicate (Nat.gcd 0 modulus) true) + | stages + 1 => fixedGcdLookupSuccComputable + modulus computer stages + (fixedGcdLookupComputable + (residue := residue) modulus computer stages) + +private theorem fixedGcdLookup_valid + (modulus : ℕ) (residue : List Bool → List Bool) + (input : List Bool) (value stages : ℕ) + (hvalue : residue input = List.replicate value true) + (hbound : value ≤ stages) : + fixedGcdLookup modulus residue stages input = + List.replicate (Nat.gcd value modulus) true := by + induction stages generalizing value with + | zero => + have hzero : value = 0 := Nat.eq_zero_of_le_zero hbound + subst value + rfl + | succ stages ih => + have hbit := fixedUnaryLessBit_valid + residue (stages + 1) input value hvalue + by_cases hlt : value < stages + 1 + · have hle : value ≤ stages := by omega + simpa only [fixedGcdLookup, Nat.succ_eq_add_one, hbit, hlt, decide_true, ↓reduceIte] + using ih value hvalue hle + · have heq : value = stages + 1 := by omega + subst value + simp only [fixedGcdLookup, Nat.succ_eq_add_one, hbit, lt_self_iff_false, decide_false, + Bool.false_eq_true, + ↓reduceIte] + +private def constantScaleUnary (scale : ℕ) : List Bool → List Bool := + fun _ => List.replicate scale true + +private noncomputable def constantScaleUnaryComputable (scale : ℕ) : + BitTM + (constantScaleUnary scale) := + sourceFixedWordComputable (List.replicate scale true) + +private def sourceReducedGcdUnary + (scale : ℕ) (numerator : List Bool → List Bool) : + List Bool → List Bool := + fixedGcdLookup scale + (computedUnaryRemainder numerator (constantScaleUnary scale)) + scale + +private noncomputable def sourceReducedGcdUnaryComputable + (scale : ℕ) {numerator : List Bool → List Bool} + (computer : BitTM numerator) : + BitTM + (sourceReducedGcdUnary scale numerator) := by + exact fixedGcdLookupComputable scale + (computedUnaryRemainderComputable + computer (constantScaleUnaryComputable scale)) scale + +private theorem sourceReducedGcdUnary_valid + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) (value : ℕ) + (hscale : 0 < scale) + (hvalue : numerator input = List.replicate value true) : + sourceReducedGcdUnary scale numerator input = + List.replicate (Nat.gcd value scale) true := by + have hremainder := computedUnaryRemainder_valid + numerator (constantScaleUnary scale) input value scale + hvalue rfl hscale + have hbound : value % scale ≤ scale := + (Nat.mod_lt value hscale).le + have hgcd := fixedGcdLookup_valid scale + (computedUnaryRemainder numerator (constantScaleUnary scale)) + input (value % scale) scale hremainder hbound + have heq : Nat.gcd (value % scale) scale = + Nat.gcd value scale := by + calc + Nat.gcd (value % scale) scale = Nat.gcd scale value := + (Nat.gcd_rec scale value).symm + _ = Nat.gcd value scale := Nat.gcd_comm scale value + simpa only [sourceReducedGcdUnary, heq] using hgcd + +private def sourceReducedNumeratorUnary + (scale : ℕ) (numerator : List Bool → List Bool) : + List Bool → List Bool := + computedUnaryQuotient numerator + (sourceReducedGcdUnary scale numerator) + +private noncomputable def sourceReducedNumeratorUnaryComputable + (scale : ℕ) {numerator : List Bool → List Bool} + (computer : BitTM numerator) : + BitTM + (sourceReducedNumeratorUnary scale numerator) := + computedUnaryQuotientComputable computer + (sourceReducedGcdUnaryComputable scale computer) + +private theorem sourceReducedNumeratorUnary_valid + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) (value : ℕ) + (hscale : 0 < scale) + (hvalue : numerator input = List.replicate value true) : + sourceReducedNumeratorUnary scale numerator input = + List.replicate (value / Nat.gcd value scale) true := by + exact computedUnaryQuotient_valid numerator + (sourceReducedGcdUnary scale numerator) input + value (Nat.gcd value scale) hvalue + (sourceReducedGcdUnary_valid scale numerator input + value hscale hvalue) + (Nat.gcd_pos_of_pos_right value hscale) + +private def sourceReducedDenominatorUnary + (scale : ℕ) (numerator : List Bool → List Bool) : + List Bool → List Bool := + computedUnaryQuotient (constantScaleUnary scale) + (sourceReducedGcdUnary scale numerator) + +private noncomputable def sourceReducedDenominatorUnaryComputable + (scale : ℕ) {numerator : List Bool → List Bool} + (computer : BitTM numerator) : + BitTM + (sourceReducedDenominatorUnary scale numerator) := + computedUnaryQuotientComputable + (constantScaleUnaryComputable scale) + (sourceReducedGcdUnaryComputable scale computer) + +private theorem sourceReducedDenominatorUnary_valid + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) (value : ℕ) + (hscale : 0 < scale) + (hvalue : numerator input = List.replicate value true) : + sourceReducedDenominatorUnary scale numerator input = + List.replicate (scale / Nat.gcd value scale) true := by + exact computedUnaryQuotient_valid + (constantScaleUnary scale) + (sourceReducedGcdUnary scale numerator) input + scale (Nat.gcd value scale) rfl + (sourceReducedGcdUnary_valid scale numerator input + value hscale hvalue) + (Nat.gcd_pos_of_pos_right value hscale) + +private def sourceReducedSignedNumeratorUnary + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) : List Bool := + List.replicate + (2 * (sourceReducedNumeratorUnary scale numerator input).length) + true + +private noncomputable def sourceReducedSignedNumeratorUnaryComputable + (scale : ℕ) {numerator : List Bool → List Bool} + (computer : BitTM numerator) : + BitTM + (sourceReducedSignedNumeratorUnary scale numerator) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (sourceReducedNumeratorUnaryComputable scale computer) + (polynomialValueUnaryComputable + (Polynomial.C 2 * Polynomial.X)) + change BitTM + (fun input : List Bool => List.replicate + (2 * (sourceReducedNumeratorUnary scale numerator input).length) + true) + simpa only [eq_natCast, Nat.cast_ofNat, Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_X, + Function.comp_def] using hphysical + +private theorem sourceReducedSignedNumeratorUnary_valid + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) (value : ℕ) + (hscale : 0 < scale) + (hvalue : numerator input = List.replicate value true) : + sourceReducedSignedNumeratorUnary scale numerator input = + List.replicate (2 * (value / Nat.gcd value scale)) true := by + unfold sourceReducedSignedNumeratorUnary + rw [sourceReducedNumeratorUnary_valid + scale numerator input value hscale hvalue] + simp only [List.length_replicate] + +private def sourceReducedRationalPairWord + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) : List Bool := + sourceReducedSignedNumeratorUnary scale numerator input ++ + false :: (sourceReducedDenominatorUnary scale numerator input ++ + [false]) + +private noncomputable def sourceReducedRationalPairWordComputable + (scale : ℕ) {numerator : List Bool → List Bool} + (computer : BitTM numerator) : + BitTM + (sourceReducedRationalPairWord scale numerator) := by + have hsecond := pointwiseAppendComputable + (sourceReducedDenominatorUnaryComputable scale computer) + (sourceFixedWordComputable [false]) + have hdelimiter := GapCVP.TMComposition.computableInPolyTime + hsecond (prependBitComputable false) + have hphysical := pointwiseAppendComputable + (sourceReducedSignedNumeratorUnaryComputable scale computer) + hdelimiter + change BitTM + (fun input : List Bool => + sourceReducedSignedNumeratorUnary scale numerator input ++ + false :: + (sourceReducedDenominatorUnary scale numerator input ++ + [false])) + simpa only [Function.comp_apply] using hphysical + +private def sourceReducedRationalCodeUnary + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) : List Bool := + unarySourcePairOutput + (sourceReducedRationalPairWord scale numerator input) + +private noncomputable def sourceReducedRationalCodeUnaryComputable + (scale : ℕ) {numerator : List Bool → List Bool} + (computer : BitTM numerator) : + BitTM + (sourceReducedRationalCodeUnary scale numerator) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (sourceReducedRationalPairWordComputable scale computer) + actualUnaryPairIndexComputable + change BitTM + (fun input : List Bool => unarySourcePairOutput + (sourceReducedRationalPairWord scale numerator input)) + simpa only [Function.comp_def] using hphysical + +private theorem sourceReducedRationalCodeUnary_valid + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) (value : ℕ) + (hscale : 0 < scale) + (hvalue : numerator input = List.replicate value true) : + sourceReducedRationalCodeUnary scale numerator input = + List.replicate + (Nat.pair (2 * (value / Nat.gcd value scale)) + (scale / Nat.gcd value scale)) true := by + unfold sourceReducedRationalCodeUnary + sourceReducedRationalPairWord + rw [sourceReducedSignedNumeratorUnary_valid + scale numerator input value hscale hvalue] + rw [sourceReducedDenominatorUnary_valid + scale numerator input value hscale hvalue] + exact unarySourcePairOutput_word + (2 * (value / Nat.gcd value scale)) + (scale / Nat.gcd value scale) + +private theorem nonnegativeRational_encode_pair + (numerator denominator : ℕ) + (hdenominator : 0 < denominator) : + Encodable.encode + ((numerator : ℚ) / (denominator : ℚ)) = + Nat.pair + (2 * (numerator / Nat.gcd numerator denominator)) + (denominator / Nat.gcd numerator denominator) := by + rw [Rat.natCast_div_eq_divInt, Rat.divInt_ofNat] + change Nat.pair + (Encodable.encode + (mkRat (Int.ofNat numerator) denominator).num) + (mkRat (Int.ofNat numerator) denominator).den = _ + rw [Rat.num_mkRat, Rat.den_mkRat] + simp only [hdenominator.ne', ↓reduceIte] + change Nat.pair + (2 * (numerator / Nat.gcd denominator numerator)) + (denominator / Nat.gcd denominator numerator) = _ + rw [Nat.gcd_comm denominator numerator] + +/-- GapCVP reduction support. -/ +def sourceReducedRationalAtomicOutput + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) : List Bool := + structuralAtomicNaturalWord + (sourceReducedRationalCodeUnary scale numerator input) + +/-- GapCVP reduction support. -/ +noncomputable def sourceReducedRationalAtomicComputable + (scale : ℕ) {numerator : List Bool → List Bool} + (computer : BitTM numerator) : + BitTM + (sourceReducedRationalAtomicOutput scale numerator) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + (sourceReducedRationalCodeUnaryComputable scale computer) + structuralAtomicNaturalWriterComputable + change BitTM + (fun input : List Bool => structuralAtomicNaturalWord + (sourceReducedRationalCodeUnary scale numerator input)) + simpa only [Function.comp_def] using hphysical + +theorem sourceReducedRationalAtomicOutput_valid + (scale : ℕ) (numerator : List Bool → List Bool) + (input : List Bool) (value : ℕ) + (hscale : 0 < scale) + (hvalue : numerator input = List.replicate value true) : + sourceReducedRationalAtomicOutput scale numerator input = + encodeAtomic ((value : ℚ) / (scale : ℚ)) := by + unfold sourceReducedRationalAtomicOutput + rw [sourceReducedRationalCodeUnary_valid + scale numerator input value hscale hvalue] + rw [structuralAtomicNaturalWord_eq_prefix] + simp only [List.length_replicate, encodeAtomic, nonnegativeRational_encode_pair value scale + hscale] + +end Factor400FinitePRadiusRationalAtomTM + +namespace Factor400BinaryCompactPhysicalGaussianOutputSerializerTM + +open Turing GapCVP.BinaryEncoding GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryStructuralRecordTM +open GapCVP.BinaryGaussianStructuralAtomTM GapCVP.GaussianPhysicalWordRankIndexTM +open GapCVP.GaussianPackedStateTargetAtomTM GapCVP.SourceWholeOutputAssemblyTM + +/-- GapCVP reduction support. -/ +def compactPhysicalGaussianRankReducedState + (reduced : List Bool → List Bool) : List Bool → List Bool := + reduced ∘ structuralRankOriginalSource + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalGaussianRankReducedStateComputable + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (compactPhysicalGaussianRankReducedState reduced) := + GapCVP.TMComposition.computableInPolyTime + structuralRankOriginalSourceComputable computer + +/-- GapCVP reduction support. -/ +def compactPhysicalGaussianRankTargetStateQuery + (reduced : List Bool → List Bool) + (input : List Bool) : List Bool := + lengthPrefixedWord + (factor400PhysicalWordGaussianTargetCoordinateUnary input) ++ + compactPhysicalGaussianRankReducedState reduced input + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalGaussianRankTargetStateQueryComputable + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (compactPhysicalGaussianRankTargetStateQuery reduced) := by + have hindex := GapCVP.TMComposition.computableInPolyTime + factor400PhysicalWordGaussianTargetCoordinateComputable + structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hindex + (compactPhysicalGaussianRankReducedStateComputable computer) + change BitTM + (fun input => + lengthPrefixedWord + (factor400PhysicalWordGaussianTargetCoordinateUnary input) ++ + compactPhysicalGaussianRankReducedState reduced input) + simpa only [Function.comp_apply] using hphysical + +/-- GapCVP reduction support. -/ +def compactPhysicalGaussianRankTargetAtom + (reduced : List Bool → List Bool) : List Bool → List Bool := + gaussianPackedIndexedTargetAtom ∘ + compactPhysicalGaussianRankTargetStateQuery reduced + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalGaussianRankTargetAtomComputable + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (compactPhysicalGaussianRankTargetAtom reduced) := + GapCVP.TMComposition.computableInPolyTime + (compactPhysicalGaussianRankTargetStateQueryComputable computer) + gaussianPackedIndexedTargetAtomComputable + +/-- GapCVP reduction support. -/ +def compactPhysicalGaussianRankRadiusAtom + (radius : List Bool → List Bool) : List Bool → List Bool := + radius ∘ structuralRankOriginalSource + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalGaussianRankRadiusAtomComputable + {radius : List Bool → List Bool} + (computer : BitTM radius) : + BitTM + (compactPhysicalGaussianRankRadiusAtom radius) := + GapCVP.TMComposition.computableInPolyTime + structuralRankOriginalSourceComputable computer + +/-- GapCVP reduction support. -/ +def compactPhysicalGaussianStructuralAtomComputerPack + (output : List Bool → List Bool) + (computer : BitTM output) : + ConstructiveStructuralAtomComputer where + output := output + computer := computer + +@[simp] theorem compactPhysicalGaussianStructuralAtomComputerPack_output + (output : List Bool → List Bool) + (computer : BitTM output) + (input : List Bool) : + (compactPhysicalGaussianStructuralAtomComputerPack + output computer).output input = output input := by + rfl + +end Factor400BinaryCompactPhysicalGaussianOutputSerializerTM + +namespace OriginalThreeSATNPHardness + +open Computability GapCVP.BinaryEncoding GapCVP.ThreeCNFReduction +open GapCVP.CLStructuralWholeCNFOutputTM GapCVP.CNFFiveFamilySourceIndexedORGadgetFinalCert + +/-- GapCVP reduction support. -/ +noncomputable def paperOriginalThreeSATLanguage (bits : List Bool) : Bool := + @decide + (∃ formula : ThreeCNF, + encodeThreeCNF formula = bits ∧ + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) + (Classical.propDecidable _) + +theorem paperOriginalThreeSATLanguage_iff (bits : List Bool) : + paperOriginalThreeSATLanguage bits ↔ + ∃ formula : ThreeCNF, + encodeThreeCNF formula = bits ∧ + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + simp only [GapCVP.OriginalThreeSATNPHardness.paperOriginalThreeSATLanguage, decide_eq_true_eq] + +private theorem paperOriginalThreeSATLanguage_encode_iff (formula : ThreeCNF) : + paperOriginalThreeSATLanguage (encodeThreeCNF formula) ↔ + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + rw [paperOriginalThreeSATLanguage_iff] + constructor + · rintro ⟨candidate, encoding, assignment, satisfied⟩ + have sameEncoding := congrArg decodeThreeCNF encoding + have sameFormula : candidate = formula := by + simpa only [decodeThreeCNF_encode, Option.some.injEq] + using sameEncoding + subst candidate + exact ⟨assignment, satisfied⟩ + · rintro ⟨assignment, satisfied⟩ + exact ⟨formula, rfl, assignment, satisfied⟩ + +private theorem paperOriginalThreeSATLanguage_encode_iff_threeSAT + (formula : ThreeCNF) + (distinct : allDistinct formula) : + paperOriginalThreeSATLanguage (encodeThreeCNF formula) ↔ + threeSATLanguage (encodeThreeCNF formula) := by + simp only [GapCVP.ThreeCNFReduction.allDistinct, decide_eq_true_eq] at distinct + rw [paperOriginalThreeSATLanguage_encode_iff] + change + (∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) ↔ + threeSATLanguage ((binaryFinEncoding ThreeCNF).encode formula) + rw [GapCVP.CLVerifier.threeSATLanguage_encode_iff] + simp only [GapCVP.threeCNFSatisfiable, decide_eq_true_eq] + exact ⟨fun satisfaction => ⟨distinct, satisfaction⟩, + fun satisfaction => satisfaction.2⟩ + +private theorem structuralWholeCNFWord_mem_paperOriginalThreeSAT_iff + (bound : Polynomial ℕ) + {verifier : List Bool × List Bool → Bool} + (machine : VerifierTM verifier) + (input : List Bool) : + paperOriginalThreeSATLanguage + (structuralWholeCNFWord bound machine input) ↔ + ∃ certificate : List Bool, + certificate.length ≤ bound.eval input.length ∧ + verifier (input, certificate) = true := by + exact + (paperOriginalThreeSATLanguage_encode_iff_threeSAT + (structuralWholeThreeCNF bound machine input) + (structuralWholeThreeCNF_allDistinct bound machine input)).trans + (structuralWholeCNFWord_mem_threeSAT_iff bound machine input) + +theorem paperOriginalThreeSATIsNPHard : + NPHard paperOriginalThreeSATLanguage := by + simp only [GapCVP.NPHard, decide_eq_true_eq] + intro language membership + simp only [GapCVP.IsNP, decide_eq_true_eq] at membership + obtain ⟨bound, verifier, ⟨machine⟩, correctness⟩ := membership + refine ⟨{ + map := structuralWholeCNFWord bound machine + polynomial_time := + ⟨actualWholeStructuralCNFOutputComputable bound machine⟩ + correct := ?_ + }⟩ + intro input + exact (correctness input).trans + (structuralWholeCNFWord_mem_paperOriginalThreeSAT_iff + bound machine input).symm + +end OriginalThreeSATNPHardness + +namespace BinarySourceTautologyNormalizationExact + +/-- GapCVP reduction support. -/ +def sourceClauseIsTautology (clause : ThreeClause) : Bool := + decide (∃ left right : Fin 3, + (clause left).1 = (clause right).1 ∧ + (clause left).2 ≠ (clause right).2) + +theorem sourceClauseIsTautology_iff + (clause : ThreeClause) : + sourceClauseIsTautology clause = true ↔ + ∃ left right : Fin 3, + (clause left).1 = (clause right).1 ∧ + (clause left).2 ≠ (clause right).2 := by + simp only [sourceClauseIsTautology, ne_eq, decide_eq_true_eq] + +private theorem sourceClauseIsTautology_satisfied + (assignment : ℕ → Bool) (clause : ThreeClause) + (htautology : sourceClauseIsTautology clause = true) : + clauseSatisfied assignment clause := by + simp only [GapCVP.clauseSatisfied, GapCVP.literalSatisfied, decide_eq_true_eq] at * + obtain ⟨left, right, hname, hsign⟩ := + (sourceClauseIsTautology_iff clause).mp htautology + by_cases hleft : assignment (clause left).1 = (clause left).2 + · exact ⟨left, hleft⟩ + · refine ⟨right, ?_⟩ + rw [← hname] + cases hvalue : assignment (clause left).1 <;> + cases hleftSign : (clause left).2 <;> + cases hrightSign : (clause right).2 <;> + simp_all + +/-- GapCVP reduction support. -/ +def noTautClauses (formula : ThreeCNF) : ThreeCNF := + formula.filter fun clause => !(sourceClauseIsTautology clause) + +theorem mem_sourceClausesWithoutTautologies + (formula : ThreeCNF) (clause : ThreeClause) : + clause ∈ noTautClauses formula ↔ + clause ∈ formula ∧ sourceClauseIsTautology clause = false := by + simp only [noTautClauses, List.mem_filter, Bool.not_eq_eq_eq_not, Bool.not_true] + +private theorem sourceClausesWithoutTautologies_satisfied_iff + (formula : ThreeCNF) (assignment : ℕ → Bool) : + (∀ clause ∈ noTautClauses formula, + clauseSatisfied assignment clause) ↔ + (∀ clause ∈ formula, clauseSatisfied assignment clause) := by + constructor + · intro hremaining clause hclause + cases htautology : sourceClauseIsTautology clause with + | false => + exact hremaining clause + ((mem_sourceClausesWithoutTautologies formula clause).mpr + ⟨hclause, htautology⟩) + | true => + exact sourceClauseIsTautology_satisfied + assignment clause htautology + · intro hall clause hclause + exact hall clause + ((mem_sourceClausesWithoutTautologies formula clause).mp + hclause).1 + +end BinarySourceTautologyNormalizationExact + +namespace SourcePreprocessingSemantics + +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.BinarySourceVariableCompaction + +/-- GapCVP reduction support. -/ +def paperSourceClauseLiterals (clause : ThreeClause) : List Literal := + [clause 0, clause 1, clause 2] + +/-- GapCVP reduction support. -/ +def paperSourceNormalizedClause (clause : ThreeClause) : List Literal := + (paperSourceClauseLiterals clause).eraseDups + +/-- GapCVP reduction support. -/ +def paperSourceNormalizedClauses (formula : ThreeCNF) : + List (List Literal) := + (noTautClauses formula).map + paperSourceNormalizedClause + +/-- GapCVP reduction support. -/ +def paperSourceNormalizedClauseRecord (clause : ThreeClause) : List Bool := + List.replicate (paperSourceNormalizedClause clause).length true ++ + false :: (paperSourceNormalizedClause clause).flatMap encodeLiteral + +/-- GapCVP reduction support. -/ +def paperSourceNormalizedClauseStream (formula : ThreeCNF) : List Bool := + (noTautClauses formula).flatMap + paperSourceNormalizedClauseRecord + +/-- GapCVP reduction support. -/ +def paperSourceNormalizedVariables (formula : ThreeCNF) : List ℕ := + (paperSourceNormalizedClauses formula).flatMap + (fun clause => clause.map Prod.fst) + +/-- GapCVP reduction support. -/ +def paperNormalizedOccurringVariables (formula : ThreeCNF) : List ℕ := + (paperSourceNormalizedVariables formula).eraseDups + +private theorem paperSourceLiteralEraseDups_length_le + (literals : List Literal) : + literals.eraseDups.length ≤ literals.length := by + induction literals using + (measure fun values : List Literal => values.length).wf.induction with + | h literals induction => + cases literals with + | nil => simp only [List.eraseDups_nil, List.length_nil, Std.le_refl] + | cons literal remaining => + rw [List.eraseDups_cons] + simp only [List.length_cons] + apply Nat.succ_le_succ + exact Nat.le_trans + (induction + (remaining.filter fun candidate => !(candidate == literal)) + (Nat.lt_succ_of_le (List.length_filter_le _ _))) + (List.length_filter_le _ remaining) + +private theorem paperSourceLiteralEraseDups_nodup + (literals : List Literal) : + literals.eraseDups.Nodup := by + induction literals using + (measure fun values : List Literal => values.length).wf.induction with + | h literals induction => + cases literals with + | nil => simp only [List.eraseDups_nil, List.nodup_nil] + | cons literal remaining => + rw [List.eraseDups_cons, List.nodup_cons] + constructor + · simp only [List.mem_eraseDups, List.mem_filter, BEq.rfl, Bool.not_true, + Bool.false_eq_true, and_false, + not_false_eq_true] + · exact induction + (remaining.filter fun candidate => !(candidate == literal)) + (Nat.lt_succ_of_le (List.length_filter_le _ _)) + +theorem paperNormalizedClause_length_le_three + (clause : ThreeClause) : + (paperSourceNormalizedClause clause).length ≤ 3 := by + simpa only [paperSourceNormalizedClause, paperSourceClauseLiterals, Fin.isValue, + List.length_cons, + List.length_nil, zero_add, Nat.reduceAdd] using + paperSourceLiteralEraseDups_length_le (paperSourceClauseLiterals clause) + +theorem paperSourceNormalizedClause_ne_nil + (clause : ThreeClause) : + paperSourceNormalizedClause clause ≠ [] := by + intro hempty + have hfirst : clause 0 ∈ paperSourceNormalizedClause clause := by + simp only [paperSourceNormalizedClause, paperSourceClauseLiterals, Fin.isValue, + List.mem_eraseDups, + List.mem_cons, List.not_mem_nil, or_false, true_or] + simp only [hempty, Fin.isValue, List.not_mem_nil] at hfirst + +theorem paperSourceNormalizedClause_nodup + (clause : ThreeClause) : + (paperSourceNormalizedClause clause).Nodup := by + exact paperSourceLiteralEraseDups_nodup + (paperSourceClauseLiterals clause) + +theorem mem_paperSourceNormalizedClause_iff + (clause : ThreeClause) (literal : Literal) : + literal ∈ paperSourceNormalizedClause clause ↔ + ∃ index : Fin 3, clause index = literal := by + simp only [paperSourceNormalizedClause, paperSourceClauseLiterals, Fin.isValue, + List.mem_eraseDups, + List.mem_cons, List.not_mem_nil, or_false, eq_comm, Fin.exists_fin_succ, + Fin.succ_zero_eq_one, Fin.succ_one_eq_two, + IsEmpty.exists_iff] + +private theorem paperSourceNormalizedClause_satisfied_iff + (assignment : ℕ → Bool) (clause : ThreeClause) : + (∃ literal ∈ paperSourceNormalizedClause clause, + literalSatisfied assignment literal) ↔ + clauseSatisfied assignment clause := by + simp only [paperSourceNormalizedClause, paperSourceClauseLiterals, Fin.isValue, + List.mem_eraseDups, + List.mem_cons, List.not_mem_nil, or_false, literalSatisfied, decide_eq_true_eq, + exists_eq_or_imp, ↓existsAndEq, + true_and, clauseSatisfied, Fin.exists_fin_succ, Fin.succ_zero_eq_one, Fin.succ_one_eq_two, + IsEmpty.exists_iff, + Bool.decide_or, Bool.or_eq_true] + +theorem mem_paperSourceNormalizedClauses_iff + (formula : ThreeCNF) (normalized : List Literal) : + normalized ∈ paperSourceNormalizedClauses formula ↔ + ∃ clause ∈ noTautClauses formula, + paperSourceNormalizedClause clause = normalized := by + simp only [paperSourceNormalizedClauses, List.mem_map] + +theorem paperSourceNormalizedClauses_satisfied_iff + (formula : ThreeCNF) (assignment : ℕ → Bool) : + (∀ clause ∈ paperSourceNormalizedClauses formula, + ∃ literal ∈ clause, literalSatisfied assignment literal) ↔ + (∀ clause ∈ formula, clauseSatisfied assignment clause) := by + constructor + · intro hnormalized + apply (sourceClausesWithoutTautologies_satisfied_iff + formula assignment).mp + intro clause hretained + apply (paperSourceNormalizedClause_satisfied_iff + assignment clause).mp + apply hnormalized + exact (mem_paperSourceNormalizedClauses_iff + formula (paperSourceNormalizedClause clause)).mpr + ⟨clause, hretained, rfl⟩ + · intro horiginal normalized hnormalized + obtain ⟨clause, hretained, rfl⟩ := + (mem_paperSourceNormalizedClauses_iff + formula normalized).mp hnormalized + apply (paperSourceNormalizedClause_satisfied_iff + assignment clause).mpr + exact (sourceClausesWithoutTautologies_satisfied_iff + formula assignment).mpr horiginal clause hretained + +private theorem mem_paperSourceNormalizedVariables_iff + (formula : ThreeCNF) (name : ℕ) : + name ∈ paperSourceNormalizedVariables formula ↔ + ∃ clause ∈ noTautClauses formula, + ∃ index : Fin 3, (clause index).1 = name := by + constructor + · intro hname + obtain ⟨normalized, hnormalized, hmember⟩ := + List.mem_flatMap.mp hname + obtain ⟨clause, hclause, rfl⟩ := + (mem_paperSourceNormalizedClauses_iff + formula normalized).mp hnormalized + obtain ⟨literal, hliteral, rfl⟩ := List.mem_map.mp hmember + obtain ⟨index, hindex⟩ := + (mem_paperSourceNormalizedClause_iff clause literal).mp hliteral + exact ⟨clause, hclause, index, congrArg Prod.fst hindex⟩ + · rintro ⟨clause, hclause, index, hindex⟩ + apply List.mem_flatMap.mpr + refine ⟨paperSourceNormalizedClause clause, + (mem_paperSourceNormalizedClauses_iff + formula (paperSourceNormalizedClause clause)).mpr + ⟨clause, hclause, rfl⟩, ?_⟩ + exact List.mem_map.mpr + ⟨clause index, + (mem_paperSourceNormalizedClause_iff + clause (clause index)).mpr ⟨index, rfl⟩, + hindex⟩ + +theorem mem_paperSourceNormalizedOccurringVariables_iff + (formula : ThreeCNF) (name : ℕ) : + name ∈ paperNormalizedOccurringVariables formula ↔ + ∃ clause ∈ noTautClauses formula, + ∃ index : Fin 3, (clause index).1 = name := by + simp only [paperNormalizedOccurringVariables, List.mem_eraseDups, + mem_paperSourceNormalizedVariables_iff] + +theorem paperSourceNormalizedOccurringVariables_nodup + (formula : ThreeCNF) : + (paperNormalizedOccurringVariables formula).Nodup := by + exact eraseDups_nodup (paperSourceNormalizedVariables formula) + +end SourcePreprocessingSemantics + +namespace FormulaBridge + +open GapCVP.Factor400FormulaBridge GapCVP.SourcePreprocessingSemantics +open GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.BinaryExplicitAffineSystem +open GapCVP.BinaryExplicitSourceSoundness + +/-- GapCVP reduction support. -/ +def paperVariableArityVariableCount (formula : ThreeCNF) : ℕ := + (paperNormalizedOccurringVariables formula).length + +/-- GapCVP reduction support. -/ +def paperVariableArityVariableRank + (formula : ThreeCNF) (name : ℕ) : ℕ := + (paperNormalizedOccurringVariables formula).idxOf name + +theorem paperVariableArityVariableRank_lt + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (literal : Literal) (hliteral : literal ∈ clause) : + paperVariableArityVariableRank formula literal.1 < + paperVariableArityVariableCount formula := by + unfold paperVariableArityVariableRank paperVariableArityVariableCount + apply List.idxOf_lt_length_of_mem + simp only [paperNormalizedOccurringVariables, + List.mem_eraseDups] + unfold paperSourceNormalizedVariables + apply List.mem_flatMap.mpr + exact ⟨clause, hclause, + List.mem_map.mpr ⟨literal, hliteral, rfl⟩⟩ + +/-- GapCVP reduction support. -/ +def paperVariableAritySourceLiteral + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (literal : Literal) (hliteral : literal ∈ clause) : + GapCVP.Core.Literal (paperVariableArityVariableCount formula) where + variableIndex := + ⟨paperVariableArityVariableRank formula literal.1, + paperVariableArityVariableRank_lt + formula clause hclause literal hliteral⟩ + satisfyingValue := literal.2 + +theorem paper_retainedClause_length_le_three + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + clause.length ≤ 3 := by + obtain ⟨original, _, horiginal⟩ := + (mem_paperSourceNormalizedClauses_iff formula clause).mp hclause + rw [← horiginal] + exact paperNormalizedClause_length_le_three original + +/-- GapCVP reduction support. -/ +def paperVariableAritySourceClause + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + GapCVP.Core.Clause (paperVariableArityVariableCount formula) where + literals := + (clause.attach.map fun item => + paperVariableAritySourceLiteral + formula clause hclause item.val item.property).toFinset + nonempty := by + obtain ⟨original, hretained, horiginal⟩ := + (mem_paperSourceNormalizedClauses_iff formula clause).mp hclause + have hfirst : original 0 ∈ clause := by + rw [← horiginal] + simp only [paperSourceNormalizedClause, paperSourceClauseLiterals, Fin.isValue, + List.mem_eraseDups, + List.mem_cons, List.not_mem_nil, or_false, true_or] + refine ⟨paperVariableAritySourceLiteral + formula clause hclause (original 0) hfirst, ?_⟩ + simp only [List.mem_toFinset, List.mem_map] + exact ⟨⟨original 0, hfirst⟩, List.mem_attach _ _, rfl⟩ + size_le_three := by + calc + (clause.attach.map fun item => + paperVariableAritySourceLiteral + formula clause hclause item.val item.property).toFinset.card ≤ + (clause.attach.map fun item => + paperVariableAritySourceLiteral + formula clause hclause item.val item.property).length := + List.toFinset_card_le _ + _ = clause.length := by simp only [List.length_map, List.length_attach] + _ ≤ 3 := paper_retainedClause_length_le_three + formula clause hclause + +/-- GapCVP reduction support. -/ +abbrev srcFormula (formula : ThreeCNF) : + GapCVP.Core.Formula where + variableCount := paperVariableArityVariableCount formula + clauses := + (paperSourceNormalizedClauses formula).attach.map fun item => + paperVariableAritySourceClause + formula item.val item.property + +@[simp] theorem paperVariableAritySourceFormula_variableCount + (formula : ThreeCNF) : + (srcFormula formula).variableCount = + paperVariableArityVariableCount formula := by + rfl + +theorem paperVariableAritySourceFormula_clauses_length + (formula : ThreeCNF) : + (srcFormula formula).clauses.length = + (noTautClauses formula).length := by + simp only [srcFormula, paperSourceNormalizedClauses, List.length_map, List.length_attach] + +private theorem paperVariableAritySourceClause_mem + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + paperVariableAritySourceClause formula clause hclause ∈ + (srcFormula formula).clauses := by + change paperVariableAritySourceClause formula clause hclause ∈ + (paperSourceNormalizedClauses formula).attach.map + (fun item => paperVariableAritySourceClause + formula item.val item.property) + exact List.mem_map.mpr + ⟨⟨clause, hclause⟩, List.mem_attach _ _, rfl⟩ + +private theorem paperVariableAritySourceClause_satisfied_iff + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (assignment : Fin (paperVariableArityVariableCount formula) → Bool) : + (paperVariableAritySourceClause formula clause hclause).Satisfied + assignment ↔ + ∃ literal : Literal, ∃ hliteral : literal ∈ clause, + assignment + (paperVariableAritySourceLiteral + formula clause hclause literal hliteral).variableIndex = + literal.2 := by + simp only [GapCVP.Core.Clause.Satisfied, decide_eq_true_eq] + constructor + · rintro ⟨sourceLiteral, hsource, hsatisfied⟩ + simp only [paperVariableAritySourceClause] at hsource + have hlist : sourceLiteral ∈ + clause.attach.map (fun item => + paperVariableAritySourceLiteral + formula clause hclause item.val item.property) := by + exact List.mem_toFinset.mp hsource + obtain ⟨item, _, rfl⟩ := List.mem_map.mp hlist + refine ⟨item.val, item.property, ?_⟩ + exact hsatisfied + · rintro ⟨literal, hliteral, hsatisfied⟩ + refine ⟨paperVariableAritySourceLiteral + formula clause hclause literal hliteral, ?_, ?_⟩ + · simp only [paperVariableAritySourceClause] + exact List.mem_toFinset.mpr + (List.mem_map.mpr ⟨⟨literal, hliteral⟩, + List.mem_attach _ _, rfl⟩) + · change + assignment (paperVariableAritySourceLiteral + formula clause hclause literal hliteral).variableIndex = + literal.2 + exact hsatisfied + +private def paperVariableArityCompactAssignment + (formula : ThreeCNF) (assignment : ℕ → Bool) + (index : Fin (paperVariableArityVariableCount formula)) : Bool := + assignment ((paperNormalizedOccurringVariables formula).get index) + +private theorem paperVariableArityCompactAssignment_literal + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (literal : Literal) (hliteral : literal ∈ clause) + (assignment : ℕ → Bool) : + paperVariableArityCompactAssignment formula assignment + (paperVariableAritySourceLiteral + formula clause hclause literal hliteral).variableIndex = + assignment literal.1 := by + unfold paperVariableArityCompactAssignment + paperVariableAritySourceLiteral paperVariableArityVariableRank + congr 1 + exact List.idxOf_get + (paperVariableArityVariableRank_lt + formula clause hclause literal hliteral) + +private def paperExpandedAssignment + (formula : ThreeCNF) + (assignment : Fin (paperVariableArityVariableCount formula) → Bool) : + ℕ → Bool := fun name => + if h : paperVariableArityVariableRank formula name < + paperVariableArityVariableCount formula then + assignment ⟨paperVariableArityVariableRank formula name, h⟩ + else + false + +private theorem paperVariableArityExpandedAssignment_literal + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (literal : Literal) (hliteral : literal ∈ clause) + (assignment : Fin (paperVariableArityVariableCount formula) → Bool) : + paperExpandedAssignment formula assignment literal.1 = + assignment + (paperVariableAritySourceLiteral + formula clause hclause literal hliteral).variableIndex := by + simp only [paperExpandedAssignment, paperVariableArityVariableRank_lt formula clause hclause + literal hliteral, + ↓reduceDIte, paperVariableAritySourceLiteral] + +theorem sourceFormula_satisfiable_iff + (formula : ThreeCNF) : + (srcFormula formula).Satisfiable ↔ + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + simp only [GapCVP.Core.Formula.Satisfiable, decide_eq_true_eq] + constructor + · rintro ⟨assignment, hsatisfied⟩ + refine ⟨paperExpandedAssignment formula assignment, ?_⟩ + apply (paperSourceNormalizedClauses_satisfied_iff + formula (paperExpandedAssignment + formula assignment)).mp + intro clause hclause + have hsource := + (formula_satisfied_iff_forall_mem + (srcFormula formula) assignment).mp + hsatisfied (paperVariableAritySourceClause + formula clause hclause) + (paperVariableAritySourceClause_mem formula clause hclause) + obtain ⟨literal, hliteral, hliteralSatisfied⟩ := + (paperVariableAritySourceClause_satisfied_iff + formula clause hclause assignment).mp hsource + refine ⟨literal, hliteral, ?_⟩ + simp only [GapCVP.literalSatisfied, decide_eq_true_eq] + rw [paperVariableArityExpandedAssignment_literal + formula clause hclause literal hliteral assignment] + exact hliteralSatisfied + · rintro ⟨assignment, hsatisfied⟩ + refine ⟨paperVariableArityCompactAssignment + formula assignment, ?_⟩ + apply (formula_satisfied_iff_forall_mem + (srcFormula formula) + (paperVariableArityCompactAssignment formula assignment)).mpr + intro sourceClause hsourceClause + change sourceClause ∈ + (paperSourceNormalizedClauses formula).attach.map + (fun item => paperVariableAritySourceClause + formula item.val item.property) at hsourceClause + obtain ⟨item, _, rfl⟩ := List.mem_map.mp hsourceClause + apply (paperVariableAritySourceClause_satisfied_iff + formula item.val item.property + (paperVariableArityCompactAssignment formula assignment)).mpr + have hnormalized := + (paperSourceNormalizedClauses_satisfied_iff + formula assignment).mpr hsatisfied + item.val item.property + obtain ⟨literal, hliteral, hliteralSatisfied⟩ := hnormalized + refine ⟨literal, hliteral, ?_⟩ + rw [paperVariableArityCompactAssignment_literal + formula item.val item.property literal hliteral assignment] + simp only [GapCVP.literalSatisfied, decide_eq_true_eq] at hliteralSatisfied + exact hliteralSatisfied + +/-- GapCVP reduction support. -/ +noncomputable abbrev paperExplicitBinarySystem + (encodingLength : ℕ) (formula : ThreeCNF) : + GapCVP.Core.BinaryAffineSystem := + sourceFormulaExplicitBinarySystem + encodingLength (srcFormula formula) + +theorem paperVariableArityExplicitBinarySystem_signedSolution_of_satisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (hsatisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + ∃ vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ, + (paperExplicitBinarySystem + encodingLength formula).Solves vector ∧ + (GapCVP.Core.integerSquaredNorm vector : ℝ) ≤ + ((GapCVP.Core.sourceOneHotCompletenessRadius + (srcFormula formula) + (sourceFormulaGrid encodingLength + (srcFormula formula)) : ℚ) : ℝ) ^ 2 := by + have hformula := + (sourceFormula_satisfiable_iff formula).mpr hsatisfiable + obtain ⟨vector, hsolve, hbound⟩ := + sourceFormulaExplicitBinarySystem_signedSolution_of_satisfiable + encodingLength (srcFormula formula) hformula + exact ⟨vector, hsolve, hbound⟩ + +end FormulaBridge + +namespace Factor400BinaryDecodingPromiseReduction + +open scoped BigOperators + +open GapCVP.Factor400BinaryCodeDecodingCorollary GapCVP.BinaryEncoding + +theorem binaryField_zero_or_one (value : ZMod 2) : + value = 0 ∨ value = 1 := by + exact GapCVP.Core.effectiveBinary_eq_zero_or_one value + +theorem integerSquaredNorm_binaryWordLift + {n : ℕ} (word : Fin n → ZMod 2) : + GapCVP.Core.integerSquaredNorm (binaryWordLift word) = + hammingNorm word := by + classical + unfold GapCVP.Core.integerSquaredNorm binaryWordLift hammingNorm + simp_rw [Int.natAbs_natCast] + rw [Finset.card_eq_sum_ones, Finset.sum_filter] + apply Finset.sum_congr rfl + intro index _ + rcases binaryField_zero_or_one (word index) with hzero | hone + · simp only [hzero, ZMod.val_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, + not_true_eq_false, + ↓reduceIte] + · simp only [hone, ne_eq, one_ne_zero, not_false_eq_true, ↓reduceIte, pow_eq_one_iff, + OfNat.ofNat_ne_zero, + or_false] + exact ZMod.val_natCast_of_lt (by norm_num : 1 < (2 : ℕ)) + +theorem sourceOneHotSignedTable_zero_or_one + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (formula : GapCVP.Core.Formula) (points : Finset K) + (assignment : Fin formula.variableCount → Bool) + (hsatisfies : formula.Satisfied assignment) + (interpolant : Polynomial K) + (index : Fin (GapCVP.Core.sourceSATTableDimension formula K points)) : + GapCVP.Core.sourceOneHotSignedTable + formula points assignment hsatisfies interpolant index = 0 ∨ + GapCVP.Core.sourceOneHotSignedTable + formula points assignment hsatisfies interpolant index = 1 := by + classical + let coordinate := + (Fintype.equivFin + (GapCVP.Core.sourceSATTableCoordinate formula K points)).symm index + cases htype : coordinate.1 with + | inl global => + by_cases hvalue : + coordinate.2.2 = interpolant.eval coordinate.2.1.val + · right + simp only [Core.sourceOneHotSignedTable, htype, List.get_eq_getElem, hvalue, ↓reduceIte, + coordinate] + · left + simp only [Core.sourceOneHotSignedTable, htype, List.get_eq_getElem, hvalue, ↓reduceIte, + coordinate] + | inr subtype => + by_cases hactive : + subtype.2 = GapCVP.Core.sourceActiveLocalTuple + formula assignment hsatisfies subtype.1 + · by_cases hvalue : + coordinate.2.2 = interpolant.eval coordinate.2.1.val + · right + simp only [Core.sourceOneHotSignedTable, htype, List.get_eq_getElem, hactive, hvalue, + and_self, ↓reduceIte, + coordinate] + · left + simp only [Core.sourceOneHotSignedTable, htype, List.get_eq_getElem, hactive, hvalue, + and_false, ↓reduceIte, + coordinate] + · left + simp only [Core.sourceOneHotSignedTable, htype, List.get_eq_getElem, hactive, false_and, + ↓reduceIte, + coordinate] + +/-- GapCVP reduction support. -/ +structure BinaryNearestCodewordInstance where + /-- GapCVP reduction support. -/ + blockLength : ℕ + /-- GapCVP reduction support. -/ + generatorRank : ℕ + /-- GapCVP reduction support. -/ + generator : Fin blockLength → Fin generatorRank → ZMod 2 + /-- GapCVP reduction support. -/ + target : Fin blockLength → ZMod 2 + /-- GapCVP reduction support. -/ + radius : ℕ + +/-- GapCVP reduction support. -/ +structure BinarySyndromeDecodingInstance where + /-- GapCVP reduction support. -/ + checkCount : ℕ + /-- GapCVP reduction support. -/ + blockLength : ℕ + /-- GapCVP reduction support. -/ + parityCheck : Fin checkCount → Fin blockLength → ZMod 2 + /-- GapCVP reduction support. -/ + syndrome : Fin checkCount → ZMod 2 + /-- GapCVP reduction support. -/ + radius : ℕ + +theorem binaryIntegerLift_zero : ((0 : ZMod 2).val : ℤ) = 0 := by + simp only [ZMod.val_zero, CharP.cast_eq_zero] + +theorem binaryIntegerLift_one : ((1 : ZMod 2).val : ℤ) = 1 := by + rw [ZMod.val_one 2] + norm_num + +theorem binaryIntegerLift_two : ((2 : ZMod 2).val : ℤ) = 0 := by + have htwo : (2 : ZMod 2) = 0 := by decide + rw [htwo, binaryIntegerLift_zero] + +private theorem binaryIntegerLift_cast (value : ZMod 2) : + ((value.val : ℤ) : ZMod 2) = value := by + rw [Int.cast_natCast] + exact ZMod.natCast_zmod_val value + +private theorem binaryIntegerLift_zero_or_one (value : ZMod 2) : + (value.val : ℤ) = 0 ∨ (value.val : ℤ) = 1 := by + rcases binaryField_zero_or_one value with hzero | hone + · left + simp only [hzero, ZMod.val_zero, CharP.cast_eq_zero] + · right + simp only [hone, binaryIntegerLift_one] + +theorem binaryIntegerLift_intCast_of_zero_or_one + {value : ℤ} (hvalue : value = 0 ∨ value = 1) : + ((value : ZMod 2).val : ℤ) = value := by + rcases hvalue with hzero | hone + · simp only [hzero, Int.cast_zero, binaryIntegerLift_zero] + · simp only [hone, Int.cast_one, binaryIntegerLift_one] + +private def binaryVectorOfIntegers {n : ℕ} (values : Fin n → ℤ) : + Option (Fin n → ZMod 2) := + if ∀ index, values index = 0 ∨ values index = 1 then + some (fun index => (values index : ZMod 2)) + else + none + +private def binaryMatrixOfIntegers {m n : ℕ} + (values : Fin m → Fin n → ℤ) : + Option (Fin m → Fin n → ZMod 2) := + if ∀ row column, values row column = 0 ∨ values row column = 1 then + some (fun row column => (values row column : ZMod 2)) + else + none + +private theorem binaryVectorOfIntegers_lift {n : ℕ} + (values : Fin n → ZMod 2) : + binaryVectorOfIntegers (fun index => ((values index).val : ℤ)) = + some values := by + simp only [binaryVectorOfIntegers, binaryIntegerLift_zero_or_one, implies_true, ↓reduceIte, + binaryIntegerLift_cast] + +private theorem binaryMatrixOfIntegers_lift {m n : ℕ} + (values : Fin m → Fin n → ZMod 2) : + binaryMatrixOfIntegers + (fun row column => ((values row column).val : ℤ)) = + some values := by + simp only [binaryMatrixOfIntegers, binaryIntegerLift_zero_or_one, implies_true, ↓reduceIte, + binaryIntegerLift_cast] + +/-- GapCVP reduction support. -/ +def encodeBinaryNearestCodewordInstance + (record : BinaryNearestCodewordInstance) : List Bool := + encodeAtomic record.blockLength ++ + encodeAtomic record.generatorRank ++ + encodeAtomic record.radius ++ + encodeFinValues record.blockLength + (fun index => ((record.target index).val : ℤ)) ++ + encodeMatrixRows record.blockLength record.generatorRank + (fun row column => ((record.generator row column).val : ℤ)) + +/-- GapCVP reduction support. -/ +def encodeBinarySyndromeDecodingInstance + (record : BinarySyndromeDecodingInstance) : List Bool := + encodeAtomic record.checkCount ++ + encodeAtomic record.blockLength ++ + encodeAtomic record.radius ++ + encodeFinValues record.checkCount + (fun row => ((record.syndrome row).val : ℤ)) ++ + encodeMatrixRows record.checkCount record.blockLength + (fun row column => ((record.parityCheck row column).val : ℤ)) + +/-- GapCVP reduction support. -/ +def decodeBinaryNearestCodewordInstance + (bits : List Bool) : Option BinaryNearestCodewordInstance := + match (readAtomic bits : Option (ℕ × List Bool)) with + | none => none + | some (blockLength, tail) => + match (readAtomic tail : Option (ℕ × List Bool)) with + | none => none + | some (generatorRank, tail) => + match (readAtomic tail : Option (ℕ × List Bool)) with + | none => none + | some (radius, tail) => + match (readFinValues blockLength tail : + Option ((Fin blockLength → ℤ) × List Bool)) with + | none => none + | some (target, tail) => + match binaryVectorOfIntegers target with + | none => none + | some target => + match readMatrixRows blockLength generatorRank tail with + | some (generator, []) => + match binaryMatrixOfIntegers generator with + | some generator => + some ⟨blockLength, generatorRank, generator, target, radius⟩ + | none => none + | _ => none + +/-- GapCVP reduction support. -/ +def decodeBinarySyndromeDecodingInstance + (bits : List Bool) : Option BinarySyndromeDecodingInstance := + match (readAtomic bits : Option (ℕ × List Bool)) with + | none => none + | some (checkCount, tail) => + match (readAtomic tail : Option (ℕ × List Bool)) with + | none => none + | some (blockLength, tail) => + match (readAtomic tail : Option (ℕ × List Bool)) with + | none => none + | some (radius, tail) => + match (readFinValues checkCount tail : + Option ((Fin checkCount → ℤ) × List Bool)) with + | none => none + | some (syndrome, tail) => + match binaryVectorOfIntegers syndrome with + | none => none + | some syndrome => + match readMatrixRows checkCount blockLength tail with + | some (parityCheck, []) => + match binaryMatrixOfIntegers parityCheck with + | some parityCheck => + some ⟨checkCount, blockLength, parityCheck, syndrome, radius⟩ + | none => none + | _ => none + +@[simp] theorem decodeBinaryNearestCodewordInstance_encode + (record : BinaryNearestCodewordInstance) : + decodeBinaryNearestCodewordInstance + (encodeBinaryNearestCodewordInstance record) = some record := by + cases record with + | mk blockLength generatorRank generator target radius => + have hmatrix : + readMatrixRows blockLength generatorRank + (encodeMatrixRows blockLength generatorRank + (fun row column => ((generator row column).val : ℤ))) = + some ((fun row column => ((generator row column).val : ℤ)), []) := by + simpa only [List.append_nil] using + (readMatrixRows_append (fun row column => ((generator row column).val : ℤ)) []) + simp only [decodeBinaryNearestCodewordInstance, encodeBinaryNearestCodewordInstance, + List.append_assoc, + readAtomic_append, readFinValues_append, binaryVectorOfIntegers_lift, hmatrix, + binaryMatrixOfIntegers_lift] + +@[simp] theorem decodeBinarySyndromeDecodingInstance_encode + (record : BinarySyndromeDecodingInstance) : + decodeBinarySyndromeDecodingInstance + (encodeBinarySyndromeDecodingInstance record) = some record := by + cases record with + | mk checkCount blockLength parityCheck syndrome radius => + have hmatrix : + readMatrixRows checkCount blockLength + (encodeMatrixRows checkCount blockLength + (fun row column => ((parityCheck row column).val : ℤ))) = + some ((fun row column => ((parityCheck row column).val : ℤ)), []) := by + simpa only [List.append_nil] using + (readMatrixRows_append (fun row column => ((parityCheck row column).val : ℤ)) []) + simp only [decodeBinarySyndromeDecodingInstance, encodeBinarySyndromeDecodingInstance, + List.append_assoc, + readAtomic_append, readFinValues_append, binaryVectorOfIntegers_lift, hmatrix, + binaryMatrixOfIntegers_lift] + +/-- GapCVP reduction support. -/ +def binaryNearestCodeword + (record : BinaryNearestCodewordInstance) + (coefficients : Fin record.generatorRank → ZMod 2) : + Fin record.blockLength → ZMod 2 := + fun index => ∑ column : Fin record.generatorRank, + record.generator index column * coefficients column + +/-- GapCVP reduction support. -/ +def binaryNearestTarget (record : BinaryNearestCodewordInstance) : + Fin record.blockLength → ZMod 2 := + record.target + +/-- GapCVP reduction support. -/ +def binarySyndromeProduct + (record : BinarySyndromeDecodingInstance) + (word : Fin record.blockLength → ZMod 2) : + Fin record.checkCount → ZMod 2 := + fun row => ∑ column : Fin record.blockLength, + record.parityCheck row column * word column + +/-- GapCVP reduction support. -/ +def binarySyndromeTarget (record : BinarySyndromeDecodingInstance) : + Fin record.checkCount → ZMod 2 := + record.syndrome + +end Factor400BinaryDecodingPromiseReduction + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part12.lean b/LeanPool/GapCVP/Part12.lean new file mode 100644 index 000000000..b6b90727d --- /dev/null +++ b/LeanPool/GapCVP/Part12.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part12D + +/-! # GapCVP proof, part 12 -/ diff --git a/LeanPool/GapCVP/Part12A.lean b/LeanPool/GapCVP/Part12A.lean new file mode 100644 index 000000000..22a2138bf --- /dev/null +++ b/LeanPool/GapCVP/Part12A.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part11 + +/-! # GapCVP proof, part 12 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace FourFamilySoundness + +open scoped BigOperators + +open GapCVP.FormulaBridge GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryExplicitFourFamilyKernel +open GapCVP.BinaryExplicitSourceSoundness GapCVP.Factor400BinaryCodeDecodingCorollary +open GapCVP.Factor400BinaryDecodingPromiseReduction + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityIntegerRadius + (encodingLength : ℕ) (formula : ThreeCNF) : ℕ := + sourceBinaryDecodingRadius encodingLength + (srcFormula formula) + +theorem paperVariableArityIntegerRadius_pos + (encodingLength : ℕ) (formula : ThreeCNF) : + 0 < paperVariableArityIntegerRadius encodingLength formula := + sourceBinaryDecodingRadius_pos encodingLength + (srcFormula formula) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem paperVariableArityExplicitBinarySystem_oneHot_of_satisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (hsatisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + ∃ vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ, + (paperExplicitBinarySystem + encodingLength formula).Solves vector ∧ + (∀ index, vector index = 0 ∨ vector index = 1) ∧ + GapCVP.Core.integerSquaredNorm vector = + paperVariableArityIntegerRadius encodingLength formula := by + classical + let F := srcFormula formula + let points := sourceFormulaGrid encodingLength F + have hformula : F.Satisfiable := + (sourceFormula_satisfiable_iff formula).mpr + hsatisfiable + simp only [GapCVP.Core.Formula.Satisfiable, decide_eq_true_eq] at hformula + obtain ⟨assignment, hsatisfied⟩ := hformula + obtain ⟨interpolant, hdegree, hinterpolant⟩ := + GapCVP.Core.exists_sourceSAT_assignment_interpolant_of_injective + F (sourceFormulaVariablePlace encodingLength F) + (sourceFormulaVariablePlace_injective encodingLength F) assignment + let vector : Fin (sourceFormulaDimension encodingLength F) → ℤ := + GapCVP.Core.sourceOneHotSignedTable + F points assignment hsatisfied interpolant + have hcanonical : + (sourceFormulaBinarySystem encodingLength F).Solves vector := by + change + (GapCVP.Core.concreteSATBinaryAffineSystem F + (sourceFormulaFieldBasis encodingLength F) + points (sourceFormulaVariablePlace encodingLength F) + (GapCVP.Core.sourceSizeParameter encodingLength F ^ 30)).Solves + vector + apply GapCVP.Core.sourceOneHot_solves_concreteSATBinaryAffineSystem + F (sourceFormulaFieldBasis encodingLength F) + points (sourceFormulaVariablePlace encodingLength F) + assignment hsatisfied interpolant hdegree hinterpolant + intro point index + exact GapCVP.Core.sourceSATPuncturedGrid_sub_ne_zero + F (sourceFormulaVariablePlace encodingLength F) point index + refine ⟨vector, ?_, ?_, ?_⟩ + · change (sourceFormulaExplicitBinarySystem + encodingLength F).Solves vector + apply (sourceFormulaExplicitBinarySystem_solves_iff_concreteSATFieldChecks + encodingLength F vector).mpr + exact (sourceFormulaBinarySystem_solves_iff + encodingLength F vector).mp hcanonical + · intro index + exact sourceOneHotSignedTable_zero_or_one + F points assignment hsatisfied interpolant index + · change GapCVP.Core.integerSquaredNorm vector = + (F.clauses.length + 1) * points.card + exact GapCVP.Core.sourceOneHotSignedTable_squaredNorm + F points assignment hsatisfied interpolant + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem paperVariableArityExplicitBinarySystem_satisfiable_of_scaled_hamming + (encodingLength : ℕ) (formula : ThreeCNF) + (vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ) + (hsolve : (paperExplicitBinarySystem + encodingLength formula).Solves vector) + (hshort : + (GapCVP.Core.integerSquaredNorm vector : ℝ) ≤ + 2 * binaryCodeGapFactor + (sourceFormulaDimension encodingLength + (srcFormula formula)) * + (paperVariableArityIntegerRadius + encodingLength formula : ℝ)) : + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + let F := srcFormula formula + apply (sourceFormula_satisfiable_iff formula).mp + have hchecks := + (sourceFormulaExplicitBinarySystem_solves_iff_concreteSATFieldChecks + encodingLength F vector).mp hsolve + have hcanonical : + (sourceFormulaBinarySystem encodingLength F).Solves vector := + (sourceFormulaBinarySystem_solves_iff + encodingLength F vector).mpr hchecks + apply sourceFormula_satisfiable_of_short_signed_solution + encodingLength F vector hcanonical + apply sourceBinaryDecoding_scaledNorm_support + encodingLength F vector + exact hshort + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem paperVariableArityExplicitBinarySystem_strict_factor400_of_unsatisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ) + (hsolve : (paperExplicitBinarySystem + encodingLength formula).Solves vector) + (hunsatisfiable : + ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + (GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + (sourceFormulaDimension encodingLength + (srcFormula formula)) * + ((GapCVP.Core.sourceOneHotCompletenessRadius + (srcFormula formula) + (sourceFormulaGrid encodingLength + (srcFormula formula)) : ℚ) : ℝ)) ^ 2 < + (GapCVP.Core.integerSquaredNorm vector : ℝ) := by + apply + sourceFormulaExplicitBinarySystem_squaredNorm_gt_factor400_of_unsatisfiable + encodingLength (srcFormula formula) vector hsolve + intro hsatisfiable + exact hunsatisfiable + ((sourceFormula_satisfiable_iff formula).mp + hsatisfiable) + +end FourFamilySoundness + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part12B.lean b/LeanPool/GapCVP/Part12B.lean new file mode 100644 index 000000000..217ec0dca --- /dev/null +++ b/LeanPool/GapCVP/Part12B.lean @@ -0,0 +1,2302 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part12A + +/-! # GapCVP proof, part 12, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace FourFamilySoundness + +open scoped BigOperators + +open GapCVP.FormulaBridge GapCVP.Factor400BinaryConstructiveSourcePlaces + +open GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryExplicitFourFamilyKernel + +open GapCVP.BinaryExplicitSourceSoundness GapCVP.Factor400BinaryCodeDecodingCorollary + +open GapCVP.Factor400BinaryDecodingPromiseReduction + +end FourFamilySoundness + +namespace SourcePreprocessingTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.SourceOriginalSourcePreservingTM +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceIndexedClauseLookupTM +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.SourceNormalizedVariableRankScanTM GapCVP.CNFGuardedFiveFamilyTagDispatchTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CLStructuralNaturalBinaryWriter GapCVP.BinaryDimensionTM + +/-- GapCVP reduction support. -/ +def paperSourcePreprocessingSuffixAt (index : ℕ) : + List Bool → List Bool := + (firstFieldSuffix^[index]) + +/-- GapCVP reduction support. -/ +noncomputable def paperPreprocessingSuffixAtComputable + (index : ℕ) : + BitTM + (paperSourcePreprocessingSuffixAt index) := by + induction index with + | zero => + exact Turing.idComputableInPolyTime bitEncoding + | succ index ih => + have physical := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable ih + change BitTM + (firstFieldSuffix^[index + 1]) + simpa only [Function.iterate_succ, Function.comp_def, paperSourcePreprocessingSuffixAt] + using physical + +/-- GapCVP reduction support. -/ +def paperSourcePreprocessingField (index : ℕ) : + List Bool → List Bool := + firstFieldContents ∘ paperSourcePreprocessingSuffixAt index + +/-- GapCVP reduction support. -/ +noncomputable def paperPreprocessingFieldComputable + (index : ℕ) : + BitTM + (paperSourcePreprocessingField index) := + GapCVP.TMComposition.computableInPolyTime + (paperPreprocessingSuffixAtComputable index) + firstFieldContentsComputable + +private def paperSourceClauseLiteralSuffixAt (index : ℕ) : + List Bool → List Bool := + (literalSuffix^[index]) + +private noncomputable def paperSourceClauseLiteralSuffixAtComputable + (index : ℕ) : + BitTM + (paperSourceClauseLiteralSuffixAt index) := by + induction index with + | zero => + exact Turing.idComputableInPolyTime bitEncoding + | succ index ih => + have physical := GapCVP.TMComposition.computableInPolyTime + literalSuffixComputable ih + change BitTM + (literalSuffix^[index + 1]) + simpa only [Function.iterate_succ, Function.comp_def, paperSourceClauseLiteralSuffixAt] + using physical + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperSourceClauseLiteralWord (position : Fin 3) : + List Bool → List Bool := + sourceOriginalIndexedPhysicalLiteralOutput ∘ + paperSourceClauseLiteralSuffixAt position.val + +private noncomputable def paperClauseLiteralWordComputable + (position : Fin 3) : + BitTM + (paperSourceClauseLiteralWord position) := + GapCVP.TMComposition.computableInPolyTime + (paperSourceClauseLiteralSuffixAtComputable position.val) + sourceOriginalIndexedPhysicalLiteralComputable + +/-- GapCVP reduction support. -/ +def paperSourceClauseVariableWord (position : Fin 3) : + List Bool → List Bool := + firstFieldContents ∘ paperSourceClauseLiteralSuffixAt position.val + +/-- GapCVP reduction support. -/ +noncomputable def paperSourceClauseVariableWordComputable + (position : Fin 3) : + BitTM + (paperSourceClauseVariableWord position) := + GapCVP.TMComposition.computableInPolyTime + (paperSourceClauseLiteralSuffixAtComputable position.val) + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def paperSourceClauseSignWord (position : Fin 3) : + List Bool → List Bool := + sourceOriginalIndexedLiteralSignOutput ∘ + paperSourceClauseLiteralSuffixAt position.val + +/-- GapCVP reduction support. -/ +noncomputable def paperSourceClauseSignWordComputable + (position : Fin 3) : + BitTM + (paperSourceClauseSignWord position) := + GapCVP.TMComposition.computableInPolyTime + (paperSourceClauseLiteralSuffixAtComputable position.val) + sourceOriginalIndexedLiteralSignComputable + +private def paperSourceClauseVariableEquality + (first second : Fin 3) : List Bool → List Bool := + maskComputedWordEquality + (paperSourceClauseVariableWord first) + (paperSourceClauseVariableWord second) + +private noncomputable def paperSourceClauseVariableEqualityComputable + (first second : Fin 3) : + BitTM + (paperSourceClauseVariableEquality first second) := + maskComputedWordEqualityComputable + (paperSourceClauseVariableWordComputable first) + (paperSourceClauseVariableWordComputable second) + +private def paperSourceClauseSignEquality + (first second : Fin 3) : List Bool → List Bool := + maskComputedWordEquality + (paperSourceClauseSignWord first) + (paperSourceClauseSignWord second) + +private noncomputable def paperSourceClauseSignEqualityComputable + (first second : Fin 3) : + BitTM + (paperSourceClauseSignEquality first second) := + maskComputedWordEqualityComputable + (paperSourceClauseSignWordComputable first) + (paperSourceClauseSignWordComputable second) + +private def paperSourceClauseOppositePair + (first second : Fin 3) : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (paperSourceClauseVariableEquality first second) + (sourceFourFamilyBooleanNotOutput + (paperSourceClauseSignEquality first second)) + +private noncomputable def paperSourceClauseOppositePairComputable + (first second : Fin 3) : + BitTM + (paperSourceClauseOppositePair first second) := + fourFamilyBooleanAndComputable + (paperSourceClauseVariableEqualityComputable first second) + (fourFamilyBooleanNotOutputComputable + (paperSourceClauseSignEqualityComputable first second)) + +private def paperSourceMarkerOr + (first second : List Bool → List Bool) : + List Bool → List Bool := + sourceFourFamilyBooleanOrOutput first second + +private noncomputable def paperSourceMarkerOrComputable + {first second : List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (paperSourceMarkerOr first second) := + sourceFourFamilyBooleanOrComputable hfirst hsecond + +private def paperSourceClauseTautologyMarker : List Bool → List Bool := + paperSourceMarkerOr (paperSourceClauseOppositePair 0 1) + (paperSourceMarkerOr (paperSourceClauseOppositePair 0 2) + (paperSourceClauseOppositePair 1 2)) + +private noncomputable def paperSourceClauseTautologyMarkerComputable : + BitTM + paperSourceClauseTautologyMarker := + paperSourceMarkerOrComputable + (paperSourceClauseOppositePairComputable 0 1) + (paperSourceMarkerOrComputable + (paperSourceClauseOppositePairComputable 0 2) + (paperSourceClauseOppositePairComputable 1 2)) + +private def paperSourceClauseLiteralEquality + (first second : Fin 3) : List Bool → List Bool := + maskComputedWordEquality + (paperSourceClauseLiteralWord first) + (paperSourceClauseLiteralWord second) + +private noncomputable def paperSourceClauseLiteralEqualityComputable + (first second : Fin 3) : + BitTM + (paperSourceClauseLiteralEquality first second) := + maskComputedWordEqualityComputable + (paperClauseLiteralWordComputable first) + (paperClauseLiteralWordComputable second) + +/-- GapCVP reduction support. -/ +def paperSourceClauseSecondKeepMarker : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + (paperSourceClauseLiteralEquality 0 1) + +/-- GapCVP reduction support. -/ +noncomputable def paperSourceClauseSecondKeepMarkerComputable : + BitTM + paperSourceClauseSecondKeepMarker := + fourFamilyBooleanNotOutputComputable + (paperSourceClauseLiteralEqualityComputable 0 1) + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperSourceClauseThirdKeepMarker : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + (paperSourceClauseLiteralEquality 0 2)) + (sourceFourFamilyBooleanNotOutput + (paperSourceClauseLiteralEquality 1 2)) + +private noncomputable def paperSourceClauseThirdKeepMarkerComputable : + BitTM + paperSourceClauseThirdKeepMarker := + fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable + (paperSourceClauseLiteralEqualityComputable 0 2)) + (fourFamilyBooleanNotOutputComputable + (paperSourceClauseLiteralEqualityComputable 1 2)) + +private def paperSourcePhysicalMarkerSelection + (marker : List Bool → List Bool) (input : List Bool) : List Bool := + (marker input).headD false :: input + +private noncomputable def paperPhysicalMarkerSelectionComputable + {marker : List Bool → List Bool} + (computer : BitTM marker) + (shape : ∀ input, ∃ bit : Bool, marker input = [bit]) : + BitTM + (paperSourcePhysicalMarkerSelection marker) := by + have preserved := originalSourcePreservingComputable computer + have physical := GapCVP.TMComposition.computableInPolyTime + preserved keepFirstDropSecondComputable + have equality : + (fun input : List Bool => + keepFirstDropSecondWord (originalSourcePreservingOutput marker input)) = + paperSourcePhysicalMarkerSelection marker := by + funext input + obtain ⟨bit, hbit⟩ := shape input + simp only [keepFirstDropSecondWord, originalSourcePreservingOutput, hbit, List.cons_append, + List.nil_append, + List.tail_cons, paperSourcePhysicalMarkerSelection, List.headD_eq_head?_getD, + List.head?_cons, Option.getD_some] + rw [← equality] + exact physical + +private theorem paperSourceClauseLiteralEquality_shape + (first second : Fin 3) (input : List Bool) : + ∃ bit : Bool, + paperSourceClauseLiteralEquality first second input = [bit] := by + refine ⟨decide + (paperSourceClauseLiteralWord first input = + paperSourceClauseLiteralWord second input), ?_⟩ + simp only [paperSourceClauseLiteralEquality, sourceQaryMaskSquareComputedWordEquality_valid] + +private theorem paperSourceClauseVariableEquality_shape + (first second : Fin 3) (input : List Bool) : + ∃ bit : Bool, + paperSourceClauseVariableEquality first second input = [bit] := by + refine ⟨decide + (paperSourceClauseVariableWord first input = + paperSourceClauseVariableWord second input), ?_⟩ + simp only [paperSourceClauseVariableEquality, sourceQaryMaskSquareComputedWordEquality_valid] + +private theorem paperSourceClauseSignEquality_shape + (first second : Fin 3) (input : List Bool) : + ∃ bit : Bool, + paperSourceClauseSignEquality first second input = [bit] := by + refine ⟨decide + (paperSourceClauseSignWord first input = + paperSourceClauseSignWord second input), ?_⟩ + simp only [paperSourceClauseSignEquality, sourceQaryMaskSquareComputedWordEquality_valid] + +private theorem paperSourceBooleanNot_shape + (marker : List Bool → List Bool) + (shape : ∀ input, ∃ bit : Bool, marker input = [bit]) + (input : List Bool) : + ∃ bit : Bool, + sourceFourFamilyBooleanNotOutput marker input = [bit] := by + obtain ⟨bit, hbit⟩ := shape input + refine ⟨!bit, ?_⟩ + exact fourFamilyBooleanNotOutput_bit marker input bit hbit + +private theorem paperSourceBooleanAnd_shape + (first second : List Bool → List Bool) + (hfirst : ∀ input, ∃ bit : Bool, first input = [bit]) + (hsecond : ∀ input, ∃ bit : Bool, second input = [bit]) + (input : List Bool) : + ∃ bit : Bool, + sourceFourFamilyBooleanAndOutput first second input = [bit] := by + obtain ⟨left, hleft⟩ := hfirst input + obtain ⟨right, hright⟩ := hsecond input + refine ⟨left && right, ?_⟩ + exact fourFamilyBooleanAndOutput_bits + first second input left right hleft hright + +private theorem paperSourceMarkerOr_shape + (first second : List Bool → List Bool) + (hfirst : ∀ input, ∃ bit : Bool, first input = [bit]) + (hsecond : ∀ input, ∃ bit : Bool, second input = [bit]) + (input : List Bool) : + ∃ bit : Bool, paperSourceMarkerOr first second input = [bit] := by + unfold paperSourceMarkerOr + apply paperSourceBooleanNot_shape + exact paperSourceBooleanAnd_shape _ _ + (paperSourceBooleanNot_shape first hfirst) + (paperSourceBooleanNot_shape second hsecond) + +private theorem paperSourceClauseOppositePair_shape + (first second : Fin 3) (input : List Bool) : + ∃ bit : Bool, paperSourceClauseOppositePair first second input = [bit] := by + unfold paperSourceClauseOppositePair + exact paperSourceBooleanAnd_shape _ _ + (paperSourceClauseVariableEquality_shape first second) + (paperSourceBooleanNot_shape _ + (paperSourceClauseSignEquality_shape first second)) input + +private theorem paperSourceClauseTautologyMarker_shape + (input : List Bool) : + ∃ bit : Bool, paperSourceClauseTautologyMarker input = [bit] := by + unfold paperSourceClauseTautologyMarker + exact paperSourceMarkerOr_shape _ _ + (paperSourceClauseOppositePair_shape 0 1) + (paperSourceMarkerOr_shape _ _ + (paperSourceClauseOppositePair_shape 0 2) + (paperSourceClauseOppositePair_shape 1 2)) input + +private theorem paperSourceClauseSecondKeepMarker_shape + (input : List Bool) : + ∃ bit : Bool, paperSourceClauseSecondKeepMarker input = [bit] := by + exact paperSourceBooleanNot_shape _ + (paperSourceClauseLiteralEquality_shape 0 1) input + +private theorem paperSourceClauseThirdKeepMarker_shape + (input : List Bool) : + ∃ bit : Bool, paperSourceClauseThirdKeepMarker input = [bit] := by + unfold paperSourceClauseThirdKeepMarker + exact paperSourceBooleanAnd_shape _ _ + (paperSourceBooleanNot_shape _ + (paperSourceClauseLiteralEquality_shape 0 2)) + (paperSourceBooleanNot_shape _ + (paperSourceClauseLiteralEquality_shape 1 2)) input + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperClauseSelectedSecondLiteral + (input : List Bool) : List Bool := + if (paperSourceClauseSecondKeepMarker input).headD false then + paperSourceClauseLiteralWord 1 input + else [] + +private noncomputable def paperSourceClauseSelectedSecondLiteralComputable : + BitTM + paperClauseSelectedSecondLiteral := by + exact sourcePreservingConditionalComputable + (paperPhysicalMarkerSelectionComputable + paperSourceClauseSecondKeepMarkerComputable + paperSourceClauseSecondKeepMarker_shape) + (paperClauseLiteralWordComputable 1) [] + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperClauseSelectedThirdLiteral + (input : List Bool) : List Bool := + if (paperSourceClauseThirdKeepMarker input).headD false then + paperSourceClauseLiteralWord 2 input + else [] + +private noncomputable def paperSourceClauseSelectedThirdLiteralComputable : + BitTM + paperClauseSelectedThirdLiteral := by + exact sourcePreservingConditionalComputable + (paperPhysicalMarkerSelectionComputable + paperSourceClauseThirdKeepMarkerComputable + paperSourceClauseThirdKeepMarker_shape) + (paperClauseLiteralWordComputable 2) [] + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperSourceClauseSecondKeepUnary + (input : List Bool) : List Bool := + if (paperSourceClauseSecondKeepMarker input).headD false then [true] else [] + +private noncomputable def paperSourceClauseSecondKeepUnaryComputable : + BitTM + paperSourceClauseSecondKeepUnary := by + exact sourcePreservingConditionalComputable + (paperPhysicalMarkerSelectionComputable + paperSourceClauseSecondKeepMarkerComputable + paperSourceClauseSecondKeepMarker_shape) + (sourceFixedWordComputable [true]) [] + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperSourceClauseThirdKeepUnary + (input : List Bool) : List Bool := + if (paperSourceClauseThirdKeepMarker input).headD false then [true] else [] + +private noncomputable def paperSourceClauseThirdKeepUnaryComputable : + BitTM + paperSourceClauseThirdKeepUnary := by + exact sourcePreservingConditionalComputable + (paperPhysicalMarkerSelectionComputable + paperSourceClauseThirdKeepMarkerComputable + paperSourceClauseThirdKeepMarker_shape) + (sourceFixedWordComputable [true]) [] + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperSourceClauseNormalizedRecord + (input : List Bool) : List Bool := + true :: + (paperSourceClauseSecondKeepUnary input ++ + (paperSourceClauseThirdKeepUnary input ++ + (false :: + (paperSourceClauseLiteralWord 0 input ++ + (paperClauseSelectedSecondLiteral input ++ + paperClauseSelectedThirdLiteral input))))) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def paperSourceClauseNormalizedRecordComputable : + BitTM + paperSourceClauseNormalizedRecord := by + have literals := pointwiseAppendComputable + (paperClauseLiteralWordComputable 0) + (pointwiseAppendComputable + paperSourceClauseSelectedSecondLiteralComputable + paperSourceClauseSelectedThirdLiteralComputable) + have stopped := GapCVP.TMComposition.computableInPolyTime + literals (prependBitComputable false) + have fields := pointwiseAppendComputable + paperSourceClauseSecondKeepUnaryComputable + (pointwiseAppendComputable + paperSourceClauseThirdKeepUnaryComputable stopped) + exact GapCVP.TMComposition.computableInPolyTime + fields (prependBitComputable true) + +private def paperSourceClauseOriginalRecord : List Bool → List Bool := + sourceOriginalIndexedPhysicalThreeClauseOutput + +private noncomputable def paperSourceClauseOriginalRecordComputable : + BitTM + paperSourceClauseOriginalRecord := + sourceOriginalIndexedPhysicalThreeClauseComputable + +private def paperSourceClauseRetainMarker : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput paperSourceClauseTautologyMarker + +private noncomputable def paperSourceClauseRetainMarkerComputable : + BitTM + paperSourceClauseRetainMarker := + fourFamilyBooleanNotOutputComputable + paperSourceClauseTautologyMarkerComputable + +private theorem paperSourceClauseRetainMarker_shape (input : List Bool) : + ∃ bit : Bool, paperSourceClauseRetainMarker input = [bit] := by + exact paperSourceBooleanNot_shape _ + paperSourceClauseTautologyMarker_shape input + +private def paperSourceRetainedOriginalClause + (input : List Bool) : List Bool := + if (paperSourceClauseRetainMarker input).headD false then + paperSourceClauseOriginalRecord input + else [] + +private noncomputable def paperSourceRetainedOriginalClauseComputable : + BitTM + paperSourceRetainedOriginalClause := by + exact sourcePreservingConditionalComputable + (paperPhysicalMarkerSelectionComputable + paperSourceClauseRetainMarkerComputable + paperSourceClauseRetainMarker_shape) + paperSourceClauseOriginalRecordComputable [] + +private def paperSourceRetainedNormalizedClause + (input : List Bool) : List Bool := + if (paperSourceClauseRetainMarker input).headD false then + paperSourceClauseNormalizedRecord input + else [] + +private noncomputable def paperSourceRetainedNormalizedClauseComputable : + BitTM + paperSourceRetainedNormalizedClause := by + exact sourcePreservingConditionalComputable + (paperPhysicalMarkerSelectionComputable + paperSourceClauseRetainMarkerComputable + paperSourceClauseRetainMarker_shape) + paperSourceClauseNormalizedRecordComputable [] + +private def paperSourceRetainedClauseUnary + (input : List Bool) : List Bool := + if (paperSourceClauseRetainMarker input).headD false then [true] else [] + +private noncomputable def paperSourceRetainedClauseUnaryComputable : + BitTM + paperSourceRetainedClauseUnary := by + exact sourcePreservingConditionalComputable + (paperPhysicalMarkerSelectionComputable + paperSourceClauseRetainMarkerComputable + paperSourceClauseRetainMarker_shape) + (sourceFixedWordComputable [true]) [] + +private def paperSourcePreprocessingCurrent + (worker : List Bool → List Bool) : List Bool → List Bool := + worker ∘ paperSourcePreprocessingField 3 + +private noncomputable def paperSourcePreprocessingCurrentComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (paperSourcePreprocessingCurrent worker) := + GapCVP.TMComposition.computableInPolyTime + (paperPreprocessingFieldComputable 3) computer + +private def paperPreprocessingNextOriginalBody + (input : List Bool) : List Bool := + paperSourcePreprocessingField 0 input ++ + paperSourcePreprocessingCurrent paperSourceRetainedOriginalClause input + +private noncomputable def paperSourcePreprocessingNextOriginalBodyComputable : + BitTM + paperPreprocessingNextOriginalBody := + pointwiseAppendComputable + (paperPreprocessingFieldComputable 0) + (paperSourcePreprocessingCurrentComputable + paperSourceRetainedOriginalClauseComputable) + +private def paperPreprocessingNextNormalizedBody + (input : List Bool) : List Bool := + paperSourcePreprocessingField 1 input ++ + paperSourcePreprocessingCurrent paperSourceRetainedNormalizedClause input + +private noncomputable def paperSourcePreprocessingNextNormalizedBodyComputable : + BitTM + paperPreprocessingNextNormalizedBody := + pointwiseAppendComputable + (paperPreprocessingFieldComputable 1) + (paperSourcePreprocessingCurrentComputable + paperSourceRetainedNormalizedClauseComputable) + +private def paperPreprocessingNextClauseCount + (input : List Bool) : List Bool := + paperSourcePreprocessingField 2 input ++ + paperSourcePreprocessingCurrent paperSourceRetainedClauseUnary input + +private noncomputable def paperSourcePreprocessingNextClauseCountComputable : + BitTM + paperPreprocessingNextClauseCount := + pointwiseAppendComputable + (paperPreprocessingFieldComputable 2) + (paperSourcePreprocessingCurrentComputable + paperSourceRetainedClauseUnaryComputable) + +private def paperSourcePreprocessingNextPending : List Bool → List Bool := + clauseSuffix ∘ paperSourcePreprocessingField 3 + +private noncomputable def paperSourcePreprocessingNextPendingComputable : + BitTM + paperSourcePreprocessingNextPending := + GapCVP.TMComposition.computableInPolyTime + (paperPreprocessingFieldComputable 3) + clauseSuffixComputable + +private def paperSourcePreprocessingOriginal : List Bool → List Bool := + paperSourcePreprocessingSuffixAt 5 + +private noncomputable def paperSourcePreprocessingOriginalComputable : + BitTM + paperSourcePreprocessingOriginal := + paperPreprocessingSuffixAtComputable 5 + +private def paperSourcePreprocessingStep (input : List Bool) : List Bool := + lengthPrefixedWord (paperPreprocessingNextOriginalBody input) ++ + (lengthPrefixedWord (paperPreprocessingNextNormalizedBody input) ++ + (lengthPrefixedWord (paperPreprocessingNextClauseCount input) ++ + (lengthPrefixedWord (paperSourcePreprocessingNextPending input) ++ + (lengthPrefixedWord (paperSourcePreprocessingField 4 input) ++ + paperSourcePreprocessingOriginal input)))) + +private noncomputable def paperSourcePreprocessingStepComputable : + BitTM + paperSourcePreprocessingStep := by + have originalBody := GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingNextOriginalBodyComputable + structuralPrefixWriterComputable + have normalizedBody := GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingNextNormalizedBodyComputable + structuralPrefixWriterComputable + have count := GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingNextClauseCountComputable + structuralPrefixWriterComputable + have pending := GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingNextPendingComputable + structuralPrefixWriterComputable + have archive := GapCVP.TMComposition.computableInPolyTime + (paperPreprocessingFieldComputable 4) + structuralPrefixWriterComputable + exact pointwiseAppendComputable originalBody + (pointwiseAppendComputable normalizedBody + (pointwiseAppendComputable count + (pointwiseAppendComputable pending + (pointwiseAppendComputable archive + paperSourcePreprocessingOriginalComputable)))) + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperSourcePreprocessingValidState + (formula : ThreeCNF) + (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) (pending : ThreeCNF) : List Bool := + lengthPrefixedWord originalBody ++ + (lengthPrefixedWord normalizedBody ++ + (lengthPrefixedWord (List.replicate retainedCount true) ++ + (lengthPrefixedWord (pending.flatMap encodeThreeClause) ++ + (lengthPrefixedWord (formula.flatMap encodeThreeClause) ++ + encodeThreeCNF formula)))) + +@[simp] private theorem paperSourcePreprocessingField_valid_zero + (formula : ThreeCNF) (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) (pending : ThreeCNF) : + paperSourcePreprocessingField 0 + (paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount pending) = + originalBody := by + simp only [paperSourcePreprocessingField, paperSourcePreprocessingSuffixAt, + Function.iterate_zero, + paperSourcePreprocessingValidState, Function.comp_apply, id_eq, firstFieldContents_valid] + +@[simp] private theorem paperSourcePreprocessingField_valid_one + (formula : ThreeCNF) (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) (pending : ThreeCNF) : + paperSourcePreprocessingField 1 + (paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount pending) = + normalizedBody := by + simp only [paperSourcePreprocessingField, paperSourcePreprocessingSuffixAt, Function.iterate_one, + paperSourcePreprocessingValidState, Function.comp_apply, firstFieldSuffix_valid, + firstFieldContents_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem paperSourcePreprocessingField_valid_two + (formula : ThreeCNF) (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) (pending : ThreeCNF) : + paperSourcePreprocessingField 2 + (paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount pending) = + List.replicate retainedCount true := by + simp [paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, + paperSourcePreprocessingValidState, Function.comp_apply] + +@[simp] private theorem paperSourcePreprocessingField_valid_three + (formula : ThreeCNF) (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) (pending : ThreeCNF) : + paperSourcePreprocessingField 3 + (paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount pending) = + pending.flatMap encodeThreeClause := by + simp [paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, + paperSourcePreprocessingValidState, Function.comp_apply] + +@[simp] private theorem paperSourcePreprocessingField_valid_four + (formula : ThreeCNF) (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) (pending : ThreeCNF) : + paperSourcePreprocessingField 4 + (paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount pending) = + formula.flatMap encodeThreeClause := by + simp [paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, + paperSourcePreprocessingValidState, Function.comp_apply] + +@[simp] private theorem paperSourcePreprocessingOriginal_valid + (formula : ThreeCNF) (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) (pending : ThreeCNF) : + paperSourcePreprocessingOriginal + (paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount pending) = + encodeThreeCNF formula := by + simp [paperSourcePreprocessingOriginal, + paperSourcePreprocessingSuffixAt, + paperSourcePreprocessingValidState, Function.comp_apply] + +private theorem paperSourcePreprocessingFieldAccounting + (input : List Bool) : + 2 * (paperSourcePreprocessingField 0 input).length + + 2 * (paperSourcePreprocessingField 1 input).length + + 2 * (paperSourcePreprocessingField 2 input).length + + 2 * (paperSourcePreprocessingField 3 input).length + + 2 * (paperSourcePreprocessingField 4 input).length + + (paperSourcePreprocessingOriginal input).length ≤ input.length := by + have first := sourceNormalizedVariableScanStructuralFieldAccounting input + have second := sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix input) + have third := sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix (firstFieldSuffix input)) + have fourth := sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix (firstFieldSuffix (firstFieldSuffix input))) + have fifth := sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix + (firstFieldSuffix (firstFieldSuffix (firstFieldSuffix input)))) + simp only [paperSourcePreprocessingField, paperSourcePreprocessingSuffixAt, + Function.iterate_zero, + Function.comp_apply, id_eq, Function.iterate_succ, paperSourcePreprocessingOriginal, ge_iff_le] + at * + omega + +private theorem paperSourcePreprocessingPending_length_le + (input : List Bool) : + (paperSourcePreprocessingField 3 input).length ≤ input.length := by + have accounting := paperSourcePreprocessingFieldAccounting input + omega + +@[simp] private theorem paperSourcePreprocessingField_three_step + (input : List Bool) : + paperSourcePreprocessingField 3 + (paperSourcePreprocessingStep input) = + clauseSuffix (paperSourcePreprocessingField 3 input) := by + simp [paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, + paperSourcePreprocessingStep, + paperSourcePreprocessingNextPending, + Function.comp_apply] + +private theorem paperSourcePreprocessingPending_step_length_le + (input : List Bool) : + (paperSourcePreprocessingField 3 + (paperSourcePreprocessingStep input)).length ≤ + (paperSourcePreprocessingField 3 input).length := by + rw [paperSourcePreprocessingField_three_step] + exact sourceOriginalIndexedClauseSuffix_length_le _ + +private theorem paperSourcePreprocessingPending_iterate_length_le + (seed : List Bool) (stage : ℕ) : + (paperSourcePreprocessingField 3 + ((paperSourcePreprocessingStep^[stage]) seed)).length ≤ + (paperSourcePreprocessingField 3 seed).length := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + exact (paperSourcePreprocessingPending_step_length_le _).trans ih + +private theorem paperSourceClauseLiteralSuffixAt_length_le + (position : ℕ) (input : List Bool) : + (paperSourceClauseLiteralSuffixAt position input).length ≤ + input.length := by + induction position with + | zero => simp only [paperSourceClauseLiteralSuffixAt, Function.iterate_zero, id_eq, Std.le_refl] + | succ position ih => + simp only [paperSourceClauseLiteralSuffixAt, + Function.iterate_succ_apply'] + exact (sourceOriginalIndexedLiteralSuffix_length_le _).trans ih + +private theorem paperSourceOriginalLiteralSign_length + (input : List Bool) : + (sourceOriginalIndexedLiteralSignOutput input).length = 1 := by + unfold sourceOriginalIndexedLiteralSignOutput + cases hfield : firstFieldSuffix input with + | nil => simp only [markerConditionalOutput, List.length_cons, List.length_nil, zero_add] + | cons bit remaining => + cases bit <;> simp [markerConditionalOutput] + +private theorem paperClauseLiteralWord_length_le + (position : Fin 3) (input : List Bool) : + (paperSourceClauseLiteralWord position input).length ≤ + input.length + 2 := by + have skipped := paperSourceClauseLiteralSuffixAt_length_le + position.val input + have accounting := sourceNormalizedVariableScanStructuralFieldAccounting + (paperSourceClauseLiteralSuffixAt position.val input) + have sign := paperSourceOriginalLiteralSign_length + (paperSourceClauseLiteralSuffixAt position.val input) + change + (sourceOriginalIndexedPhysicalLiteralOutput + (paperSourceClauseLiteralSuffixAt position.val input)).length ≤ + input.length + 2 + simp only [sourceOriginalIndexedPhysicalLiteralOutput, + sourceOriginalIndexedLiteralVariableOutput, + List.length_append, lengthPrefixedWord_length] + omega + +private theorem paperSourceClauseOriginalRecord_length_le + (input : List Bool) : + (paperSourceClauseOriginalRecord input).length ≤ + 3 * input.length + 6 := by + have first : + (sourceOriginalIndexedPhysicalLiteralOutput input).length ≤ + input.length + 2 := by + simpa [paperSourceClauseLiteralWord, + paperSourceClauseLiteralSuffixAt, Function.comp_apply] using + paperClauseLiteralWord_length_le 0 input + have second : + (sourceOriginalIndexedPhysicalLiteralOutput + (literalSuffix input)).length ≤ input.length + 2 := by + simpa [paperSourceClauseLiteralWord, + paperSourceClauseLiteralSuffixAt, Function.comp_apply] using + paperClauseLiteralWord_length_le 1 input + have third : + (sourceOriginalIndexedPhysicalLiteralOutput + (literalSuffix (literalSuffix input))).length ≤ + input.length + 2 := by + simpa [paperSourceClauseLiteralWord, + paperSourceClauseLiteralSuffixAt, Function.comp_apply] using + paperClauseLiteralWord_length_le 2 input + simp only [paperSourceClauseOriginalRecord, + sourceOriginalIndexedPhysicalThreeClauseOutput, + sourceOriginalIndexedSecondLiteralOutput, + sourceOriginalIndexedThirdLiteralOutput, + Function.comp_apply, List.length_append] + omega + +private theorem paperSourceClauseSelectedSecondLiteral_length_le + (input : List Bool) : + (paperClauseSelectedSecondLiteral input).length ≤ + input.length + 2 := by + unfold paperClauseSelectedSecondLiteral + split <;> simp_all [paperClauseLiteralWord_length_le] + +private theorem paperSourceClauseSelectedThirdLiteral_length_le + (input : List Bool) : + (paperClauseSelectedThirdLiteral input).length ≤ + input.length + 2 := by + unfold paperClauseSelectedThirdLiteral + split <;> simp_all [paperClauseLiteralWord_length_le] + +private theorem paperSourceClauseSecondKeepUnary_length_le + (input : List Bool) : + (paperSourceClauseSecondKeepUnary input).length ≤ 1 := by + unfold paperSourceClauseSecondKeepUnary + split <;> simp + +private theorem paperSourceClauseThirdKeepUnary_length_le + (input : List Bool) : + (paperSourceClauseThirdKeepUnary input).length ≤ 1 := by + unfold paperSourceClauseThirdKeepUnary + split <;> simp + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem paperSourceClauseNormalizedRecord_length_le + (input : List Bool) : + (paperSourceClauseNormalizedRecord input).length ≤ + 3 * input.length + 10 := by + have first := paperClauseLiteralWord_length_le 0 input + have second := paperSourceClauseSelectedSecondLiteral_length_le input + have third := paperSourceClauseSelectedThirdLiteral_length_le input + have secondMarker := paperSourceClauseSecondKeepUnary_length_le input + have thirdMarker := paperSourceClauseThirdKeepUnary_length_le input + simp only [paperSourceClauseNormalizedRecord, + List.length_cons, List.length_append] + omega + +private theorem paperSourceRetainedOriginalClause_length_le + (input : List Bool) : + (paperSourceRetainedOriginalClause input).length ≤ + 3 * input.length + 6 := by + unfold paperSourceRetainedOriginalClause + split + · exact paperSourceClauseOriginalRecord_length_le input + · simp only [List.length_nil, le_add_iff_nonneg_left, zero_le] + +private theorem paperSourceRetainedNormalizedClause_length_le + (input : List Bool) : + (paperSourceRetainedNormalizedClause input).length ≤ + 3 * input.length + 10 := by + unfold paperSourceRetainedNormalizedClause + split + · exact paperSourceClauseNormalizedRecord_length_le input + · simp only [List.length_nil, le_add_iff_nonneg_left, zero_le] + +private theorem paperSourceRetainedClauseUnary_length_le + (input : List Bool) : + (paperSourceRetainedClauseUnary input).length ≤ 1 := by + unfold paperSourceRetainedClauseUnary + split <;> simp + +private theorem paperSourcePreprocessingStep_length_le + (input : List Bool) : + (paperSourcePreprocessingStep input).length ≤ + input.length + + 12 * (paperSourcePreprocessingField 3 input).length + 39 := by + have accounting := paperSourcePreprocessingFieldAccounting input + have skipped := sourceOriginalIndexedClauseSuffix_length_le + (paperSourcePreprocessingField 3 input) + have original := paperSourceRetainedOriginalClause_length_le + (paperSourcePreprocessingField 3 input) + have normalized := paperSourceRetainedNormalizedClause_length_le + (paperSourcePreprocessingField 3 input) + have count := paperSourceRetainedClauseUnary_length_le + (paperSourcePreprocessingField 3 input) + simp only [paperSourcePreprocessingStep, + paperPreprocessingNextOriginalBody, + paperPreprocessingNextNormalizedBody, + paperPreprocessingNextClauseCount, + paperSourcePreprocessingCurrent, + paperSourcePreprocessingNextPending, + Function.comp_apply, List.length_append, + lengthPrefixedWord_length] + omega + +private def paperSourcePreprocessingFoldBound : Polynomial ℕ := + 40 * (Polynomial.X + 1) ^ 2 + +private theorem paperSourcePreprocessing_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates paperSourcePreprocessingStep + paperSourcePreprocessingFoldBound := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage hstage + have seedBound := sourceAtomicFoldSeed_length_le + input count seed hparse + have countBound := parsedUnaryFold_count_le_length + input count seed hparse + have pendingSeed := paperSourcePreprocessingPending_length_le seed + have intermediate : ∀ number : ℕ, + ((paperSourcePreprocessingStep^[number]) seed).length ≤ + seed.length + number * (12 * seed.length + 39) := by + intro number + induction number with + | zero => simp only [Function.iterate_zero, id_eq, zero_mul, add_zero, Std.le_refl] + | succ number ih => + rw [Function.iterate_succ_apply'] + have worker := paperSourcePreprocessingStep_length_le + ((paperSourcePreprocessingStep^[number]) seed) + have pending := paperSourcePreprocessingPending_iterate_length_le + seed number + simp only [Nat.add_mul, one_mul] + omega + have state := intermediate stage + have stageBound : stage ≤ input.length := + Nat.le_trans hstage countBound + have productBound : stage * seed.length ≤ input.length * input.length := + Nat.mul_le_mul stageBound seedBound + simp only [paperSourcePreprocessingFoldBound, + Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_pow, Polynomial.eval_add, + Polynomial.eval_X, Polynomial.eval_one] + nlinarith + +private noncomputable def paperSourcePreprocessingFoldComputable : + BitTM + (boundedRecordFoldOutput paperSourcePreprocessingStep) := + boundedDependentRecordFoldComputable + paperSourcePreprocessingStepComputable + paperSourcePreprocessingFoldBound + paperSourcePreprocessing_polynomiallyBoundedFoldStates + +private def paperSourcePreprocessingSeed (input : List Bool) : List Bool := + lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ + (lengthPrefixedWord (firstFieldSuffix input) ++ + (lengthPrefixedWord (firstFieldSuffix input) ++ input)))) + +private noncomputable def paperSourcePreprocessingSeedComputable : + BitTM + paperSourcePreprocessingSeed := by + have body := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable structuralPrefixWriterComputable + have preserved := pointwiseAppendComputable body + (pointwiseAppendComputable body + (Turing.idComputableInPolyTime bitEncoding)) + have emptyFields := prependWordComputable + (lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ lengthPrefixedWord [])) + have physical := GapCVP.TMComposition.computableInPolyTime + preserved emptyFields + change BitTM + (fun input => lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ + (lengthPrefixedWord (firstFieldSuffix input) ++ + (lengthPrefixedWord (firstFieldSuffix input) ++ input))))) + simpa only [List.append_assoc, Function.comp_apply, id_eq, Function.comp_def] using physical + +private def paperSourcePreprocessingPreparation + (input : List Bool) : List Bool := + sourceClauseCountUnary input ++ false :: paperSourcePreprocessingSeed input + +private noncomputable def paperSourcePreprocessingPreparationComputable : + BitTM + paperSourcePreprocessingPreparation := by + have marked := GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingSeedComputable (prependBitComputable false) + exact pointwiseAppendComputable + sourceClauseCountUnaryComputable marked + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperSourcePreprocessingFinalState : List Bool → List Bool := + boundedRecordFoldOutput paperSourcePreprocessingStep ∘ + paperSourcePreprocessingPreparation + +private noncomputable def paperSourcePreprocessingFinalStateComputable : + BitTM + paperSourcePreprocessingFinalState := + GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingPreparationComputable + paperSourcePreprocessingFoldComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def paperSourcePreprocessingFinalField + (index : ℕ) : List Bool → List Bool := + paperSourcePreprocessingField index ∘ + paperSourcePreprocessingFinalState + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def paperPreprocessingFinalFieldComputable + (index : ℕ) : + BitTM + (paperSourcePreprocessingFinalField index) := + GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingFinalStateComputable + (paperPreprocessingFieldComputable index) + +private def paperPreprocessingRetainedCountBinary : + List Bool → List Bool := + (fun unary : List Bool => Computability.encodeNat unary.length) ∘ + paperSourcePreprocessingFinalField 2 + +private noncomputable def paperSourcePreprocessingRetainedCountBinaryComputable : + BitTM + paperPreprocessingRetainedCountBinary := + GapCVP.TMComposition.computableInPolyTime + (paperPreprocessingFinalFieldComputable 2) + structuralNaturalBinaryWriterComputable + +/-- GapCVP reduction support. -/ +def paperPreprocessingFilteredFormulaWord + (input : List Bool) : List Bool := + lengthPrefixedWord + (paperPreprocessingRetainedCountBinary input) ++ + paperSourcePreprocessingFinalField 0 input + +/-- GapCVP reduction support. -/ +noncomputable def paperSourcePreprocessingFilteredFormulaWordComputable : + BitTM + paperPreprocessingFilteredFormulaWord := by + have count := GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingRetainedCountBinaryComputable + structuralPrefixWriterComputable + exact pointwiseAppendComputable count + (paperPreprocessingFinalFieldComputable 0) + +private def paperPreprocessingRecoveredOriginal : + List Bool → List Bool := + paperSourcePreprocessingOriginal ∘ + paperSourcePreprocessingFinalState + +private noncomputable def paperSourcePreprocessingRecoveredOriginalComputable : + BitTM + paperPreprocessingRecoveredOriginal := + GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingFinalStateComputable + paperSourcePreprocessingOriginalComputable + +/-- GapCVP reduction support. -/ +def paperSourcePreprocessingOutput (input : List Bool) : List Bool := + lengthPrefixedWord (paperPreprocessingFilteredFormulaWord input) ++ + (lengthPrefixedWord (paperSourcePreprocessingFinalField 1 input) ++ + paperPreprocessingRecoveredOriginal input) + +/-- GapCVP reduction support. -/ +noncomputable def paperSourcePreprocessingComputable : + BitTM + paperSourcePreprocessingOutput := by + have filtered := GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingFilteredFormulaWordComputable + structuralPrefixWriterComputable + have normalized := GapCVP.TMComposition.computableInPolyTime + (paperPreprocessingFinalFieldComputable 1) + structuralPrefixWriterComputable + exact pointwiseAppendComputable filtered + (pointwiseAppendComputable normalized + paperSourcePreprocessingRecoveredOriginalComputable) + +end SourcePreprocessingTM + +namespace SourcePreprocessingPairwiseIdentity + +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics + +private theorem sourceClauseIsTautology_pairwise + (clause : ThreeClause) : + sourceClauseIsTautology clause = + ((decide ((clause 0).1 = (clause 1).1) && + !(decide ((clause 0).2 = (clause 1).2))) || + ((decide ((clause 0).1 = (clause 2).1) && + !(decide ((clause 0).2 = (clause 2).2))) || + (decide ((clause 1).1 = (clause 2).1) && + !(decide ((clause 1).2 = (clause 2).2))))) := by + apply Bool.eq_iff_iff.mpr + constructor + · intro htautology + obtain ⟨left, right, hvariable, hsign⟩ := + (sourceClauseIsTautology_iff clause).mp htautology + have hor : + ((clause 0).1 = (clause 1).1 ∧ + (clause 0).2 ≠ (clause 1).2) ∨ + (((clause 0).1 = (clause 2).1 ∧ + (clause 0).2 ≠ (clause 2).2) ∨ + ((clause 1).1 = (clause 2).1 ∧ + (clause 1).2 ≠ (clause 2).2)) := by + fin_cases left <;> fin_cases right + · exact (hsign rfl).elim + · exact Or.inl ⟨hvariable, hsign⟩ + · exact Or.inr (Or.inl ⟨hvariable, hsign⟩) + · exact Or.inl ⟨hvariable.symm, Ne.symm hsign⟩ + · exact (hsign rfl).elim + · exact Or.inr (Or.inr ⟨hvariable, hsign⟩) + · exact Or.inr (Or.inl ⟨hvariable.symm, Ne.symm hsign⟩) + · exact Or.inr (Or.inr ⟨hvariable.symm, Ne.symm hsign⟩) + · exact (hsign rfl).elim + simpa only [Fin.isValue, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq, + Bool.not_eq_eq_eq_not, + Bool.not_true, decide_eq_false_iff_not, ne_eq] using hor + · intro hpair + have hor : + ((clause 0).1 = (clause 1).1 ∧ + (clause 0).2 ≠ (clause 1).2) ∨ + (((clause 0).1 = (clause 2).1 ∧ + (clause 0).2 ≠ (clause 2).2) ∨ + ((clause 1).1 = (clause 2).1 ∧ + (clause 1).2 ≠ (clause 2).2)) := by + simpa only [Fin.isValue, ne_eq, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq, + Bool.not_eq_eq_eq_not, + Bool.not_true, decide_eq_false_iff_not] using hpair + apply (sourceClauseIsTautology_iff clause).mpr + rcases hor with hfirst | hsecond | hthird + · exact ⟨0, 1, hfirst⟩ + · exact ⟨0, 2, hsecond⟩ + · exact ⟨1, 2, hthird⟩ + +theorem paperSourceEraseDupsThree_pairwise + (first second third : Literal) : + [first, second, third].eraseDups = + first :: + ((if first = second then [] else [second]) ++ + (if first = third ∨ second = third then [] else [third])) := by + classical + by_cases hfirst : first = second + · subst second + by_cases hsecond : first = third + · subst third + simp only [List.eraseDups_cons, BEq.rfl, Bool.not_true, Bool.false_eq_true, + not_false_eq_true, + List.filter_cons_of_neg, List.filter_nil, List.eraseDups_nil, ↓reduceIte, or_self, + List.append_nil] + · have hreverse := Ne.symm hsecond + simp only [List.eraseDups_cons, BEq.rfl, Bool.not_true, Bool.false_eq_true, + not_false_eq_true, + List.filter_cons_of_neg, Bool.not_eq_eq_eq_not, beq_eq_false_iff_ne, ne_eq, hreverse, + List.filter_cons_of_pos, + List.filter_nil, List.eraseDups_nil, ↓reduceIte, hsecond, or_self, List.nil_append] + · have hreverseFirst := Ne.symm hfirst + by_cases hsecond : first = third + · subst third + simp only [List.eraseDups_cons, Bool.not_eq_eq_eq_not, Bool.not_true, beq_eq_false_iff_ne, + ne_eq, + hreverseFirst, not_false_eq_true, List.filter_cons_of_pos, BEq.rfl, Bool.false_eq_true, + List.filter_cons_of_neg, + List.filter_nil, List.eraseDups_nil, hfirst, ↓reduceIte, or_false, List.append_nil] + · have hreverseSecond := Ne.symm hsecond + by_cases hthird : second = third + · subst third + simp only [List.eraseDups_cons, Bool.not_eq_eq_eq_not, Bool.not_true, beq_eq_false_iff_ne, + ne_eq, + hreverseFirst, not_false_eq_true, List.filter_cons_of_pos, List.filter_nil, BEq.rfl, + Bool.false_eq_true, + List.filter_cons_of_neg, List.eraseDups_nil, hfirst, ↓reduceIte, or_true, + List.append_nil] + · have hreverseThird := Ne.symm hthird + simp only [List.eraseDups_cons, Bool.not_eq_eq_eq_not, Bool.not_true, beq_eq_false_iff_ne, + ne_eq, + hreverseFirst, not_false_eq_true, List.filter_cons_of_pos, hreverseSecond, + List.filter_nil, hreverseThird, + List.eraseDups_nil, hfirst, ↓reduceIte, hsecond, hthird, or_self, List.cons_append, + List.nil_append] + +theorem paperSourceNormalizedClause_pairwise + (clause : ThreeClause) : + paperSourceNormalizedClause clause = + clause 0 :: + ((if clause 0 = clause 1 then [] else [clause 1]) ++ + (if clause 0 = clause 2 ∨ clause 1 = clause 2 + then [] else [clause 2])) := by + exact paperSourceEraseDupsThree_pairwise + (clause 0) (clause 1) (clause 2) + +private theorem paperSourceNormalizedClauseRecord_pairwise + (clause : ThreeClause) : + paperSourceNormalizedClauseRecord clause = + let literals := + clause 0 :: + ((if clause 0 = clause 1 then [] else [clause 1]) ++ + (if clause 0 = clause 2 ∨ clause 1 = clause 2 + then [] else [clause 2])) + List.replicate literals.length true ++ + false :: literals.flatMap encodeLiteral := by + simp only [paperSourceNormalizedClauseRecord, + paperSourceNormalizedClause_pairwise] + +end SourcePreprocessingPairwiseIdentity + +namespace SourcePreprocessingTM + +open GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceIndexedClauseLookupTM +open GapCVP.SourceIndexedClauseSignTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM GapCVP.BinaryDimensionTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.SourcePreprocessingPairwiseIdentity + +@[simp] private theorem paperSourceClauseLiteralWord_valid + (position : Fin 3) (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseLiteralWord position + (encodeThreeClause clause ++ suffix) = + encodeLiteral (clause position) := by + fin_cases position <;> + simp [paperSourceClauseLiteralWord, + paperSourceClauseLiteralSuffixAt, encodeThreeClause, + Function.comp_apply, List.append_assoc, + literalSuffix_valid, + sourceOriginalIndexedPhysicalLiteralOutput_valid] + +private theorem paperSourceClauseVariableWord_eq_literalField + (position : Fin 3) (input : List Bool) : + paperSourceClauseVariableWord position input = + firstFieldContents (paperSourceClauseLiteralWord position input) := by + unfold paperSourceClauseVariableWord paperSourceClauseLiteralWord + sourceOriginalIndexedPhysicalLiteralOutput + sourceOriginalIndexedLiteralVariableOutput + simp only [Function.comp_apply, firstFieldContents_valid] + +@[simp] theorem paperSourceClauseVariableWord_valid + (position : Fin 3) (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseVariableWord position + (encodeThreeClause clause ++ suffix) = + Computability.encodeNat (clause position).1 := by + rw [paperSourceClauseVariableWord_eq_literalField, + paperSourceClauseLiteralWord_valid] + simp only [encodeLiteral, firstFieldContents_valid] + +@[simp] theorem paperSourceClauseSignWord_valid + (position : Fin 3) (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseSignWord position + (encodeThreeClause clause ++ suffix) = + [(clause position).2] := by + fin_cases position <;> + simp [paperSourceClauseSignWord, + paperSourceClauseLiteralSuffixAt, encodeThreeClause, + Function.comp_apply, List.append_assoc, + literalSuffix_valid, + sourceOriginalIndexedLiteralSignOutput_valid] + +@[simp] private theorem paperSourceEncodeNat_eq_iff + (first second : ℕ) : + Computability.encodeNat first = Computability.encodeNat second ↔ + first = second := by + constructor + · intro heq + have hdecode := congrArg Computability.decodeNat heq + simpa only [Computability.decode_encodeNat] using hdecode + · intro heq + rw [heq] + +@[simp] private theorem paperSourceEncodeLiteral_eq_iff + (first second : Literal) : + encodeLiteral first = encodeLiteral second ↔ first = second := by + constructor + · intro heq + have hdecode := congrArg readLiteral heq + have hfirst : readLiteral (encodeLiteral first) = + some (first, []) := by + simpa only [List.append_nil] using readLiteral_append first [] + have hsecond : readLiteral (encodeLiteral second) = + some (second, []) := by + simpa only [List.append_nil] using readLiteral_append second [] + rw [hfirst, hsecond] at hdecode + exact congrArg Prod.fst (Option.some.inj hdecode) + · intro heq + rw [heq] + +@[simp] private theorem paperSourceClauseVariableEquality_valid + (first second : Fin 3) + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseVariableEquality first second + (encodeThreeClause clause ++ suffix) = + [decide ((clause first).1 = (clause second).1)] := by + unfold paperSourceClauseVariableEquality + rw [sourceQaryMaskSquareComputedWordEquality_valid, + paperSourceClauseVariableWord_valid, + paperSourceClauseVariableWord_valid] + simp only [paperSourceEncodeNat_eq_iff] + +@[simp] private theorem paperSourceClauseSignEquality_valid + (first second : Fin 3) + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseSignEquality first second + (encodeThreeClause clause ++ suffix) = + [decide ((clause first).2 = (clause second).2)] := by + unfold paperSourceClauseSignEquality + rw [sourceQaryMaskSquareComputedWordEquality_valid, + paperSourceClauseSignWord_valid, + paperSourceClauseSignWord_valid] + simp only [List.cons.injEq, and_true] + +@[simp] private theorem paperSourceClauseLiteralEquality_valid + (first second : Fin 3) + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseLiteralEquality first second + (encodeThreeClause clause ++ suffix) = + [decide (clause first = clause second)] := by + unfold paperSourceClauseLiteralEquality + rw [sourceQaryMaskSquareComputedWordEquality_valid, + paperSourceClauseLiteralWord_valid, + paperSourceClauseLiteralWord_valid] + simp only [paperSourceEncodeLiteral_eq_iff] + +private theorem paperSourceMarkerOr_bits + (first second : List Bool → List Bool) + (input : List Bool) (firstBit secondBit : Bool) + (hfirst : first input = [firstBit]) + (hsecond : second input = [secondBit]) : + paperSourceMarkerOr first second input = + [firstBit || secondBit] := by + exact GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM.fourFamilyBooleanOrOutput_bits + first second input firstBit secondBit hfirst hsecond + +@[simp] private theorem paperSourceClauseOppositePair_valid + (first second : Fin 3) + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseOppositePair first second + (encodeThreeClause clause ++ suffix) = + [decide ((clause first).1 = (clause second).1) && + !(decide ((clause first).2 = (clause second).2))] := by + unfold paperSourceClauseOppositePair + have hvariable := paperSourceClauseVariableEquality_valid + first second clause suffix + have hsign := paperSourceClauseSignEquality_valid + first second clause suffix + have hnot := fourFamilyBooleanNotOutput_bit + (paperSourceClauseSignEquality first second) + (encodeThreeClause clause ++ suffix) + (decide ((clause first).2 = (clause second).2)) hsign + exact fourFamilyBooleanAndOutput_bits + (paperSourceClauseVariableEquality first second) + (sourceFourFamilyBooleanNotOutput + (paperSourceClauseSignEquality first second)) + (encodeThreeClause clause ++ suffix) + (decide ((clause first).1 = (clause second).1)) + (!(decide ((clause first).2 = (clause second).2))) + hvariable hnot + +@[simp] private theorem paperSourceClauseTautologyMarker_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseTautologyMarker + (encodeThreeClause clause ++ suffix) = + [sourceClauseIsTautology clause] := by + unfold paperSourceClauseTautologyMarker + rw [paperSourceMarkerOr_bits + (paperSourceClauseOppositePair 0 1) + (paperSourceMarkerOr (paperSourceClauseOppositePair 0 2) + (paperSourceClauseOppositePair 1 2)) + (encodeThreeClause clause ++ suffix) + (decide ((clause 0).1 = (clause 1).1) && + !(decide ((clause 0).2 = (clause 1).2))) + ((decide ((clause 0).1 = (clause 2).1) && + !(decide ((clause 0).2 = (clause 2).2))) || + (decide ((clause 1).1 = (clause 2).1) && + !(decide ((clause 1).2 = (clause 2).2)))) + (paperSourceClauseOppositePair_valid 0 1 clause suffix) + (paperSourceMarkerOr_bits + (paperSourceClauseOppositePair 0 2) + (paperSourceClauseOppositePair 1 2) + (encodeThreeClause clause ++ suffix) + (decide ((clause 0).1 = (clause 2).1) && + !(decide ((clause 0).2 = (clause 2).2))) + (decide ((clause 1).1 = (clause 2).1) && + !(decide ((clause 1).2 = (clause 2).2))) + (paperSourceClauseOppositePair_valid 0 2 clause suffix) + (paperSourceClauseOppositePair_valid 1 2 clause suffix))] + rw [sourceClauseIsTautology_pairwise] + +@[simp] private theorem paperSourceClauseRetainMarker_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseRetainMarker + (encodeThreeClause clause ++ suffix) = + [!(sourceClauseIsTautology clause)] := by + unfold paperSourceClauseRetainMarker + exact fourFamilyBooleanNotOutput_bit + paperSourceClauseTautologyMarker + (encodeThreeClause clause ++ suffix) + (sourceClauseIsTautology clause) + (paperSourceClauseTautologyMarker_valid clause suffix) + +@[simp] theorem paperSourceClauseSecondKeepMarker_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseSecondKeepMarker + (encodeThreeClause clause ++ suffix) = + [!(decide (clause 0 = clause 1))] := by + unfold paperSourceClauseSecondKeepMarker + exact fourFamilyBooleanNotOutput_bit + (paperSourceClauseLiteralEquality 0 1) + (encodeThreeClause clause ++ suffix) + (decide (clause 0 = clause 1)) + (paperSourceClauseLiteralEquality_valid 0 1 clause suffix) + +@[simp] private theorem paperSourceClauseThirdKeepMarker_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseThirdKeepMarker + (encodeThreeClause clause ++ suffix) = + [(!(decide (clause 0 = clause 2))) && + (!(decide (clause 1 = clause 2)))] := by + unfold paperSourceClauseThirdKeepMarker + have hfirst := fourFamilyBooleanNotOutput_bit + (paperSourceClauseLiteralEquality 0 2) + (encodeThreeClause clause ++ suffix) + (decide (clause 0 = clause 2)) + (paperSourceClauseLiteralEquality_valid 0 2 clause suffix) + have hsecond := fourFamilyBooleanNotOutput_bit + (paperSourceClauseLiteralEquality 1 2) + (encodeThreeClause clause ++ suffix) + (decide (clause 1 = clause 2)) + (paperSourceClauseLiteralEquality_valid 1 2 clause suffix) + exact fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput + (paperSourceClauseLiteralEquality 0 2)) + (sourceFourFamilyBooleanNotOutput + (paperSourceClauseLiteralEquality 1 2)) + (encodeThreeClause clause ++ suffix) + (!(decide (clause 0 = clause 2))) + (!(decide (clause 1 = clause 2))) hfirst hsecond + +@[simp] private theorem paperSourceClauseOriginalRecord_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseOriginalRecord + (encodeThreeClause clause ++ suffix) = + encodeThreeClause clause := by + exact sourceOriginalIndexedPhysicalThreeClauseOutput_valid clause suffix + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem paperSourceClauseNormalizedRecord_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceClauseNormalizedRecord + (encodeThreeClause clause ++ suffix) = + paperSourceNormalizedClauseRecord clause := by + unfold paperSourceClauseNormalizedRecord + paperSourceClauseSecondKeepUnary + paperSourceClauseThirdKeepUnary + paperClauseSelectedSecondLiteral + paperClauseSelectedThirdLiteral + rw [paperSourceClauseSecondKeepMarker_valid, + paperSourceClauseThirdKeepMarker_valid, + paperSourceClauseLiteralWord_valid, + paperSourceClauseLiteralWord_valid, + paperSourceClauseLiteralWord_valid, + paperSourceNormalizedClauseRecord_pairwise] + by_cases hfirst : clause 0 = clause 1 <;> + by_cases hsecond : clause 0 = clause 2 <;> + by_cases hthird : clause 1 = clause 2 <;> + simp_all + +@[simp] private theorem paperSourceRetainedOriginalClause_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceRetainedOriginalClause + (encodeThreeClause clause ++ suffix) = + if sourceClauseIsTautology clause then [] + else encodeThreeClause clause := by + unfold paperSourceRetainedOriginalClause + rw [paperSourceClauseRetainMarker_valid] + cases htautology : sourceClauseIsTautology clause <;> + simp_all [paperSourceClauseOriginalRecord_valid] + +@[simp] private theorem paperSourceRetainedNormalizedClause_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceRetainedNormalizedClause + (encodeThreeClause clause ++ suffix) = + if sourceClauseIsTautology clause then [] + else paperSourceNormalizedClauseRecord clause := by + unfold paperSourceRetainedNormalizedClause + rw [paperSourceClauseRetainMarker_valid] + cases htautology : sourceClauseIsTautology clause <;> + simp_all [paperSourceClauseNormalizedRecord_valid] + +@[simp] private theorem paperSourceRetainedClauseUnary_valid + (clause : ThreeClause) (suffix : List Bool) : + paperSourceRetainedClauseUnary + (encodeThreeClause clause ++ suffix) = + if sourceClauseIsTautology clause then [] else [true] := by + unfold paperSourceRetainedClauseUnary + rw [paperSourceClauseRetainMarker_valid] + cases htautology : sourceClauseIsTautology clause <;> + simp_all + +private theorem paperSourcePreprocessingStep_valid_cons + (formula : ThreeCNF) + (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) + (clause : ThreeClause) (pending : ThreeCNF) : + paperSourcePreprocessingStep + (paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount + (clause :: pending)) = + if sourceClauseIsTautology clause then + paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount pending + else + paperSourcePreprocessingValidState formula + (originalBody ++ encodeThreeClause clause) + (normalizedBody ++ paperSourceNormalizedClauseRecord clause) + (retainedCount + 1) pending := by + unfold paperSourcePreprocessingStep + paperPreprocessingNextOriginalBody + paperPreprocessingNextNormalizedBody + paperPreprocessingNextClauseCount + paperSourcePreprocessingNextPending + paperSourcePreprocessingCurrent + simp only [Function.comp_apply, + paperSourcePreprocessingField_valid_zero, + paperSourcePreprocessingField_valid_one, + paperSourcePreprocessingField_valid_two, + paperSourcePreprocessingField_valid_three, + paperSourcePreprocessingField_valid_four, + paperSourcePreprocessingOriginal_valid, + List.flatMap_cons, + paperSourceRetainedOriginalClause_valid, + paperSourceRetainedNormalizedClause_valid, + paperSourceRetainedClauseUnary_valid, + clauseSuffix_valid] + cases htautology : sourceClauseIsTautology clause <;> + simp_all [paperSourcePreprocessingValidState, List.replicate_succ] + +private theorem paperSourcePreprocessingStep_iterate_valid + (formula : ThreeCNF) + (originalBody normalizedBody : List Bool) + (retainedCount : ℕ) (pending : ThreeCNF) : + ((paperSourcePreprocessingStep^[pending.length]) + (paperSourcePreprocessingValidState + formula originalBody normalizedBody retainedCount pending)) = + paperSourcePreprocessingValidState formula + (originalBody ++ + (noTautClauses pending).flatMap + encodeThreeClause) + (normalizedBody ++ paperSourceNormalizedClauseStream pending) + (retainedCount + + (noTautClauses pending).length) + [] := by + induction pending generalizing originalBody normalizedBody + retainedCount with + | nil => + simp only [List.length_nil, Function.iterate_zero, id_eq, noTautClauses, List.filter_nil, + List.flatMap_nil, + List.append_nil, paperSourceNormalizedClauseStream, add_zero] + | cons clause remaining ih => + simp only [List.length_cons] + rw [Function.iterate_succ_apply, + paperSourcePreprocessingStep_valid_cons] + cases htautology : sourceClauseIsTautology clause with + | false => + simp only [Bool.false_eq_true, ite_false] + rw [ih] + simp only [noTautClauses, List.append_assoc, paperSourceNormalizedClauseStream, + Nat.add_assoc, htautology, + Bool.not_false, List.filter_cons_of_pos, List.flatMap_cons, List.length_cons, + Nat.add_comm] + | true => + simp only [ite_true] + rw [ih] + simp only [noTautClauses, paperSourceNormalizedClauseStream, htautology, Bool.not_true, + Bool.false_eq_true, + not_false_eq_true, List.filter_cons_of_neg] + +@[simp] private theorem paperSourcePreprocessingSeed_valid + (formula : ThreeCNF) : + paperSourcePreprocessingSeed (encodeThreeCNF formula) = + paperSourcePreprocessingValidState + formula [] [] 0 formula := by + simp only [paperSourcePreprocessingSeed, encodeThreeCNF, firstFieldSuffix_valid, + paperSourcePreprocessingValidState, List.replicate_zero] + +@[simp] private theorem paperSourcePreprocessingPreparation_valid + (formula : ThreeCNF) : + paperSourcePreprocessingPreparation (encodeThreeCNF formula) = + unaryBoundedFoldWord formula.length + (paperSourcePreprocessingValidState + formula [] [] 0 formula) := by + unfold paperSourcePreprocessingPreparation + rw [sourceClauseCountUnary_valid, + paperSourcePreprocessingSeed_valid] + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem paperSourcePreprocessingFinalState_valid + (formula : ThreeCNF) : + paperSourcePreprocessingFinalState (encodeThreeCNF formula) = + paperSourcePreprocessingValidState formula + ((noTautClauses formula).flatMap + encodeThreeClause) + (paperSourceNormalizedClauseStream formula) + (noTautClauses formula).length + [] := by + unfold paperSourcePreprocessingFinalState + rw [Function.comp_apply, + paperSourcePreprocessingPreparation_valid] + simp only [boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + simpa only [List.nil_append, Nat.zero_add] using + paperSourcePreprocessingStep_iterate_valid formula [] [] 0 formula + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem paperSourcePreprocessingFinalOriginalBody_valid + (formula : ThreeCNF) : + paperSourcePreprocessingFinalField 0 + (encodeThreeCNF formula) = + (noTautClauses formula).flatMap + encodeThreeClause := by + unfold paperSourcePreprocessingFinalField + rw [Function.comp_apply, + paperSourcePreprocessingFinalState_valid, + paperSourcePreprocessingField_valid_zero] + +@[simp] private theorem paperSourcePreprocessingFinalNormalizedBody_valid + (formula : ThreeCNF) : + paperSourcePreprocessingFinalField 1 + (encodeThreeCNF formula) = + paperSourceNormalizedClauseStream formula := by + unfold paperSourcePreprocessingFinalField + rw [Function.comp_apply, + paperSourcePreprocessingFinalState_valid, + paperSourcePreprocessingField_valid_one] + +@[simp] private theorem paperSourcePreprocessingRetainedCountBinary_valid + (formula : ThreeCNF) : + paperPreprocessingRetainedCountBinary + (encodeThreeCNF formula) = + Computability.encodeNat + (noTautClauses formula).length := by + unfold paperPreprocessingRetainedCountBinary + paperSourcePreprocessingFinalField + rw [Function.comp_apply, Function.comp_apply, + paperSourcePreprocessingFinalState_valid, + paperSourcePreprocessingField_valid_two] + simp only [List.length_replicate] + +@[simp] theorem paperSourcePreprocessingFilteredFormulaWord_valid + (formula : ThreeCNF) : + paperPreprocessingFilteredFormulaWord + (encodeThreeCNF formula) = + encodeThreeCNF (noTautClauses formula) := by + unfold paperPreprocessingFilteredFormulaWord + rw [paperSourcePreprocessingRetainedCountBinary_valid, + paperSourcePreprocessingFinalOriginalBody_valid] + rfl + +@[simp] private theorem paperSourcePreprocessingRecoveredOriginal_valid + (formula : ThreeCNF) : + paperPreprocessingRecoveredOriginal + (encodeThreeCNF formula) = + encodeThreeCNF formula := by + unfold paperPreprocessingRecoveredOriginal + rw [Function.comp_apply, + paperSourcePreprocessingFinalState_valid, + paperSourcePreprocessingOriginal_valid] + +theorem paperSourcePreprocessingOutput_valid + (formula : ThreeCNF) : + paperSourcePreprocessingOutput (encodeThreeCNF formula) = + lengthPrefixedWord + (encodeThreeCNF (noTautClauses formula)) ++ + (lengthPrefixedWord + (paperSourceNormalizedClauseStream formula) ++ + encodeThreeCNF formula) := by + unfold paperSourcePreprocessingOutput + rw [paperSourcePreprocessingFilteredFormulaWord_valid, + paperSourcePreprocessingFinalNormalizedBody_valid, + paperSourcePreprocessingRecoveredOriginal_valid] + +end SourcePreprocessingTM + +namespace NormalizedRecordDecoder + +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics GapCVP.SourcePreprocessingTM + +private def readPaperVariableArityLiterals : + ℕ → List Bool → Option (List Literal × List Bool) + | 0, bits => some ([], bits) + | count + 1, bits => + match readLiteral bits with + | none => none + | some (literal, remaining) => + match readPaperVariableArityLiterals count remaining with + | none => none + | some (literals, suffix) => + some (literal :: literals, suffix) + +@[simp] private theorem readPaperVariableArityLiterals_flatMap + (literals : List Literal) (suffix : List Bool) : + readPaperVariableArityLiterals literals.length + (literals.flatMap encodeLiteral ++ suffix) = + some (literals, suffix) := by + induction literals with + | nil => simp only [List.length_nil, List.flatMap_nil, List.nil_append, + readPaperVariableArityLiterals] + | cons literal remaining ih => + simp only [List.length_cons, List.flatMap_cons, List.append_assoc, + readPaperVariableArityLiterals, + readLiteral_append, ih] + +private def readPaperVariableArityClauseRecord + (bits : List Bool) : Option (List Literal × List Bool) := + match readUnaryPrefix bits with + | none => none + | some (count, remaining) => + if 0 < count ∧ count ≤ 3 then + readPaperVariableArityLiterals count remaining + else + none + +@[simp] private theorem readPaperVariableArityClauseRecord_append + (clause : ThreeClause) (suffix : List Bool) : + readPaperVariableArityClauseRecord + (paperSourceNormalizedClauseRecord clause ++ suffix) = + some (paperSourceNormalizedClause clause, suffix) := by + have hpositive : + 0 < (paperSourceNormalizedClause clause).length := + List.length_pos_iff.mpr + (paperSourceNormalizedClause_ne_nil clause) + have hbound := paperNormalizedClause_length_le_three clause + unfold readPaperVariableArityClauseRecord + simp only [paperSourceNormalizedClauseRecord, List.append_assoc, List.cons_append, + readUnaryPrefix_replicate, + hpositive, hbound, and_self, ↓reduceIte, readPaperVariableArityLiterals_flatMap] + +private def readPaperVariableArityClauseRecords : + ℕ → List Bool → Option (List (List Literal) × List Bool) + | 0, bits => some ([], bits) + | count + 1, bits => + match readPaperVariableArityClauseRecord bits with + | none => none + | some (clause, remaining) => + match readPaperVariableArityClauseRecords count remaining with + | none => none + | some (clauses, suffix) => some (clause :: clauses, suffix) + +@[simp] private theorem readPaperVariableArityClauseRecords_flatMap + (clauses : List ThreeClause) (suffix : List Bool) : + readPaperVariableArityClauseRecords clauses.length + (clauses.flatMap paperSourceNormalizedClauseRecord ++ suffix) = + some (clauses.map paperSourceNormalizedClause, suffix) := by + induction clauses with + | nil => simp only [List.length_nil, List.flatMap_nil, List.nil_append, + readPaperVariableArityClauseRecords, + List.map_nil] + | cons clause remaining ih => + simp only [List.length_cons, List.flatMap_cons, List.append_assoc, + readPaperVariableArityClauseRecords, + readPaperVariableArityClauseRecord_append, ih, List.map_cons] + +@[simp] private theorem readPaperVariableArityClauseRecords_normalizedStream + (formula : ThreeCNF) : + readPaperVariableArityClauseRecords + (noTautClauses formula).length + (paperSourceNormalizedClauseStream formula) = + some (paperSourceNormalizedClauses formula, []) := by + simpa only [paperSourceNormalizedClauseStream, paperSourceNormalizedClauses, List.append_nil] + using + readPaperVariableArityClauseRecords_flatMap (noTautClauses formula) [] + +/-- GapCVP reduction support. -/ +structure PaperVariableArityNormalizedSourceDescriptor where + /-- GapCVP reduction support. -/ + retainedFormula : ThreeCNF + /-- GapCVP reduction support. -/ + normalizedClauses : List (List Literal) + /-- GapCVP reduction support. -/ + originalFormula : ThreeCNF + /-- GapCVP reduction support. -/ + originalWord : List Bool + +/-- GapCVP reduction support. -/ +def readPaperVariableArityNormalizedSourceDescriptor + (bits : List Bool) : + Option PaperVariableArityNormalizedSourceDescriptor := + match readLengthPrefixedWord bits with + | none => none + | some (retainedWord, suffix) => + match readLengthPrefixedWord suffix with + | none => none + | some (normalizedWord, originalWord) => + match decodeThreeCNF retainedWord, decodeThreeCNF originalWord with + | some retained, some original => + if encodeThreeCNF retained = retainedWord ∧ + encodeThreeCNF original = originalWord then + match readPaperVariableArityClauseRecords + retained.length normalizedWord with + | some (normalized, []) => + if retained = noTautClauses original ∧ + normalized = paperSourceNormalizedClauses original then + some + { retainedFormula := retained + normalizedClauses := normalized + originalFormula := original + originalWord := originalWord } + else + none + | _ => none + else + none + | _, _ => none + +@[simp] theorem readPaperVariableArityNormalizedSourceDescriptor_valid + (formula : ThreeCNF) : + readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput + (encodeThreeCNF formula)) = + some + { retainedFormula := noTautClauses formula + normalizedClauses := paperSourceNormalizedClauses formula + originalFormula := formula + originalWord := encodeThreeCNF formula } := by + rw [paperSourcePreprocessingOutput_valid] + unfold readPaperVariableArityNormalizedSourceDescriptor + simp only [readLengthPrefixedWord_append, decodeThreeCNF_encode, and_self, ↓reduceIte, + readPaperVariableArityClauseRecords_normalizedStream] + +@[simp] theorem readPaperVariableArityNormalizedSourceDescriptor_retainedCount + (formula : ThreeCNF) : + (paperSourceNormalizedClauses formula).length = + (noTautClauses formula).length := by + simp only [paperSourceNormalizedClauses, List.length_map] + +end NormalizedRecordDecoder + +namespace ClauseCardinality + +open GapCVP.SourcePreprocessingSemantics GapCVP.BinarySourceTautologyNormalizationExact + +private theorem paperVariableArity_retainedClause_signed_nodup + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + clause.Nodup := by + obtain ⟨original, _, horiginal⟩ := + (mem_paperSourceNormalizedClauses_iff formula clause).mp hclause + rw [← horiginal] + exact paperSourceNormalizedClause_nodup original + +private theorem paperVariableArity_retainedClause_fst_injective + (formula : ThreeCNF) (clause : List Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (first : Literal) (hfirst : first ∈ clause) + (second : Literal) (hsecond : second ∈ clause) + (hname : first.1 = second.1) : + first = second := by + obtain ⟨original, hretained, horiginal⟩ := + (mem_paperSourceNormalizedClauses_iff formula clause).mp hclause + have hfirstSource : first ∈ paperSourceNormalizedClause original := by + rw [horiginal] + exact hfirst + have hsecondSource : second ∈ paperSourceNormalizedClause original := by + rw [horiginal] + exact hsecond + obtain ⟨firstIndex, hfirstIndex⟩ := + (mem_paperSourceNormalizedClause_iff original first).mp hfirstSource + obtain ⟨secondIndex, hsecondIndex⟩ := + (mem_paperSourceNormalizedClause_iff original second).mp hsecondSource + by_cases hsign : first.2 = second.2 + · exact Prod.ext hname hsign + · have htautology : sourceClauseIsTautology original = true := by + apply (sourceClauseIsTautology_iff original).mpr + refine ⟨firstIndex, secondIndex, ?_, ?_⟩ + · simpa only [hfirstIndex, hsecondIndex] using hname + · simpa only [hfirstIndex, hsecondIndex, ne_eq] using hsign + have hnot := + ((mem_sourceClausesWithoutTautologies formula original).mp + hretained).2 + rw [hnot] at htautology + contradiction + +end ClauseCardinality + +namespace SourceOrder + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryFieldBasis GapCVP.BinarySourceCoordinateOrder +open GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryOrderedAssembly +open GapCVP.BinaryOrderedRefinement GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge +open GapCVP.ClauseCardinality + +/-- GapCVP reduction support. -/ +def paperVariableArityBooleanWordOrder (arity : ℕ) : + Fin (2 ^ arity) ≃ (Fin arity → Bool) := by + classical + refine Equiv.ofBijective (indexedWord arity) ?_ + apply (Fintype.bijective_iff_injective_and_card _).2 + refine ⟨indexedWord_injective arity, ?_⟩ + simp only [Fintype.card_fin, Fintype.card_pi, Fintype.card_bool, Finset.prod_const, + Finset.card_univ] + +/-- GapCVP reduction support. -/ +def paperVariableArityRejectedWord + (arity : ℕ) (sign : Fin arity → Bool) : Fin (2 ^ arity) := + (paperVariableArityBooleanWordOrder arity).symm + (fun index => Bool.not (sign index)) + +private theorem paperVariableArityWord_ne_rejected_iff + (arity : ℕ) (sign : Fin arity → Bool) (word : Fin (2 ^ arity)) : + word ≠ paperVariableArityRejectedWord arity sign ↔ + ∃ index : Fin arity, + paperVariableArityBooleanWordOrder arity word index = sign index := by + let rejected : Fin arity → Bool := fun index => Bool.not (sign index) + have neverSatisfied : + ¬ ∃ index : Fin arity, rejected index = sign index := by + rintro ⟨index, hequal⟩ + change Bool.not (sign index) = sign index at hequal + cases hsign : sign index <;> simp [hsign] at hequal + constructor + · intro different + by_contra noneSatisfied + apply different + apply (paperVariableArityBooleanWordOrder arity).injective + have allOpposite : + paperVariableArityBooleanWordOrder arity word = rejected := by + funext index + change + paperVariableArityBooleanWordOrder arity word index = + Bool.not (sign index) + apply Bool.eq_not_iff.mpr + intro hequal + exact noneSatisfied ⟨index, hequal⟩ + simpa only [paperVariableArityRejectedWord, Equiv.apply_symm_apply] using allOpposite + · rintro ⟨index, hsatisfies⟩ hequal + have wordIsRejected : + paperVariableArityBooleanWordOrder arity word = rejected := by + subst word + simp only [paperVariableArityRejectedWord, Equiv.apply_symm_apply, rejected] + exact neverSatisfied ⟨index, wordIsRejected ▸ hsatisfies⟩ + +/-- GapCVP reduction support. -/ +def paperSatisfyingWordOrder + (arity : ℕ) (sign : Fin arity → Bool) : + Fin (2 ^ arity - 1) ≃ + {assignment : Fin arity → Bool // + ∃ index : Fin arity, assignment index = sign index} := by + have positive : 0 < 2 ^ arity := by positivity + have cardinality : 2 ^ arity - 1 + 1 = 2 ^ arity := by omega + let correction : + Fin (2 ^ arity - 1 + 1) ≃ Fin (2 ^ arity) := + finCongr cardinality + let removed : Fin (2 ^ arity - 1 + 1) := + correction.symm (paperVariableArityRejectedWord arity sign) + refine (finSuccAboveEquiv removed).trans ?_ + refine Equiv.subtypeEquiv + (correction.trans (paperVariableArityBooleanWordOrder arity)) ?_ + intro word + change word ≠ removed ↔ + ∃ index : Fin arity, + paperVariableArityBooleanWordOrder arity (correction word) index = + sign index + constructor + · intro different + apply (paperVariableArityWord_ne_rejected_iff + arity sign (correction word)).mp + intro equal + apply different + apply correction.injective + simpa [removed] using equal + · intro satisfied equal + have different := (paperVariableArityWord_ne_rejected_iff + arity sign (correction word)).mpr satisfied + apply different + simpa [removed] using congrArg correction equal + +private theorem paperVariableAritySourceLiteral_mem_sourceClause + (formula : ThreeCNF) (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (literal : GapCVP.Literal) (hliteral : literal ∈ clause) : + paperVariableAritySourceLiteral + formula clause hclause literal hliteral ∈ + (paperVariableAritySourceClause formula clause hclause).literals := by + simp only [paperVariableAritySourceClause] + exact List.mem_toFinset.mpr + (List.mem_map.mpr + ⟨⟨literal, hliteral⟩, List.mem_attach _ _, rfl⟩) + +private def paperLocalVariableEmbedding + (formula : ThreeCNF) (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + Fin clause.length ↪ + (paperVariableAritySourceClause formula clause hclause).LocalVariable where + toFun index := + ⟨(paperVariableAritySourceLiteral formula clause hclause + (clause.get index) (List.get_mem clause index)).variableIndex, + Finset.mem_image_of_mem + (fun literal : GapCVP.Core.Literal + (paperVariableArityVariableCount formula) => literal.variableIndex) + (paperVariableAritySourceLiteral_mem_sourceClause formula clause hclause + (clause.get index) (List.get_mem clause index))⟩ + inj' := by + intro first second hequal + have hrank := congrArg + (fun localVariable : + (paperVariableAritySourceClause formula clause hclause).LocalVariable => + localVariable.val.val) hequal + change + paperVariableArityVariableRank formula (clause.get first).1 = + paperVariableArityVariableRank formula (clause.get second).1 at hrank + have hfirstMem : + (clause.get first).1 ∈ paperNormalizedOccurringVariables formula := by + apply List.idxOf_lt_length_iff.mp + exact paperVariableArityVariableRank_lt + formula clause hclause (clause.get first) (List.get_mem clause first) + have hname : (clause.get first).1 = (clause.get second).1 := by + apply (List.idxOf_inj hfirstMem).mp + exact hrank + have hliteral : clause.get first = clause.get second := + paperVariableArity_retainedClause_fst_injective + formula clause hclause + (clause.get first) (List.get_mem clause first) + (clause.get second) (List.get_mem clause second) hname + apply Fin.ext + calc + first.val = clause.idxOf (clause.get first) := + (List.get_idxOf + (paperVariableArity_retainedClause_signed_nodup + formula clause hclause) first).symm + _ = clause.idxOf (clause.get second) := congrArg clause.idxOf hliteral + _ = second.val := + List.get_idxOf + (paperVariableArity_retainedClause_signed_nodup + formula clause hclause) second + +private theorem paperVariableArityLocalVariableEmbedding_surjective + (formula : ThreeCNF) (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + Function.Surjective + (paperLocalVariableEmbedding formula clause hclause) := by + intro localVariable + obtain ⟨literal, hliteral, hvariable⟩ := + Finset.mem_image.mp localVariable.property + simp only [paperVariableAritySourceClause] at hliteral + obtain ⟨item, _, hequal⟩ := + List.mem_map.mp (List.mem_toFinset.mp hliteral) + obtain ⟨index, hindex⟩ := List.mem_iff_get.mp item.property + refine ⟨index, ?_⟩ + apply Subtype.ext + change + (paperVariableAritySourceLiteral formula clause hclause + (clause.get index) (List.get_mem clause index)).variableIndex = + localVariable.val + have hsource : + paperVariableAritySourceLiteral formula clause hclause + (clause.get index) (List.get_mem clause index) = literal := by + have hitem : + (⟨clause.get index, List.get_mem clause index⟩ : + {retained : GapCVP.Literal // retained ∈ clause}) = item := + Subtype.ext hindex + exact (congrArg + (fun retained : {retained : GapCVP.Literal // retained ∈ clause} => + paperVariableAritySourceLiteral formula clause hclause + retained.val retained.property) hitem).trans hequal + exact (congrArg + (fun source : GapCVP.Core.Literal + (paperVariableArityVariableCount formula) => source.variableIndex) + hsource).trans hvariable + +/-- GapCVP reduction support. -/ +def paperLocalVariableWordOrder + (formula : ThreeCNF) (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + Fin clause.length ≃ + (paperVariableAritySourceClause formula clause hclause).LocalVariable := + Equiv.ofBijective + (paperLocalVariableEmbedding formula clause hclause) + ⟨(paperLocalVariableEmbedding + formula clause hclause).injective, + paperVariableArityLocalVariableEmbedding_surjective + formula clause hclause⟩ + +/-- GapCVP reduction support. -/ +def paperLocalAssignmentWordOrder + (formula : ThreeCNF) (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + (paperVariableAritySourceClause formula clause hclause).LocalAssignment ≃ + (Fin clause.length → Bool) := + Equiv.arrowCongr + (paperLocalVariableWordOrder formula clause hclause).symm + (Equiv.refl Bool) + +theorem paperVariableAritySourceClause_localSatisfied_iff + (formula : ThreeCNF) (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (assignment : + (paperVariableAritySourceClause formula clause hclause).LocalAssignment) : + (paperVariableAritySourceClause + formula clause hclause).LocalSatisfied assignment ↔ + ∃ index : Fin clause.length, + paperLocalAssignmentWordOrder + formula clause hclause assignment index = + (clause.get index).2 := by + simp only [GapCVP.Core.Clause.LocalSatisfied, decide_eq_true_eq] at * + constructor + · rintro ⟨literal, hliteral, hsatisfied⟩ + simp only [paperVariableAritySourceClause] at hliteral + obtain ⟨item, _, hequal⟩ := + List.mem_map.mp (List.mem_toFinset.mp hliteral) + subst literal + obtain ⟨index, hindex⟩ := List.mem_iff_get.mp item.property + have hitem : + (⟨clause.get index, List.get_mem clause index⟩ : + {retained : GapCVP.Literal // retained ∈ clause}) = item := + Subtype.ext hindex + subst item + refine ⟨index, ?_⟩ + simpa only [paperLocalAssignmentWordOrder, paperLocalVariableWordOrder, + paperLocalVariableEmbedding, + paperVariableAritySourceLiteral, List.get_eq_getElem, Function.Embedding.coeFn_mk, + Equiv.arrowCongr_apply, + Equiv.coe_refl, Equiv.symm_symm, Equiv.coe_ofBijective, Function.comp_apply, id_eq] + using hsatisfied + · rintro ⟨index, hsatisfied⟩ + refine ⟨paperVariableAritySourceLiteral formula clause hclause + (clause.get index) (List.get_mem clause index), + paperVariableAritySourceLiteral_mem_sourceClause + formula clause hclause (clause.get index) + (List.get_mem clause index), ?_⟩ + simpa only [paperVariableAritySourceLiteral, List.get_eq_getElem, + paperLocalAssignmentWordOrder, + paperLocalVariableWordOrder, paperLocalVariableEmbedding, Function.Embedding.coeFn_mk, + Equiv.arrowCongr_apply, + Equiv.coe_refl, Equiv.symm_symm, Equiv.coe_ofBijective, Function.comp_apply, id_eq] + using hsatisfied + +/-- GapCVP reduction support. -/ +def paperVariableAritySatisfyingLocalTupleWordEquiv + (formula : ThreeCNF) (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + (paperVariableAritySourceClause + formula clause hclause).SatisfyingLocalTuple ≃ + {assignment : Fin clause.length → Bool // + ∃ index : Fin clause.length, + assignment index = (clause.get index).2} := + Equiv.subtypeEquiv + (paperLocalAssignmentWordOrder formula clause hclause) + (paperVariableAritySourceClause_localSatisfied_iff + formula clause hclause) + +/-- GapCVP reduction support. -/ +def sourceClauseTupleWordOrder + (formula : ThreeCNF) (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) : + Fin (2 ^ clause.length - 1) ≃ + (paperVariableAritySourceClause + formula clause hclause).SatisfyingLocalTuple := + (paperSatisfyingWordOrder + clause.length (fun index => (clause.get index).2)).trans + (paperVariableAritySatisfyingLocalTupleWordEquiv + formula clause hclause).symm + +/-- GapCVP reduction support. -/ +abbrev paperFormulaRetainedClause + (formula : ThreeCNF) + (index : Fin (srcFormula formula).clauses.length) : + {clause : List GapCVP.Literal // + clause ∈ paperSourceNormalizedClauses formula} := by + have hlength : + (srcFormula formula).clauses.length = + (paperSourceNormalizedClauses formula).attach.length := by + simp only [srcFormula, List.length_map, List.length_attach, + NormalizedRecordDecoder.readPaperVariableArityNormalizedSourceDescriptor_retainedCount] + exact (paperSourceNormalizedClauses formula).attach.get + (Fin.cast hlength index) + +theorem paperFormulaRetainedClause_sourceClause + (formula : ThreeCNF) + (index : Fin (srcFormula formula).clauses.length) : + paperVariableAritySourceClause formula + (paperFormulaRetainedClause formula index).val + (paperFormulaRetainedClause formula index).property = + (srcFormula formula).clauses.get index := by + simp only [paperFormulaRetainedClause, srcFormula, List.get_eq_getElem, Fin.val_cast, + List.getElem_attach, + List.getElem_map] + +/-- GapCVP reduction support. -/ +def paperFormulaClauseWidth + (formula : ThreeCNF) + (index : Fin (srcFormula formula).clauses.length) : ℕ := + (paperFormulaRetainedClause formula index).val.length + +/-- GapCVP reduction support. -/ +def paperFormulaClauseTupleWordOrder + (formula : ThreeCNF) + (index : Fin (srcFormula formula).clauses.length) : + Fin (2 ^ paperFormulaClauseWidth formula index - 1) ≃ + ((srcFormula + formula).clauses.get index).SatisfyingLocalTuple := by + let retained := paperFormulaRetainedClause formula index + have hequal : + paperVariableAritySourceClause + formula retained.val retained.property = + (srcFormula formula).clauses.get index := + paperFormulaRetainedClause_sourceClause formula index + change Fin (2 ^ retained.val.length - 1) ≃ _ + exact hequal ▸ sourceClauseTupleWordOrder + formula retained.val retained.property + +/-- GapCVP reduction support. -/ +def paperFormulaClauseVariableWordOrder + (formula : ThreeCNF) + (index : Fin (srcFormula formula).clauses.length) : + Fin (paperFormulaClauseWidth formula index) ≃ + ((srcFormula + formula).clauses.get index).LocalVariable := by + let retained := paperFormulaRetainedClause formula index + have hequal : + paperVariableAritySourceClause + formula retained.val retained.property = + (srcFormula formula).clauses.get index := + paperFormulaRetainedClause_sourceClause formula index + change Fin retained.val.length ≃ _ + exact hequal ▸ paperLocalVariableWordOrder + formula retained.val retained.property + +/-- GapCVP reduction support. -/ +def paperVariableArityLocalTagCount (formula : ThreeCNF) : ℕ := + ∑ index : Fin (srcFormula formula).clauses.length, + (2 ^ paperFormulaClauseWidth formula index - 1) + +/-- GapCVP reduction support. -/ +def paperVariableArityLocalTagWordOrder + (formula : ThreeCNF) : + Fin (paperVariableArityLocalTagCount formula) ≃ + (Σ index : Fin (srcFormula formula).clauses.length, + ((srcFormula + formula).clauses.get index).SatisfyingLocalTuple) := by + change Fin + (∑ index : Fin (srcFormula formula).clauses.length, + (2 ^ paperFormulaClauseWidth formula index - 1)) ≃ _ + exact finSigmaFinEquiv.symm.trans + (Equiv.sigmaCongrRight + (paperFormulaClauseTupleWordOrder formula)) + +/-- GapCVP reduction support. -/ +def sourceTypeWordOrder + (formula : ThreeCNF) : + Fin (1 + paperVariableArityLocalTagCount formula) ≃ + sourceSATTableType (srcFormula formula) := + (finSumFinEquiv + (m := 1) (n := paperVariableArityLocalTagCount formula)).symm.trans + (Equiv.sumCongr finOneEquiv + (paperVariableArityLocalTagWordOrder formula)) + +theorem sourceTableType_card + (formula : ThreeCNF) : + Fintype.card + (sourceSATTableType (srcFormula formula)) = + 1 + paperVariableArityLocalTagCount formula := by + simpa only [Fintype.card_sum, Fintype.card_unique, List.get_eq_getElem, Fintype.card_sigma, + Nat.add_left_cancel_iff, Fintype.card_fin] using (Fintype.card_congr (sourceTypeWordOrder + formula)).symm + +end SourceOrder + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part12C.lean b/LeanPool/GapCVP/Part12C.lean new file mode 100644 index 000000000..97e398f97 --- /dev/null +++ b/LeanPool/GapCVP/Part12C.lean @@ -0,0 +1,4068 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part12B + +/-! # GapCVP proof, part 12, continuation 03 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace SourceOrder + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryFieldBasis GapCVP.BinarySourceCoordinateOrder + +open GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryOrderedAssembly + +open GapCVP.BinaryOrderedRefinement GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge + +open GapCVP.ClauseCardinality + +/-- GapCVP reduction support. -/ +def sourceTypeCardWordOrder + (formula : ThreeCNF) : + Fin (Fintype.card + (sourceSATTableType (srcFormula formula))) ≃ + sourceSATTableType (srcFormula formula) := + (finCongr (sourceTableType_card formula)).trans + (sourceTypeWordOrder formula) + +/-- GapCVP reduction support. -/ +def sourceCoordinateWordOrder + (encodingLength : ℕ) (formula : ThreeCNF) : + Fin (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula)) ≃ + sourceSATTableCoordinate (srcFormula formula) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula)) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength (srcFormula formula)) := + sourceFormulaCoordinateOrder + encodingLength (srcFormula formula) + (sourceTypeCardWordOrder formula) + +private def paperVariableArityLocalVariableMomentWordOrder + (formula : ThreeCNF) (momentBudget : ℕ) + (index : Fin (srcFormula formula).clauses.length) : + Fin (paperFormulaClauseWidth formula index * + (momentBudget + 1)) ≃ + ((srcFormula + formula).clauses.get index).LocalVariable × + Fin (momentBudget + 1) := + (finProdFinEquiv + (m := paperFormulaClauseWidth formula index) + (n := momentBudget + 1)).symm.trans + ((paperFormulaClauseVariableWordOrder + formula index).prodCongr + (Equiv.refl (Fin (momentBudget + 1)))) + +/-- GapCVP reduction support. -/ +def paperShiftedClauseTagCount + (formula : ThreeCNF) (momentBudget : ℕ) + (index : Fin (srcFormula formula).clauses.length) : ℕ := + (2 ^ paperFormulaClauseWidth formula index - 1) * + (paperFormulaClauseWidth formula index * + (momentBudget + 1)) + +/-- GapCVP reduction support. -/ +def paperShiftedClauseWordOrder + (formula : ThreeCNF) (momentBudget : ℕ) + (index : Fin (srcFormula formula).clauses.length) : + Fin (paperShiftedClauseTagCount + formula momentBudget index) ≃ + (Σ _tuple : + ((srcFormula + formula).clauses.get index).SatisfyingLocalTuple, + ((srcFormula + formula).clauses.get index).LocalVariable × + Fin (momentBudget + 1)) := by + change Fin + ((2 ^ paperFormulaClauseWidth formula index - 1) * + (paperFormulaClauseWidth formula index * + (momentBudget + 1))) ≃ _ + exact (finProdFinEquiv + (m := 2 ^ paperFormulaClauseWidth formula index - 1) + (n := paperFormulaClauseWidth formula index * + (momentBudget + 1))).symm.trans + ((Equiv.sigmaEquivProd + (Fin (2 ^ paperFormulaClauseWidth formula index - 1)) + (Fin (paperFormulaClauseWidth formula index * + (momentBudget + 1)))).symm.trans + (Equiv.sigmaCongr + (paperFormulaClauseTupleWordOrder formula index) + (fun _ => paperVariableArityLocalVariableMomentWordOrder + formula momentBudget index))) + +/-- GapCVP reduction support. -/ +def paperShiftedFamilyTagCount + (formula : ThreeCNF) (momentBudget : ℕ) : ℕ := + ∑ index : Fin (srcFormula formula).clauses.length, + paperShiftedClauseTagCount + formula momentBudget index + +/-- GapCVP reduction support. -/ +def paperShiftedFamilyWordOrder + (formula : ThreeCNF) (momentBudget : ℕ) : + Fin (paperShiftedFamilyTagCount + formula momentBudget) ≃ + (Σ clause : Fin (srcFormula formula).clauses.length, + Σ _tuple : + ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple, + ((srcFormula + formula).clauses.get clause).LocalVariable × + Fin (momentBudget + 1)) := by + change Fin + (∑ index : Fin (srcFormula formula).clauses.length, + paperShiftedClauseTagCount + formula momentBudget index) ≃ _ + exact finSigmaFinEquiv.symm.trans + (Equiv.sigmaCongrRight fun clause => + paperShiftedClauseWordOrder + formula momentBudget clause) + +/-- GapCVP reduction support. -/ +def paperOrdinaryFamilyWordOrder + (formula : ThreeCNF) (momentBudget : ℕ) : + Fin ((1 + paperVariableArityLocalTagCount formula) * + (momentBudget + 1)) ≃ + sourceSATTableType (srcFormula formula) × + Fin (momentBudget + 1) := + (finProdFinEquiv + (m := 1 + paperVariableArityLocalTagCount formula) + (n := momentBudget + 1)).symm.trans + ((sourceTypeWordOrder formula).prodCongr + (Equiv.refl (Fin (momentBudget + 1)))) + +/-- GapCVP reduction support. -/ +def paperExplicitFamilyTagCount + (encodingLength : ℕ) (formula : ThreeCNF) : ℕ := + let budget := + explicitMomentBudget encodingLength + (srcFormula formula) + 1 + ((srcFormula formula).clauses.length + + ((1 + paperVariableArityLocalTagCount formula) * (budget + 1) + + paperShiftedFamilyTagCount formula budget)) + +/-- GapCVP reduction support. -/ +def paperExplicitFamilyWordOrder + (encodingLength : ℕ) (formula : ThreeCNF) : + Fin (paperExplicitFamilyTagCount + encodingLength formula) ≃ + ExplicitConstraintFamily + encodingLength (srcFormula formula) := by + let budget := + explicitMomentBudget encodingLength + (srcFormula formula) + change Fin + (1 + ((srcFormula formula).clauses.length + + ((1 + paperVariableArityLocalTagCount formula) * (budget + 1) + + paperShiftedFamilyTagCount formula budget))) ≃ _ + exact (finSumFinEquiv + (m := 1) + (n := (srcFormula formula).clauses.length + + ((1 + paperVariableArityLocalTagCount formula) * (budget + 1) + + paperShiftedFamilyTagCount formula budget))).symm.trans + (Equiv.sumCongr finOneEquiv + ((finSumFinEquiv + (m := (srcFormula formula).clauses.length) + (n := (1 + paperVariableArityLocalTagCount formula) * (budget + 1) + + paperShiftedFamilyTagCount + formula budget)).symm.trans + (Equiv.sumCongr + (Equiv.refl + (Fin (srcFormula formula).clauses.length)) + ((finSumFinEquiv + (m := (1 + paperVariableArityLocalTagCount formula) * + (budget + 1)) + (n := paperShiftedFamilyTagCount + formula budget)).symm.trans + (Equiv.sumCongr + (paperOrdinaryFamilyWordOrder + formula budget) + (paperShiftedFamilyWordOrder + formula budget)))))) + +/-- GapCVP reduction support. -/ +abbrev paperExplicitBinaryRowDegree + (encodingLength : ℕ) (formula : ThreeCNF) : ℕ := + sourceFieldExponent + (sourceSizeParameter encodingLength + (srcFormula formula)) + +/-- GapCVP reduction support. -/ +def paperExplicitBinaryFamilyBlockCount + (encodingLength : ℕ) (formula : ThreeCNF) + (index : Fin + (paperExplicitFamilyTagCount encodingLength formula)) : ℕ := + explicitFamilyRowCount + encodingLength (srcFormula formula) + (paperExplicitFamilyWordOrder + encodingLength formula index) * + paperExplicitBinaryRowDegree encodingLength formula + +/-- GapCVP reduction support. -/ +def paperExplicitBinaryRowWordCount + (encodingLength : ℕ) (formula : ThreeCNF) : ℕ := + ∑ index : Fin + (paperExplicitFamilyTagCount encodingLength formula), + paperExplicitBinaryFamilyBlockCount + encodingLength formula index + +/-- GapCVP reduction support. -/ +def paperVariableArityExplicitBinaryRowWordOrder + (encodingLength : ℕ) (formula : ThreeCNF) : + Fin (paperExplicitBinaryRowWordCount + encodingLength formula) ≃ + assembledBinaryRow + (explicitFamilyRowCount + encodingLength (srcFormula formula)) + (paperExplicitBinaryRowDegree + encodingLength formula) := by + let familyOrder := + paperExplicitFamilyWordOrder + encodingLength formula + change Fin + (∑ index : Fin + (paperExplicitFamilyTagCount encodingLength formula), + explicitFamilyRowCount + encodingLength (srcFormula formula) + (familyOrder index) * + paperExplicitBinaryRowDegree + encodingLength formula) ≃ _ + exact finSigmaFinEquiv.symm.trans + (Equiv.sigmaCongr familyOrder (fun index => + (finProdFinEquiv + (m := explicitFamilyRowCount + encodingLength (srcFormula formula) + (familyOrder index)) + (n := paperExplicitBinaryRowDegree + encodingLength formula)).symm)) + +/-- GapCVP reduction support. -/ +def physicalBinarySystem + (encodingLength : ℕ) (formula : ThreeCNF) : BinaryAffineSystem := + assembledBinaryAffineSystemOrdered + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + encodingLength (srcFormula formula)) + (explicitFamilyRowCount + encodingLength (srcFormula formula)) + (sourceFormulaPhysicalFamilyFieldMatrix + encodingLength (srcFormula formula)) + (explicitFamilyTarget + encodingLength (srcFormula formula)) + (paperVariableArityExplicitBinaryRowWordOrder + encodingLength formula) + +private theorem paperVariableArityPhysicalBinarySystem_solves_iff_explicit + (encodingLength : ℕ) (formula : ThreeCNF) + (values : Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula)) → ℤ) : + (physicalBinarySystem + encodingLength formula).Solves values ↔ + (sourceFormulaExplicitBinarySystem + encodingLength (srcFormula formula)).Solves values := by + unfold physicalBinarySystem + rw [assembledBinaryAffineSystemOrdered_solves_iff] + rw [sourceFormulaExplicitBinarySystem_solves_iff_family] + simp only [sourceFormulaPhysicalFamilyFieldMatrix, + LinearMap.toMatrix'_mulVec] + constructor + · intro hphysical family + exact (sourceFormulaPhysicalFamilyLinearMap_eq_iff_explicit + encodingLength (srcFormula formula) family + (fun position => algebraMap (ZMod 2) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula)) + (values position : ZMod 2))).mp (hphysical family) + · intro hexplicit family + exact (sourceFormulaPhysicalFamilyLinearMap_eq_iff_explicit + encodingLength (srcFormula formula) family + (fun position => algebraMap (ZMod 2) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula)) + (values position : ZMod 2))).mpr (hexplicit family) + +end SourceOrder + +namespace PhysicalColumnOrder + +open GapCVP.Core GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryExplicitFourFamilyKernel +open GapCVP.FormulaBridge GapCVP.SourceOrder + +/-- GapCVP reduction support. -/ +abbrev physicalColumnPermutation + (encodingLength : ℕ) (formula : ThreeCNF) : + Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula)) ≃ + Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula)) := + (sourceCoordinateWordOrder + encodingLength formula).trans + (Fintype.equivFin + (sourceSATTableCoordinate (srcFormula formula) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula)) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength (srcFormula formula)))) + +/-- GapCVP reduction support. -/ +def physicalCoordinateIndex + (encodingLength : ℕ) (formula : ThreeCNF) + (tableType : sourceSATTableType (srcFormula formula)) + (point : sourceSATGridPoint + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength (srcFormula formula))) + (value : + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula)) : + Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula)) := + (sourceCoordinateWordOrder + encodingLength formula).symm (tableType, point, value) + +@[simp] theorem + paperVariableArityPhysicalColumnPermutation_symm_sourceSATColumnIndex + (encodingLength : ℕ) (formula : ThreeCNF) + (tableType : sourceSATTableType (srcFormula formula)) + (point : sourceSATGridPoint + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength (srcFormula formula))) + (value : + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula)) : + (physicalColumnPermutation + encodingLength formula).symm + (sourceSATColumnIndex (srcFormula formula) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength (srcFormula formula)) + tableType point value) = + physicalCoordinateIndex + encodingLength formula tableType point value := by + let coordinateOrder := sourceCoordinateWordOrder encodingLength formula + let finiteOrder := Fintype.equivFin + (sourceSATTableCoordinate (srcFormula formula) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula)) + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength (srcFormula formula))) + change (coordinateOrder.trans finiteOrder).symm + (finiteOrder (tableType, point, value)) = + coordinateOrder.symm (tableType, point, value) + rw [Equiv.symm_trans_apply, Equiv.symm_apply_apply] + +/-- GapCVP reduction support. -/ +abbrev physicalWordBinarySystem + (encodingLength : ℕ) (formula : ThreeCNF) : BinaryAffineSystem := + reindexBinaryAffineSystem + (physicalBinarySystem + encodingLength formula) + (Equiv.refl + (Fin (paperExplicitBinaryRowWordCount + encodingLength formula))) + (physicalColumnPermutation + encodingLength formula) + +@[simp] theorem paperVariableArityPhysicalWordBinarySystem_rowCount + (encodingLength : ℕ) (formula : ThreeCNF) : + (physicalWordBinarySystem + encodingLength formula).rowCount = + paperExplicitBinaryRowWordCount + encodingLength formula := by + rfl + +theorem paperVariableArityPhysicalWordBinarySystem_check_apply + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + encodingLength formula)) + (column : Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula))) : + (physicalWordBinarySystem + encodingLength formula).check row column = + (physicalBinarySystem + encodingLength formula).check row + (physicalColumnPermutation + encodingLength formula column) := by + rfl + +private theorem paperVariableArityPhysicalWordBinarySystem_solves_iff_physical + (encodingLength : ℕ) (formula : ThreeCNF) + (values : Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula)) → ℤ) : + (physicalWordBinarySystem + encodingLength formula).Solves values ↔ + (physicalBinarySystem + encodingLength formula).Solves + (fun column => values + ((physicalColumnPermutation + encodingLength formula).symm column)) := by + exact reindexBinaryAffineSystem_solves_iff + (physicalBinarySystem + encodingLength formula) + (Equiv.refl + (Fin (paperExplicitBinaryRowWordCount + encodingLength formula))) + (physicalColumnPermutation + encodingLength formula) values + +private theorem physicalWordBinarySystem_solves_iff_explicit + (encodingLength : ℕ) (formula : ThreeCNF) + (values : Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula)) → ℤ) : + (physicalWordBinarySystem + encodingLength formula).Solves values ↔ + (sourceFormulaExplicitBinarySystem + encodingLength (srcFormula formula)).Solves + (fun column => values + ((physicalColumnPermutation + encodingLength formula).symm column)) := + (paperVariableArityPhysicalWordBinarySystem_solves_iff_physical + encodingLength formula values).trans + (paperVariableArityPhysicalBinarySystem_solves_iff_explicit + encodingLength formula + (fun column => values + ((physicalColumnPermutation + encodingLength formula).symm column))) + +private theorem physicalColumnPermutation_norm + (encodingLength : ℕ) (formula : ThreeCNF) + (values : Fin + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula)) → ℤ) : + integerSquaredNorm + (fun column => values + ((physicalColumnPermutation + encodingLength formula).symm column)) = + integerSquaredNorm values := + integerSquaredNorm_wordOrder + (physicalColumnPermutation + encodingLength formula) values + +end PhysicalColumnOrder + +namespace PhysicalWordSoundness + +open GapCVP.Core GapCVP.Factor400BinaryCodeDecodingCorollary +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.FormulaBridge +open GapCVP.FourFamilySoundness GapCVP.PhysicalColumnOrder + +theorem paperVariableArityPhysicalWordBinarySystem_oneHot_of_satisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (hsatisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + ∃ vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ, + (physicalWordBinarySystem + encodingLength formula).Solves vector ∧ + (∀ index, vector index = 0 ∨ vector index = 1) ∧ + integerSquaredNorm vector = + paperVariableArityIntegerRadius encodingLength formula := by + obtain ⟨canonical, hsolve, hbinary, hnorm⟩ := + paperVariableArityExplicitBinarySystem_oneHot_of_satisfiable + encodingLength formula hsatisfiable + let coordinate := + physicalColumnPermutation encodingLength formula + let vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ := + fun index => canonical (coordinate index) + refine ⟨vector, ?_, ?_, ?_⟩ + · apply + (physicalWordBinarySystem_solves_iff_explicit + encodingLength formula vector).mpr + simpa [vector, coordinate, paperExplicitBinarySystem] + using hsolve + · intro index + exact hbinary (coordinate index) + · have htransport := + physicalColumnPermutation_norm + encodingLength formula vector + have hequal : + integerSquaredNorm canonical = integerSquaredNorm vector := by + simpa [vector, coordinate] using htransport + exact hequal.symm.trans hnorm + +private theorem paperVariableArityPhysicalWordBinarySystem_signedSolution_of_satisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (hsatisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + ∃ vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ, + (physicalWordBinarySystem + encodingLength formula).Solves vector ∧ + (integerSquaredNorm vector : ℝ) ≤ + ((sourceOneHotCompletenessRadius + (srcFormula formula) + (sourceFormulaGrid encodingLength + (srcFormula formula)) : ℚ) : ℝ) ^ 2 := by + obtain ⟨canonical, hsolve, hbound⟩ := + paperVariableArityExplicitBinarySystem_signedSolution_of_satisfiable + encodingLength formula hsatisfiable + let coordinate := + physicalColumnPermutation encodingLength formula + let vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ := + fun index => canonical (coordinate index) + refine ⟨vector, ?_, ?_⟩ + · apply + (physicalWordBinarySystem_solves_iff_explicit + encodingLength formula vector).mpr + simpa [vector, coordinate, paperExplicitBinarySystem] + using hsolve + · have htransport := + physicalColumnPermutation_norm + encodingLength formula vector + have hequal : + integerSquaredNorm canonical = integerSquaredNorm vector := by + simpa [vector, coordinate] using htransport + rw [← hequal] + exact hbound + +theorem + paperVariableArityPhysicalWordBinarySystem_satisfiable_of_scaled_hamming + (encodingLength : ℕ) (formula : ThreeCNF) + (vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ) + (hsolve : (physicalWordBinarySystem + encodingLength formula).Solves vector) + (hshort : + (integerSquaredNorm vector : ℝ) ≤ + 2 * binaryCodeGapFactor + ((physicalWordBinarySystem + encodingLength formula).dimension) * + (paperVariableArityIntegerRadius + encodingLength formula : ℝ)) : + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + let canonical : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ := + fun index => vector + ((physicalColumnPermutation + encodingLength formula).symm index) + have hcanonical : + (paperExplicitBinarySystem + encodingLength formula).Solves canonical := by + exact + (physicalWordBinarySystem_solves_iff_explicit + encodingLength formula vector).mp hsolve + apply + paperVariableArityExplicitBinarySystem_satisfiable_of_scaled_hamming + encodingLength formula canonical hcanonical + have hnorm : + integerSquaredNorm canonical = integerSquaredNorm vector := + physicalColumnPermutation_norm + encodingLength formula vector + rw [hnorm] + simpa only [ge_iff_le] using hshort + +theorem + paperVariableArityPhysicalWordBinarySystem_strict_factor400_of_unsatisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ) + (hsolve : (physicalWordBinarySystem + encodingLength formula).Solves vector) + (hunsatisfiable : + ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + (GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + ((physicalWordBinarySystem + encodingLength formula).dimension) * + ((sourceOneHotCompletenessRadius + (srcFormula formula) + (sourceFormulaGrid encodingLength + (srcFormula formula)) : ℚ) : ℝ)) ^ 2 < + (integerSquaredNorm vector : ℝ) := by + let canonical : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ := + fun index => vector + ((physicalColumnPermutation + encodingLength formula).symm index) + have hcanonical : + (paperExplicitBinarySystem + encodingLength formula).Solves canonical := by + exact + (physicalWordBinarySystem_solves_iff_explicit + encodingLength formula vector).mp hsolve + have hstrict := + paperVariableArityExplicitBinarySystem_strict_factor400_of_unsatisfiable + encodingLength formula canonical hcanonical hunsatisfiable + have hnorm : + integerSquaredNorm canonical = integerSquaredNorm vector := + physicalColumnPermutation_norm + encodingLength formula vector + simpa only [gt_iff_lt, hnorm] using hstrict + +end PhysicalWordSoundness + +namespace Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap + +open Turing GapCVP.Core GapCVP.Factor400BinaryInstanceBridge +open GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.OriginalThreeSATNPHardness +open GapCVP.SourcePreprocessingSemantics GapCVP.SourcePreprocessingTM GapCVP.FormulaBridge +open GapCVP.FourFamilySoundness GapCVP.NormalizedRecordDecoder GapCVP.PhysicalColumnOrder +open GapCVP.PhysicalWordSoundness + +/-- GapCVP reduction support. -/ +def physicalFormulaSystem + (encodingLength : ℕ) (formula : ThreeCNF) : BinaryAffineSystem := + physicalWordBinarySystem encodingLength formula + +@[simp] theorem paperVariableArityPhysicalFormulaSystem_dimension + (encodingLength : ℕ) (formula : ThreeCNF) : + (physicalFormulaSystem encodingLength formula).dimension = + sourceFormulaDimension encodingLength + (srcFormula formula) := by + rfl + +theorem physicalFormulaSystem_dimension_pos + (encodingLength : ℕ) (formula : ThreeCNF) : + 0 < (physicalFormulaSystem + encodingLength formula).dimension := by + change 0 < sourceFormulaDimension encodingLength + (srcFormula formula) + exact Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension_pos + encodingLength + (srcFormula formula) + +/-- GapCVP reduction support. -/ +def physicalFormulaRadius + (encodingLength : ℕ) (formula : ThreeCNF) : ℚ := + sourceOneHotCompletenessRadius + (srcFormula formula) + (sourceFormulaGrid encodingLength + (srcFormula formula)) + +theorem physicalFormulaRadius_pos + (encodingLength : ℕ) (formula : ThreeCNF) : + 0 < physicalFormulaRadius + encodingLength formula := by + apply GapCVP.Core.sourceOneHotCompletenessRadius_pos + (srcFormula formula) + (sourceFormulaGrid encodingLength + (srcFormula formula)) + exact Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid_card_pos + encodingLength + (srcFormula formula) + +/-- GapCVP reduction support. -/ +def physicalFormulaInstance + (encodingLength : ℕ) (formula : ThreeCNF) : GapCVPInstance := + effectiveGapCVPInstance + (physicalFormulaSystem encodingLength formula) + (physicalFormulaSystem_dimension_pos + encodingLength formula) + (physicalFormulaRadius encodingLength formula) + (physicalFormulaRadius_pos + encodingLength formula) + +theorem paperVariableArityPhysicalFormulaSystem_oneHot_of_satisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (satisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + ∃ vector : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ, + (physicalFormulaSystem + encodingLength formula).Solves vector ∧ + (∀ index, vector index = 0 ∨ vector index = 1) ∧ + integerSquaredNorm vector = + paperVariableArityIntegerRadius encodingLength formula := by + exact paperVariableArityPhysicalWordBinarySystem_oneHot_of_satisfiable + encodingLength formula satisfiable + +theorem physicalFormulaSystem_consistent_of_satisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (satisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + (physicalFormulaSystem + encodingLength formula).effectiveReducedConsistent = true := by + apply (BinaryAffineSystem.effectiveReducedConsistent_iff_solvable + (physicalFormulaSystem + encodingLength formula)).mpr + obtain ⟨vector, solution, _, _⟩ := + paperVariableArityPhysicalFormulaSystem_oneHot_of_satisfiable + encodingLength formula satisfiable + exact ⟨vector, solution⟩ + +private theorem paperVariableArityPhysicalFormulaInstance_gapYES400_of_satisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (satisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + gapYES400 + (physicalFormulaInstance + encodingLength formula) := by + let H := physicalFormulaSystem + encodingLength formula + let radius := physicalFormulaRadius + encodingLength formula + let positiveDimension := + physicalFormulaSystem_dimension_pos + encodingLength formula + let positiveRadius := physicalFormulaRadius_pos + encodingLength formula + have consistent := + physicalFormulaSystem_consistent_of_satisfiable + encodingLength formula satisfiable + obtain ⟨vector, solution, bound⟩ := + paperVariableArityPhysicalWordBinarySystem_signedSolution_of_satisfiable + encodingLength formula satisfiable + change gapYES400 (adaptGapCVPInstance + (effectiveConstructionAInstance H positiveDimension + radius positiveRadius)) + apply (adaptGapCVPInstance_gapYES400_iff_metricYes + (effectiveConstructionAInstance H positiveDimension + radius positiveRadius)).mpr + apply (effectiveConstructionAInstance_yes_iff_signedSolution + H positiveDimension consistent radius positiveRadius).mpr + refine ⟨vector, solution, ?_⟩ + change + (integerSquaredNorm vector : ℝ) ≤ + ((sourceOneHotCompletenessRadius + (srcFormula formula) + (sourceFormulaGrid encodingLength + (srcFormula formula)) : ℚ) : ℝ) ^ 2 + exact bound + +private theorem paperVariableArityPhysicalFormulaInstance_gapNO400_of_unsatisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (consistent : + (physicalFormulaSystem + encodingLength formula).effectiveReducedConsistent = true) + (unsatisfiable : ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + gapNO400 + (physicalFormulaInstance + encodingLength formula) := by + let H := physicalFormulaSystem + encodingLength formula + let radius := physicalFormulaRadius + encodingLength formula + let positiveDimension := + physicalFormulaSystem_dimension_pos + encodingLength formula + let positiveRadius := physicalFormulaRadius_pos + encodingLength formula + change gapNO400 (adaptGapCVPInstance + (effectiveConstructionAInstance H positiveDimension + radius positiveRadius)) + apply (adaptGapCVPInstance_gapNO400_iff_metricNo + (effectiveConstructionAInstance H positiveDimension + radius positiveRadius)).mpr + apply (effectiveConstructionAInstance_no_iff_signedSolutionNorm + H positiveDimension consistent radius positiveRadius + ((1 : ℝ) / 400)).mpr + intro vector solution + have separation := + paperVariableArityPhysicalWordBinarySystem_strict_factor400_of_unsatisfiable + encodingLength formula vector solution unsatisfiable + change + ((GapCVP.SourceFactor400BinaryConstructionABounds.gapFactor400 + ((physicalWordBinarySystem + encodingLength formula).dimension)) * + ((sourceOneHotCompletenessRadius + (srcFormula formula) + (sourceFormulaGrid encodingLength + (srcFormula formula)) : ℚ) : ℝ)) ^ 2 < + (integerSquaredNorm vector : ℝ) + exact separation + +private theorem paperVariableArityPhysicalCanonicalYes_mem : + gapCVP400Promise.yes SourceMachineRouting.canonicalYesWord := by + simp only [GapCVP.gapCVP400Promise, decide_eq_true_eq] + refine ⟨SourceMachineRouting.canonicalYesInstance, rfl, ?_⟩ + exact (gapYES400_iff_gapYES + SourceMachineRouting.canonicalYesInstance).mpr + SourceMachineRouting.canonicalYesInstance_gapYES + +theorem paperVariableArityOriginal_satisfiable_of_normalized_empty + (formula : ThreeCNF) + (empty : paperSourceNormalizedClauses formula = []) : + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + refine ⟨fun _ => false, ?_⟩ + apply (paperSourceNormalizedClauses_satisfied_iff + formula (fun _ => false)).mp + simp only [empty, List.not_mem_nil, Prod.exists, Bool.exists_bool, IsEmpty.forall_iff, + implies_true] + +/-- GapCVP reduction support. -/ +def physicalSourceInstance + (input : List Bool) : GapCVPInstance := by + classical + exact + match BinaryEncoding.decodeThreeCNF input with + | none => Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance + | some formula => + if BinaryEncoding.encodeThreeCNF formula = input then + match readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput input) with + | none => Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance + | some descriptor => + if descriptor.originalWord = input then + if descriptor.normalizedClauses = [] then + SourceMachineRouting.canonicalYesInstance + else + if (physicalFormulaSystem + input.length descriptor.originalFormula).effectiveReducedConsistent then + physicalFormulaInstance + input.length descriptor.originalFormula + else + Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance + else + Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance + else + Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance + +/-- GapCVP reduction support. -/ +def paperVariableArityPhysicalSourceMap + (input : List Bool) : List Bool := + BinaryEncoding.encodeGapCVPInstance + (physicalSourceInstance input) + +theorem paperVariableArityPhysicalSourceInstance_of_decode_none + (input : List Bool) + (decode : BinaryEncoding.decodeThreeCNF input = none) : + physicalSourceInstance input = + Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance := by + simp only [physicalSourceInstance, decode] + +theorem paperVariableArityPhysicalSourceInstance_of_noncanonical + (input : List Bool) (formula : ThreeCNF) + (decode : BinaryEncoding.decodeThreeCNF input = some formula) + (noncanonical : + BinaryEncoding.encodeThreeCNF formula ≠ input) : + physicalSourceInstance input = + Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance := by + simp only [physicalSourceInstance, decode, noncanonical, ↓reduceIte] + +theorem paperVariableArityPhysicalSourceInstance_of_normalized_empty + (input : List Bool) (formula : ThreeCNF) + (decode : BinaryEncoding.decodeThreeCNF input = some formula) + (canonical : BinaryEncoding.encodeThreeCNF formula = input) + (empty : paperSourceNormalizedClauses formula = []) : + physicalSourceInstance input = + SourceMachineRouting.canonicalYesInstance := by + unfold physicalSourceInstance + simp only [decode, ite_eq_left canonical] + have descriptor : + readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput input) = + some + { retainedFormula := noTautClauses formula + normalizedClauses := paperSourceNormalizedClauses formula + originalFormula := formula + originalWord := + BinaryEncoding.encodeThreeCNF formula } := by + rw [← canonical] + exact readPaperVariableArityNormalizedSourceDescriptor_valid formula + rw [descriptor] + simp only [canonical, ↓reduceIte, empty] + +theorem paperVariableArityPhysicalSourceInstance_of_inconsistent + (input : List Bool) (formula : ThreeCNF) + (decode : BinaryEncoding.decodeThreeCNF input = some formula) + (canonical : BinaryEncoding.encodeThreeCNF formula = input) + (nonempty : paperSourceNormalizedClauses formula ≠ []) + (inconsistent : + (physicalFormulaSystem + input.length formula).effectiveReducedConsistent = false) : + physicalSourceInstance input = + Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance := by + unfold physicalSourceInstance + simp only [decode, ite_eq_left canonical] + have descriptor : + readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput input) = + some + { retainedFormula := noTautClauses formula + normalizedClauses := paperSourceNormalizedClauses formula + originalFormula := formula + originalWord := + BinaryEncoding.encodeThreeCNF formula } := by + rw [← canonical] + exact readPaperVariableArityNormalizedSourceDescriptor_valid formula + rw [descriptor] + simp only [canonical, ↓reduceIte, nonempty, inconsistent, Bool.false_eq_true] + +theorem paperVariableArityPhysicalSourceInstance_of_consistent + (input : List Bool) (formula : ThreeCNF) + (decode : BinaryEncoding.decodeThreeCNF input = some formula) + (canonical : BinaryEncoding.encodeThreeCNF formula = input) + (nonempty : paperSourceNormalizedClauses formula ≠ []) + (consistent : + (physicalFormulaSystem + input.length formula).effectiveReducedConsistent = true) : + physicalSourceInstance input = + physicalFormulaInstance + input.length formula := by + unfold physicalSourceInstance + simp only [decode, ite_eq_left canonical] + have descriptor : + readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput input) = + some + { retainedFormula := noTautClauses formula + normalizedClauses := paperSourceNormalizedClauses formula + originalFormula := formula + originalWord := + BinaryEncoding.encodeThreeCNF formula } := by + rw [← canonical] + exact readPaperVariableArityNormalizedSourceDescriptor_valid formula + rw [descriptor] + simp only [canonical, ↓reduceIte, nonempty, consistent] + +private theorem paperVariableArityPhysicalSourceMap_completeness + (input : List Bool) + (satisfiable : ∃ formula : ThreeCNF, + BinaryEncoding.encodeThreeCNF formula = input ∧ + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + gapCVP400Promise.yes + (paperVariableArityPhysicalSourceMap input) := by + obtain ⟨formula, canonical, assignment⟩ := satisfiable + have decode : BinaryEncoding.decodeThreeCNF input = + some formula := by + rw [← canonical] + exact BinaryEncoding.decodeThreeCNF_encode formula + by_cases empty : paperSourceNormalizedClauses formula = [] + · unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_normalized_empty + input formula decode canonical empty] + exact paperVariableArityPhysicalCanonicalYes_mem + · have consistent := + physicalFormulaSystem_consistent_of_satisfiable + input.length formula assignment + simp only [GapCVP.gapCVP400Promise, decide_eq_true_eq] + refine ⟨physicalFormulaInstance + input.length formula, ?_, ?_⟩ + · change + BinaryEncoding.encodeGapCVPInstance + (physicalFormulaInstance + input.length formula) = + paperVariableArityPhysicalSourceMap input + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_consistent + input formula decode canonical empty consistent] + · exact + paperVariableArityPhysicalFormulaInstance_gapYES400_of_satisfiable + input.length formula assignment + +private theorem paperVariableArityPhysicalSourceMap_soundness + (input : List Bool) + (unsatisfiable : ¬ ∃ formula : ThreeCNF, + BinaryEncoding.encodeThreeCNF formula = input ∧ + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + gapCVP400Promise.no + (paperVariableArityPhysicalSourceMap input) := by + classical + cases decode : BinaryEncoding.decodeThreeCNF input with + | none => + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_decode_none + input decode] + exact Factor400BinaryCanonicalNo.adaptedCanonicalNoWord_mem_no + | some formula => + by_cases canonical : + BinaryEncoding.encodeThreeCNF formula = input + · by_cases empty : paperSourceNormalizedClauses formula = [] + · exfalso + apply unsatisfiable + exact ⟨formula, canonical, + paperVariableArityOriginal_satisfiable_of_normalized_empty + formula empty⟩ + · cases consistent : + (physicalFormulaSystem + input.length formula).effectiveReducedConsistent with + | false => + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_inconsistent + input formula decode canonical empty consistent] + exact Factor400BinaryCanonicalNo.adaptedCanonicalNoWord_mem_no + | true => + have originalUnsatisfiable : + ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, + clauseSatisfied assignment clause := by + intro assignment + exact unsatisfiable ⟨formula, canonical, assignment⟩ + simp only [GapCVP.gapCVP400Promise, decide_eq_true_eq] + refine ⟨physicalFormulaInstance + input.length formula, ?_, ?_⟩ + · change + BinaryEncoding.encodeGapCVPInstance + (physicalFormulaInstance + input.length formula) = + paperVariableArityPhysicalSourceMap input + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_consistent + input formula decode canonical empty consistent] + · exact + paperVariableArityPhysicalFormulaInstance_gapNO400_of_unsatisfiable + input.length formula consistent originalUnsatisfiable + · unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_noncanonical + input formula decode canonical] + exact Factor400BinaryCanonicalNo.adaptedCanonicalNoWord_mem_no + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalSourceReductionOfMachine + (machine : BitTM paperVariableArityPhysicalSourceMap) : + PromiseReduction paperOriginalThreeSATLanguage gapCVP400Promise where + map := paperVariableArityPhysicalSourceMap + polynomial_time := ⟨machine⟩ + completeness input satisfiable := + paperVariableArityPhysicalSourceMap_completeness input + ((paperOriginalThreeSATLanguage_iff input).mp satisfiable) + soundness input unsatisfiable := + paperVariableArityPhysicalSourceMap_soundness input + (fun satisfiable => unsatisfiable + ((paperOriginalThreeSATLanguage_iff input).mpr satisfiable)) + +end Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap + +namespace ClauseOffsetTM + +open Turing +open scoped BigOperators + +open GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceStructuralTuringTM +open GapCVP.SourceMachineCert GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceIndexedClauseLookupTM +open GapCVP.SourceNormalizedVariableRankScanTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CNFBoundedRecordFoldTM GapCVP.CLStructuralPrefixWriter GapCVP.BinaryDimensionTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.SourcePreprocessingTM + +/-- GapCVP reduction support. -/ +def paperVariableArityClauseArityUnary (input : List Bool) : List Bool := + (unaryPrefixOutput (paperSourceClauseNormalizedRecord input)).tail + +/-- GapCVP reduction support. -/ +noncomputable def paperClauseArityUnaryComputable : + BitTM + paperVariableArityClauseArityUnary := by + have parsed := GapCVP.TMComposition.computableInPolyTime + paperSourceClauseNormalizedRecordComputable unaryPrefixComputable + exact GapCVP.TMComposition.computableInPolyTime + parsed dropHeadComputable + +@[simp] theorem paperVariableArityClauseArityUnary_valid + (clause : ThreeClause) (suffix : List Bool) : + paperVariableArityClauseArityUnary + (encodeThreeClause clause ++ suffix) = + List.replicate (paperSourceNormalizedClause clause).length true := by + unfold paperVariableArityClauseArityUnary + rw [paperSourceClauseNormalizedRecord_valid] + simp only [paperSourceNormalizedClauseRecord, unaryPrefixOutput_replicate_delimiter, + List.tail_cons] + +private theorem paperVariableArityClauseArityUnary_length_le_three + (input : List Bool) : + (paperVariableArityClauseArityUnary input).length ≤ 3 := by + unfold paperVariableArityClauseArityUnary + paperSourceClauseNormalizedRecord + paperSourceClauseSecondKeepUnary + paperSourceClauseThirdKeepUnary + split <;> split <;> + simp [unaryPrefixOutput, unaryPrefixLength] + +private def paperVariableArityClauseSquarePlusOneUnary + (input : List Bool) : List Bool := + List.replicate + ((paperVariableArityClauseArityUnary input).length ^ 2 + 1) true + +private noncomputable def paperVariableArityClauseSquarePlusOneUnaryComputable : + BitTM + paperVariableArityClauseSquarePlusOneUnary := by + have physical := GapCVP.TMComposition.computableInPolyTime + paperClauseArityUnaryComputable + (polynomialValueUnaryComputable (Polynomial.X ^ 2 + 1)) + change BitTM + (fun input : List Bool => List.replicate + ((paperVariableArityClauseArityUnary input).length ^ 2 + 1) true) + simpa only [Polynomial.eval_add, Polynomial.eval_pow, Polynomial.eval_X, Polynomial.eval_one, + Function.comp_def] using physical + +/-- GapCVP reduction support. -/ +def paperVariableArityClauseWeightUnary : List Bool → List Bool := + unarySubtractionOutput + paperVariableArityClauseSquarePlusOneUnary + paperVariableArityClauseArityUnary + +/-- GapCVP reduction support. -/ +noncomputable def paperClauseWeightUnaryComputable : + BitTM + paperVariableArityClauseWeightUnary := + unarySubtractionComputable + paperVariableArityClauseSquarePlusOneUnaryComputable + paperClauseArityUnaryComputable + +private theorem paperVariableArityClauseWeightUnary_eq + (input : List Bool) : + paperVariableArityClauseWeightUnary input = + List.replicate + ((paperVariableArityClauseArityUnary input).length ^ 2 + 1 - + (paperVariableArityClauseArityUnary input).length) true := by + unfold paperVariableArityClauseWeightUnary + apply unarySubtractionOutput_valid + paperVariableArityClauseSquarePlusOneUnary + paperVariableArityClauseArityUnary input + ((paperVariableArityClauseArityUnary input).length ^ 2 + 1) + (paperVariableArityClauseArityUnary input).length + · rfl + · unfold paperVariableArityClauseArityUnary + paperSourceClauseNormalizedRecord + paperSourceClauseSecondKeepUnary + paperSourceClauseThirdKeepUnary + split <;> split <;> + simp [unaryPrefixOutput, unaryPrefixLength] + +private theorem paperVariableArityClausePolynomialWeight_eq + (arity : ℕ) (hpositive : 0 < arity) (hbound : arity ≤ 3) : + arity ^ 2 + 1 - arity = 2 ^ arity - 1 := by + interval_cases arity <;> norm_num at * + +@[simp] theorem paperVariableArityClauseWeightUnary_valid + (clause : ThreeClause) (suffix : List Bool) : + paperVariableArityClauseWeightUnary + (encodeThreeClause clause ++ suffix) = + List.replicate (2 ^ (paperSourceNormalizedClause clause).length - 1) + true := by + rw [paperVariableArityClauseWeightUnary_eq, + paperVariableArityClauseArityUnary_valid] + simp only [List.length_replicate] + rw [paperVariableArityClausePolynomialWeight_eq + (paperSourceNormalizedClause clause).length + (List.length_pos_iff.mpr + (paperSourceNormalizedClause_ne_nil clause)) + (paperNormalizedClause_length_le_three clause)] + +private theorem paperVariableArityClauseWeightUnary_length_le_seven + (input : List Bool) : + (paperVariableArityClauseWeightUnary input).length ≤ 7 := by + rw [paperVariableArityClauseWeightUnary_eq, + List.length_replicate] + have bound := paperVariableArityClauseArityUnary_length_le_three input + interval_cases h : (paperVariableArityClauseArityUnary input).length <;> + norm_num + +private def paperVariableArityOffsetAccumulator : List Bool → List Bool := + paperSourcePreprocessingField 0 + +private def paperOffsetCatalogueField : List Bool → List Bool := + paperSourcePreprocessingField 1 + +private def paperVariableArityOffsetPending : List Bool → List Bool := + paperSourcePreprocessingField 2 + +private def paperVariableArityOffsetPreserved : List Bool → List Bool := + paperSourcePreprocessingSuffixAt 3 + +private def paperOffsetCurrentNormalized : List Bool → List Bool := + paperSourceClauseNormalizedRecord ∘ paperVariableArityOffsetPending + +private def paperOffsetCurrentArity : List Bool → List Bool := + paperVariableArityClauseArityUnary ∘ paperVariableArityOffsetPending + +private def paperOffsetCurrentWeight : List Bool → List Bool := + paperVariableArityClauseWeightUnary ∘ paperVariableArityOffsetPending + +@[simp] private theorem paperVariableArityOffsetCurrentNormalized_apply + (state : List Bool) : + paperOffsetCurrentNormalized state = + paperSourceClauseNormalizedRecord + (paperVariableArityOffsetPending state) := by + simp only [paperOffsetCurrentNormalized, + Function.comp_apply] + +@[simp] private theorem paperVariableArityOffsetCurrentArity_apply + (state : List Bool) : + paperOffsetCurrentArity state = + paperVariableArityClauseArityUnary + (paperVariableArityOffsetPending state) := by + simp only [paperOffsetCurrentArity, + Function.comp_apply] + +@[simp] private theorem paperVariableArityOffsetCurrentWeight_apply + (state : List Bool) : + paperOffsetCurrentWeight state = + paperVariableArityClauseWeightUnary + (paperVariableArityOffsetPending state) := by + simp only [paperOffsetCurrentWeight, + Function.comp_apply] + +private def paperOffsetCurrentRecord + (state : List Bool) : List Bool := + lengthPrefixedWord (paperVariableArityOffsetAccumulator state) ++ + (lengthPrefixedWord (paperOffsetCurrentArity state) ++ + (lengthPrefixedWord (paperOffsetCurrentWeight state) ++ + lengthPrefixedWord (paperOffsetCurrentNormalized state))) + +private def paperOffsetNextAccumulator + (state : List Bool) : List Bool := + paperVariableArityOffsetAccumulator state ++ + paperOffsetCurrentWeight state + +private def paperOffsetNextCatalogue + (state : List Bool) : List Bool := + paperOffsetCatalogueField state ++ + paperOffsetCurrentRecord state + +private def paperVariableArityOffsetNextPending : List Bool → List Bool := + clauseSuffix ∘ paperVariableArityOffsetPending + +private def paperVariableArityClauseOffsetStep + (state : List Bool) : List Bool := + lengthPrefixedWord (paperOffsetNextAccumulator state) ++ + (lengthPrefixedWord (paperOffsetNextCatalogue state) ++ + (lengthPrefixedWord (paperVariableArityOffsetNextPending state) ++ + paperVariableArityOffsetPreserved state)) + +private noncomputable def paperVariableArityOffsetAccumulatorComputable : + BitTM + paperVariableArityOffsetAccumulator := + paperPreprocessingFieldComputable 0 + +private noncomputable def paperVariableArityOffsetCatalogueFieldComputable : + BitTM + paperOffsetCatalogueField := + paperPreprocessingFieldComputable 1 + +private noncomputable def paperOffsetPendingComputable : + BitTM + paperVariableArityOffsetPending := + paperPreprocessingFieldComputable 2 + +private noncomputable def paperVariableArityOffsetPreservedComputable : + BitTM + paperVariableArityOffsetPreserved := + paperPreprocessingSuffixAtComputable 3 + +private noncomputable def paperVariableArityOffsetCurrentNormalizedComputable : + BitTM + paperOffsetCurrentNormalized := + GapCVP.TMComposition.computableInPolyTime + paperOffsetPendingComputable + paperSourceClauseNormalizedRecordComputable + +private noncomputable def paperVariableArityOffsetCurrentArityComputable : + BitTM + paperOffsetCurrentArity := + GapCVP.TMComposition.computableInPolyTime + paperOffsetPendingComputable + paperClauseArityUnaryComputable + +private noncomputable def paperVariableArityOffsetCurrentWeightComputable : + BitTM + paperOffsetCurrentWeight := + GapCVP.TMComposition.computableInPolyTime + paperOffsetPendingComputable + paperClauseWeightUnaryComputable + +private noncomputable def paperVariableArityOffsetCurrentRecordComputable : + BitTM + paperOffsetCurrentRecord := by + have offset := GapCVP.TMComposition.computableInPolyTime + paperVariableArityOffsetAccumulatorComputable + structuralPrefixWriterComputable + have arity := GapCVP.TMComposition.computableInPolyTime + paperVariableArityOffsetCurrentArityComputable + structuralPrefixWriterComputable + have weight := GapCVP.TMComposition.computableInPolyTime + paperVariableArityOffsetCurrentWeightComputable + structuralPrefixWriterComputable + have normalized := GapCVP.TMComposition.computableInPolyTime + paperVariableArityOffsetCurrentNormalizedComputable + structuralPrefixWriterComputable + exact pointwiseAppendComputable offset + (pointwiseAppendComputable arity + (pointwiseAppendComputable weight normalized)) + +private noncomputable def paperVariableArityOffsetNextAccumulatorComputable : + BitTM + paperOffsetNextAccumulator := + pointwiseAppendComputable + paperVariableArityOffsetAccumulatorComputable + paperVariableArityOffsetCurrentWeightComputable + +private noncomputable def paperVariableArityOffsetNextCatalogueComputable : + BitTM + paperOffsetNextCatalogue := + pointwiseAppendComputable + paperVariableArityOffsetCatalogueFieldComputable + paperVariableArityOffsetCurrentRecordComputable + +private noncomputable def paperVariableArityOffsetNextPendingComputable : + BitTM + paperVariableArityOffsetNextPending := + GapCVP.TMComposition.computableInPolyTime + paperOffsetPendingComputable clauseSuffixComputable + +private noncomputable def paperVariableArityClauseOffsetStepComputable : + BitTM + paperVariableArityClauseOffsetStep := by + have offset := GapCVP.TMComposition.computableInPolyTime + paperVariableArityOffsetNextAccumulatorComputable + structuralPrefixWriterComputable + have catalogue := GapCVP.TMComposition.computableInPolyTime + paperVariableArityOffsetNextCatalogueComputable + structuralPrefixWriterComputable + have pending := GapCVP.TMComposition.computableInPolyTime + paperVariableArityOffsetNextPendingComputable + structuralPrefixWriterComputable + exact pointwiseAppendComputable offset + (pointwiseAppendComputable catalogue + (pointwiseAppendComputable pending + paperVariableArityOffsetPreservedComputable)) + +private theorem paperVariableArityOffsetFieldAccounting + (state : List Bool) : + 2 * (paperVariableArityOffsetAccumulator state).length + + 2 * (paperOffsetCatalogueField state).length + + 2 * (paperVariableArityOffsetPending state).length + + (paperVariableArityOffsetPreserved state).length ≤ state.length := by + have first := sourceNormalizedVariableScanStructuralFieldAccounting state + have second := sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix state) + have third := sourceNormalizedVariableScanStructuralFieldAccounting + (firstFieldSuffix (firstFieldSuffix state)) + simp only [paperVariableArityOffsetAccumulator, paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, Function.iterate_zero, Function.comp_apply, id_eq, + paperOffsetCatalogueField, paperVariableArityOffsetPending, Function.iterate_succ, + paperVariableArityOffsetPreserved, ge_iff_le] at * + omega + +private theorem paperVariableArityOffsetCurrentNormalized_length_le + (state : List Bool) : + (paperOffsetCurrentNormalized state).length ≤ + 3 * (paperVariableArityOffsetPending state).length + 10 := by + rw [paperVariableArityOffsetCurrentNormalized_apply] + exact paperSourceClauseNormalizedRecord_length_le + (paperVariableArityOffsetPending state) + +private theorem paperVariableArityOffsetCurrentWeight_length_le + (state : List Bool) : + (paperOffsetCurrentWeight state).length ≤ 7 := by + rw [paperVariableArityOffsetCurrentWeight_apply] + exact paperVariableArityClauseWeightUnary_length_le_seven + (paperVariableArityOffsetPending state) + +private theorem paperVariableArityOffsetCurrentArity_length_le + (state : List Bool) : + (paperOffsetCurrentArity state).length ≤ 3 := by + rw [paperVariableArityOffsetCurrentArity_apply] + exact paperVariableArityClauseArityUnary_length_le_three + (paperVariableArityOffsetPending state) + +private theorem paperVariableArityClauseOffsetStep_length_le + (state : List Bool) : + (paperVariableArityClauseOffsetStep state).length ≤ + state.length + + 4 * (paperVariableArityOffsetAccumulator state).length + + 12 * (paperVariableArityOffsetPending state).length + 110 := by + have accounting := paperVariableArityOffsetFieldAccounting state + have arity := paperVariableArityOffsetCurrentArity_length_le state + have weight := paperVariableArityOffsetCurrentWeight_length_le state + have normalized := paperVariableArityOffsetCurrentNormalized_length_le state + have pending := sourceOriginalIndexedClauseSuffix_length_le + (paperVariableArityOffsetPending state) + simp only [paperVariableArityClauseOffsetStep, + paperOffsetNextAccumulator, + paperOffsetNextCatalogue, + paperVariableArityOffsetNextPending, + paperOffsetCurrentRecord, + Function.comp_apply, List.length_append, + lengthPrefixedWord_length] at * + omega + +@[simp] private theorem paperVariableArityOffsetAccumulator_step + (state : List Bool) : + paperVariableArityOffsetAccumulator + (paperVariableArityClauseOffsetStep state) = + paperVariableArityOffsetAccumulator state ++ + paperOffsetCurrentWeight state := by + simp only [paperVariableArityOffsetAccumulator, paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, Function.iterate_zero, paperVariableArityClauseOffsetStep, + paperOffsetNextAccumulator, Function.comp_apply, id_eq, + paperVariableArityOffsetCurrentWeight_apply, + firstFieldContents_valid] + +@[simp] private theorem paperVariableArityOffsetPending_step + (state : List Bool) : + paperVariableArityOffsetPending + (paperVariableArityClauseOffsetStep state) = + clauseSuffix (paperVariableArityOffsetPending state) := by + simp [paperVariableArityOffsetPending, + paperVariableArityClauseOffsetStep, + paperVariableArityOffsetNextPending, + paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, + Function.comp_apply] + +private theorem paperVariableArityOffsetAccumulator_iterate_length_le + (seed : List Bool) (stage : ℕ) : + (paperVariableArityOffsetAccumulator + ((paperVariableArityClauseOffsetStep^[stage]) seed)).length ≤ + (paperVariableArityOffsetAccumulator seed).length + 7 * stage := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply', + paperVariableArityOffsetAccumulator_step, + List.length_append] + have weight := paperVariableArityOffsetCurrentWeight_length_le + ((paperVariableArityClauseOffsetStep^[stage]) seed) + omega + +private theorem paperVariableArityOffsetPending_iterate_length_le + (seed : List Bool) (stage : ℕ) : + (paperVariableArityOffsetPending + ((paperVariableArityClauseOffsetStep^[stage]) seed)).length ≤ + (paperVariableArityOffsetPending seed).length := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply', + paperVariableArityOffsetPending_step] + exact (sourceOriginalIndexedClauseSuffix_length_le _).trans ih + +private theorem paperVariableArityClauseOffsetStep_iterate_length_le + (seed : List Bool) (stage : ℕ) : + (((paperVariableArityClauseOffsetStep^[stage]) seed)).length ≤ + seed.length + stage * (16 * seed.length + 28 * stage + 110) := by + have accounting := paperVariableArityOffsetFieldAccounting seed + have initialAccumulator : + (paperVariableArityOffsetAccumulator seed).length ≤ seed.length := by + omega + have initialPending : + (paperVariableArityOffsetPending seed).length ≤ seed.length := by + omega + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, mul_zero, add_zero, zero_mul, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have worker := paperVariableArityClauseOffsetStep_length_le + ((paperVariableArityClauseOffsetStep^[stage]) seed) + have accumulator := + paperVariableArityOffsetAccumulator_iterate_length_le seed stage + have pending := + paperVariableArityOffsetPending_iterate_length_le seed stage + linarith + +private def paperVariableArityClauseOffsetFoldBound : Polynomial ℕ := + 160 * (Polynomial.X + 1) ^ 2 + +private theorem paperVariableArityClauseOffset_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates paperVariableArityClauseOffsetStep + paperVariableArityClauseOffsetFoldBound := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed parsed stage bounded + have seedBound := sourceAtomicFoldSeed_length_le + input count seed parsed + have countBound := parsedUnaryFold_count_le_length + input count seed parsed + have stageBound : stage ≤ input.length := + Nat.le_trans bounded countBound + have stageSeed : stage * seed.length ≤ input.length * input.length := + Nat.mul_le_mul stageBound seedBound + have stageSquare : stage * stage ≤ input.length * input.length := + Nat.mul_le_mul stageBound stageBound + have intermediate := + paperVariableArityClauseOffsetStep_iterate_length_le seed stage + simp only [paperVariableArityClauseOffsetFoldBound, + Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_pow, Polynomial.eval_add, + Polynomial.eval_X, Polynomial.eval_one] + nlinarith + +private noncomputable def paperVariableArityClauseOffsetFoldComputable : + BitTM + (boundedRecordFoldOutput paperVariableArityClauseOffsetStep) := + boundedDependentRecordFoldComputable + paperVariableArityClauseOffsetStepComputable + paperVariableArityClauseOffsetFoldBound + paperVariableArityClauseOffset_polynomiallyBoundedFoldStates + +/-- GapCVP reduction support. -/ +def sourceClauseWeight (clause : ThreeClause) : ℕ := + 2 ^ (paperSourceNormalizedClause clause).length - 1 + +private def paperVariableAritySourceClauseOffsetRecord + (offset : ℕ) (clause : ThreeClause) : List Bool := + lengthPrefixedWord (List.replicate offset true) ++ + (lengthPrefixedWord + (List.replicate (paperSourceNormalizedClause clause).length true) ++ + (lengthPrefixedWord + (List.replicate (sourceClauseWeight clause) true) ++ + lengthPrefixedWord (paperSourceNormalizedClauseRecord clause))) + +/-- GapCVP reduction support. -/ +def sourceClauseWeightSum + (clauses : List ThreeClause) : ℕ := + (clauses.map sourceClauseWeight).sum + +/-- GapCVP reduction support. -/ +def sourceClauseOffsetCatalogue : + ℕ → List ThreeClause → List Bool + | _, [] => [] + | offset, clause :: remaining => + paperVariableAritySourceClauseOffsetRecord offset clause ++ + sourceClauseOffsetCatalogue + (offset + sourceClauseWeight clause) remaining + +private def paperClauseOffsetValidState + (formula : ThreeCNF) (offset : ℕ) + (catalogue : List Bool) (pending : List ThreeClause) : List Bool := + lengthPrefixedWord (List.replicate offset true) ++ + (lengthPrefixedWord catalogue ++ + (lengthPrefixedWord (pending.flatMap encodeThreeClause) ++ + paperSourcePreprocessingOutput (encodeThreeCNF formula))) + +@[simp] private theorem paperVariableArityOffsetAccumulator_validState + (formula : ThreeCNF) (offset : ℕ) + (catalogue : List Bool) (pending : List ThreeClause) : + paperVariableArityOffsetAccumulator + (paperClauseOffsetValidState + formula offset catalogue pending) = + List.replicate offset true := by + simp only [paperVariableArityOffsetAccumulator, paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, Function.iterate_zero, paperClauseOffsetValidState, + Function.comp_apply, id_eq, + firstFieldContents_valid] + +@[simp] private theorem paperVariableArityOffsetCatalogueField_validState + (formula : ThreeCNF) (offset : ℕ) + (catalogue : List Bool) (pending : List ThreeClause) : + paperOffsetCatalogueField + (paperClauseOffsetValidState + formula offset catalogue pending) = catalogue := by + simp only [paperOffsetCatalogueField, paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, + Function.iterate_one, paperClauseOffsetValidState, Function.comp_apply, + firstFieldSuffix_valid, + firstFieldContents_valid] + +@[simp] private theorem paperVariableArityOffsetPending_validState + (formula : ThreeCNF) (offset : ℕ) + (catalogue : List Bool) (pending : List ThreeClause) : + paperVariableArityOffsetPending + (paperClauseOffsetValidState + formula offset catalogue pending) = + pending.flatMap encodeThreeClause := by + simp [paperVariableArityOffsetPending, + paperSourcePreprocessingField, + paperSourcePreprocessingSuffixAt, + paperClauseOffsetValidState, + Function.comp_apply] + +@[simp] private theorem paperVariableArityOffsetPreserved_validState + (formula : ThreeCNF) (offset : ℕ) + (catalogue : List Bool) (pending : List ThreeClause) : + paperVariableArityOffsetPreserved + (paperClauseOffsetValidState + formula offset catalogue pending) = + paperSourcePreprocessingOutput (encodeThreeCNF formula) := by + simp [paperVariableArityOffsetPreserved, + paperSourcePreprocessingSuffixAt, + paperClauseOffsetValidState, + Function.comp_apply] + +private theorem paperVariableArityClauseOffsetStep_valid_cons + (formula : ThreeCNF) (offset : ℕ) + (catalogue : List Bool) (clause : ThreeClause) + (pending : List ThreeClause) : + paperVariableArityClauseOffsetStep + (paperClauseOffsetValidState + formula offset catalogue (clause :: pending)) = + paperClauseOffsetValidState formula + (offset + sourceClauseWeight clause) + (catalogue ++ + paperVariableAritySourceClauseOffsetRecord offset clause) + pending := by + unfold paperVariableArityClauseOffsetStep + paperOffsetNextAccumulator + paperOffsetNextCatalogue + paperVariableArityOffsetNextPending + paperOffsetCurrentRecord + simp only [Function.comp_apply, + paperVariableArityOffsetAccumulator_validState, + paperVariableArityOffsetCatalogueField_validState, + paperVariableArityOffsetPending_validState, + paperVariableArityOffsetPreserved_validState, + List.flatMap_cons, + paperVariableArityOffsetCurrentNormalized_apply, + paperVariableArityOffsetCurrentArity_apply, + paperVariableArityOffsetCurrentWeight_apply, + paperSourceClauseNormalizedRecord_valid, + paperVariableArityClauseArityUnary_valid, + paperVariableArityClauseWeightUnary_valid, + clauseSuffix_valid] + simp only [List.replicate_append_replicate, paperClauseOffsetValidState, sourceClauseWeight, + paperVariableAritySourceClauseOffsetRecord] + +private theorem paperVariableArityClauseOffsetStep_iterate_valid + (formula : ThreeCNF) (offset : ℕ) + (catalogue : List Bool) (pending : List ThreeClause) : + ((paperVariableArityClauseOffsetStep^[pending.length]) + (paperClauseOffsetValidState + formula offset catalogue pending)) = + paperClauseOffsetValidState formula + (offset + sourceClauseWeightSum pending) + (catalogue ++ + sourceClauseOffsetCatalogue offset pending) + [] := by + induction pending generalizing offset catalogue with + | nil => + simp only [List.length_nil, Function.iterate_zero, id_eq, sourceClauseWeightSum, + List.map_nil, List.sum_nil, + add_zero, sourceClauseOffsetCatalogue, List.append_nil] + | cons clause remaining ih => + simp only [List.length_cons] + rw [Function.iterate_succ_apply, + paperVariableArityClauseOffsetStep_valid_cons, + ih] + simp only [sourceClauseWeightSum, Nat.add_assoc, List.append_assoc, List.map_cons, + List.sum_cons, + sourceClauseOffsetCatalogue] + +private def paperVariableArityClauseOffsetSeed + (input : List Bool) : List Bool := + lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ + (lengthPrefixedWord + (paperSourcePreprocessingFinalField 0 input) ++ + paperSourcePreprocessingOutput input)) + +private noncomputable def paperVariableArityClauseOffsetSeedComputable : + BitTM + paperVariableArityClauseOffsetSeed := by + have pending := GapCVP.TMComposition.computableInPolyTime + (paperPreprocessingFinalFieldComputable 0) + structuralPrefixWriterComputable + have body := pointwiseAppendComputable pending + paperSourcePreprocessingComputable + have empties := GapCVP.TMComposition.computableInPolyTime + body (prependWordComputable + (lengthPrefixedWord [] ++ lengthPrefixedWord [])) + change BitTM + (fun input : List Bool => + lengthPrefixedWord [] ++ + (lengthPrefixedWord [] ++ + (lengthPrefixedWord + (paperSourcePreprocessingFinalField 0 input) ++ + paperSourcePreprocessingOutput input))) + simpa only [List.append_assoc, Function.comp_apply, Function.comp_def] using empties + +@[simp] private theorem paperVariableArityClauseOffsetSeed_valid + (formula : ThreeCNF) : + paperVariableArityClauseOffsetSeed (encodeThreeCNF formula) = + paperClauseOffsetValidState formula 0 [] + (noTautClauses formula) := by + simp only [paperVariableArityClauseOffsetSeed, paperSourcePreprocessingFinalOriginalBody_valid, + paperClauseOffsetValidState, List.replicate_zero] + +/-- GapCVP reduction support. -/ +def paperRetainedClauseCountUnary : List Bool → List Bool := + paperSourcePreprocessingFinalField 2 + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityRetainedClauseCountUnaryComputable : + BitTM + paperRetainedClauseCountUnary := + paperPreprocessingFinalFieldComputable 2 + +@[simp] theorem paperVariableArityRetainedClauseCountUnary_valid + (formula : ThreeCNF) : + paperRetainedClauseCountUnary + (encodeThreeCNF formula) = + List.replicate + (noTautClauses formula).length true := by + unfold paperRetainedClauseCountUnary + paperSourcePreprocessingFinalField + rw [Function.comp_apply, + paperSourcePreprocessingFinalState_valid, + paperSourcePreprocessingField_valid_two] + +private def paperClauseOffsetPreparation + (input : List Bool) : List Bool := + paperRetainedClauseCountUnary input ++ + false :: paperVariableArityClauseOffsetSeed input + +private noncomputable def paperVariableArityClauseOffsetPreparationComputable : + BitTM + paperClauseOffsetPreparation := by + have delimited := GapCVP.TMComposition.computableInPolyTime + paperVariableArityClauseOffsetSeedComputable + (prependBitComputable false) + exact pointwiseAppendComputable + paperVariableArityRetainedClauseCountUnaryComputable delimited + +@[simp] private theorem paperVariableArityClauseOffsetPreparation_valid + (formula : ThreeCNF) : + paperClauseOffsetPreparation + (encodeThreeCNF formula) = + unaryBoundedFoldWord + (noTautClauses formula).length + (paperClauseOffsetValidState formula 0 [] + (noTautClauses formula)) := by + simp only [paperClauseOffsetPreparation, paperVariableArityRetainedClauseCountUnary_valid, + paperVariableArityClauseOffsetSeed_valid, unaryBoundedFoldWord] + +private def paperClauseOffsetFinalState : List Bool → List Bool := + boundedRecordFoldOutput paperVariableArityClauseOffsetStep ∘ + paperClauseOffsetPreparation + +private noncomputable def paperVariableArityClauseOffsetFinalStateComputable : + BitTM + paperClauseOffsetFinalState := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityClauseOffsetPreparationComputable + paperVariableArityClauseOffsetFoldComputable + +@[simp] private theorem paperVariableArityClauseOffsetFinalState_valid + (formula : ThreeCNF) : + paperClauseOffsetFinalState + (encodeThreeCNF formula) = + paperClauseOffsetValidState formula + (sourceClauseWeightSum + (noTautClauses formula)) + (sourceClauseOffsetCatalogue 0 + (noTautClauses formula)) + [] := by + unfold paperClauseOffsetFinalState + rw [Function.comp_apply, + paperVariableArityClauseOffsetPreparation_valid] + simp only [boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + simpa only [zero_add, List.nil_append] using + paperVariableArityClauseOffsetStep_iterate_valid formula 0 [] (noTautClauses formula) + +/-- GapCVP reduction support. -/ +def paperClauseOffsetOutput + (input : List Bool) : List Bool := + lengthPrefixedWord + (paperOffsetCatalogueField + (paperClauseOffsetFinalState input)) ++ + (lengthPrefixedWord + (paperVariableArityOffsetAccumulator + (paperClauseOffsetFinalState input)) ++ + paperVariableArityOffsetPreserved + (paperClauseOffsetFinalState input)) + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityClauseOffsetOutputComputable : + BitTM + paperClauseOffsetOutput := by + have catalogueField := GapCVP.TMComposition.computableInPolyTime + paperVariableArityClauseOffsetFinalStateComputable + paperVariableArityOffsetCatalogueFieldComputable + have catalogue := GapCVP.TMComposition.computableInPolyTime + catalogueField structuralPrefixWriterComputable + have offsetField := GapCVP.TMComposition.computableInPolyTime + paperVariableArityClauseOffsetFinalStateComputable + paperVariableArityOffsetAccumulatorComputable + have offset := GapCVP.TMComposition.computableInPolyTime + offsetField structuralPrefixWriterComputable + have preserved := GapCVP.TMComposition.computableInPolyTime + paperVariableArityClauseOffsetFinalStateComputable + paperVariableArityOffsetPreservedComputable + exact pointwiseAppendComputable catalogue + (pointwiseAppendComputable offset preserved) + +theorem paperVariableArityClauseOffsetOutput_valid + (formula : ThreeCNF) : + paperClauseOffsetOutput + (encodeThreeCNF formula) = + lengthPrefixedWord + (sourceClauseOffsetCatalogue 0 + (noTautClauses formula)) ++ + (lengthPrefixedWord + (List.replicate + (sourceClauseWeightSum + (noTautClauses formula)) true) ++ + paperSourcePreprocessingOutput (encodeThreeCNF formula)) := by + unfold paperClauseOffsetOutput + rw [paperVariableArityClauseOffsetFinalState_valid] + simp only [paperVariableArityOffsetCatalogueField_validState, + paperVariableArityOffsetAccumulator_validState, + paperVariableArityOffsetPreserved_validState] + +end ClauseOffsetTM + +namespace BinaryPhysicalWordQueryCatalogueTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryExplicitAffineRows + +private def sourcePhysicalWordCatalogueRankQuery + (rank : ℕ) (width source : List Bool) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord width ++ source + +private def sourcePhysicalWordCatalogueRankUnary : List Bool → List Bool := + firstFieldContents + +private noncomputable def sourcePhysicalWordCatalogueRankUnaryComputable : + BitTM + sourcePhysicalWordCatalogueRankUnary := + firstFieldContentsComputable + +private def sourcePhysicalWordCatalogueRankOriginalSource : + List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +private noncomputable def sourcePhysicalWordCatalogueRankOriginalSourceComputable : + BitTM + sourcePhysicalWordCatalogueRankOriginalSource := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + +@[simp] private theorem sourcePhysicalWordCatalogueRankUnary_query + (rank : ℕ) (width source : List Bool) : + sourcePhysicalWordCatalogueRankUnary + (sourcePhysicalWordCatalogueRankQuery rank width source) = + List.replicate rank true := by + simp only [sourcePhysicalWordCatalogueRankUnary, sourcePhysicalWordCatalogueRankQuery, + List.append_assoc, + firstFieldContents_valid] + +@[simp] private theorem sourcePhysicalWordCatalogueRankOriginalSource_query + (rank : ℕ) (width source : List Bool) : + sourcePhysicalWordCatalogueRankOriginalSource + (sourcePhysicalWordCatalogueRankQuery rank width source) = + source := by + simp only [sourcePhysicalWordCatalogueRankOriginalSource, sourcePhysicalWordCatalogueRankQuery, + List.append_assoc, Function.comp_apply, firstFieldSuffix_valid] + +private def sourcePhysicalWordCanonicalRhsCandidate + (input : List Bool) : List Bool := + lengthPrefixedWord (sourcePhysicalWordCatalogueRankUnary input) ++ + lengthPrefixedWord [] ++ + sourcePhysicalWordCatalogueRankOriginalSource input + +private noncomputable def sourcePhysicalWordCanonicalRhsCandidateComputable : + BitTM + sourcePhysicalWordCanonicalRhsCandidate := by + have hrank := GapCVP.TMComposition.computableInPolyTime + sourcePhysicalWordCatalogueRankUnaryComputable + structuralPrefixWriterComputable + have hzero := sourceFixedWordComputable (lengthPrefixedWord []) + have hphysical := pointwiseAppendComputable hrank + (pointwiseAppendComputable hzero + sourcePhysicalWordCatalogueRankOriginalSourceComputable) + change BitTM + (fun input => + lengthPrefixedWord (sourcePhysicalWordCatalogueRankUnary input) ++ + lengthPrefixedWord [] ++ + sourcePhysicalWordCatalogueRankOriginalSource input) + simpa only [Function.comp_apply, List.append_assoc] using hphysical + +@[simp] private theorem sourcePhysicalWordCanonicalRhsCandidate_query + (rank : ℕ) (width source : List Bool) : + sourcePhysicalWordCanonicalRhsCandidate + (sourcePhysicalWordCatalogueRankQuery rank width source) = + affineCellQuery rank 0 source := by + simp only [sourcePhysicalWordCanonicalRhsCandidate, sourcePhysicalWordCatalogueRankUnary_query, + sourcePhysicalWordCatalogueRankOriginalSource_query, List.append_assoc, affineCellQuery, + List.replicate_zero] + +theorem sourcePhysicalWordCanonical_range_mul_flatMap + (rows columns : ℕ) : + List.range (rows * columns) = + (List.range rows).flatMap + (fun row => (List.range columns).map + (fun column => row * columns + column)) := by + exact + GapCVP.BinarySourceConvolutionCorrectness.factor400BinarySourceConvolution_range_mul_flatMap + rows columns + +end BinaryPhysicalWordQueryCatalogueTM + +namespace CanonicalMatrixShape + +open scoped BigOperators + +open Turing GapCVP.Core GapCVP.BinaryEncoding +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM GapCVP.ClauseOffsetTM +open GapCVP.PhysicalColumnOrder GapCVP.BinaryExplicitAffineRows + +/-- GapCVP reduction support. -/ +structure PaperVariableArityCanonicalBinaryMatrixShape where + /-- GapCVP reduction support. -/ + system : (encodingLength : ℕ) → ThreeCNF → BinaryAffineSystem + systemCorrect : ∀ (encodingLength : ℕ) (formula : ThreeCNF), + system encodingLength formula = + physicalWordBinarySystem encodingLength formula + /-- GapCVP reduction support. -/ + rows : List Bool → List Bool + /-- GapCVP reduction support. -/ + columns : List Bool → List Bool + /-- GapCVP reduction support. -/ + rowsComputable : + BitTM rows + /-- GapCVP reduction support. -/ + columnsComputable : + BitTM columns + rowsCorrect : ∀ (formula : ThreeCNF), + rows (encodeThreeCNF formula) = + List.replicate + (system (encodeThreeCNF formula).length formula).rowCount true + columnsCorrect : ∀ (formula : ThreeCNF), + columns (encodeThreeCNF formula) = + List.replicate + (system (encodeThreeCNF formula).length formula).dimension true + columnsPositive : ∀ (formula : ThreeCNF), + 0 < (system (encodeThreeCNF formula).length formula).dimension + +/-- GapCVP reduction support. -/ +structure PaperVariableArityCanonicalBinaryMatrixCellComputer + (shape : PaperVariableArityCanonicalBinaryMatrixShape) where + /-- GapCVP reduction support. -/ + check : List Bool → List Bool + /-- GapCVP reduction support. -/ + rhs : List Bool → List Bool + /-- GapCVP reduction support. -/ + checkComputable : + BitTM check + /-- GapCVP reduction support. -/ + rhsComputable : + BitTM rhs + checkCorrect : ∀ (formula : ThreeCNF) + (row : Fin + (shape.system (encodeThreeCNF formula).length formula).rowCount) + (column : Fin + (shape.system (encodeThreeCNF formula).length formula).dimension), + check (affineCellQuery + row.val column.val (encodeThreeCNF formula)) = + [decide + ((shape.system (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))] + rhsCorrect : ∀ (formula : ThreeCNF) + (row : Fin + (shape.system (encodeThreeCNF formula).length formula).rowCount) + (column : Fin + (shape.system (encodeThreeCNF formula).length formula).dimension), + rhs (affineCellQuery + row.val column.val (encodeThreeCNF formula)) = + [decide + ((shape.system (encodeThreeCNF formula).length formula).rightHandSide + row = (1 : ZMod 2))] + +private def paperVariableArityCanonicalBinaryMatrixRawCheckWidth + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + fourFamilyComputedUnaryProductOutput shape.rows shape.columns + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixRawCheckWidthComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperVariableArityCanonicalBinaryMatrixRawCheckWidth shape) := + fourFamilyComputedUnaryProductComputable + shape.rowsComputable shape.columnsComputable + +private theorem paperVariableArityCanonicalBinaryMatrixRawCheckWidth_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : + paperVariableArityCanonicalBinaryMatrixRawCheckWidth shape + (encodeThreeCNF formula) = + List.replicate + ((shape.system (encodeThreeCNF formula).length formula).rowCount * + (shape.system (encodeThreeCNF formula).length formula).dimension) + true := by + exact fourFamilyComputedUnaryProductOutput_valid + shape.rows shape.columns (encodeThreeCNF formula) + (shape.system (encodeThreeCNF formula).length formula).rowCount + (shape.system (encodeThreeCNF formula).length formula).dimension + (shape.rowsCorrect formula) (shape.columnsCorrect formula) + +end CanonicalMatrixShape + +namespace CanonicalSourceCatalogue + +open scoped BigOperators + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceMachineCert GapCVP.SourceStructuralTuringTM +open GapCVP.CNFCappedUnaryPairArithmeticTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.OutputPolynomialCompositionClosure +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceMixedRadixUnaryQuotientRemainderTM +open GapCVP.SourceMixedRadixDimensionRowMajorIndexTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM +open GapCVP.SourceFourFamilyMarkerRotationTM GapCVP.GaussianRowWorker +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryPhysicalWordPackedMatrixTM +open GapCVP.BinaryPhysicalWordQueryCatalogueTM GapCVP.CanonicalMatrixShape +open GapCVP.PhysicalColumnOrder + +private noncomputable def paperCanonicalBinaryMatrixCheckWidth + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + SourceQaryMaskDynamicGridWidth where + output := paperVariableArityCanonicalBinaryMatrixRawCheckWidth shape + computer := + paperVariableArityCanonicalBinaryMatrixRawCheckWidthComputable shape + +private noncomputable def paperCanonicalBinaryMatrixRhsWidth + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + SourceQaryMaskDynamicGridWidth where + output := shape.rows + computer := shape.rowsComputable + +private theorem paperVariableArityCanonicalBinaryMatrixCheckWidth_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : + (paperCanonicalBinaryMatrixCheckWidth shape).output + (encodeThreeCNF formula) = + List.replicate + ((shape.system (encodeThreeCNF formula).length formula).rowCount * + (shape.system (encodeThreeCNF formula).length formula).dimension) + true := + paperVariableArityCanonicalBinaryMatrixRawCheckWidth_valid + shape formula + +private theorem paperVariableArityCanonicalBinaryMatrixRhsWidth_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : + (paperCanonicalBinaryMatrixRhsWidth shape).output + (encodeThreeCNF formula) = + List.replicate + (shape.system (encodeThreeCNF formula).length formula).rowCount + true := + shape.rowsCorrect formula + +private def paperVariableArityCanonicalBinaryMatrixRankDimension + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + shape.columns ∘ sourcePhysicalWordCatalogueRankOriginalSource + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixRankDimensionComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperVariableArityCanonicalBinaryMatrixRankDimension shape) := + GapCVP.TMComposition.computableInPolyTime + sourcePhysicalWordCatalogueRankOriginalSourceComputable + shape.columnsComputable + +private def paperCanonicalBinaryMatrixRankDivisionInput + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (input : List Bool) : List Bool := + sourcePhysicalWordCatalogueRankUnary input ++ false :: + (paperVariableArityCanonicalBinaryMatrixRankDimension + shape input ++ false :: + sourcePhysicalWordCatalogueRankOriginalSource input) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixRankDivisionInputComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperCanonicalBinaryMatrixRankDivisionInput shape) := by + have source := GapCVP.TMComposition.computableInPolyTime + sourcePhysicalWordCatalogueRankOriginalSourceComputable + (prependBitComputable false) + have dimension := pointwiseAppendComputable + (paperVariableArityCanonicalBinaryMatrixRankDimensionComputable shape) + source + have separator := GapCVP.TMComposition.computableInPolyTime + dimension (prependBitComputable false) + exact pointwiseAppendComputable + sourcePhysicalWordCatalogueRankUnaryComputable separator + +private def paperCanonicalBinaryMatrixRankDivisionOutput + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + sourceMixedRadixRowMajorPairOutput ∘ + paperCanonicalBinaryMatrixRankDivisionInput shape + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixRankDivisionOutputComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperCanonicalBinaryMatrixRankDivisionOutput shape) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixRankDivisionInputComputable shape) + sourceMixedRadixRowMajorPairComputable + +private def paperCanonicalBinaryMatrixRankRow + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (input : List Bool) : List Bool := + (unaryPrefixOutput + (paperCanonicalBinaryMatrixRankDivisionOutput + shape input)).tail + +private noncomputable def paperVariableArityCanonicalBinaryMatrixRankRowComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperCanonicalBinaryMatrixRankRow shape) := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixRankDivisionOutputComputable + shape) unaryPrefixComputable + exact GapCVP.TMComposition.computableInPolyTime + hprefix dropHeadComputable + +private def paperCanonicalBinaryMatrixRankColumn + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (input : List Bool) : List Bool := + (unaryPrefixOutput + (unaryPrefixSuffixOutput + (paperCanonicalBinaryMatrixRankDivisionOutput + shape input))).tail + +private noncomputable def paperVariableArityCanonicalBinaryMatrixRankColumnComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperCanonicalBinaryMatrixRankColumn shape) := by + have hsuffix := GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixRankDivisionOutputComputable + shape) actualUnaryPrefixSuffixComputable + have hprefix := GapCVP.TMComposition.computableInPolyTime + hsuffix unaryPrefixComputable + exact GapCVP.TMComposition.computableInPolyTime + hprefix dropHeadComputable + +private def paperVariableArityCanonicalBinaryMatrixCheckCandidate + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (input : List Bool) : List Bool := + lengthPrefixedWord + (paperCanonicalBinaryMatrixRankRow shape input) ++ + lengthPrefixedWord + (paperCanonicalBinaryMatrixRankColumn shape input) ++ + sourcePhysicalWordCatalogueRankOriginalSource input + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixCheckCandidateComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperVariableArityCanonicalBinaryMatrixCheckCandidate shape) := by + have row := GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixRankRowComputable shape) + structuralPrefixWriterComputable + have column := GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixRankColumnComputable shape) + structuralPrefixWriterComputable + have physical := pointwiseAppendComputable row + (pointwiseAppendComputable column + sourcePhysicalWordCatalogueRankOriginalSourceComputable) + change BitTM + (fun input => + lengthPrefixedWord + (paperCanonicalBinaryMatrixRankRow shape input) ++ + lengthPrefixedWord + (paperCanonicalBinaryMatrixRankColumn shape input) ++ + sourcePhysicalWordCatalogueRankOriginalSource input) + simpa only [Function.comp_apply, List.append_assoc] using physical + +private theorem paperVariableArityCanonicalBinaryMatrixRankDivisionInput_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (rank dimension : ℕ) (width source : List Bool) + (hdimension : shape.columns source = + List.replicate dimension true) : + paperCanonicalBinaryMatrixRankDivisionInput shape + (sourcePhysicalWordCatalogueRankQuery rank width source) = + sourceUnaryDivisionQuery rank dimension source := by + simp only [paperCanonicalBinaryMatrixRankDivisionInput, + sourcePhysicalWordCatalogueRankUnary_query, + paperVariableArityCanonicalBinaryMatrixRankDimension, Function.comp_apply, + sourcePhysicalWordCatalogueRankOriginalSource_query, hdimension, sourceUnaryDivisionQuery] + +private theorem paperVariableArityCanonicalBinaryMatrixRankDivisionOutput_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (rank dimension : ℕ) (width source : List Bool) + (hdimension : shape.columns source = + List.replicate dimension true) + (hpositive : 0 < dimension) : + paperCanonicalBinaryMatrixRankDivisionOutput shape + (sourcePhysicalWordCatalogueRankQuery rank width source) = + List.replicate (rank / dimension) true ++ false :: + (List.replicate (rank % dimension) true ++ false :: + sourceUnaryDivisionQuery rank dimension source) := by + unfold paperCanonicalBinaryMatrixRankDivisionOutput + rw [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixRankDivisionInput_query + shape rank dimension width source hdimension, + sourceMixedRadixRowMajorPairOutput_valid + rank dimension source hpositive] + +private theorem paperVariableArityCanonicalBinaryMatrixRankRow_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (rank dimension : ℕ) (width source : List Bool) + (hdimension : shape.columns source = + List.replicate dimension true) + (hpositive : 0 < dimension) : + paperCanonicalBinaryMatrixRankRow shape + (sourcePhysicalWordCatalogueRankQuery rank width source) = + List.replicate (rank / dimension) true := by + unfold paperCanonicalBinaryMatrixRankRow + rw [paperVariableArityCanonicalBinaryMatrixRankDivisionOutput_query + shape rank dimension width source hdimension hpositive, + unaryPrefixOutput_replicate_delimiter] + rfl + +private theorem paperVariableArityCanonicalBinaryMatrixRankColumn_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (rank dimension : ℕ) (width source : List Bool) + (hdimension : shape.columns source = + List.replicate dimension true) + (hpositive : 0 < dimension) : + paperCanonicalBinaryMatrixRankColumn shape + (sourcePhysicalWordCatalogueRankQuery rank width source) = + List.replicate (rank % dimension) true := by + unfold paperCanonicalBinaryMatrixRankColumn + rw [paperVariableArityCanonicalBinaryMatrixRankDivisionOutput_query + shape rank dimension width source hdimension hpositive, + unaryPrefixSuffixOutput_valid, + unaryPrefixOutput_replicate_delimiter] + rfl + +private theorem paperVariableArityCanonicalBinaryMatrixCheckCandidate_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (rank dimension : ℕ) (width source : List Bool) + (hdimension : shape.columns source = + List.replicate dimension true) + (hpositive : 0 < dimension) : + paperVariableArityCanonicalBinaryMatrixCheckCandidate shape + (sourcePhysicalWordCatalogueRankQuery rank width source) = + affineCellQuery + (rank / dimension) (rank % dimension) source := by + unfold paperVariableArityCanonicalBinaryMatrixCheckCandidate + affineCellQuery + rw [paperVariableArityCanonicalBinaryMatrixRankRow_query + shape rank dimension width source hdimension hpositive, + paperVariableArityCanonicalBinaryMatrixRankColumn_query + shape rank dimension width source hdimension hpositive, + sourcePhysicalWordCatalogueRankOriginalSource_query] + +private def paperVariableArityCanonicalBinaryMatrixCheckQueryCatalogue + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + maskDynamicGridCandidateCatalogueOutput + (paperCanonicalBinaryMatrixCheckWidth shape) + (paperVariableArityCanonicalBinaryMatrixCheckCandidateComputable shape) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixCheckQueryCatalogueComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperVariableArityCanonicalBinaryMatrixCheckQueryCatalogue shape) := + maskDynamicGridCandidateCatalogueComputable + (paperCanonicalBinaryMatrixCheckWidth shape) + (paperVariableArityCanonicalBinaryMatrixCheckCandidateComputable shape) + +private def paperVariableArityCanonicalBinaryMatrixRhsQueryCatalogue + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + maskDynamicGridCandidateCatalogueOutput + (paperCanonicalBinaryMatrixRhsWidth shape) + sourcePhysicalWordCanonicalRhsCandidateComputable + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixRhsQueryCatalogueComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperVariableArityCanonicalBinaryMatrixRhsQueryCatalogue shape) := + maskDynamicGridCandidateCatalogueComputable + (paperCanonicalBinaryMatrixRhsWidth shape) + sourcePhysicalWordCanonicalRhsCandidateComputable + +/-- GapCVP reduction support. -/ +def paperCanonicalBinaryMatrixCheckQueries + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : List (List Bool) := + let source := encodeThreeCNF formula + let system := shape.system source.length formula + (List.finRange system.rowCount).flatMap fun row => + (List.finRange system.dimension).map fun column => + affineCellQuery row.val column.val source + +/-- GapCVP reduction support. -/ +def paperCanonicalBinaryMatrixRhsQueries + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : List (List Bool) := + let source := encodeThreeCNF formula + let system := shape.system source.length formula + (List.finRange system.rowCount).map fun row => + affineCellQuery row.val 0 source + +private theorem paperVariableArityCanonicalBinaryMatrixCheckQueryCatalogue_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : + paperVariableArityCanonicalBinaryMatrixCheckQueryCatalogue shape + (encodeThreeCNF formula) = + sourceMixedRadixOriginalSourceQueryStream + (paperCanonicalBinaryMatrixCheckQueries + shape formula) := by + let source := encodeThreeCNF formula + let system := shape.system source.length formula + have hdimension : shape.columns source = + List.replicate system.dimension true := + shape.columnsCorrect formula + have hpositive : 0 < system.dimension := + shape.columnsPositive formula + have hwidth := paperVariableArityCanonicalBinaryMatrixCheckWidth_valid + shape formula + have hcatalogue := + maskDynamicGridCandidateCatalogueOutput_valid + (paperCanonicalBinaryMatrixCheckWidth shape) + (paperVariableArityCanonicalBinaryMatrixCheckCandidateComputable shape) + source (system.rowCount * system.dimension) hwidth + change maskDynamicGridCandidateCatalogueOutput + (paperCanonicalBinaryMatrixCheckWidth shape) + (paperVariableArityCanonicalBinaryMatrixCheckCandidateComputable shape) + source = _ + rw [hcatalogue, + sourcePhysicalWordCanonical_range_mul_flatMap] + have hrow : List.range system.rowCount = + (List.finRange system.rowCount).map (fun row => row.val) := + List.map_coe_finRange_eq_range.symm + have hcolumn : List.range system.dimension = + (List.finRange system.dimension).map + (fun column => column.val) := + List.map_coe_finRange_eq_range.symm + simp_rw [hrow, hcolumn] + unfold paperCanonicalBinaryMatrixCheckQueries + sourceMixedRadixOriginalSourceQueryStream + simp only [List.flatMap_assoc, List.flatMap_map] + apply List.flatMap_congr + intro row _ + apply List.flatMap_congr + intro column _ + have hquotient : + (row.val * system.dimension + column.val) / + system.dimension = row.val := by + simpa only [Nat.mul_comm, Nat.div_eq_of_lt column.isLt, add_zero] using + Nat.mul_add_div hpositive row.val column.val + have hremainder : + (row.val * system.dimension + column.val) % + system.dimension = column.val := by + simp only [Nat.add_mod, Nat.mul_mod_left, Nat.mod_eq_of_lt column.isLt, zero_add] + have hcandidate := + paperVariableArityCanonicalBinaryMatrixCheckCandidate_query + shape (row.val * system.dimension + column.val) + system.dimension + ((paperCanonicalBinaryMatrixCheckWidth shape).output + source) + source hdimension hpositive + rw [hquotient, hremainder] at hcandidate + simpa only [sourceQaryMaskDynamicGridBaseSource, sourcePhysicalWordCatalogueRankQuery, + List.append_assoc] using congrArg lengthPrefixedWord hcandidate + +private theorem paperVariableArityCanonicalBinaryMatrixRhsQueryCatalogue_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : + paperVariableArityCanonicalBinaryMatrixRhsQueryCatalogue shape + (encodeThreeCNF formula) = + sourceMixedRadixOriginalSourceQueryStream + (paperCanonicalBinaryMatrixRhsQueries + shape formula) := by + let source := encodeThreeCNF formula + let system := shape.system source.length formula + have hwidth := paperVariableArityCanonicalBinaryMatrixRhsWidth_valid + shape formula + have hcatalogue := + maskDynamicGridCandidateCatalogueOutput_valid + (paperCanonicalBinaryMatrixRhsWidth shape) + sourcePhysicalWordCanonicalRhsCandidateComputable + source system.rowCount hwidth + change maskDynamicGridCandidateCatalogueOutput + (paperCanonicalBinaryMatrixRhsWidth shape) + sourcePhysicalWordCanonicalRhsCandidateComputable source = _ + rw [hcatalogue] + have hrow : List.range system.rowCount = + (List.finRange system.rowCount).map (fun row => row.val) := + List.map_coe_finRange_eq_range.symm + rw [hrow] + unfold paperCanonicalBinaryMatrixRhsQueries + sourceMixedRadixOriginalSourceQueryStream + simp only [List.flatMap_map] + apply List.flatMap_congr + intro row _ + have hcandidate := sourcePhysicalWordCanonicalRhsCandidate_query + row.val + ((paperCanonicalBinaryMatrixRhsWidth shape).output source) + source + simpa only [sourceQaryMaskDynamicGridBaseSource, sourcePhysicalWordCatalogueRankQuery, + List.append_assoc] using congrArg lengthPrefixedWord hcandidate + +/-- GapCVP reduction support. -/ +def paperCanonicalBinaryMatrixCheckFoldPreparation + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (input : List Bool) : List Bool := + (paperCanonicalBinaryMatrixCheckWidth shape).output input ++ + false :: + (paperVariableArityCanonicalBinaryMatrixCheckQueryCatalogue + shape input ++ lengthPrefixedWord input) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixCheckFoldPreparationComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperCanonicalBinaryMatrixCheckFoldPreparation shape) := by + have hsource := GapCVP.TMComposition.computableInPolyTime + (Turing.idComputableInPolyTime bitEncoding) + structuralPrefixWriterComputable + have htail := pointwiseAppendComputable + (paperVariableArityCanonicalBinaryMatrixCheckQueryCatalogueComputable + shape) hsource + have hseparator := GapCVP.TMComposition.computableInPolyTime + htail (prependBitComputable false) + exact pointwiseAppendComputable + (paperVariableArityCanonicalBinaryMatrixRawCheckWidthComputable shape) + hseparator + +/-- GapCVP reduction support. -/ +def paperCanonicalBinaryMatrixRhsFoldPreparation + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (input : List Bool) : List Bool := + (paperCanonicalBinaryMatrixRhsWidth shape).output input ++ + false :: + (paperVariableArityCanonicalBinaryMatrixRhsQueryCatalogue + shape input ++ lengthPrefixedWord input) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixRhsFoldPreparationComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperCanonicalBinaryMatrixRhsFoldPreparation shape) := by + have hsource := GapCVP.TMComposition.computableInPolyTime + (Turing.idComputableInPolyTime bitEncoding) + structuralPrefixWriterComputable + have htail := pointwiseAppendComputable + (paperVariableArityCanonicalBinaryMatrixRhsQueryCatalogueComputable + shape) hsource + have hseparator := GapCVP.TMComposition.computableInPolyTime + htail (prependBitComputable false) + exact pointwiseAppendComputable + shape.rowsComputable hseparator + +theorem paperVariableArityCanonicalBinaryMatrixCheckFoldPreparation_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : + paperCanonicalBinaryMatrixCheckFoldPreparation shape + (encodeThreeCNF formula) = + sourcePhysicalWordPackedQueryPreparation + (paperCanonicalBinaryMatrixCheckQueries + shape formula) + (encodeThreeCNF formula) := by + unfold paperCanonicalBinaryMatrixCheckFoldPreparation + sourcePhysicalWordPackedQueryPreparation unaryBoundedFoldWord + rw [paperVariableArityCanonicalBinaryMatrixCheckWidth_valid + shape formula, + paperVariableArityCanonicalBinaryMatrixCheckQueryCatalogue_valid + shape formula] + congr 1 + simp only [paperCanonicalBinaryMatrixCheckQueries, List.length_flatMap, List.length_map, + List.length_finRange, + List.map_const', List.sum_replicate, smul_eq_mul] + +theorem paperVariableArityCanonicalBinaryMatrixRhsFoldPreparation_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : + paperCanonicalBinaryMatrixRhsFoldPreparation shape + (encodeThreeCNF formula) = + sourcePhysicalWordPackedQueryPreparation + (paperCanonicalBinaryMatrixRhsQueries + shape formula) + (encodeThreeCNF formula) := by + unfold paperCanonicalBinaryMatrixRhsFoldPreparation + sourcePhysicalWordPackedQueryPreparation unaryBoundedFoldWord + rw [paperVariableArityCanonicalBinaryMatrixRhsWidth_valid + shape formula, + paperVariableArityCanonicalBinaryMatrixRhsQueryCatalogue_valid + shape formula] + congr 1 + simp only [paperCanonicalBinaryMatrixRhsQueries, List.length_map, List.length_finRange] + +/-- GapCVP reduction support. -/ +def paperCanonicalBinaryMatrixCheckMarker + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + binaryGaussianFirstCellWord ∘ worker.check + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixCheckMarkerComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperCanonicalBinaryMatrixCheckMarker worker) := + GapCVP.TMComposition.computableInPolyTime + worker.checkComputable binaryGaussianFirstCellComputable + +private theorem paperVariableArityCanonicalBinaryMatrixCheckMarker_length + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : + (paperCanonicalBinaryMatrixCheckMarker + worker input).length ≤ 1 := by + change (binaryGaussianFirstCellWord (worker.check input)).length ≤ 1 + cases hword : worker.check input with + | nil => + simp only [binaryGaussianFirstCellWord, markerConditionalOutput, List.length_cons, + List.length_nil, zero_add, + Std.le_refl] + | cons bit remaining => + rw [binaryGaussianFirstCellWord_valid] + exact Nat.le_refl 1 + +/-- GapCVP reduction support. -/ +def paperCanonicalBinaryMatrixRhsMarker + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + binaryGaussianFirstCellWord ∘ worker.rhs + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixRhsMarkerComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperCanonicalBinaryMatrixRhsMarker worker) := + GapCVP.TMComposition.computableInPolyTime + worker.rhsComputable binaryGaussianFirstCellComputable + +private theorem paperVariableArityCanonicalBinaryMatrixRhsMarker_length + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : + (paperCanonicalBinaryMatrixRhsMarker + worker input).length ≤ 1 := by + change (binaryGaussianFirstCellWord (worker.rhs input)).length ≤ 1 + cases hword : worker.rhs input with + | nil => + simp only [binaryGaussianFirstCellWord, markerConditionalOutput, List.length_cons, + List.length_nil, zero_add, + Std.le_refl] + | cons bit remaining => + rw [binaryGaussianFirstCellWord_valid] + exact Nat.le_refl 1 + +private def paperCanonicalBinaryMatrixCheckFold + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + (paperCanonicalBinaryMatrixCheckMarker worker)) ∘ + paperCanonicalBinaryMatrixCheckFoldPreparation shape + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixCheckFoldComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperCanonicalBinaryMatrixCheckFold worker) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixCheckFoldPreparationComputable + shape) + (fourFamilyOriginalMarkerFoldComputable + (paperVariableArityCanonicalBinaryMatrixCheckMarkerComputable worker) + (paperVariableArityCanonicalBinaryMatrixCheckMarker_length worker)) + +private def paperCanonicalBinaryMatrixRhsFold + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + (paperCanonicalBinaryMatrixRhsMarker worker)) ∘ + paperCanonicalBinaryMatrixRhsFoldPreparation shape + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalBinaryMatrixRhsFoldComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperCanonicalBinaryMatrixRhsFold worker) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixRhsFoldPreparationComputable + shape) + (fourFamilyOriginalMarkerFoldComputable + (paperVariableArityCanonicalBinaryMatrixRhsMarkerComputable worker) + (paperVariableArityCanonicalBinaryMatrixRhsMarker_length worker)) + +private theorem paperVariableArityCanonicalBinaryMatrixCheckFold_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperCanonicalBinaryMatrixCheckFold worker + (encodeThreeCNF formula) = + lengthPrefixedWord (encodeThreeCNF formula) ++ + (paperCanonicalBinaryMatrixCheckQueries + shape formula).flatMap + (paperCanonicalBinaryMatrixCheckMarker worker) := by + unfold paperCanonicalBinaryMatrixCheckFold + simp only [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixCheckFoldPreparation_valid + shape formula] + unfold sourcePhysicalWordPackedQueryPreparation + simpa only [fourFamilyOriginalMarkerStream] using + boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries + (paperCanonicalBinaryMatrixCheckMarker worker) + (paperCanonicalBinaryMatrixCheckQueries shape formula) (lengthPrefixedWord (encodeThreeCNF + formula)) + +private theorem paperVariableArityCanonicalBinaryMatrixRhsFold_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperCanonicalBinaryMatrixRhsFold worker + (encodeThreeCNF formula) = + lengthPrefixedWord (encodeThreeCNF formula) ++ + (paperCanonicalBinaryMatrixRhsQueries + shape formula).flatMap + (paperCanonicalBinaryMatrixRhsMarker worker) := by + unfold paperCanonicalBinaryMatrixRhsFold + simp only [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixRhsFoldPreparation_valid + shape formula] + unfold sourcePhysicalWordPackedQueryPreparation + simpa only [fourFamilyOriginalMarkerStream] using + boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries + (paperCanonicalBinaryMatrixRhsMarker worker) + (paperCanonicalBinaryMatrixRhsQueries shape formula) (lengthPrefixedWord (encodeThreeCNF + formula)) + +private def paperCanonicalBinaryMatrixRecoveredSource + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + firstFieldContents ∘ + paperCanonicalBinaryMatrixCheckFold worker + +private def paperCanonicalBinaryMatrixComputedCheckBits + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + firstFieldSuffix ∘ + paperCanonicalBinaryMatrixCheckFold worker + +private def paperCanonicalBinaryMatrixComputedRhsBits + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + firstFieldSuffix ∘ + paperCanonicalBinaryMatrixRhsFold worker + +/-- GapCVP reduction support. -/ +def paperCanonicalBinaryMatrixPackedOutput + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : List Bool := + lengthPrefixedWord + (paperCanonicalBinaryMatrixComputedCheckBits + worker input) ++ + lengthPrefixedWord + (paperCanonicalBinaryMatrixComputedRhsBits + worker input) ++ + paperCanonicalBinaryMatrixRecoveredSource + worker input + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityCanonicalBinaryMatrixPackedComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperCanonicalBinaryMatrixPackedOutput worker) := by + have hcheck := + paperVariableArityCanonicalBinaryMatrixCheckFoldComputable worker + have hrhs := + paperVariableArityCanonicalBinaryMatrixRhsFoldComputable worker + have hcheckBits := GapCVP.TMComposition.computableInPolyTime + hcheck firstFieldSuffixComputable + have hrhsBits := GapCVP.TMComposition.computableInPolyTime + hrhs firstFieldSuffixComputable + have hsource := GapCVP.TMComposition.computableInPolyTime + hcheck firstFieldContentsComputable + have hcheckRecord := GapCVP.TMComposition.computableInPolyTime + hcheckBits structuralPrefixWriterComputable + have hrhsRecord := GapCVP.TMComposition.computableInPolyTime + hrhsBits structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hcheckRecord + (pointwiseAppendComputable hrhsRecord hsource) + change BitTM + (fun input => + lengthPrefixedWord + (paperCanonicalBinaryMatrixComputedCheckBits + worker input) ++ + lengthPrefixedWord + (paperCanonicalBinaryMatrixComputedRhsBits + worker input) ++ + paperCanonicalBinaryMatrixRecoveredSource + worker input) + simpa only [paperCanonicalBinaryMatrixComputedCheckBits, Function.comp_apply, + paperCanonicalBinaryMatrixComputedRhsBits, paperCanonicalBinaryMatrixRecoveredSource, + List.append_assoc] using + hphysical + +private theorem paperVariableArityCanonicalBinaryMatrixRecoveredSource_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperCanonicalBinaryMatrixRecoveredSource worker + (encodeThreeCNF formula) = + encodeThreeCNF formula := by + unfold paperCanonicalBinaryMatrixRecoveredSource + simp only [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixCheckFold_valid + worker formula] + exact firstFieldContents_valid + (encodeThreeCNF formula) _ + +theorem paperVariableArityCanonicalBinaryMatrixCheckMarker_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) + (row : Fin + (shape.system (encodeThreeCNF formula).length formula).rowCount) + (column : Fin + (shape.system (encodeThreeCNF formula).length formula).dimension) : + paperCanonicalBinaryMatrixCheckMarker worker + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((shape.system (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))] := by + unfold paperCanonicalBinaryMatrixCheckMarker + simp only [Function.comp_apply, + worker.checkCorrect formula row column] + exact binaryGaussianFirstCellWord_valid _ [] + +theorem paperVariableArityCanonicalBinaryMatrixRhsMarker_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) + (row : Fin + (shape.system (encodeThreeCNF formula).length formula).rowCount) + (column : Fin + (shape.system (encodeThreeCNF formula).length formula).dimension) : + paperCanonicalBinaryMatrixRhsMarker worker + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((shape.system (encodeThreeCNF formula).length formula).rightHandSide + row = (1 : ZMod 2))] := by + unfold paperCanonicalBinaryMatrixRhsMarker + simp only [Function.comp_apply, + worker.rhsCorrect formula row column] + exact binaryGaussianFirstCellWord_valid _ [] + +private theorem paperVariableArityCanonicalBinaryMatrixComputedCheckBits_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperCanonicalBinaryMatrixComputedCheckBits worker + (encodeThreeCNF formula) = + sourcePhysicalWordPackedCheckBits + (shape.system (encodeThreeCNF formula).length formula) := by + unfold paperCanonicalBinaryMatrixComputedCheckBits + simp only [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixCheckFold_valid + worker formula] + rw [firstFieldSuffix_valid] + unfold paperCanonicalBinaryMatrixCheckQueries + sourcePhysicalWordPackedCheckBits + simp only [List.flatMap_assoc, List.flatMap_map] + apply List.flatMap_congr + intro row _ + calc + (List.finRange + (shape.system (encodeThreeCNF formula).length + formula).dimension).flatMap + (fun column => + paperCanonicalBinaryMatrixCheckMarker worker + (affineCellQuery + row.val column.val (encodeThreeCNF formula))) = + (List.finRange + (shape.system (encodeThreeCNF formula).length + formula).dimension).flatMap + (fun column => + [decide + ((shape.system (encodeThreeCNF formula).length + formula).check row column = (1 : ZMod 2))]) := by + apply List.flatMap_congr + intro column _ + exact paperVariableArityCanonicalBinaryMatrixCheckMarker_valid + worker formula row column + _ = + (List.finRange + (shape.system (encodeThreeCNF formula).length + formula).dimension).map + (fun column => decide + ((shape.system (encodeThreeCNF formula).length + formula).check row column = (1 : ZMod 2))) := + sourcePhysicalWordPackedFlatMap_singleton _ _ + +private theorem paperVariableArityCanonicalBinaryMatrixComputedRhsBits_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperCanonicalBinaryMatrixComputedRhsBits worker + (encodeThreeCNF formula) = + sourcePhysicalWordPackedRhsBits + (shape.system (encodeThreeCNF formula).length formula) := by + unfold paperCanonicalBinaryMatrixComputedRhsBits + simp only [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixRhsFold_valid + worker formula] + rw [firstFieldSuffix_valid] + unfold paperCanonicalBinaryMatrixRhsQueries + sourcePhysicalWordPackedRhsBits + simp only [List.flatMap_map] + let column : Fin + (shape.system (encodeThreeCNF formula).length + formula).dimension := + ⟨0, shape.columnsPositive formula⟩ + calc + (List.finRange + (shape.system (encodeThreeCNF formula).length + formula).rowCount).flatMap + (fun row => + paperCanonicalBinaryMatrixRhsMarker worker + (affineCellQuery row.val 0 + (encodeThreeCNF formula))) = + (List.finRange + (shape.system (encodeThreeCNF formula).length + formula).rowCount).flatMap + (fun row => + [decide + ((shape.system (encodeThreeCNF formula).length + formula).rightHandSide row = (1 : ZMod 2))]) := by + apply List.flatMap_congr + intro row _ + simpa only [column] using paperVariableArityCanonicalBinaryMatrixRhsMarker_valid worker + formula row column + _ = + (List.finRange + (shape.system (encodeThreeCNF formula).length + formula).rowCount).map + (fun row => decide + ((shape.system (encodeThreeCNF formula).length + formula).rightHandSide row = (1 : ZMod 2))) := + sourcePhysicalWordPackedFlatMap_singleton _ _ + +theorem paperVariableArityCanonicalBinaryMatrixPackedOutput_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperCanonicalBinaryMatrixPackedOutput worker + (encodeThreeCNF formula) = + lengthPrefixedWord + (sourcePhysicalWordPackedCheckBits + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula)) ++ + lengthPrefixedWord + (sourcePhysicalWordPackedRhsBits + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula)) ++ + encodeThreeCNF formula := by + unfold paperCanonicalBinaryMatrixPackedOutput + rw [paperVariableArityCanonicalBinaryMatrixComputedCheckBits_valid + worker formula, + paperVariableArityCanonicalBinaryMatrixComputedRhsBits_valid + worker formula, + paperVariableArityCanonicalBinaryMatrixRecoveredSource_valid + worker formula, + shape.systemCorrect (encodeThreeCNF formula).length formula] + +end CanonicalSourceCatalogue + +namespace GaussianAdaptivePhysicalCandidateCatalogueTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryExplicitAffineRows +open GapCVP.GaussianPivotScheduleTM GapCVP.GaussianAdaptiveEliminationCorrectness +open GapCVP.GaussianAdaptivePackedTraceCorrectness GapCVP.GaussianAdaptivePhysicalStateCellTM +open GapCVP.GaussianAdaptivePackedStateLookupTM + +/-- GapCVP reduction support. -/ +def gaussianPhysicalPivotColumnQuery + (column : ℕ) (state : List Bool) : List Bool := + lengthPrefixedWord (List.replicate column true) ++ state + +private def gaussianPhysicalPivotColumnPackedState : List Bool → List Bool := + firstFieldSuffix + +private noncomputable def gaussianPhysicalPivotColumnPackedStateComputable : + BitTM + gaussianPhysicalPivotColumnPackedState := + firstFieldSuffixComputable + +private def gaussianPhysicalPivotRowWidthOutput : List Bool → List Bool := + gaussianDenseStateRowCountUnary ∘ + gaussianPhysicalPivotColumnPackedState + +private noncomputable def gaussianPhysicalPivotRowWidthComputable : + BitTM + gaussianPhysicalPivotRowWidthOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotColumnPackedStateComputable + gaussianDenseStateRowCountUnaryComputable + +private noncomputable def gaussianPhysicalPivotRowWidth : + SourceQaryMaskDynamicGridWidth where + output := gaussianPhysicalPivotRowWidthOutput + computer := gaussianPhysicalPivotRowWidthComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalPivotRecordWord + (row width column : ℕ) (state : List Bool) : List Bool := + lengthPrefixedWord (List.replicate row true) ++ + lengthPrefixedWord (List.replicate width true) ++ + gaussianPhysicalPivotColumnQuery column state + +/-- GapCVP reduction support. -/ +def gaussianPhysicalPivotRecordRow : List Bool → List Bool := + firstFieldContents + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalPivotRecordRowComputable : + BitTM + gaussianPhysicalPivotRecordRow := + firstFieldContentsComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalPivotRecordColumn : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ firstFieldSuffix + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalPivotRecordColumnComputable : + BitTM + gaussianPhysicalPivotRecordColumn := by + have hwidth := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hwidth firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalPivotRecordState : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalPivotRecordStateComputable : + BitTM + gaussianPhysicalPivotRecordState := by + have hwidth := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hwidth firstFieldSuffixComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalPivotRecordNextUnary : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ firstFieldSuffix ∘ + gaussianPhysicalPivotRecordState + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalPivotRecordNextUnaryComputable : + BitTM + gaussianPhysicalPivotRecordNextUnary := by + have hcheck := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotRecordStateComputable + firstFieldSuffixComputable + have hrhs := GapCVP.TMComposition.computableInPolyTime + hcheck firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hrhs firstFieldContentsComputable + +private def gaussianPhysicalPivotRecordEligible : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + (fourFamilyComputedUnaryLessBitOutput + gaussianPhysicalPivotRecordRow + gaussianPhysicalPivotRecordNextUnary) + +private noncomputable def gaussianPhysicalPivotRecordEligibleComputable : + BitTM + gaussianPhysicalPivotRecordEligible := + fourFamilyBooleanNotOutputComputable + (fourFamilyComputedUnaryLessBitComputable + gaussianPhysicalPivotRecordRowComputable + gaussianPhysicalPivotRecordNextUnaryComputable) + +private def gaussianPhysicalPivotRecordCellQuery + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPhysicalPivotRecordRow input) ++ + lengthPrefixedWord (gaussianPhysicalPivotRecordColumn input) ++ + gaussianPhysicalPivotRecordState input + +private noncomputable def gaussianPhysicalPivotRecordCellQueryComputable : + BitTM + gaussianPhysicalPivotRecordCellQuery := by + have hrow := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotRecordRowComputable + structuralPrefixWriterComputable + have hcolumn := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotRecordColumnComputable + structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hrow + (pointwiseAppendComputable hcolumn + gaussianPhysicalPivotRecordStateComputable) + have hsimplified : + BitTM + (fun input => + lengthPrefixedWord (gaussianPhysicalPivotRecordRow input) ++ + (lengthPrefixedWord + (gaussianPhysicalPivotRecordColumn input) ++ + gaussianPhysicalPivotRecordState input)) := by + simpa only [Function.comp_apply] using hphysical + have heq : + (fun input => + lengthPrefixedWord (gaussianPhysicalPivotRecordRow input) ++ + (lengthPrefixedWord + (gaussianPhysicalPivotRecordColumn input) ++ + gaussianPhysicalPivotRecordState input)) = + gaussianPhysicalPivotRecordCellQuery := by + funext input + simp only [gaussianPhysicalPivotRecordCellQuery, + List.append_assoc] + rw [heq] at hsimplified + exact hsimplified + +private def gaussianPhysicalPivotRecordCheckBit : List Bool → List Bool := + gaussianPackedStateCheckCellWord ∘ + gaussianPhysicalPivotRecordCellQuery + +private noncomputable def gaussianPhysicalPivotRecordCheckBitComputable : + BitTM + gaussianPhysicalPivotRecordCheckBit := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotRecordCellQueryComputable + gaussianPackedStateCheckCellComputable + +private def gaussianPhysicalPivotRecordBit : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + gaussianPhysicalPivotRecordEligible + gaussianPhysicalPivotRecordCheckBit + +private noncomputable def gaussianPhysicalPivotRecordBitComputable : + BitTM + gaussianPhysicalPivotRecordBit := + fourFamilyBooleanAndComputable + gaussianPhysicalPivotRecordEligibleComputable + gaussianPhysicalPivotRecordCheckBitComputable + +@[simp] private theorem gaussianPhysicalPivotRowWidthOutput_query + {m n : ℕ} (state : State m n) + (source : List Bool) (column : ℕ) : + gaussianPhysicalPivotRowWidthOutput + (gaussianPhysicalPivotColumnQuery column + (effectiveGaussianPackedStateWord state source)) = + List.replicate m true := by + simp only [gaussianPhysicalPivotRowWidthOutput, gaussianPhysicalPivotColumnPackedState, + gaussianPhysicalPivotColumnQuery, Function.comp_apply, firstFieldSuffix_valid, + gaussianDenseStateRowCountUnary_effective] + +@[simp] theorem gaussianPhysicalPivotRecordRow_word + (row width column : ℕ) (state : List Bool) : + gaussianPhysicalPivotRecordRow + (gaussianPhysicalPivotRecordWord row width column state) = + List.replicate row true := by + simp only [gaussianPhysicalPivotRecordRow, gaussianPhysicalPivotRecordWord, List.append_assoc, + firstFieldContents_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem gaussianPhysicalPivotRecordColumn_word + (row width column : ℕ) (state : List Bool) : + gaussianPhysicalPivotRecordColumn + (gaussianPhysicalPivotRecordWord row width column state) = + List.replicate column true := by + simp only [gaussianPhysicalPivotRecordColumn, gaussianPhysicalPivotRecordWord, + gaussianPhysicalPivotColumnQuery, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid, + firstFieldContents_valid] + +@[simp] theorem gaussianPhysicalPivotRecordState_word + (row width column : ℕ) (state : List Bool) : + gaussianPhysicalPivotRecordState + (gaussianPhysicalPivotRecordWord row width column state) = + state := by + simp only [gaussianPhysicalPivotRecordState, gaussianPhysicalPivotRecordWord, + gaussianPhysicalPivotColumnQuery, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem gaussianPhysicalPivotRecordNextUnary_word + {m n : ℕ} (state : State m n) + (source : List Bool) (row width column : ℕ) : + gaussianPhysicalPivotRecordNextUnary + (gaussianPhysicalPivotRecordWord row width column + (effectiveGaussianPackedStateWord state source)) = + List.replicate state.nextPivot true := by + simp only [gaussianPhysicalPivotRecordNextUnary, effectiveGaussianPackedStateWord, + List.append_assoc, + Function.comp_apply, gaussianPhysicalPivotRecordState_word, firstFieldSuffix_valid, + firstFieldContents_valid] + +private theorem gaussianPhysicalPivotRecordEligible_word + {m n : ℕ} (state : State m n) + (source : List Bool) (row width column : ℕ) : + gaussianPhysicalPivotRecordEligible + (gaussianPhysicalPivotRecordWord row width column + (effectiveGaussianPackedStateWord state source)) = + [decide (state.nextPivot ≤ row)] := by + let input := gaussianPhysicalPivotRecordWord row width column + (effectiveGaussianPackedStateWord state source) + have hless := fourFamilyComputedUnaryLessBitOutput_valid + gaussianPhysicalPivotRecordRow + gaussianPhysicalPivotRecordNextUnary input row state.nextPivot + (gaussianPhysicalPivotRecordRow_word row width column + (effectiveGaussianPackedStateWord state source)) + (gaussianPhysicalPivotRecordNextUnary_word + state source row width column) + change gaussianPhysicalPivotRecordEligible input = _ + unfold gaussianPhysicalPivotRecordEligible + rw [fourFamilyBooleanNotOutput_bit _ input _ hless] + by_cases hrow : row < state.nextPivot + · have hnot : ¬ state.nextPivot ≤ row := by omega + simp only [hrow, decide_true, Bool.not_true, hnot, decide_false] + · have hle : state.nextPivot ≤ row := by omega + simp only [hrow, decide_false, Bool.not_false, hle, decide_true] + +@[simp] private theorem gaussianPhysicalPivotRecordCellQuery_word + (row width column : ℕ) (state : List Bool) : + gaussianPhysicalPivotRecordCellQuery + (gaussianPhysicalPivotRecordWord row width column state) = + affineCellQuery row column state := by + simp only [gaussianPhysicalPivotRecordCellQuery, gaussianPhysicalPivotRecordRow_word, + gaussianPhysicalPivotRecordColumn_word, gaussianPhysicalPivotRecordState_word, + List.append_assoc, affineCellQuery] + +private theorem gaussianPhysicalPivotRecordCheckBit_word + {m n : ℕ} (state : State m n) + (source : List Bool) (row : Fin m) (column : Fin n) + (width : ℕ) (hrows : 0 < m) : + gaussianPhysicalPivotRecordCheckBit + (gaussianPhysicalPivotRecordWord row.val width column.val + (effectiveGaussianPackedStateWord state source)) = + [decide (state.system.check row column = (1 : ZMod 2))] := by + unfold gaussianPhysicalPivotRecordCheckBit + rw [Function.comp_apply, + gaussianPhysicalPivotRecordCellQuery_word] + exact gaussianPackedStateCheckCellWord_query + state source row column hrows + +private theorem gaussianPhysicalPivotRecordBit_word + {m n : ℕ} (state : State m n) + (source : List Bool) (row : Fin m) (column : Fin n) + (width : ℕ) (hrows : 0 < m) : + gaussianPhysicalPivotRecordBit + (gaussianPhysicalPivotRecordWord row.val width column.val + (effectiveGaussianPackedStateWord state source)) = + [decide (state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2))] := by + let input := gaussianPhysicalPivotRecordWord + row.val width column.val + (effectiveGaussianPackedStateWord state source) + have heligible := gaussianPhysicalPivotRecordEligible_word + state source row.val width column.val + have hcheck := gaussianPhysicalPivotRecordCheckBit_word + state source row column width hrows + change gaussianPhysicalPivotRecordBit input = _ + unfold gaussianPhysicalPivotRecordBit + rw [fourFamilyBooleanAndOutput_bits _ _ input _ _ + heligible hcheck] + by_cases hrow : state.nextPivot ≤ row.val <;> + by_cases hentry : state.system.check row column = (1 : ZMod 2) <;> + simp [hrow, hentry] + +private def gaussianPhysicalPivotCandidateCatalogueOutput : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + gaussianPhysicalPivotRowWidth + gaussianPhysicalPivotRecordBitComputable + +private noncomputable def gaussianPhysicalPivotCandidateCatalogueComputable : + BitTM + gaussianPhysicalPivotCandidateCatalogueOutput := + maskDynamicGridRecordCatalogueComputable + gaussianPhysicalPivotRowWidth + gaussianPhysicalPivotRecordBitComputable + +private theorem gaussianPhysicalPivotCandidateCatalogueOutput_valid + (input : List Bool) (count : ℕ) + (hwidth : gaussianPhysicalPivotRowWidth.output input = + List.replicate count true) : + gaussianPhysicalPivotCandidateCatalogueOutput input = + (List.range count).flatMap (fun rank => + gaussianPhysicalPivotRecordBit + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalPivotRowWidth input)) := by + exact maskDynamicGridRecordCatalogueOutput_valid + gaussianPhysicalPivotRowWidth + gaussianPhysicalPivotRecordBitComputable input count hwidth + +private theorem gaussianPhysicalPivotRowWidth_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : ℕ) : + gaussianPhysicalPivotRowWidth.output + (gaussianPhysicalPivotColumnQuery column + (effectiveGaussianPackedStateWord state source)) = + List.replicate m true := by + exact gaussianPhysicalPivotRowWidthOutput_query + state source column + +private theorem gaussianPhysicalPivotGeneratedRecord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : ℕ) (row : ℕ) : + lengthPrefixedWord (List.replicate row true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalPivotRowWidth + (gaussianPhysicalPivotColumnQuery column + (effectiveGaussianPackedStateWord state source)) = + gaussianPhysicalPivotRecordWord row m column + (effectiveGaussianPackedStateWord state source) := by + unfold sourceQaryMaskDynamicGridBaseSource + rw [gaussianPhysicalPivotRowWidth_effective + state source column] + simp only [gaussianPhysicalPivotRecordWord, + List.append_assoc] + +theorem gaussianPhysicalPivot_range_flatMap_finRange + {α : Type} (count : ℕ) (record : ℕ → List α) : + (List.range count).flatMap record = + (List.finRange count).flatMap + (fun index => record index.val) := by + have hrange : (List.finRange count).map Fin.val = + List.range count := by + simp only [List.map_coe_finRange_eq_range] + calc + (List.range count).flatMap record = + ((List.finRange count).map Fin.val).flatMap record := by + rw [hrange] + _ = (List.finRange count).flatMap + (fun index => record index.val) := by + rw [List.flatMap_map] + +private theorem gaussianPhysicalPivotCandidateCatalogueOutput_grid_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) : + gaussianPhysicalPivotCandidateCatalogueOutput + (gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source)) = + (List.range m).flatMap (fun row => + gaussianPhysicalPivotRecordBit + (gaussianPhysicalPivotRecordWord row m column.val + (effectiveGaussianPackedStateWord state source))) := by + let input := gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source) + have hwidth : gaussianPhysicalPivotRowWidth.output input = + List.replicate m true := + gaussianPhysicalPivotRowWidth_effective + state source column.val + calc + gaussianPhysicalPivotCandidateCatalogueOutput input = + (List.range m).flatMap (fun row => + gaussianPhysicalPivotRecordBit + (lengthPrefixedWord (List.replicate row true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalPivotRowWidth input)) := + gaussianPhysicalPivotCandidateCatalogueOutput_valid + input m hwidth + _ = (List.range m).flatMap (fun row => + gaussianPhysicalPivotRecordBit + (gaussianPhysicalPivotRecordWord row m column.val + (effectiveGaussianPackedStateWord state source))) := by + apply List.flatMap_congr + intro row _ + exact congrArg gaussianPhysicalPivotRecordBit + (gaussianPhysicalPivotGeneratedRecord_effective + state source column.val row) + +private theorem gaussianPhysicalPivotCandidateRange_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) + (hrows : 0 < m) : + (List.range m).flatMap (fun row => + gaussianPhysicalPivotRecordBit + (gaussianPhysicalPivotRecordWord row m column.val + (effectiveGaussianPackedStateWord state source))) = + effectiveGaussianPivotCandidates state column := by + rw [gaussianPhysicalPivot_range_flatMap_finRange] + unfold effectiveGaussianPivotCandidates + rw [← List.flatMap_singleton' + ((List.finRange m).map (fun row => + decide (state.nextPivot ≤ row.val ∧ + state.system.check row column = (1 : ZMod 2))))] + rw [List.flatMap_map] + apply List.flatMap_congr + intro row _ + exact gaussianPhysicalPivotRecordBit_word + state source row column m hrows + +private theorem gaussianPhysicalPivotCandidateCatalogueOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) + (hrows : 0 < m) : + gaussianPhysicalPivotCandidateCatalogueOutput + (gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianPivotCandidates state column := by + rw [gaussianPhysicalPivotCandidateCatalogueOutput_grid_effective + state source column] + exact gaussianPhysicalPivotCandidateRange_effective + state source column hrows + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalPivotDecisionOutput : List Bool → List Bool := + binaryGaussianPivotWord ∘ + gaussianPhysicalPivotCandidateCatalogueOutput + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalPivotDecisionComputable : + BitTM + gaussianPhysicalPivotDecisionOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotCandidateCatalogueComputable + binaryGaussianPivotComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem gaussianPhysicalPivotDecisionOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) + (hrows : 0 < m) : + gaussianPhysicalPivotDecisionOutput + (gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source)) = + match findPivotOption state column with + | none => [false] + | some row => true :: List.replicate row.val true := by + unfold gaussianPhysicalPivotDecisionOutput + rw [Function.comp_apply, + gaussianPhysicalPivotCandidateCatalogueOutput_effective + state source column hrows] + exact binaryGaussianPivotWord_effective state column + +end GaussianAdaptivePhysicalCandidateCatalogueTM + +namespace GaussianAdaptivePhysicalColumnCellUpdateSemantics + +open GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian + +private theorem clearTarget_check_of_other_row + {m n : ℕ} (pivot : Fin m) (active other : Fin n) + (state : State m n) (target row : Fin m) + (different : row ≠ target) : + (clearTarget pivot active state target).system.check row other = + state.system.check row other := by + unfold clearTarget + split + · rfl + · split + · simp only [applyOperation, RowOperation.apply, addRow, different, ↓reduceIte] + · rfl + +private theorem clearTarget_rhs_of_other_row + {m n : ℕ} (pivot : Fin m) (active : Fin n) + (state : State m n) (target row : Fin m) + (different : row ≠ target) : + (clearTarget pivot active state target).system.rhs row = + state.system.rhs row := by + unfold clearTarget + split + · rfl + · split + · simp only [applyOperation, RowOperation.apply, addRow, different, ↓reduceIte] + · rfl + +private theorem clearTargets_check_of_not_mem + {m n : ℕ} (pivot : Fin m) (active other : Fin n) + (targets : List (Fin m)) (state : State m n) (row : Fin m) + (absent : row ∉ targets) : + (clearTargets pivot active targets state).system.check row other = + state.system.check row other := by + induction targets generalizing state with + | nil => rfl + | cons target remaining ih => + have different : row ≠ target := by + intro equal + apply absent + simp only [equal, List.mem_cons, true_or] + have remainingAbsent : row ∉ remaining := by + intro present + apply absent + exact List.mem_cons_of_mem target present + change + (clearTargets pivot active remaining + (clearTarget pivot active state target)).system.check row other = + state.system.check row other + rw [ih (clearTarget pivot active state target) remainingAbsent] + exact clearTarget_check_of_other_row + pivot active other state target row different + +private theorem clearTargets_rhs_of_not_mem + {m n : ℕ} (pivot : Fin m) (active : Fin n) + (targets : List (Fin m)) (state : State m n) (row : Fin m) + (absent : row ∉ targets) : + (clearTargets pivot active targets state).system.rhs row = + state.system.rhs row := by + induction targets generalizing state with + | nil => rfl + | cons target remaining ih => + have different : row ≠ target := by + intro equal + apply absent + simp only [equal, List.mem_cons, true_or] + have remainingAbsent : row ∉ remaining := by + intro present + apply absent + exact List.mem_cons_of_mem target present + change + (clearTargets pivot active remaining + (clearTarget pivot active state target)).system.rhs row = + state.system.rhs row + rw [ih (clearTarget pivot active state target) remainingAbsent] + exact clearTarget_rhs_of_other_row + pivot active state target row different + +private theorem clearTargets_check_of_nodup + {m n : ℕ} (pivot : Fin m) (active other : Fin n) + (targets : List (Fin m)) (distinct : targets.Nodup) + (state : State m n) (row : Fin m) : + (clearTargets pivot active targets state).system.check row other = + if row ∈ targets ∧ row ≠ pivot ∧ + state.system.check row active = (1 : ZMod 2) then + state.system.check row other + state.system.check pivot other + else + state.system.check row other := by + induction targets generalizing state with + | nil => + simp only [clearTargets, List.foldl_nil, List.not_mem_nil, ne_eq, false_and, ↓reduceIte] + | cons target remaining ih => + have remainingDistinct : remaining.Nodup := + List.nodup_cons.mp distinct |>.2 + by_cases equal : row = target + · subst target + have absent : row ∉ remaining := + (List.nodup_cons.mp distinct).1 + change + (clearTargets pivot active remaining + (clearTarget pivot active state row)).system.check row other = _ + rw [clearTargets_check_of_not_mem + pivot active other remaining + (clearTarget pivot active state row) row absent] + by_cases pivotEqual : row = pivot + · simp only [clearTarget, pivotEqual, ↓reduceDIte, List.mem_cons, true_or, ne_eq, + not_true_eq_false, false_and, + and_false, ↓reduceIte] + · by_cases selected : + state.system.check row active = (1 : ZMod 2) + · simp only [clearTarget, pivotEqual, ↓reduceDIte, selected, ↓reduceIte, applyOperation, + RowOperation.apply, + addRow, List.mem_cons, true_or, ne_eq, not_false_eq_true, and_self] + · simp only [clearTarget, pivotEqual, ↓reduceDIte, selected, ↓reduceIte, List.mem_cons, + true_or, ne_eq, + not_false_eq_true, and_false] + · change + (clearTargets pivot active remaining + (clearTarget pivot active state target)).system.check row other = _ + rw [ih remainingDistinct (clearTarget pivot active state target)] + rw [clearTarget_check_of_other_row + pivot active active state target row equal] + rw [clearTarget_check_of_other_row + pivot active other state target row equal] + rw [clearTarget_check_pivot pivot active other state target] + simp only [List.mem_cons, equal, false_or] + +private theorem clearTargets_rhs_of_nodup + {m n : ℕ} (pivot : Fin m) (active : Fin n) + (targets : List (Fin m)) (distinct : targets.Nodup) + (state : State m n) (row : Fin m) : + (clearTargets pivot active targets state).system.rhs row = + if row ∈ targets ∧ row ≠ pivot ∧ + state.system.check row active = (1 : ZMod 2) then + state.system.rhs row + state.system.rhs pivot + else + state.system.rhs row := by + induction targets generalizing state with + | nil => + simp only [clearTargets, List.foldl_nil, List.not_mem_nil, ne_eq, false_and, ↓reduceIte] + | cons target remaining ih => + have remainingDistinct : remaining.Nodup := + List.nodup_cons.mp distinct |>.2 + by_cases equal : row = target + · subst target + have absent : row ∉ remaining := + (List.nodup_cons.mp distinct).1 + change + (clearTargets pivot active remaining + (clearTarget pivot active state row)).system.rhs row = _ + rw [clearTargets_rhs_of_not_mem + pivot active remaining + (clearTarget pivot active state row) row absent] + by_cases pivotEqual : row = pivot + · simp only [clearTarget, pivotEqual, ↓reduceDIte, List.mem_cons, true_or, ne_eq, + not_true_eq_false, false_and, + and_false, ↓reduceIte] + · by_cases selected : + state.system.check row active = (1 : ZMod 2) + · simp only [clearTarget, pivotEqual, ↓reduceDIte, selected, ↓reduceIte, applyOperation, + RowOperation.apply, + addRow, List.mem_cons, true_or, ne_eq, not_false_eq_true, and_self] + · simp only [clearTarget, pivotEqual, ↓reduceDIte, selected, ↓reduceIte, List.mem_cons, + true_or, ne_eq, + not_false_eq_true, and_false] + · change + (clearTargets pivot active remaining + (clearTarget pivot active state target)).system.rhs row = _ + rw [ih remainingDistinct (clearTarget pivot active state target)] + rw [clearTarget_check_of_other_row + pivot active active state target row equal] + rw [clearTarget_rhs_of_other_row + pivot active state target row equal] + rw [clearTarget_rhs_pivot pivot active state target] + simp only [List.mem_cons, equal, false_or] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem clearTargets_check_finRange + {m n : ℕ} (pivot : Fin m) (active other : Fin n) + (state : State m n) (row : Fin m) : + (clearTargets pivot active (List.finRange m) state).system.check + row other = + if row ≠ pivot ∧ + state.system.check row active = (1 : ZMod 2) then + state.system.check row other + state.system.check pivot other + else + state.system.check row other := by + have exact := clearTargets_check_of_nodup + pivot active other (List.finRange m) + (List.nodup_finRange m) state row + simpa only [ne_eq, List.mem_finRange, true_and] using exact + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem clearTargets_rhs_finRange + {m n : ℕ} (pivot : Fin m) (active : Fin n) + (state : State m n) (row : Fin m) : + (clearTargets pivot active (List.finRange m) state).system.rhs row = + if row ≠ pivot ∧ + state.system.check row active = (1 : ZMod 2) then + state.system.rhs row + state.system.rhs pivot + else + state.system.rhs row := by + have exact := clearTargets_rhs_of_nodup + pivot active (List.finRange m) + (List.nodup_finRange m) state row + simpa only [ne_eq, List.mem_finRange, true_and] using exact + +end GaussianAdaptivePhysicalColumnCellUpdateSemantics + +namespace GaussianAdaptivePhysicalColumnCellUpdateTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryExplicitAffineRows +open GapCVP.GaussianRowWorker GapCVP.GaussianAdaptivePivotStepTM +open GapCVP.GaussianAdaptivePackedTraceCorrectness GapCVP.GaussianAdaptivePackedStateLookupTM +open GapCVP.GaussianAdaptivePhysicalCandidateCatalogueTM +open GapCVP.GaussianAdaptivePhysicalColumnCellUpdateSemantics +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceFourFamilyDiagonalMembershipPredicateTM + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnCellQuery + (row column active : ℕ) (state : List Bool) : List Bool := + affineCellQuery row column + (gaussianPhysicalPivotColumnQuery active state) + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev gaussianPhysicalColumnCellRow : List Bool → List Bool := + sourceExplicitAffineCellRow + +/-- Internal support shared across GapCVP continuation modules. -/ +abbrev gaussianPhysicalColumnCellColumn : List Bool → List Bool := + sourceExplicitAffineCellColumn + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnCellActive : List Bool → List Bool := + firstFieldContents ∘ sourceExplicitAffineCellOriginalSource + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalColumnCellActiveComputable : + BitTM + gaussianPhysicalColumnCellActive := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + firstFieldContentsComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnCellPackedState : List Bool → List Bool := + firstFieldSuffix ∘ sourceExplicitAffineCellOriginalSource + +private noncomputable def gaussianPhysicalColumnCellPackedStateComputable : + BitTM + gaussianPhysicalColumnCellPackedState := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + firstFieldSuffixComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem gaussianPhysicalColumnCellRow_query + (row column active : ℕ) (state : List Bool) : + gaussianPhysicalColumnCellRow + (gaussianPhysicalColumnCellQuery row column active state) = + List.replicate row true := by + exact sourceExplicitAffineCellRow_query row column + (gaussianPhysicalPivotColumnQuery active state) + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem gaussianPhysicalColumnCellColumn_query + (row column active : ℕ) (state : List Bool) : + gaussianPhysicalColumnCellColumn + (gaussianPhysicalColumnCellQuery row column active state) = + List.replicate column true := by + exact sourceExplicitAffineCellColumn_query row column + (gaussianPhysicalPivotColumnQuery active state) + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem gaussianPhysicalColumnCellActive_query + (row column active : ℕ) (state : List Bool) : + gaussianPhysicalColumnCellActive + (gaussianPhysicalColumnCellQuery row column active state) = + List.replicate active true := by + simp only [gaussianPhysicalColumnCellActive, gaussianPhysicalColumnCellQuery, + gaussianPhysicalPivotColumnQuery, Function.comp_apply, + sourceExplicitAffineCellOriginalSource_query, + firstFieldContents_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem gaussianPhysicalColumnCellPackedState_query + (row column active : ℕ) (state : List Bool) : + gaussianPhysicalColumnCellPackedState + (gaussianPhysicalColumnCellQuery row column active state) = + state := by + simp only [gaussianPhysicalColumnCellPackedState, gaussianPhysicalColumnCellQuery, + gaussianPhysicalPivotColumnQuery, Function.comp_apply, + sourceExplicitAffineCellOriginalSource_query, + firstFieldSuffix_valid] + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnDecisionQuery + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPhysicalColumnCellActive input) ++ + gaussianPhysicalColumnCellPackedState input + +private noncomputable def gaussianPhysicalColumnDecisionQueryComputable : + BitTM + gaussianPhysicalColumnDecisionQuery := by + have hactive := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnCellActiveComputable + structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable + hactive gaussianPhysicalColumnCellPackedStateComputable + change BitTM + (fun input => + lengthPrefixedWord (gaussianPhysicalColumnCellActive input) ++ + gaussianPhysicalColumnCellPackedState input) + simpa only [Function.comp_apply] using hphysical + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem gaussianPhysicalColumnDecisionQuery_query + (row column active : ℕ) (state : List Bool) : + gaussianPhysicalColumnDecisionQuery + (gaussianPhysicalColumnCellQuery row column active state) = + gaussianPhysicalPivotColumnQuery active state := by + simp only [gaussianPhysicalColumnDecisionQuery, gaussianPhysicalColumnCellActive_query, + gaussianPhysicalColumnCellPackedState_query, gaussianPhysicalPivotColumnQuery] + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnDecisionWord : List Bool → List Bool := + gaussianPhysicalPivotDecisionOutput ∘ + gaussianPhysicalColumnDecisionQuery + +private noncomputable def gaussianPhysicalColumnDecisionComputable : + BitTM + gaussianPhysicalColumnDecisionWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnDecisionQueryComputable + gaussianPhysicalPivotDecisionComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnPivotPresentWord : List Bool → List Bool := + binaryGaussianFirstCellWord ∘ gaussianPhysicalColumnDecisionWord + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnPivotPresentComputable : + BitTM + gaussianPhysicalColumnPivotPresentWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnDecisionComputable + binaryGaussianFirstCellComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnPivotPresent + (input : List Bool) : Bool := + (gaussianPhysicalColumnPivotPresentWord input).headD false + +private theorem gaussianPhysicalColumnPivotPresentWord_singleton + (input : List Bool) : + gaussianPhysicalColumnPivotPresentWord input = + [gaussianPhysicalColumnPivotPresent input] := by + change binaryGaussianFirstCellWord + (gaussianPhysicalColumnDecisionWord input) = + [(binaryGaussianFirstCellWord + (gaussianPhysicalColumnDecisionWord input)).headD false] + cases gaussianPhysicalColumnDecisionWord input with + | nil => rfl + | cons bit remaining => + cases bit <;> rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalColumnPivotSelectionComputable : + BitTM + (fun input => gaussianPhysicalColumnPivotPresent input :: input) := by + have hphysical := pointwiseAppendComputable + gaussianPhysicalColumnPivotPresentComputable + (Turing.idComputableInPolyTime bitEncoding) + change BitTM + (fun input => gaussianPhysicalColumnPivotPresentWord input ++ input) + at hphysical + have heq : + (fun input => gaussianPhysicalColumnPivotPresentWord input ++ input) = + (fun input => gaussianPhysicalColumnPivotPresent input :: input) := by + funext input + rw [gaussianPhysicalColumnPivotPresentWord_singleton] + rfl + rw [heq] at hphysical + exact hphysical + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnCandidateUnary : List Bool → List Bool := + List.tail ∘ gaussianPhysicalColumnDecisionWord + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalColumnCandidateUnaryComputable : + BitTM + gaussianPhysicalColumnCandidateUnary := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnDecisionComputable dropHeadComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnNextPivotUnary : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ firstFieldSuffix ∘ + gaussianPhysicalColumnCellPackedState + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnNextPivotUnaryComputable : + BitTM + gaussianPhysicalColumnNextPivotUnary := by + have hcheck := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnCellPackedStateComputable + firstFieldSuffixComputable + have hrhs := GapCVP.TMComposition.computableInPolyTime + hcheck firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hrhs firstFieldContentsComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem gaussianPhysicalColumnNextPivotUnary_query + {m n : ℕ} (state : State m n) (source : List Bool) + (row column active : ℕ) : + gaussianPhysicalColumnNextPivotUnary + (gaussianPhysicalColumnCellQuery row column active + (effectiveGaussianPackedStateWord state source)) = + List.replicate state.nextPivot true := by + simp only [gaussianPhysicalColumnNextPivotUnary, effectiveGaussianPackedStateWord, + List.append_assoc, + Function.comp_apply, gaussianPhysicalColumnCellPackedState_query, firstFieldSuffix_valid, + firstFieldContents_valid] + +private def gaussianPhysicalColumnDynamicCellQuery + (row column : List Bool → List Bool) + (input : List Bool) : List Bool := + lengthPrefixedWord (row input) ++ + (lengthPrefixedWord (column input) ++ + gaussianPhysicalColumnCellPackedState input) + +private noncomputable def gaussianPhysicalColumnDynamicCellQueryComputable + {row column : List Bool → List Bool} + (hrow : BitTM row) + (hcolumn : BitTM column) : + BitTM + (gaussianPhysicalColumnDynamicCellQuery row column) := by + have hfirst := GapCVP.TMComposition.computableInPolyTime + hrow structuralPrefixWriterComputable + have hsecond := GapCVP.TMComposition.computableInPolyTime + hcolumn structuralPrefixWriterComputable + have htail := pointwiseAppendComputable + hsecond gaussianPhysicalColumnCellPackedStateComputable + have hphysical := pointwiseAppendComputable hfirst htail + change BitTM + (fun input => lengthPrefixedWord (row input) ++ + (lengthPrefixedWord (column input) ++ + gaussianPhysicalColumnCellPackedState input)) + simpa only [Function.comp_apply] using hphysical + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnDynamicCheckWord + (row column : List Bool → List Bool) : List Bool → List Bool := + gaussianPackedStateCheckCellWord ∘ + gaussianPhysicalColumnDynamicCellQuery row column + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalColumnDynamicCheckComputable + {row column : List Bool → List Bool} + (hrow : BitTM row) + (hcolumn : BitTM column) : + BitTM + (gaussianPhysicalColumnDynamicCheckWord row column) := + GapCVP.TMComposition.computableInPolyTime + (gaussianPhysicalColumnDynamicCellQueryComputable hrow hcolumn) + gaussianPackedStateCheckCellComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnDynamicRhsWord + (row column : List Bool → List Bool) : List Bool → List Bool := + gaussianPackedStateRhsCellWord ∘ + gaussianPhysicalColumnDynamicCellQuery row column + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalColumnDynamicRhsComputable + {row column : List Bool → List Bool} + (hrow : BitTM row) + (hcolumn : BitTM column) : + BitTM + (gaussianPhysicalColumnDynamicRhsWord row column) := + GapCVP.TMComposition.computableInPolyTime + (gaussianPhysicalColumnDynamicCellQueryComputable hrow hcolumn) + gaussianPackedStateRhsCellComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem gaussianPhysicalColumnDynamicCheckWord_effective + {m n : ℕ} (state : State m n) (source input : List Bool) + (rowWorker columnWorker : List Bool → List Bool) + (row : Fin m) (column : Fin n) + (hstate : gaussianPhysicalColumnCellPackedState input = + effectiveGaussianPackedStateWord state source) + (hrow : rowWorker input = List.replicate row.val true) + (hcolumn : columnWorker input = List.replicate column.val true) : + gaussianPhysicalColumnDynamicCheckWord rowWorker columnWorker input = + [decide (state.system.check row column = (1 : ZMod 2))] := by + have hquery : + gaussianPhysicalColumnDynamicCellQuery + rowWorker columnWorker input = + affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source) := by + unfold gaussianPhysicalColumnDynamicCellQuery + affineCellQuery + rw [hrow, hcolumn, hstate] + simp only [List.append_assoc] + have hrows : 0 < m := by + have hlt := row.isLt + omega + unfold gaussianPhysicalColumnDynamicCheckWord + rw [Function.comp_apply, hquery] + exact gaussianPackedStateCheckCellWord_query + state source row column hrows + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem gaussianPhysicalColumnDynamicRhsWord_effective + {m n : ℕ} (state : State m n) (source input : List Bool) + (rowWorker columnWorker : List Bool → List Bool) + (row : Fin m) (column : Fin n) + (hstate : gaussianPhysicalColumnCellPackedState input = + effectiveGaussianPackedStateWord state source) + (hrow : rowWorker input = List.replicate row.val true) + (hcolumn : columnWorker input = List.replicate column.val true) : + gaussianPhysicalColumnDynamicRhsWord rowWorker columnWorker input = + [decide (state.system.rhs row = (1 : ZMod 2))] := by + have hquery : + gaussianPhysicalColumnDynamicCellQuery + rowWorker columnWorker input = + affineCellQuery row.val column.val + (effectiveGaussianPackedStateWord state source) := by + unfold gaussianPhysicalColumnDynamicCellQuery + affineCellQuery + rw [hrow, hcolumn, hstate] + simp only [List.append_assoc] + unfold gaussianPhysicalColumnDynamicRhsWord + rw [Function.comp_apply, hquery] + exact gaussianPackedStateRhsCellWord_query + state source row column.val + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnRowIsCandidateWord : List Bool → List Bool := + fourFamilyComputedUnaryEqBitOutput + gaussianPhysicalColumnCellRow gaussianPhysicalColumnCandidateUnary + +private noncomputable def gaussianPhysicalColumnRowIsCandidateComputable : + BitTM + gaussianPhysicalColumnRowIsCandidateWord := + fourFamilyComputedUnaryEqBitComputable + sourceExplicitAffineCellRowComputable + gaussianPhysicalColumnCandidateUnaryComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnRowIsPivotWord : List Bool → List Bool := + fourFamilyComputedUnaryEqBitOutput + gaussianPhysicalColumnCellRow gaussianPhysicalColumnNextPivotUnary + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalColumnRowIsPivotComputable : + BitTM + gaussianPhysicalColumnRowIsPivotWord := + fourFamilyComputedUnaryEqBitComputable + sourceExplicitAffineCellRowComputable + gaussianPhysicalColumnNextPivotUnaryComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +def gaussianPhysicalColumnSwappedBitWord + (original pivot candidate : List Bool → List Bool) : + List Bool → List Bool := + sourceFourFamilyBooleanOrOutput + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnRowIsCandidateWord pivot) + (sourceFourFamilyBooleanOrOutput + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnRowIsPivotWord candidate) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsCandidateWord) + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsPivotWord)) original)) + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def gaussianPhysicalColumnSwappedBitComputable + {original pivot candidate : List Bool → List Bool} + (horiginal : BitTM original) + (hpivot : BitTM pivot) + (hcandidate : BitTM candidate) : + BitTM + (gaussianPhysicalColumnSwappedBitWord original pivot candidate) := + sourceFourFamilyBooleanOrComputable + (fourFamilyBooleanAndComputable + gaussianPhysicalColumnRowIsCandidateComputable hpivot) + (sourceFourFamilyBooleanOrComputable + (fourFamilyBooleanAndComputable + gaussianPhysicalColumnRowIsPivotComputable hcandidate) + (fourFamilyBooleanAndComputable + (fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable + gaussianPhysicalColumnRowIsCandidateComputable) + (fourFamilyBooleanNotOutputComputable + gaussianPhysicalColumnRowIsPivotComputable)) + horiginal)) + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem gaussianPhysicalColumnSwappedBitWord_bits + (original pivot candidate : List Bool → List Bool) + (input : List Bool) + (rowIsCandidate rowIsPivot originalBit pivotBit candidateBit : Bool) + (hcandidateDecision : + gaussianPhysicalColumnRowIsCandidateWord input = [rowIsCandidate]) + (hpivotDecision : + gaussianPhysicalColumnRowIsPivotWord input = [rowIsPivot]) + (horiginal : original input = [originalBit]) + (hpivot : pivot input = [pivotBit]) + (hcandidate : candidate input = [candidateBit]) : + gaussianPhysicalColumnSwappedBitWord + original pivot candidate input = + [(rowIsCandidate && pivotBit) || + ((rowIsPivot && candidateBit) || + (((!rowIsCandidate) && (!rowIsPivot)) && originalBit))] := by + have hleft := fourFamilyBooleanAndOutput_bits + gaussianPhysicalColumnRowIsCandidateWord pivot + input rowIsCandidate pivotBit hcandidateDecision hpivot + have hmiddle := fourFamilyBooleanAndOutput_bits + gaussianPhysicalColumnRowIsPivotWord candidate + input rowIsPivot candidateBit hpivotDecision hcandidate + have hnotCandidate := fourFamilyBooleanNotOutput_bit + gaussianPhysicalColumnRowIsCandidateWord + input rowIsCandidate hcandidateDecision + have hnotPivot := fourFamilyBooleanNotOutput_bit + gaussianPhysicalColumnRowIsPivotWord + input rowIsPivot hpivotDecision + have hneither := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsCandidateWord) + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsPivotWord) + input (!rowIsCandidate) (!rowIsPivot) hnotCandidate hnotPivot + have hright := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsCandidateWord) + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsPivotWord)) + original input ((!rowIsCandidate) && (!rowIsPivot)) + originalBit hneither horiginal + have hrest := fourFamilyBooleanOrOutput_bits + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnRowIsPivotWord candidate) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsCandidateWord) + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsPivotWord)) original) + input (rowIsPivot && candidateBit) + (((!rowIsCandidate) && (!rowIsPivot)) && originalBit) + hmiddle hright + exact fourFamilyBooleanOrOutput_bits + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnRowIsCandidateWord pivot) + (sourceFourFamilyBooleanOrOutput + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnRowIsPivotWord candidate) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsCandidateWord) + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsPivotWord)) original)) + input (rowIsCandidate && pivotBit) + ((rowIsPivot && candidateBit) || + (((!rowIsCandidate) && (!rowIsPivot)) && originalBit)) + hleft hrest + +end GaussianAdaptivePhysicalColumnCellUpdateTM + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part12D.lean b/LeanPool/GapCVP/Part12D.lean new file mode 100644 index 000000000..cc4794910 --- /dev/null +++ b/LeanPool/GapCVP/Part12D.lean @@ -0,0 +1,1561 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part12C + +/-! # GapCVP proof, part 12, continuation 04 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace GaussianAdaptivePhysicalColumnCellUpdateTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding + +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CLStructuralPrefixWriter + +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryExplicitAffineRows + +open GapCVP.GaussianRowWorker GapCVP.GaussianAdaptivePivotStepTM + +open GapCVP.GaussianAdaptivePackedTraceCorrectness GapCVP.GaussianAdaptivePackedStateLookupTM + +open GapCVP.GaussianAdaptivePhysicalCandidateCatalogueTM + +open GapCVP.GaussianAdaptivePhysicalColumnCellUpdateSemantics + +open GapCVP.SourceFourFamilyBooleanPredicateTM + +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM + +open GapCVP.SourceFourFamilyDiagonalMembershipPredicateTM + +private def gaussianPhysicalColumnSwappedCheckWord + (column : List Bool → List Bool) : List Bool → List Bool := + gaussianPhysicalColumnSwappedBitWord + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnCellRow column) + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnNextPivotUnary column) + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnCandidateUnary column) + +private noncomputable def gaussianPhysicalColumnSwappedCheckComputable + {column : List Bool → List Bool} + (hcolumn : BitTM column) : + BitTM + (gaussianPhysicalColumnSwappedCheckWord column) := + gaussianPhysicalColumnSwappedBitComputable + (gaussianPhysicalColumnDynamicCheckComputable + sourceExplicitAffineCellRowComputable hcolumn) + (gaussianPhysicalColumnDynamicCheckComputable + gaussianPhysicalColumnNextPivotUnaryComputable hcolumn) + (gaussianPhysicalColumnDynamicCheckComputable + gaussianPhysicalColumnCandidateUnaryComputable hcolumn) + +private def gaussianPhysicalColumnSwappedRhsWord : List Bool → List Bool := + gaussianPhysicalColumnSwappedBitWord + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnCellRow gaussianPhysicalColumnCellColumn) + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnNextPivotUnary gaussianPhysicalColumnCellColumn) + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnCandidateUnary gaussianPhysicalColumnCellColumn) + +private noncomputable def gaussianPhysicalColumnSwappedRhsComputable : + BitTM + gaussianPhysicalColumnSwappedRhsWord := + gaussianPhysicalColumnSwappedBitComputable + (gaussianPhysicalColumnDynamicRhsComputable + sourceExplicitAffineCellRowComputable + sourceExplicitAffineCellColumnComputable) + (gaussianPhysicalColumnDynamicRhsComputable + gaussianPhysicalColumnNextPivotUnaryComputable + sourceExplicitAffineCellColumnComputable) + (gaussianPhysicalColumnDynamicRhsComputable + gaussianPhysicalColumnCandidateUnaryComputable + sourceExplicitAffineCellColumnComputable) + +private def gaussianPhysicalColumnClearGateWord : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsPivotWord) + (gaussianPhysicalColumnSwappedCheckWord + gaussianPhysicalColumnCellActive) + +private noncomputable def gaussianPhysicalColumnClearGateComputable : + BitTM + gaussianPhysicalColumnClearGateWord := + fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable + gaussianPhysicalColumnRowIsPivotComputable) + (gaussianPhysicalColumnSwappedCheckComputable + gaussianPhysicalColumnCellActiveComputable) + +private def gaussianPhysicalColumnCandidateCheckWord : List Bool → List Bool := + gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnCandidateUnary + gaussianPhysicalColumnCellColumn + +private noncomputable def gaussianPhysicalColumnCandidateCheckComputable : + BitTM + gaussianPhysicalColumnCandidateCheckWord := + gaussianPhysicalColumnDynamicCheckComputable + gaussianPhysicalColumnCandidateUnaryComputable + sourceExplicitAffineCellColumnComputable + +private def gaussianPhysicalColumnCandidateRhsWord : List Bool → List Bool := + gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnCandidateUnary + gaussianPhysicalColumnCellColumn + +private noncomputable def gaussianPhysicalColumnCandidateRhsComputable : + BitTM + gaussianPhysicalColumnCandidateRhsWord := + gaussianPhysicalColumnDynamicRhsComputable + gaussianPhysicalColumnCandidateUnaryComputable + sourceExplicitAffineCellColumnComputable + +private def gaussianPhysicalColumnPivotUpdatedCheckWord : List Bool → List Bool := + sourceExplicitAffineXorBits + (gaussianPhysicalColumnSwappedCheckWord + gaussianPhysicalColumnCellColumn) + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnClearGateWord + gaussianPhysicalColumnCandidateCheckWord) + +private noncomputable def gaussianPhysicalColumnPivotUpdatedCheckComputable : + BitTM + gaussianPhysicalColumnPivotUpdatedCheckWord := + sourceExplicitAffineXorBitsComputable + (gaussianPhysicalColumnSwappedCheckComputable + sourceExplicitAffineCellColumnComputable) + (fourFamilyBooleanAndComputable + gaussianPhysicalColumnClearGateComputable + gaussianPhysicalColumnCandidateCheckComputable) + +private def gaussianPhysicalColumnPivotUpdatedRhsWord : List Bool → List Bool := + sourceExplicitAffineXorBits gaussianPhysicalColumnSwappedRhsWord + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnClearGateWord + gaussianPhysicalColumnCandidateRhsWord) + +private noncomputable def gaussianPhysicalColumnPivotUpdatedRhsComputable : + BitTM + gaussianPhysicalColumnPivotUpdatedRhsWord := + sourceExplicitAffineXorBitsComputable + gaussianPhysicalColumnSwappedRhsComputable + (fourFamilyBooleanAndComputable + gaussianPhysicalColumnClearGateComputable + gaussianPhysicalColumnCandidateRhsComputable) + +private def gaussianPhysicalColumnOriginalCheckWord : List Bool → List Bool := + gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnCellRow gaussianPhysicalColumnCellColumn + +private noncomputable def gaussianPhysicalColumnOriginalCheckComputable : + BitTM + gaussianPhysicalColumnOriginalCheckWord := + gaussianPhysicalColumnDynamicCheckComputable + sourceExplicitAffineCellRowComputable + sourceExplicitAffineCellColumnComputable + +private def gaussianPhysicalColumnOriginalRhsWord : List Bool → List Bool := + gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnCellRow gaussianPhysicalColumnCellColumn + +private noncomputable def gaussianPhysicalColumnOriginalRhsComputable : + BitTM + gaussianPhysicalColumnOriginalRhsWord := + gaussianPhysicalColumnDynamicRhsComputable + sourceExplicitAffineCellRowComputable + sourceExplicitAffineCellColumnComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnUpdatedCheckWord : List Bool → List Bool := + binaryGaussianDynamicBranchOutput + gaussianPhysicalColumnPivotPresent + gaussianPhysicalColumnPivotUpdatedCheckWord + gaussianPhysicalColumnOriginalCheckWord + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnUpdatedCheckComputable : + BitTM + gaussianPhysicalColumnUpdatedCheckWord := + binaryGaussianDynamicBranchComputable + gaussianPhysicalColumnPivotSelectionComputable + gaussianPhysicalColumnPivotUpdatedCheckComputable + gaussianPhysicalColumnOriginalCheckComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnUpdatedRhsWord : List Bool → List Bool := + binaryGaussianDynamicBranchOutput + gaussianPhysicalColumnPivotPresent + gaussianPhysicalColumnPivotUpdatedRhsWord + gaussianPhysicalColumnOriginalRhsWord + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnUpdatedRhsComputable : + BitTM + gaussianPhysicalColumnUpdatedRhsWord := + binaryGaussianDynamicBranchComputable + gaussianPhysicalColumnPivotSelectionComputable + gaussianPhysicalColumnPivotUpdatedRhsComputable + gaussianPhysicalColumnOriginalRhsComputable + +private theorem gaussianPhysicalColumnBinaryAdd_decide + (first second : ZMod 2) : + decide (first + second = (1 : ZMod 2)) = + Bool.xor (decide (first = (1 : ZMod 2))) + (decide (second = (1 : ZMod 2))) := by + rcases effectiveBinary_eq_zero_or_one first with hfirst | hfirst <;> + rcases effectiveBinary_eq_zero_or_one second with hsecond | hsecond <;> + simp [hfirst, hsecond] + +private theorem gaussianPhysicalColumnSwapFormula + {m : ℕ} (row candidate pivot : Fin m) + (bit : Fin m → Bool) : + ((decide (row.val = candidate.val) && bit pivot) || + ((decide (row.val = pivot.val) && bit candidate) || + (((!decide (row.val = candidate.val)) && + (!decide (row.val = pivot.val))) && bit row))) = + bit (Equiv.swap candidate pivot row) := by + by_cases hcandidate : row = candidate + · subst row + by_cases equal : candidate = pivot + · subst pivot + simp only [decide_true, Bool.true_and, Bool.not_true, Bool.and_self, Bool.false_and, + Bool.or_false, + Bool.or_self, Equiv.swap_self, Equiv.refl_apply] + · have different : candidate.val ≠ pivot.val := by + intro h + exact equal (Fin.ext h) + simp only [decide_true, Bool.true_and, different, decide_false, Bool.false_and, + Bool.not_true, Bool.not_false, + Bool.and_true, Bool.or_self, Bool.or_false, Equiv.swap_apply_left] + · have hcandidateVal : row.val ≠ candidate.val := by + intro equal + exact hcandidate (Fin.ext equal) + by_cases hpivot : row = pivot + · subst row + simp only [hcandidateVal, decide_false, Bool.false_and, decide_true, Bool.true_and, + Bool.not_false, + Bool.not_true, Bool.and_false, Bool.or_false, Bool.false_or, Equiv.swap_apply_right] + · have hpivotVal : row.val ≠ pivot.val := by + intro equal + exact hpivot (Fin.ext equal) + rw [Equiv.swap_apply_of_ne_of_ne hcandidate hpivot] + simp only [hcandidateVal, decide_false, Bool.false_and, hpivotVal, Bool.not_false, + Bool.and_self, + Bool.true_and, Bool.false_or] + +private theorem gaussianPhysicalColumnDecisionWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) : + gaussianPhysicalColumnDecisionWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + match findPivotOption state active with + | none => [false] + | some candidate => true :: List.replicate candidate.val true := by + have hrows : 0 < m := by + have hlt := row.isLt + omega + unfold gaussianPhysicalColumnDecisionWord + rw [Function.comp_apply, + gaussianPhysicalColumnDecisionQuery_query] + exact gaussianPhysicalPivotDecisionOutput_effective + state source active hrows + +private theorem gaussianPhysicalColumnCandidateUnary_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) (candidate : Fin m) + (found : findPivotOption state active = some candidate) : + gaussianPhysicalColumnCandidateUnary + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate candidate.val true := by + unfold gaussianPhysicalColumnCandidateUnary + rw [Function.comp_apply, + gaussianPhysicalColumnDecisionWord_effective + state source row column active, found] + simp only [List.tail_cons] + +theorem gaussianPhysicalColumnPivotPresent_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) : + gaussianPhysicalColumnPivotPresent + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + (findPivotOption state active).isSome := by + unfold gaussianPhysicalColumnPivotPresent + gaussianPhysicalColumnPivotPresentWord + simp only [Function.comp_apply] + rw [gaussianPhysicalColumnDecisionWord_effective + state source row column active] + cases findPivotOption state active <;> rfl + +private theorem gaussianPhysicalColumnRowIsCandidateWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) (candidate : Fin m) + (found : findPivotOption state active = some candidate) : + gaussianPhysicalColumnRowIsCandidateWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide (row.val = candidate.val)] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + exact fourFamilyComputedUnaryEqBitOutput_valid + gaussianPhysicalColumnCellRow gaussianPhysicalColumnCandidateUnary + input row.val candidate.val + (gaussianPhysicalColumnCellRow_query row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) + (gaussianPhysicalColumnCandidateUnary_effective + state source row column active candidate found) + +private theorem gaussianPhysicalColumnRowIsPivotWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) (pivot : Fin m) + (boundary : state.nextPivot = pivot.val) : + gaussianPhysicalColumnRowIsPivotWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide (row.val = pivot.val)] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + apply fourFamilyComputedUnaryEqBitOutput_valid + gaussianPhysicalColumnCellRow gaussianPhysicalColumnNextPivotUnary + input row.val pivot.val + · exact gaussianPhysicalColumnCellRow_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + · simpa only [boundary] using + gaussianPhysicalColumnNextPivotUnary_query + state source row.val column.val active.val + +private theorem gaussianPhysicalColumnSwappedCheckWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active selected : Fin n) + (candidate pivot : Fin m) + (found : findPivotOption state active = some candidate) + (boundary : state.nextPivot = pivot.val) + (columnWorker : List Bool → List Bool) + (selectedWord : + columnWorker + (gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate selected.val true) : + gaussianPhysicalColumnSwappedCheckWord columnWorker + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide + ((swapRows state.system candidate pivot).check row selected = + (1 : ZMod 2))] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hstate : gaussianPhysicalColumnCellPackedState input = + effectiveGaussianPackedStateWord state source := + gaussianPhysicalColumnCellPackedState_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have horiginal := gaussianPhysicalColumnDynamicCheckWord_effective + state source input gaussianPhysicalColumnCellRow columnWorker + row selected hstate + (gaussianPhysicalColumnCellRow_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) + selectedWord + have hnext : gaussianPhysicalColumnNextPivotUnary input = + List.replicate pivot.val true := by + simpa only [boundary] using + (gaussianPhysicalColumnNextPivotUnary_query + state source row.val column.val active.val) + have hpivot := gaussianPhysicalColumnDynamicCheckWord_effective + state source input gaussianPhysicalColumnNextPivotUnary columnWorker + pivot selected hstate hnext selectedWord + have hcandidate := gaussianPhysicalColumnDynamicCheckWord_effective + state source input gaussianPhysicalColumnCandidateUnary columnWorker + candidate selected hstate + (gaussianPhysicalColumnCandidateUnary_effective + state source row column active candidate found) + selectedWord + have hrowCandidate := + gaussianPhysicalColumnRowIsCandidateWord_effective + state source row column active candidate found + have hrowPivot := gaussianPhysicalColumnRowIsPivotWord_effective + state source row column active pivot boundary + have hswap := gaussianPhysicalColumnSwappedBitWord_bits + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnCellRow columnWorker) + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnNextPivotUnary columnWorker) + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnCandidateUnary columnWorker) + input (decide (row.val = candidate.val)) + (decide (row.val = pivot.val)) + (decide (state.system.check row selected = (1 : ZMod 2))) + (decide (state.system.check pivot selected = (1 : ZMod 2))) + (decide (state.system.check candidate selected = (1 : ZMod 2))) + hrowCandidate hrowPivot horiginal hpivot hcandidate + change gaussianPhysicalColumnSwappedBitWord + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnCellRow columnWorker) + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnNextPivotUnary columnWorker) + (gaussianPhysicalColumnDynamicCheckWord + gaussianPhysicalColumnCandidateUnary columnWorker) + input = _ + rw [hswap] + exact congrArg (fun bit : Bool => [bit]) + (gaussianPhysicalColumnSwapFormula row candidate pivot + (fun current => + decide (state.system.check current selected = (1 : ZMod 2)))) + +private theorem gaussianPhysicalColumnSwappedRhsWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) + (candidate pivot : Fin m) + (found : findPivotOption state active = some candidate) + (boundary : state.nextPivot = pivot.val) : + gaussianPhysicalColumnSwappedRhsWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide + ((swapRows state.system candidate pivot).rhs row = + (1 : ZMod 2))] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hstate : gaussianPhysicalColumnCellPackedState input = + effectiveGaussianPackedStateWord state source := + gaussianPhysicalColumnCellPackedState_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hcolumn := gaussianPhysicalColumnCellColumn_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have horiginal := gaussianPhysicalColumnDynamicRhsWord_effective + state source input gaussianPhysicalColumnCellRow + gaussianPhysicalColumnCellColumn row column hstate + (gaussianPhysicalColumnCellRow_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) + hcolumn + have hnext : gaussianPhysicalColumnNextPivotUnary input = + List.replicate pivot.val true := by + simpa only [boundary] using + (gaussianPhysicalColumnNextPivotUnary_query + state source row.val column.val active.val) + have hpivot := gaussianPhysicalColumnDynamicRhsWord_effective + state source input gaussianPhysicalColumnNextPivotUnary + gaussianPhysicalColumnCellColumn pivot column hstate + hnext hcolumn + have hcandidate := gaussianPhysicalColumnDynamicRhsWord_effective + state source input gaussianPhysicalColumnCandidateUnary + gaussianPhysicalColumnCellColumn candidate column hstate + (gaussianPhysicalColumnCandidateUnary_effective + state source row column active candidate found) + hcolumn + have hrowCandidate := + gaussianPhysicalColumnRowIsCandidateWord_effective + state source row column active candidate found + have hrowPivot := gaussianPhysicalColumnRowIsPivotWord_effective + state source row column active pivot boundary + have hswap := gaussianPhysicalColumnSwappedBitWord_bits + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnCellRow gaussianPhysicalColumnCellColumn) + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnNextPivotUnary gaussianPhysicalColumnCellColumn) + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnCandidateUnary gaussianPhysicalColumnCellColumn) + input (decide (row.val = candidate.val)) + (decide (row.val = pivot.val)) + (decide (state.system.rhs row = (1 : ZMod 2))) + (decide (state.system.rhs pivot = (1 : ZMod 2))) + (decide (state.system.rhs candidate = (1 : ZMod 2))) + hrowCandidate hrowPivot horiginal hpivot hcandidate + change gaussianPhysicalColumnSwappedBitWord + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnCellRow gaussianPhysicalColumnCellColumn) + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnNextPivotUnary gaussianPhysicalColumnCellColumn) + (gaussianPhysicalColumnDynamicRhsWord + gaussianPhysicalColumnCandidateUnary gaussianPhysicalColumnCellColumn) + input = _ + rw [hswap] + exact congrArg (fun bit : Bool => [bit]) + (gaussianPhysicalColumnSwapFormula row candidate pivot + (fun current => decide (state.system.rhs current = (1 : ZMod 2)))) + +private theorem gaussianPhysicalColumnClearGateWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) + (candidate pivot : Fin m) + (found : findPivotOption state active = some candidate) + (boundary : state.nextPivot = pivot.val) : + gaussianPhysicalColumnClearGateWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide (row ≠ pivot ∧ + (swapRows state.system candidate pivot).check row active = + (1 : ZMod 2))] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hrow := gaussianPhysicalColumnRowIsPivotWord_effective + state source row column active pivot boundary + have hnot := fourFamilyBooleanNotOutput_bit + gaussianPhysicalColumnRowIsPivotWord input + (decide (row.val = pivot.val)) hrow + have hactive := gaussianPhysicalColumnSwappedCheckWord_effective + state source row column active active candidate pivot + found boundary gaussianPhysicalColumnCellActive + (gaussianPhysicalColumnCellActive_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) + have hand := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsPivotWord) + (gaussianPhysicalColumnSwappedCheckWord + gaussianPhysicalColumnCellActive) + input (!(decide (row.val = pivot.val))) + (decide + ((swapRows state.system candidate pivot).check row active = + (1 : ZMod 2))) hnot hactive + change sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnRowIsPivotWord) + (gaussianPhysicalColumnSwappedCheckWord + gaussianPhysicalColumnCellActive) input = _ + rw [hand] + by_cases heq : row = pivot + · subst row + simp only [decide_true, Bool.not_true, Bool.false_and, ne_eq, not_true_eq_false, false_and, + decide_false] + · have hv : row.val ≠ pivot.val := by + intro h + exact heq (Fin.ext h) + by_cases hbit : + (swapRows state.system candidate pivot).check row active = + (1 : ZMod 2) <;> + simp [heq, hv, hbit] + +private theorem gaussianPhysicalColumnPivotUpdatedCheckWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) + (candidate pivot : Fin m) + (found : findPivotOption state active = some candidate) + (boundary : state.nextPivot = pivot.val) : + gaussianPhysicalColumnPivotUpdatedCheckWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide + ((clearTargets pivot active (List.finRange m) + (applyOperation state (.swap candidate pivot))).system.check + row column = (1 : ZMod 2))] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + let swapped := swapRows state.system candidate pivot + let condition := row ≠ pivot ∧ + swapped.check row active = (1 : ZMod 2) + have hstate : gaussianPhysicalColumnCellPackedState input = + effectiveGaussianPackedStateWord state source := + gaussianPhysicalColumnCellPackedState_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hcolumn := gaussianPhysicalColumnCellColumn_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hswapped := gaussianPhysicalColumnSwappedCheckWord_effective + state source row column active column candidate pivot + found boundary gaussianPhysicalColumnCellColumn hcolumn + have hgate := gaussianPhysicalColumnClearGateWord_effective + state source row column active candidate pivot found boundary + have hcandidate := gaussianPhysicalColumnDynamicCheckWord_effective + state source input gaussianPhysicalColumnCandidateUnary + gaussianPhysicalColumnCellColumn candidate column hstate + (gaussianPhysicalColumnCandidateUnary_effective + state source row column active candidate found) + hcolumn + have hterm := fourFamilyBooleanAndOutput_bits + gaussianPhysicalColumnClearGateWord + gaussianPhysicalColumnCandidateCheckWord input + (decide condition) + (decide (state.system.check candidate column = (1 : ZMod 2))) + hgate hcandidate + have hxor := sourceExplicitAffineXorBits_valid + (gaussianPhysicalColumnSwappedCheckWord + gaussianPhysicalColumnCellColumn) + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnClearGateWord + gaussianPhysicalColumnCandidateCheckWord) + input + (decide (swapped.check row column = (1 : ZMod 2))) + (decide condition && + decide (state.system.check candidate column = (1 : ZMod 2))) + hswapped hterm + change sourceExplicitAffineXorBits + (gaussianPhysicalColumnSwappedCheckWord + gaussianPhysicalColumnCellColumn) + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnClearGateWord + gaussianPhysicalColumnCandidateCheckWord) input = _ + rw [hxor] + rw [clearTargets_check_finRange] + change + [Bool.xor + (decide (swapped.check row column = (1 : ZMod 2))) + (decide condition && + decide (state.system.check candidate column = (1 : ZMod 2)))] = + [decide + ((if condition then + swapped.check row column + swapped.check pivot column + else + swapped.check row column) = (1 : ZMod 2))] + by_cases hcondition : condition + · simp only [hcondition, decide_true, Bool.true_and, ite_true] + rw [gaussianPhysicalColumnBinaryAdd_decide] + have hpivotEntry : swapped.check pivot column = + state.system.check candidate column := by + change state.system.check + (Equiv.swap candidate pivot pivot) column = + state.system.check candidate column + rw [Equiv.swap_apply_right] + rw [hpivotEntry] + · simp only [hcondition, decide_false, Bool.false_and, Bool.bne_false, ↓reduceIte] + +private theorem gaussianPhysicalColumnPivotUpdatedRhsWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) + (candidate pivot : Fin m) + (found : findPivotOption state active = some candidate) + (boundary : state.nextPivot = pivot.val) : + gaussianPhysicalColumnPivotUpdatedRhsWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide + ((clearTargets pivot active (List.finRange m) + (applyOperation state (.swap candidate pivot))).system.rhs + row = (1 : ZMod 2))] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + let swapped := swapRows state.system candidate pivot + let condition := row ≠ pivot ∧ + swapped.check row active = (1 : ZMod 2) + have hstate : gaussianPhysicalColumnCellPackedState input = + effectiveGaussianPackedStateWord state source := + gaussianPhysicalColumnCellPackedState_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hcolumn := gaussianPhysicalColumnCellColumn_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hswapped := gaussianPhysicalColumnSwappedRhsWord_effective + state source row column active candidate pivot found boundary + have hgate := gaussianPhysicalColumnClearGateWord_effective + state source row column active candidate pivot found boundary + have hcandidate := gaussianPhysicalColumnDynamicRhsWord_effective + state source input gaussianPhysicalColumnCandidateUnary + gaussianPhysicalColumnCellColumn candidate column hstate + (gaussianPhysicalColumnCandidateUnary_effective + state source row column active candidate found) + hcolumn + have hterm := fourFamilyBooleanAndOutput_bits + gaussianPhysicalColumnClearGateWord + gaussianPhysicalColumnCandidateRhsWord input + (decide condition) + (decide (state.system.rhs candidate = (1 : ZMod 2))) + hgate hcandidate + have hxor := sourceExplicitAffineXorBits_valid + gaussianPhysicalColumnSwappedRhsWord + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnClearGateWord + gaussianPhysicalColumnCandidateRhsWord) + input + (decide (swapped.rhs row = (1 : ZMod 2))) + (decide condition && + decide (state.system.rhs candidate = (1 : ZMod 2))) + hswapped hterm + change sourceExplicitAffineXorBits + gaussianPhysicalColumnSwappedRhsWord + (sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnClearGateWord + gaussianPhysicalColumnCandidateRhsWord) input = _ + rw [hxor] + rw [clearTargets_rhs_finRange] + change + [Bool.xor + (decide (swapped.rhs row = (1 : ZMod 2))) + (decide condition && + decide (state.system.rhs candidate = (1 : ZMod 2)))] = + [decide + ((if condition then + swapped.rhs row + swapped.rhs pivot + else + swapped.rhs row) = (1 : ZMod 2))] + by_cases hcondition : condition + · simp only [hcondition, decide_true, Bool.true_and, ite_true] + rw [gaussianPhysicalColumnBinaryAdd_decide] + have hpivotEntry : swapped.rhs pivot = + state.system.rhs candidate := by + change state.system.rhs + (Equiv.swap candidate pivot pivot) = + state.system.rhs candidate + rw [Equiv.swap_apply_right] + rw [hpivotEntry] + · simp only [hcondition, decide_false, Bool.false_and, Bool.bne_false, ↓reduceIte] + +theorem gaussianPhysicalColumnUpdatedCheckWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) : + gaussianPhysicalColumnUpdatedCheckWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide ((columnStep state active).system.check row column = + (1 : ZMod 2))] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hstate : gaussianPhysicalColumnCellPackedState input = + effectiveGaussianPackedStateWord state source := + gaussianPhysicalColumnCellPackedState_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hrow := gaussianPhysicalColumnCellRow_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hcolumn := gaussianPhysicalColumnCellColumn_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + cases found : findPivotOption state active with + | none => + have hpresent : gaussianPhysicalColumnPivotPresent input = false := by + simpa only [found, Option.isSome_none] using + gaussianPhysicalColumnPivotPresent_effective state source row column active + have horiginal := gaussianPhysicalColumnDynamicCheckWord_effective + state source input gaussianPhysicalColumnCellRow + gaussianPhysicalColumnCellColumn row column hstate hrow hcolumn + have hstep : columnStep state active = state := by + simp only [columnStep, found, dite_eq_ite, ite_self] + unfold gaussianPhysicalColumnUpdatedCheckWord + binaryGaussianDynamicBranchOutput + rw [hpresent] + change gaussianPhysicalColumnOriginalCheckWord input = _ + rw [hstep] + exact horiginal + | some candidate => + have habove := (findPivotOption_some state active candidate found).1 + have hactive : state.nextPivot < m := habove.trans_lt candidate.isLt + let pivot : Fin m := ⟨state.nextPivot, hactive⟩ + have hpresent : gaussianPhysicalColumnPivotPresent input = true := by + simpa only [found, Option.isSome_some] using + gaussianPhysicalColumnPivotPresent_effective state source row column active + unfold gaussianPhysicalColumnUpdatedCheckWord + binaryGaussianDynamicBranchOutput + rw [hpresent] + simp only [↓reduceIte] + have hupdated := gaussianPhysicalColumnPivotUpdatedCheckWord_effective + state source row column active candidate pivot found rfl + simp only [columnStep, hactive, ↓reduceDIte, found] + exact hupdated + +theorem gaussianPhysicalColumnUpdatedRhsWord_effective + {m n : ℕ} (state : State m n) (source : List Bool) + (row : Fin m) (column active : Fin n) : + gaussianPhysicalColumnUpdatedRhsWord + (gaussianPhysicalColumnCellQuery row.val column.val active.val + (effectiveGaussianPackedStateWord state source)) = + [decide ((columnStep state active).system.rhs row = + (1 : ZMod 2))] := by + let input := gaussianPhysicalColumnCellQuery + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hstate : gaussianPhysicalColumnCellPackedState input = + effectiveGaussianPackedStateWord state source := + gaussianPhysicalColumnCellPackedState_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hrow := gaussianPhysicalColumnCellRow_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + have hcolumn := gaussianPhysicalColumnCellColumn_query + row.val column.val active.val + (effectiveGaussianPackedStateWord state source) + cases found : findPivotOption state active with + | none => + have hpresent : gaussianPhysicalColumnPivotPresent input = false := by + simpa only [found, Option.isSome_none] using + gaussianPhysicalColumnPivotPresent_effective state source row column active + have horiginal := gaussianPhysicalColumnDynamicRhsWord_effective + state source input gaussianPhysicalColumnCellRow + gaussianPhysicalColumnCellColumn row column hstate hrow hcolumn + have hstep : columnStep state active = state := by + simp only [columnStep, found, dite_eq_ite, ite_self] + unfold gaussianPhysicalColumnUpdatedRhsWord + binaryGaussianDynamicBranchOutput + rw [hpresent] + change gaussianPhysicalColumnOriginalRhsWord input = _ + rw [hstep] + exact horiginal + | some candidate => + have habove := (findPivotOption_some state active candidate found).1 + have hactive : state.nextPivot < m := habove.trans_lt candidate.isLt + let pivot : Fin m := ⟨state.nextPivot, hactive⟩ + have hpresent : gaussianPhysicalColumnPivotPresent input = true := by + simpa only [found, Option.isSome_some] using + gaussianPhysicalColumnPivotPresent_effective state source row column active + unfold gaussianPhysicalColumnUpdatedRhsWord + binaryGaussianDynamicBranchOutput + rw [hpresent] + simp only [↓reduceIte] + have hupdated := gaussianPhysicalColumnPivotUpdatedRhsWord_effective + state source row column active candidate pivot found rfl + simp only [columnStep, hactive, ↓reduceDIte, found] + exact hupdated + +end GaussianAdaptivePhysicalColumnCellUpdateTM + +namespace GaussianAdaptivePhysicalColumnStateTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceOriginalSourcePreservingTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceFourFamilyDiagonalMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM GapCVP.BinaryExplicitAffineRows +open GapCVP.Factor400BinaryPhysicalWorkers GapCVP.GaussianRowWorker +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianAdaptiveEliminationCorrectness +open GapCVP.GaussianAdaptivePackedTraceCorrectness GapCVP.GaussianAdaptivePhysicalStateCellTM +open GapCVP.GaussianAdaptivePackedStateLookupTM +open GapCVP.GaussianAdaptivePhysicalCandidateCatalogueTM + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnActiveUnary : List Bool → List Bool := + firstFieldContents + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnActiveUnaryComputable : + BitTM + gaussianPhysicalColumnActiveUnary := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnCurrentState : List Bool → List Bool := + firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnCurrentStateComputable : + BitTM + gaussianPhysicalColumnCurrentState := + firstFieldSuffixComputable + +private def gaussianPhysicalColumnOldNextUnary : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ firstFieldSuffix ∘ + gaussianPhysicalColumnCurrentState + +private noncomputable def gaussianPhysicalColumnOldNextUnaryComputable : + BitTM + gaussianPhysicalColumnOldNextUnary := by + have hcheck := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnCurrentStateComputable + firstFieldSuffixComputable + have hrhs := GapCVP.TMComposition.computableInPolyTime + hcheck firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hrhs firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnPivotPresent + (input : List Bool) : Bool := + (gaussianPhysicalPivotDecisionOutput input).headD false + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnPivotPresentComputable : + BitTM + (fun input => gaussianPhysicalColumnPivotPresent input :: input) := by + have hbit := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotDecisionComputable + binaryGaussianFirstCellComputable + have hpreserved := originalSourcePreservingComputable hbit + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved factor400KeepFirstDropSecondComputable + convert hphysical using 1 + funext input + change gaussianPhysicalColumnPivotPresent input :: input = + factor400KeepFirstDropSecondWord + (originalSourcePreservingOutput + (binaryGaussianFirstCellWord ∘ + gaussianPhysicalPivotDecisionOutput) input) + cases hpivot : gaussianPhysicalPivotDecisionOutput input with + | nil => + simp only [gaussianPhysicalColumnPivotPresent, hpivot, List.headD_eq_head?_getD, + List.head?_nil, + Option.getD_none, factor400KeepFirstDropSecondWord, originalSourcePreservingOutput, + binaryGaussianFirstCellWord, + Function.comp_apply, OutputPolynomialCompositionClosure.markerConditionalOutput, + List.cons_append, List.nil_append, + List.tail_cons] + | cons first remaining => + simp only [gaussianPhysicalColumnPivotPresent, hpivot, List.headD_eq_head?_getD, + List.head?_cons, + Option.getD_some, factor400KeepFirstDropSecondWord, originalSourcePreservingOutput, + Function.comp_apply, + binaryGaussianFirstCellWord_valid, List.cons_append, List.nil_append, List.tail_cons] + +private def gaussianPhysicalColumnNextSuccessor : List Bool → List Bool := + fourFamilyComputedUnarySumOutput + gaussianPhysicalColumnOldNextUnary + (fun _ : List Bool => [true]) + +private noncomputable def gaussianPhysicalColumnNextSuccessorComputable : + BitTM + gaussianPhysicalColumnNextSuccessor := + fourFamilyComputedUnarySumComputable + gaussianPhysicalColumnOldNextUnaryComputable + (sourceFixedWordComputable [true]) + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnNextPivotUnary : List Bool → List Bool := + binaryGaussianDynamicBranchOutput + gaussianPhysicalColumnPivotPresent + gaussianPhysicalColumnNextSuccessor + gaussianPhysicalColumnOldNextUnary + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnNextPivotUnaryComputable : + BitTM + gaussianPhysicalColumnNextPivotUnary := + binaryGaussianDynamicBranchComputable + gaussianPhysicalColumnPivotPresentComputable + gaussianPhysicalColumnNextSuccessorComputable + gaussianPhysicalColumnOldNextUnaryComputable + +@[simp] theorem gaussianPhysicalColumnActiveUnary_query + (column : ℕ) (state : List Bool) : + gaussianPhysicalColumnActiveUnary + (gaussianPhysicalPivotColumnQuery column state) = + List.replicate column true := by + simp only [gaussianPhysicalColumnActiveUnary, gaussianPhysicalPivotColumnQuery, + firstFieldContents_valid] + +@[simp] theorem gaussianPhysicalColumnCurrentState_query + (column : ℕ) (state : List Bool) : + gaussianPhysicalColumnCurrentState + (gaussianPhysicalPivotColumnQuery column state) = state := by + simp only [gaussianPhysicalColumnCurrentState, gaussianPhysicalPivotColumnQuery, + firstFieldSuffix_valid] + +@[simp] private theorem gaussianPhysicalColumnOldNextUnary_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) : + gaussianPhysicalColumnOldNextUnary + (gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate state.nextPivot true := by + simp only [gaussianPhysicalColumnOldNextUnary, gaussianPhysicalColumnCurrentState, + gaussianPhysicalPivotColumnQuery, effectiveGaussianPackedStateWord, List.append_assoc, + Function.comp_apply, + firstFieldSuffix_valid, firstFieldContents_valid] + +theorem gaussianPhysicalColumnPivotPresent_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) + (hrows : 0 < m) : + gaussianPhysicalColumnPivotPresent + (gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source)) = + (findPivotOption state column).isSome := by + unfold gaussianPhysicalColumnPivotPresent + rw [gaussianPhysicalPivotDecisionOutput_effective + state source column hrows] + cases findPivotOption state column <;> rfl + +private theorem gaussianPhysicalColumnNextSuccessor_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) : + gaussianPhysicalColumnNextSuccessor + (gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate (state.nextPivot + 1) true := by + apply fourFamilyComputedUnarySumOutput_valid + gaussianPhysicalColumnOldNextUnary + (fun _ : List Bool => [true]) + (gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source)) + state.nextPivot 1 + · exact gaussianPhysicalColumnOldNextUnary_effective + state source column + · rfl + +private theorem gaussianPhysicalColumn_foundPivot_next_lt + {m n : ℕ} (state : State m n) + (column : Fin n) (row : Fin m) + (hfound : findPivotOption state column = some row) : + state.nextPivot < m := by + have hle := (findPivotOption_some state column row hfound).1 + exact lt_of_le_of_lt hle row.isLt + +theorem gaussianPhysicalColumnNextPivotUnary_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column : Fin n) + (hrows : 0 < m) : + gaussianPhysicalColumnNextPivotUnary + (gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate (columnStep state column).nextPivot true := by + let input := gaussianPhysicalPivotColumnQuery column.val + (effectiveGaussianPackedStateWord state source) + have hmarker := gaussianPhysicalColumnPivotPresent_effective + state source column hrows + change gaussianPhysicalColumnNextPivotUnary input = _ + unfold gaussianPhysicalColumnNextPivotUnary + binaryGaussianDynamicBranchOutput + cases hfound : findPivotOption state column with + | none => + have hfalse : gaussianPhysicalColumnPivotPresent input = false := by + simpa only [hfound, Option.isSome_none] using hmarker + rw [hfalse, ite_eq_right Bool.false_ne_true] + rw [gaussianPhysicalColumnOldNextUnary_effective] + by_cases hactive : state.nextPivot < m <;> + simp [columnStep, hactive, hfound] + | some row => + have htrue : gaussianPhysicalColumnPivotPresent input = true := by + simpa only [hfound, Option.isSome_some] using hmarker + have hactive : state.nextPivot < m := + gaussianPhysicalColumn_foundPivot_next_lt + state column row hfound + rw [htrue, ite_eq_left rfl] + rw [gaussianPhysicalColumnNextSuccessor_effective] + simp only [columnStep, hactive, ↓reduceDIte, hfound, clearTargets_pivots] + +private theorem effectiveGaussianColumnStepPivotWord + {m n : ℕ} (state : State m n) + (active column : Fin n) : + effectiveGaussianStatePivotWord + (columnStep state active) column = + if (findPivotOption state active).isSome && + decide (active = column) then + true :: List.replicate state.nextPivot true + else + effectiveGaussianStatePivotWord state column := by + cases hfound : findPivotOption state active with + | none => + by_cases hactive : state.nextPivot < m <;> + simp [columnStep, hactive, hfound] + | some row => + have hactive : state.nextPivot < m := + gaussianPhysicalColumn_foundPivot_next_lt + state active row hfound + by_cases heq : active = column + · subst column + simp only [effectiveGaussianStatePivotWord, + effectiveGaussianStatePivotRowOption, columnStep, + hactive, ↓reduceDIte, + hfound, applyOperation, clearTargets_pivots, decide_true, List.find?_cons_of_pos, + Option.map_some, + Option.isSome_some, Bool.and_self, ↓reduceIte] + · simp only [effectiveGaussianStatePivotWord, + effectiveGaussianStatePivotRowOption, columnStep, + hactive, ↓reduceDIte, + hfound, applyOperation, clearTargets_pivots, heq, decide_false, Bool.false_eq_true, + not_false_eq_true, + List.find?_cons_of_neg, Option.isSome_some, Bool.and_false, ↓reduceIte] + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnPivotRecordOuter : + List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnPivotRecordOuterComputable : + BitTM + gaussianPhysicalColumnPivotRecordOuter := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + +@[simp] theorem gaussianPhysicalColumnPivotRecordOuter_word + (rank width active : ℕ) (state : List Bool) : + gaussianPhysicalColumnPivotRecordOuter + (gaussianPhysicalPivotRecordWord rank width active state) = + gaussianPhysicalPivotColumnQuery active state := by + simp only [gaussianPhysicalColumnPivotRecordOuter, gaussianPhysicalPivotRecordWord, + List.append_assoc, + Function.comp_apply, firstFieldSuffix_valid] + +private def gaussianPhysicalColumnOldPivotQuery + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPhysicalPivotRecordRow input) ++ + (lengthPrefixedWord [] ++ + gaussianPhysicalPivotRecordState input) + +private noncomputable def gaussianPhysicalColumnOldPivotQueryComputable : + BitTM + gaussianPhysicalColumnOldPivotQuery := by + have hrank := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotRecordRowComputable + structuralPrefixWriterComputable + have hzero := sourceFixedWordComputable + (lengthPrefixedWord ([] : List Bool)) + have hphysical := pointwiseAppendComputable hrank + (pointwiseAppendComputable hzero + gaussianPhysicalPivotRecordStateComputable) + change BitTM + (fun input => + lengthPrefixedWord (gaussianPhysicalPivotRecordRow input) ++ + (lengthPrefixedWord [] ++ + gaussianPhysicalPivotRecordState input)) + simpa only [Function.comp_apply] using hphysical + +@[simp] private theorem gaussianPhysicalColumnOldPivotQuery_word + (rank width active : ℕ) (state : List Bool) : + gaussianPhysicalColumnOldPivotQuery + (gaussianPhysicalPivotRecordWord rank width active state) = + affineCellQuery rank 0 state := by + simp only [gaussianPhysicalColumnOldPivotQuery, gaussianPhysicalPivotRecordRow_word, + gaussianPhysicalPivotRecordState_word, affineCellQuery, List.replicate_zero, + List.append_assoc] + +private def gaussianPhysicalColumnOldPivotWord : List Bool → List Bool := + gaussianPackedStatePivotCellWord ∘ + gaussianPhysicalColumnOldPivotQuery + +private noncomputable def gaussianPhysicalColumnOldPivotComputable : + BitTM + gaussianPhysicalColumnOldPivotWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnOldPivotQueryComputable + gaussianPackedStatePivotCellComputable + +private theorem gaussianPhysicalColumnOldPivotWord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column active : Fin n) + (width : ℕ) : + gaussianPhysicalColumnOldPivotWord + (gaussianPhysicalPivotRecordWord column.val width active.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianStatePivotWord state column := by + unfold gaussianPhysicalColumnOldPivotWord + rw [Function.comp_apply, + gaussianPhysicalColumnOldPivotQuery_word] + exact gaussianPackedStatePivotCellWord_query + state source column + +private def gaussianPhysicalColumnPivotRecordActiveEq : + List Bool → List Bool := + fourFamilyComputedUnaryEqBitOutput + gaussianPhysicalPivotRecordRow + gaussianPhysicalPivotRecordColumn + +private noncomputable def gaussianPhysicalColumnPivotRecordActiveEqComputable : + BitTM + gaussianPhysicalColumnPivotRecordActiveEq := + fourFamilyComputedUnaryEqBitComputable + gaussianPhysicalPivotRecordRowComputable + gaussianPhysicalPivotRecordColumnComputable + +private def gaussianPhysicalColumnPivotRecordPresentWord : + List Bool → List Bool := + binaryGaussianFirstCellWord ∘ + gaussianPhysicalPivotDecisionOutput ∘ + gaussianPhysicalColumnPivotRecordOuter + +private noncomputable def gaussianPhysicalColumnPivotRecordPresentComputable : + BitTM + gaussianPhysicalColumnPivotRecordPresentWord := by + have hdecision := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnPivotRecordOuterComputable + gaussianPhysicalPivotDecisionComputable + exact GapCVP.TMComposition.computableInPolyTime + hdecision binaryGaussianFirstCellComputable + +private def gaussianPhysicalColumnPivotRecordUpdateMarker : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + gaussianPhysicalColumnPivotRecordPresentWord + gaussianPhysicalColumnPivotRecordActiveEq + +private noncomputable def gaussianPhysicalColumnPivotRecordUpdateMarkerComputable : + BitTM + gaussianPhysicalColumnPivotRecordUpdateMarker := + fourFamilyBooleanAndComputable + gaussianPhysicalColumnPivotRecordPresentComputable + gaussianPhysicalColumnPivotRecordActiveEqComputable + +private def gaussianPhysicalColumnNewPivotWord + (input : List Bool) : List Bool := + [true] ++ gaussianPhysicalPivotRecordNextUnary input + +private noncomputable def gaussianPhysicalColumnNewPivotComputable : + BitTM + gaussianPhysicalColumnNewPivotWord := + pointwiseAppendComputable + (sourceFixedWordComputable [true]) + gaussianPhysicalPivotRecordNextUnaryComputable + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalComputedMarkerPreservingComputable + {marker : List Bool → List Bool} + (computer : BitTM marker) : + BitTM + (fun input => (marker input).headD false :: input) := by + have hbit := GapCVP.TMComposition.computableInPolyTime + computer binaryGaussianFirstCellComputable + have hpreserved := originalSourcePreservingComputable hbit + have hphysical := GapCVP.TMComposition.computableInPolyTime + hpreserved factor400KeepFirstDropSecondComputable + convert hphysical using 1 + funext input + change (marker input).headD false :: input = + factor400KeepFirstDropSecondWord + (originalSourcePreservingOutput + (binaryGaussianFirstCellWord ∘ marker) input) + cases hmarker : marker input with + | nil => + simp only [List.headD_eq_head?_getD, List.head?_nil, Option.getD_none, + factor400KeepFirstDropSecondWord, + originalSourcePreservingOutput, binaryGaussianFirstCellWord, Function.comp_apply, + OutputPolynomialCompositionClosure.markerConditionalOutput, hmarker, List.cons_append, + List.nil_append, + List.tail_cons] + | cons bit remaining => + simp only [List.headD_eq_head?_getD, List.head?_cons, Option.getD_some, + factor400KeepFirstDropSecondWord, + originalSourcePreservingOutput, Function.comp_apply, hmarker, + binaryGaussianFirstCellWord_valid, List.cons_append, + List.nil_append, List.tail_cons] + +private def gaussianPhysicalColumnPivotRecordShouldUpdate + (input : List Bool) : Bool := + (gaussianPhysicalColumnPivotRecordUpdateMarker input).headD false + +private noncomputable def gaussianPhysicalColumnPivotRecordShouldUpdateComputable : + BitTM + (fun input => + gaussianPhysicalColumnPivotRecordShouldUpdate input :: input) := + gaussianPhysicalComputedMarkerPreservingComputable + gaussianPhysicalColumnPivotRecordUpdateMarkerComputable + +private def gaussianPhysicalColumnUpdatedPivotWord : + List Bool → List Bool := + binaryGaussianDynamicBranchOutput + gaussianPhysicalColumnPivotRecordShouldUpdate + gaussianPhysicalColumnNewPivotWord + gaussianPhysicalColumnOldPivotWord + +private noncomputable def gaussianPhysicalColumnUpdatedPivotComputable : + BitTM + gaussianPhysicalColumnUpdatedPivotWord := + binaryGaussianDynamicBranchComputable + gaussianPhysicalColumnPivotRecordShouldUpdateComputable + gaussianPhysicalColumnNewPivotComputable + gaussianPhysicalColumnOldPivotComputable + +private theorem gaussianPhysicalColumnPivotRecordActiveEq_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column active : Fin n) + (width : ℕ) : + gaussianPhysicalColumnPivotRecordActiveEq + (gaussianPhysicalPivotRecordWord column.val width active.val + (effectiveGaussianPackedStateWord state source)) = + [decide (column = active)] := by + let input := gaussianPhysicalPivotRecordWord + column.val width active.val + (effectiveGaussianPackedStateWord state source) + have heq := fourFamilyComputedUnaryEqBitOutput_valid + gaussianPhysicalPivotRecordRow + gaussianPhysicalPivotRecordColumn input + column.val active.val + (gaussianPhysicalPivotRecordRow_word + column.val width active.val + (effectiveGaussianPackedStateWord state source)) + (gaussianPhysicalPivotRecordColumn_word + column.val width active.val + (effectiveGaussianPackedStateWord state source)) + change gaussianPhysicalColumnPivotRecordActiveEq input = _ + change fourFamilyComputedUnaryEqBitOutput + gaussianPhysicalPivotRecordRow + gaussianPhysicalPivotRecordColumn input = _ + rw [heq] + by_cases h : column = active + · subst active + simp only [decide_true] + · have hv : column.val ≠ active.val := by + intro hv + exact h (Fin.ext hv) + simp only [hv, decide_false, h] + +private theorem gaussianPhysicalColumnPivotRecordPresentWord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column active : Fin n) + (width : ℕ) (hrows : 0 < m) : + gaussianPhysicalColumnPivotRecordPresentWord + (gaussianPhysicalPivotRecordWord column.val width active.val + (effectiveGaussianPackedStateWord state source)) = + [(findPivotOption state active).isSome] := by + unfold gaussianPhysicalColumnPivotRecordPresentWord + simp only [Function.comp_apply, + gaussianPhysicalColumnPivotRecordOuter_word] + rw [gaussianPhysicalPivotDecisionOutput_effective + state source active hrows] + cases findPivotOption state active <;> + simp [binaryGaussianFirstCellWord, + GapCVP.OutputPolynomialCompositionClosure.markerConditionalOutput] + +private theorem gaussianPhysicalColumnPivotRecordUpdateMarker_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column active : Fin n) + (width : ℕ) (hrows : 0 < m) : + gaussianPhysicalColumnPivotRecordUpdateMarker + (gaussianPhysicalPivotRecordWord column.val width active.val + (effectiveGaussianPackedStateWord state source)) = + [(findPivotOption state active).isSome && + decide (column = active)] := by + let input := gaussianPhysicalPivotRecordWord + column.val width active.val + (effectiveGaussianPackedStateWord state source) + have hpresent := gaussianPhysicalColumnPivotRecordPresentWord_effective + state source column active width hrows + have hequal := gaussianPhysicalColumnPivotRecordActiveEq_effective + state source column active width + exact fourFamilyBooleanAndOutput_bits + gaussianPhysicalColumnPivotRecordPresentWord + gaussianPhysicalColumnPivotRecordActiveEq input + (findPivotOption state active).isSome + (decide (column = active)) hpresent hequal + +private theorem gaussianPhysicalColumnUpdatedPivotWord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column active : Fin n) + (width : ℕ) (hrows : 0 < m) : + gaussianPhysicalColumnUpdatedPivotWord + (gaussianPhysicalPivotRecordWord column.val width active.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianStatePivotWord + (columnStep state active) column := by + let input := gaussianPhysicalPivotRecordWord + column.val width active.val + (effectiveGaussianPackedStateWord state source) + have hmarker := gaussianPhysicalColumnPivotRecordUpdateMarker_effective + state source column active width hrows + have hnext := gaussianPhysicalPivotRecordNextUnary_word + state source column.val width active.val + have hold := gaussianPhysicalColumnOldPivotWord_effective + state source column active width + have hsemantic := effectiveGaussianColumnStepPivotWord + state active column + change gaussianPhysicalColumnUpdatedPivotWord input = _ + unfold gaussianPhysicalColumnUpdatedPivotWord + binaryGaussianDynamicBranchOutput + gaussianPhysicalColumnPivotRecordShouldUpdate + rw [hmarker] + cases hfound : findPivotOption state active with + | none => + simp only [Option.isSome_none, Bool.false_and, + List.headD_cons, Bool.false_eq_true, ↓reduceIte] + rw [hold, hsemantic, hfound] + simp only [Option.isSome_none, Bool.false_and, Bool.false_eq_true, ↓reduceIte] + | some row => + by_cases heq : column = active + · subst column + simp only [Option.isSome_some, decide_true, + Bool.and_self, List.headD_cons, ↓reduceIte] + change [true] ++ + gaussianPhysicalPivotRecordNextUnary input = _ + rw [hnext, hsemantic, hfound] + simp only [List.cons_append, List.nil_append, Option.isSome_some, decide_true, + Bool.and_self, ↓reduceIte] + · have hreverse : active ≠ column := Ne.symm heq + simp only [Option.isSome_some, heq, decide_false, + Bool.and_false, List.headD_cons, + Bool.false_eq_true, ↓reduceIte] + rw [hold, hsemantic, hfound] + simp only [Option.isSome_some, hreverse, decide_false, Bool.and_false, Bool.false_eq_true, + ↓reduceIte] + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnPivotWidthOutput : List Bool → List Bool := + gaussianDenseStateDimensionUnary ∘ + gaussianPhysicalColumnCurrentState + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnPivotWidthComputable : + BitTM + gaussianPhysicalColumnPivotWidthOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnCurrentStateComputable + gaussianDenseStateDimensionUnaryComputable + +private noncomputable def gaussianPhysicalColumnPivotWidth : + SourceQaryMaskDynamicGridWidth where + output := gaussianPhysicalColumnPivotWidthOutput + computer := gaussianPhysicalColumnPivotWidthComputable + +private def gaussianPhysicalColumnUpdatedPivotRecordOutput : + List Bool → List Bool := + (fun word => lengthPrefixedWord word) ∘ + gaussianPhysicalColumnUpdatedPivotWord + +private noncomputable def gaussianPhysicalColumnUpdatedPivotRecordComputable : + BitTM + gaussianPhysicalColumnUpdatedPivotRecordOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnUpdatedPivotComputable + structuralPrefixWriterComputable + +/-- GapCVP reduction support. -/ +def gaussianPhysicalColumnUpdatedPivotCatalogueOutput : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + gaussianPhysicalColumnPivotWidth + gaussianPhysicalColumnUpdatedPivotRecordComputable + +/-- GapCVP reduction support. -/ +noncomputable def gaussianPhysicalColumnUpdatedPivotCatalogueComputable : + BitTM + gaussianPhysicalColumnUpdatedPivotCatalogueOutput := + maskDynamicGridRecordCatalogueComputable + gaussianPhysicalColumnPivotWidth + gaussianPhysicalColumnUpdatedPivotRecordComputable + +theorem gaussianPhysicalColumnPivotWidth_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (hrows : 0 < m) : + gaussianPhysicalColumnPivotWidth.output + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate n true := by + change gaussianDenseStateDimensionUnary + (gaussianPhysicalColumnCurrentState + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source))) = _ + rw [gaussianPhysicalColumnCurrentState_query] + exact gaussianDenseStateDimensionUnary_effective + state source hrows + +private theorem gaussianPhysicalColumnUpdatedPivotCatalogueOutput_valid + (input : List Bool) (count : ℕ) + (hwidth : gaussianPhysicalColumnPivotWidth.output input = + List.replicate count true) : + gaussianPhysicalColumnUpdatedPivotCatalogueOutput input = + (List.range count).flatMap (fun rank => + gaussianPhysicalColumnUpdatedPivotRecordOutput + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalColumnPivotWidth input)) := by + exact maskDynamicGridRecordCatalogueOutput_valid + gaussianPhysicalColumnPivotWidth + gaussianPhysicalColumnUpdatedPivotRecordComputable + input count hwidth + +private theorem gaussianPhysicalColumnPivotGeneratedRecord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (rank : ℕ) (hrows : 0 < m) : + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalColumnPivotWidth + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + gaussianPhysicalPivotRecordWord rank n active.val + (effectiveGaussianPackedStateWord state source) := by + unfold sourceQaryMaskDynamicGridBaseSource + rw [gaussianPhysicalColumnPivotWidth_effective + state source active hrows] + simp only [gaussianPhysicalPivotRecordWord, + List.append_assoc] + +private theorem gaussianPhysicalColumnUpdatedPivotRecordOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (column active : Fin n) + (width : ℕ) (hrows : 0 < m) : + gaussianPhysicalColumnUpdatedPivotRecordOutput + (gaussianPhysicalPivotRecordWord column.val width active.val + (effectiveGaussianPackedStateWord state source)) = + lengthPrefixedWord + (effectiveGaussianStatePivotWord + (columnStep state active) column) := by + unfold gaussianPhysicalColumnUpdatedPivotRecordOutput + rw [Function.comp_apply, + gaussianPhysicalColumnUpdatedPivotWord_effective + state source column active width hrows] + +theorem gaussianPhysicalColumnUpdatedPivotCatalogueOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (hrows : 0 < m) : + gaussianPhysicalColumnUpdatedPivotCatalogueOutput + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianPackedPivotCatalogue + (columnStep state active) := by + let input := gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source) + have hwidth : gaussianPhysicalColumnPivotWidth.output input = + List.replicate n true := + gaussianPhysicalColumnPivotWidth_effective + state source active hrows + have hcatalogue := + gaussianPhysicalColumnUpdatedPivotCatalogueOutput_valid + input n hwidth + calc + gaussianPhysicalColumnUpdatedPivotCatalogueOutput input = + (List.range n).flatMap (fun rank => + gaussianPhysicalColumnUpdatedPivotRecordOutput + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalColumnPivotWidth input)) := + hcatalogue + _ = (List.range n).flatMap (fun rank => + gaussianPhysicalColumnUpdatedPivotRecordOutput + (gaussianPhysicalPivotRecordWord rank n active.val + (effectiveGaussianPackedStateWord state source))) := by + apply List.flatMap_congr + intro rank _ + exact congrArg gaussianPhysicalColumnUpdatedPivotRecordOutput + (gaussianPhysicalColumnPivotGeneratedRecord_effective + state source active rank hrows) + _ = (List.finRange n).flatMap (fun column => + gaussianPhysicalColumnUpdatedPivotRecordOutput + (gaussianPhysicalPivotRecordWord column.val n active.val + (effectiveGaussianPackedStateWord state source))) := + gaussianPhysicalPivot_range_flatMap_finRange n _ + _ = (List.finRange n).flatMap (fun column => + lengthPrefixedWord + (effectiveGaussianStatePivotWord + (columnStep state active) column)) := by + apply List.flatMap_congr + intro column _ + exact gaussianPhysicalColumnUpdatedPivotRecordOutput_effective + state source column active n hrows + _ = effectiveGaussianPackedPivotCatalogue + (columnStep state active) := by + unfold effectiveGaussianPackedPivotCatalogue + binaryGaussianPivotBatchStream + sourceMixedRadixOriginalSourceQueryStream + rw [List.flatMap_map] + +end GaussianAdaptivePhysicalColumnStateTM + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part13.lean b/LeanPool/GapCVP/Part13.lean new file mode 100644 index 000000000..2e5dd2cdf --- /dev/null +++ b/LeanPool/GapCVP/Part13.lean @@ -0,0 +1,7782 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part12 + +/-! # GapCVP proof, part 13 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace GaussianAdaptivePhysicalUpdatedMatrixCatalogueTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceMachineCert GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceStructuralTuringTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFCappedUnaryPairArithmeticTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.SourceMixedRadixUnaryQuotientRemainderTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryPhysicalWordPackedMatrixTM GapCVP.BinaryPhysicalWordQueryCatalogueTM +open GapCVP.GaussianAdaptiveEliminationCorrectness GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianAdaptivePhysicalStateCellTM +open GapCVP.GaussianAdaptivePhysicalCandidateCatalogueTM +open GapCVP.GaussianAdaptivePhysicalColumnStateTM +open GapCVP.GaussianAdaptivePhysicalColumnCellUpdateTM + +private def gaussianPhysicalUpdatedRowsUnary : List Bool → List Bool := + gaussianDenseStateRowCountUnary ∘ + gaussianPhysicalColumnCurrentState + +private noncomputable def gaussianPhysicalUpdatedRowsUnaryComputable : + BitTM + gaussianPhysicalUpdatedRowsUnary := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnCurrentStateComputable + gaussianDenseStateRowCountUnaryComputable + +private def gaussianPhysicalUpdatedCheckWidthOutput : + List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + gaussianPhysicalUpdatedRowsUnary + gaussianPhysicalColumnPivotWidthOutput + +private noncomputable def gaussianPhysicalUpdatedCheckWidthComputable : + BitTM + gaussianPhysicalUpdatedCheckWidthOutput := + fourFamilyComputedUnaryProductComputable + gaussianPhysicalUpdatedRowsUnaryComputable + gaussianPhysicalColumnPivotWidthComputable + +private noncomputable def gaussianPhysicalUpdatedCheckWidth : + SourceQaryMaskDynamicGridWidth where + output := gaussianPhysicalUpdatedCheckWidthOutput + computer := gaussianPhysicalUpdatedCheckWidthComputable + +private noncomputable def gaussianPhysicalUpdatedRhsWidth : + SourceQaryMaskDynamicGridWidth where + output := gaussianPhysicalUpdatedRowsUnary + computer := gaussianPhysicalUpdatedRowsUnaryComputable + +private def gaussianPhysicalUpdatedRankDimension : List Bool → List Bool := + gaussianDenseStateDimensionUnary ∘ + gaussianPhysicalPivotRecordState + +private noncomputable def gaussianPhysicalUpdatedRankDimensionComputable : + BitTM + gaussianPhysicalUpdatedRankDimension := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotRecordStateComputable + gaussianDenseStateDimensionUnaryComputable + +private def gaussianPhysicalUpdatedRankDivisionInput + (input : List Bool) : List Bool := + gaussianPhysicalPivotRecordRow input ++ false :: + (gaussianPhysicalUpdatedRankDimension input ++ false :: + gaussianPhysicalColumnPivotRecordOuter input) + +private noncomputable def gaussianPhysicalUpdatedRankDivisionInputComputable : + BitTM + gaussianPhysicalUpdatedRankDivisionInput := by + have hsource := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnPivotRecordOuterComputable + (prependBitComputable false) + have hdimension := pointwiseAppendComputable + gaussianPhysicalUpdatedRankDimensionComputable hsource + have hseparator := GapCVP.TMComposition.computableInPolyTime + hdimension (prependBitComputable false) + have hphysical := pointwiseAppendComputable + gaussianPhysicalPivotRecordRowComputable hseparator + change BitTM + (fun input => + gaussianPhysicalPivotRecordRow input ++ false :: + (gaussianPhysicalUpdatedRankDimension input ++ false :: + gaussianPhysicalColumnPivotRecordOuter input)) + simpa only [Function.comp_apply] using hphysical + +private def gaussianPhysicalUpdatedRankDivisionOutput : + List Bool → List Bool := + sourceUnaryDivisionOutput ∘ + gaussianPhysicalUpdatedRankDivisionInput + +private noncomputable def gaussianPhysicalUpdatedRankDivisionComputable : + BitTM + gaussianPhysicalUpdatedRankDivisionOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedRankDivisionInputComputable + sourceUnaryDivisionComputable + +private def gaussianPhysicalUpdatedRankRow + (input : List Bool) : List Bool := + (unaryPrefixOutput + (gaussianPhysicalUpdatedRankDivisionOutput input)).tail + +private noncomputable def gaussianPhysicalUpdatedRankRowComputable : + BitTM + gaussianPhysicalUpdatedRankRow := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedRankDivisionComputable + unaryPrefixComputable + exact GapCVP.TMComposition.computableInPolyTime + hprefix dropHeadComputable + +private def gaussianPhysicalUpdatedRankColumn + (input : List Bool) : List Bool := + (unaryPrefixOutput + (unaryPrefixSuffixOutput + (gaussianPhysicalUpdatedRankDivisionOutput input))).tail + +private noncomputable def gaussianPhysicalUpdatedRankColumnComputable : + BitTM + gaussianPhysicalUpdatedRankColumn := by + have hsuffix := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedRankDivisionComputable + actualUnaryPrefixSuffixComputable + have hprefix := GapCVP.TMComposition.computableInPolyTime + hsuffix unaryPrefixComputable + exact GapCVP.TMComposition.computableInPolyTime + hprefix dropHeadComputable + +private def gaussianPhysicalUpdatedCheckCellQuery + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPhysicalUpdatedRankRow input) ++ + (lengthPrefixedWord (gaussianPhysicalUpdatedRankColumn input) ++ + gaussianPhysicalColumnPivotRecordOuter input) + +private noncomputable def gaussianPhysicalUpdatedCheckCellQueryComputable : + BitTM + gaussianPhysicalUpdatedCheckCellQuery := by + have hrow := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedRankRowComputable + structuralPrefixWriterComputable + have hcolumn := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedRankColumnComputable + structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hrow + (pointwiseAppendComputable hcolumn + gaussianPhysicalColumnPivotRecordOuterComputable) + change BitTM + (fun input => + lengthPrefixedWord (gaussianPhysicalUpdatedRankRow input) ++ + (lengthPrefixedWord (gaussianPhysicalUpdatedRankColumn input) ++ + gaussianPhysicalColumnPivotRecordOuter input)) + simpa only [Function.comp_apply] using hphysical + +private def gaussianPhysicalUpdatedCheckRecordOutput : + List Bool → List Bool := + gaussianPhysicalColumnUpdatedCheckWord ∘ + gaussianPhysicalUpdatedCheckCellQuery + +private noncomputable def gaussianPhysicalUpdatedCheckRecordComputable : + BitTM + gaussianPhysicalUpdatedCheckRecordOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedCheckCellQueryComputable + gaussianPhysicalColumnUpdatedCheckComputable + +private def gaussianPhysicalUpdatedRhsCellQuery + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPhysicalPivotRecordRow input) ++ + (lengthPrefixedWord [] ++ + gaussianPhysicalColumnPivotRecordOuter input) + +private noncomputable def gaussianPhysicalUpdatedRhsCellQueryComputable : + BitTM + gaussianPhysicalUpdatedRhsCellQuery := by + have hrow := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPivotRecordRowComputable + structuralPrefixWriterComputable + have hzero := sourceFixedWordComputable + (lengthPrefixedWord ([] : List Bool)) + have hphysical := pointwiseAppendComputable hrow + (pointwiseAppendComputable hzero + gaussianPhysicalColumnPivotRecordOuterComputable) + change BitTM + (fun input => + lengthPrefixedWord (gaussianPhysicalPivotRecordRow input) ++ + (lengthPrefixedWord [] ++ + gaussianPhysicalColumnPivotRecordOuter input)) + simpa only [Function.comp_apply] using hphysical + +private def gaussianPhysicalUpdatedRhsRecordOutput : + List Bool → List Bool := + gaussianPhysicalColumnUpdatedRhsWord ∘ + gaussianPhysicalUpdatedRhsCellQuery + +private noncomputable def gaussianPhysicalUpdatedRhsRecordComputable : + BitTM + gaussianPhysicalUpdatedRhsRecordOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedRhsCellQueryComputable + gaussianPhysicalColumnUpdatedRhsComputable + +private def gaussianPhysicalUpdatedCheckBitsOutput : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + gaussianPhysicalUpdatedCheckWidth + gaussianPhysicalUpdatedCheckRecordComputable + +private noncomputable def gaussianPhysicalUpdatedCheckBitsComputable : + BitTM + gaussianPhysicalUpdatedCheckBitsOutput := + maskDynamicGridRecordCatalogueComputable + gaussianPhysicalUpdatedCheckWidth + gaussianPhysicalUpdatedCheckRecordComputable + +private def gaussianPhysicalUpdatedRhsBitsOutput : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + gaussianPhysicalUpdatedRhsWidth + gaussianPhysicalUpdatedRhsRecordComputable + +private noncomputable def gaussianPhysicalUpdatedRhsBitsComputable : + BitTM + gaussianPhysicalUpdatedRhsBitsOutput := + maskDynamicGridRecordCatalogueComputable + gaussianPhysicalUpdatedRhsWidth + gaussianPhysicalUpdatedRhsRecordComputable + +@[simp] private theorem gaussianPhysicalUpdatedRowsUnary_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) : + gaussianPhysicalUpdatedRowsUnary + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate m true := by + unfold gaussianPhysicalUpdatedRowsUnary + rw [Function.comp_apply, + gaussianPhysicalColumnCurrentState_query, + gaussianDenseStateRowCountUnary_effective] + +private theorem gaussianPhysicalUpdatedCheckWidth_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (hrows : 0 < m) : + gaussianPhysicalUpdatedCheckWidth.output + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate (m * n) true := by + apply fourFamilyComputedUnaryProductOutput_valid + gaussianPhysicalUpdatedRowsUnary + gaussianPhysicalColumnPivotWidthOutput + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) m n + · exact gaussianPhysicalUpdatedRowsUnary_effective + state source active + · exact gaussianPhysicalColumnPivotWidth_effective + state source active hrows + +private theorem gaussianPhysicalUpdatedRhsWidth_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) : + gaussianPhysicalUpdatedRhsWidth.output + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate m true := by + exact gaussianPhysicalUpdatedRowsUnary_effective + state source active + +private theorem gaussianPhysicalUpdatedRankDimension_word + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (rank width : ℕ) (hrows : 0 < m) : + gaussianPhysicalUpdatedRankDimension + (gaussianPhysicalPivotRecordWord rank width active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate n true := by + unfold gaussianPhysicalUpdatedRankDimension + rw [Function.comp_apply, + gaussianPhysicalPivotRecordState_word] + exact gaussianDenseStateDimensionUnary_effective + state source hrows + +private theorem gaussianPhysicalUpdatedRankDivisionInput_word + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (rank width : ℕ) (hrows : 0 < m) : + gaussianPhysicalUpdatedRankDivisionInput + (gaussianPhysicalPivotRecordWord rank width active.val + (effectiveGaussianPackedStateWord state source)) = + sourceUnaryDivisionQuery rank n + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) := by + unfold gaussianPhysicalUpdatedRankDivisionInput + rw [gaussianPhysicalPivotRecordRow_word, + gaussianPhysicalUpdatedRankDimension_word + state source active rank width hrows, + gaussianPhysicalColumnPivotRecordOuter_word] + rfl + +private theorem gaussianPhysicalUpdatedRankDivisionOutput_word + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (rank width : ℕ) (hrows : 0 < m) : + gaussianPhysicalUpdatedRankDivisionOutput + (gaussianPhysicalPivotRecordWord rank width active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate (rank / n) true ++ false :: + (List.replicate (rank % n) true ++ false :: + sourceUnaryDivisionQuery rank n + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source))) := by + have hn : 0 < n := + lt_of_le_of_lt (Nat.zero_le active.val) active.isLt + unfold gaussianPhysicalUpdatedRankDivisionOutput + rw [Function.comp_apply, + gaussianPhysicalUpdatedRankDivisionInput_word + state source active rank width hrows, + sourceUnaryDivisionOutput_valid rank n + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) hn] + +private theorem gaussianPhysicalUpdatedRankRow_word + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (rank width : ℕ) (hrows : 0 < m) : + gaussianPhysicalUpdatedRankRow + (gaussianPhysicalPivotRecordWord rank width active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate (rank / n) true := by + unfold gaussianPhysicalUpdatedRankRow + rw [gaussianPhysicalUpdatedRankDivisionOutput_word + state source active rank width hrows, + unaryPrefixOutput_replicate_delimiter] + rfl + +private theorem gaussianPhysicalUpdatedRankColumn_word + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (rank width : ℕ) (hrows : 0 < m) : + gaussianPhysicalUpdatedRankColumn + (gaussianPhysicalPivotRecordWord rank width active.val + (effectiveGaussianPackedStateWord state source)) = + List.replicate (rank % n) true := by + unfold gaussianPhysicalUpdatedRankColumn + rw [gaussianPhysicalUpdatedRankDivisionOutput_word + state source active rank width hrows, + unaryPrefixSuffixOutput_valid, + unaryPrefixOutput_replicate_delimiter] + rfl + +private theorem gaussianPhysicalUpdatedCheckCellQuery_word + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (rank width : ℕ) (hrows : 0 < m) : + gaussianPhysicalUpdatedCheckCellQuery + (gaussianPhysicalPivotRecordWord rank width active.val + (effectiveGaussianPackedStateWord state source)) = + gaussianPhysicalColumnCellQuery + (rank / n) (rank % n) active.val + (effectiveGaussianPackedStateWord state source) := by + unfold gaussianPhysicalUpdatedCheckCellQuery + gaussianPhysicalColumnCellQuery + affineCellQuery + rw [gaussianPhysicalUpdatedRankRow_word + state source active rank width hrows, + gaussianPhysicalUpdatedRankColumn_word + state source active rank width hrows, + gaussianPhysicalColumnPivotRecordOuter_word] + simp only [List.append_assoc] + +private theorem gaussianPhysicalUpdatedRhsCellQuery_word + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (row width : ℕ) : + gaussianPhysicalUpdatedRhsCellQuery + (gaussianPhysicalPivotRecordWord row width active.val + (effectiveGaussianPackedStateWord state source)) = + gaussianPhysicalColumnCellQuery row 0 active.val + (effectiveGaussianPackedStateWord state source) := by + unfold gaussianPhysicalUpdatedRhsCellQuery + gaussianPhysicalColumnCellQuery + affineCellQuery + rw [gaussianPhysicalPivotRecordRow_word, + gaussianPhysicalColumnPivotRecordOuter_word] + simp only [List.append_assoc, List.replicate_zero] + +private theorem gaussianPhysicalUpdatedCheckBitsOutput_valid + (input : List Bool) (count : ℕ) + (hwidth : gaussianPhysicalUpdatedCheckWidth.output input = + List.replicate count true) : + gaussianPhysicalUpdatedCheckBitsOutput input = + (List.range count).flatMap (fun rank => + gaussianPhysicalUpdatedCheckRecordOutput + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalUpdatedCheckWidth input)) := by + exact maskDynamicGridRecordCatalogueOutput_valid + gaussianPhysicalUpdatedCheckWidth + gaussianPhysicalUpdatedCheckRecordComputable input count hwidth + +private theorem gaussianPhysicalUpdatedRhsBitsOutput_valid + (input : List Bool) (count : ℕ) + (hwidth : gaussianPhysicalUpdatedRhsWidth.output input = + List.replicate count true) : + gaussianPhysicalUpdatedRhsBitsOutput input = + (List.range count).flatMap (fun rank => + gaussianPhysicalUpdatedRhsRecordOutput + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalUpdatedRhsWidth input)) := by + exact maskDynamicGridRecordCatalogueOutput_valid + gaussianPhysicalUpdatedRhsWidth + gaussianPhysicalUpdatedRhsRecordComputable input count hwidth + +private theorem gaussianPhysicalUpdatedCheckGeneratedRecord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (rank : ℕ) (hrows : 0 < m) : + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalUpdatedCheckWidth + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + gaussianPhysicalPivotRecordWord rank (m * n) active.val + (effectiveGaussianPackedStateWord state source) := by + unfold sourceQaryMaskDynamicGridBaseSource + rw [gaussianPhysicalUpdatedCheckWidth_effective + state source active hrows] + simp only [gaussianPhysicalPivotRecordWord, + List.append_assoc] + +private theorem gaussianPhysicalUpdatedRhsGeneratedRecord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (row : ℕ) : + lengthPrefixedWord (List.replicate row true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalUpdatedRhsWidth + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + gaussianPhysicalPivotRecordWord row m active.val + (effectiveGaussianPackedStateWord state source) := by + unfold sourceQaryMaskDynamicGridBaseSource + rw [gaussianPhysicalUpdatedRhsWidth_effective + state source active] + simp only [gaussianPhysicalPivotRecordWord, + List.append_assoc] + +private theorem gaussianPhysicalUpdatedCheckRecordOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (row : Fin m) (column : Fin n) + (hrows : 0 < m) : + gaussianPhysicalUpdatedCheckRecordOutput + (gaussianPhysicalPivotRecordWord + (row.val * n + column.val) (m * n) active.val + (effectiveGaussianPackedStateWord state source)) = + [decide + ((columnStep state active).system.check row column = + (1 : ZMod 2))] := by + have hn : 0 < n := + lt_of_le_of_lt (Nat.zero_le active.val) active.isLt + have hquotient : + (row.val * n + column.val) / n = row.val := by + simpa only [Nat.mul_comm, Nat.div_eq_of_lt column.isLt, add_zero] using Nat.mul_add_div hn + row.val column.val + have hremainder : + (row.val * n + column.val) % n = column.val := by + simp only [Nat.add_mod, Nat.mul_mod_left, Nat.mod_eq_of_lt column.isLt, zero_add] + have hquery := gaussianPhysicalUpdatedCheckCellQuery_word + state source active (row.val * n + column.val) + (m * n) hrows + rw [hquotient, hremainder] at hquery + unfold gaussianPhysicalUpdatedCheckRecordOutput + rw [Function.comp_apply, hquery] + exact gaussianPhysicalColumnUpdatedCheckWord_effective + state source row column active + +private theorem gaussianPhysicalUpdatedRhsRecordOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (row : Fin m) : + gaussianPhysicalUpdatedRhsRecordOutput + (gaussianPhysicalPivotRecordWord row.val m active.val + (effectiveGaussianPackedStateWord state source)) = + [decide + ((columnStep state active).system.rhs row = + (1 : ZMod 2))] := by + have hn : 0 < n := + lt_of_le_of_lt (Nat.zero_le active.val) active.isLt + let zero : Fin n := ⟨0, hn⟩ + unfold gaussianPhysicalUpdatedRhsRecordOutput + rw [Function.comp_apply, + gaussianPhysicalUpdatedRhsCellQuery_word] + exact gaussianPhysicalColumnUpdatedRhsWord_effective + state source row zero active + +private theorem gaussianPhysicalUpdatedCheckBitsOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (hrows : 0 < m) : + gaussianPhysicalUpdatedCheckBitsOutput + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianPackedCheckBits + (columnStep state active) := by + let input := gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source) + have hwidth : gaussianPhysicalUpdatedCheckWidth.output input = + List.replicate (m * n) true := + gaussianPhysicalUpdatedCheckWidth_effective + state source active hrows + have hcatalogue := gaussianPhysicalUpdatedCheckBitsOutput_valid + input (m * n) hwidth + calc + gaussianPhysicalUpdatedCheckBitsOutput input = + (List.range (m * n)).flatMap (fun rank => + gaussianPhysicalUpdatedCheckRecordOutput + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalUpdatedCheckWidth input)) := + hcatalogue + _ = (List.range (m * n)).flatMap (fun rank => + gaussianPhysicalUpdatedCheckRecordOutput + (gaussianPhysicalPivotRecordWord rank (m * n) + active.val + (effectiveGaussianPackedStateWord state source))) := by + apply List.flatMap_congr + intro rank _ + exact congrArg gaussianPhysicalUpdatedCheckRecordOutput + (gaussianPhysicalUpdatedCheckGeneratedRecord_effective + state source active rank hrows) + _ = (List.range m).flatMap (fun row => + (List.range n).flatMap (fun column => + gaussianPhysicalUpdatedCheckRecordOutput + (gaussianPhysicalPivotRecordWord + (row * n + column) (m * n) active.val + (effectiveGaussianPackedStateWord state source)))) := by + rw [sourcePhysicalWordCanonical_range_mul_flatMap] + simp only [List.flatMap_assoc, List.flatMap_map] + _ = (List.finRange m).flatMap (fun row => + (List.finRange n).flatMap (fun column => + [decide + ((columnStep state active).system.check row column = + (1 : ZMod 2))])) := by + rw [gaussianPhysicalPivot_range_flatMap_finRange] + apply List.flatMap_congr + intro row _ + rw [gaussianPhysicalPivot_range_flatMap_finRange] + apply List.flatMap_congr + intro column _ + exact gaussianPhysicalUpdatedCheckRecordOutput_effective + state source active row column hrows + _ = effectiveGaussianPackedCheckBits + (columnStep state active) := by + unfold effectiveGaussianPackedCheckBits + apply List.flatMap_congr + intro row _ + exact sourcePhysicalWordPackedFlatMap_singleton + (List.finRange n) + (fun column => + decide + ((columnStep state active).system.check row column = + (1 : ZMod 2))) + +private theorem gaussianPhysicalUpdatedRhsBitsOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) : + gaussianPhysicalUpdatedRhsBitsOutput + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianPackedRhsBits + (columnStep state active) := by + let input := gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source) + have hwidth : gaussianPhysicalUpdatedRhsWidth.output input = + List.replicate m true := + gaussianPhysicalUpdatedRhsWidth_effective + state source active + have hcatalogue := gaussianPhysicalUpdatedRhsBitsOutput_valid + input m hwidth + calc + gaussianPhysicalUpdatedRhsBitsOutput input = + (List.range m).flatMap (fun row => + gaussianPhysicalUpdatedRhsRecordOutput + (lengthPrefixedWord (List.replicate row true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalUpdatedRhsWidth input)) := + hcatalogue + _ = (List.range m).flatMap (fun row => + gaussianPhysicalUpdatedRhsRecordOutput + (gaussianPhysicalPivotRecordWord row m active.val + (effectiveGaussianPackedStateWord state source))) := by + apply List.flatMap_congr + intro row _ + exact congrArg gaussianPhysicalUpdatedRhsRecordOutput + (gaussianPhysicalUpdatedRhsGeneratedRecord_effective + state source active row) + _ = (List.finRange m).flatMap (fun row => + [decide + ((columnStep state active).system.rhs row = + (1 : ZMod 2))]) := by + rw [gaussianPhysicalPivot_range_flatMap_finRange] + apply List.flatMap_congr + intro row _ + exact gaussianPhysicalUpdatedRhsRecordOutput_effective + state source active row + _ = effectiveGaussianPackedRhsBits + (columnStep state active) := by + unfold effectiveGaussianPackedRhsBits + exact sourcePhysicalWordPackedFlatMap_singleton + (List.finRange m) + (fun row => + decide + ((columnStep state active).system.rhs row = + (1 : ZMod 2))) + +private def gaussianPhysicalUpdatedOriginalSource : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix ∘ firstFieldSuffix ∘ + firstFieldSuffix ∘ gaussianPhysicalColumnCurrentState + +private noncomputable def gaussianPhysicalUpdatedOriginalSourceComputable : + BitTM + gaussianPhysicalUpdatedOriginalSource := by + have hcheck := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnCurrentStateComputable + firstFieldSuffixComputable + have hrhs := GapCVP.TMComposition.computableInPolyTime + hcheck firstFieldSuffixComputable + have hnext := GapCVP.TMComposition.computableInPolyTime + hrhs firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hnext firstFieldSuffixComputable + +@[simp] private theorem gaussianPhysicalUpdatedOriginalSource_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) : + gaussianPhysicalUpdatedOriginalSource + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + source := by + simp only [gaussianPhysicalUpdatedOriginalSource, gaussianPhysicalColumnCurrentState, + gaussianPhysicalPivotColumnQuery, effectiveGaussianPackedStateWord, List.append_assoc, + Function.comp_apply, + firstFieldSuffix_valid] + +private def gaussianPhysicalColumnStateOutput + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPhysicalUpdatedCheckBitsOutput input) ++ + lengthPrefixedWord (gaussianPhysicalUpdatedRhsBitsOutput input) ++ + lengthPrefixedWord + (GaussianAdaptivePhysicalColumnStateTM.gaussianPhysicalColumnNextPivotUnary input) ++ + lengthPrefixedWord + (gaussianPhysicalColumnUpdatedPivotCatalogueOutput input) ++ + gaussianPhysicalUpdatedOriginalSource input + +private noncomputable def gaussianPhysicalColumnStateComputable : + BitTM + gaussianPhysicalColumnStateOutput := by + have hcheck := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedCheckBitsComputable + structuralPrefixWriterComputable + have hrhs := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalUpdatedRhsBitsComputable + structuralPrefixWriterComputable + have hnext := GapCVP.TMComposition.computableInPolyTime + GaussianAdaptivePhysicalColumnStateTM.gaussianPhysicalColumnNextPivotUnaryComputable + structuralPrefixWriterComputable + have hpivots := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnUpdatedPivotCatalogueComputable + structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hcheck + (pointwiseAppendComputable hrhs + (pointwiseAppendComputable hnext + (pointwiseAppendComputable hpivots + gaussianPhysicalUpdatedOriginalSourceComputable))) + change BitTM + (fun input => + lengthPrefixedWord (gaussianPhysicalUpdatedCheckBitsOutput input) ++ + lengthPrefixedWord (gaussianPhysicalUpdatedRhsBitsOutput input) ++ + lengthPrefixedWord + (GaussianAdaptivePhysicalColumnStateTM.gaussianPhysicalColumnNextPivotUnary input) ++ + lengthPrefixedWord + (gaussianPhysicalColumnUpdatedPivotCatalogueOutput input) ++ + gaussianPhysicalUpdatedOriginalSource input) + simpa only [Function.comp_apply, List.append_assoc] using hphysical + +private theorem gaussianPhysicalColumnStateOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (active : Fin n) + (hrows : 0 < m) : + gaussianPhysicalColumnStateOutput + (gaussianPhysicalPivotColumnQuery active.val + (effectiveGaussianPackedStateWord state source)) = + effectiveGaussianPackedStateWord + (columnStep state active) source := by + unfold gaussianPhysicalColumnStateOutput + rw [gaussianPhysicalUpdatedCheckBitsOutput_effective + state source active hrows, + gaussianPhysicalUpdatedRhsBitsOutput_effective + state source active, + GaussianAdaptivePhysicalColumnStateTM.gaussianPhysicalColumnNextPivotUnary_effective + state source active hrows, + gaussianPhysicalColumnUpdatedPivotCatalogueOutput_effective + state source active hrows, + gaussianPhysicalUpdatedOriginalSource_effective] + rfl + +end GaussianAdaptivePhysicalUpdatedMatrixCatalogueTM + +namespace GaussianAdaptivePhysicalInitialStateTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.SourceStructuralTuringTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.SourceMixedRadixUnaryQuotientRemainderTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryDimensionTM +open GapCVP.BinaryPhysicalWordPackedMatrixTM GapCVP.GaussianAdaptiveEliminationCorrectness +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianAdaptivePhysicalStateCellTM + +private noncomputable def gaussianPhysicalInitialPivotWidth : + SourceQaryMaskDynamicGridWidth where + output := gaussianDenseStateDimensionUnary + computer := gaussianDenseStateDimensionUnaryComputable + +private def gaussianPhysicalInitialPivotCatalogue : List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + gaussianPhysicalInitialPivotWidth + (sourceFixedWordComputable (lengthPrefixedWord [false])) + +private noncomputable def gaussianPhysicalInitialPivotCatalogueComputable : + BitTM + gaussianPhysicalInitialPivotCatalogue := + maskDynamicGridRecordCatalogueComputable + gaussianPhysicalInitialPivotWidth + (sourceFixedWordComputable (lengthPrefixedWord [false])) + +private def gaussianPhysicalPackedFullInitialStateOutput + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPackedStateCheckBits input) ++ + lengthPrefixedWord (gaussianPackedStateRhsBits input) ++ + lengthPrefixedWord [] ++ + lengthPrefixedWord + (gaussianPhysicalInitialPivotCatalogue input) ++ + gaussianPackedInitialOriginalSource input + +private noncomputable def gaussianPhysicalPackedFullInitialStateComputable : + BitTM + gaussianPhysicalPackedFullInitialStateOutput := by + have hcheck := GapCVP.TMComposition.computableInPolyTime + gaussianPackedStateCheckBitsComputable + structuralPrefixWriterComputable + have hrhs := GapCVP.TMComposition.computableInPolyTime + gaussianPackedStateRhsBitsComputable + structuralPrefixWriterComputable + have hpivot := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalInitialPivotCatalogueComputable + structuralPrefixWriterComputable + have hzero := sourceFixedWordComputable + (lengthPrefixedWord ([] : List Bool)) + have hphysical := pointwiseAppendComputable hcheck + (pointwiseAppendComputable hrhs + (pointwiseAppendComputable hzero + (pointwiseAppendComputable hpivot + gaussianPackedInitialOriginalSourceComputable))) + change BitTM + (fun input => + lengthPrefixedWord (gaussianPackedStateCheckBits input) ++ + lengthPrefixedWord (gaussianPackedStateRhsBits input) ++ + lengthPrefixedWord [] ++ + lengthPrefixedWord + (gaussianPhysicalInitialPivotCatalogue input) ++ + gaussianPackedInitialOriginalSource input) + simpa only [Function.comp_apply, List.append_assoc] using hphysical + +private theorem gaussianDenseStateCheckLengthUnary_matrixWord + (checks rhs source : List Bool) : + gaussianDenseStateCheckLengthUnary + (lengthPrefixedWord checks ++ + lengthPrefixedWord rhs ++ source) = + List.replicate checks.length true := by + change + sourceInputLengthUnary + (gaussianPackedStateCheckBits + (lengthPrefixedWord checks ++ + lengthPrefixedWord rhs ++ source)) = _ + rw [gaussianPackedStateCheckBits_matrixWord] + rfl + +private theorem gaussianDenseStateRowCountUnary_matrixWord + (checks rhs source : List Bool) : + gaussianDenseStateRowCountUnary + (lengthPrefixedWord checks ++ + lengthPrefixedWord rhs ++ source) = + List.replicate rhs.length true := by + change + sourceInputLengthUnary + (gaussianPackedStateRhsBits + (lengthPrefixedWord checks ++ + lengthPrefixedWord rhs ++ source)) = _ + rw [gaussianPackedStateRhsBits_matrixWord] + rfl + +private theorem gaussianDenseStateDimensionUnary_matrixWord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (hrows : 0 < m) : + gaussianDenseStateDimensionUnary + (lengthPrefixedWord (effectiveGaussianPackedCheckBits state) ++ + lengthPrefixedWord (effectiveGaussianPackedRhsBits state) ++ + source) = + List.replicate n true := by + let word := + lengthPrefixedWord (effectiveGaussianPackedCheckBits state) ++ + lengthPrefixedWord (effectiveGaussianPackedRhsBits state) ++ + source + have hcheck : gaussianDenseStateCheckLengthUnary word = + List.replicate (m * n) true := by + dsimp [word] + rw [gaussianDenseStateCheckLengthUnary_matrixWord, + effectiveGaussianPackedCheckBits_length] + have hrhs : gaussianDenseStateRowCountUnary word = + List.replicate m true := by + dsimp [word] + rw [gaussianDenseStateRowCountUnary_matrixWord, + effectiveGaussianPackedRhsBits_length] + have hquery : gaussianDenseStateDimensionDivisionQuery word = + sourceUnaryDivisionQuery (m * n) m word := by + simp only [gaussianDenseStateDimensionDivisionQuery, hcheck, hrhs, sourceUnaryDivisionQuery] + change gaussianDenseStateDimensionUnary word = _ + unfold gaussianDenseStateDimensionUnary + simp only [Function.comp_apply] + rw [hquery, sourceUnaryDivisionOutput_valid + (m * n) m word hrows] + rw [unaryPrefixOutput_replicate_delimiter] + simp only [List.tail_cons] + rw [Nat.mul_div_cancel_left n hrows] + +private theorem gaussianPhysicalInitialPivotCatalogue_valid + (input : List Bool) (dimension : ℕ) + (hdimension : gaussianDenseStateDimensionUnary input = + List.replicate dimension true) : + gaussianPhysicalInitialPivotCatalogue input = + binaryGaussianPivotBatchStream + (List.replicate dimension [false]) := by + change + maskDynamicGridRecordCatalogueOutput + gaussianPhysicalInitialPivotWidth + (sourceFixedWordComputable + (lengthPrefixedWord [false])) input = _ + rw [maskDynamicGridRecordCatalogueOutput_valid + gaussianPhysicalInitialPivotWidth + (sourceFixedWordComputable + (lengthPrefixedWord [false])) + input dimension hdimension] + change + (List.range dimension).flatMap + (fun _ => lengthPrefixedWord [false]) = + (List.replicate dimension [false]).flatMap + lengthPrefixedWord + rw [← List.flatMap_map] + simp only [List.map_const', List.length_range] + +private theorem gaussianPhysicalPackedFullInitialStateOutput_effective + (system : BinaryAffineSystem) + (source : List Bool) (hrows : 0 < system.rowCount) : + gaussianPhysicalPackedFullInitialStateOutput + (lengthPrefixedWord + (sourcePhysicalWordPackedCheckBits system) ++ + lengthPrefixedWord + (sourcePhysicalWordPackedRhsBits system) ++ source) = + effectiveGaussianPackedStateWord + (initialState system.effectiveGaussianSystem) source := by + let initial := initialState system.effectiveGaussianSystem + let word := + lengthPrefixedWord + (sourcePhysicalWordPackedCheckBits system) ++ + lengthPrefixedWord + (sourcePhysicalWordPackedRhsBits system) ++ source + have hcheck : sourcePhysicalWordPackedCheckBits system = + effectiveGaussianPackedCheckBits initial := + sourcePhysicalWordPackedCheckBits_eq_effective_initial system + have hrhs : sourcePhysicalWordPackedRhsBits system = + effectiveGaussianPackedRhsBits initial := + sourcePhysicalWordPackedRhsBits_eq_effective_initial system + have hdimension : gaussianDenseStateDimensionUnary word = + List.replicate system.dimension true := by + dsimp [word] + rw [hcheck, hrhs] + exact gaussianDenseStateDimensionUnary_matrixWord_effective + initial source hrows + have hpivots := gaussianPhysicalInitialPivotCatalogue_valid + word system.dimension hdimension + change gaussianPhysicalPackedFullInitialStateOutput word = _ + unfold gaussianPhysicalPackedFullInitialStateOutput + effectiveGaussianPackedStateWord + rw [gaussianPackedStateCheckBits_matrixWord, + gaussianPackedStateRhsBits_matrixWord, + gaussianPackedInitialOriginalSource_matrixWord, + hpivots, effectiveGaussianPackedPivotCatalogue_initial] + rw [hcheck, hrhs] + rfl + +end GaussianAdaptivePhysicalInitialStateTM + +namespace GaussianAdaptivePhysicalColumnIterationBoundTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFAnnotatedSourceClauseBubblePassTM GapCVP.BinaryDimensionTM +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianAdaptivePhysicalStateCellTM +open GapCVP.GaussianAdaptivePhysicalColumnStateTM +open GapCVP.GaussianAdaptivePhysicalUpdatedMatrixCatalogueTM +open GapCVP.GaussianAdaptivePhysicalInitialStateTM + +private def gaussianPhysicalColumnIterationBudgetWord + (packed : List Bool) : List Bool := + List.replicate (64 * (packed.length + 1) ^ 2) true + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationBudgetWordComputable : + BitTM + gaussianPhysicalColumnIterationBudgetWord := by + have hphysical := polynomialValueUnaryComputable + (64 * (Polynomial.X + 1) ^ 2) + change BitTM + (fun packed : List Bool => + List.replicate (64 * (packed.length + 1) ^ 2) true) + simpa only [Polynomial.eval_mul, Polynomial.eval_ofNat, + Polynomial.eval_pow, Polynomial.eval_add, Polynomial.eval_X, + Polynomial.eval_one] using hphysical + +private abbrev gaussianPhysicalColumnIterationBudgetArchive : + List Bool → List Bool := + firstFieldContents + +private abbrev gaussianPhysicalColumnIterationCurrentQuery : + List Bool → List Bool := + firstFieldSuffix + +private def gaussianPhysicalColumnIterationActiveUnary : + List Bool → List Bool := + gaussianPhysicalColumnActiveUnary ∘ + gaussianPhysicalColumnIterationCurrentQuery + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationActiveUnaryComputable : + BitTM + gaussianPhysicalColumnIterationActiveUnary := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable + gaussianPhysicalColumnActiveUnaryComputable + +private def gaussianPhysicalColumnIterationCandidate + (input : List Bool) : List Bool := + lengthPrefixedWord + (true :: gaussianPhysicalColumnIterationActiveUnary input) ++ + gaussianPhysicalColumnStateOutput + (gaussianPhysicalColumnIterationCurrentQuery input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationCandidateComputable : + BitTM + gaussianPhysicalColumnIterationCandidate := by + have hactive := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnIterationActiveUnaryComputable + (prependBitComputable true) + have hprefix := GapCVP.TMComposition.computableInPolyTime + hactive structuralPrefixWriterComputable + have hstate := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable gaussianPhysicalColumnStateComputable + exact pointwiseAppendComputable hprefix hstate + +private def gaussianPhysicalColumnIterationBudgetLengthUnary : + List Bool → List Bool := + sourceInputLengthUnary ∘ + gaussianPhysicalColumnIterationBudgetArchive + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationBudgetLengthUnaryComputable : + BitTM + gaussianPhysicalColumnIterationBudgetLengthUnary := + GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable sourceInputLengthUnaryComputable + +private def gaussianPhysicalColumnIterationCandidateLengthUnary : + List Bool → List Bool := + sourceInputLengthUnary ∘ + gaussianPhysicalColumnIterationCandidate + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationCandidateLengthUnaryComputable : + BitTM + gaussianPhysicalColumnIterationCandidateLengthUnary := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnIterationCandidateComputable + sourceInputLengthUnaryComputable + +private def gaussianPhysicalColumnIterationOverflowMarker : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + gaussianPhysicalColumnIterationBudgetLengthUnary + gaussianPhysicalColumnIterationCandidateLengthUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationOverflowMarkerComputable : + BitTM + gaussianPhysicalColumnIterationOverflowMarker := + fourFamilyComputedUnaryLessBitComputable + gaussianPhysicalColumnIterationBudgetLengthUnaryComputable + gaussianPhysicalColumnIterationCandidateLengthUnaryComputable + +private def gaussianPhysicalColumnIterationAcceptMarker : + List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + gaussianPhysicalColumnIterationOverflowMarker + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationAcceptMarkerComputable : + BitTM + gaussianPhysicalColumnIterationAcceptMarker := + fourFamilyBooleanNotOutputComputable + gaussianPhysicalColumnIterationOverflowMarkerComputable + +private def gaussianPhysicalColumnIterationAccepted + (input : List Bool) : Bool := + (gaussianPhysicalColumnIterationAcceptMarker input).headD false + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationAcceptedComputable : + BitTM + (fun input => + gaussianPhysicalColumnIterationAccepted input :: input) := + gaussianPhysicalComputedMarkerPreservingComputable + gaussianPhysicalColumnIterationAcceptMarkerComputable + +private def gaussianPhysicalColumnIterationAcceptedOutput + (input : List Bool) : List Bool := + lengthPrefixedWord + (gaussianPhysicalColumnIterationBudgetArchive input) ++ + gaussianPhysicalColumnIterationCandidate input + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationAcceptedOutputComputable : + BitTM + gaussianPhysicalColumnIterationAcceptedOutput := by + have hbudget := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable structuralPrefixWriterComputable + exact pointwiseAppendComputable hbudget + gaussianPhysicalColumnIterationCandidateComputable + +private def gaussianPhysicalColumnIterationStep : + List Bool → List Bool := + binaryGaussianDynamicBranchOutput + gaussianPhysicalColumnIterationAccepted + gaussianPhysicalColumnIterationAcceptedOutput id + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationStepComputable : + BitTM + gaussianPhysicalColumnIterationStep := + binaryGaussianDynamicBranchComputable + gaussianPhysicalColumnIterationAcceptedComputable + gaussianPhysicalColumnIterationAcceptedOutputComputable + (Turing.idComputableInPolyTime bitEncoding) + +@[simp] private theorem gaussianPhysicalColumnIterationOverflowMarker_valid + (input : List Bool) : + gaussianPhysicalColumnIterationOverflowMarker input = + [decide + ((gaussianPhysicalColumnIterationBudgetArchive input).length < + (gaussianPhysicalColumnIterationCandidate input).length)] := by + unfold gaussianPhysicalColumnIterationOverflowMarker + apply fourFamilyComputedUnaryLessBitOutput_valid + gaussianPhysicalColumnIterationBudgetLengthUnary + gaussianPhysicalColumnIterationCandidateLengthUnary input + (gaussianPhysicalColumnIterationBudgetArchive input).length + (gaussianPhysicalColumnIterationCandidate input).length + · rfl + · rfl + +@[simp] private theorem gaussianPhysicalColumnIterationAccepted_valid + (input : List Bool) : + gaussianPhysicalColumnIterationAccepted input = + decide + ((gaussianPhysicalColumnIterationCandidate input).length ≤ + (gaussianPhysicalColumnIterationBudgetArchive input).length) := by + unfold gaussianPhysicalColumnIterationAccepted + gaussianPhysicalColumnIterationAcceptMarker + rw [fourFamilyBooleanNotOutput_bit + gaussianPhysicalColumnIterationOverflowMarker input + (decide + ((gaussianPhysicalColumnIterationBudgetArchive input).length < + (gaussianPhysicalColumnIterationCandidate input).length)) + (gaussianPhysicalColumnIterationOverflowMarker_valid input)] + simp only [List.headD_cons, ← decide_not, Nat.not_lt] + +@[simp] private theorem gaussianPhysicalColumnIterationBudgetArchive_step + (input : List Bool) : + gaussianPhysicalColumnIterationBudgetArchive + (gaussianPhysicalColumnIterationStep input) = + gaussianPhysicalColumnIterationBudgetArchive input := by + unfold gaussianPhysicalColumnIterationStep + binaryGaussianDynamicBranchOutput + cases haccept : gaussianPhysicalColumnIterationAccepted input with + | false => simp only [Bool.false_eq_true, ↓reduceIte, id_eq] + | true => + simp only [↓reduceIte, gaussianPhysicalColumnIterationAcceptedOutput, + firstFieldContents_valid] + +private theorem gaussianPhysicalColumnIterationStep_length_le + (input : List Bool) : + (gaussianPhysicalColumnIterationStep input).length ≤ + max input.length + (3 * (gaussianPhysicalColumnIterationBudgetArchive input).length + 1) := by + unfold gaussianPhysicalColumnIterationStep + binaryGaussianDynamicBranchOutput + cases haccept : gaussianPhysicalColumnIterationAccepted input with + | false => simp only [Bool.false_eq_true, ↓reduceIte, id_eq, le_sup_left] + | true => + have hfits : + (gaussianPhysicalColumnIterationCandidate input).length ≤ + (gaussianPhysicalColumnIterationBudgetArchive input).length := by + have hdecision := + gaussianPhysicalColumnIterationAccepted_valid input + rw [haccept] at hdecision + exact of_decide_eq_true hdecision.symm + change + (lengthPrefixedWord + (gaussianPhysicalColumnIterationBudgetArchive input) ++ + gaussianPhysicalColumnIterationCandidate input).length ≤ _ + simp only [List.length_append, lengthPrefixedWord_length] + omega + +@[simp] private theorem gaussianPhysicalColumnIterationBudgetArchive_iterate + (input : List Bool) (stage : ℕ) : + gaussianPhysicalColumnIterationBudgetArchive + ((gaussianPhysicalColumnIterationStep^[stage]) input) = + gaussianPhysicalColumnIterationBudgetArchive input := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq] + | succ stage ih => + rw [Function.iterate_succ_apply', + gaussianPhysicalColumnIterationBudgetArchive_step, ih] + +private theorem gaussianPhysicalColumnIteration_iterate_length_le + (seed : List Bool) (stage : ℕ) : + ((gaussianPhysicalColumnIterationStep^[stage]) seed).length ≤ + max seed.length + (3 * (gaussianPhysicalColumnIterationBudgetArchive seed).length + 1) := by + induction stage with + | zero => simp only [Function.iterate_zero, id_eq, le_sup_left] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have hstep := gaussianPhysicalColumnIterationStep_length_le + ((gaussianPhysicalColumnIterationStep^[stage]) seed) + rw [gaussianPhysicalColumnIterationBudgetArchive_iterate] at hstep + omega + +private theorem gaussianPhysicalColumnIterationStep_polynomiallyBoundedFoldStates : + PolynomiallyBoundedFoldStates + gaussianPhysicalColumnIterationStep (4 * Polynomial.X + 1) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] + intro input count seed hparse stage _ + have hword := parseUnaryBoundedFold_eq_word + input count seed hparse + have hseed : seed.length ≤ input.length := by + rw [hword] + simp only [unaryBoundedFoldWord, List.length_append, + List.length_replicate, List.length_cons] + omega + have hbudget := annotatedStructuralFieldAccounting seed + have harchive : + (gaussianPhysicalColumnIterationBudgetArchive seed).length ≤ + seed.length := by + change (firstFieldContents seed).length ≤ seed.length + omega + have hstate := gaussianPhysicalColumnIteration_iterate_length_le + seed stage + simp only [Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X, Polynomial.eval_one] + omega + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationFoldComputable : + BitTM + (boundedRecordFoldOutput gaussianPhysicalColumnIterationStep) := + boundedDependentRecordFoldComputable + gaussianPhysicalColumnIterationStepComputable + (4 * Polynomial.X + 1) + gaussianPhysicalColumnIterationStep_polynomiallyBoundedFoldStates + +private def gaussianPhysicalColumnIterationSeed + (packed : List Bool) : List Bool := + lengthPrefixedWord + (gaussianPhysicalColumnIterationBudgetWord packed) ++ + lengthPrefixedWord ([] : List Bool) ++ packed + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationSeedComputable : + BitTM + gaussianPhysicalColumnIterationSeed := by + have hbudget := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnIterationBudgetWordComputable + structuralPrefixWriterComputable + have hzero := sourceFixedWordComputable + (lengthPrefixedWord ([] : List Bool)) + have hphysical := pointwiseAppendComputable hbudget + (pointwiseAppendComputable hzero + (Turing.idComputableInPolyTime bitEncoding)) + change BitTM + (fun packed : List Bool => + lengthPrefixedWord + (gaussianPhysicalColumnIterationBudgetWord packed) ++ + lengthPrefixedWord ([] : List Bool) ++ packed) + simpa only [Function.comp_apply, List.append_assoc, id_eq] using hphysical + +private def gaussianPhysicalColumnIterationPreparation + (packed : List Bool) : List Bool := + gaussianDenseStateDimensionUnary packed ++ + false :: gaussianPhysicalColumnIterationSeed packed + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationPreparationComputable : + BitTM + gaussianPhysicalColumnIterationPreparation := by + have hseed := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnIterationSeedComputable + (prependBitComputable false) + exact pointwiseAppendComputable + gaussianDenseStateDimensionUnaryComputable hseed + +private def gaussianPhysicalColumnIterationOutput : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix ∘ + boundedRecordFoldOutput gaussianPhysicalColumnIterationStep ∘ + gaussianPhysicalColumnIterationPreparation + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalColumnIterationComputable : + BitTM + gaussianPhysicalColumnIterationOutput := by + have hfold := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalColumnIterationPreparationComputable + gaussianPhysicalColumnIterationFoldComputable + have hbudget := GapCVP.TMComposition.computableInPolyTime + hfold firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hbudget firstFieldSuffixComputable + +private def gaussianPhysicalSourceEliminationOutput : List Bool → List Bool := + gaussianPhysicalColumnIterationOutput ∘ + gaussianPhysicalPackedFullInitialStateOutput + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPhysicalSourceEliminationComputable : + BitTM + gaussianPhysicalSourceEliminationOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalPackedFullInitialStateComputable + gaussianPhysicalColumnIterationComputable + +end GaussianAdaptivePhysicalColumnIterationBoundTM + +namespace GaussianAdaptivePhysicalPackedStateBoundTM + +open GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.GaussianAdaptiveEliminationCorrectness GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianAdaptivePhysicalCandidateCatalogueTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM + +private theorem gaussianPhysicalPackedCheckBits_length + {m n : ℕ} (state : State m n) : + (effectiveGaussianPackedCheckBits state).length = m * n := by + simp only [effectiveGaussianPackedCheckBits, List.length_flatMap, List.length_map, + List.length_finRange, + List.map_const', List.sum_replicate, smul_eq_mul] + +private theorem gaussianPhysicalPackedRhsBits_length + {m n : ℕ} (state : State m n) : + (effectiveGaussianPackedRhsBits state).length = m := by + simp only [effectiveGaussianPackedRhsBits, List.length_map, List.length_finRange] + +private theorem gaussianPhysicalPackedPivotWord_length_le + {m n : ℕ} (state : State m n) (column : Fin n) : + (effectiveGaussianStatePivotWord state column).length ≤ m + 1 := by + cases hpivot : effectiveGaussianStatePivotRowOption state column with + | none => simp only [effectiveGaussianStatePivotWord, hpivot, List.length_cons, List.length_nil, + zero_add, + le_add_iff_nonneg_left, zero_le] + | some row => + simp only [effectiveGaussianStatePivotWord, hpivot, + List.length_cons, List.length_replicate] + have hrow := row.isLt + omega + +private theorem gaussianPhysicalPackedPrefixedPivotWord_length_le + {m n : ℕ} (state : State m n) (column : Fin n) : + (lengthPrefixedWord + (effectiveGaussianStatePivotWord state column)).length ≤ + 2 * m + 3 := by + rw [lengthPrefixedWord_length] + have hpivot := gaussianPhysicalPackedPivotWord_length_le state column + omega + +private theorem gaussianPhysicalPackedPivotRecords_length_le + {m n : ℕ} (state : State m n) + (columns : List (Fin n)) : + ((columns.map + (effectiveGaussianStatePivotWord state)).flatMap + lengthPrefixedWord).length ≤ + columns.length * (2 * m + 3) := by + induction columns with + | nil => simp only [List.map_nil, List.flatMap_nil, List.length_nil, zero_mul, Std.le_refl] + | cons column remaining ih => + have hpivot := + gaussianPhysicalPackedPrefixedPivotWord_length_le state column + calc + (((column :: remaining).map + (effectiveGaussianStatePivotWord state)).flatMap + lengthPrefixedWord).length = + (lengthPrefixedWord + (effectiveGaussianStatePivotWord state column)).length + + ((remaining.map + (effectiveGaussianStatePivotWord state)).flatMap + lengthPrefixedWord).length := by + simp only [List.map_cons, List.flatMap_cons, List.length_append, + lengthPrefixedWord_length, List.length_flatMap, List.map_map] + _ ≤ (2 * m + 3) + remaining.length * (2 * m + 3) := + Nat.add_le_add hpivot ih + _ = (column :: remaining).length * (2 * m + 3) := by + simp only [List.length_cons, Nat.succ_mul] + omega + +private theorem gaussianPhysicalPackedPivotCatalogue_length_le + {m n : ℕ} (state : State m n) : + (effectiveGaussianPackedPivotCatalogue state).length ≤ + n * (2 * m + 3) := by + unfold effectiveGaussianPackedPivotCatalogue + binaryGaussianPivotBatchStream + sourceMixedRadixOriginalSourceQueryStream + simpa only [List.length_finRange] using + gaussianPhysicalPackedPivotRecords_length_le + state (List.finRange n) + +private theorem gaussianPhysicalPackedPrefixedPivotWord_length_pos + {m n : ℕ} (state : State m n) (column : Fin n) : + 0 < (lengthPrefixedWord + (effectiveGaussianStatePivotWord state column)).length := by + rw [lengthPrefixedWord_length] + omega + +private theorem gaussianPhysicalPackedPivotRecords_length_ge + {m n : ℕ} (state : State m n) + (columns : List (Fin n)) : + columns.length ≤ + ((columns.map + (effectiveGaussianStatePivotWord state)).flatMap + lengthPrefixedWord).length := by + induction columns with + | nil => simp only [List.length_nil, List.map_nil, List.flatMap_nil, Std.le_refl] + | cons column remaining ih => + have hpivot := + gaussianPhysicalPackedPrefixedPivotWord_length_pos state column + simp only [List.map_cons, List.flatMap_cons, + List.length_append, List.length_cons] + omega + +private theorem gaussianPhysicalPackedPivotCatalogue_length_ge + {m n : ℕ} (state : State m n) : + n ≤ (effectiveGaussianPackedPivotCatalogue state).length := by + unfold effectiveGaussianPackedPivotCatalogue + binaryGaussianPivotBatchStream + sourceMixedRadixOriginalSourceQueryStream + simpa only [List.length_finRange] using + gaussianPhysicalPackedPivotRecords_length_ge + state (List.finRange n) + +private theorem gaussianPhysicalPackedState_rows_le_length + {m n : ℕ} (state : State m n) (source : List Bool) : + m ≤ (effectiveGaussianPackedStateWord state source).length := by + unfold effectiveGaussianPackedStateWord + simp only [List.length_append, lengthPrefixedWord_length, + gaussianPhysicalPackedRhsBits_length, List.length_replicate] + omega + +private theorem gaussianPhysicalPackedState_columns_le_length + {m n : ℕ} (state : State m n) (source : List Bool) : + n ≤ (effectiveGaussianPackedStateWord state source).length := by + have hpivots := gaussianPhysicalPackedPivotCatalogue_length_ge state + unfold effectiveGaussianPackedStateWord + simp only [List.length_append, lengthPrefixedWord_length, + List.length_replicate] + omega + +private theorem gaussianPhysicalPackedState_source_le_length + {m n : ℕ} (state : State m n) (source : List Bool) : + source.length ≤ + (effectiveGaussianPackedStateWord state source).length := by + unfold effectiveGaussianPackedStateWord + simp only [List.length_append] + omega + +private def gaussianPhysicalPackedStateSizeBound + (rows columns sourceLength : ℕ) : ℕ := + 2 * (rows * columns) + 4 * rows + + 2 * (columns * (2 * rows + 3)) + 4 + sourceLength + +private theorem gaussianPhysicalPackedStateWord_length_le + {m n : ℕ} (state : State m n) + (source : List Bool) (hnext : state.nextPivot ≤ m) : + (effectiveGaussianPackedStateWord state source).length ≤ + gaussianPhysicalPackedStateSizeBound m n source.length := by + unfold effectiveGaussianPackedStateWord + gaussianPhysicalPackedStateSizeBound + simp only [List.length_append, lengthPrefixedWord_length, + gaussianPhysicalPackedCheckBits_length, + gaussianPhysicalPackedRhsBits_length, + List.length_replicate] + have hpivots := gaussianPhysicalPackedPivotCatalogue_length_le state + omega + +private theorem gaussianPhysicalColumnStep_nextPivot_le + {m n : ℕ} (state : State m n) (column : Fin n) + (hnext : state.nextPivot ≤ m) : + (columnStep state column).nextPivot ≤ m := by + by_cases hrow : state.nextPivot < m + · cases hpivot : findPivotOption state column with + | none => simpa only [columnStep, hrow, ↓reduceDIte, hpivot] using hnext + | some candidate => + simp only [columnStep, hrow, ↓reduceDIte, hpivot] + omega + · simpa only [columnStep, hrow, ↓reduceDIte] using hnext + +private theorem gaussianPhysicalRunColumns_nextPivot_le + {m n : ℕ} (columns : List (Fin n)) (state : State m n) + (hnext : state.nextPivot ≤ m) : + (runColumns columns state).nextPivot ≤ m := by + induction columns generalizing state with + | nil => simpa only [runColumns, List.foldl_nil] using hnext + | cons column remaining ih => + change + (runColumns remaining (columnStep state column)).nextPivot ≤ m + exact ih (columnStep state column) + (gaussianPhysicalColumnStep_nextPivot_le state column hnext) + +private theorem gaussianPhysicalInitialState_nextPivot_le + {m n : ℕ} (system : System m n) : + (initialState system).nextPivot ≤ m := by + simp only [initialState, zero_le] + +private theorem gaussianPhysicalPackedColumnCandidate_length_le + {m n : ℕ} + (reference state : State m n) (source : List Bool) + (column : Fin n) (hnext : state.nextPivot ≤ m) : + (gaussianPhysicalPivotColumnQuery (column.val + 1) + (effectiveGaussianPackedStateWord + (columnStep state column) source)).length ≤ + 64 * + ((effectiveGaussianPackedStateWord reference source).length + 1) ^ 2 := by + let originalLength := + (effectiveGaussianPackedStateWord reference source).length + have hrows : m ≤ originalLength := + gaussianPhysicalPackedState_rows_le_length reference source + have hcolumns : n ≤ originalLength := + gaussianPhysicalPackedState_columns_le_length reference source + have hsource : source.length ≤ originalLength := + gaussianPhysicalPackedState_source_le_length reference source + have hproduct : m * n ≤ originalLength * originalLength := + Nat.mul_le_mul hrows hcolumns + have hstep := gaussianPhysicalPackedStateWord_length_le + (columnStep state column) source + (gaussianPhysicalColumnStep_nextPivot_le state column hnext) + have hcolumn := column.isLt + have hshape : + (effectiveGaussianPackedStateWord + (columnStep state column) source).length ≤ + 6 * (m * n) + 4 * m + 6 * n + 4 + source.length := by + calc + _ ≤ gaussianPhysicalPackedStateSizeBound + m n source.length := hstep + _ = _ := by + unfold gaussianPhysicalPackedStateSizeBound + ring + have hcandidate : + (gaussianPhysicalPivotColumnQuery (column.val + 1) + (effectiveGaussianPackedStateWord + (columnStep state column) source)).length ≤ + 6 * (originalLength * originalLength) + + 13 * originalLength + 7 := by + unfold gaussianPhysicalPivotColumnQuery + simp only [List.length_append, lengthPrefixedWord_length, + List.length_replicate] + omega + calc + _ ≤ 6 * (originalLength * originalLength) + + 13 * originalLength + 7 := hcandidate + _ ≤ 64 * (originalLength + 1) ^ 2 := by + linarith + _ = _ := by rfl + +end GaussianAdaptivePhysicalPackedStateBoundTM + +namespace GaussianAdaptivePhysicalColumnIterationBoundTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.OutputBoundedDependentRecordFold GapCVP.BinaryPhysicalWordPackedMatrixTM +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianAdaptivePhysicalStateCellTM +open GapCVP.GaussianAdaptivePhysicalCandidateCatalogueTM +open GapCVP.GaussianAdaptivePhysicalColumnStateTM +open GapCVP.GaussianAdaptivePhysicalUpdatedMatrixCatalogueTM +open GapCVP.GaussianAdaptivePhysicalInitialStateTM +open GapCVP.GaussianAdaptivePhysicalPackedStateBoundTM + +private def gaussianPhysicalColumnIterationExpectedState + {m n : ℕ} + (reference current : State m n) + (source : List Bool) (active : ℕ) : List Bool := + lengthPrefixedWord + (gaussianPhysicalColumnIterationBudgetWord + (effectiveGaussianPackedStateWord reference source)) ++ + gaussianPhysicalPivotColumnQuery active + (effectiveGaussianPackedStateWord current source) + +@[simp] private theorem gaussianPhysicalColumnIterationExpectedState_archive + {m n : ℕ} + (reference current : State m n) + (source : List Bool) (active : ℕ) : + gaussianPhysicalColumnIterationBudgetArchive + (gaussianPhysicalColumnIterationExpectedState + reference current source active) = + gaussianPhysicalColumnIterationBudgetWord + (effectiveGaussianPackedStateWord reference source) := by + simp only [gaussianPhysicalColumnIterationExpectedState, + SourceFormulaStructuralDecoder.firstFieldContents_valid] + +@[simp] private theorem gaussianPhysicalColumnIterationExpectedState_query + {m n : ℕ} + (reference current : State m n) + (source : List Bool) (active : ℕ) : + gaussianPhysicalColumnIterationCurrentQuery + (gaussianPhysicalColumnIterationExpectedState + reference current source active) = + gaussianPhysicalPivotColumnQuery active + (effectiveGaussianPackedStateWord current source) := by + simp only [gaussianPhysicalColumnIterationExpectedState, + SourceFormulaStructuralDecoder.firstFieldSuffix_valid] + +@[simp] private theorem gaussianPhysicalColumnIterationExpectedState_active + {m n : ℕ} + (reference current : State m n) + (source : List Bool) (active : ℕ) : + gaussianPhysicalColumnIterationActiveUnary + (gaussianPhysicalColumnIterationExpectedState + reference current source active) = + List.replicate active true := by + unfold gaussianPhysicalColumnIterationActiveUnary + rw [Function.comp_apply, + gaussianPhysicalColumnIterationExpectedState_query, + gaussianPhysicalColumnActiveUnary_query] + +private theorem gaussianPhysicalColumnIterationCandidate_effective + {m n : ℕ} + (reference current : State m n) + (source : List Bool) (column : Fin n) + (hrows : 0 < m) : + gaussianPhysicalColumnIterationCandidate + (gaussianPhysicalColumnIterationExpectedState + reference current source column.val) = + gaussianPhysicalPivotColumnQuery (column.val + 1) + (effectiveGaussianPackedStateWord + (columnStep current column) source) := by + unfold gaussianPhysicalColumnIterationCandidate + rw [gaussianPhysicalColumnIterationExpectedState_active, + gaussianPhysicalColumnIterationExpectedState_query, + gaussianPhysicalColumnStateOutput_effective + current source column hrows] + simp only [gaussianPhysicalPivotColumnQuery, List.replicate_succ] + +private theorem gaussianPhysicalColumnIterationAccepted_effective + {m n : ℕ} + (reference current : State m n) + (source : List Bool) (column : Fin n) + (hrows : 0 < m) + (hnext : current.nextPivot ≤ m) : + gaussianPhysicalColumnIterationAccepted + (gaussianPhysicalColumnIterationExpectedState + reference current source column.val) = true := by + let input := gaussianPhysicalColumnIterationExpectedState + reference current source column.val + have hbound := gaussianPhysicalPackedColumnCandidate_length_le + reference current source column hnext + have hcandidate := gaussianPhysicalColumnIterationCandidate_effective + reference current source column hrows + have harchive := gaussianPhysicalColumnIterationExpectedState_archive + reference current source column.val + rw [gaussianPhysicalColumnIterationAccepted_valid] + change decide + ((gaussianPhysicalColumnIterationCandidate input).length ≤ + (gaussianPhysicalColumnIterationBudgetArchive input).length) = true + rw [hcandidate, harchive] + simp only [gaussianPhysicalColumnIterationBudgetWord, + List.length_replicate] + exact decide_eq_true hbound + +private theorem gaussianPhysicalColumnIterationStep_effective + {m n : ℕ} + (reference current : State m n) + (source : List Bool) (column : Fin n) + (hrows : 0 < m) + (hnext : current.nextPivot ≤ m) : + gaussianPhysicalColumnIterationStep + (gaussianPhysicalColumnIterationExpectedState + reference current source column.val) = + gaussianPhysicalColumnIterationExpectedState + reference (columnStep current column) + source (column.val + 1) := by + let input := gaussianPhysicalColumnIterationExpectedState + reference current source column.val + have haccept := gaussianPhysicalColumnIterationAccepted_effective + reference current source column hrows hnext + have harchive := gaussianPhysicalColumnIterationExpectedState_archive + reference current source column.val + have hcandidate := gaussianPhysicalColumnIterationCandidate_effective + reference current source column hrows + change gaussianPhysicalColumnIterationStep input = _ + unfold gaussianPhysicalColumnIterationStep + binaryGaussianDynamicBranchOutput + rw [haccept, ite_eq_left rfl] + unfold gaussianPhysicalColumnIterationAcceptedOutput + rw [harchive, hcandidate] + rfl + +private theorem gaussianPhysicalEffectiveRunColumns_append + {m n : ℕ} (first second : List (Fin n)) + (state : State m n) : + runColumns (first ++ second) state = + runColumns second (runColumns first state) := by + induction first generalizing state with + | nil => simp only [runColumns, List.nil_append, List.foldl_nil] + | cons column rest ih => + simp only [List.cons_append, runColumns] + exact ih (columnStep state column) + +private theorem gaussianPhysicalColumnIterationSeed_effective + {m n : ℕ} (reference : State m n) + (source : List Bool) : + gaussianPhysicalColumnIterationSeed + (effectiveGaussianPackedStateWord reference source) = + gaussianPhysicalColumnIterationExpectedState + reference reference source 0 := by + simp only [gaussianPhysicalColumnIterationSeed, List.append_assoc, + gaussianPhysicalColumnIterationExpectedState, gaussianPhysicalPivotColumnQuery, + List.replicate_zero] + +private theorem gaussianPhysicalColumnIteration_iterate_effective + {m n : ℕ} (reference : State m n) + (source : List Bool) (hrows : 0 < m) + (hnext : reference.nextPivot ≤ m) + (stage : ℕ) (hstage : stage ≤ n) : + ((gaussianPhysicalColumnIterationStep^[stage]) + (gaussianPhysicalColumnIterationSeed + (effectiveGaussianPackedStateWord reference source))) = + gaussianPhysicalColumnIterationExpectedState + reference + (runColumns ((List.finRange n).take stage) reference) + source stage := by + induction stage with + | zero => + simpa only [Function.iterate_zero, id_eq, runColumns, List.take_zero, List.foldl_nil] using + gaussianPhysicalColumnIterationSeed_effective reference source + | succ stage ih => + have hlt : stage < n := by omega + have hprev : stage ≤ n := by omega + let active : Fin n := ⟨stage, hlt⟩ + let current := + runColumns ((List.finRange n).take stage) reference + have hcurrent : current.nextPivot ≤ m := + gaussianPhysicalRunColumns_nextPivot_le + ((List.finRange n).take stage) reference hnext + rw [Function.iterate_succ_apply'] + rw [ih hprev] + have hstep := gaussianPhysicalColumnIterationStep_effective + reference current source active hrows hcurrent + have hactiveval : active.val = stage := rfl + rw [hactiveval] at hstep + rw [hstep] + have hindex : stage < (List.finRange n).length := by + simpa only [List.length_finRange] using hlt + have hget : (List.finRange n)[stage] = active := by + apply Fin.ext + simpa only [List.getElem_finRange, Fin.cast_mk] using hactiveval.symm + rw [List.take_succ_eq_append_getElem hindex, + hget, gaussianPhysicalEffectiveRunColumns_append] + simp only [runColumns, List.foldl_cons, List.foldl_nil, current] + +private theorem gaussianPhysicalColumnIterationPreparation_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (hrows : 0 < m) : + gaussianPhysicalColumnIterationPreparation + (effectiveGaussianPackedStateWord state source) = + unaryBoundedFoldWord n + (gaussianPhysicalColumnIterationSeed + (effectiveGaussianPackedStateWord state source)) := by + unfold gaussianPhysicalColumnIterationPreparation + unaryBoundedFoldWord + rw [gaussianDenseStateDimensionUnary_effective + state source hrows] + +private theorem gaussianPhysicalColumnIterationOutput_state_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (hrows : 0 < m) + (hnext : state.nextPivot ≤ m) : + gaussianPhysicalColumnIterationOutput + (effectiveGaussianPackedStateWord state source) = + effectiveGaussianPackedStateWord + (runColumns (List.finRange n) state) source := by + unfold gaussianPhysicalColumnIterationOutput + simp only [Function.comp_apply] + rw [gaussianPhysicalColumnIterationPreparation_effective + state source hrows] + simp only [boundedRecordFoldOutput, + parseUnaryBoundedFold_word] + rw [gaussianPhysicalColumnIteration_iterate_effective + state source hrows hnext n (Nat.le_refl n)] + have htake : (List.finRange n).take n = + List.finRange n := by + simpa only [List.length_finRange] using + (List.take_length (l := List.finRange n)) + rw [htake] + simp only [gaussianPhysicalColumnIterationExpectedState, gaussianPhysicalPivotColumnQuery, + SourceFormulaStructuralDecoder.firstFieldSuffix_valid] + +private theorem gaussianPhysicalColumnIterationOutput_effective + {m n : ℕ} (system : System m n) + (source : List Bool) (hrows : 0 < m) : + gaussianPhysicalColumnIterationOutput + (effectiveGaussianPackedStateWord + (initialState system) source) = + effectiveGaussianPackedStateWord + (eliminate system) source := by + have hnext := gaussianPhysicalInitialState_nextPivot_le system + simpa only [eliminate] using + gaussianPhysicalColumnIterationOutput_state_effective (initialState system) source hrows + hnext + +private theorem gaussianPhysicalSourceEliminationOutput_effective + (system : BinaryAffineSystem) (source : List Bool) + (hrows : 0 < system.rowCount) : + gaussianPhysicalSourceEliminationOutput + (lengthPrefixedWord + (sourcePhysicalWordPackedCheckBits system) ++ + lengthPrefixedWord + (sourcePhysicalWordPackedRhsBits system) ++ source) = + effectiveGaussianPackedStateWord + system.effectiveGaussianState source := by + unfold gaussianPhysicalSourceEliminationOutput + rw [Function.comp_apply, + gaussianPhysicalPackedFullInitialStateOutput_effective + system source hrows] + exact gaussianPhysicalColumnIterationOutput_effective + system.effectiveGaussianSystem source hrows + +end GaussianAdaptivePhysicalColumnIterationBoundTM + +namespace GaussianSourceInitializer + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem +open GapCVP.FormulaBridge GapCVP.PhysicalColumnOrder GapCVP.SourceOrder +open GapCVP.BinaryPhysicalWordPackedMatrixTM GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianAdaptivePhysicalColumnIterationBoundTM + +private theorem paperVariableArityPhysicalWordBinarySystem_rowCount_pos + (encodingLength : ℕ) (formula : ThreeCNF) : + 0 < (physicalWordBinarySystem + encodingLength formula).rowCount := by + let normalized := srcFormula formula + let degree := sourceFieldExponent + (sourceSizeParameter encodingLength normalized) + have hdegree : 0 < degree := + sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength normalized) + have hgrid : 0 < Fintype.card + (ExplicitGridPoint encodingLength normalized) := by + simpa [ExplicitGridPoint] using + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid_card_pos + encodingLength normalized + let global : ExplicitConstraintFamily encodingLength normalized := .inl () + have hglobal : 0 < explicitFamilyRowCount + encodingLength normalized global := by + simpa [global, explicitFamilyRowCount] using hgrid + let actual : assembledBinaryRow + (explicitFamilyRowCount encodingLength normalized) degree := + ⟨global, (⟨0, hglobal⟩, ⟨0, hdegree⟩)⟩ + let physical := + (paperVariableArityExplicitBinaryRowWordOrder + encodingLength formula).symm actual + have hphysical := physical.isLt + change 0 < paperExplicitBinaryRowWordCount + encodingLength formula + omega + +private structure PaperVariableArityPhysicalPackedMatrixSourceComputer where + output : List Bool → List Bool + computer : BitTM output + output_valid : ∀ formula : ThreeCNF, + output (encodeThreeCNF formula) = + lengthPrefixedWord + (sourcePhysicalWordPackedCheckBits + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula)) ++ + lengthPrefixedWord + (sourcePhysicalWordPackedRhsBits + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula)) ++ + encodeThreeCNF formula + +private def gaussianPaperVariableAritySourceReducedStateOutput + (matrix : PaperVariableArityPhysicalPackedMatrixSourceComputer) : + List Bool → List Bool := + gaussianPhysicalSourceEliminationOutput ∘ matrix.output + +private noncomputable def gaussianPaperVariableAritySourceReducedStateComputable + (matrix : PaperVariableArityPhysicalPackedMatrixSourceComputer) : + BitTM + (gaussianPaperVariableAritySourceReducedStateOutput matrix) := + GapCVP.TMComposition.computableInPolyTime + matrix.computer gaussianPhysicalSourceEliminationComputable + +private theorem gaussianPaperVariableAritySourceReducedStateOutput_effective + (matrix : PaperVariableArityPhysicalPackedMatrixSourceComputer) + (formula : ThreeCNF) : + gaussianPaperVariableAritySourceReducedStateOutput matrix + (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula) := by + unfold gaussianPaperVariableAritySourceReducedStateOutput + rw [Function.comp_apply, matrix.output_valid formula] + exact gaussianPhysicalSourceEliminationOutput_effective + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula) + (encodeThreeCNF formula) + (paperVariableArityPhysicalWordBinarySystem_rowCount_pos + (encodeThreeCNF formula).length formula) + +end GaussianSourceInitializer + +namespace GaussianAdaptivePhysicalReducedConsistencyCatalogueTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryGaussian GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceMixedRadixOriginalSourceDescriptorRotationTM +open GapCVP.OutputBoundedDependentRecordFold GapCVP.BinaryExplicitAffineRows +open GapCVP.GaussianPackedPivotColumnTM GapCVP.GaussianReducedConsistencyTM +open GapCVP.GaussianAdaptiveEliminationCorrectness GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianAdaptivePhysicalStateCellTM GapCVP.GaussianAdaptivePackedStateLookupTM +open GapCVP.GaussianAdaptivePhysicalCandidateCatalogueTM + +private def gaussianPhysicalReducedRowRecordWord + (row width : ℕ) (state : List Bool) : List Bool := + lengthPrefixedWord (List.replicate row true) ++ + lengthPrefixedWord (List.replicate width true) ++ state + +private def gaussianPhysicalReducedRowRank : List Bool → List Bool := + firstFieldContents + +private noncomputable def gaussianPhysicalReducedRowRankComputable : + BitTM + gaussianPhysicalReducedRowRank := + firstFieldContentsComputable + +private def gaussianPhysicalReducedRowState : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +private noncomputable def gaussianPhysicalReducedRowStateComputable : + BitTM + gaussianPhysicalReducedRowState := + GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + +private def gaussianPhysicalReducedNextUnary : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ firstFieldSuffix ∘ + gaussianPhysicalReducedRowState + +private noncomputable def gaussianPhysicalReducedNextUnaryComputable : + BitTM + gaussianPhysicalReducedNextUnary := by + have hcheck := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalReducedRowStateComputable + firstFieldSuffixComputable + have hrhs := GapCVP.TMComposition.computableInPolyTime + hcheck firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hrhs firstFieldContentsComputable + +private def gaussianPhysicalReducedRowEligibleWord : + List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + (fourFamilyComputedUnaryLessBitOutput + gaussianPhysicalReducedRowRank + gaussianPhysicalReducedNextUnary) + +private noncomputable def gaussianPhysicalReducedRowEligibleComputable : + BitTM + gaussianPhysicalReducedRowEligibleWord := + fourFamilyBooleanNotOutputComputable + (fourFamilyComputedUnaryLessBitComputable + gaussianPhysicalReducedRowRankComputable + gaussianPhysicalReducedNextUnaryComputable) + +private def gaussianPhysicalReducedRowRhsQuery + (input : List Bool) : List Bool := + lengthPrefixedWord (gaussianPhysicalReducedRowRank input) ++ + (lengthPrefixedWord [] ++ gaussianPhysicalReducedRowState input) + +private noncomputable def gaussianPhysicalReducedRowRhsQueryComputable : + BitTM + gaussianPhysicalReducedRowRhsQuery := by + have hrank := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalReducedRowRankComputable + structuralPrefixWriterComputable + have hzero := + GapCVP.SourceCanonicalFixedWordTuringTM.sourceFixedWordComputable + (lengthPrefixedWord ([] : List Bool)) + have hphysical := pointwiseAppendComputable hrank + (pointwiseAppendComputable hzero + gaussianPhysicalReducedRowStateComputable) + change BitTM + (fun input => + lengthPrefixedWord (gaussianPhysicalReducedRowRank input) ++ + (lengthPrefixedWord [] ++ + gaussianPhysicalReducedRowState input)) + simpa only [Function.comp_apply] using hphysical + +private def gaussianPhysicalReducedRowRhsWord : List Bool → List Bool := + gaussianPackedStateRhsCellWord ∘ + gaussianPhysicalReducedRowRhsQuery + +private noncomputable def gaussianPhysicalReducedRowRhsComputable : + BitTM + gaussianPhysicalReducedRowRhsWord := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalReducedRowRhsQueryComputable + gaussianPackedStateRhsCellComputable + +private def gaussianPhysicalReducedRowOriginalSource : + List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix ∘ firstFieldSuffix ∘ + firstFieldSuffix ∘ gaussianPhysicalReducedRowState + +private noncomputable def gaussianPhysicalReducedRowOriginalSourceComputable : + BitTM + gaussianPhysicalReducedRowOriginalSource := by + have hcheck := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalReducedRowStateComputable + firstFieldSuffixComputable + have hrhs := GapCVP.TMComposition.computableInPolyTime + hcheck firstFieldSuffixComputable + have hnext := GapCVP.TMComposition.computableInPolyTime + hrhs firstFieldSuffixComputable + exact GapCVP.TMComposition.computableInPolyTime + hnext firstFieldSuffixComputable + +private def gaussianPhysicalReducedRowPayload + (input : List Bool) : List Bool := + gaussianPhysicalReducedRowEligibleWord input ++ + (gaussianPhysicalReducedRowRhsWord input ++ + gaussianPhysicalReducedRowOriginalSource input) + +private noncomputable def gaussianPhysicalReducedRowPayloadComputable : + BitTM + gaussianPhysicalReducedRowPayload := by + have hphysical := pointwiseAppendComputable + gaussianPhysicalReducedRowEligibleComputable + (pointwiseAppendComputable + gaussianPhysicalReducedRowRhsComputable + gaussianPhysicalReducedRowOriginalSourceComputable) + change BitTM + (fun input => + gaussianPhysicalReducedRowEligibleWord input ++ + (gaussianPhysicalReducedRowRhsWord input ++ + gaussianPhysicalReducedRowOriginalSource input)) + simpa only [Function.comp_apply] using hphysical + +private def gaussianPhysicalReducedRowRecordOutput : + List Bool → List Bool := + (fun payload => lengthPrefixedWord payload) ∘ + gaussianPhysicalReducedRowPayload + +private noncomputable def gaussianPhysicalReducedRowRecordComputable : + BitTM + gaussianPhysicalReducedRowRecordOutput := + GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalReducedRowPayloadComputable + structuralPrefixWriterComputable + +private noncomputable def gaussianPhysicalReducedRowWidth : + SourceQaryMaskDynamicGridWidth where + output := gaussianDenseStateRowCountUnary + computer := gaussianDenseStateRowCountUnaryComputable + +private def gaussianPhysicalReducedRowCatalogueOutput : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + gaussianPhysicalReducedRowWidth + gaussianPhysicalReducedRowRecordComputable + +private noncomputable def gaussianPhysicalReducedRowCatalogueComputable : + BitTM + gaussianPhysicalReducedRowCatalogueOutput := + maskDynamicGridRecordCatalogueComputable + gaussianPhysicalReducedRowWidth + gaussianPhysicalReducedRowRecordComputable + +private def gaussianPhysicalReducedConsistencyQueryOutput + (input : List Bool) : List Bool := + gaussianDenseStateRowCountUnary input ++ + (false :: gaussianPhysicalReducedRowCatalogueOutput input) + +private noncomputable def gaussianPhysicalReducedConsistencyQueryComputable : + BitTM + gaussianPhysicalReducedConsistencyQueryOutput := by + have htail := GapCVP.TMComposition.computableInPolyTime + gaussianPhysicalReducedRowCatalogueComputable + (GapCVP.SourceMachineCert.prependBitComputable false) + have hphysical := pointwiseAppendComputable + gaussianDenseStateRowCountUnaryComputable htail + change BitTM + (fun input => + gaussianDenseStateRowCountUnary input ++ + (false :: gaussianPhysicalReducedRowCatalogueOutput input)) + simpa only [Function.comp_apply] using hphysical + +@[simp] private theorem gaussianPhysicalReducedRowRank_word + (row width : ℕ) (state : List Bool) : + gaussianPhysicalReducedRowRank + (gaussianPhysicalReducedRowRecordWord row width state) = + List.replicate row true := by + simp only [gaussianPhysicalReducedRowRank, gaussianPhysicalReducedRowRecordWord, + List.append_assoc, + firstFieldContents_valid] + +@[simp] private theorem gaussianPhysicalReducedRowState_word + (row width : ℕ) (state : List Bool) : + gaussianPhysicalReducedRowState + (gaussianPhysicalReducedRowRecordWord row width state) = + state := by + simp only [gaussianPhysicalReducedRowState, gaussianPhysicalReducedRowRecordWord, + List.append_assoc, + Function.comp_apply, firstFieldSuffix_valid] + +@[simp] private theorem gaussianPhysicalReducedNextUnary_word + {m n : ℕ} (state : State m n) + (source : List Bool) (row width : ℕ) : + gaussianPhysicalReducedNextUnary + (gaussianPhysicalReducedRowRecordWord row width + (effectiveGaussianPackedStateWord state source)) = + List.replicate state.nextPivot true := by + simp only [gaussianPhysicalReducedNextUnary, effectiveGaussianPackedStateWord, List.append_assoc, + Function.comp_apply, gaussianPhysicalReducedRowState_word, firstFieldSuffix_valid, + firstFieldContents_valid] + +private theorem gaussianPhysicalReducedRowEligibleWord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (row width : ℕ) : + gaussianPhysicalReducedRowEligibleWord + (gaussianPhysicalReducedRowRecordWord row width + (effectiveGaussianPackedStateWord state source)) = + [decide (state.nextPivot ≤ row)] := by + let input := gaussianPhysicalReducedRowRecordWord row width + (effectiveGaussianPackedStateWord state source) + have hless := fourFamilyComputedUnaryLessBitOutput_valid + gaussianPhysicalReducedRowRank + gaussianPhysicalReducedNextUnary input row state.nextPivot + (gaussianPhysicalReducedRowRank_word row width + (effectiveGaussianPackedStateWord state source)) + (gaussianPhysicalReducedNextUnary_word + state source row width) + change gaussianPhysicalReducedRowEligibleWord input = _ + unfold gaussianPhysicalReducedRowEligibleWord + rw [fourFamilyBooleanNotOutput_bit _ input _ hless] + by_cases hlt : row < state.nextPivot + · have hnot : ¬ state.nextPivot ≤ row := by omega + simp only [hlt, decide_true, Bool.not_true, hnot, decide_false] + · have hle : state.nextPivot ≤ row := by omega + simp only [hlt, decide_false, Bool.not_false, hle, decide_true] + +@[simp] private theorem gaussianPhysicalReducedRowRhsQuery_word + (row width : ℕ) (state : List Bool) : + gaussianPhysicalReducedRowRhsQuery + (gaussianPhysicalReducedRowRecordWord row width state) = + affineCellQuery row 0 state := by + simp only [gaussianPhysicalReducedRowRhsQuery, gaussianPhysicalReducedRowRank_word, + gaussianPhysicalReducedRowState_word, affineCellQuery, List.replicate_zero, + List.append_assoc] + +private theorem gaussianPhysicalReducedRowRhsWord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (row : Fin m) (width : ℕ) : + gaussianPhysicalReducedRowRhsWord + (gaussianPhysicalReducedRowRecordWord row.val width + (effectiveGaussianPackedStateWord state source)) = + [decide (state.system.rhs row = (1 : ZMod 2))] := by + unfold gaussianPhysicalReducedRowRhsWord + rw [Function.comp_apply, + gaussianPhysicalReducedRowRhsQuery_word] + exact gaussianPackedStateRhsCellWord_query + state source row 0 + +@[simp] private theorem gaussianPhysicalReducedRowOriginalSource_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (row width : ℕ) : + gaussianPhysicalReducedRowOriginalSource + (gaussianPhysicalReducedRowRecordWord row width + (effectiveGaussianPackedStateWord state source)) = + source := by + simp only [gaussianPhysicalReducedRowOriginalSource, effectiveGaussianPackedStateWord, + List.append_assoc, + Function.comp_apply, gaussianPhysicalReducedRowState_word, firstFieldSuffix_valid] + +private theorem gaussianPhysicalReducedRowPayload_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (row : Fin m) (width : ℕ) : + gaussianPhysicalReducedRowPayload + (gaussianPhysicalReducedRowRecordWord row.val width + (effectiveGaussianPackedStateWord state source)) = + binaryGaussianPackedPivotRowQuery + (decide (state.nextPivot ≤ row.val)) + (decide (state.system.rhs row = (1 : ZMod 2))) source := by + unfold gaussianPhysicalReducedRowPayload + binaryGaussianPackedPivotRowQuery + rw [gaussianPhysicalReducedRowEligibleWord_effective + state source row.val width, + gaussianPhysicalReducedRowRhsWord_effective + state source row width, + gaussianPhysicalReducedRowOriginalSource_effective] + rfl + +private theorem gaussianPhysicalReducedRowRecordOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (row : Fin m) (width : ℕ) : + gaussianPhysicalReducedRowRecordOutput + (gaussianPhysicalReducedRowRecordWord row.val width + (effectiveGaussianPackedStateWord state source)) = + lengthPrefixedWord + (binaryGaussianPackedPivotRowQuery + (decide (state.nextPivot ≤ row.val)) + (decide (state.system.rhs row = (1 : ZMod 2))) source) := by + unfold gaussianPhysicalReducedRowRecordOutput + rw [Function.comp_apply, + gaussianPhysicalReducedRowPayload_effective + state source row width] + +private theorem gaussianPhysicalReducedRowWidth_effective + {m n : ℕ} (state : State m n) + (source : List Bool) : + gaussianPhysicalReducedRowWidth.output + (effectiveGaussianPackedStateWord state source) = + List.replicate m true := by + exact gaussianDenseStateRowCountUnary_effective + state source + +private theorem gaussianPhysicalReducedRowCatalogueOutput_valid + (input : List Bool) (count : ℕ) + (hwidth : gaussianPhysicalReducedRowWidth.output input = + List.replicate count true) : + gaussianPhysicalReducedRowCatalogueOutput input = + (List.range count).flatMap (fun rank => + gaussianPhysicalReducedRowRecordOutput + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalReducedRowWidth input)) := by + exact maskDynamicGridRecordCatalogueOutput_valid + gaussianPhysicalReducedRowWidth + gaussianPhysicalReducedRowRecordComputable + input count hwidth + +private theorem gaussianPhysicalReducedGeneratedRecord_effective + {m n : ℕ} (state : State m n) + (source : List Bool) (rank : ℕ) : + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalReducedRowWidth + (effectiveGaussianPackedStateWord state source) = + gaussianPhysicalReducedRowRecordWord rank m + (effectiveGaussianPackedStateWord state source) := by + unfold sourceQaryMaskDynamicGridBaseSource + rw [gaussianPhysicalReducedRowWidth_effective state source] + simp only [gaussianPhysicalReducedRowRecordWord, + List.append_assoc] + +private theorem gaussianPhysicalReducedRowCatalogueOutput_effective + {m n : ℕ} (state : State m n) + (source : List Bool) : + gaussianPhysicalReducedRowCatalogueOutput + (effectiveGaussianPackedStateWord state source) = + sourceMixedRadixOriginalSourceQueryStream + ((effectiveGaussianStateReducedConsistencyRows state).map + (fun row => binaryGaussianPackedPivotRowQuery + row.1 row.2 source)) := by + let input := effectiveGaussianPackedStateWord state source + have hwidth : gaussianPhysicalReducedRowWidth.output input = + List.replicate m true := + gaussianPhysicalReducedRowWidth_effective state source + have hcatalogue := gaussianPhysicalReducedRowCatalogueOutput_valid + input m hwidth + calc + gaussianPhysicalReducedRowCatalogueOutput input = + (List.range m).flatMap (fun rank => + gaussianPhysicalReducedRowRecordOutput + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + gaussianPhysicalReducedRowWidth input)) := + hcatalogue + _ = (List.range m).flatMap (fun rank => + gaussianPhysicalReducedRowRecordOutput + (gaussianPhysicalReducedRowRecordWord rank m + (effectiveGaussianPackedStateWord state source))) := by + apply List.flatMap_congr + intro rank _ + exact congrArg gaussianPhysicalReducedRowRecordOutput + (gaussianPhysicalReducedGeneratedRecord_effective + state source rank) + _ = (List.finRange m).flatMap (fun row => + lengthPrefixedWord + (binaryGaussianPackedPivotRowQuery + (decide (state.nextPivot ≤ row.val)) + (decide (state.system.rhs row = (1 : ZMod 2))) + source)) := by + rw [gaussianPhysicalPivot_range_flatMap_finRange] + apply List.flatMap_congr + intro row _ + exact gaussianPhysicalReducedRowRecordOutput_effective + state source row m + _ = sourceMixedRadixOriginalSourceQueryStream + ((effectiveGaussianStateReducedConsistencyRows state).map + (fun row => binaryGaussianPackedPivotRowQuery + row.1 row.2 source)) := by + unfold sourceMixedRadixOriginalSourceQueryStream + effectiveGaussianStateReducedConsistencyRows + simp only [List.flatMap_map, List.map_map, + Function.comp_apply] + +private theorem gaussianPhysicalReducedConsistencyQueryOutput_state_effective + {m n : ℕ} (state : State m n) + (source : List Bool) : + gaussianPhysicalReducedConsistencyQueryOutput + (effectiveGaussianPackedStateWord state source) = + effectiveGaussianStateReducedConsistencyQuery state source := by + unfold gaussianPhysicalReducedConsistencyQueryOutput + rw [gaussianDenseStateRowCountUnary_effective, + gaussianPhysicalReducedRowCatalogueOutput_effective] + unfold effectiveGaussianStateReducedConsistencyQuery + binaryGaussianPackedPivotColumnWord + unaryBoundedFoldWord + simp only [effectiveGaussianStateReducedConsistencyRows, + List.length_map, List.length_finRange] + +private theorem gaussianPhysicalReducedConsistencyQueryOutput_effective + (system : BinaryAffineSystem) (source : List Bool) : + gaussianPhysicalReducedConsistencyQueryOutput + (effectiveGaussianPackedStateWord + system.effectiveGaussianState source) = + effectiveGaussianReducedConsistencyQuery system source := by + exact gaussianPhysicalReducedConsistencyQueryOutput_state_effective + system.effectiveGaussianState source + +end GaussianAdaptivePhysicalReducedConsistencyCatalogueTM + +namespace GaussianSourceReducedConsistency + +open Turing GapCVP.BinaryEncoding GapCVP.PhysicalColumnOrder GapCVP.GaussianSourceInitializer +open GapCVP.GaussianAdaptivePhysicalReducedConsistencyCatalogueTM +open GapCVP.GaussianReducedConsistencyTM + +private def gaussianPaperVariableAritySourceReducedConsistencyQueryOutput + (matrix : PaperVariableArityPhysicalPackedMatrixSourceComputer) : + List Bool → List Bool := + gaussianPhysicalReducedConsistencyQueryOutput ∘ + gaussianPaperVariableAritySourceReducedStateOutput matrix + +/-- GapCVP reduction support. -/ +noncomputable def + gaussianPaperVariableAritySourceReducedConsistencyQueryComputable + (matrix : PaperVariableArityPhysicalPackedMatrixSourceComputer) : + BitTM + (gaussianPaperVariableAritySourceReducedConsistencyQueryOutput + matrix) := + GapCVP.TMComposition.computableInPolyTime + (gaussianPaperVariableAritySourceReducedStateComputable matrix) + gaussianPhysicalReducedConsistencyQueryComputable + +private theorem gaussianPaperVariableAritySourceReducedConsistencyQueryOutput_valid + (matrix : PaperVariableArityPhysicalPackedMatrixSourceComputer) + (formula : ThreeCNF) : + gaussianPaperVariableAritySourceReducedConsistencyQueryOutput matrix + (encodeThreeCNF formula) = + effectiveGaussianReducedConsistencyQuery + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula) + (encodeThreeCNF formula) := by + unfold gaussianPaperVariableAritySourceReducedConsistencyQueryOutput + rw [Function.comp_apply, + gaussianPaperVariableAritySourceReducedStateOutput_effective + matrix formula] + exact gaussianPhysicalReducedConsistencyQueryOutput_effective + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula) + (encodeThreeCNF formula) + +end GaussianSourceReducedConsistency + +namespace GaussianSourceInitializerInstantiation + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.CanonicalMatrixShape +open GapCVP.CanonicalSourceCatalogue GapCVP.PhysicalColumnOrder +open GapCVP.GaussianAdaptivePackedTraceCorrectness GapCVP.GaussianReducedConsistencyTM +open GapCVP.GaussianSourceInitializer GapCVP.GaussianSourceReducedConsistency + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityCanonicalPhysicalPackedMatrixSourceComputer + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + PaperVariableArityPhysicalPackedMatrixSourceComputer where + output := paperCanonicalBinaryMatrixPackedOutput worker + computer := paperVariableArityCanonicalBinaryMatrixPackedComputable worker + output_valid := paperVariableArityCanonicalBinaryMatrixPackedOutput_valid worker + +/-- GapCVP reduction support. -/ +def gaussianPaperVariableArityCanonicalSourceReducedStateOutput + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + gaussianPaperVariableAritySourceReducedStateOutput + (paperVariableArityCanonicalPhysicalPackedMatrixSourceComputer worker) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPaperVariableArityCanonicalSourceReducedStateComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (gaussianPaperVariableArityCanonicalSourceReducedStateOutput worker) := + gaussianPaperVariableAritySourceReducedStateComputable + (paperVariableArityCanonicalPhysicalPackedMatrixSourceComputer worker) + +theorem gaussianPaperVariableArityCanonicalSourceReducedStateOutput_effective + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + gaussianPaperVariableArityCanonicalSourceReducedStateOutput worker + (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula) := + gaussianPaperVariableAritySourceReducedStateOutput_effective + (paperVariableArityCanonicalPhysicalPackedMatrixSourceComputer worker) + formula + +private def gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryOutput + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + gaussianPaperVariableAritySourceReducedConsistencyQueryOutput + (paperVariableArityCanonicalPhysicalPackedMatrixSourceComputer worker) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryOutput + worker) := + gaussianPaperVariableAritySourceReducedConsistencyQueryComputable + (paperVariableArityCanonicalPhysicalPackedMatrixSourceComputer worker) + +theorem + gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryOutput_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryOutput + worker (encodeThreeCNF formula) = + effectiveGaussianReducedConsistencyQuery + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula) + (encodeThreeCNF formula) := + gaussianPaperVariableAritySourceReducedConsistencyQueryOutput_valid + (paperVariableArityCanonicalPhysicalPackedMatrixSourceComputer worker) + formula + +end GaussianSourceInitializerInstantiation + +namespace GaussianOutputSerializerTM + +open Turing GapCVP.Core GapCVP.Factor400BinaryInstanceBridge GapCVP.BinaryEncoding +open GapCVP.SourceMachineCert GapCVP.CLStructuralPrefixWriter +open GapCVP.CLStructuralAtomicNaturalWriter GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.BinaryDimensionTM GapCVP.BinaryExplicitAffineRows GapCVP.BinaryStructuralRecordTM +open GapCVP.BinaryGaussianStructuralAtomTM GapCVP.BinaryGaussianStructuralRecordIndex +open GapCVP.BinaryPhysicalRowBasisDivisionTM GapCVP.GaussianPhysicalWordRankIndexTM +open GapCVP.GaussianPackedStateTargetAtomTM GapCVP.GaussianPackedStateBasisAtomTM +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.Factor400BinaryCompactPhysicalGaussianOutputSerializerTM GapCVP.CanonicalMatrixShape +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +/-- GapCVP reduction support. -/ +noncomputable def paperGaussianSourceDimensionWidth + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + SourceQaryMaskDynamicGridWidth where + output := shape.columns + computer := shape.columnsComputable + +theorem paperVariableArityGaussianSourceDimensionWidth_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) : + (paperGaussianSourceDimensionWidth shape).output + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension true := by + change shape.columns (encodeThreeCNF formula) = _ + have actual := shape.columnsCorrect formula + rw [shape.systemCorrect] at actual + exact actual + +/-- GapCVP reduction support. -/ +def paperGaussianRankDimensionUnary + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + shape.columns ∘ structuralRankOriginalSource + +private noncomputable def paperGaussianRankDimensionComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperGaussianRankDimensionUnary shape) := + GapCVP.TMComposition.computableInPolyTime + structuralRankOriginalSourceComputable shape.columnsComputable + +theorem paperGaussianRankDimensionUnary_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) (rank : ℕ) : + paperGaussianRankDimensionUnary shape + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + List.replicate + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension true := by + unfold paperGaussianRankDimensionUnary + rw [Function.comp_apply, structuralRankOriginalSource_query] + exact paperVariableArityGaussianSourceDimensionWidth_valid shape formula + +/-- GapCVP reduction support. -/ +def paperGaussianRankDimensionAtomicOutput + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + structuralAtomicNaturalWord ∘ + paperGaussianRankDimensionUnary shape + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityGaussianRankDimensionAtomicComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperGaussianRankDimensionAtomicOutput shape) := + GapCVP.TMComposition.computableInPolyTime + (paperGaussianRankDimensionComputable shape) + structuralAtomicNaturalWriterComputable + +/-- GapCVP reduction support. -/ +def paperGaussianRankTargetBound + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (input : List Bool) : List Bool := + true :: true :: paperGaussianRankDimensionUnary shape input + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityGaussianRankTargetBoundComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperGaussianRankTargetBound shape) := by + have once := GapCVP.TMComposition.computableInPolyTime + (paperGaussianRankDimensionComputable shape) + (prependBitComputable true) + exact GapCVP.TMComposition.computableInPolyTime + once (prependBitComputable true) + +theorem paperVariableArityGaussianRankTargetBound_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) (rank : ℕ) : + paperGaussianRankTargetBound shape + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + List.replicate + (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) true := by + unfold paperGaussianRankTargetBound + rw [paperGaussianRankDimensionUnary_query] + rw [show 2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension = + Nat.succ (Nat.succ (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) by omega] + simp only [paperVariableArityPhysicalFormulaSystem_dimension, Nat.succ_eq_add_one, + List.replicate_succ] + +private def paperGaussianBasisFlatUnary + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + unarySubtractionOutput structuralRankUnary + (paperGaussianRankTargetBound shape) + +private noncomputable def paperVariableArityGaussianBasisFlatComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperGaussianBasisFlatUnary shape) := + unarySubtractionComputable structuralRankUnaryComputable + (paperVariableArityGaussianRankTargetBoundComputable shape) + +private theorem paperVariableArityGaussianBasisFlatUnary_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) (rank : ℕ) : + paperGaussianBasisFlatUnary shape + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + List.replicate + (rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) true := by + exact unarySubtractionOutput_valid structuralRankUnary + (paperGaussianRankTargetBound shape) + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) + rank + (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) + (structuralRankUnary_query + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) + (paperVariableArityGaussianRankTargetBound_query + shape formula rank) + +/-- GapCVP reduction support. -/ +def paperGaussianBasisRowUnary + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + (paperGaussianBasisFlatUnary shape) + (paperGaussianRankDimensionUnary shape) + +private noncomputable def paperVariableArityGaussianBasisRowComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperGaussianBasisRowUnary shape) := + sourcePhysicalComputedUnaryQuotientComputable + (paperVariableArityGaussianBasisFlatComputable shape) + (paperGaussianRankDimensionComputable shape) + +/-- GapCVP reduction support. -/ +def paperGaussianBasisColumnUnary + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + (paperGaussianBasisFlatUnary shape) + (paperGaussianRankDimensionUnary shape) + +private noncomputable def paperVariableArityGaussianBasisColumnComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + BitTM + (paperGaussianBasisColumnUnary shape) := + sourcePhysicalComputedUnaryRemainderComputable + (paperVariableArityGaussianBasisFlatComputable shape) + (paperGaussianRankDimensionComputable shape) + +theorem paperVariableArityGaussianBasisRowUnary_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) (rank : ℕ) : + paperGaussianBasisRowUnary shape + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + List.replicate + ((rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) / + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) true := by + exact sourcePhysicalComputedUnaryQuotient_valid + (paperGaussianBasisFlatUnary shape) + (paperGaussianRankDimensionUnary shape) + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) + (rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension + (physicalFormulaSystem_dimension_pos + (encodeThreeCNF formula).length formula) + (paperVariableArityGaussianBasisFlatUnary_query shape formula rank) + (paperGaussianRankDimensionUnary_query + shape formula rank) + +theorem paperVariableArityGaussianBasisColumnUnary_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (formula : ThreeCNF) (rank : ℕ) : + paperGaussianBasisColumnUnary shape + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + List.replicate + ((rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) % + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) true := by + exact sourcePhysicalComputedUnaryRemainder_valid + (paperGaussianBasisFlatUnary shape) + (paperGaussianRankDimensionUnary shape) + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) + (rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension + (physicalFormulaSystem_dimension_pos + (encodeThreeCNF formula).length formula) + (paperVariableArityGaussianBasisFlatUnary_query shape formula rank) + (paperGaussianRankDimensionUnary_query + shape formula rank) + +/-- GapCVP reduction support. -/ +def paperGaussianRankBasisStateQuery + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (reduced : List Bool → List Bool) + (input : List Bool) : List Bool := + lengthPrefixedWord + (paperGaussianBasisRowUnary shape input) ++ + (lengthPrefixedWord + (paperGaussianBasisColumnUnary shape input) ++ + compactPhysicalGaussianRankReducedState reduced input) + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityGaussianRankBasisStateQueryComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (paperGaussianRankBasisStateQuery shape reduced) := by + have row := GapCVP.TMComposition.computableInPolyTime + (paperVariableArityGaussianBasisRowComputable shape) + structuralPrefixWriterComputable + have column := GapCVP.TMComposition.computableInPolyTime + (paperVariableArityGaussianBasisColumnComputable shape) + structuralPrefixWriterComputable + have tail := pointwiseAppendComputable column + (compactPhysicalGaussianRankReducedStateComputable computer) + have physical := pointwiseAppendComputable row tail + change BitTM + (fun input => + lengthPrefixedWord + (paperGaussianBasisRowUnary shape input) ++ + (lengthPrefixedWord + (paperGaussianBasisColumnUnary shape input) ++ + compactPhysicalGaussianRankReducedState reduced input)) + simpa only [Function.comp_apply] using physical + +private def paperGaussianRankBasisAtom + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (reduced : List Bool → List Bool) : List Bool → List Bool := + gaussianPackedIndexedBasisAtom ∘ + paperGaussianRankBasisStateQuery shape reduced + +private noncomputable def paperVariableArityGaussianRankBasisAtomComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (paperGaussianRankBasisAtom shape reduced) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityGaussianRankBasisStateQueryComputable + shape computer) + gaussianPackedIndexedBasisAtomComputable + +private def paperGaussianStructuralAtomOutput + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (radius reduced : List Bool → List Bool) : List Bool → List Bool := + binaryGaussianDynamicBranchOutput + (structuralRankLessBit structuralRankOneBound) + (paperGaussianRankDimensionAtomicOutput shape) + (binaryGaussianDynamicBranchOutput + (structuralRankLessBit structuralRankTwoBound) + (compactPhysicalGaussianRankRadiusAtom radius) + (binaryGaussianDynamicBranchOutput + (structuralRankLessBit + (paperGaussianRankTargetBound shape)) + (compactPhysicalGaussianRankTargetAtom reduced) + (paperGaussianRankBasisAtom shape reduced))) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityGaussianStructuralAtomComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {radius reduced : List Bool → List Bool} + (radiusComputer : BitTM radius) + (reducedComputer : BitTM reduced) : + BitTM + (paperGaussianStructuralAtomOutput + shape radius reduced) := by + have tail := binaryGaussianDynamicBranchComputable + (structuralRankLessSelectionComputable + (paperVariableArityGaussianRankTargetBoundComputable shape)) + (compactPhysicalGaussianRankTargetAtomComputable reducedComputer) + (paperVariableArityGaussianRankBasisAtomComputable + shape reducedComputer) + have scalar := binaryGaussianDynamicBranchComputable + (structuralRankLessSelectionComputable + structuralRankTwoBoundComputable) + (compactPhysicalGaussianRankRadiusAtomComputable radiusComputer) + tail + exact binaryGaussianDynamicBranchComputable + (structuralRankLessSelectionComputable + structuralRankOneBoundComputable) + (paperVariableArityGaussianRankDimensionAtomicComputable shape) + scalar + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityGaussianStructuralAtomComputer + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {radius reduced : List Bool → List Bool} + (radiusComputer : BitTM radius) + (reducedComputer : BitTM reduced) : + ConstructiveStructuralAtomComputer := + compactPhysicalGaussianStructuralAtomComputerPack + (paperGaussianStructuralAtomOutput + shape radius reduced) + (paperVariableArityGaussianStructuralAtomComputable + shape radiusComputer reducedComputer) + +@[simp] private theorem paperVariableArityGaussianStructuralAtomComputer_output + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {radius reduced : List Bool → List Bool} + (radiusComputer : BitTM radius) + (reducedComputer : BitTM reduced) + (input : List Bool) : + (paperVariableArityGaussianStructuralAtomComputer + shape radiusComputer reducedComputer).output input = + paperGaussianStructuralAtomOutput + shape radius reduced input := by + unfold paperVariableArityGaussianStructuralAtomComputer + exact compactPhysicalGaussianStructuralAtomComputerPack_output + (paperGaussianStructuralAtomOutput + shape radius reduced) + (paperVariableArityGaussianStructuralAtomComputable + shape radiusComputer reducedComputer) input + +/-- GapCVP reduction support. -/ +noncomputable def paperGaussianStructuralSourceWord + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {radius reduced : List Bool → List Bool} + (radiusComputer : BitTM radius) + (reducedComputer : BitTM reduced) : List Bool → List Bool := + constructiveStructuralSourceWord + (paperGaussianSourceDimensionWidth shape) + (paperVariableArityGaussianStructuralAtomComputer + shape radiusComputer reducedComputer) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityGaussianStructuralSourceWordComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {radius reduced : List Bool → List Bool} + (radiusComputer : BitTM radius) + (reducedComputer : BitTM reduced) : + BitTM + (paperGaussianStructuralSourceWord + shape radiusComputer reducedComputer) := + constructiveStructuralSourceWordComputable + (paperGaussianSourceDimensionWidth shape) + (paperVariableArityGaussianStructuralAtomComputer + shape radiusComputer reducedComputer) + +theorem paperGaussianRankReducedState_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (formula : ThreeCNF) (rank : ℕ) + (actual : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) : + compactPhysicalGaussianRankReducedState reduced + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula) := by + unfold compactPhysicalGaussianRankReducedState + rw [Function.comp_apply, structuralRankOriginalSource_query, actual] + +private theorem paperVariableArityGaussianRankTargetAtom_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (formula : ThreeCNF) (rank : ℕ) + (index : Fin + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) + (indexCorrect : rank - 2 = index.val) + (actual : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) : + compactPhysicalGaussianRankTargetAtom reduced + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + encodeAtomic + (((physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveAffineRepresentative + index : ℤ) : ℚ) := by + unfold compactPhysicalGaussianRankTargetAtom + rw [Function.comp_apply] + unfold compactPhysicalGaussianRankTargetStateQuery + rw [factor400PhysicalWordGaussianTargetCoordinateUnary_query, + paperGaussianRankReducedState_query + shape formula rank actual, indexCorrect] + exact gaussianPackedIndexedTargetAtom_effective + (physicalFormulaSystem + (encodeThreeCNF formula).length formula) + index (encodeThreeCNF formula) + +private theorem paperVariableArityGaussianRankBasisAtom_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (formula : ThreeCNF) (rank : ℕ) + (row column : Fin + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) + (rowCorrect : + (rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) / + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension = row.val) + (columnCorrect : + (rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) % + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension = column.val) + (actual : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) : + paperGaussianRankBasisAtom shape reduced + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + encodeAtomic + ((physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveSquareBasisMatrix + row column) := by + unfold paperGaussianRankBasisAtom + rw [Function.comp_apply] + unfold paperGaussianRankBasisStateQuery + rw [paperVariableArityGaussianBasisRowUnary_query + shape formula rank, + paperVariableArityGaussianBasisColumnUnary_query + shape formula rank, + paperGaussianRankReducedState_query + shape formula rank actual, + rowCorrect, columnCorrect] + simpa only [gaussianPackedIndexedBasisStateWord, + affineCellQuery, List.append_assoc] using + gaussianPackedIndexedBasisAtom_effective + (physicalFormulaSystem + (encodeThreeCNF formula).length formula) + row column (encodeThreeCNF formula) + +private theorem paperVariableArityGaussianStructuralAtomOutput_correct + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {radius reduced : List Bool → List Bool} + (formula : ThreeCNF) + (radiusValue : ℚ) + (radiusPositive : 0 < radiusValue) + (actualRadius : + radius (encodeThreeCNF formula) = encodeAtomic radiusValue) + (actualReduced : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) + (rank : ℕ) + (recordBound : + rank < + (sourceLatticeStructuralRecords + (effectiveGapCVPInstance + (physicalFormulaSystem + (encodeThreeCNF formula).length formula) + (physicalFormulaSystem_dimension_pos + (encodeThreeCNF formula).length formula) + radiusValue radiusPositive)).length) : + paperGaussianStructuralAtomOutput + shape radius reduced + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + (sourceLatticeStructuralRecords + (effectiveGapCVPInstance + (physicalFormulaSystem + (encodeThreeCNF formula).length formula) + (physicalFormulaSystem_dimension_pos + (encodeThreeCNF formula).length formula) + radiusValue radiusPositive)).getD rank [] := by + let source := encodeThreeCNF formula + let system := physicalFormulaSystem + source.length formula + let positiveDimension := + physicalFormulaSystem_dimension_pos + source.length formula + let lattice := effectiveGapCVPInstance + system positiveDimension radiusValue radiusPositive + let width := paperGaussianSourceDimensionWidth shape + let query := constructiveStructuralRankQuery width source rank + have one : + structuralRankLessBit structuralRankOneBound query = + decide (rank < 1) := + structuralRankOneDecision_query width source rank + have two : + structuralRankLessBit structuralRankTwoBound query = + decide (rank < 2) := + structuralRankTwoDecision_query width source rank + have boundary : + paperGaussianRankTargetBound shape query = + List.replicate (2 + lattice.dimension) true := by + have dimension : lattice.dimension = system.dimension := rfl + rw [dimension] + simpa only [query, source, width, system] using + paperVariableArityGaussianRankTargetBound_query + shape formula rank + have target : + structuralRankLessBit + (paperGaussianRankTargetBound shape) query = + decide (rank < 2 + lattice.dimension) := + structuralRankLessBit_valid + (paperGaussianRankTargetBound shape) + query rank (2 + lattice.dimension) + (structuralRankUnary_query width source rank) boundary + change paperGaussianStructuralAtomOutput + shape radius reduced query = + (sourceLatticeStructuralRecords lattice).getD rank [] + unfold paperGaussianStructuralAtomOutput + binaryGaussianDynamicBranchOutput + rw [one] + by_cases zeroRank : rank < 1 + · rw [decide_eq_true zeroRank, ite_eq_left (by decide)] + have exactRank : rank = 0 := by omega + subst rank + change + paperGaussianRankDimensionAtomicOutput shape + (constructiveStructuralRankQuery width source 0) = + (sourceLatticeStructuralRecords lattice).getD 0 [] + unfold paperGaussianRankDimensionAtomicOutput + rw [Function.comp_apply] + change + structuralAtomicNaturalWord + (paperGaussianRankDimensionUnary shape + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) 0)) = + (sourceLatticeStructuralRecords lattice).getD 0 [] + rw [paperGaussianRankDimensionUnary_query + shape formula 0, + sourceLatticeStructuralRecords_getD_dimension lattice] + simp only [structuralAtomicNaturalWord, List.length_replicate] + rfl + · rw [decide_eq_false zeroRank, ite_eq_right (by decide), two] + by_cases radiusRank : rank < 2 + · rw [decide_eq_true radiusRank, ite_eq_left (by decide)] + have exactRank : rank = 1 := by omega + subst rank + change + compactPhysicalGaussianRankRadiusAtom radius + (constructiveStructuralRankQuery width source 1) = + (sourceLatticeStructuralRecords lattice).getD 1 [] + unfold compactPhysicalGaussianRankRadiusAtom + rw [Function.comp_apply, structuralRankOriginalSource_query] + change radius (encodeThreeCNF formula) = + (sourceLatticeStructuralRecords lattice).getD 1 [] + rw [actualRadius, + sourceLatticeStructuralRecords_getD_radius lattice] + rfl + · rw [decide_eq_false radiusRank, ite_eq_right (by decide), target] + by_cases targetRank : rank < 2 + lattice.dimension + · rw [decide_eq_true targetRank, ite_eq_left (by decide)] + have dimension : lattice.dimension = system.dimension := rfl + have indexBound : rank - 2 < system.dimension := by omega + let index : Fin system.dimension := ⟨rank - 2, indexBound⟩ + have exactRank : rank = 2 + index.val := by + dsimp [index] + omega + have atom := paperVariableArityGaussianRankTargetAtom_query + shape formula rank index rfl actualReduced + have exactRecord : + (sourceLatticeStructuralRecords lattice).getD rank [] = + encodeAtomic + ((system.effectiveAffineRepresentative index : ℤ) : ℚ) := by + rw [exactRank, + sourceLatticeStructuralRecords_getD_target lattice index] + rfl + rw [exactRecord] + exact atom + · rw [decide_eq_false targetRank, ite_eq_right (by decide)] + have positive : 0 < system.dimension := positiveDimension + have dimension : lattice.dimension = system.dimension := rfl + have latticeRecords : + rank < 2 + lattice.dimension + + lattice.dimension * lattice.dimension := by + simpa only [sourceLatticeStructuralRecords_length] + using recordBound + rw [dimension] at latticeRecords + have records : + rank < 2 + system.dimension + + system.dimension * system.dimension := latticeRecords + have start : 2 + system.dimension ≤ rank := by omega + have offset : + rank - (2 + system.dimension) < + system.dimension * system.dimension := by omega + have rowBound : + (rank - (2 + system.dimension)) / system.dimension < + system.dimension := + (Nat.div_lt_iff_lt_mul positive).2 offset + let row : Fin system.dimension := + ⟨(rank - (2 + system.dimension)) / system.dimension, + rowBound⟩ + let column : Fin system.dimension := + ⟨(rank - (2 + system.dimension)) % system.dimension, + Nat.mod_lt _ positive⟩ + have decompose : + row.val * system.dimension + column.val = + rank - (2 + system.dimension) := by + dsimp [row, column] + rw [Nat.mul_comm] + exact Nat.div_add_mod _ _ + have exactRank : + rank = 2 + system.dimension + + row.val * system.dimension + column.val := by omega + have atom := paperVariableArityGaussianRankBasisAtom_query + shape formula rank row column rfl rfl actualReduced + have exactRecord : + (sourceLatticeStructuralRecords lattice).getD rank [] = + encodeAtomic + (system.effectiveSquareBasisMatrix row column) := by + rw [exactRank] + change + (sourceLatticeStructuralRecords lattice).getD + (2 + lattice.dimension + + row.val * lattice.dimension + column.val) [] = + encodeAtomic (lattice.basis row column) + exact sourceLatticeStructuralRecords_getD_basis + lattice row column + rw [exactRecord] + exact atom + +theorem paperVariableArityGaussianStructuralSourceWord_eq_encodeGapCVPInstance + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {radius reduced : List Bool → List Bool} + (radiusComputer : BitTM radius) + (reducedComputer : BitTM reduced) + (formula : ThreeCNF) + (radiusValue : ℚ) + (radiusPositive : 0 < radiusValue) + (actualRadius : + radius (encodeThreeCNF formula) = encodeAtomic radiusValue) + (actualReduced : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) : + paperGaussianStructuralSourceWord + shape radiusComputer reducedComputer + (encodeThreeCNF formula) = + encodeGapCVPInstance + (effectiveGapCVPInstance + (physicalFormulaSystem + (encodeThreeCNF formula).length formula) + (physicalFormulaSystem_dimension_pos + (encodeThreeCNF formula).length formula) + radiusValue radiusPositive) := by + let lattice := effectiveGapCVPInstance + (physicalFormulaSystem + (encodeThreeCNF formula).length formula) + (physicalFormulaSystem_dimension_pos + (encodeThreeCNF formula).length formula) + radiusValue radiusPositive + unfold paperGaussianStructuralSourceWord + apply constructiveStructuralSourceWord_eq_encodeGapCVPInstance + (paperGaussianSourceDimensionWidth shape) + (paperVariableArityGaussianStructuralAtomComputer + shape radiusComputer reducedComputer) + (encodeThreeCNF formula) lattice + · exact paperVariableArityGaussianSourceDimensionWidth_valid + shape formula + · intro rank bound + rw [paperVariableArityGaussianStructuralAtomComputer_output] + exact paperVariableArityGaussianStructuralAtomOutput_correct + shape formula radiusValue radiusPositive + actualRadius actualReduced rank bound + +end GaussianOutputSerializerTM + +namespace PhysicalFamilyRowTM + +open scoped BigOperators + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceMachineCert GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.CNFBoundedRecordFoldTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.CLStructuralNaturalBinaryWriter GapCVP.CLVerifier GapCVP.BinaryDimensionTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.BinarySourceVariableCompaction +open GapCVP.BinaryCompactSourceFirstOccurrenceTM GapCVP.SourcePreprocessingSemantics +open GapCVP.SourcePreprocessingTM GapCVP.FormulaBridge GapCVP.ClauseOffsetTM + +/-- GapCVP reduction support. -/ +abbrev physicalFormulaSize (formula : ThreeCNF) : ℕ := + sourceSizeParameter (encodeThreeCNF formula).length + (srcFormula formula) + +/-- GapCVP reduction support. -/ +abbrev physDegree (formula : ThreeCNF) : ℕ := + sourceFieldExponent (physicalFormulaSize formula) + +/-- GapCVP reduction support. -/ +abbrev physFieldCard + (formula : ThreeCNF) : ℕ := + 2 ^ physDegree formula + +/-- GapCVP reduction support. -/ +abbrev physicalFormulaVariableCount + (formula : ThreeCNF) : ℕ := + paperVariableArityVariableCount formula + +/-- GapCVP reduction support. -/ +abbrev physGridCard + (formula : ThreeCNF) : ℕ := + physFieldCard formula - + physicalFormulaVariableCount formula + +/-- GapCVP reduction support. -/ +abbrev physicalFormulaMomentCount + (formula : ThreeCNF) : ℕ := + physicalFormulaSize formula ^ 30 + 1 + +/-- GapCVP reduction support. -/ +abbrev physicalFormulaTupleCount + (formula : ThreeCNF) : ℕ := + sourceClauseWeightSum + (noTautClauses formula) + +/-- GapCVP reduction support. -/ +abbrev physicalFormulaGlobalBoundary + (formula : ThreeCNF) : ℕ := + physGridCard formula * + physDegree formula + +/-- GapCVP reduction support. -/ +abbrev physicalFormulaRefinementBoundary + (formula : ThreeCNF) : ℕ := + physicalFormulaGlobalBoundary formula + + (noTautClauses formula).length * + physGridCard formula * + physFieldCard formula * + physDegree formula + +/-- GapCVP reduction support. -/ +abbrev physicalFormulaOrdinaryBoundary + (formula : ThreeCNF) : ℕ := + physicalFormulaRefinementBoundary formula + + (1 + physicalFormulaTupleCount formula) * + physicalFormulaMomentCount formula * + physGridCard formula * + physDegree formula + +private def physicalFamilyRetainedSource : + List Bool → List Bool := + firstFieldContents ∘ paperSourcePreprocessingOutput + +private noncomputable def paperVariableArityPhysicalFamilyRetainedSourceComputable : + BitTM + physicalFamilyRetainedSource := + GapCVP.TMComposition.computableInPolyTime + paperSourcePreprocessingComputable firstFieldContentsComputable + +@[simp] private theorem paperVariableArityPhysicalFamilyRetainedSource_valid + (formula : ThreeCNF) : + physicalFamilyRetainedSource + (encodeThreeCNF formula) = + encodeThreeCNF (noTautClauses formula) := by + unfold physicalFamilyRetainedSource + rw [Function.comp_apply, paperSourcePreprocessingOutput_valid] + exact firstFieldContents_valid + (encodeThreeCNF (noTautClauses formula)) + (lengthPrefixedWord (paperSourceNormalizedClauseStream formula) ++ + encodeThreeCNF formula) + +private def physicalFamilyClauseCountUnary : + List Bool → List Bool := + sourceClauseCountUnary ∘ physicalFamilyRetainedSource + +private noncomputable def physicalFamilyClauseCountUnaryComputable : + BitTM + physicalFamilyClauseCountUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilyRetainedSourceComputable + sourceClauseCountUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalFamilyClauseCountUnary_valid + (formula : ThreeCNF) : + physicalFamilyClauseCountUnary + (encodeThreeCNF formula) = + List.replicate (noTautClauses formula).length true := by + simp only [physicalFamilyClauseCountUnary, Function.comp_apply, + paperVariableArityPhysicalFamilyRetainedSource_valid, sourceClauseCountUnary_valid] + +private theorem paperVariableArityPhysicalFamilyRetainedVariableCount_eq + (formula : ThreeCNF) : + occurringVariableCount + (noTautClauses formula) = + paperVariableArityVariableCount formula := by + classical + let retained := noTautClauses formula + have sameVariables : + (occurringVariables retained).toFinset = + (paperNormalizedOccurringVariables formula).toFinset := by + ext name + simp only [List.mem_toFinset] + exact (mem_occurringVariables_iff retained name).trans + ((mem_formulaVariables_iff_exists_literal retained name).trans + (mem_paperSourceNormalizedOccurringVariables_iff + formula name).symm) + unfold occurringVariableCount paperVariableArityVariableCount + change (occurringVariables retained).length = + (paperNormalizedOccurringVariables formula).length + calc + (occurringVariables retained).length = + (occurringVariables retained).toFinset.card := + (List.toFinset_card_of_nodup + (occurringVariables_nodup retained)).symm + _ = (paperNormalizedOccurringVariables formula).toFinset.card := + congrArg Finset.card sameVariables + _ = (paperNormalizedOccurringVariables formula).length := + List.toFinset_card_of_nodup + (paperSourceNormalizedOccurringVariables_nodup formula) + +/-- GapCVP reduction support. -/ +def physicalFamilyVariableCountUnary : + List Bool → List Bool := + compactSourceOccurringVariableCountUnary ∘ + physicalFamilyRetainedSource + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyVariableCountUnaryComputable : + BitTM + physicalFamilyVariableCountUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilyRetainedSourceComputable + compactSourceOccurringVariableCountUnaryComputable + +@[simp] theorem paperVariableArityPhysicalFamilyVariableCountUnary_valid + (formula : ThreeCNF) : + physicalFamilyVariableCountUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaVariableCount formula) true := by + unfold physicalFamilyVariableCountUnary + rw [Function.comp_apply, + paperVariableArityPhysicalFamilyRetainedSource_valid, + compactSourceOccurringVariableCountUnary_valid, + paperVariableArityPhysicalFamilyRetainedVariableCount_eq] + +private def physicalFamilySizeUnary + (input : List Bool) : List Bool := + List.replicate 100 true ++ + (sourceInputLengthUnary input ++ + (physicalFamilyVariableCountUnary input ++ + physicalFamilyClauseCountUnary input)) + +private noncomputable def paperVariableArityPhysicalFamilySizeUnaryComputable : + BitTM + physicalFamilySizeUnary := + pointwiseAppendComputable + (sourceFixedWordComputable (List.replicate 100 true)) + (pointwiseAppendComputable sourceInputLengthUnaryComputable + (pointwiseAppendComputable + paperVariableArityPhysicalFamilyVariableCountUnaryComputable + physicalFamilyClauseCountUnaryComputable)) + +@[simp] private theorem paperVariableArityPhysicalFamilySizeUnary_valid + (formula : ThreeCNF) : + physicalFamilySizeUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaSize formula) true := by + simp only [physicalFamilySizeUnary, + sourceInputLengthUnary, + paperVariableArityPhysicalFamilyVariableCountUnary_valid, + paperVariableArityPhysicalFamilyClauseCountUnary_valid, + ← List.replicate_add, + GapCVP.Core.sourceSizeParameter, + physicalFormulaVariableCount, srcFormula, + paperSourceNormalizedClauses, List.length_map, + List.length_attach] + simp only [Nat.add_assoc] + +private def physicalFamilyPowerTwoHundredUnary : + List Bool → List Bool := + (fun input : List Bool => + List.replicate ((Polynomial.X ^ 200).eval input.length) true) ∘ + physicalFamilySizeUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyPowerTwoHundredUnaryComputable : + BitTM + physicalFamilyPowerTwoHundredUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilySizeUnaryComputable + (polynomialValueUnaryComputable (Polynomial.X ^ 200)) + +@[simp] private theorem paperVariableArityPhysicalFamilyPowerTwoHundredUnary_valid + (formula : ThreeCNF) : + physicalFamilyPowerTwoHundredUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaSize formula ^ 200) true := by + unfold physicalFamilyPowerTwoHundredUnary + rw [Function.comp_apply, paperVariableArityPhysicalFamilySizeUnary_valid, + List.length_replicate, Polynomial.eval_pow, Polynomial.eval_X] + +/-- GapCVP reduction support. -/ +def physicalFamilyFieldCardinalityUnary : + List Bool → List Bool := + nextPowerUnaryOutput physicalFamilyPowerTwoHundredUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable : + BitTM + physicalFamilyFieldCardinalityUnary := + nextPowerUnaryComputable + paperVariableArityPhysicalFamilyPowerTwoHundredUnaryComputable + +@[simp] theorem paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid + (formula : ThreeCNF) : + physicalFamilyFieldCardinalityUnary + (encodeThreeCNF formula) = + List.replicate + (physFieldCard formula) true := by + unfold physicalFamilyFieldCardinalityUnary + rw [show physFieldCard formula = + 2 ^ Nat.clog 2 (physicalFormulaSize formula ^ 200) by + simp only [physFieldCard, physDegree, sourceFieldExponent_eq]] + apply nextPowerUnaryOutput_valid + physicalFamilyPowerTwoHundredUnary + (encodeThreeCNF formula) + (physicalFormulaSize formula ^ 200) + · exact paperVariableArityPhysicalFamilyPowerTwoHundredUnary_valid formula + · have size := GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula) + positivity + +private def paperVariableArityPhysicalFamilyFieldCardinalityBinary : + List Bool → List Bool := + (fun input : List Bool => Computability.encodeNat input.length) ∘ + physicalFamilyFieldCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyFieldCardinalityBinaryComputable : + BitTM + paperVariableArityPhysicalFamilyFieldCardinalityBinary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable + structuralNaturalBinaryWriterComputable + +private def paperVariableArityPhysicalFamilyFieldBitLengthUnary : + List Bool → List Bool := + sourceInputLengthUnary ∘ + paperVariableArityPhysicalFamilyFieldCardinalityBinary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyFieldBitLengthUnaryComputable : + BitTM + paperVariableArityPhysicalFamilyFieldBitLengthUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilyFieldCardinalityBinaryComputable + sourceInputLengthUnaryComputable + +/-- GapCVP reduction support. -/ +def physicalFamilyFieldDegreeUnary : + List Bool → List Bool := + List.tail ∘ paperVariableArityPhysicalFamilyFieldBitLengthUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable : + BitTM + physicalFamilyFieldDegreeUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilyFieldBitLengthUnaryComputable + dropHeadComputable + +@[simp] theorem paperVariableArityPhysicalFamilyFieldDegreeUnary_valid + (formula : ThreeCNF) : + physicalFamilyFieldDegreeUnary + (encodeThreeCNF formula) = + List.replicate + (physDegree formula) true := by + unfold physicalFamilyFieldDegreeUnary + paperVariableArityPhysicalFamilyFieldBitLengthUnary + paperVariableArityPhysicalFamilyFieldCardinalityBinary + sourceInputLengthUnary + simp only [Function.comp_apply] + rw [paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid] + simp only [List.length_replicate, encodeNat_length_eq_size, Nat.size_pow, List.replicate_succ, + List.tail_cons] + +/-- GapCVP reduction support. -/ +def physicalFamilyGridCardinalityUnary : + List Bool → List Bool := + unarySubtractionOutput + physicalFamilyFieldCardinalityUnary + physicalFamilyVariableCountUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable : + BitTM + physicalFamilyGridCardinalityUnary := + unarySubtractionComputable + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable + paperVariableArityPhysicalFamilyVariableCountUnaryComputable + +@[simp] theorem paperVariableArityPhysicalFamilyGridCardinalityUnary_valid + (formula : ThreeCNF) : + physicalFamilyGridCardinalityUnary + (encodeThreeCNF formula) = + List.replicate + (physGridCard formula) true := by + unfold physicalFamilyGridCardinalityUnary + exact unarySubtractionOutput_valid + physicalFamilyFieldCardinalityUnary + physicalFamilyVariableCountUnary + (encodeThreeCNF formula) + (physFieldCard formula) + (physicalFormulaVariableCount formula) + (paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid formula) + (paperVariableArityPhysicalFamilyVariableCountUnary_valid formula) + +private def paperVariableArityPhysicalFamilyMomentBudgetUnary : + List Bool → List Bool := + (fun input : List Bool => + List.replicate ((Polynomial.X ^ 30).eval input.length) true) ∘ + physicalFamilySizeUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyMomentBudgetUnaryComputable : + BitTM + paperVariableArityPhysicalFamilyMomentBudgetUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilySizeUnaryComputable + (polynomialValueUnaryComputable (Polynomial.X ^ 30)) + +/-- GapCVP reduction support. -/ +def physicalFamilyMomentCountUnary + (input : List Bool) : List Bool := + true :: paperVariableArityPhysicalFamilyMomentBudgetUnary input + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyMomentCountUnaryComputable : + BitTM + physicalFamilyMomentCountUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilyMomentBudgetUnaryComputable + (prependBitComputable true) + +@[simp] theorem paperVariableArityPhysicalFamilyMomentCountUnary_valid + (formula : ThreeCNF) : + physicalFamilyMomentCountUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaMomentCount formula) true := by + unfold physicalFamilyMomentCountUnary + paperVariableArityPhysicalFamilyMomentBudgetUnary + simp only [Polynomial.eval_pow, Polynomial.eval_X, Function.comp_apply, + paperVariableArityPhysicalFamilySizeUnary_valid, List.length_replicate, List.replicate_succ] + +private def physicalFamilyTupleCountUnary : + List Bool → List Bool := + paperSourcePreprocessingField 1 ∘ + paperClauseOffsetOutput + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyTupleCountUnaryComputable : + BitTM + physicalFamilyTupleCountUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityClauseOffsetOutputComputable + (paperPreprocessingFieldComputable 1) + +@[simp] private theorem paperVariableArityPhysicalFamilyTupleCountUnary_valid + (formula : ThreeCNF) : + physicalFamilyTupleCountUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaTupleCount formula) true := by + unfold physicalFamilyTupleCountUnary + rw [Function.comp_apply, paperVariableArityClauseOffsetOutput_valid] + simp only [paperSourcePreprocessingField, paperSourcePreprocessingSuffixAt, Function.iterate_one, + Function.comp_apply, firstFieldSuffix_valid, firstFieldContents_valid] + +private def physicalFamilyTypeCountUnary + (input : List Bool) : List Bool := + true :: physicalFamilyTupleCountUnary input + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalFamilyTypeCountUnaryComputable : + BitTM + physicalFamilyTypeCountUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFamilyTupleCountUnaryComputable + (prependBitComputable true) + +@[simp] private theorem paperVariableArityPhysicalFamilyTypeCountUnary_valid + (formula : ThreeCNF) : + physicalFamilyTypeCountUnary + (encodeThreeCNF formula) = + List.replicate + (1 + physicalFormulaTupleCount formula) true := by + unfold physicalFamilyTypeCountUnary + rw [paperVariableArityPhysicalFamilyTupleCountUnary_valid] + rw [Nat.add_comm] + rfl + +end PhysicalFamilyRowTM + +namespace Factor400BinaryConstructivePaperVariableArityPhysicalRadiusMachine + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceMachineCert +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap GapCVP.BinaryRadiusTM + +private def physicalOneHotClauseCountUnary + (input : List Bool) : List Bool := + true :: physicalFamilyClauseCountUnary input + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalOneHotClauseCountUnaryComputable : + BitTM + physicalOneHotClauseCountUnary := by + have physical := GapCVP.TMComposition.computableInPolyTime + physicalFamilyClauseCountUnaryComputable + (prependBitComputable true) + change BitTM + (fun input => true :: physicalFamilyClauseCountUnary input) + simpa only [Function.comp_def] using physical + +@[simp] private theorem paperVariableArityPhysicalOneHotClauseCountUnary_valid + (formula : ThreeCNF) : + physicalOneHotClauseCountUnary + (encodeThreeCNF formula) = + List.replicate + ((noTautClauses formula).length + 1) true := by + simp only [physicalOneHotClauseCountUnary, + paperVariableArityPhysicalFamilyClauseCountUnary_valid, + List.replicate_succ] + +private theorem paperVariableArityPhysicalFamilyGridCardinalityUnary_eq_actualGrid + (formula : ThreeCNF) : + physicalFamilyGridCardinalityUnary + (encodeThreeCNF formula) = + List.replicate + (sourceFormulaGrid (encodeThreeCNF formula).length + (srcFormula formula)).card true := by + rw [paperVariableArityPhysicalFamilyGridCardinalityUnary_valid] + congr 1 + simpa only [physGridCard, physFieldCard, physDegree, physicalFormulaSize, + physicalFormulaVariableCount, + paperVariableAritySourceFormula_variableCount] using + (sourceFormulaGrid_card_eq_fieldWordCount (encodeThreeCNF formula).length (srcFormula + formula)).symm + +/-- GapCVP reduction support. -/ +def physicalOneHotWeightUnary : List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + physicalOneHotClauseCountUnary + physicalFamilyGridCardinalityUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalOneHotWeightUnaryComputable : + BitTM + physicalOneHotWeightUnary := + fourFamilyComputedUnaryProductComputable + paperVariableArityPhysicalOneHotClauseCountUnaryComputable + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable + +@[simp] theorem paperVariableArityPhysicalOneHotWeightUnary_valid + (formula : ThreeCNF) : + physicalOneHotWeightUnary + (encodeThreeCNF formula) = + List.replicate + (((noTautClauses formula).length + 1) * + (sourceFormulaGrid (encodeThreeCNF formula).length + (srcFormula formula)).card) + true := by + exact fourFamilyComputedUnaryProductOutput_valid + physicalOneHotClauseCountUnary + physicalFamilyGridCardinalityUnary + (encodeThreeCNF formula) + ((noTautClauses formula).length + 1) + (sourceFormulaGrid (encodeThreeCNF formula).length + (srcFormula formula)).card + (paperVariableArityPhysicalOneHotClauseCountUnary_valid formula) + (paperVariableArityPhysicalFamilyGridCardinalityUnary_eq_actualGrid + formula) + +private def paperVariableArityPhysicalRadiusAtomicOutput : List Bool → List Bool := + ceilSquareRootAtomicRationalOutput + physicalOneHotWeightUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalRadiusAtomicComputable : + BitTM + paperVariableArityPhysicalRadiusAtomicOutput := + ceilSquareRootAtomicRationalComputable + paperVariableArityPhysicalOneHotWeightUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRadiusAtomicOutput_valid + (formula : ThreeCNF) : + paperVariableArityPhysicalRadiusAtomicOutput + (encodeThreeCNF formula) = + encodeAtomic + (physicalFormulaRadius + (encodeThreeCNF formula).length formula) := by + unfold paperVariableArityPhysicalRadiusAtomicOutput + rw [ceilSquareRootAtomicRationalOutput_valid + physicalOneHotWeightUnary + (encodeThreeCNF formula) + (((noTautClauses formula).length + 1) * + (sourceFormulaGrid (encodeThreeCNF formula).length + (srcFormula formula)).card) + (paperVariableArityPhysicalOneHotWeightUnary_valid formula)] + unfold physicalFormulaRadius + GapCVP.Core.sourceOneHotCompletenessRadius + rw [paperVariableAritySourceFormula_clauses_length] + +end Factor400BinaryConstructivePaperVariableArityPhysicalRadiusMachine + +namespace PhysicalNormalizedBranchTM + +open Turing GapCVP.BinaryEncoding GapCVP.OutputPolynomialCompositionClosure +open GapCVP.SourceOriginalSourcePreservingTM GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics GapCVP.PhysicalFamilyRowTM GapCVP.GaussianRowWorker +open GapCVP.Factor400BinaryPhysicalWorkers + +/-- GapCVP reduction support. -/ +def physicalNormalizedNonemptyMarker + (input : List Bool) : Bool := + (physicalFamilyClauseCountUnary input).headD false + +private def physicalNormalizedNonemptyDecisionWord : + List Bool → List Bool := + binaryGaussianFirstCellWord ∘ + physicalFamilyClauseCountUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalNormalizedNonemptyDecisionComputable : + BitTM + physicalNormalizedNonemptyDecisionWord := + GapCVP.TMComposition.computableInPolyTime + physicalFamilyClauseCountUnaryComputable + binaryGaussianFirstCellComputable + +private theorem paperVariableArityPhysicalNormalizedNonemptyDecisionWord_eq + (input : List Bool) : + physicalNormalizedNonemptyDecisionWord input = + [physicalNormalizedNonemptyMarker input] := by + unfold physicalNormalizedNonemptyDecisionWord + physicalNormalizedNonemptyMarker + cases hcount : physicalFamilyClauseCountUnary input with + | nil => + simp only [binaryGaussianFirstCellWord, Function.comp_apply, markerConditionalOutput, hcount, + List.headD_eq_head?_getD, List.head?_nil, Option.getD_none] + | cons bit remaining => + simp only [Function.comp_apply, hcount, binaryGaussianFirstCellWord_valid, + List.headD_eq_head?_getD, + List.head?_cons, Option.getD_some] + +@[simp] theorem paperVariableArityPhysicalNormalizedNonemptyMarker_valid + (formula : ThreeCNF) : + physicalNormalizedNonemptyMarker + (encodeThreeCNF formula) = + decide (paperSourceNormalizedClauses formula ≠ []) := by + unfold physicalNormalizedNonemptyMarker + rw [paperVariableArityPhysicalFamilyClauseCountUnary_valid] + cases hretained : noTautClauses formula with + | nil => + simp only [List.length_nil, List.replicate_zero, List.headD_eq_head?_getD, List.head?_nil, + Option.getD_none, + paperSourceNormalizedClauses, hretained, List.map_nil, ne_eq, not_true_eq_false, + decide_false] + | cons clause remaining => + simp only [List.length_cons, List.replicate_succ, List.headD_eq_head?_getD, List.head?_cons, + Option.getD_some, + paperSourceNormalizedClauses, hretained, List.map_cons, ne_eq, reduceCtorEq, + not_false_eq_true, decide_true] + +private def physicalNormalizedEmptyDecisionWord : + List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + physicalNormalizedNonemptyDecisionWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalNormalizedEmptyDecisionComputable : + BitTM + physicalNormalizedEmptyDecisionWord := + fourFamilyBooleanNotOutputComputable + paperVariableArityPhysicalNormalizedNonemptyDecisionComputable + +private def physicalCanonicalDecisionWord : + List Bool → List Bool := + binaryGaussianFirstCellWord ∘ + (fun input => constructiveCanonicalSourceMarker input :: input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalDecisionComputable : + BitTM + physicalCanonicalDecisionWord := + GapCVP.TMComposition.computableInPolyTime + constructiveCanonicalSourceMarkerComputable + binaryGaussianFirstCellComputable + +@[simp] private theorem paperVariableArityPhysicalCanonicalDecisionWord_eq + (input : List Bool) : + physicalCanonicalDecisionWord input = + [constructiveCanonicalSourceMarker input] := by + simp only [physicalCanonicalDecisionWord, Function.comp_apply, binaryGaussianFirstCellWord_valid] + +/-- GapCVP reduction support. -/ +def physicalCanonicalNormalizedNonemptyGuard + (input : List Bool) : Bool := + constructiveCanonicalSourceMarker input && + physicalNormalizedNonemptyMarker input + +private def physicalCanonicalNormalizedNonemptyDecisionWord : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + physicalCanonicalDecisionWord + physicalNormalizedNonemptyDecisionWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalNormalizedNonemptyDecisionComputable : + BitTM + physicalCanonicalNormalizedNonemptyDecisionWord := + fourFamilyBooleanAndComputable + paperVariableArityPhysicalCanonicalDecisionComputable + paperVariableArityPhysicalNormalizedNonemptyDecisionComputable + +private theorem paperVariableArityPhysicalCanonicalNormalizedNonemptyDecisionWord_eq + (input : List Bool) : + physicalCanonicalNormalizedNonemptyDecisionWord input = + [physicalCanonicalNormalizedNonemptyGuard input] := by + unfold physicalCanonicalNormalizedNonemptyDecisionWord + physicalCanonicalNormalizedNonemptyGuard + exact fourFamilyBooleanAndOutput_bits + physicalCanonicalDecisionWord + physicalNormalizedNonemptyDecisionWord + input (constructiveCanonicalSourceMarker input) + (physicalNormalizedNonemptyMarker input) + (paperVariableArityPhysicalCanonicalDecisionWord_eq input) + (paperVariableArityPhysicalNormalizedNonemptyDecisionWord_eq input) + +private def physicalCanonicalNormalizedNonemptySelectionOutput : + List Bool → List Bool := + factor400KeepFirstDropSecondWord ∘ + originalSourcePreservingOutput + physicalCanonicalNormalizedNonemptyDecisionWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalNormalizedNonemptyPreservedComputable : + BitTM + (originalSourcePreservingOutput + physicalCanonicalNormalizedNonemptyDecisionWord) := + originalSourcePreservingComputable + paperVariableArityPhysicalCanonicalNormalizedNonemptyDecisionComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalNormalizedNonemptySelectionComputable : + BitTM + physicalCanonicalNormalizedNonemptySelectionOutput := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalCanonicalNormalizedNonemptyPreservedComputable + factor400KeepFirstDropSecondComputable + +private theorem paperVariableArityPhysicalCanonicalNormalizedNonemptySelectionOutput_eq + (input : List Bool) : + physicalCanonicalNormalizedNonemptySelectionOutput + input = + physicalCanonicalNormalizedNonemptyGuard input :: + input := by + unfold physicalCanonicalNormalizedNonemptySelectionOutput + originalSourcePreservingOutput + rw [Function.comp_apply, + paperVariableArityPhysicalCanonicalNormalizedNonemptyDecisionWord_eq + input] + simp only [factor400KeepFirstDropSecondWord, List.cons_append, List.nil_append, List.tail_cons] + +end PhysicalNormalizedBranchTM + +namespace PhysicalNormalizedCanonicalGuardTM + +open Turing GapCVP.SourceOriginalSourcePreservingTM GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.PhysicalNormalizedBranchTM +open GapCVP.Factor400BinaryPhysicalWorkers + +/-- GapCVP reduction support. -/ +def physicalNormalizedEmptyMarker + (input : List Bool) : Bool := + !physicalNormalizedNonemptyMarker input + +private theorem paperVariableArityPhysicalNormalizedEmptyDecisionWord_eq + (input : List Bool) : + physicalNormalizedEmptyDecisionWord input = + [physicalNormalizedEmptyMarker input] := by + unfold physicalNormalizedEmptyDecisionWord + physicalNormalizedEmptyMarker + exact fourFamilyBooleanNotOutput_bit + physicalNormalizedNonemptyDecisionWord input + (physicalNormalizedNonemptyMarker input) + (paperVariableArityPhysicalNormalizedNonemptyDecisionWord_eq input) + +/-- GapCVP reduction support. -/ +def physicalCanonicalNormalizedEmptyGuard + (input : List Bool) : Bool := + constructiveCanonicalSourceMarker input && + physicalNormalizedEmptyMarker input + +private def physicalCanonicalNormalizedEmptyDecisionWord : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + physicalCanonicalDecisionWord + physicalNormalizedEmptyDecisionWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalNormalizedEmptyDecisionComputable : + BitTM + physicalCanonicalNormalizedEmptyDecisionWord := + fourFamilyBooleanAndComputable + paperVariableArityPhysicalCanonicalDecisionComputable + paperVariableArityPhysicalNormalizedEmptyDecisionComputable + +private theorem paperVariableArityPhysicalCanonicalNormalizedEmptyDecisionWord_eq + (input : List Bool) : + physicalCanonicalNormalizedEmptyDecisionWord input = + [physicalCanonicalNormalizedEmptyGuard input] := by + unfold physicalCanonicalNormalizedEmptyDecisionWord + physicalCanonicalNormalizedEmptyGuard + exact fourFamilyBooleanAndOutput_bits + physicalCanonicalDecisionWord + physicalNormalizedEmptyDecisionWord input + (constructiveCanonicalSourceMarker input) + (physicalNormalizedEmptyMarker input) + (paperVariableArityPhysicalCanonicalDecisionWord_eq input) + (paperVariableArityPhysicalNormalizedEmptyDecisionWord_eq input) + +private def physicalCanonicalNormalizedEmptySelectionOutput : + List Bool → List Bool := + factor400KeepFirstDropSecondWord ∘ + originalSourcePreservingOutput + physicalCanonicalNormalizedEmptyDecisionWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalNormalizedEmptyPreservedComputable : + BitTM + (originalSourcePreservingOutput + physicalCanonicalNormalizedEmptyDecisionWord) := + originalSourcePreservingComputable + paperVariableArityPhysicalCanonicalNormalizedEmptyDecisionComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalNormalizedEmptySelectionComputable : + BitTM + physicalCanonicalNormalizedEmptySelectionOutput := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalCanonicalNormalizedEmptyPreservedComputable + factor400KeepFirstDropSecondComputable + +private theorem paperVariableArityPhysicalCanonicalNormalizedEmptySelectionOutput_eq + (input : List Bool) : + physicalCanonicalNormalizedEmptySelectionOutput input = + physicalCanonicalNormalizedEmptyGuard input :: + input := by + unfold physicalCanonicalNormalizedEmptySelectionOutput + originalSourcePreservingOutput + rw [Function.comp_apply, + paperVariableArityPhysicalCanonicalNormalizedEmptyDecisionWord_eq input] + simp only [factor400KeepFirstDropSecondWord, List.cons_append, List.nil_append, List.tail_cons] + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalNormalizedEmptyGuardComputable : + BitTM + (fun input => + physicalCanonicalNormalizedEmptyGuard input :: + input) := by + have equality : + physicalCanonicalNormalizedEmptySelectionOutput = + (fun input => + physicalCanonicalNormalizedEmptyGuard input :: + input) := + funext paperVariableArityPhysicalCanonicalNormalizedEmptySelectionOutput_eq + rw [← equality] + exact paperVariableArityPhysicalCanonicalNormalizedEmptySelectionComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCanonicalNormalizedNonemptyGuardComputable : + BitTM + (fun input => + physicalCanonicalNormalizedNonemptyGuard input :: + input) := by + have equality : + physicalCanonicalNormalizedNonemptySelectionOutput = + (fun input => + physicalCanonicalNormalizedNonemptyGuard input :: + input) := + funext paperVariableArityPhysicalCanonicalNormalizedNonemptySelectionOutput_eq + rw [← equality] + exact paperVariableArityPhysicalCanonicalNormalizedNonemptySelectionComputable + +end PhysicalNormalizedCanonicalGuardTM + +namespace GaussianExactSourceInitializer + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.OutputPolynomialCompositionClosure +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.CanonicalMatrixShape GapCVP.PhysicalColumnOrder +open GapCVP.GaussianSourceConsistencyBridge GapCVP.GaussianSourceInitializerInstantiation + +/-- GapCVP reduction support. -/ +def paperCanonicalSourceBinarySystem + (input : List Bool) : Option BinaryAffineSystem := + match decodeThreeCNF input with + | none => none + | some formula => + if encodeThreeCNF formula = input then + some (physicalWordBinarySystem input.length formula) + else + none + +@[simp] private theorem paperVariableArityCanonicalSourceBinarySystem_encode + (formula : ThreeCNF) : + paperCanonicalSourceBinarySystem + (encodeThreeCNF formula) = + some (physicalWordBinarySystem + (encodeThreeCNF formula).length formula) := by + simp only [paperCanonicalSourceBinarySystem, decodeThreeCNF_encode, ↓reduceIte] + +private def gaussianPaperVariableArityExactSourceReducedStateOutput + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : List Bool := + if constructiveCanonicalSourceMarker input then + gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryOutput + worker input + else + binaryGaussianMalformedReducedState + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPaperVariableArityExactSourceReducedStateComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (gaussianPaperVariableArityExactSourceReducedStateOutput worker) := by + change BitTM + (fun input => + if constructiveCanonicalSourceMarker input then + gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryOutput + worker input + else + binaryGaussianMalformedReducedState) + exact sourcePreservingConditionalComputable + constructiveCanonicalSourceMarkerComputable + (gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryComputable + worker) + binaryGaussianMalformedReducedState + +private theorem gaussianPaperVariableArityExactSourceReducedStateOutput_eq + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : + gaussianPaperVariableArityExactSourceReducedStateOutput worker input = + binaryGaussianExpectedReducedSourceState + paperCanonicalSourceBinarySystem input := by + cases hdecode : decodeThreeCNF input with + | none => + simp only [gaussianPaperVariableArityExactSourceReducedStateOutput, + constructiveCanonicalSourceMarker, + hdecode, Bool.false_eq_true, ↓reduceIte, binaryGaussianExpectedReducedSourceState, + paperCanonicalSourceBinarySystem] + | some formula => + by_cases hcanonical : encodeThreeCNF formula = input + · subst input + simpa only [gaussianPaperVariableArityExactSourceReducedStateOutput, + constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, decide_true, ↓reduceIte, + binaryGaussianExpectedReducedSourceState, + paperCanonicalSourceBinarySystem] using + gaussianPaperVariableArityCanonicalSourceReducedConsistencyQueryOutput_valid worker + formula + · simp only [gaussianPaperVariableArityExactSourceReducedStateOutput, + constructiveCanonicalSourceMarker, + hdecode, hcanonical, decide_false, Bool.false_eq_true, ↓reduceIte, + binaryGaussianExpectedReducedSourceState, + paperCanonicalSourceBinarySystem] + +@[irreducible] private noncomputable def gaussianPaperVariableArityExactSourceInitializer + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BinaryGaussianExactSourceInitializer + paperCanonicalSourceBinarySystem where + output := gaussianPaperVariableArityExactSourceReducedStateOutput worker + computer := gaussianPaperVariableArityExactSourceReducedStateComputable worker + output_eq := gaussianPaperVariableArityExactSourceReducedStateOutput_eq worker + +private def gaussianPaperVariableArityAllInputExactConsistencyOutput + (input : List Bool) : List Bool := + binaryGaussianSourceConsistencyGuard + paperCanonicalSourceBinarySystem input :: input + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + gaussianPaperVariableArityAllInputExactConsistencyComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (worker : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + gaussianPaperVariableArityAllInputExactConsistencyOutput := + binaryGaussianExactSourceConsistencyComputable + (gaussianPaperVariableArityExactSourceInitializer worker) + +end GaussianExactSourceInitializer + +namespace ExactPhysicalSourceTM + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.OutputPolynomialCompositionClosure GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianSourceConsistencyBridge +open GapCVP.SourcePreprocessingSemantics GapCVP.CanonicalMatrixShape +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.PhysicalNormalizedBranchTM GapCVP.PhysicalNormalizedCanonicalGuardTM +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalRadiusMachine +open GapCVP.GaussianExactSourceInitializer GapCVP.GaussianSourceInitializerInstantiation +open GapCVP.GaussianOutputSerializerTM + +private noncomputable def paperExactPhysicalStructuralOutput + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + paperGaussianStructuralSourceWord shape + paperVariableArityPhysicalRadiusAtomicComputable + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityExactPhysicalStructuralOutputComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperExactPhysicalStructuralOutput cell) := + paperVariableArityGaussianStructuralSourceWordComputable shape + paperVariableArityPhysicalRadiusAtomicComputable + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell) + +private theorem paperVariableArityExactPhysicalStructuralOutput_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperExactPhysicalStructuralOutput cell + (encodeThreeCNF formula) = + encodeGapCVPInstance + (physicalFormulaInstance + (encodeThreeCNF formula).length formula) := by + unfold paperExactPhysicalStructuralOutput + exact paperVariableArityGaussianStructuralSourceWord_eq_encodeGapCVPInstance + shape + paperVariableArityPhysicalRadiusAtomicComputable + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell) + formula + (physicalFormulaRadius + (encodeThreeCNF formula).length formula) + (physicalFormulaRadius_pos + (encodeThreeCNF formula).length formula) + (paperVariableArityPhysicalRadiusAtomicOutput_valid formula) + (gaussianPaperVariableArityCanonicalSourceReducedStateOutput_effective + cell formula) + +private def paperExactPhysicalRoutedOutput + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : List Bool := + if physicalCanonicalNormalizedEmptyGuard input then + SourceMachineRouting.canonicalYesWord + else if physicalCanonicalNormalizedNonemptyGuard input then + if binaryGaussianSourceConsistencyGuard + paperCanonicalSourceBinarySystem input then + paperExactPhysicalStructuralOutput cell input + else + Factor400BinaryCanonicalNo.adaptedCanonicalNoWord + else + Factor400BinaryCanonicalNo.adaptedCanonicalNoWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityExactPhysicalRoutedOutputComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperExactPhysicalRoutedOutput cell) := by + have consistency := sourcePreservingConditionalComputable + (gaussianPaperVariableArityAllInputExactConsistencyComputable cell) + (paperVariableArityExactPhysicalStructuralOutputComputable cell) + Factor400BinaryCanonicalNo.adaptedCanonicalNoWord + have nonempty := sourcePreservingConditionalComputable + paperVariableArityPhysicalCanonicalNormalizedNonemptyGuardComputable + consistency Factor400BinaryCanonicalNo.adaptedCanonicalNoWord + have routed := binaryGaussianDynamicBranchComputable + paperVariableArityPhysicalCanonicalNormalizedEmptyGuardComputable + (sourceFixedWordComputable SourceMachineRouting.canonicalYesWord) + nonempty + exact routed + +@[simp] theorem paperVariableArityExactPhysicalConsistencyGuard_encode + (formula : ThreeCNF) : + binaryGaussianSourceConsistencyGuard + paperCanonicalSourceBinarySystem + (encodeThreeCNF formula) = + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveReducedConsistent := by + unfold binaryGaussianSourceConsistencyGuard + rw [paperVariableArityCanonicalSourceBinarySystem_encode] + rfl + +private theorem paperVariableArityExactPhysicalRoutedOutput_eq_sourceMap + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : + paperExactPhysicalRoutedOutput cell input = + paperVariableArityPhysicalSourceMap input := by + cases decoded : decodeThreeCNF input with + | none => + have canonical : constructiveCanonicalSourceMarker input = false := by + simp only [constructiveCanonicalSourceMarker, decoded] + have empty : + physicalCanonicalNormalizedEmptyGuard input = + false := by + simp only [physicalCanonicalNormalizedEmptyGuard, canonical, Bool.false_and] + have nonempty : + physicalCanonicalNormalizedNonemptyGuard input = + false := by + simp only [physicalCanonicalNormalizedNonemptyGuard, canonical, Bool.false_and] + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_decode_none + input decoded] + simp only [paperExactPhysicalRoutedOutput, + empty, Bool.false_eq_true, ↓reduceIte, nonempty] + rfl + | some formula => + by_cases canonical : encodeThreeCNF formula = input + · subst input + by_cases empty : paperSourceNormalizedClauses formula = [] + · have emptyGuard : + physicalCanonicalNormalizedEmptyGuard + (encodeThreeCNF formula) = true := by + simp only [physicalCanonicalNormalizedEmptyGuard, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, physicalNormalizedEmptyMarker, + paperVariableArityPhysicalNormalizedNonemptyMarker_valid, empty, ne_eq, + not_true_eq_false, decide_false, Bool.not_false, Bool.and_self] + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_normalized_empty + (encodeThreeCNF formula) formula (by simp only [decodeThreeCNF_encode]) rfl empty] + simp only [paperExactPhysicalRoutedOutput, + emptyGuard, ↓reduceIte] + rfl + · have emptyGuard : + physicalCanonicalNormalizedEmptyGuard + (encodeThreeCNF formula) = false := by + simp only [physicalCanonicalNormalizedEmptyGuard, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, physicalNormalizedEmptyMarker, + paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, empty, + not_false_eq_true, Bool.not_true, Bool.and_false] + have nonemptyGuard : + physicalCanonicalNormalizedNonemptyGuard + (encodeThreeCNF formula) = true := by + simp only [physicalCanonicalNormalizedNonemptyGuard, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, + empty, not_false_eq_true, + Bool.and_self] + cases consistent : + (physicalFormulaSystem + (encodeThreeCNF formula).length + formula).effectiveReducedConsistent with + | false => + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_inconsistent + (encodeThreeCNF formula) formula + (by simp only [decodeThreeCNF_encode]) rfl empty consistent] + simp only [paperExactPhysicalRoutedOutput, + emptyGuard, Bool.false_eq_true, ↓reduceIte, + nonemptyGuard, paperVariableArityExactPhysicalConsistencyGuard_encode, + consistent] + rfl + | true => + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_consistent + (encodeThreeCNF formula) formula + (by simp only [decodeThreeCNF_encode]) rfl empty consistent] + simp only [paperExactPhysicalRoutedOutput, + emptyGuard, Bool.false_eq_true, ↓reduceIte, + nonemptyGuard, paperVariableArityExactPhysicalConsistencyGuard_encode, + consistent] + exact paperVariableArityExactPhysicalStructuralOutput_valid + cell formula + · have sourceGuard : + constructiveCanonicalSourceMarker input = false := by + simp only [constructiveCanonicalSourceMarker, decoded, canonical, decide_false] + have emptyGuard : + physicalCanonicalNormalizedEmptyGuard input = + false := by + simp only [physicalCanonicalNormalizedEmptyGuard, sourceGuard, Bool.false_and] + have nonemptyGuard : + physicalCanonicalNormalizedNonemptyGuard input = + false := by + simp only [physicalCanonicalNormalizedNonemptyGuard, sourceGuard, Bool.false_and] + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_noncanonical + input formula decoded canonical] + simp only [paperExactPhysicalRoutedOutput, + emptyGuard, Bool.false_eq_true, ↓reduceIte, nonemptyGuard] + rfl + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalSourceMapMachineOfCell + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + paperVariableArityPhysicalSourceMap := by + have machine := paperVariableArityExactPhysicalRoutedOutputComputable cell + have equality : + paperExactPhysicalRoutedOutput cell = + paperVariableArityPhysicalSourceMap := + funext (paperVariableArityExactPhysicalRoutedOutput_eq_sourceMap cell) + rwa [equality] at machine + +end ExactPhysicalSourceTM + +namespace PhysicalFamilyMarkerTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.PhysicalFamilyRowTM + +private def physicalGlobalBoundaryUnary : + List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + physicalFamilyGridCardinalityUnary + physicalFamilyFieldDegreeUnary + +private noncomputable def paperVariableArityPhysicalGlobalBoundaryUnaryComputable : + BitTM + physicalGlobalBoundaryUnary := + fourFamilyComputedUnaryProductComputable + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalGlobalBoundaryUnary_valid + (formula : ThreeCNF) : + physicalGlobalBoundaryUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaGlobalBoundary formula) true := by + unfold physicalGlobalBoundaryUnary + exact fourFamilyComputedUnaryProductOutput_valid + physicalFamilyGridCardinalityUnary + physicalFamilyFieldDegreeUnary + (encodeThreeCNF formula) + (physGridCard formula) + (physDegree formula) + (paperVariableArityPhysicalFamilyGridCardinalityUnary_valid formula) + (paperVariableArityPhysicalFamilyFieldDegreeUnary_valid formula) + +private def physicalRefinementWidthUnary : + List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + physicalFamilyClauseCountUnary + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldCardinalityUnary) + physicalFamilyFieldDegreeUnary + +private noncomputable def paperVariableArityPhysicalRefinementWidthUnaryComputable : + BitTM + physicalRefinementWidthUnary := + fourFamilyComputedUnaryProductComputable + (fourFamilyComputedUnaryProductComputable + (fourFamilyComputedUnaryProductComputable + physicalFamilyClauseCountUnaryComputable + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable) + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable) + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementWidthUnary_valid + (formula : ThreeCNF) : + physicalRefinementWidthUnary + (encodeThreeCNF formula) = + List.replicate + ((noTautClauses formula).length * + physGridCard formula * + physFieldCard formula * + physDegree formula) true := by + let input := encodeThreeCNF formula + have clauseGrid := fourFamilyComputedUnaryProductOutput_valid + physicalFamilyClauseCountUnary + physicalFamilyGridCardinalityUnary input + (noTautClauses formula).length + (physGridCard formula) + (paperVariableArityPhysicalFamilyClauseCountUnary_valid formula) + (paperVariableArityPhysicalFamilyGridCardinalityUnary_valid formula) + have field := fourFamilyComputedUnaryProductOutput_valid + (fourFamilyComputedUnaryProductOutput + physicalFamilyClauseCountUnary + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldCardinalityUnary input + ((noTautClauses formula).length * + physGridCard formula) + (physFieldCard formula) + clauseGrid + (paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid formula) + exact fourFamilyComputedUnaryProductOutput_valid + (fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + physicalFamilyClauseCountUnary + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldCardinalityUnary) + physicalFamilyFieldDegreeUnary input + ((noTautClauses formula).length * + physGridCard formula * + physFieldCard formula) + (physDegree formula) + field + (paperVariableArityPhysicalFamilyFieldDegreeUnary_valid formula) + +private def physicalRefinementBoundaryUnary : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + physicalGlobalBoundaryUnary + physicalRefinementWidthUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementBoundaryUnaryComputable : + BitTM + physicalRefinementBoundaryUnary := + fourFamilyComputedUnarySumComputable + paperVariableArityPhysicalGlobalBoundaryUnaryComputable + paperVariableArityPhysicalRefinementWidthUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementBoundaryUnary_valid + (formula : ThreeCNF) : + physicalRefinementBoundaryUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaRefinementBoundary formula) + true := by + unfold physicalRefinementBoundaryUnary + exact fourFamilyComputedUnarySumOutput_valid + physicalGlobalBoundaryUnary + physicalRefinementWidthUnary + (encodeThreeCNF formula) + (physicalFormulaGlobalBoundary formula) + ((noTautClauses formula).length * + physGridCard formula * + physFieldCard formula * + physDegree formula) + (paperVariableArityPhysicalGlobalBoundaryUnary_valid formula) + (paperVariableArityPhysicalRefinementWidthUnary_valid formula) + +private def physicalOrdinaryWidthUnary : + List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + physicalFamilyTypeCountUnary + physicalFamilyMomentCountUnary) + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldDegreeUnary + +private noncomputable def paperVariableArityPhysicalOrdinaryWidthUnaryComputable : + BitTM + physicalOrdinaryWidthUnary := + fourFamilyComputedUnaryProductComputable + (fourFamilyComputedUnaryProductComputable + (fourFamilyComputedUnaryProductComputable + paperVariableArityPhysicalFamilyTypeCountUnaryComputable + paperVariableArityPhysicalFamilyMomentCountUnaryComputable) + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable) + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalOrdinaryWidthUnary_valid + (formula : ThreeCNF) : + physicalOrdinaryWidthUnary + (encodeThreeCNF formula) = + List.replicate + ((1 + physicalFormulaTupleCount formula) * + physicalFormulaMomentCount formula * + physGridCard formula * + physDegree formula) true := by + let input := encodeThreeCNF formula + have tagMoment := fourFamilyComputedUnaryProductOutput_valid + physicalFamilyTypeCountUnary + physicalFamilyMomentCountUnary input + (1 + physicalFormulaTupleCount formula) + (physicalFormulaMomentCount formula) + (paperVariableArityPhysicalFamilyTypeCountUnary_valid formula) + (paperVariableArityPhysicalFamilyMomentCountUnary_valid formula) + have grid := fourFamilyComputedUnaryProductOutput_valid + (fourFamilyComputedUnaryProductOutput + physicalFamilyTypeCountUnary + physicalFamilyMomentCountUnary) + physicalFamilyGridCardinalityUnary input + ((1 + physicalFormulaTupleCount formula) * + physicalFormulaMomentCount formula) + (physGridCard formula) + tagMoment + (paperVariableArityPhysicalFamilyGridCardinalityUnary_valid formula) + exact fourFamilyComputedUnaryProductOutput_valid + (fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + physicalFamilyTypeCountUnary + physicalFamilyMomentCountUnary) + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldDegreeUnary input + ((1 + physicalFormulaTupleCount formula) * + physicalFormulaMomentCount formula * + physGridCard formula) + (physDegree formula) + grid + (paperVariableArityPhysicalFamilyFieldDegreeUnary_valid formula) + +private def physicalOrdinaryBoundaryUnary : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + physicalRefinementBoundaryUnary + physicalOrdinaryWidthUnary + +private noncomputable def paperVariableArityPhysicalOrdinaryBoundaryUnaryComputable : + BitTM + physicalOrdinaryBoundaryUnary := + fourFamilyComputedUnarySumComputable + paperVariableArityPhysicalRefinementBoundaryUnaryComputable + paperVariableArityPhysicalOrdinaryWidthUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalOrdinaryBoundaryUnary_valid + (formula : ThreeCNF) : + physicalOrdinaryBoundaryUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaOrdinaryBoundary formula) + true := by + unfold physicalOrdinaryBoundaryUnary + exact fourFamilyComputedUnarySumOutput_valid + physicalRefinementBoundaryUnary + physicalOrdinaryWidthUnary + (encodeThreeCNF formula) + (physicalFormulaRefinementBoundary formula) + ((1 + physicalFormulaTupleCount formula) * + physicalFormulaMomentCount formula * + physGridCard formula * + physDegree formula) + (paperVariableArityPhysicalRefinementBoundaryUnary_valid formula) + (paperVariableArityPhysicalOrdinaryWidthUnary_valid formula) + +/-- GapCVP reduction support. -/ +def physicalCellSourceLift + (worker : List Bool → List Bool) : List Bool → List Bool := + worker ∘ sourceExplicitAffineCellOriginalSource + +/-- GapCVP reduction support. -/ +noncomputable def physicalCellSourceLiftComputable + {worker : List Bool → List Bool} + (computer : BitTM worker) : + BitTM + (physicalCellSourceLift worker) := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable computer + +@[simp] theorem paperVariableArityPhysicalCellSourceLift_query + (worker : List Bool → List Bool) + (row column : ℕ) (formula : ThreeCNF) : + physicalCellSourceLift worker + (affineCellQuery row column + (encodeThreeCNF formula)) = + worker (encodeThreeCNF formula) := by + simp only [physicalCellSourceLift, Function.comp_apply, + sourceExplicitAffineCellOriginalSource_query] + +/-- GapCVP reduction support. -/ +def physicalCellGlobalBoundaryUnary : + List Bool → List Bool := + physicalCellSourceLift + physicalGlobalBoundaryUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalCellGlobalBoundaryUnaryComputable : + BitTM + physicalCellGlobalBoundaryUnary := + physicalCellSourceLiftComputable + paperVariableArityPhysicalGlobalBoundaryUnaryComputable + +@[simp] theorem paperVariableArityPhysicalCellGlobalBoundaryUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalCellGlobalBoundaryUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFormulaGlobalBoundary formula) true := by + unfold physicalCellGlobalBoundaryUnary + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalGlobalBoundaryUnary_valid] + +/-- GapCVP reduction support. -/ +def physicalCellRefinementBoundaryUnary : + List Bool → List Bool := + physicalCellSourceLift + physicalRefinementBoundaryUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalCellRefinementBoundaryUnaryComputable : + BitTM + physicalCellRefinementBoundaryUnary := + physicalCellSourceLiftComputable + paperVariableArityPhysicalRefinementBoundaryUnaryComputable + +@[simp] theorem paperVariableArityPhysicalCellRefinementBoundaryUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalCellRefinementBoundaryUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFormulaRefinementBoundary formula) + true := by + unfold physicalCellRefinementBoundaryUnary + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalRefinementBoundaryUnary_valid] + +/-- GapCVP reduction support. -/ +def physicalCellOrdinaryBoundaryUnary : + List Bool → List Bool := + physicalCellSourceLift + physicalOrdinaryBoundaryUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalCellOrdinaryBoundaryUnaryComputable : + BitTM + physicalCellOrdinaryBoundaryUnary := + physicalCellSourceLiftComputable + paperVariableArityPhysicalOrdinaryBoundaryUnaryComputable + +@[simp] theorem paperVariableArityPhysicalCellOrdinaryBoundaryUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalCellOrdinaryBoundaryUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFormulaOrdinaryBoundary formula) + true := by + unfold physicalCellOrdinaryBoundaryUnary + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalOrdinaryBoundaryUnary_valid] + +private def physicalRowBeforeGlobal : List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + sourceExplicitAffineCellRow + physicalCellGlobalBoundaryUnary + +private noncomputable def paperVariableArityPhysicalRowBeforeGlobalComputable : + BitTM + physicalRowBeforeGlobal := + fourFamilyComputedUnaryLessBitComputable + sourceExplicitAffineCellRowComputable + paperVariableArityPhysicalCellGlobalBoundaryUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRowBeforeGlobal_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRowBeforeGlobal + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (row < physicalFormulaGlobalBoundary formula)] := by + unfold physicalRowBeforeGlobal + exact fourFamilyComputedUnaryLessBitOutput_valid + sourceExplicitAffineCellRow + physicalCellGlobalBoundaryUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + row (physicalFormulaGlobalBoundary formula) + (sourceExplicitAffineCellRow_query row column + (encodeThreeCNF formula)) + (paperVariableArityPhysicalCellGlobalBoundaryUnary_query + row column formula) + +private def physicalRowBeforeRefinement : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + sourceExplicitAffineCellRow + physicalCellRefinementBoundaryUnary + +private noncomputable def paperVariableArityPhysicalRowBeforeRefinementComputable : + BitTM + physicalRowBeforeRefinement := + fourFamilyComputedUnaryLessBitComputable + sourceExplicitAffineCellRowComputable + paperVariableArityPhysicalCellRefinementBoundaryUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRowBeforeRefinement_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRowBeforeRefinement + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (row < physicalFormulaRefinementBoundary formula)] := by + unfold physicalRowBeforeRefinement + exact fourFamilyComputedUnaryLessBitOutput_valid + sourceExplicitAffineCellRow + physicalCellRefinementBoundaryUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + row (physicalFormulaRefinementBoundary formula) + (sourceExplicitAffineCellRow_query row column + (encodeThreeCNF formula)) + (paperVariableArityPhysicalCellRefinementBoundaryUnary_query + row column formula) + +private def physicalRowBeforeOrdinary : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + sourceExplicitAffineCellRow + physicalCellOrdinaryBoundaryUnary + +private noncomputable def paperVariableArityPhysicalRowBeforeOrdinaryComputable : + BitTM + physicalRowBeforeOrdinary := + fourFamilyComputedUnaryLessBitComputable + sourceExplicitAffineCellRowComputable + paperVariableArityPhysicalCellOrdinaryBoundaryUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRowBeforeOrdinary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRowBeforeOrdinary + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (row < physicalFormulaOrdinaryBoundary formula)] := by + unfold physicalRowBeforeOrdinary + exact fourFamilyComputedUnaryLessBitOutput_valid + sourceExplicitAffineCellRow + physicalCellOrdinaryBoundaryUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + row (physicalFormulaOrdinaryBoundary formula) + (sourceExplicitAffineCellRow_query row column + (encodeThreeCNF formula)) + (paperVariableArityPhysicalCellOrdinaryBoundaryUnary_query + row column formula) + +/-- GapCVP reduction support. -/ +abbrev physicalGlobalRowMarker : List Bool → List Bool := + physicalRowBeforeGlobal + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalGlobalRowMarkerComputable : + BitTM + physicalGlobalRowMarker := + paperVariableArityPhysicalRowBeforeGlobalComputable + +theorem paperVariableArityPhysicalGlobalRowMarker_query + (row column : ℕ) (formula : ThreeCNF) : + physicalGlobalRowMarker + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (row < physicalFormulaGlobalBoundary formula)] := + paperVariableArityPhysicalRowBeforeGlobal_query row column formula + +/-- GapCVP reduction support. -/ +def physicalRefinementRowMarker : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + physicalRowBeforeGlobal) + physicalRowBeforeRefinement + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalRefinementRowMarkerComputable : + BitTM + physicalRefinementRowMarker := + fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable + paperVariableArityPhysicalRowBeforeGlobalComputable) + paperVariableArityPhysicalRowBeforeRefinementComputable + +@[simp] theorem paperVariableArityPhysicalRefinementRowMarker_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementRowMarker + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (physicalFormulaGlobalBoundary formula ≤ row ∧ + row < physicalFormulaRefinementBoundary formula)] := by + let query := affineCellQuery row column + (encodeThreeCNF formula) + have notGlobal := fourFamilyBooleanNotOutput_bit + physicalRowBeforeGlobal query + (decide (row < physicalFormulaGlobalBoundary formula)) + (paperVariableArityPhysicalRowBeforeGlobal_query row column formula) + have both := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput + physicalRowBeforeGlobal) + physicalRowBeforeRefinement query + (!(decide + (row < physicalFormulaGlobalBoundary formula))) + (decide + (row < physicalFormulaRefinementBoundary formula)) + notGlobal + (paperVariableArityPhysicalRowBeforeRefinement_query + row column formula) + change sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + physicalRowBeforeGlobal) + physicalRowBeforeRefinement query = _ + simpa only [← decide_not, Nat.not_lt, ← Bool.decide_and] using both + +/-- GapCVP reduction support. -/ +def physicalOrdinaryRowMarker : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + physicalRowBeforeRefinement) + physicalRowBeforeOrdinary + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalOrdinaryRowMarkerComputable : + BitTM + physicalOrdinaryRowMarker := + fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable + paperVariableArityPhysicalRowBeforeRefinementComputable) + paperVariableArityPhysicalRowBeforeOrdinaryComputable + +@[simp] theorem paperVariableArityPhysicalOrdinaryRowMarker_query + (row column : ℕ) (formula : ThreeCNF) : + physicalOrdinaryRowMarker + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (physicalFormulaRefinementBoundary formula ≤ row ∧ + row < physicalFormulaOrdinaryBoundary formula)] := by + let query := affineCellQuery row column + (encodeThreeCNF formula) + have notRefinement := fourFamilyBooleanNotOutput_bit + physicalRowBeforeRefinement query + (decide + (row < physicalFormulaRefinementBoundary formula)) + (paperVariableArityPhysicalRowBeforeRefinement_query + row column formula) + have both := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput + physicalRowBeforeRefinement) + physicalRowBeforeOrdinary query + (!(decide + (row < physicalFormulaRefinementBoundary formula))) + (decide + (row < physicalFormulaOrdinaryBoundary formula)) + notRefinement + (paperVariableArityPhysicalRowBeforeOrdinary_query + row column formula) + change sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + physicalRowBeforeRefinement) + physicalRowBeforeOrdinary query = _ + simpa only [← decide_not, Nat.not_lt, ← Bool.decide_and] using both + +/-- GapCVP reduction support. -/ +def physicalShiftedRowMarker : List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + physicalRowBeforeOrdinary + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalShiftedRowMarkerComputable : + BitTM + physicalShiftedRowMarker := + fourFamilyBooleanNotOutputComputable + paperVariableArityPhysicalRowBeforeOrdinaryComputable + +@[simp] theorem paperVariableArityPhysicalShiftedRowMarker_query + (row column : ℕ) (formula : ThreeCNF) : + physicalShiftedRowMarker + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (physicalFormulaOrdinaryBoundary formula ≤ row)] := by + unfold physicalShiftedRowMarker + have negation := fourFamilyBooleanNotOutput_bit + physicalRowBeforeOrdinary + (affineCellQuery row column + (encodeThreeCNF formula)) + (decide + (row < physicalFormulaOrdinaryBoundary formula)) + (paperVariableArityPhysicalRowBeforeOrdinary_query + row column formula) + simpa only [← decide_not, Nat.not_lt] using negation + +end PhysicalFamilyMarkerTM + +namespace ShiftedTupleTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert +open GapCVP.SourceIndexedClauseLookupTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.SourcePreprocessingTM GapCVP.ClauseOffsetTM + +/-- GapCVP reduction support. -/ +def paperShiftedSourceClauseWeight (clause : ThreeClause) : ℕ := + (paperSourceNormalizedClause clause).length * + (2 ^ (paperSourceNormalizedClause clause).length - 1) + +/-- GapCVP reduction support. -/ +def paperShiftedSourceClauseWeightSum + (clauses : List ThreeClause) : ℕ := + (clauses.map paperShiftedSourceClauseWeight).sum + +/-- GapCVP reduction support. -/ +def paperShiftedClauseWeightUnary : List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + paperVariableArityClauseArityUnary + paperVariableArityClauseWeightUnary + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityShiftedClauseWeightUnaryComputable : + BitTM + paperShiftedClauseWeightUnary := + fourFamilyComputedUnaryProductComputable + paperClauseArityUnaryComputable + paperClauseWeightUnaryComputable + +@[simp] theorem paperVariableArityShiftedClauseWeightUnary_valid + (clause : ThreeClause) (suffix : List Bool) : + paperShiftedClauseWeightUnary + (encodeThreeClause clause ++ suffix) = + List.replicate + (paperShiftedSourceClauseWeight clause) true := by + unfold paperShiftedClauseWeightUnary + paperShiftedSourceClauseWeight + exact fourFamilyComputedUnaryProductOutput_valid + paperVariableArityClauseArityUnary + paperVariableArityClauseWeightUnary + (encodeThreeClause clause ++ suffix) + (paperSourceNormalizedClause clause).length + (2 ^ (paperSourceNormalizedClause clause).length - 1) + (paperVariableArityClauseArityUnary_valid clause suffix) + (paperVariableArityClauseWeightUnary_valid clause suffix) + +/-- GapCVP reduction support. -/ +abbrev paperVariableArityShiftedRetainedSourceWord : + List Bool → List Bool := + paperPreprocessingFilteredFormulaWord + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityShiftedRetainedSourceWordComputable : + BitTM + paperVariableArityShiftedRetainedSourceWord := + paperSourcePreprocessingFilteredFormulaWordComputable + +/-- GapCVP reduction support. -/ +noncomputable def paperShiftedRetainedClauseWidth : + SourceQaryMaskDynamicGridWidth where + output := paperRetainedClauseCountUnary + computer := paperVariableArityRetainedClauseCountUnaryComputable + +@[simp] theorem paperVariableArityShiftedRetainedClauseWidth_output + (input : List Bool) : + paperShiftedRetainedClauseWidth.output input = + paperRetainedClauseCountUnary input := by + rfl + +/-- GapCVP reduction support. -/ +def paperShiftedIndexedClauseQuery + (input : List Bool) : List Bool := + firstFieldContents input ++ + false :: paperVariableArityShiftedRetainedSourceWord + (firstFieldSuffix (firstFieldSuffix input)) + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityShiftedIndexedClauseQueryComputable : + BitTM + paperShiftedIndexedClauseQuery := by + have original := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable firstFieldSuffixComputable + have retained := GapCVP.TMComposition.computableInPolyTime + original paperVariableArityShiftedRetainedSourceWordComputable + have delimited := GapCVP.TMComposition.computableInPolyTime + retained (prependBitComputable false) + exact pointwiseAppendComputable + firstFieldContentsComputable delimited + +@[simp] theorem paperVariableArityShiftedIndexedClauseQuery_valid + (formula : ThreeCNF) (rank : ℕ) : + paperShiftedIndexedClauseQuery + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + paperShiftedRetainedClauseWidth + (encodeThreeCNF formula)) = + sourceOriginalIndexedClauseQuery rank + (noTautClauses formula) := by + simp only [paperShiftedIndexedClauseQuery, sourceQaryMaskDynamicGridBaseSource, + paperShiftedRetainedClauseWidth, paperVariableArityRetainedClauseCountUnary_valid, + firstFieldContents_valid, + firstFieldSuffix_valid, paperSourcePreprocessingFilteredFormulaWord_valid, + sourceOriginalIndexedClauseQuery] + +private def paperVariableArityShiftedIndexedClauseWeightUnary : + List Bool → List Bool := + paperShiftedClauseWeightUnary ∘ + sourceOriginalIndexedClauseOutput ∘ + paperShiftedIndexedClauseQuery + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedIndexedClauseWeightUnaryComputable : + BitTM + paperVariableArityShiftedIndexedClauseWeightUnary := by + have indexed := GapCVP.TMComposition.computableInPolyTime + paperVariableArityShiftedIndexedClauseQueryComputable + sourceOriginalIndexedClauseComputable + exact GapCVP.TMComposition.computableInPolyTime + indexed paperVariableArityShiftedClauseWeightUnaryComputable + +private theorem paperVariableArityShiftedIndexedClauseWeightUnary_valid + (formula : ThreeCNF) (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) : + paperVariableArityShiftedIndexedClauseWeightUnary + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + paperShiftedRetainedClauseWidth + (encodeThreeCNF formula)) = + List.replicate + (paperShiftedSourceClauseWeight + ((noTautClauses formula).get + ⟨rank, hbound⟩)) true := by + unfold paperVariableArityShiftedIndexedClauseWeightUnary + simp only [Function.comp_apply] + rw [paperVariableArityShiftedIndexedClauseQuery_valid, + sourceOriginalIndexedClauseOutput_valid rank + (noTautClauses formula) hbound] + simpa only [List.get_eq_getElem, List.append_nil] using + paperVariableArityShiftedClauseWeightUnary_valid ((noTautClauses formula).get ⟨rank, hbound⟩) + [] + +/-- GapCVP reduction support. -/ +def paperShiftedIndexedSourceClauseWeight + (clauses : List ThreeClause) (rank : ℕ) : ℕ := + match clauses[rank]? with + | some clause => paperShiftedSourceClauseWeight clause + | none => 0 + +theorem paperVariableArityShiftedSourceClauseWeight_flatMap + (clauses : List ThreeClause) : + (List.range clauses.length).flatMap + (fun rank => List.replicate + (paperShiftedIndexedSourceClauseWeight + clauses rank) true) = + List.replicate + (paperShiftedSourceClauseWeightSum clauses) true := by + induction clauses with + | nil => + simp only [List.length_nil, List.range_zero, List.flatMap_nil, + paperShiftedSourceClauseWeightSum, + List.map_nil, List.sum_nil, List.replicate_zero] + | cons clause remaining ih => + simp only [paperShiftedIndexedSourceClauseWeight, List.length_cons, List.range_succ_eq_map, + List.flatMap_cons, + lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le, getElem?_pos, List.getElem_cons_zero, + List.flatMap_map, + Nat.succ_eq_add_one, List.getElem?_cons_succ, paperShiftedSourceClauseWeightSum, + List.map_cons, List.sum_cons] + change + List.replicate + (paperShiftedSourceClauseWeight clause) true ++ + (List.range remaining.length).flatMap + (fun rank => List.replicate + (paperShiftedIndexedSourceClauseWeight + remaining rank) true) = + List.replicate + (paperShiftedSourceClauseWeight clause + + paperShiftedSourceClauseWeightSum remaining) + true + rw [ih, List.replicate_append_replicate] + +private def paperVariableArityShiftedTagCountUnary : List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + paperShiftedRetainedClauseWidth + paperVariableArityShiftedIndexedClauseWeightUnaryComputable + +private noncomputable def paperVariableArityShiftedTagCountUnaryComputable : + BitTM + paperVariableArityShiftedTagCountUnary := + maskDynamicGridRecordCatalogueComputable + paperShiftedRetainedClauseWidth + paperVariableArityShiftedIndexedClauseWeightUnaryComputable + +private theorem paperVariableArityShiftedTagCountUnary_valid + (formula : ThreeCNF) : + paperVariableArityShiftedTagCountUnary + (encodeThreeCNF formula) = + List.replicate + (paperShiftedSourceClauseWeightSum + (noTautClauses formula)) true := by + have hwidth : + paperShiftedRetainedClauseWidth.output + (encodeThreeCNF formula) = + List.replicate + (noTautClauses formula).length true := by + rw [paperVariableArityShiftedRetainedClauseWidth_output] + exact paperVariableArityRetainedClauseCountUnary_valid formula + have catalogue := maskDynamicGridRecordCatalogueOutput_valid + paperShiftedRetainedClauseWidth + paperVariableArityShiftedIndexedClauseWeightUnaryComputable + (encodeThreeCNF formula) + (noTautClauses formula).length hwidth + change maskDynamicGridRecordCatalogueOutput + paperShiftedRetainedClauseWidth + paperVariableArityShiftedIndexedClauseWeightUnaryComputable + (encodeThreeCNF formula) = _ + rw [catalogue] + rw [← paperVariableArityShiftedSourceClauseWeight_flatMap + (noTautClauses formula)] + apply List.flatMap_congr + intro rank hrank + have hbound : rank < (noTautClauses formula).length := + List.mem_range.mp hrank + rw [paperVariableArityShiftedIndexedClauseWeightUnary_valid + formula rank hbound] + simp only [paperShiftedIndexedSourceClauseWeight, + List.getElem?_eq_getElem hbound, List.get_eq_getElem] + +end ShiftedTupleTM + +namespace CanonicalOffsetIdentity + +open scoped BigOperators + +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.FormulaBridge GapCVP.ClauseOffsetTM GapCVP.ShiftedTupleTM GapCVP.SourceOrder + +theorem sourceListWeightSum + {α : Type*} (clauses : List α) (weight : α → ℕ) : + (clauses.map weight).sum = + ∑ index : Fin clauses.length, weight (clauses.get index) := by + calc + (clauses.map weight).sum = + (List.map weight (List.ofFn clauses.get)).sum := by + rw [List.ofFn_get] + _ = (List.ofFn + (fun index : Fin clauses.length => + weight (clauses.get index))).sum := by + rw [List.map_ofFn] + rfl + _ = ∑ index : Fin clauses.length, weight (clauses.get index) := + List.sum_ofFn + +/-- GapCVP reduction support. -/ +abbrev paperRetainedOriginalClauseIndexOrder + (formula : ThreeCNF) : + Fin (noTautClauses formula).length ≃ + Fin (srcFormula formula).clauses.length := by + apply finCongr + simp only [srcFormula, paperSourceNormalizedClauses, List.length_map, List.length_attach] + +theorem paperFormulaClauseWidth_retainedOriginal + (formula : ThreeCNF) + (index : Fin (noTautClauses formula).length) : + paperFormulaClauseWidth formula + (paperRetainedOriginalClauseIndexOrder + formula index) = + (paperSourceNormalizedClause + ((noTautClauses formula).get index)).length := by + simp only [paperFormulaClauseWidth, paperSourceNormalizedClauses, paperFormulaRetainedClause, + Fin.cast, + srcFormula, paperRetainedOriginalClauseIndexOrder, finCongr, List.get_eq_getElem, + List.getElem_attach, + List.getElem_map] + congr 3 + +theorem sourceClauseWeightSum_eq_localTagCount + (formula : ThreeCNF) : + sourceClauseWeightSum + (noTautClauses formula) = + paperVariableArityLocalTagCount formula := by + let retained := noTautClauses formula + let indexOrder := + paperRetainedOriginalClauseIndexOrder formula + unfold sourceClauseWeightSum + paperVariableArityLocalTagCount + calc + (retained.map sourceClauseWeight).sum = + ∑ index : Fin retained.length, + sourceClauseWeight + (retained.get index) := + sourceListWeightSum + retained sourceClauseWeight + _ = ∑ index : Fin retained.length, + (2 ^ paperFormulaClauseWidth + formula (indexOrder index) - 1) := by + apply Finset.sum_congr rfl + intro index _ + simp only [sourceClauseWeight, List.get_eq_getElem] + rw [paperFormulaClauseWidth_retainedOriginal] + rfl + _ = ∑ index : Fin + (srcFormula formula).clauses.length, + (2 ^ paperFormulaClauseWidth formula index - 1) := + indexOrder.sum_comp + (fun index => + 2 ^ paperFormulaClauseWidth formula index - 1) + +private theorem paperVariableArityShiftedSourceClauseWeightSum_eq_localWeights + (formula : ThreeCNF) : + paperShiftedSourceClauseWeightSum + (noTautClauses formula) = + ∑ index : Fin + (srcFormula formula).clauses.length, + paperFormulaClauseWidth formula index * + (2 ^ paperFormulaClauseWidth formula index - 1) := by + let retained := noTautClauses formula + let indexOrder := + paperRetainedOriginalClauseIndexOrder formula + unfold paperShiftedSourceClauseWeightSum + calc + (retained.map paperShiftedSourceClauseWeight).sum = + ∑ index : Fin retained.length, + paperShiftedSourceClauseWeight + (retained.get index) := + sourceListWeightSum + retained paperShiftedSourceClauseWeight + _ = ∑ index : Fin retained.length, + paperFormulaClauseWidth + formula (indexOrder index) * + (2 ^ paperFormulaClauseWidth + formula (indexOrder index) - 1) := by + apply Finset.sum_congr rfl + intro index _ + simp only [paperShiftedSourceClauseWeight, List.get_eq_getElem] + rw [paperFormulaClauseWidth_retainedOriginal] + rfl + _ = ∑ index : Fin + (srcFormula formula).clauses.length, + paperFormulaClauseWidth formula index * + (2 ^ paperFormulaClauseWidth + formula index - 1) := + indexOrder.sum_comp + (fun index => + paperFormulaClauseWidth formula index * + (2 ^ paperFormulaClauseWidth + formula index - 1)) + +theorem paperVariableArityShiftedFamilyTagCount_eq_sourceWeight + (formula : ThreeCNF) (momentBudget : ℕ) : + paperShiftedFamilyTagCount formula momentBudget = + paperShiftedSourceClauseWeightSum + (noTautClauses formula) * + (momentBudget + 1) := by + unfold paperShiftedFamilyTagCount + paperShiftedClauseTagCount + calc + (∑ index : Fin + (srcFormula formula).clauses.length, + (2 ^ paperFormulaClauseWidth formula index - 1) * + (paperFormulaClauseWidth formula index * + (momentBudget + 1))) = + ∑ index : Fin + (srcFormula formula).clauses.length, + (paperFormulaClauseWidth formula index * + (2 ^ paperFormulaClauseWidth + formula index - 1)) * (momentBudget + 1) := by + apply Finset.sum_congr rfl + intro index _ + ring + _ = + (∑ index : Fin + (srcFormula formula).clauses.length, + paperFormulaClauseWidth formula index * + (2 ^ paperFormulaClauseWidth + formula index - 1)) * (momentBudget + 1) := by + rw [Finset.sum_mul] + _ = paperShiftedSourceClauseWeightSum + (noTautClauses formula) * + (momentBudget + 1) := by + rw [paperVariableArityShiftedSourceClauseWeightSum_eq_localWeights] + +end CanonicalOffsetIdentity + +namespace Factor400BinaryConstructivePaperVariableArityPhysicalRowCountMachine + +open scoped BigOperators + +open Turing GapCVP.Core GapCVP.BinaryEncoding +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.BinaryExplicitAffineSystem +open GapCVP.FormulaBridge GapCVP.ClauseOffsetTM GapCVP.SourceOrder GapCVP.ShiftedTupleTM +open GapCVP.CanonicalOffsetIdentity GapCVP.PhysicalColumnOrder GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalFamilyMarkerTM + +/-- GapCVP reduction support. -/ +abbrev physicalFormulaShiftedTupleCount + (formula : ThreeCNF) : ℕ := + paperShiftedSourceClauseWeightSum + (noTautClauses formula) + +private abbrev paperVariableArityPhysicalFormulaShiftedWidth + (formula : ThreeCNF) : ℕ := + physicalFormulaShiftedTupleCount formula * + physicalFormulaMomentCount formula * + physGridCard formula * + physDegree formula + +/-- GapCVP reduction support. -/ +abbrev paperVariableArityPhysicalFormulaRowCount + (formula : ThreeCNF) : ℕ := + physicalFormulaOrdinaryBoundary formula + + paperVariableArityPhysicalFormulaShiftedWidth formula + +private abbrev physicalFormulaColumnCount + (formula : ThreeCNF) : ℕ := + (1 + physicalFormulaTupleCount formula) * + physGridCard formula * + physFieldCard formula + +private def physicalShiftedTupleCountUnary : + List Bool → List Bool := + paperVariableArityShiftedTagCountUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalShiftedTupleCountUnaryComputable : + BitTM + physicalShiftedTupleCountUnary := + paperVariableArityShiftedTagCountUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalShiftedTupleCountUnary_valid + (formula : ThreeCNF) : + physicalShiftedTupleCountUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaShiftedTupleCount formula) true := by + exact paperVariableArityShiftedTagCountUnary_valid formula + +private def physicalShiftedWidthUnary : + List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + physicalShiftedTupleCountUnary + physicalFamilyMomentCountUnary) + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldDegreeUnary + +private noncomputable def paperVariableArityPhysicalShiftedWidthUnaryComputable : + BitTM + physicalShiftedWidthUnary := + fourFamilyComputedUnaryProductComputable + (fourFamilyComputedUnaryProductComputable + (fourFamilyComputedUnaryProductComputable + paperVariableArityPhysicalShiftedTupleCountUnaryComputable + paperVariableArityPhysicalFamilyMomentCountUnaryComputable) + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable) + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalShiftedWidthUnary_valid + (formula : ThreeCNF) : + physicalShiftedWidthUnary + (encodeThreeCNF formula) = + List.replicate + (paperVariableArityPhysicalFormulaShiftedWidth formula) true := by + let input := encodeThreeCNF formula + have tagMoment := fourFamilyComputedUnaryProductOutput_valid + physicalShiftedTupleCountUnary + physicalFamilyMomentCountUnary input + (physicalFormulaShiftedTupleCount formula) + (physicalFormulaMomentCount formula) + (paperVariableArityPhysicalShiftedTupleCountUnary_valid formula) + (paperVariableArityPhysicalFamilyMomentCountUnary_valid formula) + have grid := fourFamilyComputedUnaryProductOutput_valid + (fourFamilyComputedUnaryProductOutput + physicalShiftedTupleCountUnary + physicalFamilyMomentCountUnary) + physicalFamilyGridCardinalityUnary input + (physicalFormulaShiftedTupleCount formula * + physicalFormulaMomentCount formula) + (physGridCard formula) + tagMoment + (paperVariableArityPhysicalFamilyGridCardinalityUnary_valid formula) + exact fourFamilyComputedUnaryProductOutput_valid + (fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + physicalShiftedTupleCountUnary + physicalFamilyMomentCountUnary) + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldDegreeUnary input + (physicalFormulaShiftedTupleCount formula * + physicalFormulaMomentCount formula * + physGridCard formula) + (physDegree formula) + grid + (paperVariableArityPhysicalFamilyFieldDegreeUnary_valid formula) + +/-- GapCVP reduction support. -/ +def physicalRowCountUnary : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + physicalOrdinaryBoundaryUnary + physicalShiftedWidthUnary + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalRowCountUnaryComputable : + BitTM + physicalRowCountUnary := + fourFamilyComputedUnarySumComputable + paperVariableArityPhysicalOrdinaryBoundaryUnaryComputable + paperVariableArityPhysicalShiftedWidthUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRowCountUnary_formula_valid + (formula : ThreeCNF) : + physicalRowCountUnary + (encodeThreeCNF formula) = + List.replicate + (paperVariableArityPhysicalFormulaRowCount formula) true := by + unfold physicalRowCountUnary + exact fourFamilyComputedUnarySumOutput_valid + physicalOrdinaryBoundaryUnary + physicalShiftedWidthUnary + (encodeThreeCNF formula) + (physicalFormulaOrdinaryBoundary formula) + (paperVariableArityPhysicalFormulaShiftedWidth formula) + (paperVariableArityPhysicalOrdinaryBoundaryUnary_valid formula) + (paperVariableArityPhysicalShiftedWidthUnary_valid formula) + +/-- GapCVP reduction support. -/ +def physicalColumnCountUnary : + List Bool → List Bool := + fourFamilyComputedUnaryProductOutput + (fourFamilyComputedUnaryProductOutput + physicalFamilyTypeCountUnary + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalColumnCountUnaryComputable : + BitTM + physicalColumnCountUnary := + fourFamilyComputedUnaryProductComputable + (fourFamilyComputedUnaryProductComputable + paperVariableArityPhysicalFamilyTypeCountUnaryComputable + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable) + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalColumnCountUnary_formula_valid + (formula : ThreeCNF) : + physicalColumnCountUnary + (encodeThreeCNF formula) = + List.replicate + (physicalFormulaColumnCount formula) true := by + let input := encodeThreeCNF formula + have typeGrid := fourFamilyComputedUnaryProductOutput_valid + physicalFamilyTypeCountUnary + physicalFamilyGridCardinalityUnary input + (1 + physicalFormulaTupleCount formula) + (physGridCard formula) + (paperVariableArityPhysicalFamilyTypeCountUnary_valid formula) + (paperVariableArityPhysicalFamilyGridCardinalityUnary_valid formula) + exact fourFamilyComputedUnaryProductOutput_valid + (fourFamilyComputedUnaryProductOutput + physicalFamilyTypeCountUnary + physicalFamilyGridCardinalityUnary) + physicalFamilyFieldCardinalityUnary input + ((1 + physicalFormulaTupleCount formula) * + physGridCard formula) + (physFieldCard formula) + typeGrid + (paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid formula) + +private theorem paperVariableArityPhysicalFormulaColumnCount_eq_sourceDimension + (formula : ThreeCNF) : + physicalFormulaColumnCount formula = + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + (encodeThreeCNF formula).length + (srcFormula formula) := by + symm + unfold GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + rw [GapCVP.Core.sourceSATTableDimension_eq, + sourceTableType_card, + sourceFormulaGrid_card_eq_fieldWordCount, + GapCVP.Core.sourceFiniteField_card + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)), + paperVariableAritySourceFormula_variableCount, + ← sourceClauseWeightSum_eq_localTagCount formula] + +theorem paperVariableArityPhysicalColumnCountUnary_valid + (formula : ThreeCNF) : + physicalColumnCountUnary + (encodeThreeCNF formula) = + List.replicate + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).dimension true := by + rw [paperVariableArityPhysicalColumnCountUnary_formula_valid, + paperVariableArityPhysicalFormulaColumnCount_eq_sourceDimension] + +theorem paperVariableArityExplicitBinaryRowWordCount_eq_fourFamily + (formula : ThreeCNF) : + paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula = + paperVariableArityPhysicalFormulaRowCount formula := by + classical + let length := (encodeThreeCNF formula).length + let source := srcFormula formula + let gridCount := Fintype.card + (ExplicitGridPoint length source) + let fieldCount := Fintype.card + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + length source) + let degree := physDegree formula + let momentCount := physicalFormulaMomentCount formula + have grid_valid : + gridCount = physGridCard formula := by + change Fintype.card + (ExplicitGridPoint length source) = _ + simpa [length, source, + paperVariableAritySourceFormula_variableCount] using + sourceFormulaGrid_card_eq_fieldWordCount length source + have field_valid : + fieldCount = + physFieldCard formula := by + change Fintype.card + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + length source) = _ + simpa [length, source] using + GapCVP.Core.sourceFiniteField_card + (GapCVP.Core.sourceSizeParameter_ge_one_hundred length source) + have shifted_valid : + Fintype.card + (Σ clause : Fin source.clauses.length, + Σ _tuple : + (source.clauses.get clause).SatisfyingLocalTuple, + (source.clauses.get clause).LocalVariable × + Fin (explicitMomentBudget length source + 1)) = + physicalFormulaShiftedTupleCount formula * + momentCount := by + calc + Fintype.card + (Σ clause : Fin source.clauses.length, + Σ _tuple : + (source.clauses.get clause).SatisfyingLocalTuple, + (source.clauses.get clause).LocalVariable × + Fin (explicitMomentBudget length source + 1)) = + paperShiftedFamilyTagCount + formula (explicitMomentBudget length source) := by + simpa [source] using + (Fintype.card_congr + (paperShiftedFamilyWordOrder formula + (explicitMomentBudget length source))).symm + _ = physicalFormulaShiftedTupleCount formula * + (explicitMomentBudget length source + 1) := + paperVariableArityShiftedFamilyTagCount_eq_sourceWeight + formula (explicitMomentBudget length source) + _ = physicalFormulaShiftedTupleCount formula * + momentCount := by + rfl + have table_valid : + Fintype.card (sourceSATTableType source) = + 1 + physicalFormulaTupleCount formula := by + change Fintype.card + (sourceSATTableType (srcFormula formula)) = _ + rw [sourceTableType_card, + ← sourceClauseWeightSum_eq_localTagCount formula] + calc + paperExplicitBinaryRowWordCount + length formula = + ∑ family : ExplicitConstraintFamily length source, + explicitFamilyRowCount length source family * degree := by + unfold paperExplicitBinaryRowWordCount + paperExplicitBinaryFamilyBlockCount + exact (paperExplicitFamilyWordOrder + length formula).sum_comp + (fun family => explicitFamilyRowCount + length (srcFormula formula) + family * degree) + _ = gridCount * degree + + (noTautClauses formula).length * + gridCount * fieldCount * degree + + (1 + physicalFormulaTupleCount formula) * + momentCount * gridCount * degree + + physicalFormulaShiftedTupleCount formula * + momentCount * gridCount * degree := by + simp only [Fintype.sum_sum_type, + explicitFamilyRowCount, Fintype.card_prod, + Finset.sum_const, Finset.card_univ, nsmul_eq_mul, + Fintype.card_fin] + rw [shifted_valid, table_valid] + simp [source, + gridCount, fieldCount, degree, momentCount, + explicitMomentBudget] + ring + _ = paperVariableArityPhysicalFormulaRowCount formula := by + rw [grid_valid, field_valid] + +theorem paperVariableArityPhysicalRowCountUnary_valid + (formula : ThreeCNF) : + physicalRowCountUnary + (encodeThreeCNF formula) = + List.replicate + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rowCount true := by + rw [paperVariableArityPhysicalRowCountUnary_formula_valid] + rw [paperVariableArityPhysicalWordBinarySystem_rowCount] + rw [paperVariableArityExplicitBinaryRowWordCount_eq_fourFamily] + +end Factor400BinaryConstructivePaperVariableArityPhysicalRowCountMachine + +namespace CanonicalPhysicalMatrixShape + +open Turing GapCVP.BinaryEncoding GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.FormulaBridge GapCVP.CanonicalMatrixShape GapCVP.PhysicalColumnOrder +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalRowCountMachine + +/-- GapCVP reduction support. -/ +noncomputable def paperCanonicalPhysicalMatrixShape : + PaperVariableArityCanonicalBinaryMatrixShape where + system := physicalWordBinarySystem + systemCorrect _ _ := rfl + rows := physicalRowCountUnary + columns := physicalColumnCountUnary + rowsComputable := paperVariableArityPhysicalRowCountUnaryComputable + columnsComputable := paperVariableArityPhysicalColumnCountUnaryComputable + rowsCorrect formula := + paperVariableArityPhysicalRowCountUnary_valid formula + columnsCorrect formula := + paperVariableArityPhysicalColumnCountUnary_valid formula + columnsPositive formula := + sourceFormulaDimension_pos + (encodeThreeCNF formula).length + (srcFormula formula) + +@[simp] private theorem paperVariableArityCanonicalPhysicalMatrixShape_system + (encodingLength : ℕ) (formula : ThreeCNF) : + paperCanonicalPhysicalMatrixShape.system + encodingLength formula = + physicalWordBinarySystem encodingLength formula := by + rfl + +@[simp] theorem paperVariableArityCanonicalPhysicalMatrixShape_rows_valid + (formula : ThreeCNF) : + paperCanonicalPhysicalMatrixShape.rows + (encodeThreeCNF formula) = + List.replicate + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rowCount true := by + simpa only [paperVariableArityCanonicalPhysicalMatrixShape_system] using + paperCanonicalPhysicalMatrixShape.rowsCorrect formula + +@[simp] theorem paperVariableArityCanonicalPhysicalMatrixShape_columns_valid + (formula : ThreeCNF) : + paperCanonicalPhysicalMatrixShape.columns + (encodeThreeCNF formula) = + List.replicate + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).dimension true := by + simpa only [paperVariableArityCanonicalPhysicalMatrixShape_system] using + paperCanonicalPhysicalMatrixShape.columnsCorrect formula + +/-- GapCVP reduction support. -/ +abbrev PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer := + PaperVariableArityCanonicalBinaryMatrixCellComputer + paperCanonicalPhysicalMatrixShape + +end CanonicalPhysicalMatrixShape + +namespace BinaryCompactPhysicalFieldCoefficientBitTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalCellGridWordTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryPhysicalWordRuntimeDegreeTM + +private def compactPhysicalFieldCoefficientBitQuery + (basisRank : ℕ) (coefficient source : List Bool) : List Bool := + lengthPrefixedWord (List.replicate basisRank true) ++ + (lengthPrefixedWord coefficient ++ source) + +private def compactPhysicalFieldCoefficientBitIndex : List Bool → List Bool := + firstFieldContents + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldCoefficientBitIndexComputable : + BitTM + compactPhysicalFieldCoefficientBitIndex := + firstFieldContentsComputable + +private def compactPhysicalFieldCoefficientBitSource : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldCoefficientBitSourceComputable : + BitTM + compactPhysicalFieldCoefficientBitSource := + factor400BinaryPhysicalWordRuntimeCompositionComputer + firstFieldSuffixComputable firstFieldContentsComputable + +@[simp] private theorem compactPhysicalFieldCoefficientBitIndex_query + (basisRank : ℕ) (coefficient source : List Bool) : + compactPhysicalFieldCoefficientBitIndex + (compactPhysicalFieldCoefficientBitQuery + basisRank coefficient source) = + List.replicate basisRank true := by + simp only [compactPhysicalFieldCoefficientBitIndex, compactPhysicalFieldCoefficientBitQuery, + firstFieldContents_valid] + +@[simp] private theorem compactPhysicalFieldCoefficientBitSource_query + (basisRank : ℕ) (coefficient source : List Bool) : + compactPhysicalFieldCoefficientBitSource + (compactPhysicalFieldCoefficientBitQuery + basisRank coefficient source) = coefficient := by + simp only [compactPhysicalFieldCoefficientBitSource, compactPhysicalFieldCoefficientBitQuery, + Function.comp_apply, firstFieldSuffix_valid, firstFieldContents_valid] + +private def compactPhysicalFieldCoefficientBitWord : List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + compactPhysicalFieldCoefficientBitIndex + compactPhysicalFieldCoefficientBitSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldCoefficientBitComputable : + BitTM + compactPhysicalFieldCoefficientBitWord := + fiveOriginalDynamicBitComputable + compactPhysicalFieldCoefficientBitIndexComputable + compactPhysicalFieldCoefficientBitSourceComputable + +@[simp] private theorem compactPhysicalFieldCoefficientBitWord_valid + (basisRank : ℕ) (coefficient source : List Bool) : + compactPhysicalFieldCoefficientBitWord + (compactPhysicalFieldCoefficientBitQuery + basisRank coefficient source) = + [(coefficient.drop basisRank).headD false] := by + unfold compactPhysicalFieldCoefficientBitWord + rw [fiveOriginalDynamicBitWord_valid + compactPhysicalFieldCoefficientBitIndex + compactPhysicalFieldCoefficientBitSource + (compactPhysicalFieldCoefficientBitQuery + basisRank coefficient source) + basisRank + (compactPhysicalFieldCoefficientBitIndex_query + basisRank coefficient source), + compactPhysicalFieldCoefficientBitSource_query] + +private theorem compactPhysicalFieldCoefficientFiniteWord_drop_head + {degree : ℕ} + (word : GapCVP.Core.EffectiveBinaryField.Word degree) + (basisRank : ℕ) (hrank : basisRank < degree) : + ((finiteWordBits word).drop basisRank).headD false = + word ⟨basisRank, hrank⟩ := by + exact GapCVP.BinarySourceConvolutionCorrectness.factor400BinaryFiniteWordBits_drop_head + word basisRank hrank + +private def compactPhysicalFieldCoefficientBitPreparedQuery + (basisRank coefficient source : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + lengthPrefixedWord (basisRank.output input) ++ + (lengthPrefixedWord (coefficient.output input) ++ + source.output input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldCoefficientBitPreparedQueryComputable + (basisRank coefficient source : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalFieldCoefficientBitPreparedQuery + basisRank coefficient source) := + physicalCellGridAppendComputer + (factor400BinaryPhysicalWordRuntimeCompositionComputer + basisRank.computer physicalCellGridPrefixComputer) + (physicalCellGridAppendComputer + (factor400BinaryPhysicalWordRuntimeCompositionComputer + coefficient.computer physicalCellGridPrefixComputer) + source.computer) + +private theorem compactPhysicalFieldCoefficientBitPreparedQuery_valid + (basisRank coefficient source : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (position : ℕ) + (coefficientWord originalSource : List Bool) + (hrank : basisRank.output input = + List.replicate position true) + (hcoefficient : coefficient.output input = coefficientWord) + (hsource : source.output input = originalSource) : + compactPhysicalFieldCoefficientBitPreparedQuery + basisRank coefficient source input = + compactPhysicalFieldCoefficientBitQuery + position coefficientWord originalSource := by + simp only [compactPhysicalFieldCoefficientBitPreparedQuery, + compactPhysicalFieldCoefficientBitQuery, + hrank, hcoefficient, hsource] + +/-- GapCVP reduction support. -/ +def compactPhysicalFieldCoefficientPreparedBit + (basisRank coefficient source : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + compactPhysicalFieldCoefficientBitWord ∘ + compactPhysicalFieldCoefficientBitPreparedQuery + basisRank coefficient source + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldCoefficientPreparedBitComputable + (basisRank coefficient source : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalFieldCoefficientPreparedBit + basisRank coefficient source) := + factor400BinaryPhysicalWordRuntimeCompositionComputer + (compactPhysicalFieldCoefficientBitPreparedQueryComputable + basisRank coefficient source) + compactPhysicalFieldCoefficientBitComputable + +private theorem compactPhysicalFieldCoefficientPreparedBit_valid + (basisRank coefficient source : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (position : ℕ) + (coefficientWord originalSource : List Bool) + (hrank : basisRank.output input = + List.replicate position true) + (hcoefficient : coefficient.output input = coefficientWord) + (hsource : source.output input = originalSource) : + compactPhysicalFieldCoefficientPreparedBit + basisRank coefficient source input = + [(coefficientWord.drop position).headD false] := by + unfold compactPhysicalFieldCoefficientPreparedBit + rw [Function.comp_apply, + compactPhysicalFieldCoefficientBitPreparedQuery_valid + basisRank coefficient source input position + coefficientWord originalSource hrank hcoefficient hsource, + compactPhysicalFieldCoefficientBitWord_valid] + +theorem compactPhysicalFieldCoefficientPreparedBit_bounded_valid + {degree : ℕ} + (basisRank coefficient source : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (formula : ThreeCNF) + (word : GapCVP.Core.EffectiveBinaryField.Word degree) + (position : ℕ) (hposition : position < degree) + (hrank : basisRank.output input = + List.replicate position true) + (hcoefficient : coefficient.output input = finiteWordBits word) + (hsource : source.output input = encodeThreeCNF formula) : + compactPhysicalFieldCoefficientPreparedBit + basisRank coefficient source input = + [word ⟨position, hposition⟩] := by + rw [compactPhysicalFieldCoefficientPreparedBit_valid + basisRank coefficient source input position + (finiteWordBits word) (encodeThreeCNF formula) + hrank hcoefficient hsource, + compactPhysicalFieldCoefficientFiniteWord_drop_head + word position hposition] + +private noncomputable def compactPhysicalFieldCoefficientCellSourceComputer : + SourcePhysicalLagrangeWordComputer where + output := sourceExplicitAffineCellOriginalSource + computer := factor400BinaryPhysicalWordCellOriginalSourceComputer + +@[simp] private theorem compactPhysicalFieldCoefficientCellSourceComputer_query + (row column : ℕ) (formula : ThreeCNF) : + compactPhysicalFieldCoefficientCellSourceComputer.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + encodeThreeCNF formula := by + change sourceExplicitAffineCellOriginalSource + (affineCellQuery row column + (encodeThreeCNF formula)) = encodeThreeCNF formula + exact sourceExplicitAffineCellOriginalSource_query + row column (encodeThreeCNF formula) + +/-- GapCVP reduction support. -/ +def compactPhysicalFieldCoefficientCellBit + (basisRank coefficient : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + compactPhysicalFieldCoefficientPreparedBit + basisRank coefficient compactPhysicalFieldCoefficientCellSourceComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldCoefficientCellBitComputable + (basisRank coefficient : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalFieldCoefficientCellBit basisRank coefficient) := + compactPhysicalFieldCoefficientPreparedBitComputable + basisRank coefficient compactPhysicalFieldCoefficientCellSourceComputer + +theorem compactPhysicalFieldCoefficientCellBit_valid + {degree : ℕ} + (basisRank coefficient : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (word : GapCVP.Core.EffectiveBinaryField.Word degree) + (position : ℕ) (hposition : position < degree) + (hrank : basisRank.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate position true) + (hcoefficient : coefficient.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits word) : + compactPhysicalFieldCoefficientCellBit basisRank coefficient + (affineCellQuery row column + (encodeThreeCNF formula)) = + [word ⟨position, hposition⟩] := by + unfold compactPhysicalFieldCoefficientCellBit + exact compactPhysicalFieldCoefficientPreparedBit_bounded_valid + basisRank coefficient compactPhysicalFieldCoefficientCellSourceComputer + (affineCellQuery row column + (encodeThreeCNF formula)) + formula word position hposition hrank hcoefficient + (compactPhysicalFieldCoefficientCellSourceComputer_query + row column formula) + +end BinaryCompactPhysicalFieldCoefficientBitTM + +namespace BinaryCompactPhysicalFieldBasisCoordinates + +open Polynomial GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryFieldBasis +open GapCVP.BinaryFieldInverseAlgebra + +private theorem effectiveExtensionBasis_wordElement_coordinate + (degree : ℕ) (word : Word degree) (index : Fin degree) : + (effectiveExtensionBasis degree).equivFun + (wordElement word) index = bitValue (word index) := by + change + ((AdjoinRoot.powerBasisAux' + (selectedPolynomial_monic degree)).reindex + (finCongr (selectedPolynomial_natDegree degree))).equivFun + (AdjoinRoot.mk (selectedPolynomial degree) + (wordPolynomial word)) index = _ + rw [Module.Basis.equivFun_apply, + Module.Basis.repr_reindex_apply, + AdjoinRoot.powerBasisAux'_repr_apply_to_fun, + AdjoinRoot.modByMonicHom_mk] + have hdegree : + (wordPolynomial word).degree < + (selectedPolynomial degree).degree := by + rw [Polynomial.degree_eq_natDegree + (selectedPolynomial_monic degree).ne_zero, + selectedPolynomial_natDegree] + exact wordPolynomial_degree_lt word + rw [(Polynomial.modByMonic_eq_self_iff + (selectedPolynomial_monic degree)).mpr hdegree] + exact wordPolynomial_coeff_fin word index + +theorem sourceFormulaFieldBasis_sourceWordValue_coordinate + (encodingLength : ℕ) (formula : Formula) + (word : Word + (sourceFieldExponent + (sourceSizeParameter encodingLength formula))) + (index : Fin + (sourceFieldExponent + (sourceSizeParameter encodingLength formula))) : + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + encodingLength formula).equivFun + (sourceWordValue encodingLength formula word) index = + bitValue (word index) := by + change + (effectiveFieldBasis + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula))).equivFun + (extensionAlgEquivGaloisField + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)) + (sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred encodingLength formula)) + (wordElement word)) index = _ + rw [effectiveFieldBasis_coordinates_transport] + exact effectiveExtensionBasis_wordElement_coordinate + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)) word index + +end BinaryCompactPhysicalFieldBasisCoordinates + +namespace MatrixEntrySemantics + +open scoped BigOperators + +open GapCVP.Core GapCVP.Core.EffectiveBinaryField +open GapCVP.BinaryCompactPhysicalFieldBasisCoordinates GapCVP.BinaryExplicitAffineSystem +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryOrderedRefinement GapCVP.FormulaBridge +open GapCVP.PhysicalColumnOrder GapCVP.SourceOrder GapCVP.BinaryPhysicalWordEntries +open GapCVP.BinaryReedSolomonParity GapCVP.BinarySourceRowOrder + +attribute [local instance] Classical.propDecidable + +/-- GapCVP reduction support. -/ +abbrev PaperVariableArityPhysicalWordField + (encodingLength : ℕ) (formula : ThreeCNF) := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula) + +/-- GapCVP reduction support. -/ +abbrev PaperVariableArityPhysicalWordDimension + (encodingLength : ℕ) (formula : ThreeCNF) := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaDimension + encodingLength (srcFormula formula) + +/-- GapCVP reduction support. -/ +abbrev PaperVariableArityPhysicalWordGrid + (encodingLength : ℕ) (formula : ThreeCNF) := + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + encodingLength (srcFormula formula) + +private def physicalWordBasisVector + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + Fin (PaperVariableArityPhysicalWordDimension + encodingLength formula) → + PaperVariableArityPhysicalWordField encodingLength formula := + Pi.single + (physicalColumnPermutation + encodingLength formula column) 1 + +/-- GapCVP reduction support. -/ +def physicalWordCoordinateDelta + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) + (tableType : sourceSATTableType + (srcFormula formula)) + (point : sourceSATGridPoint + (PaperVariableArityPhysicalWordGrid encodingLength formula)) + (value : PaperVariableArityPhysicalWordField + encodingLength formula) : + PaperVariableArityPhysicalWordField encodingLength formula := + if physicalCoordinateIndex + encodingLength formula tableType point value = column + then 1 else 0 + +@[simp] private theorem paperVariableArityPhysicalWordBasisVector_apply_coordinate + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) + (tableType : sourceSATTableType + (srcFormula formula)) + (point : sourceSATGridPoint + (PaperVariableArityPhysicalWordGrid encodingLength formula)) + (value : PaperVariableArityPhysicalWordField + encodingLength formula) : + physicalWordBasisVector + encodingLength formula column + (sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid encodingLength formula) + tableType point value) = + physicalWordCoordinateDelta + encodingLength formula column tableType point value := by + let permutation := + physicalColumnPermutation + encodingLength formula + let semantic := sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid encodingLength formula) + tableType point value + have index : + permutation.symm semantic = + physicalCoordinateIndex + encodingLength formula tableType point value := + paperVariableArityPhysicalColumnPermutation_symm_sourceSATColumnIndex + encodingLength formula tableType point value + have equivalent : + permutation column = semantic ↔ + physicalCoordinateIndex + encodingLength formula tableType point value = column := by + constructor + · intro equality + have inverse := congrArg permutation.symm equality + simpa only [index, Equiv.symm_apply_apply] using inverse.symm + · intro equality + apply permutation.symm.injective + simpa only [Equiv.symm_apply_apply, index] using equality.symm + simp only [physicalWordBasisVector, + physicalWordCoordinateDelta] + change Pi.single (permutation column) 1 semantic = + if physicalCoordinateIndex + encodingLength formula tableType point value = column + then 1 else 0 + by_cases physical : + physicalCoordinateIndex + encodingLength formula tableType point value = column + · have semanticEquality : semantic = permutation column := + (equivalent.mpr physical).symm + rw [semanticEquality, Pi.single_eq_same] + simp only [physical, ↓reduceIte] + · have semanticInequality : semantic ≠ permutation column := by + intro equality + exact physical (equivalent.mp equality.symm) + rw [Pi.single_eq_of_ne semanticInequality] + simp only [physical, ↓reduceIte] + +/-- GapCVP reduction support. -/ +def physicalWordFamilyFieldCoefficient + (encodingLength : ℕ) (formula : ThreeCNF) + (family : ExplicitConstraintFamily + encodingLength (srcFormula formula)) + (row : Fin + (explicitFamilyRowCount + encodingLength (srcFormula formula) family)) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + PaperVariableArityPhysicalWordField encodingLength formula := + sourceFormulaPhysicalFamilyLinearMap + encodingLength (srcFormula formula) family + (physicalWordBasisVector + encodingLength formula column) row + +@[simp] private theorem paperVariableArityPhysicalWordFamilyFieldCoefficient_eq_matrix + (encodingLength : ℕ) (formula : ThreeCNF) + (family : ExplicitConstraintFamily + encodingLength (srcFormula formula)) + (row : Fin + (explicitFamilyRowCount + encodingLength (srcFormula formula) family)) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula family row column = + sourceFormulaPhysicalFamilyFieldMatrix + encodingLength (srcFormula formula) family row + (physicalColumnPermutation + encodingLength formula column) := by + rw [sourceFormulaPhysicalFamilyFieldMatrix, + LinearMap.toMatrix'_apply] + rfl + +theorem paperVariableArityPhysicalWordGlobalFieldCoefficient + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)))) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula (.inl ()) row column = + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + physicalWordCoordinateDelta + encodingLength formula column (.inl ()) + (sourceFormulaExplicitGridOrder + encodingLength (srcFormula formula) + row) value := by + change + (∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + physicalWordBasisVector + encodingLength formula column + (sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid + encodingLength formula) (.inl ()) + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) row) + value)) = _ + apply Finset.sum_congr rfl + intro value _ + exact paperVariableArityPhysicalWordBasisVector_apply_coordinate + encodingLength formula column (.inl ()) + (sourceFormulaExplicitGridOrder + encodingLength (srcFormula formula) row) value + +theorem paperVariableArityPhysicalWordRefinementFieldCoefficient + (encodingLength : ℕ) (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) + (row : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula) × + PaperVariableArityPhysicalWordField + encodingLength formula))) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula (.inr (.inl clause)) row column = + let position := sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) row + physicalWordCoordinateDelta + encodingLength formula column + (.inl ()) position.1 position.2 - + ∑ tuple : + ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple, + physicalWordCoordinateDelta + encodingLength formula column + (.inr ⟨clause, tuple⟩) position.1 position.2 := by + dsimp only + change + physicalWordBasisVector + encodingLength formula column + (sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid + encodingLength formula) (.inl ()) + (sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) row).1 + (sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) row).2) - + ∑ tuple : + ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple, + physicalWordBasisVector + encodingLength formula column + (sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid + encodingLength formula) + (.inr ⟨clause, tuple⟩) + (sourceFormulaExplicitRefinementOrder + encodingLength + (srcFormula formula) row).1 + (sourceFormulaExplicitRefinementOrder + encodingLength + (srcFormula formula) row).2) = _ + rw [paperVariableArityPhysicalWordBasisVector_apply_coordinate] + refine congrArg (HSub.hSub _) ?_ + apply Finset.sum_congr rfl + intro tuple _ + exact paperVariableArityPhysicalWordBasisVector_apply_coordinate + encodingLength formula column (.inr ⟨clause, tuple⟩) + (sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) row).1 + (sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) row).2 + +theorem paperVariableArityPhysicalWordOrdinaryFieldCoefficient + (encodingLength : ℕ) (formula : ThreeCNF) + (tableType : sourceSATTableType + (srcFormula formula)) + (moment : Fin + (explicitMomentBudget + encodingLength (srcFormula formula) + 1)) + (row : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)))) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula + (.inr (.inr (.inl (tableType, moment)))) row column = + ∑ position : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula))), + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) index).val) + (explicitOrdinaryDegree_lt_grid encodingLength + (srcFormula formula) moment) + row position * + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + physicalWordCoordinateDelta + encodingLength formula column tableType + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) position) value * + value ^ moment.val := by + let gridOrder := sourceFormulaExplicitGridOrder + encodingLength (srcFormula formula) + let fieldVector := physicalWordBasisVector + encodingLength formula column + change + constructiveParityLinearMap + (fun index => (gridOrder index).val) + (explicitOrdinaryDegree_lt_grid encodingLength + (srcFormula formula) moment) + (fun position => + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + fieldVector + (sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid + encodingLength formula) + tableType (gridOrder position) value) * + value ^ moment.val) row = _ + rw [← LinearMap.toMatrix'_mulVec] + change + (∑ position : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula))), + constructiveParityMatrix + (fun index => (gridOrder index).val) + (explicitOrdinaryDegree_lt_grid encodingLength + (srcFormula formula) moment) + row position * + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + fieldVector + (sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid + encodingLength formula) + tableType (gridOrder position) value) * + value ^ moment.val) = _ + apply Finset.sum_congr rfl + intro position _ + refine congrArg (HMul.hMul _) ?_ + apply Finset.sum_congr rfl + intro value _ + refine congrArg (· * _) ?_ + exact paperVariableArityPhysicalWordBasisVector_apply_coordinate + encodingLength formula column tableType + (gridOrder position) value + +theorem paperVariableArityPhysicalWordShiftedFieldCoefficient + (encodingLength : ℕ) (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) + (tuple : + ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple) + (localVariable : + ((srcFormula + formula).clauses.get clause).LocalVariable) + (moment : Fin + (explicitMomentBudget + encodingLength (srcFormula formula) + 1)) + (row : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)))) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula + (.inr (.inr (.inr + ⟨clause, tuple, localVariable, moment⟩))) row column = + ∑ position : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula))), + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) index).val) + (explicitShiftedDegree_lt_grid encodingLength + (srcFormula formula) moment) + row position * + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + physicalWordCoordinateDelta + encodingLength formula column + (.inr ⟨clause, tuple⟩) + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) position) value * + ((value - + sourceSATFieldBit + (K := PaperVariableArityPhysicalWordField + encodingLength formula) + (tuple.val localVariable)) / + ((sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) position).val - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength (srcFormula formula) + localVariable.val)) ^ moment.val := by + let gridOrder := sourceFormulaExplicitGridOrder + encodingLength (srcFormula formula) + let fieldVector := physicalWordBasisVector + encodingLength formula column + change + constructiveParityLinearMap + (fun index => (gridOrder index).val) + (explicitShiftedDegree_lt_grid encodingLength + (srcFormula formula) moment) + (fun position => + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + fieldVector + (sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid + encodingLength formula) + (.inr ⟨clause, tuple⟩) (gridOrder position) value) * + ((value - + sourceSATFieldBit + (K := PaperVariableArityPhysicalWordField + encodingLength formula) + (tuple.val localVariable)) / + ((gridOrder position).val - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength (srcFormula formula) + localVariable.val)) ^ moment.val) row = _ + rw [← LinearMap.toMatrix'_mulVec] + change + (∑ position : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula))), + constructiveParityMatrix + (fun index => (gridOrder index).val) + (explicitShiftedDegree_lt_grid encodingLength + (srcFormula formula) moment) + row position * + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + fieldVector + (sourceSATColumnIndex + (srcFormula formula) + (PaperVariableArityPhysicalWordGrid + encodingLength formula) + (.inr ⟨clause, tuple⟩) (gridOrder position) value) * + ((value - + sourceSATFieldBit + (K := PaperVariableArityPhysicalWordField + encodingLength formula) + (tuple.val localVariable)) / + ((gridOrder position).val - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength (srcFormula formula) + localVariable.val)) ^ moment.val) = _ + apply Finset.sum_congr rfl + intro position _ + refine congrArg (HMul.hMul _) ?_ + apply Finset.sum_congr rfl + intro value _ + refine congrArg (· * _) ?_ + exact paperVariableArityPhysicalWordBasisVector_apply_coordinate + encodingLength formula column + (.inr ⟨clause, tuple⟩) (gridOrder position) value + +/-- GapCVP reduction support. -/ +abbrev physicalWordDecodedRow + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + encodingLength formula)) := + paperVariableArityExplicitBinaryRowWordOrder + encodingLength formula row + +theorem physicalWordBinaryCheckCoefficient + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + encodingLength formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + (physicalWordBinarySystem + encodingLength formula).check row column = + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + encodingLength (srcFormula formula)).equivFun + (physicalWordFamilyFieldCoefficient + encodingLength formula + (physicalWordDecodedRow + encodingLength formula row).1 + (physicalWordDecodedRow + encodingLength formula row).2.1 column) + (physicalWordDecodedRow + encodingLength formula row).2.2 := by + rw [paperVariableArityPhysicalWordBinarySystem_check_apply] + change + binaryFieldParityMatrix + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + encodingLength (srcFormula formula)) + (sourceFormulaPhysicalFamilyFieldMatrix + encodingLength (srcFormula formula) + (physicalWordDecodedRow + encodingLength formula row).1) + ((physicalWordDecodedRow + encodingLength formula row).2.1, + (physicalWordDecodedRow + encodingLength formula row).2.2) + (physicalColumnPermutation + encodingLength formula column) = _ + rw [binaryFieldParityMatrix_apply_basisCoordinate] + rw [← paperVariableArityPhysicalWordFamilyFieldCoefficient_eq_matrix] + +private theorem paperVariableArityPhysicalWordBinaryRightHandSideCoefficient + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + encodingLength formula)) : + (physicalWordBinarySystem + encodingLength formula).rightHandSide row = + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + encodingLength (srcFormula formula)).equivFun + (explicitFamilyTarget + encodingLength (srcFormula formula) + (physicalWordDecodedRow + encodingLength formula row).1 + (physicalWordDecodedRow + encodingLength formula row).2.1) + (physicalWordDecodedRow + encodingLength formula row).2.2 := by + rfl + +@[simp] theorem paperVariableArityPhysicalFieldBasis_one_coordinate + (encodingLength : ℕ) (formula : ThreeCNF) + (coordinate : Fin + (sourceFieldExponent + (sourceSizeParameter encodingLength + (srcFormula formula)))) : + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + encodingLength (srcFormula formula)).equivFun + 1 coordinate = bitValue (decide (coordinate.val = 0)) := by + have word := sourceFormulaFieldBasis_sourceWordValue_coordinate + encodingLength (srcFormula formula) + (oneWord (sourceFieldExponent + (sourceSizeParameter encodingLength + (srcFormula formula)))) coordinate + rw [sourceWordValue_oneWord] at word + simpa only [Module.Basis.equivFun_apply, oneWord] using word + +private theorem paperVariableArityExplicitFamilyTarget_eq + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (family : ExplicitConstraintFamily encodingLength formula) + (row : Fin (explicitFamilyRowCount + encodingLength formula family)) : + explicitFamilyTarget encodingLength formula family row = + if family = .inl () then 1 else 0 := by + cases family with + | inl value => + cases value + simp only [explicitFamilyTarget, List.get_eq_getElem, ↓reduceIte] + | inr value => + simp only [explicitFamilyTarget, List.get_eq_getElem, reduceCtorEq, ↓reduceIte] + +private theorem paperVariableArityPhysicalWordBinaryRightHandSide_global + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + encodingLength formula)) + (global : + (physicalWordDecodedRow + encodingLength formula row).1 = .inl ()) : + (physicalWordBinarySystem + encodingLength formula).rightHandSide row = + bitValue (decide + ((physicalWordDecodedRow + encodingLength formula row).2.2.val = 0)) := by + rw [paperVariableArityPhysicalWordBinaryRightHandSideCoefficient] + rw [paperVariableArityExplicitFamilyTarget_eq, + ite_eq_left global] + exact paperVariableArityPhysicalFieldBasis_one_coordinate + encodingLength formula + (physicalWordDecodedRow + encodingLength formula row).2.2 + +private theorem paperVariableArityPhysicalWordBinaryRightHandSide_nonGlobal + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + encodingLength formula)) + (nonGlobal : + (physicalWordDecodedRow + encodingLength formula row).1 ≠ .inl ()) : + (physicalWordBinarySystem + encodingLength formula).rightHandSide row = 0 := by + rw [paperVariableArityPhysicalWordBinaryRightHandSideCoefficient] + rw [paperVariableArityExplicitFamilyTarget_eq, + ite_eq_right nonGlobal] + simp only [map_zero, Pi.zero_apply] + +private theorem paperVariableArityPhysicalWordBinaryRightHandSide_eq_one_iff + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + encodingLength formula)) : + (physicalWordBinarySystem + encodingLength formula).rightHandSide row = 1 ↔ + (physicalWordDecodedRow + encodingLength formula row).1 = .inl () ∧ + (physicalWordDecodedRow + encodingLength formula row).2.2.val = 0 := by + by_cases global : + (physicalWordDecodedRow + encodingLength formula row).1 = .inl () + · rw [paperVariableArityPhysicalWordBinaryRightHandSide_global + encodingLength formula row global] + simp only [bitValue, decide_eq_true_eq, ite_eq_left_iff, zero_ne_one, imp_false, + Decidable.not_not, global, + List.get_eq_getElem, true_and] + · rw [paperVariableArityPhysicalWordBinaryRightHandSide_nonGlobal + encodingLength formula row global] + simp only [zero_ne_one, List.get_eq_getElem, global, false_and] + +end MatrixEntrySemantics + +namespace PhysicalRowOrderProjection + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.FormulaBridge +open GapCVP.SourceOrder GapCVP.PhysicalColumnOrder GapCVP.MatrixEntrySemantics + +/-- GapCVP reduction support. -/ +def physicalRowDependentFamilyIndex + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + Fin (paperExplicitFamilyTagCount + encodingLength formula) := + ((finSigmaFinEquiv + (n := paperExplicitBinaryFamilyBlockCount + encodingLength formula)).symm row).1 + +/-- GapCVP reduction support. -/ +def physicalRowDependentBlockRank + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + Fin (paperExplicitBinaryFamilyBlockCount + encodingLength formula + (physicalRowDependentFamilyIndex + encodingLength formula row)) := + ((finSigmaFinEquiv + (n := paperExplicitBinaryFamilyBlockCount + encodingLength formula)).symm row).2 + +theorem physicalRowDependentRank_eq_prefix + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + row.val = + (∑ index : Fin + (physicalRowDependentFamilyIndex + encodingLength formula row).val, + paperExplicitBinaryFamilyBlockCount + encodingLength formula + (Fin.castLE + (physicalRowDependentFamilyIndex + encodingLength formula row).isLt.le index)) + + (physicalRowDependentBlockRank + encodingLength formula row).val := by + let decomposition := + (finSigmaFinEquiv + (n := paperExplicitBinaryFamilyBlockCount + encodingLength formula)).symm row + change row.val = + (∑ index : Fin decomposition.1.val, + paperExplicitBinaryFamilyBlockCount + encodingLength formula + (Fin.castLE decomposition.1.isLt.le index)) + + decomposition.2.val + calc + row.val = (finSigmaFinEquiv decomposition).val := by + exact congrArg Fin.val + ((finSigmaFinEquiv + (n := paperExplicitBinaryFamilyBlockCount + encodingLength formula)).apply_symm_apply row).symm + _ = _ := finSigmaFinEquiv_apply decomposition + +theorem physicalRowOrder_family + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + (physicalWordDecodedRow + encodingLength formula row).1 = + paperExplicitFamilyWordOrder + encodingLength formula + (physicalRowDependentFamilyIndex + encodingLength formula row) := by + rfl + +theorem physicalRowOrder_fieldRow + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + (physicalWordDecodedRow + encodingLength formula row).2.1.val = + (physicalRowDependentBlockRank + encodingLength formula row).val / + paperExplicitBinaryRowDegree + encodingLength formula := by + rfl + +private theorem paperVariableArityPhysicalRowOrder_basis + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + (physicalWordDecodedRow + encodingLength formula row).2.2.val = + (physicalRowDependentBlockRank + encodingLength formula row).val % + paperExplicitBinaryRowDegree + encodingLength formula := by + rfl + +theorem physicalRowOrder_basis_val + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + (physicalWordDecodedRow + encodingLength formula row).2.2.val = + row.val % paperExplicitBinaryRowDegree + encodingLength formula := by + rw [paperVariableArityPhysicalRowOrder_basis] + have rank := physicalRowDependentRank_eq_prefix + encodingLength formula row + have prefixSum : + (∑ index : Fin + (physicalRowDependentFamilyIndex + encodingLength formula row).val, + paperExplicitBinaryFamilyBlockCount + encodingLength formula + (Fin.castLE + (physicalRowDependentFamilyIndex + encodingLength formula row).isLt.le index)) = + (∑ index : Fin + (physicalRowDependentFamilyIndex + encodingLength formula row).val, + explicitFamilyRowCount encodingLength + (srcFormula formula) + (paperExplicitFamilyWordOrder + encodingLength formula + (Fin.castLE + (physicalRowDependentFamilyIndex + encodingLength formula row).isLt.le index))) * + paperExplicitBinaryRowDegree + encodingLength formula := by + simp only [paperExplicitBinaryFamilyBlockCount] + rw [Finset.sum_mul] + rw [prefixSum] at rank + have residue := congrArg + (fun value : ℕ => + value % paperExplicitBinaryRowDegree + encodingLength formula) rank + simpa only [Nat.add_mod, Nat.mul_mod_left, zero_add, dvd_refl, Nat.mod_mod_of_dvd] + using residue.symm + +private theorem paperVariableArityPhysicalSigmaFamilyIndex_zero_iff + {familyCount : ℕ} + (blockCount : Fin familyCount → ℕ) + (positive : 0 < familyCount) + (row : Fin (∑ index : Fin familyCount, blockCount index)) : + ((finSigmaFinEquiv (n := blockCount)).symm row).1.val = 0 ↔ + row.val < blockCount ⟨0, positive⟩ := by + let decomposition := + (finSigmaFinEquiv (n := blockCount)).symm row + have rank : + row.val = + (∑ index : Fin decomposition.1.val, + blockCount (Fin.castLE decomposition.1.isLt.le index)) + + decomposition.2.val := by + simpa only [decomposition, Equiv.apply_symm_apply] using + finSigmaFinEquiv_apply decomposition + constructor + · intro zero + change decomposition.1.val = 0 at zero + have first : decomposition.1 = ⟨0, positive⟩ := by + apply Fin.ext + exact zero + have prefixZero : + (∑ index : Fin decomposition.1.val, + blockCount (Fin.castLE decomposition.1.isLt.le index)) = 0 := by + apply Finset.sum_eq_zero + intro index _ + exact Fin.elim0 (Fin.cast zero index) + have localEquality : row.val = decomposition.2.val := by + omega + rw [localEquality] + simpa [first] using decomposition.2.isLt + · intro bounded + by_contra nonzero + change decomposition.1.val ≠ 0 at nonzero + have indexPositive : 0 < decomposition.1.val := + Nat.pos_of_ne_zero nonzero + let first : Fin decomposition.1.val := ⟨0, indexPositive⟩ + have prefixLower : + blockCount ⟨0, positive⟩ ≤ + ∑ index : Fin decomposition.1.val, + blockCount (Fin.castLE decomposition.1.isLt.le index) := by + have term := Finset.single_le_sum + (f := fun index : Fin decomposition.1.val => + blockCount (Fin.castLE decomposition.1.isLt.le index)) + (fun _ _ => Nat.zero_le _) + (Finset.mem_univ first) + simpa [first] using term + omega + +theorem physicalFamilyTagCount_pos + (encodingLength : ℕ) (formula : ThreeCNF) : + 0 < paperExplicitFamilyTagCount + encodingLength formula := by + simp only [paperExplicitFamilyTagCount, + add_pos_iff, + Order.lt_one_iff, true_or, mul_pos_iff_of_pos_left, Order.lt_add_one_iff, zero_le, or_true, + or_self] + +theorem physicalFamilyWordOrder_zero + (encodingLength : ℕ) (formula : ThreeCNF) : + paperExplicitFamilyWordOrder + encodingLength formula + ⟨0, physicalFamilyTagCount_pos + encodingLength formula⟩ = .inl () := by + rfl + +theorem physicalFirstFamilyBlockCount + (encodingLength : ℕ) (formula : ThreeCNF) : + paperExplicitBinaryFamilyBlockCount + encodingLength formula + ⟨0, physicalFamilyTagCount_pos + encodingLength formula⟩ = + Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)) * + paperExplicitBinaryRowDegree + encodingLength formula := by + simp only [paperExplicitBinaryFamilyBlockCount, explicitFamilyRowCount, + physicalFamilyWordOrder_zero, + List.get_eq_getElem, Fintype.card_coe] + +/-- GapCVP reduction support. -/ +abbrev physicalSourceGlobalBoundary + (encodingLength : ℕ) (formula : ThreeCNF) : ℕ := + Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)) * + paperExplicitBinaryRowDegree + encodingLength formula + +theorem paperVariableArityPhysicalRowOrder_global_iff + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + (physicalWordDecodedRow + encodingLength formula row).1 = .inl () ↔ + row.val < physicalSourceGlobalBoundary + encodingLength formula := by + let positive := physicalFamilyTagCount_pos + encodingLength formula + have first := paperVariableArityPhysicalSigmaFamilyIndex_zero_iff + (paperExplicitBinaryFamilyBlockCount + encodingLength formula) positive row + constructor + · intro global + have selected : + paperExplicitFamilyWordOrder + encodingLength formula + (physicalRowDependentFamilyIndex + encodingLength formula row) = .inl () := by + exact (physicalRowOrder_family + encodingLength formula row).symm.trans global + have zero : + physicalRowDependentFamilyIndex + encodingLength formula row = ⟨0, positive⟩ := by + apply + (paperExplicitFamilyWordOrder + encodingLength formula).injective + simpa only [physicalFamilyWordOrder_zero, List.get_eq_getElem] using selected + have selectedZero : + ((finSigmaFinEquiv + (n := paperExplicitBinaryFamilyBlockCount + encodingLength formula)).symm row).1.val = 0 := by + change + (physicalRowDependentFamilyIndex + encodingLength formula row).val = 0 + exact congrArg Fin.val zero + have bounded := first.mp selectedZero + rw [physicalFirstFamilyBlockCount] at bounded + exact bounded + · intro bounded + have inFirst : + row.val < paperExplicitBinaryFamilyBlockCount + encodingLength formula ⟨0, positive⟩ := by + rw [physicalFirstFamilyBlockCount] + exact bounded + have zero := first.mpr inFirst + have selected : + physicalRowDependentFamilyIndex + encodingLength formula row = ⟨0, positive⟩ := by + apply Fin.ext + exact zero + rw [physicalRowOrder_family] + change + paperExplicitFamilyWordOrder + encodingLength formula + (physicalRowDependentFamilyIndex + encodingLength formula row) = .inl () + rw [selected] + exact physicalFamilyWordOrder_zero + encodingLength formula + +theorem physicalSourceGridCardinality_eq + (encodingLength : ℕ) (formula : ThreeCNF) : + Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)) = + 2 ^ sourceFieldExponent + (sourceSizeParameter encodingLength + (srcFormula formula)) - + paperVariableArityVariableCount formula := by + simpa only [Fintype.card_coe, paperVariableAritySourceFormula_variableCount] using + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid_card_eq_fieldWordCount + encodingLength + (srcFormula formula) + +private theorem paperVariableArityPhysicalSourceGlobalBoundary_eq + (formula : ThreeCNF) : + physicalSourceGlobalBoundary + (encodeThreeCNF formula).length formula = + (2 ^ sourceFieldExponent + (sourceSizeParameter (encodeThreeCNF formula).length + (srcFormula formula)) - + paperVariableArityVariableCount formula) * + sourceFieldExponent + (sourceSizeParameter (encodeThreeCNF formula).length + (srcFormula formula)) := by + change + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) * + sourceFieldExponent + (sourceSizeParameter (encodeThreeCNF formula).length + (srcFormula formula)) = _ + rw [physicalSourceGridCardinality_eq] + +private theorem paperVariableArityPhysicalWordBinaryRightHandSide_eq_one_iff_sourceRanks + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + encodingLength formula)) : + (physicalWordBinarySystem + encodingLength formula).rightHandSide row = 1 ↔ + row.val < physicalSourceGlobalBoundary + encodingLength formula ∧ + row.val % paperExplicitBinaryRowDegree + encodingLength formula = 0 := by + rw [paperVariableArityPhysicalWordBinaryRightHandSide_eq_one_iff] + exact and_congr + (paperVariableArityPhysicalRowOrder_global_iff + encodingLength formula row) + (by rw [physicalRowOrder_basis_val]) + +/-- GapCVP reduction support. -/ +def physicalSigmaPrefix + {familyCount : ℕ} + (blockCount : Fin familyCount → ℕ) + (family : Fin familyCount) : ℕ := + ∑ index : Fin family.val, + blockCount (Fin.castLE family.isLt.le index) + +theorem paperVariableArityPhysicalSigmaFamilyIndex_eq_iff + {familyCount : ℕ} + (blockCount : Fin familyCount → ℕ) + (row : Fin (∑ index : Fin familyCount, blockCount index)) + (family : Fin familyCount) : + ((finSigmaFinEquiv (n := blockCount)).symm row).1 = family ↔ + physicalSigmaPrefix + blockCount family ≤ row.val ∧ + row.val < physicalSigmaPrefix + blockCount family + blockCount family := by + let decomposition := + (finSigmaFinEquiv (n := blockCount)).symm row + have rank : + row.val = + physicalSigmaPrefix + blockCount decomposition.1 + decomposition.2.val := by + simpa only [physicalSigmaPrefix, + decomposition, Equiv.apply_symm_apply] using + finSigmaFinEquiv_apply decomposition + constructor + · intro selected + change decomposition.1 = family at selected + subst family + have bound := decomposition.2.isLt + omega + · rintro ⟨lower, upper⟩ + let localRank : Fin (blockCount family) := + ⟨row.val - physicalSigmaPrefix + blockCount family, by omega⟩ + have forward : + finSigmaFinEquiv (n := blockCount) + (⟨family, localRank⟩ : (index : Fin familyCount) × + Fin (blockCount index)) = row := by + apply Fin.ext + rw [finSigmaFinEquiv_apply] + change + physicalSigmaPrefix blockCount family + + (row.val - physicalSigmaPrefix + blockCount family) = row.val + omega + have decode : + (finSigmaFinEquiv (n := blockCount)).symm row = + (⟨family, localRank⟩ : (index : Fin familyCount) × + Fin (blockCount index)) := by + rw [← forward, Equiv.symm_apply_apply] + exact congrArg Sigma.fst decode + +/-- GapCVP reduction support. -/ +def physicalRefinementFamilyIndex + (encodingLength : ℕ) (formula : ThreeCNF) + (clause : Fin + (srcFormula formula).clauses.length) : + Fin (paperExplicitFamilyTagCount + encodingLength formula) := + (paperExplicitFamilyWordOrder + encodingLength formula).symm (.inr (.inl clause)) + +theorem paperVariableArityPhysicalRefinementFamilyIndex_val + (encodingLength : ℕ) (formula : ThreeCNF) + (clause : Fin + (srcFormula formula).clauses.length) : + (physicalRefinementFamilyIndex + encodingLength formula clause).val = 1 + clause.val := by + rfl + +theorem paperVariableArityPhysicalRefinementFamilyBlockCount + (encodingLength : ℕ) (formula : ThreeCNF) + (clause : Fin + (srcFormula formula).clauses.length) : + paperExplicitBinaryFamilyBlockCount + encodingLength formula + (physicalRefinementFamilyIndex + encodingLength formula clause) = + Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)) * + Fintype.card + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + encodingLength (srcFormula formula)) * + paperExplicitBinaryRowDegree + encodingLength formula := by + simp only [paperExplicitBinaryFamilyBlockCount, explicitFamilyRowCount, + physicalRefinementFamilyIndex, + List.get_eq_getElem, Equiv.apply_symm_apply, Fintype.card_prod, Fintype.card_coe] + +end PhysicalRowOrderProjection + +namespace PhysicalRightHandSideTM + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryPhysicalRowBasisDivisionTM +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.PhysicalColumnOrder +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM GapCVP.MatrixEntrySemantics +open GapCVP.PhysicalRowOrderProjection + +/-- GapCVP reduction support. -/ +def physicalRightHandSideCellDegreeUnary : + List Bool → List Bool := + physicalFamilyFieldDegreeUnary ∘ + sourceExplicitAffineCellOriginalSource + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRightHandSideCellDegreeUnaryComputable : + BitTM + physicalRightHandSideCellDegreeUnary := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +@[simp] theorem paperVariableArityPhysicalRightHandSideCellDegreeUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRightHandSideCellDegreeUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physDegree formula) true := by + unfold physicalRightHandSideCellDegreeUnary + rw [Function.comp_apply, sourceExplicitAffineCellOriginalSource_query, + paperVariableArityPhysicalFamilyFieldDegreeUnary_valid] + +private def physicalRightHandSideBasisRankUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + sourceExplicitAffineCellRow + physicalRightHandSideCellDegreeUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRightHandSideBasisRankUnaryComputable : + BitTM + physicalRightHandSideBasisRankUnary := + sourcePhysicalComputedUnaryRemainderComputable + sourceExplicitAffineCellRowComputable + paperVariableArityPhysicalRightHandSideCellDegreeUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRightHandSideBasisRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRightHandSideBasisRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (row % physDegree formula) true := by + unfold physicalRightHandSideBasisRankUnary + apply sourcePhysicalComputedUnaryRemainder_valid + sourceExplicitAffineCellRow + physicalRightHandSideCellDegreeUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + row (physDegree formula) + · exact GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)) + · exact sourceExplicitAffineCellRow_query + row column (encodeThreeCNF formula) + · exact paperVariableArityPhysicalRightHandSideCellDegreeUnary_query + row column formula + +/-- GapCVP reduction support. -/ +def physicalRightHandSideBasisZeroBit : + List Bool → List Bool := + maskComputedWordEquality + physicalRightHandSideBasisRankUnary + (fun _ => []) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRightHandSideBasisZeroBitComputable : + BitTM + physicalRightHandSideBasisZeroBit := + maskComputedWordEqualityComputable + paperVariableArityPhysicalRightHandSideBasisRankUnaryComputable + (sourceFixedWordComputable []) + +@[simp] theorem paperVariableArityPhysicalRightHandSideBasisZeroBit_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRightHandSideBasisZeroBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide (row % physDegree formula = 0)] := by + unfold physicalRightHandSideBasisZeroBit + rw [sourceQaryMaskSquareComputedWordEquality_valid, + paperVariableArityPhysicalRightHandSideBasisRankUnary_query] + simp only [List.replicate_eq_nil_iff] + +/-- GapCVP reduction support. -/ +def physicalRightHandSideBit : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + physicalGlobalRowMarker + physicalRightHandSideBasisZeroBit + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalRightHandSideBitComputable : + BitTM + physicalRightHandSideBit := + fourFamilyBooleanAndComputable + paperVariableArityPhysicalGlobalRowMarkerComputable + paperVariableArityPhysicalRightHandSideBasisZeroBitComputable + +@[simp] private theorem paperVariableArityPhysicalRightHandSideBit_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRightHandSideBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (row < physicalFormulaGlobalBoundary formula) && + decide + (row % physDegree formula = 0)] := by + unfold physicalRightHandSideBit + exact fourFamilyBooleanAndOutput_bits + physicalGlobalRowMarker + physicalRightHandSideBasisZeroBit + (affineCellQuery row column + (encodeThreeCNF formula)) + (decide + (row < physicalFormulaGlobalBoundary formula)) + (decide + (row % physDegree formula = 0)) + (paperVariableArityPhysicalGlobalRowMarker_query + row column formula) + (paperVariableArityPhysicalRightHandSideBasisZeroBit_query + row column formula) + +theorem paperVariableArityPhysicalRightHandSide_valid + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalRightHandSideBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rightHandSide row = + (1 : ZMod 2))] := by + have boundary : + physicalSourceGlobalBoundary + (encodeThreeCNF formula).length formula = + physicalFormulaGlobalBoundary formula := + paperVariableArityPhysicalSourceGlobalBoundary_eq formula + have target : + (row.val < physicalFormulaGlobalBoundary formula ∧ + row.val % physDegree formula = 0) ↔ + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rightHandSide row = + (1 : ZMod 2) := by + have ranks := paperVariableArityPhysicalWordBinaryRightHandSide_eq_one_iff_sourceRanks + (encodeThreeCNF formula).length formula row + rw [boundary] at ranks + exact ranks.symm + rw [paperVariableArityPhysicalRightHandSideBit_query, + ← Bool.decide_and] + exact congrArg (fun bit : Bool => [bit]) + (Bool.decide_congr target) + +end PhysicalRightHandSideTM + +namespace BinaryAllWordRankOrder + +open GapCVP.BinaryFieldBasis GapCVP.Core.EffectiveBinaryField + +private theorem naturalRange_double_flatMap (count : ℕ) : + List.range (2 * count) = + (List.range count).flatMap + (fun rank => [2 * rank, 2 * rank + 1]) := by + induction count with + | zero => simp only [mul_zero, List.range_zero, List.flatMap_nil] + | succ count ih => + rw [show 2 * (count + 1) = 2 * count + 2 by omega, + List.range_add] + simp only [ih, List.range_succ, List.range_zero, List.nil_append, List.cons_append, + List.map_cons, add_zero, + List.map_nil, List.flatMap_append, List.flatMap_cons, List.flatMap_nil, List.append_nil] + +private def naturalRankWord (degree rank : ℕ) : Word degree := + fun bit => rank.testBit bit.val + +private theorem naturalRankWord_even + (degree rank : ℕ) : + naturalRankWord (degree + 1) (2 * rank) = + Fin.cases false (naturalRankWord degree rank) := by + funext bit + refine Fin.cases ?_ (fun next => ?_) bit + · simp only [naturalRankWord, Fin.coe_ofNat_eq_mod, Nat.zero_mod, Nat.testBit_zero, + Nat.mul_mod_right, + zero_ne_one, decide_false, Fin.cases_zero] + · simp only [naturalRankWord, Fin.val_succ, Nat.testBit_succ, ne_eq, OfNat.ofNat_ne_zero, + not_false_eq_true, + mul_div_cancel_left₀, Fin.cases_succ] + +private theorem naturalRankWord_odd + (degree rank : ℕ) : + naturalRankWord (degree + 1) (2 * rank + 1) = + Fin.cases true (naturalRankWord degree rank) := by + funext bit + refine Fin.cases ?_ (fun next => ?_) bit + · simp only [naturalRankWord, Fin.coe_ofNat_eq_mod, Nat.zero_mod, Nat.testBit_zero, + Nat.mul_add_mod_self_left, + Nat.mod_succ, decide_true, Fin.cases_zero] + · change + (2 * rank + 1).testBit (next.val + 1) = + rank.testBit next.val + have hdivision : (2 * rank + 1) / 2 = rank := by + omega + rw [show next.val + 1 = Nat.succ next.val by omega, + Nat.testBit_succ, hdivision] + +private theorem allWords_eq_naturalRankWords (degree : ℕ) : + allWords degree = + (List.range (2 ^ degree)).map + (naturalRankWord degree) := by + induction degree with + | zero => + change [(fun bit : Fin 0 => Fin.elim0 bit)] = + [naturalRankWord 0 0] + congr 1 + exact Subsingleton.elim _ _ + | succ degree ih => + calc + allWords (degree + 1) = + ((List.range (2 ^ degree)).map + (naturalRankWord degree)).flatMap + (fun tail => + [Fin.cases false tail, Fin.cases true tail]) := by + rw [allWords, ih] + _ = (List.range (2 ^ degree)).flatMap + (fun rank => + [naturalRankWord (degree + 1) (2 * rank), + naturalRankWord (degree + 1) (2 * rank + 1)]) := by + simp only [List.flatMap_map] + apply List.flatMap_congr + intro rank _ + rw [naturalRankWord_even, naturalRankWord_odd] + _ = ((List.range (2 ^ degree)).flatMap + (fun rank => [2 * rank, 2 * rank + 1])).map + (naturalRankWord (degree + 1)) := by + simp only [List.map_flatMap, List.map_cons, List.map_nil] + _ = (List.range (2 * 2 ^ degree)).map + (naturalRankWord (degree + 1)) := by + rw [naturalRange_double_flatMap] + _ = (List.range (2 ^ (degree + 1))).map + (naturalRankWord (degree + 1)) := by + rw [pow_succ] + congr 2 + omega + +theorem allWords_eq_finRange_indexedWord (degree : ℕ) : + allWords degree = + (List.finRange (2 ^ degree)).map (indexedWord degree) := by + calc + allWords degree = + (List.range (2 ^ degree)).map + (naturalRankWord degree) := + allWords_eq_naturalRankWords degree + _ = ((List.finRange (2 ^ degree)).map + (fun rank => rank.val)).map + (naturalRankWord degree) := by + rw [List.map_coe_finRange_eq_range] + _ = (List.finRange (2 ^ degree)).map + (indexedWord degree) := by + rw [List.map_map] + rfl + +end BinaryAllWordRankOrder + +namespace BinarySelectedIrreducibleWordTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.CNFBoundedRecordFoldTM +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryFieldBasis +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalWordRuntimeDegreeTM +open GapCVP.BinarySourceConvolutionTM + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalCompositionComputer + {f g : List Bool → List Bool} + (first : BitTM f) + (second : BitTM g) : + BitTM (g ∘ f) := + GapCVP.TMComposition.computableInPolyTime first second + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalAppendComputer + {first second : List Bool → List Bool} + (firstComputer : BitTM first) + (secondComputer : BitTM second) : + BitTM + (fun input => first input ++ second input) := + pointwiseAppendComputable firstComputer secondComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalDynamicCatalogueComputer + (width : SourceQaryMaskDynamicGridWidth) + {record : List Bool → List Bool} + (computer : BitTM record) : + BitTM + (maskDynamicGridRecordCatalogueOutput width computer) := + maskDynamicGridRecordCatalogueComputable width computer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalDynamicWidth + {output : List Bool → List Bool} + (computer : BitTM output) : + SourceQaryMaskDynamicGridWidth where + output := output + computer := computer + +@[simp] theorem factor400BinaryIrreduciblePhysicalDynamicWidth_output + {output : List Bool → List Bool} + (computer : BitTM output) + (input : List Bool) : + (factor400BinaryIrreduciblePhysicalDynamicWidth computer).output input = + output input := by + unfold factor400BinaryIrreduciblePhysicalDynamicWidth + rfl + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalFalseComputer : + BitTM + (fun _ : List Bool => [false]) := + sourceFixedWordComputable [false] + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalTrueComputer : + BitTM + (fun _ : List Bool => [true]) := + sourceFixedWordComputable [true] + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalNaturalWriterComputer : + BitTM + (fun input : List Bool => Computability.encodeNat input.length) := + factor400BinaryPhysicalWordNaturalWriterComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalDropHeadComputer : + BitTM List.tail := + factor400BinaryPhysicalWordDropHeadComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalFieldContentsComputer : + BitTM + firstFieldContents := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalFieldSuffixComputer : + BitTM + firstFieldSuffix := + firstFieldSuffixComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalPrefixWriterComputer : + BitTM + lengthPrefixedWord := + structuralPrefixWriterComputable + +/-- GapCVP reduction support. -/ +def binaryIrreduciblePhysicalComputedPrefixOutput + (word : List Bool → List Bool) : List Bool → List Bool := + lengthPrefixedWord ∘ word + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalComputedPrefixComputer + {word : List Bool → List Bool} + (computer : BitTM word) : + BitTM + (binaryIrreduciblePhysicalComputedPrefixOutput word) := + factor400BinaryIrreduciblePhysicalCompositionComputer + (f := word) (g := lengthPrefixedWord) + computer factor400BinaryIrreduciblePhysicalPrefixWriterComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalSquareComputer : + BitTM + (fun input : List Bool => + List.replicate ((Polynomial.X ^ 2).eval input.length) true) := + polynomialValueUnaryComputable (Polynomial.X ^ 2) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreduciblePhysicalConvolutionComputer : + BitTM + binarySourceRawConvolutionWord := + factor400BinarySourceRawConvolutionComputable + +/-- GapCVP reduction support. -/ +def factor400BinaryIrreducibleRankUnary + (input : List Bool) : List Bool := + firstFieldContents input + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreducibleRankUnaryComputable : + BitTM + factor400BinaryIrreducibleRankUnary := + factor400BinaryIrreduciblePhysicalFieldContentsComputer + +/-- GapCVP reduction support. -/ +def binaryIrreducibleRankOriginal : + List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreducibleRankOriginalComputable : + BitTM + binaryIrreducibleRankOriginal := + factor400BinaryIrreduciblePhysicalCompositionComputer + (f := firstFieldSuffix) (g := firstFieldSuffix) + factor400BinaryIrreduciblePhysicalFieldSuffixComputer + factor400BinaryIrreduciblePhysicalFieldSuffixComputer + +theorem factor400BinaryIrreducibleRankOriginal_valid + (rank auxiliary source : List Bool) : + binaryIrreducibleRankOriginal + (lengthPrefixedWord rank ++ + lengthPrefixedWord auxiliary ++ source) = source := by + simp only [binaryIrreducibleRankOriginal, List.append_assoc, Function.comp_apply, + firstFieldSuffix_valid] + +/-- GapCVP reduction support. -/ +def binaryIrreducibleRankBinary : + List Bool → List Bool := + (fun input : List Bool => Computability.encodeNat input.length) ∘ + factor400BinaryIrreducibleRankUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreducibleRankBinaryComputable : + BitTM + binaryIrreducibleRankBinary := + factor400BinaryIrreduciblePhysicalCompositionComputer + (f := factor400BinaryIrreducibleRankUnary) + (g := fun input : List Bool => Computability.encodeNat input.length) + factor400BinaryIrreducibleRankUnaryComputable + factor400BinaryIrreduciblePhysicalNaturalWriterComputer + +/-- GapCVP reduction support. -/ +def binaryIrreducibleCoefficientOuterSource : + List Bool → List Bool := + binaryIrreducibleRankOriginal + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreducibleCoefficientOuterSourceComputable : + BitTM + binaryIrreducibleCoefficientOuterSource := + factor400BinaryIrreducibleRankOriginalComputable + +/-- GapCVP reduction support. -/ +def factor400BinaryIrreducibleCoefficientRankBinary : + List Bool → List Bool := + binaryIrreducibleRankBinary ∘ + binaryIrreducibleCoefficientOuterSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreducibleCoefficientRankBinaryComputable : + BitTM + factor400BinaryIrreducibleCoefficientRankBinary := + factor400BinaryIrreduciblePhysicalCompositionComputer + (f := binaryIrreducibleCoefficientOuterSource) + (g := binaryIrreducibleRankBinary) + factor400BinaryIrreducibleCoefficientOuterSourceComputable + factor400BinaryIrreducibleRankBinaryComputable + +/-- GapCVP reduction support. -/ +def binaryIrreducibleCoefficientBitWord : + List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord + factor400BinaryIrreducibleRankUnary + factor400BinaryIrreducibleCoefficientRankBinary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinaryIrreducibleCoefficientBitComputable : + BitTM + binaryIrreducibleCoefficientBitWord := + fiveOriginalDynamicBitComputable + factor400BinaryIrreducibleRankUnaryComputable + factor400BinaryIrreducibleCoefficientRankBinaryComputable + +private theorem factor400Irreducible_encodePosNum_eq_bits (value : PosNum) : + Computability.encodePosNum value = Nat.bits (value : ℕ) := by + induction value with + | one => rfl + | bit0 value ih => + change false :: Computability.encodePosNum value = + Nat.bits ((value : ℕ) + (value : ℕ)) + rw [← two_mul, Nat.bit0_bits] + · exact congrArg (List.cons false) ih + · exact Nat.ne_of_gt (PosNum.cast_pos value) + | bit1 value ih => + change true :: Computability.encodePosNum value = + Nat.bits ((value : ℕ) + (value : ℕ) + 1) + rw [← two_mul, Nat.bit1_bits] + exact congrArg (List.cons true) ih + +private theorem factor400Irreducible_encodeNat_eq_bits (value : ℕ) : + Computability.encodeNat value = Nat.bits value := by + change Computability.encodeNum (value : Num) = Nat.bits value + generalize hnum : (value : Num) = numeral + have hvalue : (numeral : ℕ) = value := by + rw [← hnum] + exact Num.to_of_nat value + cases numeral with + | zero => + have hz : value = 0 := by simpa only [Num.cast_zero'] using hvalue.symm + subst value + rfl + | pos positive => + change Computability.encodePosNum positive = Nat.bits value + rw [← hvalue] + exact factor400Irreducible_encodePosNum_eq_bits positive + +theorem factor400Irreducible_encodeNat_drop_head + (value index : ℕ) : + ((Computability.encodeNat value).drop index).headD false = + value.testBit index := by + rw [factor400Irreducible_encodeNat_eq_bits, + Nat.testBit_eq_inth, List.getI_eq_getElem?_getD] + simp only [List.headD_eq_head?_getD, List.head?_drop, Bool.default_bool] + +theorem factor400BinaryIrreducibleFiniteWordBits_indexedWord + (degree : ℕ) (rank : Fin (2 ^ degree)) : + finiteWordBits (indexedWord degree rank) = + (List.range degree).map + (fun bitRank => rank.val.testBit bitRank) := by + apply List.ext_getElem + · simp only [finiteWordBits, List.length_map, List.length_finRange, List.length_range] + · intro bitRank hleft hright + simp only [finiteWordBits, List.getElem_map, indexedWord, List.getElem_finRange, Fin.cast_mk, + List.getElem_range] + +/-- GapCVP reduction support. -/ +def binaryIndexedNoProperFactorsBit + (degree rank : ℕ) : Bool := + if h : rank < 2 ^ degree then + GapCVP.Core.EffectiveBinaryField.noProperFactors degree + (indexedWord degree ⟨rank, h⟩) + else + false + +/-- GapCVP reduction support. -/ +def binarySourceIrreducibleFactorPairCandidateSource : + List Bool → List Bool := + factor400BinarySourceSkipFields 2 + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinarySourceIrreducibleFactorPairCandidateSourceComputable : + BitTM + binarySourceIrreducibleFactorPairCandidateSource := + binarySourceSkipFieldsComputable 2 + +/-- GapCVP reduction support. -/ +def factor400BinarySourceIrreducibleFactorPairOriginalSource : + List Bool → List Bool := + binaryIrreducibleRankOriginal ∘ + binarySourceIrreducibleFactorPairCandidateSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + factor400BinarySourceIrreducibleFactorPairOriginalSourceComputable : + BitTM + factor400BinarySourceIrreducibleFactorPairOriginalSource := + factor400BinaryIrreduciblePhysicalCompositionComputer + factor400BinarySourceIrreducibleFactorPairCandidateSourceComputable + factor400BinaryIrreducibleRankOriginalComputable + +/-- GapCVP reduction support. -/ +def binaryIndexedIrreducibleCandidateMarkers + (degree : ℕ) : List Bool := + (List.range (2 ^ degree)).map + (binaryIndexedNoProperFactorsBit degree) + +end BinarySelectedIrreducibleWordTM + +namespace BinarySelectedIrreducibleFactorCorrectness + +open Turing GapCVP.BinaryFieldBasis +open GapCVP.BinaryAllWordRankOrder GapCVP.Core.EffectiveBinaryField + +/-- GapCVP reduction support. -/ +def binaryIndexedProperFactorPairBit + (degree : ℕ) (lower : Word degree) (rank : ℕ) : Bool := + if h : rank < (2 ^ degree) ^ 2 then + have hq : 0 < 2 ^ degree := by positivity + let first : Fin (2 ^ degree) := + ⟨rank / (2 ^ degree), by + apply (Nat.div_lt_iff_lt_mul hq).2 + simpa only [pow_two] using h⟩ + let second : Fin (2 ^ degree) := + ⟨rank % (2 ^ degree), Nat.mod_lt rank hq⟩ + decide + (multiplyWords (indexedWord degree first) + (indexedWord degree second) = monicWord lower) + else + false + +private theorem factor400BinaryIndexedWord_surjective + (degree : ℕ) (word : Word degree) : + ∃ rank : Fin (2 ^ degree), indexedWord degree rank = word := by + have hword := GapCVP.Core.EffectiveBinaryField.mem_allWords word + rw [allWords_eq_finRange_indexedWord degree] at hword + obtain ⟨rank, _, hrank⟩ := List.mem_map.mp hword + exact ⟨rank, hrank⟩ + +private theorem factor400BinaryProperFactorPairRank_lt + {degree : ℕ} + (first second : Fin (2 ^ degree)) : + first.val * 2 ^ degree + second.val < (2 ^ degree) ^ 2 := by + calc + first.val * 2 ^ degree + second.val < + first.val * 2 ^ degree + 2 ^ degree := + Nat.add_lt_add_left second.isLt _ + _ = (first.val + 1) * 2 ^ degree := by + simp only [Nat.add_mul, one_mul] + _ ≤ (2 ^ degree) * (2 ^ degree) := + Nat.mul_le_mul_right (2 ^ degree) + (Nat.succ_le_of_lt first.isLt) + _ = (2 ^ degree) ^ 2 := by + rw [pow_two] + +private theorem factor400BinaryProperFactorPairRank_div + {degree : ℕ} + (first second : Fin (2 ^ degree)) : + (first.val * 2 ^ degree + second.val) / (2 ^ degree) = first.val := by + have hq : 0 < 2 ^ degree := by positivity + rw [Nat.mul_comm first.val (2 ^ degree), + Nat.mul_add_div hq, Nat.div_eq_of_lt second.isLt] + simp only [add_zero] + +private theorem factor400BinaryProperFactorPairRank_mod + {degree : ℕ} + (first second : Fin (2 ^ degree)) : + (first.val * 2 ^ degree + second.val) % (2 ^ degree) = second.val := by + rw [Nat.mul_add_mod' first.val (2 ^ degree) second.val, + Nat.mod_eq_of_lt second.isLt] + +private theorem factor400BinaryIndexedProperFactorPairBit_rank + {degree : ℕ} (lower : Word degree) + (first second : Fin (2 ^ degree)) : + binaryIndexedProperFactorPairBit degree lower + (first.val * 2 ^ degree + second.val) = + decide + (multiplyWords + (indexedWord degree first) + (indexedWord degree second) = monicWord lower) := by + unfold binaryIndexedProperFactorPairBit + rw [dite_eq_left (factor400BinaryProperFactorPairRank_lt first second)] + dsimp + simp only [factor400BinaryProperFactorPairRank_div first second, + factor400BinaryProperFactorPairRank_mod first second, Fin.eta] + +theorem factor400BinaryIndexedProperFactorPairMarkers_find_none_iff + (degree : ℕ) (lower : Word degree) : + ((List.range ((2 ^ degree) ^ 2)).map + (binaryIndexedProperFactorPairBit degree lower)).findIdx? + id = none ↔ + ∀ first second : Word degree, + multiplyWords first second ≠ monicWord lower := by + constructor + · intro hnone first second + obtain ⟨firstRank, hfirst⟩ := + factor400BinaryIndexedWord_surjective degree first + obtain ⟨secondRank, hsecond⟩ := + factor400BinaryIndexedWord_surjective degree second + let rank := firstRank.val * 2 ^ degree + secondRank.val + have hbound : rank < (2 ^ degree) ^ 2 := + factor400BinaryProperFactorPairRank_lt firstRank secondRank + have hmember : + binaryIndexedProperFactorPairBit degree lower rank ∈ + (List.range ((2 ^ degree) ^ 2)).map + (binaryIndexedProperFactorPairBit degree lower) := + List.mem_map.mpr + ⟨rank, List.mem_range.mpr hbound, rfl⟩ + have hfalse := (List.findIdx?_eq_none_iff.mp hnone) + (binaryIndexedProperFactorPairBit degree lower rank) hmember + change + binaryIndexedProperFactorPairBit degree lower rank = false + at hfalse + dsimp [rank] at hfalse + rw [factor400BinaryIndexedProperFactorPairBit_rank] at hfalse + rw [hfirst, hsecond] at hfalse + exact of_decide_eq_false hfalse + · intro hnone + apply List.findIdx?_eq_none_iff.mpr + intro marker hmember + obtain ⟨rank, hrank, hmarker⟩ := List.mem_map.mp hmember + subst marker + have hbound : rank < (2 ^ degree) ^ 2 := + List.mem_range.mp hrank + unfold binaryIndexedProperFactorPairBit + rw [dite_eq_left hbound] + dsimp + exact decide_eq_false (hnone _ _) + +end BinarySelectedIrreducibleFactorCorrectness + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part14.lean b/LeanPool/GapCVP/Part14.lean new file mode 100644 index 000000000..d28ed91ba --- /dev/null +++ b/LeanPool/GapCVP/Part14.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part14B + +/-! # GapCVP proof, part 14 -/ diff --git a/LeanPool/GapCVP/Part14A.lean b/LeanPool/GapCVP/Part14A.lean new file mode 100644 index 000000000..7cdeca3cd --- /dev/null +++ b/LeanPool/GapCVP/Part14A.lean @@ -0,0 +1,338 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part13 + +/-! # GapCVP proof, part 14 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace BinarySelectedIrreducibleWordOrderCorrectness + +open GapCVP.BinaryAllWordRankOrder GapCVP.BinaryFieldBasis GapCVP.BinaryModularReductionTM +open GapCVP.BinarySelectedIrreducibleWordTM GapCVP.Core.EffectiveBinaryField + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem finiteWordBits_monicWord + {degree : ℕ} (hdegree : 0 < degree) + (lower : Word degree) : + finiteWordBits (monicWord lower) = + finiteWordBits lower ++ + ([true] ++ List.replicate (degree - 1) false) := by + apply List.ext_getElem + · simp only [finiteWordBits, List.length_map, List.length_finRange, List.cons_append, + List.nil_append, + List.length_append, List.length_cons, List.length_replicate] + omega + · intro index hleft hright + by_cases hlow : index < degree + · simp only [finiteWordBits, List.getElem_map, monicWord, List.getElem_finRange, Fin.cast_mk, + hlow, ↓reduceDIte, + List.cons_append, List.nil_append, List.length_map, List.length_finRange, + List.getElem_append_left] + · by_cases htop : index = degree + · subst index + simp only [finiteWordBits, List.getElem_map, monicWord, List.getElem_finRange, Fin.cast_mk, + lt_self_iff_false, + ↓reduceDIte, decide_true, List.cons_append, List.nil_append, List.length_map, + List.length_finRange, Std.le_refl, + List.getElem_append_right, tsub_self, List.getElem_cons_zero] + · have hge : degree ≤ index := Nat.le_of_not_gt hlow + have hgt : degree < index := by omega + simp only [finiteWordBits, List.getElem_map, monicWord, List.getElem_finRange, Fin.cast_mk, + hlow, ↓reduceDIte, + htop, decide_false, List.cons_append, List.nil_append, Bool.false_eq] + rw [List.getElem_append_right (by + simpa only [List.length_map, List.length_finRange] using hge)] + have hpositive : 0 < index - degree := Nat.sub_pos_of_lt hgt + cases hdifference : index - degree with + | zero => omega + | succ remaining => simp only [List.length_map, List.length_finRange, hdifference, + List.getElem_cons_succ, List.getElem_replicate] + +private theorem factor400IndexedIrreducibleCandidateMarkers_eq_finRange + (degree : ℕ) : + binaryIndexedIrreducibleCandidateMarkers degree = + (List.finRange (2 ^ degree)).map + (fun rank => noProperFactors degree + (indexedWord degree rank)) := by + unfold binaryIndexedIrreducibleCandidateMarkers + rw [← List.map_coe_finRange_eq_range, List.map_map] + apply List.map_congr_left + intro rank _ + simp only [Function.comp_apply, binaryIndexedNoProperFactorsBit, rank.isLt, ↓reduceDIte, Fin.eta] + +private theorem finRange_idxOfOption_eq_some + {count : ℕ} (rank : Fin count) : + (List.finRange count).idxOf? rank = some rank.val := by + exact GapCVP.GaussianAdaptiveEliminationCorrectness.finRange_idxOfOption_eq_some rank + +private theorem finRange_findIdxOption_of_findOption + {count : ℕ} + (predicate : Fin count → Bool) + (rank : Fin count) + (hfound : (List.finRange count).find? predicate = some rank) : + (List.finRange count).findIdx? predicate = some rank.val := by + rw [List.findIdx?_eq_bind_find?_idxOf?, hfound] + exact finRange_idxOfOption_eq_some rank + +private theorem factor400IndexedIrreducibleCandidateMarkers_findIdxOption + (degree : ℕ) + (rank : Fin (2 ^ degree)) + (hfound : + (List.finRange (2 ^ degree)).find? + (fun candidate => noProperFactors degree + (indexedWord degree candidate)) = some rank) : + (binaryIndexedIrreducibleCandidateMarkers degree).findIdx? + id = some rank.val := by + rw [factor400IndexedIrreducibleCandidateMarkers_eq_finRange, + List.findIdx?_map] + simpa only [CompTriple.comp_eq] using + finRange_findIdxOption_of_findOption + (fun candidate : Fin (2 ^ degree) => noProperFactors degree (indexedWord degree candidate)) + rank hfound + +private theorem findIrreducibleWordOption_eq_finRange_findOption + (degree : ℕ) : + findIrreducibleWordOption degree = + ((List.finRange (2 ^ degree)).find? + (fun rank => noProperFactors degree + (indexedWord degree rank))).map + (indexedWord degree) := by + unfold findIrreducibleWordOption + rw [allWords_eq_finRange_indexedWord, + List.find?_map] + rfl + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem exists_first_source_irreducible_rank + (degree : ℕ) (hdegree : 0 < degree) : + ∃ rank : Fin (2 ^ degree), + (binaryIndexedIrreducibleCandidateMarkers + degree).findIdx? id = some rank.val ∧ + indexedWord degree rank = irreducibleWord degree := by + obtain ⟨word, hword, _⟩ := + findIrreducibleWordOption_exists degree hdegree + rw [findIrreducibleWordOption_eq_finRange_findOption] at hword + cases hfound : + (List.finRange (2 ^ degree)).find? + (fun rank => noProperFactors degree + (indexedWord degree rank)) with + | none => + simp only [hfound, Option.map_none, reduceCtorEq] at hword + | some rank => + have hrank : indexedWord degree rank = word := by + simpa only [hfound, Option.map_some, Option.some.injEq] using hword + refine ⟨rank, + factor400IndexedIrreducibleCandidateMarkers_findIdxOption + degree rank hfound, ?_⟩ + unfold irreducibleWord + have horiginal : findIrreducibleWordOption degree = some word := by + rw [findIrreducibleWordOption_eq_finRange_findOption, hfound] + simp only [Option.map_some, hrank] + rw [horiginal] + exact hrank + +end BinarySelectedIrreducibleWordOrderCorrectness + +namespace Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert +open GapCVP.SourceStructuralTuringTM GapCVP.SourceMixedRadixDimensionRowMajorIndexTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.SourceMixedRadixUnaryQuotientRemainderTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.CNFCappedUnaryPairArithmeticTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM +open GapCVP.GaussianPivotScheduleTM GapCVP.GaussianRowWorker GapCVP.BinaryFieldBasis +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceFieldMultiplicationTM +open GapCVP.BinarySourceConvolutionTM GapCVP.BinarySourceConvolutionCorrectness +open GapCVP.BinarySelectedIrreducibleWordTM GapCVP.BinarySelectedIrreducibleWordOrderCorrectness +open GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM GapCVP.Core.EffectiveBinaryField + +/-- GapCVP reduction support. -/ +abbrev sourceIrreducibleFormulaDegree (formula : ThreeCNF) : ℕ := + GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length + (srcFormula formula)) + +private def sourceIrreducibleRankDegreeUnary : List Bool → List Bool := + physicalFamilyFieldDegreeUnary ∘ binaryIrreducibleRankOriginal + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleRankDegreeUnaryComputable : + BitTM + sourceIrreducibleRankDegreeUnary := + factor400BinaryIrreduciblePhysicalCompositionComputer + factor400BinaryIrreducibleRankOriginalComputable + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +private theorem paperVariableAritySourceIrreducibleRankDegreeUnary_query + (formula : ThreeCNF) (rank : ℕ) (auxiliary : List Bool) : + sourceIrreducibleRankDegreeUnary + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord auxiliary ++ encodeThreeCNF formula) = + List.replicate + (sourceIrreducibleFormulaDegree formula) true := by + unfold sourceIrreducibleRankDegreeUnary + rw [Function.comp_apply, + factor400BinaryIrreducibleRankOriginal_valid, + paperVariableArityPhysicalFamilyFieldDegreeUnary_valid] + +private noncomputable def sourceIrreducibleRankDegreeWidth : + SourceQaryMaskDynamicGridWidth := + factor400BinaryIrreduciblePhysicalDynamicWidth + paperVariableAritySourceIrreducibleRankDegreeUnaryComputable + +@[simp] private theorem paperVariableAritySourceIrreducibleRankDegreeWidth_output + (input : List Bool) : + sourceIrreducibleRankDegreeWidth.output input = + sourceIrreducibleRankDegreeUnary input := by + exact factor400BinaryIrreduciblePhysicalDynamicWidth_output + paperVariableAritySourceIrreducibleRankDegreeUnaryComputable input + +/-- Internal support shared across GapCVP continuation modules. -/ +def sourceIrreducibleRankCoefficientWord : List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + sourceIrreducibleRankDegreeWidth + factor400BinaryIrreducibleCoefficientBitComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleRankCoefficientWordComputable : + BitTM + sourceIrreducibleRankCoefficientWord := + factor400BinaryIrreduciblePhysicalDynamicCatalogueComputer + sourceIrreducibleRankDegreeWidth + factor400BinaryIrreducibleCoefficientBitComputable + +private theorem paperVariableAritySourceIrreducibleCoefficientBitWord_query + (width : SourceQaryMaskDynamicGridWidth) + (formula : ThreeCNF) (rank bitRank : ℕ) + (auxiliary : List Bool) : + binaryIrreducibleCoefficientBitWord + (lengthPrefixedWord (List.replicate bitRank true) ++ + sourceQaryMaskDynamicGridBaseSource width + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord auxiliary ++ + encodeThreeCNF formula)) = + [rank.testBit bitRank] := by + let outer := lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord auxiliary ++ encodeThreeCNF formula + let inner := lengthPrefixedWord (List.replicate bitRank true) ++ + sourceQaryMaskDynamicGridBaseSource width outer + have hbit : factor400BinaryIrreducibleRankUnary inner = + List.replicate bitRank true := by + dsimp [inner, factor400BinaryIrreducibleRankUnary] + exact firstFieldContents_valid + (List.replicate bitRank true) + (sourceQaryMaskDynamicGridBaseSource width outer) + have houter : + binaryIrreducibleCoefficientOuterSource inner = outer := by + simp only [binaryIrreducibleCoefficientOuterSource, binaryIrreducibleRankOriginal, + sourceQaryMaskDynamicGridBaseSource, Function.comp_apply, firstFieldSuffix_valid, inner] + have hrank : + binaryIrreducibleRankBinary outer = + Computability.encodeNat rank := by + simp only [binaryIrreducibleRankBinary, List.append_assoc, Function.comp_apply, + factor400BinaryIrreducibleRankUnary, firstFieldContents_valid, List.length_replicate, + outer] + change binaryIrreducibleCoefficientBitWord inner = _ + unfold binaryIrreducibleCoefficientBitWord + rw [fiveOriginalDynamicBitWord_valid + factor400BinaryIrreducibleRankUnary + factor400BinaryIrreducibleCoefficientRankBinary + inner bitRank hbit] + change + [((binaryIrreducibleRankBinary + (binaryIrreducibleCoefficientOuterSource inner)).drop + bitRank).headD false] = _ + rw [houter, hrank, factor400Irreducible_encodeNat_drop_head] + +private theorem paperVariableAritySourceIrreducibleRankCoefficientWord_query + (formula : ThreeCNF) (rank : ℕ) (auxiliary : List Bool) : + sourceIrreducibleRankCoefficientWord + (lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord auxiliary ++ encodeThreeCNF formula) = + (List.range + (sourceIrreducibleFormulaDegree formula)).map + (fun bitRank => rank.testBit bitRank) := by + let outer := lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord auxiliary ++ encodeThreeCNF formula + let degree := sourceIrreducibleFormulaDegree formula + have hdegree : + sourceIrreducibleRankDegreeWidth.output outer = + List.replicate degree true := by + rw [paperVariableAritySourceIrreducibleRankDegreeWidth_output] + exact paperVariableAritySourceIrreducibleRankDegreeUnary_query + formula rank auxiliary + change + maskDynamicGridRecordCatalogueOutput + sourceIrreducibleRankDegreeWidth + factor400BinaryIrreducibleCoefficientBitComputable outer = _ + rw [maskDynamicGridRecordCatalogueOutput_valid + sourceIrreducibleRankDegreeWidth + factor400BinaryIrreducibleCoefficientBitComputable + outer degree hdegree] + change + (List.range degree).flatMap (fun bitRank => + binaryIrreducibleCoefficientBitWord + (lengthPrefixedWord (List.replicate bitRank true) ++ + sourceQaryMaskDynamicGridBaseSource + sourceIrreducibleRankDegreeWidth outer)) = _ + simp_rw [show outer = + lengthPrefixedWord (List.replicate rank true) ++ + lengthPrefixedWord auxiliary ++ encodeThreeCNF formula from rfl, + paperVariableAritySourceIrreducibleCoefficientBitWord_query] + simpa only [degree] using + (List.map_eq_flatMap (f := fun bitRank => rank.testBit bitRank) + (l := List.range degree)).symm + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem sourceIrreducibleRankCoefficientWord_eq_indexedWord + (formula : ThreeCNF) + (rank : Fin (2 ^ sourceIrreducibleFormulaDegree formula)) + (auxiliary : List Bool) : + sourceIrreducibleRankCoefficientWord + (lengthPrefixedWord (List.replicate rank.val true) ++ + lengthPrefixedWord auxiliary ++ encodeThreeCNF formula) = + finiteWordBits + (indexedWord (sourceIrreducibleFormulaDegree formula) + rank) := by + rw [paperVariableAritySourceIrreducibleRankCoefficientWord_query, + factor400BinaryIrreducibleFiniteWordBits_indexedWord] + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def sourceIrreducibleCandidateWidth : + SourceQaryMaskDynamicGridWidth := + factor400BinaryIrreduciblePhysicalDynamicWidth + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable + +/-- Internal support shared across GapCVP continuation modules. -/ +@[simp] theorem paperVariableAritySourceIrreducibleCandidateWidth_output + (input : List Bool) : + sourceIrreducibleCandidateWidth.output input = + physicalFamilyFieldCardinalityUnary input := by + exact factor400BinaryIrreduciblePhysicalDynamicWidth_output + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable input + +end + +end Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part14B.lean b/LeanPool/GapCVP/Part14B.lean new file mode 100644 index 000000000..93fb773db --- /dev/null +++ b/LeanPool/GapCVP/Part14B.lean @@ -0,0 +1,7595 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part14A + +/-! # GapCVP proof, part 14, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert + +open GapCVP.SourceStructuralTuringTM GapCVP.SourceMixedRadixDimensionRowMajorIndexTM + +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.SourceMixedRadixUnaryQuotientRemainderTM + +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM + +open GapCVP.CNFCappedUnaryPairArithmeticTM GapCVP.CNFFiveFamilyOriginalIndexedBitTM + +open GapCVP.GaussianPivotScheduleTM GapCVP.GaussianRowWorker GapCVP.BinaryFieldBasis + +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceFieldMultiplicationTM + +open GapCVP.BinarySourceConvolutionTM GapCVP.BinarySourceConvolutionCorrectness + +open GapCVP.BinarySelectedIrreducibleWordTM GapCVP.BinarySelectedIrreducibleWordOrderCorrectness + +open GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM GapCVP.Core.EffectiveBinaryField + +private def sourceIrreducibleCandidateQuery + (input : List Bool) (rank : ℕ) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + sourceIrreducibleCandidateWidth input + +private def sourceIrreducibleCandidateCardinalityUnary : + List Bool → List Bool := + physicalFamilyFieldCardinalityUnary ∘ + binaryIrreducibleRankOriginal + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleCandidateCardinalityComputable : + BitTM + sourceIrreducibleCandidateCardinalityUnary := + factor400BinaryIrreduciblePhysicalCompositionComputer + factor400BinaryIrreducibleRankOriginalComputable + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable + +private def paperVariableAritySourceIrreducibleFactorPairWidthOutput : + List Bool → List Bool := + (fun input : List Bool => + List.replicate ((Polynomial.X ^ 2).eval input.length) true) ∘ + sourceIrreducibleCandidateCardinalityUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairWidthComputable : + BitTM + paperVariableAritySourceIrreducibleFactorPairWidthOutput := + factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceIrreducibleCandidateCardinalityComputable + factor400BinaryIrreduciblePhysicalSquareComputer + +private noncomputable def sourceIrreducibleFactorPairWidth : + SourceQaryMaskDynamicGridWidth := + factor400BinaryIrreduciblePhysicalDynamicWidth + paperVariableAritySourceIrreducibleFactorPairWidthComputable + +private abbrev sourceIrreducibleFactorPairOriginalSource : + List Bool → List Bool := + factor400BinarySourceIrreducibleFactorPairOriginalSource + +private def sourceIrreducibleFactorPairCardinalityUnary : + List Bool → List Bool := + physicalFamilyFieldCardinalityUnary ∘ + sourceIrreducibleFactorPairOriginalSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairCardinalityComputable : + BitTM + sourceIrreducibleFactorPairCardinalityUnary := + factor400BinaryIrreduciblePhysicalCompositionComputer + factor400BinarySourceIrreducibleFactorPairOriginalSourceComputable + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable + +private def sourceIrreducibleFactorPairDivisionQuery + (input : List Bool) : List Bool := + firstFieldContents input ++ false :: + (sourceIrreducibleFactorPairCardinalityUnary input ++ + false :: sourceIrreducibleFactorPairOriginalSource input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairDivisionQueryComputable : + BitTM + sourceIrreducibleFactorPairDivisionQuery := by + have hsource := factor400BinaryIrreduciblePhysicalCompositionComputer + factor400BinarySourceIrreducibleFactorPairOriginalSourceComputable + (prependBitComputable false) + have hcardinality := factor400BinaryIrreduciblePhysicalAppendComputer + paperVariableAritySourceIrreducibleFactorPairCardinalityComputable hsource + have hseparator := factor400BinaryIrreduciblePhysicalCompositionComputer + hcardinality (prependBitComputable false) + exact factor400BinaryIrreduciblePhysicalAppendComputer + firstFieldContentsComputable hseparator + +private def sourceIrreducibleFactorPairOdometer : + List Bool → List Bool := + sourceMixedRadixRowMajorPairOutput ∘ + sourceIrreducibleFactorPairDivisionQuery + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairOdometerComputable : + BitTM + sourceIrreducibleFactorPairOdometer := + factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceIrreducibleFactorPairDivisionQueryComputable + sourceMixedRadixRowMajorPairComputable + +private def sourceIrreducibleFactorPairFirstRank + (input : List Bool) : List Bool := + (unaryPrefixOutput + (sourceIrreducibleFactorPairOdometer input)).tail + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairFirstRankComputable : + BitTM + sourceIrreducibleFactorPairFirstRank := by + have hprefix := factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceIrreducibleFactorPairOdometerComputable + unaryPrefixComputable + exact factor400BinaryIrreduciblePhysicalCompositionComputer + hprefix factor400BinaryIrreduciblePhysicalDropHeadComputer + +private def sourceIrreducibleFactorPairSecondRank + (input : List Bool) : List Bool := + (unaryPrefixOutput (unaryPrefixSuffixOutput + (sourceIrreducibleFactorPairOdometer input))).tail + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairSecondRankComputable : + BitTM + sourceIrreducibleFactorPairSecondRank := by + have hsuffix := factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceIrreducibleFactorPairOdometerComputable + actualUnaryPrefixSuffixComputable + have hprefix := factor400BinaryIrreduciblePhysicalCompositionComputer + hsuffix unaryPrefixComputable + exact factor400BinaryIrreduciblePhysicalCompositionComputer + hprefix factor400BinaryIrreduciblePhysicalDropHeadComputer + +private def sourceIrreducibleFactorRankQuery + (rank : List Bool → List Bool) + (input : List Bool) : List Bool := + binaryIrreduciblePhysicalComputedPrefixOutput rank input ++ + (binaryIrreduciblePhysicalComputedPrefixOutput + sourceIrreducibleFactorPairCardinalityUnary input ++ + sourceIrreducibleFactorPairOriginalSource input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorRankQueryComputable + {rank : List Bool → List Bool} + (computer : BitTM rank) : + BitTM + (sourceIrreducibleFactorRankQuery rank) := + factor400BinaryIrreduciblePhysicalAppendComputer + (factor400BinaryIrreduciblePhysicalComputedPrefixComputer computer) + (factor400BinaryIrreduciblePhysicalAppendComputer + (factor400BinaryIrreduciblePhysicalComputedPrefixComputer + paperVariableAritySourceIrreducibleFactorPairCardinalityComputable) + factor400BinarySourceIrreducibleFactorPairOriginalSourceComputable) + +private def sourceIrreducibleFactorPairLowerWord : + List Bool → List Bool := + sourceIrreducibleRankCoefficientWord ∘ + binarySourceIrreducibleFactorPairCandidateSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairLowerWordComputable : + BitTM + sourceIrreducibleFactorPairLowerWord := + factor400BinaryIrreduciblePhysicalCompositionComputer + factor400BinarySourceIrreducibleFactorPairCandidateSourceComputable + paperVariableAritySourceIrreducibleRankCoefficientWordComputable + +private def sourceIrreducibleFactorPairFirstWord : + List Bool → List Bool := + sourceIrreducibleRankCoefficientWord ∘ + sourceIrreducibleFactorRankQuery + sourceIrreducibleFactorPairFirstRank + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairFirstWordComputable : + BitTM + sourceIrreducibleFactorPairFirstWord := + factor400BinaryIrreduciblePhysicalCompositionComputer + (paperVariableAritySourceIrreducibleFactorRankQueryComputable + paperVariableAritySourceIrreducibleFactorPairFirstRankComputable) + paperVariableAritySourceIrreducibleRankCoefficientWordComputable + +private def sourceIrreducibleFactorPairSecondWord : + List Bool → List Bool := + sourceIrreducibleRankCoefficientWord ∘ + sourceIrreducibleFactorRankQuery + sourceIrreducibleFactorPairSecondRank + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairSecondWordComputable : + BitTM + sourceIrreducibleFactorPairSecondWord := + factor400BinaryIrreduciblePhysicalCompositionComputer + (paperVariableAritySourceIrreducibleFactorRankQueryComputable + paperVariableAritySourceIrreducibleFactorPairSecondRankComputable) + paperVariableAritySourceIrreducibleRankCoefficientWordComputable + +private def sourceIrreducibleFactorPairProductQuery + (input : List Bool) : List Bool := + binaryIrreduciblePhysicalComputedPrefixOutput + sourceIrreducibleFactorPairLowerWord input ++ + (binaryIrreduciblePhysicalComputedPrefixOutput + sourceIrreducibleFactorPairFirstWord input ++ + (binaryIrreduciblePhysicalComputedPrefixOutput + sourceIrreducibleFactorPairSecondWord input ++ + sourceIrreducibleFactorPairOriginalSource input)) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairProductQueryComputable : + BitTM + sourceIrreducibleFactorPairProductQuery := + factor400BinaryIrreduciblePhysicalAppendComputer + (factor400BinaryIrreduciblePhysicalComputedPrefixComputer + paperVariableAritySourceIrreducibleFactorPairLowerWordComputable) + (factor400BinaryIrreduciblePhysicalAppendComputer + (factor400BinaryIrreduciblePhysicalComputedPrefixComputer + paperVariableAritySourceIrreducibleFactorPairFirstWordComputable) + (factor400BinaryIrreduciblePhysicalAppendComputer + (factor400BinaryIrreduciblePhysicalComputedPrefixComputer + paperVariableAritySourceIrreducibleFactorPairSecondWordComputable) + factor400BinarySourceIrreducibleFactorPairOriginalSourceComputable)) + +private def sourceIrreducibleFactorPairProductWord : + List Bool → List Bool := + binarySourceRawConvolutionWord ∘ + sourceIrreducibleFactorPairProductQuery + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairProductWordComputable : + BitTM + sourceIrreducibleFactorPairProductWord := + factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceIrreducibleFactorPairProductQueryComputable + factor400BinaryIrreduciblePhysicalConvolutionComputer + +private def sourceIrreducibleFactorPairDegreeUnary : + List Bool → List Bool := + physicalFamilyFieldDegreeUnary ∘ + sourceIrreducibleFactorPairOriginalSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairDegreeUnaryComputable : + BitTM + sourceIrreducibleFactorPairDegreeUnary := + factor400BinaryIrreduciblePhysicalCompositionComputer + factor400BinarySourceIrreducibleFactorPairOriginalSourceComputable + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +private def paperVariableAritySourceIrreducibleMonicZeroWidthOutput + (input : List Bool) : List Bool := + (sourceIrreducibleFactorPairDegreeUnary input).tail + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleMonicZeroWidthComputable : + BitTM + paperVariableAritySourceIrreducibleMonicZeroWidthOutput := + factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceIrreducibleFactorPairDegreeUnaryComputable + factor400BinaryIrreduciblePhysicalDropHeadComputer + +private noncomputable def sourceIrreducibleMonicZeroWidth : + SourceQaryMaskDynamicGridWidth := + factor400BinaryIrreduciblePhysicalDynamicWidth + paperVariableAritySourceIrreducibleMonicZeroWidthComputable + +private def sourceIrreducibleMonicZeroWord : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + sourceIrreducibleMonicZeroWidth + factor400BinaryIrreduciblePhysicalFalseComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleMonicZeroWordComputable : + BitTM + sourceIrreducibleMonicZeroWord := + factor400BinaryIrreduciblePhysicalDynamicCatalogueComputer + sourceIrreducibleMonicZeroWidth + factor400BinaryIrreduciblePhysicalFalseComputer + +private def sourceIrreducibleFactorPairMonicWord + (input : List Bool) : List Bool := + sourceIrreducibleFactorPairLowerWord input ++ + ([true] ++ sourceIrreducibleMonicZeroWord input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairMonicWordComputable : + BitTM + sourceIrreducibleFactorPairMonicWord := by + have htail := factor400BinaryIrreduciblePhysicalAppendComputer + factor400BinaryIrreduciblePhysicalTrueComputer + paperVariableAritySourceIrreducibleMonicZeroWordComputable + exact factor400BinaryIrreduciblePhysicalAppendComputer + paperVariableAritySourceIrreducibleFactorPairLowerWordComputable htail + +private def sourceIrreducibleFactorPairMarker : + List Bool → List Bool := + maskComputedWordEquality + sourceIrreducibleFactorPairProductWord + sourceIrreducibleFactorPairMonicWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairMarkerComputable : + BitTM + sourceIrreducibleFactorPairMarker := + maskComputedWordEqualityComputable + paperVariableAritySourceIrreducibleFactorPairProductWordComputable + paperVariableAritySourceIrreducibleFactorPairMonicWordComputable + +private def sourceIrreducibleFactorPairMarkerStream : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + sourceIrreducibleFactorPairWidth + paperVariableAritySourceIrreducibleFactorPairMarkerComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleFactorPairMarkerStreamComputable : + BitTM + sourceIrreducibleFactorPairMarkerStream := + factor400BinaryIrreduciblePhysicalDynamicCatalogueComputer + sourceIrreducibleFactorPairWidth + paperVariableAritySourceIrreducibleFactorPairMarkerComputable + +private def paperVariableAritySourceIrreducibleProperFactorExistsWord : + List Bool → List Bool := + binaryGaussianFirstCellWord ∘ binaryGaussianPivotWord ∘ + sourceIrreducibleFactorPairMarkerStream + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleProperFactorExistsComputable : + BitTM + paperVariableAritySourceIrreducibleProperFactorExistsWord := by + have hscan := factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceIrreducibleFactorPairMarkerStreamComputable + binaryGaussianPivotComputable + exact factor400BinaryIrreduciblePhysicalCompositionComputer + hscan binaryGaussianFirstCellComputable + +private def sourceIrreducibleNoProperFactorWord : + List Bool → List Bool := + sourceFourFamilyBooleanNotWord ∘ + paperVariableAritySourceIrreducibleProperFactorExistsWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceIrreducibleNoProperFactorComputable : + BitTM + sourceIrreducibleNoProperFactorWord := + factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceIrreducibleProperFactorExistsComputable + sourceFourFamilyBooleanNotComputable + +private def sourceActualIrreducibleCandidateMarkerStream : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + sourceIrreducibleCandidateWidth + paperVariableAritySourceIrreducibleNoProperFactorComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceActualIrreducibleCandidateMarkerStreamComputable : + BitTM + sourceActualIrreducibleCandidateMarkerStream := + factor400BinaryIrreduciblePhysicalDynamicCatalogueComputer + sourceIrreducibleCandidateWidth + paperVariableAritySourceIrreducibleNoProperFactorComputable + +private def sourceActualIrreducibleFirstCandidateWord : + List Bool → List Bool := + binaryGaussianPivotWord ∘ + sourceActualIrreducibleCandidateMarkerStream + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceActualIrreducibleFirstCandidateComputable : + BitTM + sourceActualIrreducibleFirstCandidateWord := + factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceActualIrreducibleCandidateMarkerStreamComputable + binaryGaussianPivotComputable + +private def sourceActualIrreducibleSelectedRankUnary : + List Bool → List Bool := + List.tail ∘ sourceActualIrreducibleFirstCandidateWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceActualIrreducibleSelectedRankComputable : + BitTM + sourceActualIrreducibleSelectedRankUnary := + factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceActualIrreducibleFirstCandidateComputable + factor400BinaryIrreduciblePhysicalDropHeadComputer + +private def paperVariableAritySourceActualIrreducibleSelectedRankQuery + (input : List Bool) : List Bool := + binaryIrreduciblePhysicalComputedPrefixOutput + sourceActualIrreducibleSelectedRankUnary input ++ + (binaryIrreduciblePhysicalComputedPrefixOutput + physicalFamilyFieldCardinalityUnary input ++ input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceActualIrreducibleSelectedRankQueryComputable : + BitTM + paperVariableAritySourceActualIrreducibleSelectedRankQuery := + factor400BinaryIrreduciblePhysicalAppendComputer + (factor400BinaryIrreduciblePhysicalComputedPrefixComputer + paperVariableAritySourceActualIrreducibleSelectedRankComputable) + (factor400BinaryIrreduciblePhysicalAppendComputer + (factor400BinaryIrreduciblePhysicalComputedPrefixComputer + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable) + (Turing.idComputableInPolyTime bitEncoding)) + +/-- GapCVP reduction support. -/ +def sourceSelectedIrreducibleWord : + List Bool → List Bool := + sourceIrreducibleRankCoefficientWord ∘ + paperVariableAritySourceActualIrreducibleSelectedRankQuery + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableAritySourceSelectedIrreducibleWordComputable : + BitTM + sourceSelectedIrreducibleWord := + factor400BinaryIrreduciblePhysicalCompositionComputer + paperVariableAritySourceActualIrreducibleSelectedRankQueryComputable + paperVariableAritySourceIrreducibleRankCoefficientWordComputable + +private theorem paperVariableAritySourceIrreducibleCandidateWidth_valid + (formula : ThreeCNF) : + sourceIrreducibleCandidateWidth.output + (encodeThreeCNF formula) = + List.replicate + (2 ^ sourceIrreducibleFormulaDegree formula) true := by + rw [paperVariableAritySourceIrreducibleCandidateWidth_output, + paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid] + +@[simp] private theorem paperVariableAritySourceIrreducibleCandidateOriginalSource_query + (formula : ThreeCNF) (rank : ℕ) : + binaryIrreducibleRankOriginal + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) rank) = + encodeThreeCNF formula := by + unfold sourceIrreducibleCandidateQuery + sourceQaryMaskDynamicGridBaseSource + simpa only [List.append_assoc] using + factor400BinaryIrreducibleRankOriginal_valid + (List.replicate rank true) + (sourceIrreducibleCandidateWidth.output + (encodeThreeCNF formula)) + (encodeThreeCNF formula) + +@[simp] private theorem paperVariableAritySourceIrreducibleCandidateCardinality_query + (formula : ThreeCNF) (rank : ℕ) : + sourceIrreducibleCandidateCardinalityUnary + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) rank) = + List.replicate + (2 ^ sourceIrreducibleFormulaDegree formula) true := by + unfold sourceIrreducibleCandidateCardinalityUnary + rw [Function.comp_apply, + paperVariableAritySourceIrreducibleCandidateOriginalSource_query, + paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid] + +@[simp] private theorem paperVariableAritySourceIrreducibleFactorPairWidth_valid + (formula : ThreeCNF) (rank : ℕ) : + sourceIrreducibleFactorPairWidth.output + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) rank) = + List.replicate + ((2 ^ sourceIrreducibleFormulaDegree formula) ^ 2) + true := by + unfold sourceIrreducibleFactorPairWidth + rw [factor400BinaryIrreduciblePhysicalDynamicWidth_output] + unfold paperVariableAritySourceIrreducibleFactorPairWidthOutput + rw [Function.comp_apply, + paperVariableAritySourceIrreducibleCandidateCardinality_query] + simp only [List.length_replicate, Polynomial.eval_pow, + Polynomial.eval_X] + +private def sourcePhysicalIrreducibleFactorPairQuery + (candidate : List Bool) (rank : ℕ) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + sourceIrreducibleFactorPairWidth candidate + +@[simp] private theorem paperVariableAritySourceIrreducibleFactorPairCandidateSource_query + (candidate : List Bool) (rank : ℕ) : + binarySourceIrreducibleFactorPairCandidateSource + (sourcePhysicalIrreducibleFactorPairQuery + candidate rank) = candidate := by + simp only [binarySourceIrreducibleFactorPairCandidateSource, factor400BinarySourceSkipFields, + CompTriple.comp_eq, sourcePhysicalIrreducibleFactorPairQuery, + sourceQaryMaskDynamicGridBaseSource, + Function.comp_apply, firstFieldSuffix_valid] + +@[simp] private theorem paperVariableAritySourceIrreducibleFactorPairOriginalSource_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleFactorPairOriginalSource + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + encodeThreeCNF formula := by + unfold sourceIrreducibleFactorPairOriginalSource + factor400BinarySourceIrreducibleFactorPairOriginalSource + rw [Function.comp_apply, + paperVariableAritySourceIrreducibleFactorPairCandidateSource_query, + paperVariableAritySourceIrreducibleCandidateOriginalSource_query] + +@[simp] private theorem paperVariableAritySourceIrreducibleFactorPairCardinality_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleFactorPairCardinalityUnary + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + List.replicate + (2 ^ sourceIrreducibleFormulaDegree formula) true := by + unfold sourceIrreducibleFactorPairCardinalityUnary + rw [Function.comp_apply, + paperVariableAritySourceIrreducibleFactorPairOriginalSource_query, + paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid] + +@[simp] private theorem paperVariableAritySourceIrreducibleFactorPairRank_query + (candidate : List Bool) (rank : ℕ) : + firstFieldContents + (sourcePhysicalIrreducibleFactorPairQuery + candidate rank) = List.replicate rank true := by + unfold sourcePhysicalIrreducibleFactorPairQuery + exact firstFieldContents_valid (List.replicate rank true) + (sourceQaryMaskDynamicGridBaseSource + sourceIrreducibleFactorPairWidth candidate) + +private theorem paperVariableAritySourceIrreducibleFactorPairDivisionQuery_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleFactorPairDivisionQuery + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + sourceUnaryDivisionQuery pairRank + (2 ^ sourceIrreducibleFormulaDegree formula) + (encodeThreeCNF formula) := by + unfold sourceIrreducibleFactorPairDivisionQuery + sourceUnaryDivisionQuery + rw [paperVariableAritySourceIrreducibleFactorPairRank_query, + paperVariableAritySourceIrreducibleFactorPairCardinality_query, + paperVariableAritySourceIrreducibleFactorPairOriginalSource_query] + +private theorem paperVariableAritySourceIrreducibleFactorPairOdometer_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleFactorPairOdometer + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + List.replicate + (pairRank / + (2 ^ sourceIrreducibleFormulaDegree formula)) true ++ + false :: + (List.replicate + (pairRank % + (2 ^ sourceIrreducibleFormulaDegree formula)) true ++ + false :: sourceUnaryDivisionQuery pairRank + (2 ^ sourceIrreducibleFormulaDegree formula) + (encodeThreeCNF formula)) := by + unfold sourceIrreducibleFactorPairOdometer + rw [Function.comp_apply, + paperVariableAritySourceIrreducibleFactorPairDivisionQuery_query, + sourceMixedRadixRowMajorPairOutput_valid] + positivity + +private theorem paperVariableAritySourceIrreducibleFactorPairFirstRank_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleFactorPairFirstRank + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + List.replicate + (pairRank / + (2 ^ sourceIrreducibleFormulaDegree formula)) true := by + unfold sourceIrreducibleFactorPairFirstRank + rw [paperVariableAritySourceIrreducibleFactorPairOdometer_query, + unaryPrefixOutput_replicate_delimiter] + rfl + +private theorem paperVariableAritySourceIrreducibleFactorPairSecondRank_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleFactorPairSecondRank + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + List.replicate + (pairRank % + (2 ^ sourceIrreducibleFormulaDegree formula)) true := by + unfold sourceIrreducibleFactorPairSecondRank + rw [paperVariableAritySourceIrreducibleFactorPairOdometer_query, + unaryPrefixSuffixOutput_valid, + unaryPrefixOutput_replicate_delimiter] + rfl + +private def sourceIrreducibleProperFactorFirstIndex + (degree pairRank : ℕ) + (hpair : pairRank < (2 ^ degree) ^ 2) : Fin (2 ^ degree) := + ⟨pairRank / (2 ^ degree), by + have hq : 0 < 2 ^ degree := by positivity + apply (Nat.div_lt_iff_lt_mul hq).2 + simpa only [pow_two] using hpair⟩ + +private def sourceIrreducibleProperFactorSecondIndex + (degree pairRank : ℕ) + (_hpair : pairRank < (2 ^ degree) ^ 2) : Fin (2 ^ degree) := + ⟨pairRank % (2 ^ degree), Nat.mod_lt _ (by positivity)⟩ + +private theorem paperVariableAritySourceIrreducibleFactorPairLowerWord_query + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (pairRank : ℕ) : + sourceIrreducibleFactorPairLowerWord + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) pairRank) = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + candidateRank) := by + unfold sourceIrreducibleFactorPairLowerWord + rw [Function.comp_apply, + paperVariableAritySourceIrreducibleFactorPairCandidateSource_query] + unfold sourceIrreducibleCandidateQuery + sourceQaryMaskDynamicGridBaseSource + simpa only [List.append_assoc] using + sourceIrreducibleRankCoefficientWord_eq_indexedWord + formula candidateRank + (sourceIrreducibleCandidateWidth.output + (encodeThreeCNF formula)) + +private theorem paperVariableAritySourceIrreducibleFactorPairFirstWord_query + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (pairRank : ℕ) + (hpair : pairRank < + (2 ^ sourceIrreducibleFormulaDegree formula) ^ 2) : + sourceIrreducibleFactorPairFirstWord + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) pairRank) = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (sourceIrreducibleProperFactorFirstIndex + (sourceIrreducibleFormulaDegree formula) + pairRank hpair)) := by + unfold sourceIrreducibleFactorPairFirstWord + rw [Function.comp_apply] + unfold sourceIrreducibleFactorRankQuery + binaryIrreduciblePhysicalComputedPrefixOutput + simp only [Function.comp_apply] + rw [paperVariableAritySourceIrreducibleFactorPairFirstRank_query, + paperVariableAritySourceIrreducibleFactorPairCardinality_query, + paperVariableAritySourceIrreducibleFactorPairOriginalSource_query] + simpa only [sourceIrreducibleProperFactorFirstIndex, + List.append_assoc] using + sourceIrreducibleRankCoefficientWord_eq_indexedWord + formula + (sourceIrreducibleProperFactorFirstIndex + (sourceIrreducibleFormulaDegree formula) + pairRank hpair) + (List.replicate + (2 ^ sourceIrreducibleFormulaDegree formula) true) + +private theorem paperVariableAritySourceIrreducibleFactorPairSecondWord_query + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (pairRank : ℕ) + (hpair : pairRank < + (2 ^ sourceIrreducibleFormulaDegree formula) ^ 2) : + sourceIrreducibleFactorPairSecondWord + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) pairRank) = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (sourceIrreducibleProperFactorSecondIndex + (sourceIrreducibleFormulaDegree formula) + pairRank hpair)) := by + unfold sourceIrreducibleFactorPairSecondWord + rw [Function.comp_apply] + unfold sourceIrreducibleFactorRankQuery + binaryIrreduciblePhysicalComputedPrefixOutput + simp only [Function.comp_apply] + rw [paperVariableAritySourceIrreducibleFactorPairSecondRank_query, + paperVariableAritySourceIrreducibleFactorPairCardinality_query, + paperVariableAritySourceIrreducibleFactorPairOriginalSource_query] + simpa only [sourceIrreducibleProperFactorSecondIndex, + List.append_assoc] using + sourceIrreducibleRankCoefficientWord_eq_indexedWord + formula + (sourceIrreducibleProperFactorSecondIndex + (sourceIrreducibleFormulaDegree formula) + pairRank hpair) + (List.replicate + (2 ^ sourceIrreducibleFormulaDegree formula) true) + +private theorem paperVariableAritySourceIrreducibleFactorPairProductQuery_query + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (pairRank : ℕ) + (hpair : pairRank < + (2 ^ sourceIrreducibleFormulaDegree formula) ^ 2) : + sourceIrreducibleFactorPairProductQuery + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) pairRank) = + factor400BinarySourceFieldQuery + (finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + candidateRank)) + (finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (sourceIrreducibleProperFactorFirstIndex + (sourceIrreducibleFormulaDegree formula) + pairRank hpair))) + (finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (sourceIrreducibleProperFactorSecondIndex + (sourceIrreducibleFormulaDegree formula) + pairRank hpair))) + (encodeThreeCNF formula) := by + unfold sourceIrreducibleFactorPairProductQuery + binaryIrreduciblePhysicalComputedPrefixOutput + simp only [Function.comp_apply] + rw [paperVariableAritySourceIrreducibleFactorPairLowerWord_query, + paperVariableAritySourceIrreducibleFactorPairFirstWord_query + formula candidateRank pairRank hpair, + paperVariableAritySourceIrreducibleFactorPairSecondWord_query + formula candidateRank pairRank hpair, + paperVariableAritySourceIrreducibleFactorPairOriginalSource_query] + simp only [factor400BinarySourceFieldQuery, List.append_assoc] + +private theorem paperVariableAritySourceIrreducibleFactorPairProductWord_query + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (pairRank : ℕ) + (hpair : pairRank < + (2 ^ sourceIrreducibleFormulaDegree formula) ^ 2) : + sourceIrreducibleFactorPairProductWord + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) pairRank) = + finiteWordBits + (multiplyWords + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (sourceIrreducibleProperFactorFirstIndex + (sourceIrreducibleFormulaDegree formula) + pairRank hpair)) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (sourceIrreducibleProperFactorSecondIndex + (sourceIrreducibleFormulaDegree formula) + pairRank hpair))) := by + unfold sourceIrreducibleFactorPairProductWord + rw [Function.comp_apply, + paperVariableAritySourceIrreducibleFactorPairProductQuery_query + formula candidateRank pairRank hpair, + factor400BinarySourceRawConvolutionWord_valid] + +@[simp] private theorem paperVariableAritySourceIrreducibleFactorPairDegreeUnary_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleFactorPairDegreeUnary + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + List.replicate + (sourceIrreducibleFormulaDegree formula) true := by + unfold sourceIrreducibleFactorPairDegreeUnary + rw [Function.comp_apply, + paperVariableAritySourceIrreducibleFactorPairOriginalSource_query, + paperVariableArityPhysicalFamilyFieldDegreeUnary_valid] + +@[simp] private theorem paperVariableAritySourceIrreducibleMonicZeroWidth_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleMonicZeroWidth.output + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + List.replicate + (sourceIrreducibleFormulaDegree formula - 1) true := by + unfold sourceIrreducibleMonicZeroWidth + rw [factor400BinaryIrreduciblePhysicalDynamicWidth_output] + unfold paperVariableAritySourceIrreducibleMonicZeroWidthOutput + rw [paperVariableAritySourceIrreducibleFactorPairDegreeUnary_query] + simp only [List.tail_replicate] + +private theorem paperVariableAritySourceIrreducibleMonicZeroWord_query + (formula : ThreeCNF) (candidateRank pairRank : ℕ) : + sourceIrreducibleMonicZeroWord + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) = + List.replicate + (sourceIrreducibleFormulaDegree formula - 1) false := by + unfold sourceIrreducibleMonicZeroWord + rw [maskDynamicGridRecordCatalogueOutput_valid + sourceIrreducibleMonicZeroWidth + factor400BinaryIrreduciblePhysicalFalseComputer + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank) pairRank) + (sourceIrreducibleFormulaDegree formula - 1) + (paperVariableAritySourceIrreducibleMonicZeroWidth_query + formula candidateRank pairRank)] + change + (List.range + (sourceIrreducibleFormulaDegree formula - 1)).flatMap + (fun _ => [false]) = _ + rw [← List.map_eq_flatMap] + simp only [List.map_const', List.length_range] + +private theorem paperVariableAritySourceIrreducibleFactorPairMonicWord_query + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (pairRank : ℕ) : + sourceIrreducibleFactorPairMonicWord + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) pairRank) = + finiteWordBits + (monicWord + (indexedWord + (sourceIrreducibleFormulaDegree formula) + candidateRank)) := by + unfold sourceIrreducibleFactorPairMonicWord + rw [paperVariableAritySourceIrreducibleFactorPairLowerWord_query, + paperVariableAritySourceIrreducibleMonicZeroWord_query] + symm + apply finiteWordBits_monicWord + exact GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)) + +end + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.BinaryFieldBasis +open GapCVP.BinaryModularReductionTM GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM +open GapCVP.BinarySelectedIrreducibleWordTM GapCVP.BinarySelectedIrreducibleWordOrderCorrectness +open GapCVP.BinarySelectedIrreducibleFactorCorrectness GapCVP.BinarySourceFieldMultiplicationTM +open GapCVP.GaussianPivotScheduleTM GapCVP.GaussianRowWorker GapCVP.Core.EffectiveBinaryField + +@[simp] private theorem paperVariableAritySourceFiniteWordBits_eq_iff + {degree : ℕ} (left right : Word degree) : + finiteWordBits left = finiteWordBits right ↔ left = right := by + constructor + · intro heq + have hwords := congrArg + (factor400BinarySourcePaddedWord degree) heq + simpa only [factor400BinarySourcePaddedWord_finiteWordBits] + using hwords + · intro heq + rw [heq] + +private theorem paperVariableAritySourceIrreducibleFactorPairMarker_query + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (pairRank : ℕ) + (hpair : pairRank < + (2 ^ sourceIrreducibleFormulaDegree formula) ^ 2) : + sourceIrreducibleFactorPairMarker + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) pairRank) = + [binaryIndexedProperFactorPairBit + (sourceIrreducibleFormulaDegree formula) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + candidateRank) + pairRank] := by + unfold sourceIrreducibleFactorPairMarker + rw [sourceQaryMaskSquareComputedWordEquality_valid, + paperVariableAritySourceIrreducibleFactorPairProductWord_query + formula candidateRank pairRank hpair, + paperVariableAritySourceIrreducibleFactorPairMonicWord_query + formula candidateRank pairRank] + simp only [paperVariableAritySourceFiniteWordBits_eq_iff] + simp only [sourceIrreducibleProperFactorFirstIndex, sourceIrreducibleProperFactorSecondIndex, + binaryIndexedProperFactorPairBit, hpair, ↓reduceDIte, + List.cons.injEq, and_true] + rfl + +private theorem paperVariableAritySourceIrreducibleFactorPairMarkerStream_valid + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) : + sourceIrreducibleFactorPairMarkerStream + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) = + (List.range + ((2 ^ sourceIrreducibleFormulaDegree formula) ^ 2)).map + (binaryIndexedProperFactorPairBit + (sourceIrreducibleFormulaDegree formula) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + candidateRank)) := by + unfold sourceIrreducibleFactorPairMarkerStream + rw [maskDynamicGridRecordCatalogueOutput_valid + sourceIrreducibleFactorPairWidth + paperVariableAritySourceIrreducibleFactorPairMarkerComputable + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) + ((2 ^ sourceIrreducibleFormulaDegree formula) ^ 2) + (paperVariableAritySourceIrreducibleFactorPairWidth_valid + formula candidateRank.val)] + change + (List.range + ((2 ^ sourceIrreducibleFormulaDegree formula) ^ 2)).flatMap + (fun pairRank => + sourceIrreducibleFactorPairMarker + (sourcePhysicalIrreducibleFactorPairQuery + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) pairRank)) = _ + calc + _ = (List.range + ((2 ^ sourceIrreducibleFormulaDegree formula) ^ 2)).flatMap + (fun pairRank => + [binaryIndexedProperFactorPairBit + (sourceIrreducibleFormulaDegree formula) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + candidateRank) pairRank]) := by + apply List.flatMap_congr + intro pairRank hpair + exact paperVariableAritySourceIrreducibleFactorPairMarker_query + formula candidateRank pairRank (List.mem_range.mp hpair) + _ = _ := + (List.map_eq_flatMap + (f := binaryIndexedProperFactorPairBit + (sourceIrreducibleFormulaDegree formula) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + candidateRank)) + (l := List.range + ((2 ^ sourceIrreducibleFormulaDegree formula) ^ 2))).symm + +private theorem paperVariableAritySourceIrreducibleFirstPivotMarker + (markers : List Bool) : + binaryGaussianFirstCellWord (binaryGaussianPivotWord markers) = + [decide (markers.findIdx? id ≠ none)] := by + cases hfind : markers.findIdx? id with + | none => simp only [binaryGaussianPivotWord, hfind, binaryGaussianFirstCellWord_valid, ne_eq, + not_true_eq_false, + decide_false] + | some rank => simp only [binaryGaussianPivotWord, hfind, binaryGaussianFirstCellWord_valid, + ne_eq, reduceCtorEq, + not_false_eq_true, decide_true] + +private theorem paperVariableAritySourceIrreducibleNoProperFactorWord_valid + (formula : ThreeCNF) + (candidateRank : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) : + sourceIrreducibleNoProperFactorWord + (sourceIrreducibleCandidateQuery + (encodeThreeCNF formula) candidateRank.val) = + [noProperFactors + (sourceIrreducibleFormulaDegree formula) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + candidateRank)] := by + let degree := sourceIrreducibleFormulaDegree formula + let lower := indexedWord degree candidateRank + let markers := + (List.range ((2 ^ degree) ^ 2)).map + (binaryIndexedProperFactorPairBit degree lower) + unfold sourceIrreducibleNoProperFactorWord + paperVariableAritySourceIrreducibleProperFactorExistsWord + simp only [Function.comp_apply] + rw [paperVariableAritySourceIrreducibleFactorPairMarkerStream_valid + formula candidateRank] + change + sourceFourFamilyBooleanNotWord + (binaryGaussianFirstCellWord (binaryGaussianPivotWord markers)) = + [noProperFactors degree lower] + rw [paperVariableAritySourceIrreducibleFirstPivotMarker, + sourceFourFamilyBooleanNotWord_bit] + cases hfind : markers.findIdx? id with + | none => + have hgood : noProperFactors degree lower = true := + (noProperFactors_eq_true_iff lower).mpr + ((factor400BinaryIndexedProperFactorPairMarkers_find_none_iff + degree lower).mp hfind) + simp only [ne_eq, not_true_eq_false, decide_false, Bool.not_false, hgood] + | some index => + have hbad : noProperFactors degree lower = false := by + cases hvalue : noProperFactors degree lower with + | false => rfl + | true => + have hnone : markers.findIdx? id = none := + (factor400BinaryIndexedProperFactorPairMarkers_find_none_iff + degree lower).mpr + ((noProperFactors_eq_true_iff lower).mp hvalue) + rw [hfind] at hnone + cases hnone + simp only [ne_eq, reduceCtorEq, not_false_eq_true, decide_true, Bool.not_true, hbad] + +private theorem paperVariableAritySourceActualIrreducibleCandidateMarkerStream_valid + (formula : ThreeCNF) : + sourceActualIrreducibleCandidateMarkerStream + (encodeThreeCNF formula) = + binaryIndexedIrreducibleCandidateMarkers + (sourceIrreducibleFormulaDegree formula) := by + let degree := sourceIrreducibleFormulaDegree formula + let input := encodeThreeCNF formula + unfold sourceActualIrreducibleCandidateMarkerStream + rw [maskDynamicGridRecordCatalogueOutput_valid + sourceIrreducibleCandidateWidth + paperVariableAritySourceIrreducibleNoProperFactorComputable + input (2 ^ degree) + (paperVariableAritySourceIrreducibleCandidateWidth_valid formula)] + change + (List.range (2 ^ degree)).flatMap + (fun rank => sourceIrreducibleNoProperFactorWord + (sourceIrreducibleCandidateQuery input rank)) = + binaryIndexedIrreducibleCandidateMarkers degree + unfold binaryIndexedIrreducibleCandidateMarkers + calc + _ = (List.range (2 ^ degree)).flatMap + (fun rank => [binaryIndexedNoProperFactorsBit degree rank]) := by + apply List.flatMap_congr + intro rank hrank + have hlt : rank < 2 ^ degree := List.mem_range.mp hrank + have hcorrect := paperVariableAritySourceIrreducibleNoProperFactorWord_valid + formula (⟨rank, hlt⟩ : Fin (2 ^ degree)) + simpa only [input, degree, + binaryIndexedNoProperFactorsBit, + dite_eq_left hlt] using hcorrect + _ = _ := + (List.map_eq_flatMap + (f := binaryIndexedNoProperFactorsBit degree) + (l := List.range (2 ^ degree))).symm + +theorem paperVariableAritySourceSelectedIrreducibleWord_valid + (formula : ThreeCNF) : + sourceSelectedIrreducibleWord + (encodeThreeCNF formula) = + finiteWordBits + (irreducibleWord + (sourceIrreducibleFormulaDegree formula)) := by + let degree := sourceIrreducibleFormulaDegree formula + have hdegree : 0 < degree := by + exact GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)) + obtain ⟨rank, hfirst, hselected⟩ := + exists_first_source_irreducible_rank degree hdegree + have hpivot : + sourceActualIrreducibleFirstCandidateWord + (encodeThreeCNF formula) = + true :: List.replicate rank.val true := by + unfold sourceActualIrreducibleFirstCandidateWord + rw [Function.comp_apply, + paperVariableAritySourceActualIrreducibleCandidateMarkerStream_valid] + change + binaryGaussianPivotWord + (binaryIndexedIrreducibleCandidateMarkers degree) = _ + simp only [binaryGaussianPivotWord, hfirst] + have hrank : + sourceActualIrreducibleSelectedRankUnary + (encodeThreeCNF formula) = + List.replicate rank.val true := by + simp only [sourceActualIrreducibleSelectedRankUnary, Function.comp_apply, hpivot, + List.tail_cons] + unfold sourceSelectedIrreducibleWord + rw [Function.comp_apply] + unfold paperVariableAritySourceActualIrreducibleSelectedRankQuery + binaryIrreduciblePhysicalComputedPrefixOutput + simp only [Function.comp_apply, hrank, + paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid] + change + sourceIrreducibleRankCoefficientWord + (lengthPrefixedWord (List.replicate rank.val true) ++ + (lengthPrefixedWord (List.replicate (2 ^ degree) true) ++ + encodeThreeCNF formula)) = + finiteWordBits (irreducibleWord degree) + have hword := sourceIrreducibleRankCoefficientWord_eq_indexedWord + formula rank + (List.replicate (2 ^ degree) true) + calc + _ = finiteWordBits (indexedWord degree rank) := by + simpa only [List.append_assoc, degree] using hword + _ = _ := congrArg finiteWordBits hselected + +end + +end Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine + +namespace PhysicalMatrixCellTM + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryModularReductionTM GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics +open GapCVP.PhysicalColumnOrder GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalRightHandSideTM +open GapCVP.SourceOrder GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryPhysicalRowBasisDivisionTM GapCVP.BinaryCompactPhysicalFieldCoefficientBitTM +open GapCVP.CanonicalMatrixShape GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM + +private def paperVariableArityPhysicalMatrixLiftedSourceWord + (worker : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + worker.output ∘ sourceExplicitAffineCellOriginalSource + +private noncomputable def paperVariableArityPhysicalMatrixLiftedSourceWordComputable + (worker : SourcePhysicalLagrangeWordComputer) : + BitTM + (paperVariableArityPhysicalMatrixLiftedSourceWord worker) := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable worker.computer + +private noncomputable def paperVariableArityPhysicalMatrixLiftedSourceComputer + (worker : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := paperVariableArityPhysicalMatrixLiftedSourceWord worker + computer := paperVariableArityPhysicalMatrixLiftedSourceWordComputable worker + +@[simp] private theorem paperVariableArityPhysicalMatrixLiftedSourceComputer_query + (worker : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) : + (paperVariableArityPhysicalMatrixLiftedSourceComputer worker).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + worker.output (encodeThreeCNF formula) := by + change + worker.output + (sourceExplicitAffineCellOriginalSource + (affineCellQuery row column + (encodeThreeCNF formula))) = _ + rw [sourceExplicitAffineCellOriginalSource_query] + +/-- GapCVP reduction support. -/ +noncomputable def physicalMatrixBasisRankComputer + (degree : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := sourcePhysicalComputedUnaryRemainder + sourceExplicitAffineCellRow degree.output + computer := sourcePhysicalComputedUnaryRemainderComputable + sourceExplicitAffineCellRowComputable degree.computer + +theorem paperVariableArityPhysicalMatrixBasisRankComputer_query + (degree : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (fieldDegree : ℕ) (positive : 0 < fieldDegree) + (correctDegree : degree.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate fieldDegree true) : + (physicalMatrixBasisRankComputer degree).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate (row % fieldDegree) true := by + exact sourcePhysicalComputedUnaryRemainder_valid + sourceExplicitAffineCellRow degree.output + (affineCellQuery row column + (encodeThreeCNF formula)) + row fieldDegree positive + (sourceExplicitAffineCellRow_query + row column (encodeThreeCNF formula)) correctDegree + +private noncomputable def paperVariableArityPhysicalMatrixSourceDegreeComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalFamilyFieldDegreeUnary + computer := paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +/-- GapCVP reduction support. -/ +noncomputable def physicalMatrixFieldDegreeComputer : + SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalMatrixLiftedSourceComputer + paperVariableArityPhysicalMatrixSourceDegreeComputer + +@[simp] theorem paperVariableArityPhysicalMatrixFieldDegreeComputer_query + (row column : ℕ) (formula : ThreeCNF) : + physicalMatrixFieldDegreeComputer.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physDegree formula) true := by + change + (paperVariableArityPhysicalMatrixLiftedSourceComputer + paperVariableArityPhysicalMatrixSourceDegreeComputer).output + (affineCellQuery row column + (encodeThreeCNF formula)) = _ + rw [paperVariableArityPhysicalMatrixLiftedSourceComputer_query] + exact paperVariableArityPhysicalFamilyFieldDegreeUnary_valid formula + +/-- GapCVP reduction support. -/ +noncomputable def physicalMatrixSelectedBasisRankComputer : + SourcePhysicalLagrangeWordComputer := + physicalMatrixBasisRankComputer + physicalMatrixFieldDegreeComputer + +@[simp] theorem + paperVariableArityPhysicalMatrixSelectedBasisRankComputer_query + (row column : ℕ) (formula : ThreeCNF) : + physicalMatrixSelectedBasisRankComputer.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (row % physDegree formula) true := by + apply paperVariableArityPhysicalMatrixBasisRankComputer_query + physicalMatrixFieldDegreeComputer + row column formula + (physDegree formula) + (GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula))) + exact paperVariableArityPhysicalMatrixFieldDegreeComputer_query + row column formula + +/-- GapCVP reduction support. -/ +def physicalMatrixCoefficientBit + (basisRank coefficient : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + compactPhysicalFieldCoefficientCellBit basisRank coefficient + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalMatrixCoefficientBitComputable + (basisRank coefficient : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalMatrixCoefficientBit + basisRank coefficient) := + compactPhysicalFieldCoefficientCellBitComputable + basisRank coefficient + +theorem paperVariableArityPhysicalMatrixCoefficientBit_valid + {degree : ℕ} + (basisRank coefficient : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (word : GapCVP.Core.EffectiveBinaryField.Word degree) + (position : ℕ) (bounded : position < degree) + (correctRank : basisRank.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate position true) + (correctCoefficient : coefficient.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits word) : + physicalMatrixCoefficientBit + basisRank coefficient + (affineCellQuery row column + (encodeThreeCNF formula)) = + [word ⟨position, bounded⟩] := by + exact compactPhysicalFieldCoefficientCellBit_valid + basisRank coefficient row column formula word position bounded + correctRank correctCoefficient + +/-- GapCVP reduction support. -/ +def physicalMatrixGuardedFourFamilyCheck + (global refinement ordinary shifted : List Bool → List Bool) : + List Bool → List Bool := + sourceFourFamilyBooleanOrOutput global + (sourceFourFamilyBooleanOrOutput refinement + (sourceFourFamilyBooleanOrOutput ordinary shifted)) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalMatrixGuardedFourFamilyCheckComputable + (global refinement ordinary shifted : List Bool → List Bool) + (globalComputer : BitTM global) + (refinementComputer : BitTM refinement) + (ordinaryComputer : BitTM ordinary) + (shiftedComputer : BitTM shifted) : + BitTM + (physicalMatrixGuardedFourFamilyCheck + global refinement ordinary shifted) := + sourceFourFamilyBooleanOrComputable globalComputer + (sourceFourFamilyBooleanOrComputable refinementComputer + (sourceFourFamilyBooleanOrComputable + ordinaryComputer shiftedComputer)) + +private theorem paperVariableArityPhysicalMatrixFamilyGuardCover + (row globalBoundary refinementBoundary ordinaryBoundary : ℕ) + (entry : Bool) : + ((decide (row < globalBoundary) && entry) || + ((decide (globalBoundary ≤ row ∧ row < refinementBoundary) && + entry) || + ((decide (refinementBoundary ≤ row ∧ row < ordinaryBoundary) && + entry) || + (decide (ordinaryBoundary ≤ row) && entry)))) = entry := by + cases entry with + | false => simp only [Bool.and_false, Bool.decide_and, Bool.or_self] + | true => + by_cases global : row < globalBoundary + · simp only [global, decide_true, Bool.and_self, Bool.decide_and, Bool.and_true, + Bool.true_or] + · have afterGlobal : globalBoundary ≤ row := + Nat.le_of_not_gt global + by_cases refinement : row < refinementBoundary + · simp only [global, decide_false, Bool.and_true, afterGlobal, refinement, and_self, + decide_true, Bool.and_self, + Bool.decide_and, Bool.true_or, Bool.or_true] + · have afterRefinement : refinementBoundary ≤ row := + Nat.le_of_not_gt refinement + by_cases ordinary : row < ordinaryBoundary + · simp only [global, decide_false, Bool.and_true, afterGlobal, refinement, and_false, + afterRefinement, ordinary, + and_self, decide_true, Bool.and_self, Bool.true_or, Bool.or_true] + · have afterOrdinary : ordinaryBoundary ≤ row := + Nat.le_of_not_gt ordinary + simp only [global, decide_false, Bool.and_true, afterGlobal, refinement, and_false, + afterRefinement, ordinary, + afterOrdinary, decide_true, Bool.and_self, Bool.or_true] + +theorem paperVariableArityPhysicalMatrixGuardedFourFamilyCheck_valid + (global refinement ordinary shifted : List Bool → List Bool) + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (correctGlobal : + global (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (row.val < physicalFormulaGlobalBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) + (correctRefinement : + refinement (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) + (correctOrdinary : + ordinary (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaRefinementBoundary formula ≤ + row.val ∧ + row.val < + physicalFormulaOrdinaryBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) + (correctShifted : + shifted (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaOrdinaryBoundary formula ≤ + row.val) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) : + physicalMatrixGuardedFourFamilyCheck + global refinement ordinary shifted + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))] := by + let query := affineCellQuery row.val column.val + (encodeThreeCNF formula) + let entry := decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2)) + let globalBit := + decide (row.val < physicalFormulaGlobalBoundary formula) + let refinementBit := decide + (physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < physicalFormulaRefinementBoundary formula) + let ordinaryBit := decide + (physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) + let shiftedBit := decide + (physicalFormulaOrdinaryBoundary formula ≤ row.val) + have globalValue : global query = [globalBit && entry] := by + simpa only [query, globalBit, entry] using correctGlobal + have refinementValue : refinement query = [refinementBit && entry] := by + simpa only [query, refinementBit, entry] using correctRefinement + have ordinaryValue : ordinary query = [ordinaryBit && entry] := by + simpa only [query, ordinaryBit, entry] using correctOrdinary + have shiftedValue : shifted query = [shiftedBit && entry] := by + simpa only [query, shiftedBit, entry] using correctShifted + have last := fourFamilyBooleanOrOutput_bits + ordinary shifted query + (ordinaryBit && entry) (shiftedBit && entry) + ordinaryValue shiftedValue + have middle := fourFamilyBooleanOrOutput_bits + refinement (sourceFourFamilyBooleanOrOutput ordinary shifted) query + (refinementBit && entry) + ((ordinaryBit && entry) || (shiftedBit && entry)) + refinementValue last + have complete := fourFamilyBooleanOrOutput_bits + global + (sourceFourFamilyBooleanOrOutput refinement + (sourceFourFamilyBooleanOrOutput ordinary shifted)) query + (globalBit && entry) + ((refinementBit && entry) || + ((ordinaryBit && entry) || (shiftedBit && entry))) + globalValue middle + have covered := paperVariableArityPhysicalMatrixFamilyGuardCover + row.val + (physicalFormulaGlobalBoundary formula) + (physicalFormulaRefinementBoundary formula) + (physicalFormulaOrdinaryBoundary formula) + entry + change + physicalMatrixGuardedFourFamilyCheck + global refinement ordinary shifted query = [entry] + change + sourceFourFamilyBooleanOrOutput global + (sourceFourFamilyBooleanOrOutput refinement + (sourceFourFamilyBooleanOrOutput ordinary shifted)) query = + [entry] + rw [← covered] + exact complete + +private theorem paperVariableArityPhysicalMatrixCheckEntry_transport + (source target : GapCVP.Core.BinaryAffineSystem) + (same : source = target) + (row : Fin source.rowCount) + (column : Fin source.dimension) : + target.check + (Fin.cast (congrArg GapCVP.Core.BinaryAffineSystem.rowCount same) row) + (Fin.cast (congrArg GapCVP.Core.BinaryAffineSystem.dimension same) + column) = + source.check row column := by + cases same + rfl + +private theorem paperVariableArityPhysicalMatrixRightHandSide_transport + (source target : GapCVP.Core.BinaryAffineSystem) + (same : source = target) + (row : Fin source.rowCount) : + target.rightHandSide + (Fin.cast (congrArg GapCVP.Core.BinaryAffineSystem.rowCount same) row) = + source.rightHandSide row := by + cases same + rfl + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityCanonicalPhysicalMatrixCellComputerOfCheck + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (check : List Bool → List Bool) + (checkComputer : BitTM check) + (correctCheck : ∀ (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)), + check + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) : + PaperVariableArityCanonicalBinaryMatrixCellComputer shape where + check := check + rhs := physicalRightHandSideBit + checkComputable := checkComputer + rhsComputable := paperVariableArityPhysicalRightHandSideBitComputable + checkCorrect formula row column := by + let source := + shape.system (encodeThreeCNF formula).length formula + let target := + physicalWordBinarySystem + (encodeThreeCNF formula).length formula + have same : source = target := + shape.systemCorrect (encodeThreeCNF formula).length formula + let physicalRow : Fin target.rowCount := + Fin.cast + (congrArg GapCVP.Core.BinaryAffineSystem.rowCount same) row + let physicalColumn : Fin target.dimension := + Fin.cast + (congrArg GapCVP.Core.BinaryAffineSystem.dimension same) column + have transferred : + target.check physicalRow physicalColumn = + source.check row column := by + exact paperVariableArityPhysicalMatrixCheckEntry_transport + source target same row column + have correct := correctCheck formula physicalRow physicalColumn + rw [transferred] at correct + simpa only [source, target, physicalRow, physicalColumn, Fin.val_cast] + using correct + rhsCorrect formula row column := by + let source := + shape.system (encodeThreeCNF formula).length formula + let target := + physicalWordBinarySystem + (encodeThreeCNF formula).length formula + have same : source = target := + shape.systemCorrect (encodeThreeCNF formula).length formula + let physicalRow : Fin target.rowCount := + Fin.cast + (congrArg GapCVP.Core.BinaryAffineSystem.rowCount same) row + let physicalColumn : Fin target.dimension := + Fin.cast + (congrArg GapCVP.Core.BinaryAffineSystem.dimension same) column + have transferred : + target.rightHandSide physicalRow = + source.rightHandSide row := by + exact paperVariableArityPhysicalMatrixRightHandSide_transport + source target same row + have correct := paperVariableArityPhysicalRightHandSide_valid + formula physicalRow physicalColumn + rw [transferred] at correct + simpa only [source, target, physicalRow, physicalColumn, Fin.val_cast] + using correct + +end PhysicalMatrixCellTM + +namespace PhysicalGlobalRefinementCoefficientTM + +open scoped BigOperators + +open Turing GapCVP.BinaryEncoding GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryExplicitAffineSystem +open GapCVP.BinaryPhysicalRowBasisDivisionTM GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalFamilyMarkerTM GapCVP.PhysicalRowOrderProjection +open GapCVP.PhysicalRightHandSideTM + +attribute [local instance] Classical.propDecidable + +private def physicalCoefficientFieldCardinalityUnary : + List Bool → List Bool := + physicalCellSourceLift + physicalFamilyFieldCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalCoefficientFieldCardinalityUnaryComputable : + BitTM + physicalCoefficientFieldCardinalityUnary := + physicalCellSourceLiftComputable + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalCoefficientFieldCardinalityUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalCoefficientFieldCardinalityUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physFieldCard formula) true := by + unfold physicalCoefficientFieldCardinalityUnary + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid] + +private def physicalCoefficientGridCardinalityUnary : + List Bool → List Bool := + physicalCellSourceLift + physicalFamilyGridCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalCoefficientGridCardinalityUnaryComputable : + BitTM + physicalCoefficientGridCardinalityUnary := + physicalCellSourceLiftComputable + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalCoefficientGridCardinalityUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalCoefficientGridCardinalityUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physGridCard formula) true := by + unfold physicalCoefficientGridCardinalityUnary + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalFamilyGridCardinalityUnary_valid] + +theorem physicalCoefficientFieldCardinality_pos + (formula : ThreeCNF) : + 0 < physFieldCard formula := by + exact pow_pos (by decide : 0 < (2 : ℕ)) _ + +theorem physicalCoefficientGridCardinality_pos + (formula : ThreeCNF) : + 0 < physGridCard formula := by + have gridCardinality : + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) = + physGridCard formula := by + simpa only [Fintype.card_coe, physGridCard, physFieldCard, physDegree, physicalFormulaSize, + physicalFormulaVariableCount] using physicalSourceGridCardinality_eq (encodeThreeCNF + formula).length formula + rw [← gridCardinality] + simpa only [Fintype.card_coe, Finset.card_pos] using + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid_card_pos (encodeThreeCNF + formula).length + (srcFormula formula) + +private def physicalColumnGridQuotientUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + sourceExplicitAffineCellColumn + physicalCoefficientFieldCardinalityUnary + +private noncomputable def paperVariableArityPhysicalColumnGridQuotientUnaryComputable : + BitTM + physicalColumnGridQuotientUnary := + sourcePhysicalComputedUnaryQuotientComputable + sourceExplicitAffineCellColumnComputable + paperVariableArityPhysicalCoefficientFieldCardinalityUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalColumnGridQuotientUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalColumnGridQuotientUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (column / physFieldCard formula) + true := by + unfold physicalColumnGridQuotientUnary + exact sourcePhysicalComputedUnaryQuotient_valid + sourceExplicitAffineCellColumn + physicalCoefficientFieldCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + column (physFieldCard formula) + (physicalCoefficientFieldCardinality_pos formula) + (sourceExplicitAffineCellColumn_query row column + (encodeThreeCNF formula)) + (paperVariableArityPhysicalCoefficientFieldCardinalityUnary_query + row column formula) + +/-- GapCVP reduction support. -/ +def physicalColumnFieldValueRankUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + sourceExplicitAffineCellColumn + physicalCoefficientFieldCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalColumnFieldValueRankUnaryComputable : + BitTM + physicalColumnFieldValueRankUnary := + sourcePhysicalComputedUnaryRemainderComputable + sourceExplicitAffineCellColumnComputable + paperVariableArityPhysicalCoefficientFieldCardinalityUnaryComputable + +@[simp] theorem paperVariableArityPhysicalColumnFieldValueRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalColumnFieldValueRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (column % physFieldCard formula) + true := by + unfold physicalColumnFieldValueRankUnary + exact sourcePhysicalComputedUnaryRemainder_valid + sourceExplicitAffineCellColumn + physicalCoefficientFieldCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + column (physFieldCard formula) + (physicalCoefficientFieldCardinality_pos formula) + (sourceExplicitAffineCellColumn_query row column + (encodeThreeCNF formula)) + (paperVariableArityPhysicalCoefficientFieldCardinalityUnary_query + row column formula) + +/-- GapCVP reduction support. -/ +def physicalColumnGridRankUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + physicalColumnGridQuotientUnary + physicalCoefficientGridCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def physicalColumnGridRankUnaryComputable : + BitTM + physicalColumnGridRankUnary := + sourcePhysicalComputedUnaryRemainderComputable + paperVariableArityPhysicalColumnGridQuotientUnaryComputable + paperVariableArityPhysicalCoefficientGridCardinalityUnaryComputable + +@[simp] theorem paperVariableArityPhysicalColumnGridRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalColumnGridRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((column / physFieldCard formula) % + physGridCard formula) + true := by + unfold physicalColumnGridRankUnary + exact sourcePhysicalComputedUnaryRemainder_valid + physicalColumnGridQuotientUnary + physicalCoefficientGridCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (column / physFieldCard formula) + (physGridCard formula) + (physicalCoefficientGridCardinality_pos formula) + (paperVariableArityPhysicalColumnGridQuotientUnary_query + row column formula) + (paperVariableArityPhysicalCoefficientGridCardinalityUnary_query + row column formula) + +/-- GapCVP reduction support. -/ +def physicalColumnTypeRankUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + physicalColumnGridQuotientUnary + physicalCoefficientGridCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalColumnTypeRankUnaryComputable : + BitTM + physicalColumnTypeRankUnary := + sourcePhysicalComputedUnaryQuotientComputable + paperVariableArityPhysicalColumnGridQuotientUnaryComputable + paperVariableArityPhysicalCoefficientGridCardinalityUnaryComputable + +@[simp] theorem paperVariableArityPhysicalColumnTypeRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalColumnTypeRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((column / physFieldCard formula) / + physGridCard formula) + true := by + unfold physicalColumnTypeRankUnary + exact sourcePhysicalComputedUnaryQuotient_valid + physicalColumnGridQuotientUnary + physicalCoefficientGridCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (column / physFieldCard formula) + (physGridCard formula) + (physicalCoefficientGridCardinality_pos formula) + (paperVariableArityPhysicalColumnGridQuotientUnary_query + row column formula) + (paperVariableArityPhysicalCoefficientGridCardinalityUnary_query + row column formula) + +private def physicalGlobalRowFieldRankUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + sourceExplicitAffineCellRow + physicalRightHandSideCellDegreeUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalGlobalRowFieldRankUnaryComputable : + BitTM + physicalGlobalRowFieldRankUnary := + sourcePhysicalComputedUnaryQuotientComputable + sourceExplicitAffineCellRowComputable + paperVariableArityPhysicalRightHandSideCellDegreeUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalGlobalRowFieldRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalGlobalRowFieldRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (row / physDegree formula) true := by + unfold physicalGlobalRowFieldRankUnary + exact sourcePhysicalComputedUnaryQuotient_valid + sourceExplicitAffineCellRow + physicalRightHandSideCellDegreeUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + row (physDegree formula) + (GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula))) + (sourceExplicitAffineCellRow_query row column + (encodeThreeCNF formula)) + (paperVariableArityPhysicalRightHandSideCellDegreeUnary_query + row column formula) + +/-- GapCVP reduction support. -/ +def physicalCoefficientUnaryEquality + (first second : List Bool → List Bool) : List Bool → List Bool := + maskComputedWordEquality first second + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalCoefficientUnaryEqualityComputable + {first second : List Bool → List Bool} + (firstComputer : BitTM first) + (secondComputer : BitTM second) : + BitTM + (physicalCoefficientUnaryEquality first second) := + maskComputedWordEqualityComputable + firstComputer secondComputer + +theorem physicalCoefficientUnaryEquality_valid + (first second : List Bool → List Bool) + (input : List Bool) (left right : ℕ) + (firstValid : first input = List.replicate left true) + (secondValid : second input = List.replicate right true) : + physicalCoefficientUnaryEquality first second input = + [decide (left = right)] := by + unfold physicalCoefficientUnaryEquality + rw [sourceQaryMaskSquareComputedWordEquality_valid, + firstValid, secondValid] + simp only [List.replicate_inj, or_true, and_true] + +private def physicalColumnGlobalTypeBit : + List Bool → List Bool := + physicalCoefficientUnaryEquality + physicalColumnTypeRankUnary (fun _ => []) + +private noncomputable def paperVariableArityPhysicalColumnGlobalTypeBitComputable : + BitTM + physicalColumnGlobalTypeBit := + paperVariableArityPhysicalCoefficientUnaryEqualityComputable + paperVariableArityPhysicalColumnTypeRankUnaryComputable + (sourceFixedWordComputable []) + +@[simp] private theorem paperVariableArityPhysicalColumnGlobalTypeBit_query + (row column : ℕ) (formula : ThreeCNF) : + physicalColumnGlobalTypeBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (((column / physFieldCard formula) / + physGridCard formula) = 0)] := by + unfold physicalColumnGlobalTypeBit + exact physicalCoefficientUnaryEquality_valid + physicalColumnTypeRankUnary (fun _ => []) + (affineCellQuery row column (encodeThreeCNF formula)) + ((column / physFieldCard formula) / + physGridCard formula) + 0 + (paperVariableArityPhysicalColumnTypeRankUnary_query row column formula) + rfl + +private def physicalGlobalGridMatchBit : + List Bool → List Bool := + physicalCoefficientUnaryEquality + physicalColumnGridRankUnary + physicalGlobalRowFieldRankUnary + +private noncomputable def paperVariableArityPhysicalGlobalGridMatchBitComputable : + BitTM + physicalGlobalGridMatchBit := + paperVariableArityPhysicalCoefficientUnaryEqualityComputable + physicalColumnGridRankUnaryComputable + paperVariableArityPhysicalGlobalRowFieldRankUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalGlobalGridMatchBit_query + (row column : ℕ) (formula : ThreeCNF) : + physicalGlobalGridMatchBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (((column / physFieldCard formula) % + physGridCard formula) = + row / physDegree formula)] := by + unfold physicalGlobalGridMatchBit + exact physicalCoefficientUnaryEquality_valid + physicalColumnGridRankUnary + physicalGlobalRowFieldRankUnary + (affineCellQuery row column (encodeThreeCNF formula)) + ((column / physFieldCard formula) % + physGridCard formula) + (row / physDegree formula) + (paperVariableArityPhysicalColumnGridRankUnary_query row column formula) + (paperVariableArityPhysicalGlobalRowFieldRankUnary_query + row column formula) + +private def physicalGlobalFamilyCoefficientWord : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + physicalColumnGlobalTypeBit + physicalGlobalGridMatchBit + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalGlobalFamilyCoefficientWordComputable : + BitTM + physicalGlobalFamilyCoefficientWord := + fourFamilyBooleanAndComputable + paperVariableArityPhysicalColumnGlobalTypeBitComputable + paperVariableArityPhysicalGlobalGridMatchBitComputable + +@[simp] private theorem paperVariableArityPhysicalGlobalFamilyCoefficientWord_query + (row column : ℕ) (formula : ThreeCNF) : + physicalGlobalFamilyCoefficientWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (((column / physFieldCard formula) / + physGridCard formula) = 0) && + decide + (((column / physFieldCard formula) % + physGridCard formula) = + row / physDegree formula)] := by + unfold physicalGlobalFamilyCoefficientWord + exact fourFamilyBooleanAndOutput_bits + physicalColumnGlobalTypeBit + physicalGlobalGridMatchBit + (affineCellQuery row column + (encodeThreeCNF formula)) + (decide + (((column / physFieldCard formula) / + physGridCard formula) = 0)) + (decide + (((column / physFieldCard formula) % + physGridCard formula) = + row / physDegree formula)) + (paperVariableArityPhysicalColumnGlobalTypeBit_query + row column formula) + (paperVariableArityPhysicalGlobalGridMatchBit_query + row column formula) + +/-- GapCVP reduction support. -/ +def physicalGlobalCheckBit : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + physicalGlobalRowMarker + (sourceFourFamilyBooleanAndOutput + physicalRightHandSideBasisZeroBit + physicalGlobalFamilyCoefficientWord) + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalGlobalCheckBitComputable : + BitTM + physicalGlobalCheckBit := + fourFamilyBooleanAndComputable + paperVariableArityPhysicalGlobalRowMarkerComputable + (fourFamilyBooleanAndComputable + paperVariableArityPhysicalRightHandSideBasisZeroBitComputable + paperVariableArityPhysicalGlobalFamilyCoefficientWordComputable) + +@[simp] private theorem paperVariableArityPhysicalGlobalCheckBit_query + (row column : ℕ) (formula : ThreeCNF) : + physicalGlobalCheckBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (row < physicalFormulaGlobalBoundary formula) && + (decide (row % physDegree formula = 0) && + (decide + (((column / physFieldCard formula) / + physGridCard formula) = 0) && + decide + (((column / physFieldCard formula) % + physGridCard formula) = + row / physDegree formula)))] := by + let input := affineCellQuery row column + (encodeThreeCNF formula) + let basis := decide + (row % physDegree formula = 0) + let tag := decide + (((column / physFieldCard formula) / + physGridCard formula) = 0) + let grid := decide + (((column / physFieldCard formula) % + physGridCard formula) = + row / physDegree formula) + have inner := fourFamilyBooleanAndOutput_bits + physicalRightHandSideBasisZeroBit + physicalGlobalFamilyCoefficientWord input + basis (tag && grid) + (paperVariableArityPhysicalRightHandSideBasisZeroBit_query + row column formula) + (paperVariableArityPhysicalGlobalFamilyCoefficientWord_query + row column formula) + exact fourFamilyBooleanAndOutput_bits + physicalGlobalRowMarker + (sourceFourFamilyBooleanAndOutput + physicalRightHandSideBasisZeroBit + physicalGlobalFamilyCoefficientWord) + input + (decide + (row < physicalFormulaGlobalBoundary formula)) + (basis && (tag && grid)) + (paperVariableArityPhysicalGlobalRowMarker_query + row column formula) + inner + +end PhysicalGlobalRefinementCoefficientTM + +namespace PhysicalColumnOrderProjection + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinarySourceCoordinateOrder GapCVP.FormulaBridge GapCVP.SourceOrder +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalRowOrderProjection + +theorem paperVariableAritySourceCoordinateFieldWordRank + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula))) : + ((sourceFormulaFieldCardOrder encodingLength + (srcFormula formula)).symm + ((sourceCoordinateWordOrder + encodingLength formula column).2.2)).val = + column.val % Fintype.card + (sourceFormulaField encodingLength + (srcFormula formula)) := by + simp only [sourceCoordinateWordOrder, sourceFormulaCoordinateOrder, finProdFinEquiv, + Equiv.symm_mk, + Equiv.trans_apply, finCongr_apply, Equiv.coe_fn_mk, Equiv.prodCongr_apply, Prod.map_apply, + Equiv.prodAssoc_apply, + Equiv.coe_refl, id_eq, Equiv.symm_apply_apply, Fin.coe_modNat, Fin.val_cast] + +theorem sourceCoordinateGridWordRank + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula))) : + ((sourceFormulaGridOrder encodingLength + (srcFormula formula)).symm + ((sourceCoordinateWordOrder + encodingLength formula column).2.1)).val = + (column.val / Fintype.card + (sourceFormulaField encodingLength + (srcFormula formula))) % + (sourceFormulaGrid encodingLength + (srcFormula formula)).card := by + simp only [sourceCoordinateWordOrder, sourceFormulaCoordinateOrder, finProdFinEquiv, + Equiv.symm_mk, + Equiv.trans_apply, finCongr_apply, Equiv.coe_fn_mk, Equiv.prodCongr_apply, Prod.map_apply, + Equiv.prodAssoc_apply, + Equiv.coe_refl, id_eq, Equiv.symm_apply_apply, Fin.coe_modNat, Fin.coe_divNat, Fin.val_cast] + +theorem sourceCoordinateTypeWordRank + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula))) : + ((sourceTypeCardWordOrder formula).symm + ((sourceCoordinateWordOrder + encodingLength formula column).1)).val = + (column.val / Fintype.card + (sourceFormulaField encodingLength + (srcFormula formula))) / + (sourceFormulaGrid encodingLength + (srcFormula formula)).card := by + simp only [sourceCoordinateWordOrder, sourceFormulaCoordinateOrder, finProdFinEquiv, + Equiv.symm_mk, + Equiv.trans_apply, finCongr_apply, Equiv.coe_fn_mk, Equiv.prodCongr_apply, Prod.map_apply, + Equiv.prodAssoc_apply, + Equiv.coe_refl, id_eq, Equiv.symm_apply_apply, Fin.coe_divNat, Fin.val_cast] + +theorem physicalFormulaFieldCardinality_eq_card + (formula : ThreeCNF) : + Fintype.card + (sourceFormulaField (encodeThreeCNF formula).length + (srcFormula formula)) = + physFieldCard formula := by + exact sourceFormulaFieldWordOrder_card + (encodeThreeCNF formula).length + (srcFormula formula) + +theorem physicalFormulaGridCardinality_eq_card + (formula : ThreeCNF) : + (sourceFormulaGrid (encodeThreeCNF formula).length + (srcFormula formula)).card = + physGridCard formula := by + simpa only [physGridCard, physFieldCard, physDegree, physicalFormulaSize, + physicalFormulaVariableCount, + Fintype.card_coe] using physicalSourceGridCardinality_eq (encodeThreeCNF formula).length + formula + +private theorem paperVariableArityGlobalTypeWordRank_zero + (formula : ThreeCNF) : + ((sourceTypeCardWordOrder formula).symm + (Sum.inl ())).val = 0 := by + simp only [sourceTypeCardWordOrder, sourceTypeWordOrder, finSumFinEquiv, Equiv.symm_mk, + List.get_eq_getElem, + Equiv.symm_trans, Equiv.sumCongr_symm, finCongr_symm, Equiv.trans_apply, + Equiv.sumCongr_apply, Sum.map_inl, + Equiv.coe_fn_mk, Sum.elim_inl, finCongr_apply, Fin.val_cast, Fin.val_castAdd, + Fin.val_eq_zero] + +private theorem paperVariableAritySourceTypeWord_isGlobal_iff + (formula : ThreeCNF) + (tableType : sourceSATTableType + (srcFormula formula)) : + tableType = Sum.inl () ↔ + ((sourceTypeCardWordOrder formula).symm + tableType).val = 0 := by + constructor + · intro hglobal + subst tableType + exact paperVariableArityGlobalTypeWordRank_zero formula + · intro hrank + apply (sourceTypeCardWordOrder formula).symm.injective + apply Fin.ext + exact hrank.trans + (paperVariableArityGlobalTypeWordRank_zero formula).symm + +private theorem paperVariableAritySourceCoordinate_isGlobal_iff + (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) : + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 = Sum.inl () ↔ + (column.val / + physFieldCard formula) / + physGridCard formula = 0 := by + rw [paperVariableAritySourceTypeWord_isGlobal_iff formula, + sourceCoordinateTypeWordRank + (encodeThreeCNF formula).length formula column, + physicalFormulaFieldCardinality_eq_card, + physicalFormulaGridCardinality_eq_card] + +end PhysicalColumnOrderProjection + +namespace PhysicalGlobalCoefficientCorrectness + +open scoped BigOperators + +open GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryExplicitAffineSystem +open GapCVP.BinarySourceCoordinateOrder GapCVP.FormulaBridge GapCVP.SourceOrder +open GapCVP.PhysicalColumnOrder GapCVP.PhysicalColumnOrderProjection GapCVP.PhysicalFamilyRowTM +open GapCVP.MatrixEntrySemantics GapCVP.PhysicalRowOrderProjection +open GapCVP.PhysicalGlobalRefinementCoefficientTM + +attribute [local instance] Classical.propDecidable + +private theorem paperVariableArityPhysicalWordCoordinateDelta_eq_coordinate + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) + (tableType : sourceSATTableType + (srcFormula formula)) + (point : sourceSATGridPoint + (PaperVariableArityPhysicalWordGrid encodingLength formula)) + (value : PaperVariableArityPhysicalWordField + encodingLength formula) : + physicalWordCoordinateDelta + encodingLength formula column tableType point value = + if (tableType, point, value) = + sourceCoordinateWordOrder + encodingLength formula column + then 1 else 0 := by + let order := sourceCoordinateWordOrder + encodingLength formula + change + (if order.symm (tableType, point, value) = column + then 1 else 0) = + if (tableType, point, value) = order column + then 1 else 0 + by_cases hcoordinate : + (tableType, point, value) = order column + · have hcolumn : + order.symm (tableType, point, value) = column := by + rw [hcoordinate, order.symm_apply_apply] + rw [ite_eq_left hcolumn, ite_eq_left hcoordinate] + · have hcolumn : + order.symm (tableType, point, value) ≠ column := by + intro hequal + apply hcoordinate + have happly := congrArg order hequal + simpa only [Equiv.apply_symm_apply] using happly + rw [ite_eq_right hcolumn, ite_eq_right hcoordinate] + +private theorem paperVariableArityPhysicalWordGlobalFieldCoefficient_eq_coordinate + (encodingLength : ℕ) (formula : ThreeCNF) + (row : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)))) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula (.inl ()) row column = + if + (sourceCoordinateWordOrder + encodingLength formula column).1 = .inl () ∧ + (sourceCoordinateWordOrder + encodingLength formula column).2.1 = + sourceFormulaExplicitGridOrder + encodingLength + (srcFormula formula) row + then 1 else 0 := by + let decoded := sourceCoordinateWordOrder + encodingLength formula column + let grid := sourceFormulaExplicitGridOrder + encodingLength (srcFormula formula) row + rw [paperVariableArityPhysicalWordGlobalFieldCoefficient + encodingLength formula row column] + simp_rw [paperVariableArityPhysicalWordCoordinateDelta_eq_coordinate + encodingLength formula column] + change + (∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + if ((.inl () : sourceSATTableType + (srcFormula formula)), grid, value) = decoded + then 1 else 0) = + if decoded.1 = .inl () ∧ decoded.2.1 = grid then 1 else 0 + by_cases htype : decoded.1 = .inl () + · by_cases hgrid : decoded.2.1 = grid + · have hcoordinate (value : PaperVariableArityPhysicalWordField + encodingLength formula) : + ((.inl () : sourceSATTableType + (srcFormula formula)), grid, value) = + decoded ↔ value = decoded.2.2 := by + constructor + · intro hequal + exact congrArg (fun coordinate => coordinate.2.2) hequal + · intro hequal + apply Prod.ext + · exact htype.symm + · apply Prod.ext + · exact hgrid.symm + · exact hequal + simp_rw [hcoordinate] + simp only [htype, hgrid, and_self, ite_true] + simpa only [Finset.mem_univ, ite_true] using + Finset.sum_ite_eq' + (Finset.univ : Finset + (PaperVariableArityPhysicalWordField encodingLength formula)) + decoded.2.2 + (fun _ : PaperVariableArityPhysicalWordField + encodingLength formula => 1) + · have hcoordinate (value : PaperVariableArityPhysicalWordField + encodingLength formula) : + ((.inl () : sourceSATTableType + (srcFormula formula)), grid, value) ≠ + decoded := by + intro hequal + apply hgrid + exact (congrArg (fun coordinate => coordinate.2.1) hequal).symm + simp only [hcoordinate, ite_false, Finset.sum_const_zero, + htype, true_and, hgrid] + · have hcoordinate (value : PaperVariableArityPhysicalWordField + encodingLength formula) : + ((.inl () : sourceSATTableType + (srcFormula formula)), grid, value) ≠ + decoded := by + intro hequal + apply htype + exact (congrArg (fun coordinate => coordinate.1) hequal).symm + simp only [hcoordinate, ite_false, Finset.sum_const_zero, + htype, false_and] + +private theorem paperVariableArityPhysicalGlobalRowFieldRank + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (hglobal : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 = .inl ()) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.1.val = + row.val / physDegree formula := by + let encodingLength := (encodeThreeCNF formula).length + have hfirst : + physicalRowDependentFamilyIndex + encodingLength formula row = + ⟨0, physicalFamilyTagCount_pos + encodingLength formula⟩ := by + apply (paperExplicitFamilyWordOrder + encodingLength formula).injective + calc + paperExplicitFamilyWordOrder + encodingLength formula + (physicalRowDependentFamilyIndex + encodingLength formula row) = + (physicalWordDecodedRow + encodingLength formula row).1 := + (physicalRowOrder_family + encodingLength formula row).symm + _ = .inl () := hglobal + _ = paperExplicitFamilyWordOrder + encodingLength formula + ⟨0, physicalFamilyTagCount_pos + encodingLength formula⟩ := + (physicalFamilyWordOrder_zero + encodingLength formula).symm + have hzero : + (physicalRowDependentFamilyIndex + encodingLength formula row).val = 0 := + congrArg Fin.val hfirst + have hprefix : + (∑ index : Fin + (physicalRowDependentFamilyIndex + encodingLength formula row).val, + paperExplicitBinaryFamilyBlockCount + encodingLength formula + (Fin.castLE + (physicalRowDependentFamilyIndex + encodingLength formula row).isLt.le index)) = 0 := by + apply Finset.sum_eq_zero + intro index _ + exact Fin.elim0 (Fin.cast hzero index) + have hrank := physicalRowDependentRank_eq_prefix + encodingLength formula row + have hblock : + row.val = + (physicalRowDependentBlockRank + encodingLength formula row).val := by + omega + rw [physicalRowOrder_fieldRow] + change + (physicalRowDependentBlockRank + encodingLength formula row).val / + physDegree formula = + row.val / physDegree formula + rw [hblock] + +private theorem paperVariableArityPhysicalGlobalFieldCoefficient_eq_mixedRadix + (formula : ThreeCNF) + (fieldRow : Fin + (Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)))) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalWordFamilyFieldCoefficient + (encodeThreeCNF formula).length formula + (.inl ()) fieldRow column = + if + (column.val / physFieldCard formula) / + physGridCard formula = 0 ∧ + (column.val / physFieldCard formula) % + physGridCard formula = + fieldRow.val + then 1 else 0 := by + let encodingLength := (encodeThreeCNF formula).length + let decoded := sourceCoordinateWordOrder + encodingLength formula column + have htype : + decoded.1 = .inl () ↔ + (column.val / + physFieldCard formula) / + physGridCard formula = 0 := + paperVariableAritySourceCoordinate_isGlobal_iff formula column + have hgridrank : + ((sourceFormulaGridOrder + encodingLength (srcFormula formula)).symm + decoded.2.1).val = + (column.val / + physFieldCard formula) % + physGridCard formula := by + simpa only [encodingLength, decoded, + physicalFormulaFieldCardinality_eq_card, + physicalFormulaGridCardinality_eq_card] using + sourceCoordinateGridWordRank + encodingLength formula column + have hfieldrank : + ((sourceFormulaGridOrder + encodingLength (srcFormula formula)).symm + (sourceFormulaExplicitGridOrder + encodingLength (srcFormula formula) + fieldRow)).val = fieldRow.val := by + simp only [sourceFormulaExplicitGridOrder, Equiv.trans_apply, finCongr_apply, + Equiv.symm_apply_apply, + Fin.val_cast] + have hgrid : + decoded.2.1 = + sourceFormulaExplicitGridOrder + encodingLength (srcFormula formula) + fieldRow ↔ + (column.val / + physFieldCard formula) % + physGridCard formula = + fieldRow.val := by + constructor + · intro hequal + have hrank := congrArg + (fun point => + ((sourceFormulaGridOrder + encodingLength (srcFormula formula)).symm + point).val) hequal + exact hgridrank.symm.trans (hrank.trans hfieldrank) + · intro hrank + apply (sourceFormulaGridOrder + encodingLength (srcFormula formula)).symm.injective + apply Fin.ext + exact hgridrank.trans (hrank.trans hfieldrank.symm) + rw [paperVariableArityPhysicalWordGlobalFieldCoefficient_eq_coordinate] + by_cases hsource : + decoded.1 = .inl () ∧ + decoded.2.1 = + sourceFormulaExplicitGridOrder + encodingLength (srcFormula formula) + fieldRow + · have hphysical : + (column.val / + physFieldCard formula) / + physGridCard formula = 0 ∧ + (column.val / + physFieldCard formula) % + physGridCard formula = + fieldRow.val := + ⟨htype.mp hsource.1, hgrid.mp hsource.2⟩ + rw [ite_eq_left hsource, ite_eq_left hphysical] + · have hphysical : + ¬ ((column.val / + physFieldCard formula) / + physGridCard formula = 0 ∧ + (column.val / + physFieldCard formula) % + physGridCard formula = + fieldRow.val) := by + intro hphysical + exact hsource ⟨htype.mpr hphysical.1, hgrid.mpr hphysical.2⟩ + rw [ite_eq_right hsource, ite_eq_right hphysical] + +private theorem paperVariableArityPhysicalGlobalWordBinaryCheck_eq_mixedRadix + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (hglobal : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 = .inl ()) : + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check row column = + if + (column.val / + physFieldCard formula) / + physGridCard formula = 0 ∧ + (column.val / + physFieldCard formula) % + physGridCard formula = + row.val / physDegree formula + then bitValue + (decide (row.val % physDegree formula = 0)) + else 0 := by + have hfield := paperVariableArityPhysicalGlobalRowFieldRank + formula row hglobal + have hbasis : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.2.val = + row.val % physDegree formula := + physicalRowOrder_basis_val + (encodeThreeCNF formula).length formula row + rw [physicalWordBinaryCheckCoefficient] + generalize hdecoded : + physicalWordDecodedRow + (encodeThreeCNF formula).length formula row = decoded + at hglobal hfield hbasis ⊢ + rcases decoded with ⟨family, fieldRow, basis⟩ + cases family with + | inl value => + cases value + change fieldRow.val = + row.val / physDegree formula at hfield + change basis.val = + row.val % physDegree formula at hbasis + rw [paperVariableArityPhysicalGlobalFieldCoefficient_eq_mixedRadix] + rw [hfield] + split_ifs + · rw [paperVariableArityPhysicalFieldBasis_one_coordinate] + rw [hbasis] + · simp only [map_zero, Pi.zero_apply] + | inr value => + cases hglobal + +private theorem paperVariableArityPhysicalGlobalCheckBit_valid_of_global + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (hglobal : + row.val < physicalFormulaGlobalBoundary formula) : + physicalGlobalCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = 1)] := by + have hsource : + row.val < physicalSourceGlobalBoundary + (encodeThreeCNF formula).length formula := by + change row.val < + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) * + physDegree formula + rw [physicalSourceGridCardinality_eq] + exact hglobal + have hfamily := + (paperVariableArityPhysicalRowOrder_global_iff + (encodeThreeCNF formula).length formula row).mpr hsource + have hcheck := paperVariableArityPhysicalGlobalWordBinaryCheck_eq_mixedRadix + formula row column hfamily + rw [paperVariableArityPhysicalGlobalCheckBit_query, hcheck] + apply congrArg (fun bit : Bool => [bit]) + by_cases htype : + (column.val / + physFieldCard formula) / + physGridCard formula = 0 + · by_cases hgrid : + (column.val / + physFieldCard formula) % + physGridCard formula = + row.val / physDegree formula + · by_cases hbasis : + row.val % physDegree formula = 0 + · simp only [hglobal, htype, hgrid, hbasis, decide_true, + and_self, ↓reduceIte, bitValue, Bool.true_and] + · simp only [hglobal, htype, hgrid, hbasis, decide_true, + decide_false, and_self, ↓reduceIte, bitValue, + Bool.false_eq_true, zero_ne_one, Bool.true_and, + Bool.false_and] + · simp only [hglobal, htype, hgrid, decide_true, decide_false, + and_false, ↓reduceIte, zero_ne_one, Bool.and_false] + · simp only [hglobal, htype, decide_true, decide_false, + false_and, ↓reduceIte, zero_ne_one, Bool.false_and, + Bool.and_false] + +theorem paperVariableArityPhysicalGlobalCheckBit_valid + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalGlobalCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (row.val < physicalFormulaGlobalBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = 1)] := by + by_cases hglobal : + row.val < physicalFormulaGlobalBoundary formula + · rw [paperVariableArityPhysicalGlobalCheckBit_valid_of_global + formula row column hglobal] + simp only [hglobal, decide_true, + Bool.true_and] + · rw [paperVariableArityPhysicalGlobalCheckBit_query] + simp only [hglobal, decide_false, Nat.div_eq_zero_iff, Bool.decide_or, Bool.false_and] + +end PhysicalGlobalCoefficientCorrectness + +namespace PhysicalRefinementFieldCoordinateCorrectness + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinarySourceRowOrder GapCVP.BinaryExplicitAffineSystem +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.MatrixEntrySemantics +open GapCVP.PhysicalGlobalCoefficientCorrectness + +attribute [local instance] Classical.propDecidable + +private theorem paperVariableArityPhysicalWordRefinementFieldCoefficient_eq_coordinate + (encodingLength : ℕ) + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) + (row : Fin + (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula) × + PaperVariableArityPhysicalWordField encodingLength formula))) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula (.inr (.inl clause)) row column = + if + (sourceCoordinateWordOrder + encodingLength formula column).2.1 = + (sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) row).1 ∧ + (sourceCoordinateWordOrder + encodingLength formula column).2.2 = + (sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) row).2 ∧ + ((sourceCoordinateWordOrder + encodingLength formula column).1 = .inl () ∨ + ∃ tuple : + ((srcFormula formula).clauses.get + clause).SatisfyingLocalTuple, + (sourceCoordinateWordOrder + encodingLength formula column).1 = + .inr ⟨clause, tuple⟩) + then 1 else 0 := by + let decoded := sourceCoordinateWordOrder + encodingLength formula column + let position := sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) row + rw [paperVariableArityPhysicalWordRefinementFieldCoefficient] + dsimp only + simp_rw [paperVariableArityPhysicalWordCoordinateDelta_eq_coordinate + encodingLength formula column] + change + (if + ((.inl () : sourceSATTableType + (srcFormula formula)), + position.1, position.2) = decoded + then 1 else 0) - + (∑ tuple : + ((srcFormula formula).clauses.get + clause).SatisfyingLocalTuple, + if + ((.inr ⟨clause, tuple⟩ : sourceSATTableType + (srcFormula formula)), + position.1, position.2) = decoded + then 1 else 0) = + if + decoded.2.1 = position.1 ∧ + decoded.2.2 = position.2 ∧ + (decoded.1 = .inl () ∨ + ∃ tuple : + ((srcFormula formula).clauses.get + clause).SatisfyingLocalTuple, + decoded.1 = .inr ⟨clause, tuple⟩) + then 1 else 0 + rcases decoded with ⟨type, grid, value⟩ + rcases position with ⟨point, entry⟩ + dsimp + by_cases hgrid : grid = point + · subst grid + by_cases hvalue : value = entry + · subst value + rcases type with ⟨⟩ | ⟨selectedClause, selectedTuple⟩ + · simp only [List.get_eq_getElem, ↓reduceIte, Prod.mk.injEq, reduceCtorEq, and_true, + Finset.sum_const_zero, + sub_zero, exists_false, or_false, and_self] + · by_cases hclause : selectedClause = clause + · subst selectedClause + simp only [List.get_eq_getElem, Prod.mk.injEq, reduceCtorEq, and_true, ↓reduceIte, + Sum.inr.injEq, + Sigma.mk.injEq, heq_eq_eq, true_and, Finset.sum_ite_eq', Finset.mem_univ, + CharTwo.sub_eq_add, zero_add, exists_eq', + or_true, and_self] + · simp only [List.get_eq_getElem, Prod.mk.injEq, reduceCtorEq, and_true, ↓reduceIte, + Sum.inr.injEq, + Sigma.mk.injEq, Ne.symm hclause, false_and, Finset.sum_const_zero, sub_self, + exists_and_left, Subtype.exists, + false_or, true_and, right_eq_ite_iff, zero_ne_one, imp_false, not_and, not_exists] + aesop + · simp only [Prod.mk.injEq, Ne.symm hvalue, and_false, ↓reduceIte, Finset.sum_const_zero, + sub_self, + Subtype.exists, true_and, right_eq_ite_iff, zero_ne_one, imp_false, not_and, not_or, + not_exists] + aesop + · simp only [Prod.mk.injEq, Ne.symm hgrid, false_and, and_false, ↓reduceIte, + Finset.sum_const_zero, sub_self, + Subtype.exists, right_eq_ite_iff, zero_ne_one, imp_false, not_and, not_or, not_exists] + aesop + +end PhysicalRefinementFieldCoordinateCorrectness + +namespace PhysicalRefinementRowProjection + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem +open GapCVP.BinarySourceCoordinateOrder GapCVP.BinarySourceRowOrder GapCVP.FormulaBridge +open GapCVP.SourceOrder GapCVP.PhysicalFamilyRowTM GapCVP.MatrixEntrySemantics +open GapCVP.PhysicalRowOrderProjection + +theorem physicalRefinementGridCard_eq + (formula : ThreeCNF) : + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) = + physGridCard formula := by + simpa only [Fintype.card_coe, physGridCard, physFieldCard, physDegree, physicalFormulaSize, + physicalFormulaVariableCount] using physicalSourceGridCardinality_eq (encodeThreeCNF + formula).length formula + +private theorem paperVariableArityPhysicalRefinementFieldCard_eq + (formula : ThreeCNF) : + Fintype.card + (PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula) = + physFieldCard formula := by + exact sourceFiniteField_card + (sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)) + +/-- GapCVP reduction support. -/ +abbrev physicalRefinementBlockWidth + (formula : ThreeCNF) : ℕ := + physGridCard formula * + physFieldCard formula * + physDegree formula + +theorem physicalRefinementDegree_pos + (formula : ThreeCNF) : + 0 < physDegree formula := + sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)) + +private theorem paperVariableArityPhysicalRefinementFieldCard_pos + (formula : ThreeCNF) : + 0 < physFieldCard formula := by + exact pow_pos (by decide : 0 < (2 : ℕ)) _ + +theorem physicalRefinementGridCard_pos + (formula : ThreeCNF) : + 0 < physGridCard formula := by + rw [← physicalRefinementGridCard_eq formula] + simpa only [Fintype.card_coe, Finset.card_pos] using + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid_card_pos (encodeThreeCNF + formula).length + (srcFormula formula) + +private theorem paperVariableArityPhysicalRefinementBlockWidth_pos + (formula : ThreeCNF) : + 0 < physicalRefinementBlockWidth formula := by + exact Nat.mul_pos + (Nat.mul_pos + (physicalRefinementGridCard_pos formula) + (paperVariableArityPhysicalRefinementFieldCard_pos formula)) + (physicalRefinementDegree_pos formula) + +theorem physicalRefinementFamilySourceBlockCount + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) : + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula clause) = + physicalRefinementBlockWidth formula := by + rw [paperVariableArityPhysicalRefinementFamilyBlockCount, + physicalRefinementGridCard_eq, + paperVariableArityPhysicalRefinementFieldCard_eq] + +private theorem paperVariableArityPhysicalRefinementFamilyPrefix + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) : + physicalSigmaPrefix + (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula) + (physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula clause) = + physicalFormulaGlobalBoundary formula + + clause.val * physicalRefinementBlockWidth formula := by + have familyBound : + 1 + clause.val ≤ + paperExplicitFamilyTagCount + (encodeThreeCNF formula).length formula := by + have bounded := + (physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula clause).isLt + rw [paperVariableArityPhysicalRefinementFamilyIndex_val] at bounded + omega + unfold physicalSigmaPrefix + change + (∑ index : Fin (1 + clause.val), + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (Fin.castLE familyBound index)) = + physicalFormulaGlobalBoundary formula + + clause.val * physicalRefinementBlockWidth formula + rw [Fin.sum_univ_add, Fin.sum_univ_one] + have first : + (Fin.castLE familyBound + (Fin.castAdd clause.val (0 : Fin 1))) = + (⟨0, physicalFamilyTagCount_pos + (encodeThreeCNF formula).length formula⟩ : + Fin (paperExplicitFamilyTagCount + (encodeThreeCNF formula).length formula)) := by + apply Fin.ext + rfl + rw [first, physicalFirstFamilyBlockCount, + physicalRefinementGridCard_eq] + congr 1 + have blocks : + (∑ index : Fin clause.val, + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (Fin.castLE familyBound (Fin.natAdd 1 index))) = + ∑ _index : Fin clause.val, + physicalRefinementBlockWidth formula := by + apply Finset.sum_congr rfl + intro index _ + let selectedClause : + Fin (srcFormula formula).clauses.length := + ⟨index.val, Nat.lt_trans index.isLt clause.isLt⟩ + have selected : + (Fin.castLE familyBound (Fin.natAdd 1 index)) = + physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula selectedClause := by + apply Fin.ext + simp only [Fin.val_castLE, Fin.val_natAdd, + paperVariableArityPhysicalRefinementFamilyIndex_val, + selectedClause] + rw [selected, + physicalRefinementFamilySourceBlockCount] + rw [blocks] + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, smul_eq_mul] + +private theorem paperVariableArityPhysicalRowOrder_refinementClause_iff + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (clause : Fin (srcFormula formula).clauses.length) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 = + .inr (.inl clause) ↔ + physicalFormulaGlobalBoundary formula + + clause.val * physicalRefinementBlockWidth formula + ≤ row.val ∧ + row.val < + physicalFormulaGlobalBoundary formula + + (clause.val + 1) * + physicalRefinementBlockWidth formula := by + let encodingLength := (encodeThreeCNF formula).length + let blockCount := paperExplicitBinaryFamilyBlockCount + encodingLength formula + let selectedFamily := physicalRefinementFamilyIndex + encodingLength formula clause + calc + (physicalWordDecodedRow + encodingLength formula row).1 = .inr (.inl clause) ↔ + physicalRowDependentFamilyIndex + encodingLength formula row = selectedFamily := by + rw [physicalRowOrder_family] + change + paperExplicitFamilyWordOrder + encodingLength formula + (physicalRowDependentFamilyIndex + encodingLength formula row) = .inr (.inl clause) ↔ + physicalRowDependentFamilyIndex + encodingLength formula row = + (paperExplicitFamilyWordOrder + encodingLength formula).symm (.inr (.inl clause)) + exact (paperExplicitFamilyWordOrder + encodingLength formula).eq_symm_apply.symm + _ ↔ physicalSigmaPrefix blockCount selectedFamily + ≤ row.val ∧ + row.val < + physicalSigmaPrefix blockCount selectedFamily + + blockCount selectedFamily := by + exact paperVariableArityPhysicalSigmaFamilyIndex_eq_iff + blockCount row selectedFamily + _ ↔ physicalFormulaGlobalBoundary formula + + clause.val * physicalRefinementBlockWidth formula + ≤ row.val ∧ + row.val < + physicalFormulaGlobalBoundary formula + + (clause.val + 1) * + physicalRefinementBlockWidth formula := by + change + physicalSigmaPrefix + (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula) + (physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula clause) ≤ row.val ∧ + row.val < + physicalSigmaPrefix + (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula) + (physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula clause) + + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula clause) ↔ _ + rw [paperVariableArityPhysicalRefinementFamilyPrefix, + physicalRefinementFamilySourceBlockCount] + simp only [Nat.add_mul, one_mul, Nat.add_assoc] + +private theorem paperVariableArityPhysicalRefinementProductFieldWordRank + (encodingLength : ℕ) (formula : ThreeCNF) + (fieldRow : Fin + (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula) × + PaperVariableArityPhysicalWordField encodingLength formula))) : + ((sourceFormulaFieldCardOrder encodingLength + (srcFormula formula)).symm + ((sourceFormulaExplicitRefinementOrder encodingLength + (srcFormula formula) fieldRow).2)).val = + fieldRow.val % + Fintype.card + (PaperVariableArityPhysicalWordField encodingLength formula) := by + simp only [sourceFormulaExplicitRefinementOrder, finProdFinEquiv, Equiv.symm_mk, + Equiv.trans_apply, + finCongr_apply, Equiv.coe_fn_mk, Equiv.prodCongr_apply, Prod.map_apply, + Equiv.symm_apply_apply, Fin.coe_modNat, + Fin.val_cast] + +private theorem paperVariableArityPhysicalRefinementProductGridWordRank + (encodingLength : ℕ) (formula : ThreeCNF) + (fieldRow : Fin + (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula) × + PaperVariableArityPhysicalWordField encodingLength formula))) : + ((sourceFormulaGridOrder encodingLength + (srcFormula formula)).symm + ((sourceFormulaExplicitRefinementOrder encodingLength + (srcFormula formula) fieldRow).1)).val = + fieldRow.val / + Fintype.card + (PaperVariableArityPhysicalWordField encodingLength formula) := by + simp only [sourceFormulaExplicitRefinementOrder, finProdFinEquiv, Equiv.symm_mk, + sourceFormulaExplicitGridOrder, Equiv.trans_apply, finCongr_apply, Equiv.coe_fn_mk, + Equiv.prodCongr_apply, + Equiv.coe_trans, Prod.map_apply, Function.comp_apply, Equiv.symm_apply_apply, Fin.val_cast, + Fin.coe_divNat] + +end PhysicalRefinementRowProjection + +namespace PhysicalRefinementSelectedRowProjection + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.PhysicalFamilyRowTM +open GapCVP.MatrixEntrySemantics GapCVP.PhysicalRowOrderProjection +open GapCVP.PhysicalRefinementRowProjection + +private def physicalDecodedRefinementClause + (formula : ThreeCNF) (row : ℕ) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row ∧ + row < physicalFormulaRefinementBoundary formula) : + Fin (srcFormula formula).clauses.length := by + refine ⟨(row - physicalFormulaGlobalBoundary formula) / + physicalRefinementBlockWidth formula, ?_⟩ + apply (Nat.div_lt_iff_lt_mul + (paperVariableArityPhysicalRefinementBlockWidth_pos formula)).mpr + have upper := inRefinement.2 + change + row < physicalFormulaGlobalBoundary formula + + (noTautClauses formula).length * + physGridCard formula * + physFieldCard formula * + physDegree formula at upper + change + row - physicalFormulaGlobalBoundary formula < + (srcFormula formula).clauses.length * + (physGridCard formula * + physFieldCard formula * + physDegree formula) + rw [paperVariableAritySourceFormula_clauses_length] + simp only [← Nat.mul_assoc] at upper ⊢ + omega + +private theorem paperVariableArityPhysicalDecodedRefinementClause_val + (formula : ThreeCNF) (row : ℕ) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row ∧ + row < physicalFormulaRefinementBoundary formula) : + (physicalDecodedRefinementClause + formula row inRefinement).val = + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) / + physGridCard formula := by + change + (row - physicalFormulaGlobalBoundary formula) / + (physGridCard formula * + physFieldCard formula * + physDegree formula) = _ + rw [Nat.div_div_eq_div_mul, Nat.div_div_eq_div_mul] + congr 1 + ac_rfl + +private theorem paperVariableArityPhysicalRowOrder_refinementFamily + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 = + .inr (.inl + (physicalDecodedRefinementClause + formula row.val inRefinement)) := by + let width := physicalRefinementBlockWidth formula + let localRank := + row.val - physicalFormulaGlobalBoundary formula + have positive := paperVariableArityPhysicalRefinementBlockWidth_pos formula + have selected : + (physicalDecodedRefinementClause + formula row.val inRefinement).val = localRank / width := by + rfl + apply (paperVariableArityPhysicalRowOrder_refinementClause_iff + formula row + (physicalDecodedRefinementClause + formula row.val inRefinement)).mpr + change + physicalFormulaGlobalBoundary formula + + (physicalDecodedRefinementClause + formula row.val inRefinement).val * width ≤ row.val ∧ + row.val < physicalFormulaGlobalBoundary formula + + ((physicalDecodedRefinementClause + formula row.val inRefinement).val + 1) * width + rw [selected] + have lower := Nat.div_mul_le_self localRank width + have upper := (Nat.div_lt_iff_lt_mul positive).mp + (Nat.lt_succ_self (localRank / width)) + dsimp [localRank, width] at lower upper ⊢ + omega + +private theorem paperVariableArityPhysicalRefinementDependentFamilyIndex + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) : + physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row = + physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula + (physicalDecodedRefinementClause + formula row.val inRefinement) := by + apply (paperExplicitFamilyWordOrder + (encodeThreeCNF formula).length formula).injective + rw [← physicalRowOrder_family, + paperVariableArityPhysicalRowOrder_refinementFamily formula row + inRefinement] + simp only [List.get_eq_getElem, physicalRefinementFamilyIndex, Equiv.apply_symm_apply] + +private theorem paperVariableArityPhysicalRefinementDependentBlockRank_lt + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) : + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val < + physicalRefinementBlockWidth formula := by + calc + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val < + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row) := + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).isLt + _ = physicalRefinementBlockWidth formula := by + rw [paperVariableArityPhysicalRefinementDependentFamilyIndex + formula row inRefinement, + physicalRefinementFamilySourceBlockCount] + +private theorem paperVariableArityPhysicalRefinementGlobalSubtractedRank + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) : + row.val - physicalFormulaGlobalBoundary formula = + (physicalDecodedRefinementClause + formula row.val inRefinement).val * + physicalRefinementBlockWidth formula + + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val := by + let blockCount := paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + let selected := physicalDecodedRefinementClause + formula row.val inRefinement + have family := paperVariableArityPhysicalRefinementDependentFamilyIndex + formula row inRefinement + have prefixEquality : + physicalSigmaPrefix blockCount + (physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row) = + physicalFormulaGlobalBoundary formula + + selected.val * + physicalRefinementBlockWidth formula := by + calc + physicalSigmaPrefix blockCount + (physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row) = + physicalSigmaPrefix blockCount + (physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula selected) := + congrArg (physicalSigmaPrefix blockCount) family + _ = physicalFormulaGlobalBoundary formula + + selected.val * + physicalRefinementBlockWidth formula := + paperVariableArityPhysicalRefinementFamilyPrefix formula selected + have rank := physicalRowDependentRank_eq_prefix + (encodeThreeCNF formula).length formula row + change + row.val = + physicalSigmaPrefix blockCount + (physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row) + + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val at rank + rw [prefixEquality] at rank + dsimp [selected] at rank ⊢ + omega + +private theorem paperVariableArityPhysicalRefinementDecodedFieldRowRank + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.1.val = + ((row.val - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + (physGridCard formula * + physFieldCard formula) := by + rw [physicalRowOrder_fieldRow] + let localRank := (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val + let grid := physGridCard formula + let field := physFieldCard formula + let degree := physDegree formula + let clause := physicalDecodedRefinementClause + formula row.val inRefinement + have bounded : localRank < grid * field * degree := + paperVariableArityPhysicalRefinementDependentBlockRank_lt + formula row inRefinement + have degreePositive : 0 < degree := + physicalRefinementDegree_pos formula + have quotientBound : localRank / degree < grid * field := by + apply (Nat.div_lt_iff_lt_mul degreePositive).mpr + simpa only [Nat.mul_assoc] using bounded + have sourceRank : + row.val - physicalFormulaGlobalBoundary formula = + clause.val * (grid * field * degree) + localRank := + paperVariableArityPhysicalRefinementGlobalSubtractedRank + formula row inRefinement + change localRank / degree = + ((row.val - physicalFormulaGlobalBoundary formula) / + degree) % (grid * field) + rw [sourceRank] + have quotient : + (clause.val * (grid * field * degree) + localRank) / degree = + clause.val * (grid * field) + localRank / degree := by + calc + (clause.val * (grid * field * degree) + localRank) / degree = + (degree * (clause.val * (grid * field)) + localRank) / degree := by + congr 1 + ac_rfl + _ = clause.val * (grid * field) + localRank / degree := + Nat.mul_add_div degreePositive + (clause.val * (grid * field)) localRank + rw [quotient] + simp only [Nat.add_mod, Nat.mul_mod_left, Nat.mod_eq_of_lt quotientBound, zero_add] + +end PhysicalRefinementSelectedRowProjection + +namespace PhysicalRefinementSelectedProductProjection + +open GapCVP.BinaryEncoding GapCVP.SourceOrder GapCVP.PhysicalFamilyRowTM +open GapCVP.MatrixEntrySemantics + +private theorem paperVariableArityPhysicalDecodedRefinementBasisRank + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.2.val = + row.val % physDegree formula := + GapCVP.PhysicalRowOrderProjection.physicalRowOrder_basis_val + (encodeThreeCNF formula).length formula row + +end PhysicalRefinementSelectedProductProjection + +namespace PhysicalRefinementColumnTagProjection + +open scoped BigOperators + +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.ClauseOffsetTM + +private def physicalRetainedClause + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) : + ThreeClause := + (noTautClauses formula).get + ⟨clause.val, by + simpa only [srcFormula, paperSourceNormalizedClauses, + List.length_map, List.length_attach] using clause.isLt⟩ + +@[simp] private theorem paperVariableArityPhysicalRetainedClauseWidth + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) : + paperFormulaClauseWidth formula clause = + (paperSourceNormalizedClause + (physicalRetainedClause formula clause)).length := by + simp only [paperFormulaClauseWidth, paperSourceNormalizedClauses, paperFormulaRetainedClause, + srcFormula, + List.get_eq_getElem, List.getElem_attach, List.getElem_map, + physicalRetainedClause] + rfl + +private theorem paperVariableArityPhysicalRetainedClauseWeight + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) : + 2 ^ paperFormulaClauseWidth formula clause - 1 = + sourceClauseWeight + (physicalRetainedClause formula clause) := by + simp only [paperVariableArityPhysicalRetainedClauseWidth, sourceClauseWeight] + +private def paperDependentClausePrefix + {size : ℕ} (weight : Fin size → ℕ) (clause : Fin size) : ℕ := + ∑ index : Fin clause.val, weight (Fin.castLE clause.isLt.le index) + +private theorem paperVariableArityDependentClausePrefix_next_le + {size : ℕ} (weight : Fin size → ℕ) + (left right : Fin size) (hless : left.val < right.val) : + paperDependentClausePrefix weight left + weight left ≤ + paperDependentClausePrefix weight right := by + let extended : ℕ → ℕ := + fun index => if hindex : index < size + then weight ⟨index, hindex⟩ else 0 + have leftSum : + paperDependentClausePrefix weight left = + ∑ index ∈ Finset.range left.val, extended index := by + unfold paperDependentClausePrefix + rw [← Fin.sum_univ_eq_sum_range extended left.val] + apply Finset.sum_congr rfl + intro index _ + simp only [extended, dite_eq_left (Nat.lt_trans index.isLt left.isLt)] + rfl + have rightSum : + paperDependentClausePrefix weight right = + ∑ index ∈ Finset.range right.val, extended index := by + unfold paperDependentClausePrefix + rw [← Fin.sum_univ_eq_sum_range extended right.val] + apply Finset.sum_congr rfl + intro index _ + simp only [extended, dite_eq_left (Nat.lt_trans index.isLt right.isLt)] + rfl + rw [leftSum, rightSum] + calc + (∑ index ∈ Finset.range left.val, extended index) + weight left = + ∑ index ∈ Finset.range (left.val + 1), extended index := by + rw [Finset.sum_range_succ] + simp only [left.isLt, ↓reduceDIte, Fin.eta, extended] + _ ≤ ∑ index ∈ Finset.range right.val, extended index := + Finset.sum_le_sum_of_subset + (Finset.range_mono (by omega)) + +private theorem paperVariableArityDependentSigmaClause_iff + {size : ℕ} (weight : Fin size → ℕ) + (clause : Fin size) + (word : Fin (∑ index : Fin size, weight index)) : + ((finSigmaFinEquiv.symm word : + (index : Fin size) × Fin (weight index)).fst = clause) ↔ + paperDependentClausePrefix weight clause ≤ word.val ∧ + word.val < + paperDependentClausePrefix weight clause + + weight clause := by + let decoded : (index : Fin size) × Fin (weight index) := + finSigmaFinEquiv.symm word + have rank : word.val = + paperDependentClausePrefix weight decoded.fst + + decoded.snd.val := by + have hword : finSigmaFinEquiv decoded = word := by + simp only [Equiv.apply_symm_apply, decoded] + have hval := congrArg Fin.val hword + simpa only [paperDependentClausePrefix, finSigmaFinEquiv_apply] using hval.symm + constructor + · intro hclause + change decoded.fst = clause at hclause + subst clause + have hbound := decoded.snd.isLt + omega + · rintro ⟨hlower, hupper⟩ + change decoded.fst = clause + apply Fin.ext + rcases lt_trichotomy decoded.fst.val clause.val with hless | hequal | hgreater + · have hdisjoint := + paperVariableArityDependentClausePrefix_next_le + weight decoded.fst clause hless + have hbound := decoded.snd.isLt + omega + · exact hequal + · have hdisjoint := + paperVariableArityDependentClausePrefix_next_le + weight clause decoded.fst hgreater + omega + +end PhysicalRefinementColumnTagProjection + +namespace SourceClausePrefixBridge + +open scoped BigOperators + +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.FormulaBridge GapCVP.ClauseOffsetTM +open GapCVP.SourceOrder GapCVP.CanonicalOffsetIdentity + +private theorem paperVariableAritySourceFiniteClauseWeight_eq + (formula : ThreeCNF) + (index : Fin (srcFormula formula).clauses.length) : + 2 ^ paperFormulaClauseWidth formula index - 1 = + sourceClauseWeight + ((noTautClauses formula).get + (Fin.cast + (paperVariableAritySourceFormula_clauses_length formula) + index)) := by + let retainedIndex : Fin + (noTautClauses formula).length := + Fin.cast + (paperVariableAritySourceFormula_clauses_length formula) + index + have hindex : + paperRetainedOriginalClauseIndexOrder + formula retainedIndex = index := by + apply Fin.ext + rfl + have hwidth := paperFormulaClauseWidth_retainedOriginal + formula retainedIndex + rw [hindex] at hwidth + rw [hwidth] + rfl + +/-- GapCVP reduction support. -/ +def sourceRetainedPrefixIndex + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) + (index : Fin clause.val) : + Fin (noTautClauses formula).length := + Fin.cast (paperVariableAritySourceFormula_clauses_length formula) + (Fin.castLE clause.isLt.le index) + +private theorem paperVariableAritySourceIndexedClausePrefix_eq_weightSum + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) : + (∑ index : Fin clause.val, + sourceClauseWeight + ((noTautClauses formula).get + (sourceRetainedPrefixIndex + formula clause index))) = + sourceClauseWeightSum + ((noTautClauses formula).take clause.val) := by + let retained := noTautClauses formula + have hretained : clause.val ≤ retained.length := by + have positive : clause.val < retained.length := by + simpa only [srcFormula, + GapCVP.SourcePreprocessingSemantics.paperSourceNormalizedClauses, + List.length_map, List.length_attach, retained] using clause.isLt + exact Nat.le_of_lt positive + have htake : (retained.take clause.val).length = clause.val := by + simp only [List.length_take, Nat.min_eq_left hretained] + let order : Fin (retained.take clause.val).length ≃ Fin clause.val := + finCongr htake + let weight : Fin clause.val → ℕ := fun index => + sourceClauseWeight + (retained.get + (sourceRetainedPrefixIndex + formula clause index)) + change (∑ index : Fin clause.val, weight index) = _ + calc + (∑ index : Fin clause.val, weight index) = + ∑ index : Fin (retained.take clause.val).length, + weight (order index) := by + symm + exact order.sum_comp weight + _ = ∑ index : Fin (retained.take clause.val).length, + sourceClauseWeight + ((retained.take clause.val).get index) := by + apply Finset.sum_congr rfl + intro index _ + have hget : + retained.get + (sourceRetainedPrefixIndex + formula clause (order index)) = + (retained.take clause.val).get index := by + simp only [List.get_eq_getElem, List.getElem_take] + rfl + exact congrArg sourceClauseWeight hget + _ = sourceClauseWeightSum + (retained.take clause.val) := by + symm + exact sourceListWeightSum + (retained.take clause.val) + sourceClauseWeight + +theorem paperVariableAritySourceDependentClausePrefix_eq_weightSum + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) : + (∑ index : Fin clause.val, + (2 ^ paperFormulaClauseWidth formula + (Fin.castLE clause.isLt.le index) - 1)) = + sourceClauseWeightSum + ((noTautClauses formula).take clause.val) := by + calc + (∑ index : Fin clause.val, + (2 ^ paperFormulaClauseWidth formula + (Fin.castLE clause.isLt.le index) - 1)) = + ∑ index : Fin clause.val, + sourceClauseWeight + ((noTautClauses formula).get + (sourceRetainedPrefixIndex + formula clause index)) := by + apply Finset.sum_congr rfl + intro index _ + exact paperVariableAritySourceFiniteClauseWeight_eq + formula (Fin.castLE clause.isLt.le index) + _ = sourceClauseWeightSum + ((noTautClauses formula).take clause.val) := + paperVariableAritySourceIndexedClausePrefix_eq_weightSum + formula clause + +end SourceClausePrefixBridge + +namespace PhysicalRefinementColumnTagSourceCorrectness + +open scoped BigOperators + +open GapCVP.BinaryEncoding GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.FormulaBridge GapCVP.SourceOrder +open GapCVP.ClauseOffsetTM GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalColumnOrderProjection +open GapCVP.PhysicalRefinementColumnTagProjection GapCVP.SourceClausePrefixBridge + +theorem paperVariableAritySourceLocalTypeWordRank + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) + (tuple : ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple) : + ((sourceTypeCardWordOrder formula).symm + (Sum.inr ⟨clause, tuple⟩)).val = + 1 + (finSigmaFinEquiv + (n := fun index : + Fin (srcFormula formula).clauses.length => + 2 ^ paperFormulaClauseWidth formula index - 1) + ⟨clause, + (paperFormulaClauseTupleWordOrder + formula clause).symm tuple⟩).val := by + rfl + +private theorem paperVariableAritySourceTypeLocalTag_iff + (formula : ThreeCNF) + (tableType : GapCVP.Core.sourceSATTableType + (srcFormula formula)) + (clause : Fin (srcFormula formula).clauses.length) : + (∃ tuple : ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple, + tableType = Sum.inr ⟨clause, tuple⟩) ↔ + ((sourceTypeCardWordOrder + formula).symm tableType).val ≠ 0 ∧ + paperDependentClausePrefix + (fun index => + 2 ^ paperFormulaClauseWidth formula index - 1) + clause ≤ + ((sourceTypeCardWordOrder + formula).symm tableType).val - 1 ∧ + ((sourceTypeCardWordOrder + formula).symm tableType).val - 1 < + paperDependentClausePrefix + (fun index => + 2 ^ paperFormulaClauseWidth formula index - 1) + clause + + (2 ^ paperFormulaClauseWidth formula clause - 1) := by + classical + cases tableType with + | inl global => + cases global + constructor + · rintro ⟨tuple, equality⟩ + cases equality + · rintro ⟨nonzero, _⟩ + exact False.elim + (nonzero + (paperVariableArityGlobalTypeWordRank_zero formula)) + | inr selectedLocal => + rcases selectedLocal with ⟨selected, tuple⟩ + let weight : + Fin (srcFormula formula).clauses.length → ℕ := + fun index => + 2 ^ paperFormulaClauseWidth formula index - 1 + let word : Fin (∑ index, weight index) := + finSigmaFinEquiv (n := weight) + ⟨selected, + (paperFormulaClauseTupleWordOrder + formula selected).symm tuple⟩ + have rank : + ((sourceTypeCardWordOrder formula).symm + (Sum.inr ⟨selected, tuple⟩)).val = 1 + word.val := by + exact paperVariableAritySourceLocalTypeWordRank + formula selected tuple + have selectedTag : + (∃ candidate : ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple, + (Sum.inr ⟨selected, tuple⟩ : + GapCVP.Core.sourceSATTableType + (srcFormula formula)) = + Sum.inr ⟨clause, candidate⟩) ↔ + selected = clause := by + constructor + · rintro ⟨candidate, hcandidate⟩ + have hsigma : + (⟨selected, tuple⟩ : + (index : Fin (srcFormula + formula).clauses.length) × + ((srcFormula + formula).clauses.get index).SatisfyingLocalTuple) = + ⟨clause, candidate⟩ := Sum.inr.inj hcandidate + exact congrArg Sigma.fst hsigma + · intro hselected + subst clause + exact ⟨tuple, rfl⟩ + have decoded : + ((finSigmaFinEquiv.symm word : + (index : Fin (srcFormula + formula).clauses.length) × Fin (weight index)).fst) = + selected := by + simp only [List.get_eq_getElem, Equiv.symm_apply_apply, word] + have interval := + paperVariableArityDependentSigmaClause_iff + weight clause word + rw [decoded] at interval + rw [selectedTag, rank] + change selected = clause ↔ + 1 + word.val ≠ 0 ∧ + paperDependentClausePrefix weight clause ≤ + 1 + word.val - 1 ∧ + 1 + word.val - 1 < + paperDependentClausePrefix weight clause + + weight clause + omega + +private theorem paperVariableArityPhysicalSourceCoordinateLocalTag_iff + (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) + (clause : Fin (srcFormula formula).clauses.length) : + (∃ tuple : ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple, + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 = + Sum.inr ⟨clause, tuple⟩) ↔ + let rank := + (column.val / + physFieldCard formula) / + physGridCard formula + let lower := sourceClauseWeightSum + ((noTautClauses formula).take clause.val) + let weight := sourceClauseWeight + (physicalRetainedClause formula clause) + rank ≠ 0 ∧ lower ≤ rank - 1 ∧ rank - 1 < lower + weight := by + have hsemantic := paperVariableAritySourceTypeLocalTag_iff + formula + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 clause + have hrank := sourceCoordinateTypeWordRank + (encodeThreeCNF formula).length formula column + rw [physicalFormulaFieldCardinality_eq_card, + physicalFormulaGridCardinality_eq_card] at hrank + rw [hrank] at hsemantic + unfold paperDependentClausePrefix at hsemantic + rw [paperVariableAritySourceDependentClausePrefix_eq_weightSum + formula clause] at hsemantic + rw [paperVariableArityPhysicalRetainedClauseWeight + formula clause] at hsemantic + exact hsemantic + +private theorem paperVariableArityPhysicalSourceCoordinateGlobalOrLocalTag_iff + (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) + (clause : Fin (srcFormula formula).clauses.length) : + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 = Sum.inl () ∨ + ∃ tuple : ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple, + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 = + Sum.inr ⟨clause, tuple⟩) ↔ + let rank := + (column.val / + physFieldCard formula) / + physGridCard formula + let lower := sourceClauseWeightSum + ((noTautClauses formula).take clause.val) + let weight := sourceClauseWeight + (physicalRetainedClause formula clause) + rank = 0 ∨ + (lower ≤ rank - 1 ∧ rank - 1 < lower + weight) := by + rw [paperVariableAritySourceCoordinate_isGlobal_iff, + paperVariableArityPhysicalSourceCoordinateLocalTag_iff] + dsimp + omega + +end PhysicalRefinementColumnTagSourceCorrectness + +namespace RefinementClauseOffsetTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert +open GapCVP.SourceIndexedClauseLookupTM GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingTM GapCVP.ClauseOffsetTM GapCVP.ShiftedTupleTM + +/-- GapCVP reduction support. -/ +def paperRefinementClauseRankEnvelope + (formula : ThreeCNF) (rank : ℕ) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + paperShiftedRetainedClauseWidth + (encodeThreeCNF formula) + +/-- GapCVP reduction support. -/ +noncomputable def paperRefinementPrefixRankWidth : + SourceQaryMaskDynamicGridWidth where + output := firstFieldContents + computer := firstFieldContentsComputable + +@[simp] private theorem paperVariableArityRefinementPrefixRankWidth_output + (input : List Bool) : + paperRefinementPrefixRankWidth.output input = + firstFieldContents input := by + rfl + +/-- GapCVP reduction support. -/ +def paperRefinementPrefixRankEnvelope + (formula : ThreeCNF) (outer inner : ℕ) : List Bool := + lengthPrefixedWord (List.replicate inner true) ++ + sourceQaryMaskDynamicGridBaseSource + paperRefinementPrefixRankWidth + (paperRefinementClauseRankEnvelope formula outer) + +/-- GapCVP reduction support. -/ +def paperRefinementPrefixIndexedClauseQuery + (input : List Bool) : List Bool := + firstFieldContents input ++ + false :: paperVariableArityShiftedRetainedSourceWord + (paperSourcePreprocessingSuffixAt 4 input) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityRefinementPrefixIndexedClauseQueryComputable : + BitTM + paperRefinementPrefixIndexedClauseQuery := by + have retained := GapCVP.TMComposition.computableInPolyTime + (paperPreprocessingSuffixAtComputable 4) + paperVariableArityShiftedRetainedSourceWordComputable + have delimited := GapCVP.TMComposition.computableInPolyTime + retained (prependBitComputable false) + exact pointwiseAppendComputable + firstFieldContentsComputable delimited + +@[simp] theorem paperVariableArityRefinementPrefixIndexedClauseQuery_valid + (formula : ThreeCNF) (outer inner : ℕ) : + paperRefinementPrefixIndexedClauseQuery + (paperRefinementPrefixRankEnvelope formula outer inner) = + sourceOriginalIndexedClauseQuery inner + (noTautClauses formula) := by + simp [paperRefinementPrefixIndexedClauseQuery, + paperRefinementPrefixRankEnvelope, + paperRefinementClauseRankEnvelope, + sourceQaryMaskDynamicGridBaseSource, + paperVariableArityRefinementPrefixRankWidth_output, + paperSourcePreprocessingSuffixAt, + Function.iterate_succ_apply, + sourceOriginalIndexedClauseQuery, + paperSourcePreprocessingFilteredFormulaWord_valid] + +private def paperRefinementPrefixIndexedClauseWeightUnary : + List Bool → List Bool := + paperVariableArityClauseWeightUnary ∘ + sourceOriginalIndexedClauseOutput ∘ + paperRefinementPrefixIndexedClauseQuery + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityRefinementPrefixIndexedClauseWeightUnaryComputable : + BitTM + paperRefinementPrefixIndexedClauseWeightUnary := by + have indexed := GapCVP.TMComposition.computableInPolyTime + paperVariableArityRefinementPrefixIndexedClauseQueryComputable + sourceOriginalIndexedClauseComputable + exact GapCVP.TMComposition.computableInPolyTime + indexed paperClauseWeightUnaryComputable + +private theorem paperVariableArityRefinementPrefixIndexedClauseWeightUnary_valid + (formula : ThreeCNF) (outer inner : ℕ) + (hinner : inner < (noTautClauses formula).length) : + paperRefinementPrefixIndexedClauseWeightUnary + (paperRefinementPrefixRankEnvelope + formula outer inner) = + List.replicate + (sourceClauseWeight + ((noTautClauses formula).get + ⟨inner, hinner⟩)) true := by + unfold paperRefinementPrefixIndexedClauseWeightUnary + simp only [Function.comp_apply] + rw [paperVariableArityRefinementPrefixIndexedClauseQuery_valid, + sourceOriginalIndexedClauseOutput_valid inner + (noTautClauses formula) hinner] + simpa only [List.get_eq_getElem, sourceClauseWeight, List.append_nil] using + paperVariableArityClauseWeightUnary_valid ((noTautClauses formula).get ⟨inner, hinner⟩) [] + +private def paperRefinementIndexedSourceClauseWeight + (clauses : List ThreeClause) (rank : ℕ) : ℕ := + match clauses[rank]? with + | some clause => sourceClauseWeight clause + | none => 0 + +private theorem paperVariableArityRefinementSourceClauseWeight_flatMap + (clauses : List ThreeClause) : + (List.range clauses.length).flatMap + (fun rank => List.replicate + (paperRefinementIndexedSourceClauseWeight + clauses rank) true) = + List.replicate + (sourceClauseWeightSum clauses) true := by + induction clauses with + | nil => + simp only [List.length_nil, List.range_zero, List.flatMap_nil, sourceClauseWeightSum, + List.map_nil, + List.sum_nil, List.replicate_zero] + | cons clause remaining ih => + simp only [paperRefinementIndexedSourceClauseWeight, List.length_cons, + List.range_succ_eq_map, + List.flatMap_cons, lt_add_iff_pos_left, Order.lt_add_one_iff, zero_le, getElem?_pos, + List.getElem_cons_zero, + List.flatMap_map, Nat.succ_eq_add_one, List.getElem?_cons_succ, sourceClauseWeightSum, + List.map_cons, List.sum_cons] + change + List.replicate (sourceClauseWeight clause) true ++ + (List.range remaining.length).flatMap + (fun rank => List.replicate + (paperRefinementIndexedSourceClauseWeight + remaining rank) true) = + List.replicate + (sourceClauseWeight clause + + sourceClauseWeightSum remaining) + true + rw [ih, List.replicate_append_replicate] + +/-- GapCVP reduction support. -/ +def paperRefinementClauseOffsetUnary : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + paperRefinementPrefixRankWidth + paperVariableArityRefinementPrefixIndexedClauseWeightUnaryComputable + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityRefinementClauseOffsetUnaryComputable : + BitTM + paperRefinementClauseOffsetUnary := + maskDynamicGridRecordCatalogueComputable + paperRefinementPrefixRankWidth + paperVariableArityRefinementPrefixIndexedClauseWeightUnaryComputable + +theorem paperVariableArityRefinementClauseOffsetUnary_valid + (formula : ThreeCNF) (rank : ℕ) + (hbound : rank ≤ (noTautClauses formula).length) : + paperRefinementClauseOffsetUnary + (paperRefinementClauseRankEnvelope formula rank) = + List.replicate + (sourceClauseWeightSum + ((noTautClauses formula).take rank)) true := by + have hwidth : + paperRefinementPrefixRankWidth.output + (paperRefinementClauseRankEnvelope formula rank) = + List.replicate rank true := by + rw [paperVariableArityRefinementPrefixRankWidth_output] + simp only [paperRefinementClauseRankEnvelope, firstFieldContents_valid] + have catalogue := maskDynamicGridRecordCatalogueOutput_valid + paperRefinementPrefixRankWidth + paperVariableArityRefinementPrefixIndexedClauseWeightUnaryComputable + (paperRefinementClauseRankEnvelope formula rank) + rank hwidth + change maskDynamicGridRecordCatalogueOutput + paperRefinementPrefixRankWidth + paperVariableArityRefinementPrefixIndexedClauseWeightUnaryComputable + (paperRefinementClauseRankEnvelope formula rank) = _ + rw [catalogue] + rw [← paperVariableArityRefinementSourceClauseWeight_flatMap + ((noTautClauses formula).take rank)] + have hlength : + ((noTautClauses formula).take rank).length = rank := by + simp only [List.length_take, Nat.min_eq_left hbound] + rw [hlength] + apply List.flatMap_congr + intro inner hmem + have hlt : inner < rank := List.mem_range.mp hmem + have hinner : inner < + (noTautClauses formula).length := + Nat.lt_of_lt_of_le hlt hbound + change paperRefinementPrefixIndexedClauseWeightUnary + (paperRefinementPrefixRankEnvelope + formula rank inner) = _ + rw [paperVariableArityRefinementPrefixIndexedClauseWeightUnary_valid + formula rank inner hinner] + simp only [paperRefinementIndexedSourceClauseWeight, + List.getElem?_take, ite_eq_left hlt, + List.getElem?_eq_getElem hinner, List.get_eq_getElem] + +end RefinementClauseOffsetTM + +namespace PhysicalRefinementClauseLocalTagTM + +open Turing +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceIndexedClauseLookupTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryDimensionTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryPhysicalRowBasisDivisionTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.ClauseOffsetTM GapCVP.ShiftedTupleTM +open GapCVP.RefinementClauseOffsetTM GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM +open GapCVP.PhysicalRightHandSideTM GapCVP.PhysicalGlobalRefinementCoefficientTM +open GapCVP.PhysicalRefinementRowProjection + +private def physicalRefinementRowLocalRankUnary : + List Bool → List Bool := + unarySubtractionOutput sourceExplicitAffineCellRow + physicalCellGlobalBoundaryUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementRowLocalRankUnaryComputable : + BitTM + physicalRefinementRowLocalRankUnary := + unarySubtractionComputable sourceExplicitAffineCellRowComputable + paperVariableArityPhysicalCellGlobalBoundaryUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementRowLocalRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementRowLocalRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (row - physicalFormulaGlobalBoundary formula) + true := by + unfold physicalRefinementRowLocalRankUnary + exact unarySubtractionOutput_valid + sourceExplicitAffineCellRow + physicalCellGlobalBoundaryUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + row (physicalFormulaGlobalBoundary formula) + (sourceExplicitAffineCellRow_query row column + (encodeThreeCNF formula)) + (paperVariableArityPhysicalCellGlobalBoundaryUnary_query + row column formula) + +private def physicalRefinementRowFieldQuotientUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + physicalRefinementRowLocalRankUnary + physicalRightHandSideCellDegreeUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementRowFieldQuotientUnaryComputable : + BitTM + physicalRefinementRowFieldQuotientUnary := + sourcePhysicalComputedUnaryQuotientComputable + paperVariableArityPhysicalRefinementRowLocalRankUnaryComputable + paperVariableArityPhysicalRightHandSideCellDegreeUnaryComputable + +@[simp] theorem + paperVariableArityPhysicalRefinementRowFieldQuotientUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementRowFieldQuotientUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) true := by + unfold physicalRefinementRowFieldQuotientUnary + exact sourcePhysicalComputedUnaryQuotient_valid + physicalRefinementRowLocalRankUnary + physicalRightHandSideCellDegreeUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (row - physicalFormulaGlobalBoundary formula) + (physDegree formula) + (physicalRefinementDegree_pos formula) + (paperVariableArityPhysicalRefinementRowLocalRankUnary_query + row column formula) + (paperVariableArityPhysicalRightHandSideCellDegreeUnary_query + row column formula) + +private def physicalRefinementRowFieldValueRankUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + physicalRefinementRowFieldQuotientUnary + physicalCoefficientFieldCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementRowFieldValueRankUnaryComputable : + BitTM + physicalRefinementRowFieldValueRankUnary := + sourcePhysicalComputedUnaryRemainderComputable + paperVariableArityPhysicalRefinementRowFieldQuotientUnaryComputable + paperVariableArityPhysicalCoefficientFieldCardinalityUnaryComputable + +@[simp] theorem + paperVariableArityPhysicalRefinementRowFieldValueRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementRowFieldValueRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula) + true := by + unfold physicalRefinementRowFieldValueRankUnary + exact sourcePhysicalComputedUnaryRemainder_valid + physicalRefinementRowFieldQuotientUnary + physicalCoefficientFieldCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) + (physFieldCard formula) + (physicalCoefficientFieldCardinality_pos formula) + (paperVariableArityPhysicalRefinementRowFieldQuotientUnary_query + row column formula) + (paperVariableArityPhysicalCoefficientFieldCardinalityUnary_query + row column formula) + +private def physicalRefinementRowGridQuotientUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + physicalRefinementRowFieldQuotientUnary + physicalCoefficientFieldCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementRowGridQuotientUnaryComputable : + BitTM + physicalRefinementRowGridQuotientUnary := + sourcePhysicalComputedUnaryQuotientComputable + paperVariableArityPhysicalRefinementRowFieldQuotientUnaryComputable + paperVariableArityPhysicalCoefficientFieldCardinalityUnaryComputable + +@[simp] theorem + paperVariableArityPhysicalRefinementRowGridQuotientUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementRowGridQuotientUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) + true := by + unfold physicalRefinementRowGridQuotientUnary + exact sourcePhysicalComputedUnaryQuotient_valid + physicalRefinementRowFieldQuotientUnary + physicalCoefficientFieldCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) + (physFieldCard formula) + (physicalCoefficientFieldCardinality_pos formula) + (paperVariableArityPhysicalRefinementRowFieldQuotientUnary_query + row column formula) + (paperVariableArityPhysicalCoefficientFieldCardinalityUnary_query + row column formula) + +private def physicalRefinementRowGridRankUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + physicalRefinementRowGridQuotientUnary + physicalCoefficientGridCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementRowGridRankUnaryComputable : + BitTM + physicalRefinementRowGridRankUnary := + sourcePhysicalComputedUnaryRemainderComputable + paperVariableArityPhysicalRefinementRowGridQuotientUnaryComputable + paperVariableArityPhysicalCoefficientGridCardinalityUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementRowGridRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementRowGridRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula) + true := by + unfold physicalRefinementRowGridRankUnary + exact sourcePhysicalComputedUnaryRemainder_valid + physicalRefinementRowGridQuotientUnary + physicalCoefficientGridCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) + (physGridCard formula) + (physicalCoefficientGridCardinality_pos formula) + (paperVariableArityPhysicalRefinementRowGridQuotientUnary_query + row column formula) + (paperVariableArityPhysicalCoefficientGridCardinalityUnary_query + row column formula) + +private def physicalRefinementClauseRankUnary : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + physicalRefinementRowGridQuotientUnary + physicalCoefficientGridCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementClauseRankUnaryComputable : + BitTM + physicalRefinementClauseRankUnary := + sourcePhysicalComputedUnaryQuotientComputable + paperVariableArityPhysicalRefinementRowGridQuotientUnaryComputable + paperVariableArityPhysicalCoefficientGridCardinalityUnaryComputable + +private abbrev physicalRefinementRowClauseRank + (row : ℕ) (formula : ThreeCNF) : ℕ := + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) / + physGridCard formula + +@[simp] private theorem paperVariableArityPhysicalRefinementClauseRankUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementClauseRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalRefinementRowClauseRank row formula) + true := by + unfold physicalRefinementClauseRankUnary + exact sourcePhysicalComputedUnaryQuotient_valid + physicalRefinementRowGridQuotientUnary + physicalCoefficientGridCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) + (physGridCard formula) + (physicalCoefficientGridCardinality_pos formula) + (paperVariableArityPhysicalRefinementRowGridQuotientUnary_query + row column formula) + (paperVariableArityPhysicalCoefficientGridCardinalityUnary_query + row column formula) + +private def physicalRefinementClauseRankEnvelopeOutput + (input : List Bool) : List Bool := + lengthPrefixedWord + (physicalRefinementClauseRankUnary input) ++ + sourceQaryMaskDynamicGridBaseSource + paperShiftedRetainedClauseWidth + (sourceExplicitAffineCellOriginalSource input) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementClauseRankEnvelopeOutputComputable : + BitTM + physicalRefinementClauseRankEnvelopeOutput := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalRefinementClauseRankUnaryComputable + structuralPrefixWriterComputable + have hbase := GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + (maskDynamicGridBaseSourceComputable + paperShiftedRetainedClauseWidth) + exact pointwiseAppendComputable hprefix hbase + +@[simp] theorem + paperVariableArityPhysicalRefinementClauseRankEnvelopeOutput_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementClauseRankEnvelopeOutput + (affineCellQuery row column + (encodeThreeCNF formula)) = + paperRefinementClauseRankEnvelope formula + (physicalRefinementRowClauseRank row formula) := by + unfold physicalRefinementClauseRankEnvelopeOutput + paperRefinementClauseRankEnvelope + rw [paperVariableArityPhysicalRefinementClauseRankUnary_query, + sourceExplicitAffineCellOriginalSource_query] + +private def physicalRefinementClauseOffsetUnary : + List Bool → List Bool := + GapCVP.RefinementClauseOffsetTM.paperRefinementClauseOffsetUnary ∘ + physicalRefinementClauseRankEnvelopeOutput + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementClauseOffsetUnaryComputable : + BitTM + physicalRefinementClauseOffsetUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalRefinementClauseRankEnvelopeOutputComputable + GapCVP.RefinementClauseOffsetTM.paperVariableArityRefinementClauseOffsetUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementClauseOffsetUnary_query + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula ≤ + (noTautClauses formula).length) : + physicalRefinementClauseOffsetUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (sourceClauseWeightSum + ((noTautClauses formula).take + (physicalRefinementRowClauseRank row formula))) + true := by + unfold physicalRefinementClauseOffsetUnary + rw [Function.comp_apply, + paperVariableArityPhysicalRefinementClauseRankEnvelopeOutput_query] + exact paperVariableArityRefinementClauseOffsetUnary_valid + formula (physicalRefinementRowClauseRank row formula) + hbound + +private def physicalRefinementClauseWidthUnary : + List Bool → List Bool := + paperVariableArityClauseWeightUnary ∘ + sourceOriginalIndexedClauseOutput ∘ + paperShiftedIndexedClauseQuery ∘ + physicalRefinementClauseRankEnvelopeOutput + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementClauseWidthUnaryComputable : + BitTM + physicalRefinementClauseWidthUnary := by + have indexed := GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalRefinementClauseRankEnvelopeOutputComputable + paperVariableArityShiftedIndexedClauseQueryComputable + have clause := GapCVP.TMComposition.computableInPolyTime + indexed sourceOriginalIndexedClauseComputable + exact GapCVP.TMComposition.computableInPolyTime + clause paperClauseWeightUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementClauseWidthUnary_query + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : + physicalRefinementClauseWidthUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (sourceClauseWeight + ((noTautClauses formula).get + ⟨physicalRefinementRowClauseRank row formula, + hbound⟩)) true := by + unfold physicalRefinementClauseWidthUnary + simp only [Function.comp_apply] + rw [paperVariableArityPhysicalRefinementClauseRankEnvelopeOutput_query] + unfold paperRefinementClauseRankEnvelope + rw [paperVariableArityShiftedIndexedClauseQuery_valid, + sourceOriginalIndexedClauseOutput_valid + (physicalRefinementRowClauseRank row formula) + (noTautClauses formula) hbound] + simpa only [sourceClauseWeight, List.append_nil] using + (paperVariableArityClauseWeightUnary_valid + ((noTautClauses formula).get + ⟨physicalRefinementRowClauseRank row formula, + hbound⟩) []) + +private def physicalRefinementColumnLocalTagUnary : + List Bool → List Bool := + unarySubtractionOutput + physicalColumnTypeRankUnary + (fun _ => [true]) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementColumnLocalTagUnaryComputable : + BitTM + physicalRefinementColumnLocalTagUnary := + unarySubtractionComputable + paperVariableArityPhysicalColumnTypeRankUnaryComputable + (sourceFixedWordComputable [true]) + +@[simp] theorem + paperVariableArityPhysicalRefinementColumnLocalTagUnary_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementColumnLocalTagUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (((column / + physFieldCard formula) / + physGridCard formula) - 1) + true := by + unfold physicalRefinementColumnLocalTagUnary + exact unarySubtractionOutput_valid + physicalColumnTypeRankUnary + (fun _ => [true]) + (affineCellQuery row column (encodeThreeCNF formula)) + ((column / physFieldCard formula) / + physGridCard formula) + 1 + (paperVariableArityPhysicalColumnTypeRankUnary_query + row column formula) + (by rfl) + +private def physicalRefinementClauseLocalTagUpperUnary : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + physicalRefinementClauseOffsetUnary + physicalRefinementClauseWidthUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementClauseLocalTagUpperUnaryComputable : + BitTM + physicalRefinementClauseLocalTagUpperUnary := + fourFamilyComputedUnarySumComputable + paperVariableArityPhysicalRefinementClauseOffsetUnaryComputable + paperVariableArityPhysicalRefinementClauseWidthUnaryComputable + +@[simp] theorem + paperVariableArityPhysicalRefinementClauseLocalTagUpperUnary_query + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : + physicalRefinementClauseLocalTagUpperUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (sourceClauseWeightSum + ((noTautClauses formula).take + (physicalRefinementRowClauseRank row formula)) + + sourceClauseWeight + ((noTautClauses formula).get + ⟨physicalRefinementRowClauseRank row formula, + hbound⟩)) true := by + unfold physicalRefinementClauseLocalTagUpperUnary + exact fourFamilyComputedUnarySumOutput_valid + physicalRefinementClauseOffsetUnary + physicalRefinementClauseWidthUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (sourceClauseWeightSum + ((noTautClauses formula).take + (physicalRefinementRowClauseRank row formula))) + (sourceClauseWeight + ((noTautClauses formula).get + ⟨physicalRefinementRowClauseRank row formula, + hbound⟩)) + (paperVariableArityPhysicalRefinementClauseOffsetUnary_query + row column formula hbound.le) + (paperVariableArityPhysicalRefinementClauseWidthUnary_query + row column formula hbound) + +private def physicalRefinementLocalTagBelowPrefixBit : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + physicalRefinementColumnLocalTagUnary + physicalRefinementClauseOffsetUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementLocalTagBelowPrefixBitComputable : + BitTM + physicalRefinementLocalTagBelowPrefixBit := + fourFamilyComputedUnaryLessBitComputable + paperVariableArityPhysicalRefinementColumnLocalTagUnaryComputable + paperVariableArityPhysicalRefinementClauseOffsetUnaryComputable + +private def physicalRefinementLocalTagBelowUpperBit : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + physicalRefinementColumnLocalTagUnary + physicalRefinementClauseLocalTagUpperUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementLocalTagBelowUpperBitComputable : + BitTM + physicalRefinementLocalTagBelowUpperBit := + fourFamilyComputedUnaryLessBitComputable + paperVariableArityPhysicalRefinementColumnLocalTagUnaryComputable + paperVariableArityPhysicalRefinementClauseLocalTagUpperUnaryComputable + +private def physicalRefinementLocalTagMarker : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + physicalRefinementLocalTagBelowPrefixBit) + physicalRefinementLocalTagBelowUpperBit + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementLocalTagMarkerComputable : + BitTM + physicalRefinementLocalTagMarker := + fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable + paperVariableArityPhysicalRefinementLocalTagBelowPrefixBitComputable) + paperVariableArityPhysicalRefinementLocalTagBelowUpperBitComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementLocalTagMarker_query + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : + physicalRefinementLocalTagMarker + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (sourceClauseWeightSum + ((noTautClauses formula).take + (physicalRefinementRowClauseRank row formula)) ≤ + ((column / + physFieldCard formula) / + physGridCard formula) - 1 ∧ + ((column / + physFieldCard formula) / + physGridCard formula) - 1 < + sourceClauseWeightSum + ((noTautClauses formula).take + (physicalRefinementRowClauseRank + row formula)) + + sourceClauseWeight + ((noTautClauses formula).get + ⟨physicalRefinementRowClauseRank + row formula, hbound⟩))] := by + let input := affineCellQuery row column + (encodeThreeCNF formula) + let selectedTag := ((column / + physFieldCard formula) / + physGridCard formula) - 1 + let lower := sourceClauseWeightSum + ((noTautClauses formula).take + (physicalRefinementRowClauseRank row formula)) + let width := sourceClauseWeight + ((noTautClauses formula).get + ⟨physicalRefinementRowClauseRank row formula, + hbound⟩) + have hlocal : + physicalRefinementColumnLocalTagUnary input = + List.replicate selectedTag true := + paperVariableArityPhysicalRefinementColumnLocalTagUnary_query + row column formula + have hlower : + physicalRefinementClauseOffsetUnary input = + List.replicate lower true := + paperVariableArityPhysicalRefinementClauseOffsetUnary_query + row column formula hbound.le + have hupper : + physicalRefinementClauseLocalTagUpperUnary input = + List.replicate (lower + width) true := + paperVariableArityPhysicalRefinementClauseLocalTagUpperUnary_query + row column formula hbound + have hlessLower : + physicalRefinementLocalTagBelowPrefixBit input = + [decide (selectedTag < lower)] := + fourFamilyComputedUnaryLessBitOutput_valid + physicalRefinementColumnLocalTagUnary + physicalRefinementClauseOffsetUnary + input selectedTag lower hlocal hlower + have hlessUpper : + physicalRefinementLocalTagBelowUpperBit input = + [decide (selectedTag < lower + width)] := + fourFamilyComputedUnaryLessBitOutput_valid + physicalRefinementColumnLocalTagUnary + physicalRefinementClauseLocalTagUpperUnary + input selectedTag (lower + width) hlocal hupper + have hnot := fourFamilyBooleanNotOutput_bit + physicalRefinementLocalTagBelowPrefixBit + input (decide (selectedTag < lower)) hlessLower + have hand := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput + physicalRefinementLocalTagBelowPrefixBit) + physicalRefinementLocalTagBelowUpperBit + input (!(decide (selectedTag < lower))) + (decide (selectedTag < lower + width)) hnot hlessUpper + change physicalRefinementLocalTagMarker input = + [decide (lower ≤ selectedTag ∧ selectedTag < lower + width)] + change sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput + physicalRefinementLocalTagBelowPrefixBit) + physicalRefinementLocalTagBelowUpperBit input = _ + simpa only [← decide_not, Nat.not_lt, ← Bool.decide_and] using hand + +end PhysicalRefinementClauseLocalTagTM + +namespace PhysicalRefinementCheckSourceCorrectness + +open scoped BigOperators + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.FormulaBridge GapCVP.SourceOrder +open GapCVP.ClauseOffsetTM GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM +open GapCVP.MatrixEntrySemantics GapCVP.PhysicalRightHandSideTM +open GapCVP.PhysicalGlobalRefinementCoefficientTM GapCVP.PhysicalRefinementSelectedRowProjection +open GapCVP.PhysicalRefinementColumnTagProjection +open GapCVP.PhysicalRefinementColumnTagSourceCorrectness +open GapCVP.PhysicalRefinementClauseLocalTagTM + +attribute [local instance] Classical.propDecidable + +private abbrev physicalRefinementColumnTypeRank + (column : ℕ) (formula : ThreeCNF) : ℕ := + (column / physFieldCard formula) / + physGridCard formula + +private abbrev paperVariableArityPhysicalRefinementLocalSourcePrefix + (row : ℕ) (formula : ThreeCNF) : ℕ := + sourceClauseWeightSum + ((noTautClauses formula).take + (physicalRefinementRowClauseRank row formula)) + +private abbrev paperVariableArityPhysicalRefinementLocalSourceWidth + (row : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : ℕ := + sourceClauseWeight + ((noTautClauses formula).get + ⟨physicalRefinementRowClauseRank row formula, + hbound⟩) + +attribute [-instance] Classical.propDecidable in +private def physicalRefinementSourceLocalTagInRange + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : Bool := + decide ( + paperVariableArityPhysicalRefinementLocalSourcePrefix row formula ≤ + physicalRefinementColumnTypeRank column formula - 1 ∧ + physicalRefinementColumnTypeRank column formula - 1 < + paperVariableArityPhysicalRefinementLocalSourcePrefix row formula + + paperVariableArityPhysicalRefinementLocalSourceWidth + row formula hbound + ) +attribute [-instance] Classical.propDecidable in +private def physicalRefinementSourceFieldMatch + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : Bool := + decide ( + ((column / physFieldCard formula) % + physGridCard formula = + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula) ∧ + (column % physFieldCard formula = + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula) ∧ + (physicalRefinementColumnTypeRank column formula = 0 ∨ + physicalRefinementSourceLocalTagInRange + row column formula hbound) + ) +private def physicalRefinementGridMatchBit : + List Bool → List Bool := + physicalCoefficientUnaryEquality + physicalColumnGridRankUnary + physicalRefinementRowGridRankUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementGridMatchBitComputable : + BitTM + physicalRefinementGridMatchBit := + paperVariableArityPhysicalCoefficientUnaryEqualityComputable + physicalColumnGridRankUnaryComputable + paperVariableArityPhysicalRefinementRowGridRankUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementGridMatchBit_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementGridMatchBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (((column / + physFieldCard formula) % + physGridCard formula) = + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula)] := by + unfold physicalRefinementGridMatchBit + exact physicalCoefficientUnaryEquality_valid + physicalColumnGridRankUnary + physicalRefinementRowGridRankUnary + (affineCellQuery row column (encodeThreeCNF formula)) + ((column / physFieldCard formula) % + physGridCard formula) + ((((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula) + (paperVariableArityPhysicalColumnGridRankUnary_query row column formula) + (paperVariableArityPhysicalRefinementRowGridRankUnary_query + row column formula) + +private def physicalRefinementFieldValueMatchBit : + List Bool → List Bool := + physicalCoefficientUnaryEquality + physicalColumnFieldValueRankUnary + physicalRefinementRowFieldValueRankUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementFieldValueMatchBitComputable : + BitTM + physicalRefinementFieldValueMatchBit := + paperVariableArityPhysicalCoefficientUnaryEqualityComputable + paperVariableArityPhysicalColumnFieldValueRankUnaryComputable + paperVariableArityPhysicalRefinementRowFieldValueRankUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementFieldValueMatchBit_query + (row column : ℕ) (formula : ThreeCNF) : + physicalRefinementFieldValueMatchBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (column % physFieldCard formula = + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula)] := by + unfold physicalRefinementFieldValueMatchBit + exact physicalCoefficientUnaryEquality_valid + physicalColumnFieldValueRankUnary + physicalRefinementRowFieldValueRankUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (column % physFieldCard formula) + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula) + (paperVariableArityPhysicalColumnFieldValueRankUnary_query + row column formula) + (paperVariableArityPhysicalRefinementRowFieldValueRankUnary_query + row column formula) + +private def physicalRefinementAllowedTypeBit : + List Bool → List Bool := + sourceFourFamilyBooleanOrOutput + physicalColumnGlobalTypeBit + physicalRefinementLocalTagMarker + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementAllowedTypeBitComputable : + BitTM + physicalRefinementAllowedTypeBit := + sourceFourFamilyBooleanOrComputable + paperVariableArityPhysicalColumnGlobalTypeBitComputable + paperVariableArityPhysicalRefinementLocalTagMarkerComputable + +@[simp] private theorem paperVariableArityPhysicalRefinementAllowedTypeBit_query + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : + physicalRefinementAllowedTypeBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (physicalRefinementColumnTypeRank + column formula = 0) || + decide + (physicalRefinementSourceLocalTagInRange + row column formula hbound)] := by + unfold physicalRefinementAllowedTypeBit + exact fourFamilyBooleanOrOutput_bits + physicalColumnGlobalTypeBit + physicalRefinementLocalTagMarker + (affineCellQuery row column + (encodeThreeCNF formula)) + (decide + (physicalRefinementColumnTypeRank + column formula = 0)) + (decide + (physicalRefinementSourceLocalTagInRange + row column formula hbound)) + (paperVariableArityPhysicalColumnGlobalTypeBit_query + row column formula) + (by simpa only [physicalRefinementSourceLocalTagInRange, + decide_eq_true_eq] using + (paperVariableArityPhysicalRefinementLocalTagMarker_query + row column formula hbound)) + +private def physicalRefinementFamilyCoefficientWord : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + physicalRefinementGridMatchBit + (sourceFourFamilyBooleanAndOutput + physicalRefinementFieldValueMatchBit + physicalRefinementAllowedTypeBit) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalRefinementFamilyCoefficientWordComputable : + BitTM + physicalRefinementFamilyCoefficientWord := + fourFamilyBooleanAndComputable + paperVariableArityPhysicalRefinementGridMatchBitComputable + (fourFamilyBooleanAndComputable + paperVariableArityPhysicalRefinementFieldValueMatchBitComputable + paperVariableArityPhysicalRefinementAllowedTypeBitComputable) + +@[simp] theorem + paperVariableArityPhysicalRefinementFamilyCoefficientWord_query + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : + physicalRefinementFamilyCoefficientWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (((column / + physFieldCard formula) % + physGridCard formula) = + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula) && + (decide + (column % physFieldCard formula = + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula) && + (decide + (physicalRefinementColumnTypeRank + column formula = 0) || + decide + (physicalRefinementSourceLocalTagInRange + row column formula hbound)))] := by + let input := affineCellQuery row column + (encodeThreeCNF formula) + let grid := decide + (((column / physFieldCard formula) % + physGridCard formula) = + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula) + let value := decide + (column % physFieldCard formula = + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula) + let allowed := decide + (physicalRefinementColumnTypeRank + column formula = 0) || + decide + (physicalRefinementSourceLocalTagInRange + row column formula hbound) + have inner := fourFamilyBooleanAndOutput_bits + physicalRefinementFieldValueMatchBit + physicalRefinementAllowedTypeBit + input value allowed + (paperVariableArityPhysicalRefinementFieldValueMatchBit_query + row column formula) + (paperVariableArityPhysicalRefinementAllowedTypeBit_query + row column formula hbound) + exact fourFamilyBooleanAndOutput_bits + physicalRefinementGridMatchBit + (sourceFourFamilyBooleanAndOutput + physicalRefinementFieldValueMatchBit + physicalRefinementAllowedTypeBit) + input grid (value && allowed) + (paperVariableArityPhysicalRefinementGridMatchBit_query + row column formula) + inner + +/-- GapCVP reduction support. -/ +def physicalRefinementCheckBit : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + physicalRefinementRowMarker + (sourceFourFamilyBooleanAndOutput + physicalRightHandSideBasisZeroBit + physicalRefinementFamilyCoefficientWord) + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalRefinementCheckBitComputable : + BitTM + physicalRefinementCheckBit := + fourFamilyBooleanAndComputable + paperVariableArityPhysicalRefinementRowMarkerComputable + (fourFamilyBooleanAndComputable + paperVariableArityPhysicalRightHandSideBasisZeroBitComputable + paperVariableArityPhysicalRefinementFamilyCoefficientWordComputable) + +private def paperVariableArityPhysicalRefinementCheckDecision + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : Bool := + decide + (physicalFormulaGlobalBoundary formula ≤ row ∧ + row < physicalFormulaRefinementBoundary formula) && + (decide (row % physDegree formula = 0) && + (decide + (((column / + physFieldCard formula) % + physGridCard formula) = + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula) && + (decide + (column % physFieldCard formula = + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula) && + (decide + (physicalRefinementColumnTypeRank + column formula = 0) || + decide + (physicalRefinementSourceLocalTagInRange + row column formula hbound))))) + +@[simp] private theorem paperVariableArityPhysicalRefinementCheckBit_query + (row column : ℕ) (formula : ThreeCNF) + (hbound : physicalRefinementRowClauseRank row formula < + (noTautClauses formula).length) : + physicalRefinementCheckBit + (affineCellQuery row column + (encodeThreeCNF formula)) = + [paperVariableArityPhysicalRefinementCheckDecision + row column formula hbound] := by + let input := affineCellQuery row column + (encodeThreeCNF formula) + let marker := decide + (physicalFormulaGlobalBoundary formula ≤ row ∧ + row < physicalFormulaRefinementBoundary formula) + let basis := decide + (row % physDegree formula = 0) + let grid := decide + (((column / + physFieldCard formula) % + physGridCard formula) = + (((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula) + let value := decide + (column % physFieldCard formula = + ((row - physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula) + let allowed := decide + (physicalRefinementColumnTypeRank + column formula = 0) || + decide + (physicalRefinementSourceLocalTagInRange + row column formula hbound) + have coefficient := + paperVariableArityPhysicalRefinementFamilyCoefficientWord_query + row column formula hbound + have inner := fourFamilyBooleanAndOutput_bits + physicalRightHandSideBasisZeroBit + physicalRefinementFamilyCoefficientWord + input basis (grid && (value && allowed)) + (paperVariableArityPhysicalRightHandSideBasisZeroBit_query + row column formula) + coefficient + have outer := fourFamilyBooleanAndOutput_bits + physicalRefinementRowMarker + (sourceFourFamilyBooleanAndOutput + physicalRightHandSideBasisZeroBit + physicalRefinementFamilyCoefficientWord) + input marker (basis && (grid && (value && allowed))) + (paperVariableArityPhysicalRefinementRowMarker_query + row column formula) + inner + exact outer + +private theorem paperVariableArityPhysicalRefinementRowClauseRank_lt + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (hinterval : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < physicalFormulaRefinementBoundary formula) : + physicalRefinementRowClauseRank row.val formula < + (noTautClauses formula).length := by + calc + physicalRefinementRowClauseRank row.val formula = + (physicalDecodedRefinementClause + formula row.val hinterval).val := by + exact (paperVariableArityPhysicalDecodedRefinementClause_val + formula row.val hinterval).symm + _ < (srcFormula formula).clauses.length := + (physicalDecodedRefinementClause + formula row.val hinterval).isLt + _ = (noTautClauses formula).length := + paperVariableAritySourceFormula_clauses_length formula + +private theorem paperVariableArityPhysicalRefinementAllowedCoordinate_iff + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (hinterval : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < physicalFormulaRefinementBoundary formula) + (hbound : physicalRefinementRowClauseRank + row.val formula < + (noTautClauses formula).length) : + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 = .inl () ∨ + ∃ tuple : + ((srcFormula formula).clauses.get + (physicalDecodedRefinementClause + formula row.val hinterval)).SatisfyingLocalTuple, + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 = + .inr ⟨physicalDecodedRefinementClause + formula row.val hinterval, tuple⟩) ↔ + physicalRefinementColumnTypeRank + column.val formula = 0 ∨ + physicalRefinementSourceLocalTagInRange + row.val column.val formula hbound := by + let selected := physicalDecodedRefinementClause + formula row.val hinterval + have hselected : + selected.val = + physicalRefinementRowClauseRank row.val formula := + paperVariableArityPhysicalDecodedRefinementClause_val + formula row.val hinterval + have hretained : + physicalRetainedClause formula selected = + (noTautClauses formula).get + ⟨physicalRefinementRowClauseRank + row.val formula, hbound⟩ := by + unfold physicalRetainedClause + apply congrArg ((noTautClauses formula).get) + apply Fin.ext + exact hselected + have hsource := + paperVariableArityPhysicalSourceCoordinateGlobalOrLocalTag_iff + formula column selected + dsimp only at hsource + rw [hselected, hretained] at hsource + simpa only [physicalRefinementSourceLocalTagInRange, + decide_eq_true_eq] using hsource + +end PhysicalRefinementCheckSourceCorrectness + +namespace PhysicalRefinementGuardAbsorption + +open GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryExplicitAffineSystem GapCVP.BinarySourceCoordinateOrder +open GapCVP.BinarySourceRowOrder GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.PhysicalColumnOrder +open GapCVP.PhysicalColumnOrderProjection GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalFamilyMarkerTM GapCVP.MatrixEntrySemantics GapCVP.PhysicalRightHandSideTM +open GapCVP.PhysicalRefinementRowProjection GapCVP.PhysicalRefinementSelectedRowProjection +open GapCVP.PhysicalRefinementSelectedProductProjection +open GapCVP.PhysicalRefinementFieldCoordinateCorrectness +open GapCVP.PhysicalRefinementClauseLocalTagTM GapCVP.PhysicalRefinementCheckSourceCorrectness + +attribute [local instance] Classical.propDecidable + +private theorem paperVariableArityPhysicalBooleanAnd_false_left + (first second : List Bool → List Bool) + (input : List Bool) + (hfirst : first input = [false]) : + sourceFourFamilyBooleanAndOutput first second input = [false] := by + simp only [sourceFourFamilyBooleanAndOutput, sourceFourFamilyBooleanAndPairWord, + OutputPolynomialCompositionClosure.markerConditionalOutput, hfirst, List.cons_append, + List.nil_append] + +private theorem paperVariableArityPhysicalRefinementFieldCoefficient_eq_sourceRanks + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < physicalFormulaRefinementBoundary formula) + (clauseBound : + physicalRefinementRowClauseRank row.val formula < + (noTautClauses formula).length) + (fieldRow : Fin + (Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula) × + PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula))) : + physicalWordFamilyFieldCoefficient + (encodeThreeCNF formula).length formula + (.inr (.inl + (physicalDecodedRefinementClause + formula row.val inRefinement))) + fieldRow column = + if + (column.val / + physFieldCard formula) % + physGridCard formula = + ((sourceFormulaGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceFormulaExplicitRefinementOrder + (encodeThreeCNF formula).length + (srcFormula formula) fieldRow).1).val ∧ + column.val % + physFieldCard formula = + ((sourceFormulaFieldCardOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceFormulaExplicitRefinementOrder + (encodeThreeCNF formula).length + (srcFormula formula) fieldRow).2).val ∧ + (physicalRefinementColumnTypeRank + column.val formula = 0 ∨ + physicalRefinementSourceLocalTagInRange + row.val column.val formula clauseBound) + then 1 else 0 := by + let encodingLength := (encodeThreeCNF formula).length + let decoded := sourceCoordinateWordOrder + encodingLength formula column + let position := sourceFormulaExplicitRefinementOrder + encodingLength (srcFormula formula) fieldRow + have columnGrid : + ((sourceFormulaGridOrder + encodingLength (srcFormula formula)).symm + decoded.2.1).val = + (column.val / + physFieldCard formula) % + physGridCard formula := by + simpa only [encodingLength, decoded, + physicalFormulaFieldCardinality_eq_card, + physicalFormulaGridCardinality_eq_card] using + sourceCoordinateGridWordRank + encodingLength formula column + have columnField : + ((sourceFormulaFieldCardOrder + encodingLength (srcFormula formula)).symm + decoded.2.2).val = + column.val % + physFieldCard formula := by + simpa only [encodingLength, decoded, + physicalFormulaFieldCardinality_eq_card] using + paperVariableAritySourceCoordinateFieldWordRank + encodingLength formula column + have sameGrid : + decoded.2.1 = position.1 ↔ + (column.val / + physFieldCard formula) % + physGridCard formula = + ((sourceFormulaGridOrder + encodingLength (srcFormula formula)).symm + position.1).val := by + constructor + · intro equality + rw [← columnGrid, equality] + · intro equality + apply (sourceFormulaGridOrder + encodingLength (srcFormula formula)).symm.injective + apply Fin.ext + exact columnGrid.trans equality + have sameField : + decoded.2.2 = position.2 ↔ + column.val % + physFieldCard formula = + ((sourceFormulaFieldCardOrder + encodingLength (srcFormula formula)).symm + position.2).val := by + constructor + · intro equality + rw [← columnField, equality] + · intro equality + apply (sourceFormulaFieldCardOrder + encodingLength (srcFormula formula)).symm.injective + apply Fin.ext + exact columnField.trans equality + have allowed := paperVariableArityPhysicalRefinementAllowedCoordinate_iff + formula row column inRefinement clauseBound + rw [paperVariableArityPhysicalWordRefinementFieldCoefficient_eq_coordinate] + change + (if decoded.2.1 = position.1 ∧ decoded.2.2 = position.2 ∧ + (decoded.1 = .inl () ∨ + ∃ tuple : + ((srcFormula formula).clauses.get + (physicalDecodedRefinementClause + formula row.val inRefinement)).SatisfyingLocalTuple, + decoded.1 = .inr + ⟨physicalDecodedRefinementClause + formula row.val inRefinement, tuple⟩) + then 1 else 0) = _ + by_cases sourceCondition : + decoded.2.1 = position.1 ∧ decoded.2.2 = position.2 ∧ + (decoded.1 = .inl () ∨ + ∃ tuple : + ((srcFormula formula).clauses.get + (physicalDecodedRefinementClause + formula row.val inRefinement)).SatisfyingLocalTuple, + decoded.1 = .inr + ⟨physicalDecodedRefinementClause + formula row.val inRefinement, tuple⟩) + · have physicalCondition : + (column.val / + physFieldCard formula) % + physGridCard formula = + ((sourceFormulaGridOrder encodingLength + (srcFormula formula)).symm + position.1).val ∧ + column.val % + physFieldCard formula = + ((sourceFormulaFieldCardOrder encodingLength + (srcFormula formula)).symm + position.2).val ∧ + (physicalRefinementColumnTypeRank + column.val formula = 0 ∨ + physicalRefinementSourceLocalTagInRange + row.val column.val formula clauseBound) := + ⟨sameGrid.mp sourceCondition.1, + sameField.mp sourceCondition.2.1, + allowed.mp sourceCondition.2.2⟩ + rw [ite_eq_left sourceCondition, ite_eq_left physicalCondition] + · have physicalCondition : + ¬ ((column.val / + physFieldCard formula) % + physGridCard formula = + ((sourceFormulaGridOrder encodingLength + (srcFormula formula)).symm + position.1).val ∧ + column.val % + physFieldCard formula = + ((sourceFormulaFieldCardOrder encodingLength + (srcFormula formula)).symm + position.2).val ∧ + (physicalRefinementColumnTypeRank + column.val formula = 0 ∨ + physicalRefinementSourceLocalTagInRange + row.val column.val formula clauseBound)) := by + rintro ⟨gridEquality, fieldEquality, tagEquality⟩ + exact sourceCondition + ⟨sameGrid.mpr gridEquality, sameField.mpr fieldEquality, + allowed.mpr tagEquality⟩ + rw [ite_eq_right sourceCondition, ite_eq_right physicalCondition] + +private theorem paperVariableArityPhysicalRefinementWordBinaryCheck_eq_sourceRanks + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < physicalFormulaRefinementBoundary formula) + (clauseBound : + physicalRefinementRowClauseRank row.val formula < + (noTautClauses formula).length) : + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check row column = + if physicalRefinementSourceFieldMatch + row.val column.val formula clauseBound + then bitValue + (decide + (row.val % physDegree formula = 0)) + else 0 := by + let selected := physicalDecodedRefinementClause + formula row.val inRefinement + have family := paperVariableArityPhysicalRowOrder_refinementFamily + formula row inRefinement + have fieldRank := paperVariableArityPhysicalRefinementDecodedFieldRowRank + formula row inRefinement + have basisRank := paperVariableArityPhysicalDecodedRefinementBasisRank + formula row + rw [physicalWordBinaryCheckCoefficient] + generalize decodedEquality : + physicalWordDecodedRow + (encodeThreeCNF formula).length formula row = decoded + at family fieldRank basisRank ⊢ + rcases decoded with ⟨rowFamily, fieldRow, basis⟩ + cases rowFamily with + | inl value => + cases family + | inr otherFamily => + cases otherFamily with + | inr other => + cases family + | inl actualClause => + have sameClause : actualClause = selected := by + exact Sum.inl.inj (Sum.inr.inj family) + subst actualClause + change + fieldRow.val = + ((row.val - + physicalFormulaGlobalBoundary formula) / + physDegree formula) % + (physGridCard formula * + physFieldCard formula) + at fieldRank + change + basis.val = + row.val % physDegree formula + at basisRank + have gridRank : + ((sourceFormulaGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceFormulaExplicitRefinementOrder + (encodeThreeCNF formula).length + (srcFormula formula) fieldRow).1).val = + (((row.val - + physicalFormulaGlobalBoundary formula) / + physDegree formula) / + physFieldCard formula) % + physGridCard formula := by + calc + ((sourceFormulaGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceFormulaExplicitRefinementOrder + (encodeThreeCNF formula).length + (srcFormula formula) fieldRow).1).val = + fieldRow.val / + Fintype.card + (PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula) := + paperVariableArityPhysicalRefinementProductGridWordRank + (encodeThreeCNF formula).length formula fieldRow + _ = + (((row.val - + physicalFormulaGlobalBoundary formula) / + physDegree formula) % + (physGridCard formula * + physFieldCard formula)) / + physFieldCard formula := by + rw [fieldRank, paperVariableArityPhysicalRefinementFieldCard_eq] + _ = _ := + Nat.mod_mul_left_div_self + ((row.val - + physicalFormulaGlobalBoundary formula) / + physDegree formula) + (physFieldCard formula) + (physGridCard formula) + have valueRank : + ((sourceFormulaFieldCardOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceFormulaExplicitRefinementOrder + (encodeThreeCNF formula).length + (srcFormula formula) fieldRow).2).val = + ((row.val - + physicalFormulaGlobalBoundary formula) / + physDegree formula) % + physFieldCard formula := by + calc + ((sourceFormulaFieldCardOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceFormulaExplicitRefinementOrder + (encodeThreeCNF formula).length + (srcFormula formula) fieldRow).2).val = + fieldRow.val % + Fintype.card + (PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula) := + paperVariableArityPhysicalRefinementProductFieldWordRank + (encodeThreeCNF formula).length formula fieldRow + _ = + (((row.val - + physicalFormulaGlobalBoundary formula) / + physDegree formula) % + (physGridCard formula * + physFieldCard formula)) % + physFieldCard formula := by + rw [fieldRank, paperVariableArityPhysicalRefinementFieldCard_eq] + _ = _ := + Nat.mod_mul_left_mod + ((row.val - + physicalFormulaGlobalBoundary formula) / + physDegree formula) + (physGridCard formula) + (physFieldCard formula) + have coefficient := + paperVariableArityPhysicalRefinementFieldCoefficient_eq_sourceRanks + formula row column inRefinement clauseBound fieldRow + dsimp [selected] at family ⊢ + rw [gridRank, valueRank] at coefficient + rw [coefficient] + simp only [physicalRefinementSourceFieldMatch, + decide_eq_true_eq] + split_ifs + · rw [← Module.Basis.equivFun_apply] + rw [paperVariableArityPhysicalFieldBasis_one_coordinate] + rw [basisRank] + · rw [map_zero] + rfl + +private theorem paperVariableArityPhysicalRefinementCheckBit_valid_of_refinement + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < physicalFormulaRefinementBoundary formula) : + physicalRefinementCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check row column = 1)] := by + let clauseBound := paperVariableArityPhysicalRefinementRowClauseRank_lt + formula row inRefinement + let basisRank := row.val % + physDegree formula + let fieldMatch : Prop := + physicalRefinementSourceFieldMatch + row.val column.val formula clauseBound + have checkEntry := + paperVariableArityPhysicalRefinementWordBinaryCheck_eq_sourceRanks + formula row column inRefinement clauseBound + have entry : + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check row column = 1 ↔ + basisRank = 0 ∧ fieldMatch := by + rw [checkEntry] + change + (if fieldMatch then bitValue (decide (basisRank = 0)) else 0) = 1 ↔ + basisRank = 0 ∧ fieldMatch + by_cases fieldAccepted : fieldMatch + · rw [ite_eq_left fieldAccepted] + simp only [bitValue, decide_eq_true_eq, ite_eq_left_iff, zero_ne_one, imp_false, + Decidable.not_not, + fieldAccepted, and_true] + · rw [ite_eq_right fieldAccepted] + simp only [zero_ne_one, fieldAccepted, and_false] + have source : + paperVariableArityPhysicalRefinementCheckDecision + row.val column.val formula clauseBound = true ↔ + basisRank = 0 ∧ fieldMatch := by + simp only [paperVariableArityPhysicalRefinementCheckDecision, inRefinement, and_self, + decide_true, + Nat.div_eq_zero_iff, Bool.decide_or, Bool.decide_eq_true, Bool.true_and, Bool.and_eq_true, + decide_eq_true_eq, + Bool.or_eq_true, physicalRefinementSourceFieldMatch, Bool.decide_and, basisRank, + fieldMatch] + rw [paperVariableArityPhysicalRefinementCheckBit_query + row.val column.val formula clauseBound] + apply congrArg (fun bit : Bool => [bit]) + apply Bool.eq_iff_iff.mpr + constructor + · intro accepted + exact decide_eq_true (entry.mpr (source.mp accepted)) + · intro accepted + exact source.mpr (entry.mp (of_decide_eq_true accepted)) + +theorem paperVariableArityPhysicalRefinementCheckBit_valid + (formula : ThreeCNF) + (row : Fin + (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalRefinementCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check row column = 1)] := by + by_cases inRefinement : + physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula + · rw [paperVariableArityPhysicalRefinementCheckBit_valid_of_refinement + formula row column inRefinement] + simp only [inRefinement, and_self, + decide_true, + Bool.true_and] + · have marker : + physicalRefinementRowMarker + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = [false] := by + rw [paperVariableArityPhysicalRefinementRowMarker_query] + simp only [inRefinement, decide_false] + change + sourceFourFamilyBooleanAndOutput + physicalRefinementRowMarker + (sourceFourFamilyBooleanAndOutput + physicalRightHandSideBasisZeroBit + physicalRefinementFamilyCoefficientWord) + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = _ + rw [paperVariableArityPhysicalBooleanAnd_false_left + physicalRefinementRowMarker + (sourceFourFamilyBooleanAndOutput + physicalRightHandSideBasisZeroBit + physicalRefinementFamilyCoefficientWord) + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) marker] + simp only [inRefinement, decide_false, + Bool.false_and] + +end PhysicalRefinementGuardAbsorption + +namespace Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceAnchoredGridRecordFoldTM +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.BinaryDimensionTM GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryFieldBasis +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryFieldInverseTM +open GapCVP.BinaryModularReductionTM GapCVP.BinarySourceFieldMultiplicationTM + +private abbrev physicalFieldFormulaDegree + (formula : ThreeCNF) : ℕ := + GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length + (srcFormula formula)) + +private def physicalFieldInverseCounter : List Bool → List Bool := + unarySubtractionOutput + physicalFamilyFieldCardinalityUnary + (fun _ => [true, true, true]) ∘ + binarySourceFieldInverseSource + +private noncomputable def paperVariableArityPhysicalFieldInverseCounterComputable : + BitTM + physicalFieldInverseCounter := + GapCVP.TMComposition.computableInPolyTime + factor400BinarySourceFieldInverseSourceComputable + (unarySubtractionComputable + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable + (sourceFixedWordComputable [true, true, true])) + +@[simp] private theorem paperVariableArityPhysicalFieldInverseCounter_valid + (formula : ThreeCNF) (lower operand : List Bool) : + physicalFieldInverseCounter + (binarySourceFieldInverseQuery + lower operand (encodeThreeCNF formula)) = + List.replicate + (2 ^ physicalFieldFormulaDegree formula - 3) true := by + unfold physicalFieldInverseCounter + simp only [Function.comp_apply] + rw [factor400BinarySourceFieldInverseSource_query] + exact unarySubtractionOutput_valid + physicalFamilyFieldCardinalityUnary + (fun _ => [true, true, true]) + (encodeThreeCNF formula) + (2 ^ physicalFieldFormulaDegree formula) + 3 (paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid formula) rfl + +private def paperVariableArityPhysicalFieldInversePreparation + (input : List Bool) : List Bool := + physicalFieldInverseCounter input ++ false :: + (lengthPrefixedWord input ++ + lengthPrefixedWord (factor400BinarySourceLeftBits input)) + +@[simp] private theorem paperVariableArityPhysicalFieldInverseOperand_query + (lower operand source : List Bool) : + factor400BinarySourceLeftBits + (binarySourceFieldInverseQuery lower operand source) = + operand := by + simp only [factor400BinarySourceLeftBits, Function.comp_apply, + binarySourceFieldInverseQuery, + List.append_assoc, firstFieldSuffix_valid, firstFieldContents_valid] + +private noncomputable def paperVariableArityPhysicalFieldInversePreparationComputable : + BitTM + paperVariableArityPhysicalFieldInversePreparation := by + have hoperand := GapCVP.TMComposition.computableInPolyTime + binarySourceLeftBitsComputable + structuralPrefixWriterComputable + have hstate := pointwiseAppendComputable + structuralPrefixWriterComputable hoperand + have hdelimiter := GapCVP.TMComposition.computableInPolyTime + hstate (prependBitComputable false) + have hphysical := pointwiseAppendComputable + paperVariableArityPhysicalFieldInverseCounterComputable hdelimiter + change BitTM + (fun input => + physicalFieldInverseCounter input ++ false :: + (lengthPrefixedWord input ++ + lengthPrefixedWord (factor400BinarySourceLeftBits input))) + simpa only [Function.comp_apply] using hphysical + +private def physicalFieldInverseWord : List Bool → List Bool := + firstFieldContents ∘ firstFieldSuffix ∘ + boundedRecordFoldOutput + (sourceAnchoredGridRecordRotationOutput + binarySourceFieldPowerCandidate) ∘ + paperVariableArityPhysicalFieldInversePreparation + +private noncomputable def paperVariableArityPhysicalFieldInverseComputable : + BitTM + physicalFieldInverseWord := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalFieldInversePreparationComputable + (sourceAnchoredGridRecordFoldComputable + (factor400BinarySourceFieldPowerCandidateComputable + binarySourceMultiplyModComputable))) + firstFieldSuffixComputable) + firstFieldContentsComputable + +private theorem paperVariableArityPhysicalFieldInverseWord_valid + (formula : ThreeCNF) + (lower operand : GapCVP.Core.EffectiveBinaryField.Word + (physicalFieldFormulaDegree formula)) : + physicalFieldInverseWord + (binarySourceFieldInverseQuery + (finiteWordBits lower) (finiteWordBits operand) + (encodeThreeCNF formula)) = + finiteWordBits + (sourceFieldPowerIterate lower operand + (2 ^ physicalFieldFormulaDegree formula - 3)) := by + let count := 2 ^ physicalFieldFormulaDegree formula - 3 + let anchor := binarySourceFieldInverseQuery + (finiteWordBits lower) (finiteWordBits operand) + (encodeThreeCNF formula) + have hcounter : + physicalFieldInverseCounter anchor = + List.replicate count true := + paperVariableArityPhysicalFieldInverseCounter_valid + formula (finiteWordBits lower) (finiteWordBits operand) + have hoperand : + factor400BinarySourceLeftBits anchor = finiteWordBits operand := + paperVariableArityPhysicalFieldInverseOperand_query + (finiteWordBits lower) (finiteWordBits operand) + (encodeThreeCNF formula) + unfold physicalFieldInverseWord + paperVariableArityPhysicalFieldInversePreparation + simp only [Function.comp_apply] + rw [hcounter, hoperand] + rw [show + List.replicate count true ++ false :: + (lengthPrefixedWord anchor ++ + lengthPrefixedWord (finiteWordBits operand)) = + unaryBoundedFoldWord count + (lengthPrefixedWord anchor ++ + lengthPrefixedWord (finiteWordBits operand)) from rfl] + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + rw [factor400BinarySourceFieldPowerRotation_iterate + lower operand operand (encodeThreeCNF formula) count] + rw [firstFieldSuffix_valid anchor + (lengthPrefixedWord + (finiteWordBits + (((sourceFieldPowerStep lower operand)^[count]) operand)))] + simpa only [List.append_nil, sourceFieldPowerIterate] using + firstFieldContents_valid + (finiteWordBits + (((sourceFieldPowerStep lower operand)^[count]) operand)) [] + +theorem paperVariableArityPhysicalSourceWordValue_injective + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) : + Function.Injective (sourceWordValue encodingLength formula) := by + intro left right hequal + apply wordElement_injective + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula)) + apply + (GapCVP.Core.EffectiveBinaryField.extensionAlgEquivGaloisField + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula)) + (GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + encodingLength formula))).injective + exact hequal + +private theorem paperVariableArityPhysicalFieldInverseSelectedWord_valid + (formula : ThreeCNF) + (operand : GapCVP.Core.EffectiveBinaryField.Word + (physicalFieldFormulaDegree formula)) : + physicalFieldInverseWord + (binarySourceFieldInverseQuery + (finiteWordBits + (GapCVP.Core.EffectiveBinaryField.irreducibleWord + (physicalFieldFormulaDegree formula))) + (finiteWordBits operand) + (encodeThreeCNF formula)) = + finiteWordBits (sourceInverseWord operand) := by + rw [paperVariableArityPhysicalFieldInverseWord_valid] + congr 1 + apply paperVariableArityPhysicalSourceWordValue_injective + (encodeThreeCNF formula).length (srcFormula formula) + rw [sourceWordValue_sourceFieldPowerIterate, + sourceInverseWord, sourceWordValue_sourceWordPow] + congr 1 + have hsize := GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length (srcFormula formula) + have hsourcePower : + GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length (srcFormula formula) ≤ + GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length (srcFormula formula) ^ + 200 := by + calc + GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length (srcFormula formula) = + GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length (srcFormula formula) ^ + 1 := by simp only [pow_one] + _ ≤ _ := Nat.pow_le_pow_right (by omega) (by norm_num) + have hfield := GapCVP.Core.sourceFiniteField_card_lower hsize + rw [GapCVP.Core.sourceFiniteField_card hsize] at hfield + have hcardinality : + 3 ≤ 2 ^ physicalFieldFormulaDegree formula := by + change + 3 ≤ 2 ^ GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length (srcFormula formula)) + calc + 3 ≤ GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length + (srcFormula formula) := by omega + _ ≤ GapCVP.Core.sourceSizeParameter + (encodeThreeCNF formula).length + (srcFormula formula) ^ 200 := hsourcePower + _ ≤ _ := hfield + change + (2 ^ physicalFieldFormulaDegree formula - 3) + 1 = + 2 ^ physicalFieldFormulaDegree formula - 2 + omega + +end + +section + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CLStructuralPrefixWriter GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryFieldInverseTM +open GapCVP.BinaryModularReductionTM GapCVP.PhysicalFamilyRowTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM + +private def paperVariableAritySourceSelectedFieldOperandQuery + (operand source : List Bool) : List Bool := + lengthPrefixedWord operand ++ source + +private def sourceSelectedFieldInversePreparation + (input : List Bool) : List Bool := + binarySourceFieldInverseQuery + (sourceSelectedIrreducibleWord + (firstFieldSuffix input)) + (firstFieldContents input) + (firstFieldSuffix input) + +private noncomputable def paperVariableAritySourceSelectedFieldInversePreparationComputable : + BitTM + sourceSelectedFieldInversePreparation := by + have hmodulus := GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable + paperVariableAritySourceSelectedIrreducibleWordComputable) + structuralPrefixWriterComputable + have hoperand := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hmodulus + (pointwiseAppendComputable + hoperand firstFieldSuffixComputable) + unfold sourceSelectedFieldInversePreparation + simpa only [binarySourceFieldInverseQuery, List.append_assoc, Function.comp_apply] + using hphysical + +/-- GapCVP reduction support. -/ +def sourceSelectedFieldInverseWord : List Bool → List Bool := + physicalFieldInverseWord ∘ + sourceSelectedFieldInversePreparation + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableAritySourceSelectedFieldInverseComputable : + BitTM + sourceSelectedFieldInverseWord := + GapCVP.TMComposition.computableInPolyTime + paperVariableAritySourceSelectedFieldInversePreparationComputable + paperVariableArityPhysicalFieldInverseComputable + +@[simp] theorem paperVariableAritySourceSelectedFieldInverseWord_valid + (formula : ThreeCNF) + (operand : GapCVP.Core.EffectiveBinaryField.Word + (physicalFieldFormulaDegree formula)) : + sourceSelectedFieldInverseWord + (paperVariableAritySourceSelectedFieldOperandQuery + (finiteWordBits operand) (encodeThreeCNF formula)) = + finiteWordBits (sourceInverseWord operand) := by + unfold sourceSelectedFieldInverseWord + sourceSelectedFieldInversePreparation + paperVariableAritySourceSelectedFieldOperandQuery + simp only [Function.comp_apply, + firstFieldSuffix_valid, firstFieldContents_valid] + rw [paperVariableAritySourceSelectedIrreducibleWord_valid] + exact paperVariableArityPhysicalFieldInverseSelectedWord_valid formula operand + +end + +section + +open Turing GapCVP.BinaryEncoding GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryFieldBasis GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.PhysicalFamilyRowTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine + +private def physicalCellSelectedModulusWord : + List Bool → List Bool := + sourceSelectedIrreducibleWord ∘ + sourceExplicitAffineCellOriginalSource + +private noncomputable def paperVariableArityPhysicalCellSelectedModulusComputable : + BitTM + physicalCellSelectedModulusWord := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + paperVariableAritySourceSelectedIrreducibleWordComputable + +private noncomputable def physicalCellSelectedModulusComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalCellSelectedModulusWord + computer := paperVariableArityPhysicalCellSelectedModulusComputable + +@[simp] private theorem paperVariableArityPhysicalCellSelectedModulusWord_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalCellSelectedModulusWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.irreducibleWord + (sourceIrreducibleFormulaDegree formula)) := by + unfold physicalCellSelectedModulusWord + rw [Function.comp_apply, sourceExplicitAffineCellOriginalSource_query] + exact paperVariableAritySourceSelectedIrreducibleWord_valid formula + +private def paperVariableArityPhysicalCellInverseQuery + (operand : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + lengthPrefixedWord (operand.output input) ++ + sourceExplicitAffineCellOriginalSource input + +private noncomputable def paperVariableArityPhysicalCellInverseQueryComputable + (operand : SourcePhysicalLagrangeWordComputer) : + BitTM + (paperVariableArityPhysicalCellInverseQuery operand) := by + have hprefixed := GapCVP.TMComposition.computableInPolyTime + operand.computer structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hprefixed + sourceExplicitAffineCellOriginalSourceComputable + change BitTM + (fun input => lengthPrefixedWord (operand.output input) ++ + sourceExplicitAffineCellOriginalSource input) + simpa only [Function.comp_apply] using hphysical + +/-- GapCVP reduction support. -/ +def physicalCellInverseWord + (operand : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + sourceSelectedFieldInverseWord ∘ + paperVariableArityPhysicalCellInverseQuery operand + +private noncomputable def paperVariableArityPhysicalCellInverseComputable + (operand : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalCellInverseWord operand) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityPhysicalCellInverseQueryComputable operand) + paperVariableAritySourceSelectedFieldInverseComputable + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalCellInverseComputer + (operand : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalCellInverseWord operand + computer := paperVariableArityPhysicalCellInverseComputable operand + +@[simp] theorem paperVariableArityPhysicalCellInverseWord_valid + (operand : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physicalFieldFormulaDegree formula)) + (hvalue : operand.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + physicalCellInverseWord operand + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits (sourceInverseWord value) := by + unfold physicalCellInverseWord + paperVariableArityPhysicalCellInverseQuery + rw [Function.comp_apply, hvalue, + sourceExplicitAffineCellOriginalSource_query] + exact paperVariableAritySourceSelectedFieldInverseWord_valid + formula value + +private def paperVariableArityPhysicalCellFieldRankQuery + (rank : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + lengthPrefixedWord (rank.output input) ++ + lengthPrefixedWord + (physicalFamilyFieldCardinalityUnary + (sourceExplicitAffineCellOriginalSource input)) ++ + sourceExplicitAffineCellOriginalSource input + +private noncomputable def paperVariableArityPhysicalCellFieldRankQueryComputable + (rank : SourcePhysicalLagrangeWordComputer) : + BitTM + (paperVariableArityPhysicalCellFieldRankQuery rank) := by + have hrank := GapCVP.TMComposition.computableInPolyTime + rank.computer structuralPrefixWriterComputable + have hcard := GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + paperVariableArityPhysicalFamilyFieldCardinalityUnaryComputable) + structuralPrefixWriterComputable + have hphysical := pointwiseAppendComputable hrank + (pointwiseAppendComputable hcard + sourceExplicitAffineCellOriginalSourceComputable) + change BitTM + (fun input => lengthPrefixedWord (rank.output input) ++ + lengthPrefixedWord + (physicalFamilyFieldCardinalityUnary + (sourceExplicitAffineCellOriginalSource input)) ++ + sourceExplicitAffineCellOriginalSource input) + simpa only [List.append_assoc, Function.comp_apply] using hphysical + +/-- GapCVP reduction support. -/ +def physicalCellFieldWordAt + (rank : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + sourceIrreducibleRankCoefficientWord ∘ + paperVariableArityPhysicalCellFieldRankQuery rank + +/-- GapCVP reduction support. -/ +noncomputable def physicalCellFieldWordAtComputable + (rank : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalCellFieldWordAt rank) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityPhysicalCellFieldRankQueryComputable rank) + paperVariableAritySourceIrreducibleRankCoefficientWordComputable + +theorem physicalCellFieldWordAt_valid + (rank : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (index : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (hrank : rank.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate index.val true) : + physicalCellFieldWordAt rank + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (indexedWord (sourceIrreducibleFormulaDegree formula) + index) := by + unfold physicalCellFieldWordAt + paperVariableArityPhysicalCellFieldRankQuery + rw [Function.comp_apply, hrank, + sourceExplicitAffineCellOriginalSource_query, + paperVariableArityPhysicalFamilyFieldCardinalityUnary_valid] + exact sourceIrreducibleRankCoefficientWord_eq_indexedWord + formula index + (List.replicate + (physFieldCard formula) true) + +end + +end Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine + +namespace BinaryCompactPhysicalFieldWordXorTM + +open Turing Polynomial GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.CNFFiveFamilyOriginalIndexedBitTM GapCVP.GaussianXorWorker GapCVP.BinaryFieldBasis +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalCellGridWordTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryPhysicalWordRuntimeDegreeTM + +/-- GapCVP reduction support. -/ +def compactPhysicalFieldWordXorValue {degree : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word degree) : + GapCVP.Core.EffectiveBinaryField.Word degree := + fun position => Bool.xor (left position) (right position) + +private theorem compactPhysicalFieldWordXorValue_wordPolynomial + {degree : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word degree) : + wordPolynomial (compactPhysicalFieldWordXorValue left right) = + wordPolynomial left + wordPolynomial right := by + apply Polynomial.ext + intro position + by_cases hposition : position < degree + · let index : Fin degree := ⟨position, hposition⟩ + change + (wordPolynomial + (compactPhysicalFieldWordXorValue left right)).coeff index.val = + (wordPolynomial left + wordPolynomial right).coeff index.val + rw [Polynomial.coeff_add, wordPolynomial_coeff_fin, + wordPolynomial_coeff_fin, wordPolynomial_coeff_fin] + exact bitValue_xor (left index) (right index) + · have hlarge : degree ≤ position := Nat.le_of_not_gt hposition + rw [wordPolynomial_coeff_eq_zero _ position hlarge, + Polynomial.coeff_add, + wordPolynomial_coeff_eq_zero left position hlarge, + wordPolynomial_coeff_eq_zero right position hlarge, + add_zero] + +private theorem compactPhysicalFieldWordXorValue_wordElement + {degree : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word degree) : + wordElement (compactPhysicalFieldWordXorValue left right) = + wordElement left + wordElement right := by + unfold wordElement + rw [compactPhysicalFieldWordXorValue_wordPolynomial, map_add] + +private theorem compactPhysicalFieldWordXorValue_sourceWordValue + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (left right : GapCVP.Core.EffectiveBinaryField.Word + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) : + sourceWordValue encodingLength formula + (compactPhysicalFieldWordXorValue left right) = + sourceWordValue encodingLength formula left + + sourceWordValue encodingLength formula right := by + unfold sourceWordValue + rw [compactPhysicalFieldWordXorValue_wordElement, map_add] + +theorem compactPhysicalFieldWordXorValue_sourceWordValue_sub + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (left right : GapCVP.Core.EffectiveBinaryField.Word + (GapCVP.Core.sourceFieldExponent + (GapCVP.Core.sourceSizeParameter encodingLength formula))) : + sourceWordValue encodingLength formula + (compactPhysicalFieldWordXorValue left right) = + sourceWordValue encodingLength formula left - + sourceWordValue encodingLength formula right := by + rw [CharTwo.sub_eq_add] + exact compactPhysicalFieldWordXorValue_sourceWordValue + encodingLength formula left right + +private def compactPhysicalFieldWordXorOriginalCell : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldWordXorOriginalCellComputable : + BitTM + compactPhysicalFieldWordXorOriginalCell := + factor400BinaryPhysicalWordRuntimeCompositionComputer + firstFieldSuffixComputable firstFieldSuffixComputable + +private def compactPhysicalFieldWordXorCandidateOperand + (worker : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + worker.output ∘ compactPhysicalFieldWordXorOriginalCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldWordXorCandidateOperandComputable + (worker : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalFieldWordXorCandidateOperand worker) := + factor400BinaryPhysicalWordRuntimeCompositionComputer + compactPhysicalFieldWordXorOriginalCellComputable worker.computer + +private def compactPhysicalFieldWordXorCandidateBit + (worker : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + fiveFamilyOriginalDynamicBitWord firstFieldContents + (compactPhysicalFieldWordXorCandidateOperand worker) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldWordXorCandidateBitComputable + (worker : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalFieldWordXorCandidateBit worker) := + fiveOriginalDynamicBitComputable firstFieldContentsComputable + (compactPhysicalFieldWordXorCandidateOperandComputable worker) + +private def compactPhysicalFieldWordXorCandidate + (left right : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + binaryGaussianXorHeadWord ∘ + (fun input => + compactPhysicalFieldWordXorCandidateBit left input ++ + compactPhysicalFieldWordXorCandidateBit right input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldWordXorCandidateComputable + (left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalFieldWordXorCandidate left right) := + factor400BinaryPhysicalWordRuntimeCompositionComputer + (physicalCellGridAppendComputer + (compactPhysicalFieldWordXorCandidateBitComputable left) + (compactPhysicalFieldWordXorCandidateBitComputable right)) + binaryGaussianXorHeadComputable + +@[simp] private theorem compactPhysicalFieldWordXorOriginalCell_query + (width : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : + compactPhysicalFieldWordXorOriginalCell + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input) = input := by + simp only [compactPhysicalFieldWordXorOriginalCell, sourceQaryMaskDynamicGridBaseSource, + Function.comp_apply, + firstFieldSuffix_valid] + +private theorem compactPhysicalFieldWordXorCandidateBit_query + (worker : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : + compactPhysicalFieldWordXorCandidateBit worker + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input) = + [((worker.output input).drop rank).headD false] := by + let query := lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input + have hrank : firstFieldContents query = + List.replicate rank true := by + simp only [firstFieldContents_valid, query] + unfold compactPhysicalFieldWordXorCandidateBit + rw [fiveOriginalDynamicBitWord_valid firstFieldContents + (compactPhysicalFieldWordXorCandidateOperand worker) + query rank hrank] + simp only [compactPhysicalFieldWordXorCandidateOperand, Function.comp_apply, + compactPhysicalFieldWordXorOriginalCell_query, List.headD_eq_head?_getD, List.head?_drop, + query] + +private theorem compactPhysicalFieldWordXorCandidate_query + (left right : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : + compactPhysicalFieldWordXorCandidate left right + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input) = + [Bool.xor + (((left.output input).drop rank).headD false) + (((right.output input).drop rank).headD false)] := by + unfold compactPhysicalFieldWordXorCandidate + simp only [Function.comp_apply, + compactPhysicalFieldWordXorCandidateBit_query] + rfl + +private noncomputable def compactPhysicalFieldWordXorDegreeWidth + (degree : SourcePhysicalLagrangeWordComputer) : + SourceQaryMaskDynamicGridWidth where + output := degree.output + computer := degree.computer + +/-- GapCVP reduction support. -/ +def compactPhysicalFieldWordXorWithDegree + (degree left right : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + (compactPhysicalFieldWordXorDegreeWidth degree) + (compactPhysicalFieldWordXorCandidateComputable left right) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalFieldWordXorWithDegreeComputable + (degree left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalFieldWordXorWithDegree degree left right) := + maskDynamicGridRecordCatalogueComputable + (compactPhysicalFieldWordXorDegreeWidth degree) + (compactPhysicalFieldWordXorCandidateComputable left right) + +private theorem finiteWordBits_compactPhysicalFieldWordXorValue + {degree : ℕ} + (left right : GapCVP.Core.EffectiveBinaryField.Word degree) : + (List.range degree).map + (fun rank => Bool.xor + (((finiteWordBits left).drop rank).headD false) + (((finiteWordBits right).drop rank).headD false)) = + finiteWordBits (compactPhysicalFieldWordXorValue left right) := by + rw [← List.map_coe_finRange_eq_range, List.map_map] + unfold finiteWordBits + apply List.map_congr_left + intro index _ + simp only [List.headD_eq_head?_getD, List.head?_drop, List.getElem?_map, Function.comp_apply, + List.length_finRange, Fin.is_lt, getElem?_pos, List.getElem_finRange, Fin.cast_mk, Fin.eta, + Option.map_some, + Option.getD_some, compactPhysicalFieldWordXorValue] + +theorem compactPhysicalFieldWordXorWithDegree_valid + (degreeWorker left right : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (degree : ℕ) + (leftWord rightWord : GapCVP.Core.EffectiveBinaryField.Word degree) + (hdegree : degreeWorker.output input = + List.replicate degree true) + (hleft : left.output input = finiteWordBits leftWord) + (hright : right.output input = finiteWordBits rightWord) : + compactPhysicalFieldWordXorWithDegree + degreeWorker left right input = + finiteWordBits + (compactPhysicalFieldWordXorValue leftWord rightWord) := by + unfold compactPhysicalFieldWordXorWithDegree + rw [maskDynamicGridRecordCatalogueOutput_valid + (compactPhysicalFieldWordXorDegreeWidth degreeWorker) + (compactPhysicalFieldWordXorCandidateComputable left right) + input degree hdegree] + simp_rw [compactPhysicalFieldWordXorCandidate_query] + rw [hleft, hright, ← List.map_eq_flatMap] + exact finiteWordBits_compactPhysicalFieldWordXorValue + leftWord rightWord + +end BinaryCompactPhysicalFieldWordXorTM + +namespace BinaryCompactPhysicalLagrangeProductFoldTM + +open Turing GapCVP.SourceFormulaStructuralDecoder GapCVP.BinaryModularReductionTM +open GapCVP.BinarySourceFieldMultiplicationTM GapCVP.BinaryPhysicalLagrangeProductFoldTM + +private def compactPhysicalLagrangeProductFold : + List Bool → List Bool := + sourcePhysicalLagrangeProductFoldOutput + +private noncomputable def compactPhysicalLagrangeProductFoldComputable : + BitTM + compactPhysicalLagrangeProductFold := + sourcePhysicalLagrangeProductFoldComputable + binarySourceMultiplyModComputable + +private def compactPhysicalLagrangeProductWord : + List Bool → List Bool := + sourcePhysicalLagrangeProductAccumulator ∘ + compactPhysicalLagrangeProductFold + +private noncomputable def compactPhysicalLagrangeProductWordComputable : + BitTM + compactPhysicalLagrangeProductWord := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeProductFoldComputable + sourcePhysicalLagrangeProductAccumulatorComputable + +private theorem compactPhysicalLagrangeProductWord_generic_valid + {degree : ℕ} + (lower initial : GapCVP.Core.EffectiveBinaryField.Word degree) + (factors : List (GapCVP.Core.EffectiveBinaryField.Word degree)) + (source : List Bool) : + compactPhysicalLagrangeProductWord + (sourcePhysicalLagrangeProductFoldWord + lower initial factors source) = + finiteWordBits + (factors.foldl + (GapCVP.Core.EffectiveBinaryField.multiplyMod lower) + initial) := by + change + firstFieldContents + (firstFieldSuffix + (sourcePhysicalLagrangeProductFoldOutput + (sourcePhysicalLagrangeProductFoldWord + lower initial factors source))) = _ + rw [sourcePhysicalLagrangeProductFoldOutput_valid] + rw [firstFieldSuffix_valid] + simpa only [List.append_nil] using + (firstFieldContents_valid + (finiteWordBits + (factors.foldl + (GapCVP.Core.EffectiveBinaryField.multiplyMod lower) + initial)) []) + +end BinaryCompactPhysicalLagrangeProductFoldTM + +namespace BinaryCompactPhysicalLagrangeFactorStreamTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryPhysicalLagrangeProductFoldTM +open GapCVP.BinaryCompactPhysicalLagrangeProductFoldTM + +private def compactPhysicalLagrangeNodeFactorRecord + (factor : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + lengthPrefixedWord (factor.output input) + +private noncomputable def compactPhysicalLagrangeNodeFactorRecordComputable + (factor : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalLagrangeNodeFactorRecord factor) := by + have hphysical := GapCVP.TMComposition.computableInPolyTime + factor.computer structuralPrefixWriterComputable + change BitTM + (fun input => lengthPrefixedWord (factor.output input)) + simpa only [Function.comp_def] using hphysical + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNodeFactorCatalogue + (width : SourceQaryMaskDynamicGridWidth) + (factor : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + width (compactPhysicalLagrangeNodeFactorRecordComputable factor) + +private noncomputable def compactPhysicalLagrangeNodeFactorCatalogueComputable + (width : SourceQaryMaskDynamicGridWidth) + (factor : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalLagrangeNodeFactorCatalogue width factor) := + maskDynamicGridRecordCatalogueComputable + width (compactPhysicalLagrangeNodeFactorRecordComputable factor) + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNodeFactorQuery + (width : SourceQaryMaskDynamicGridWidth) + (input : List Bool) (rank : ℕ) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input + +theorem compactPhysicalLagrangeNodeFactorCatalogue_valid + (width : SourceQaryMaskDynamicGridWidth) + (factor : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (count : ℕ) + (hwidth : width.output input = List.replicate count true) : + compactPhysicalLagrangeNodeFactorCatalogue width factor input = + (List.range count).flatMap + (fun rank => + lengthPrefixedWord + (factor.output + (compactPhysicalLagrangeNodeFactorQuery + width input rank))) := by + exact maskDynamicGridRecordCatalogueOutput_valid + width (compactPhysicalLagrangeNodeFactorRecordComputable factor) + input count hwidth + +private noncomputable def compactPhysicalLagrangeOriginalSourceComputer : + SourcePhysicalLagrangeWordComputer where + output := sourceExplicitAffineCellOriginalSource + computer := sourceExplicitAffineCellOriginalSourceComputable + +private def compactPhysicalLagrangeFactorProductAnchor + (lower source : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + lengthPrefixedWord (lower.output input) ++ source.output input + +private noncomputable def compactPhysicalLagrangeFactorProductAnchorComputable + (lower source : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalLagrangeFactorProductAnchor lower source) := by + have hphysical := pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable lower) + source.computer + change BitTM + (fun input => + lengthPrefixedWord (lower.output input) ++ source.output input) + exact hphysical + +private def compactPhysicalLagrangeFactorProductPreparation + (width : SourceQaryMaskDynamicGridWidth) + (lower initial source factor : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + width.output input ++ false :: + (lengthPrefixedWord + (compactPhysicalLagrangeFactorProductAnchor lower source input) ++ + lengthPrefixedWord (initial.output input) ++ + compactPhysicalLagrangeNodeFactorCatalogue width factor input) + +/-- GapCVP reduction support. -/ +noncomputable def + compactPhysicalLagrangeFactorProductPreparationComputable + (width : SourceQaryMaskDynamicGridWidth) + (lower initial source factor : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalLagrangeFactorProductPreparation + width lower initial source factor) := by + have hanchor := GapCVP.TMComposition.computableInPolyTime + (compactPhysicalLagrangeFactorProductAnchorComputable lower source) + structuralPrefixWriterComputable + have htail := pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable initial) + (compactPhysicalLagrangeNodeFactorCatalogueComputable width factor) + have hseed := pointwiseAppendComputable hanchor htail + have hdelimiter := GapCVP.TMComposition.computableInPolyTime + hseed (prependBitComputable false) + have hphysical := pointwiseAppendComputable + width.computer hdelimiter + change BitTM + (fun input => + width.output input ++ false :: + (lengthPrefixedWord + (compactPhysicalLagrangeFactorProductAnchor + lower source input) ++ + lengthPrefixedWord (initial.output input) ++ + compactPhysicalLagrangeNodeFactorCatalogue + width factor input)) + simpa only [List.append_assoc, Function.comp_apply, sourcePhysicalLagrangePrefixedOutput] + using hphysical + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeFactorProductWord + (width : SourceQaryMaskDynamicGridWidth) + (lower initial source factor : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + compactPhysicalLagrangeProductWord ∘ + compactPhysicalLagrangeFactorProductPreparation + width lower initial source factor + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalLagrangeFactorProductComputable + (width : SourceQaryMaskDynamicGridWidth) + (lower initial source factor : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalLagrangeFactorProductWord + width lower initial source factor) := + GapCVP.TMComposition.computableInPolyTime + (compactPhysicalLagrangeFactorProductPreparationComputable + width lower initial source factor) + compactPhysicalLagrangeProductWordComputable + +theorem compactPhysicalLagrangeFactorProductWord_valid + {degree : ℕ} + (width : SourceQaryMaskDynamicGridWidth) + (lower initial source factor : SourcePhysicalLagrangeWordComputer) + (input : List Bool) + (lowerWord initialWord : GapCVP.Core.EffectiveBinaryField.Word degree) + (factors : List (GapCVP.Core.EffectiveBinaryField.Word degree)) + (original : List Bool) + (hwidth : width.output input = List.replicate factors.length true) + (hlower : lower.output input = finiteWordBits lowerWord) + (hinitial : initial.output input = finiteWordBits initialWord) + (hsource : source.output input = original) + (hfactors : compactPhysicalLagrangeNodeFactorCatalogue + width factor input = + sourcePhysicalLagrangePackedFactorWords factors) : + compactPhysicalLagrangeFactorProductWord + width lower initial source factor input = + finiteWordBits + (factors.foldl + (GapCVP.Core.EffectiveBinaryField.multiplyMod lowerWord) + initialWord) := by + unfold compactPhysicalLagrangeFactorProductWord + compactPhysicalLagrangeFactorProductPreparation + compactPhysicalLagrangeFactorProductAnchor + rw [Function.comp_apply, hwidth, hlower, hinitial, hsource, + hfactors] + exact compactPhysicalLagrangeProductWord_generic_valid + lowerWord initialWord factors original + +end BinaryCompactPhysicalLagrangeFactorStreamTM + +namespace PhysicalOrdinaryShiftedCoefficientTM + +open Turing GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinarySourceFieldMultiplicationTM GapCVP.BinaryCompactPhysicalFieldWordXorTM +open GapCVP.PhysicalFamilyRowTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine + +/-- GapCVP reduction support. -/ +abbrev PaperVariableArityPhysicalInterpolationWord (formula : ThreeCNF) := + GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula) + +private def physicalInterpolationDegreeWord : + List Bool → List Bool := + physicalFamilyFieldDegreeUnary ∘ + sourceExplicitAffineCellOriginalSource + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationDegreeWordComputable : + BitTM + physicalInterpolationDegreeWord := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +private noncomputable def paperVariableArityPhysicalInterpolationDegreeComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationDegreeWord + computer := paperVariableArityPhysicalInterpolationDegreeWordComputable + +@[simp] private theorem paperVariableArityPhysicalInterpolationDegreeWord_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationDegreeWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physDegree formula) true := by + unfold physicalInterpolationDegreeWord + rw [Function.comp_apply, sourceExplicitAffineCellOriginalSource_query] + exact paperVariableArityPhysicalFamilyFieldDegreeUnary_valid formula + +private def physicalInterpolationDifferenceWord + (left right : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + compactPhysicalFieldWordXorWithDegree + paperVariableArityPhysicalInterpolationDegreeComputer left right + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationDifferenceWordComputable + (left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationDifferenceWord left right) := + compactPhysicalFieldWordXorWithDegreeComputable + paperVariableArityPhysicalInterpolationDegreeComputer left right + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalInterpolationDifferenceComputer + (left right : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationDifferenceWord left right + computer := + paperVariableArityPhysicalInterpolationDifferenceWordComputable left right + +theorem paperVariableArityPhysicalInterpolationDifferenceWord_valid + (left right : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (leftWord rightWord : PaperVariableArityPhysicalInterpolationWord formula) + (hleft : left.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits leftWord) + (hright : right.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits rightWord) : + physicalInterpolationDifferenceWord left right + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (compactPhysicalFieldWordXorValue leftWord rightWord) := by + exact compactPhysicalFieldWordXorWithDegree_valid + paperVariableArityPhysicalInterpolationDegreeComputer left right + (affineCellQuery row column (encodeThreeCNF formula)) + (physDegree formula) leftWord rightWord + (paperVariableArityPhysicalInterpolationDegreeWord_valid + row column formula) hleft hright + +/-- GapCVP reduction support. -/ +def paperVariableArityPhysicalInterpolationProductWord + (left right : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + sourcePhysicalLagrangeMultiplyWord + physicalCellSelectedModulusComputer left right + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalInterpolationProductWordComputable + (left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (paperVariableArityPhysicalInterpolationProductWord left right) := + sourcePhysicalLagrangeMultiplyComputable + binarySourceMultiplyModComputable + physicalCellSelectedModulusComputer left right + +theorem paperVariableArityPhysicalInterpolationProductWord_valid + (left right : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (leftWord rightWord : PaperVariableArityPhysicalInterpolationWord formula) + (hleft : left.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits leftWord) + (hright : right.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits rightWord) : + paperVariableArityPhysicalInterpolationProductWord left right + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (GapCVP.Core.EffectiveBinaryField.multiplyMod + (GapCVP.Core.EffectiveBinaryField.irreducibleWord + (physDegree formula)) + leftWord rightWord) := by + exact sourcePhysicalLagrangeMultiplyWord_valid + (GapCVP.Core.EffectiveBinaryField.irreducibleWord + (physDegree formula)) + leftWord rightWord + physicalCellSelectedModulusComputer left right + row column (encodeThreeCNF formula) + (paperVariableArityPhysicalCellSelectedModulusWord_valid + row column formula) hleft hright + +end PhysicalOrdinaryShiftedCoefficientTM + +namespace BinaryCompactPhysicalNodeParityTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert +open GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.Factor400BinaryPhysicalParityTM + +private def compactPhysicalNodeParityPreparation + (width : SourceQaryMaskDynamicGridWidth) + {term : List Bool → List Bool} + (computer : BitTM term) + (input : List Bool) : List Bool := + width.output input ++ false :: + (false :: maskDynamicGridRecordCatalogueOutput + width computer input) + +private noncomputable def compactPhysicalNodeParityPreparationComputable + (width : SourceQaryMaskDynamicGridWidth) + {term : List Bool → List Bool} + (computer : BitTM term) : + BitTM + (compactPhysicalNodeParityPreparation width computer) := by + have hcatalogue := + maskDynamicGridRecordCatalogueComputable width computer + have hseed := GapCVP.TMComposition.computableInPolyTime + hcatalogue (prependBitComputable false) + have hdelimiter := GapCVP.TMComposition.computableInPolyTime + hseed (prependBitComputable false) + have hphysical := pointwiseAppendComputable + width.computer hdelimiter + change BitTM + (fun input => width.output input ++ + false :: (false :: + maskDynamicGridRecordCatalogueOutput + width computer input)) + simpa only [Function.comp_apply] using hphysical + +private def compactPhysicalNodeParity + (width : SourceQaryMaskDynamicGridWidth) + {term : List Bool → List Bool} + (computer : BitTM term) : List Bool → List Bool := + prefixParityOutput ∘ + compactPhysicalNodeParityPreparation width computer + +private noncomputable def compactPhysicalNodeParityComputable + (width : SourceQaryMaskDynamicGridWidth) + {term : List Bool → List Bool} + (computer : BitTM term) : + BitTM + (compactPhysicalNodeParity width computer) := + GapCVP.TMComposition.computableInPolyTime + (compactPhysicalNodeParityPreparationComputable width computer) + prefixParityComputable + +private theorem compactPhysicalNodeParity_valid + (width : SourceQaryMaskDynamicGridWidth) + {term : List Bool → List Bool} + (computer : BitTM term) + (input : List Bool) (count : ℕ) (value : ℕ → Bool) + (hwidth : width.output input = List.replicate count true) + (hterm : ∀ rank ∈ List.range count, + term (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input) = + [value rank]) : + compactPhysicalNodeParity width computer input = + [((List.range count).map value).foldl Bool.xor false] := by + have hcatalogue := + maskDynamicGridRecordCatalogueOutput_valid + width computer input count hwidth + have hrecords : + (List.range count).flatMap + (fun rank => term + (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input)) = + (List.range count).map value := by + rw [List.map_eq_flatMap] + exact List.flatMap_congr hterm + unfold compactPhysicalNodeParity compactPhysicalNodeParityPreparation + simp only [Function.comp_apply] + rw [hwidth, hcatalogue, hrecords] + have hparity := prefixParityOutput_valid + false ((List.range count).map value) [] + simpa only [unaryBoundedFoldWord, List.length_map, List.length_range, List.append_nil] + using hparity + +end BinaryCompactPhysicalNodeParityTM + +namespace PhysicalOrdinaryShiftedCoefficientSumTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryDimensionTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryCompactPhysicalNodeParityTM GapCVP.PhysicalFamilyRowTM + +private def physicalInterpolationVariableCountWord : + List Bool → List Bool := + physicalFamilyVariableCountUnary ∘ + sourceExplicitAffineCellOriginalSource + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationVariableCountWordComputable : + BitTM + physicalInterpolationVariableCountWord := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + paperVariableArityPhysicalFamilyVariableCountUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalInterpolationVariableCountWord_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationVariableCountWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFormulaVariableCount formula) true := by + unfold physicalInterpolationVariableCountWord + rw [Function.comp_apply, sourceExplicitAffineCellOriginalSource_query] + exact paperVariableArityPhysicalFamilyVariableCountUnary_valid formula + +private def physicalInterpolationShiftedVariableCountWord : + List Bool → List Bool := + unarySubtractionOutput + physicalInterpolationVariableCountWord + (fun _ => [true]) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationShiftedVariableCountWordComputable : + BitTM + physicalInterpolationShiftedVariableCountWord := + unarySubtractionComputable + paperVariableArityPhysicalInterpolationVariableCountWordComputable + (sourceFixedWordComputable [true]) + +@[simp] theorem + paperVariableArityPhysicalInterpolationShiftedVariableCountWord_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationShiftedVariableCountWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFormulaVariableCount formula - 1) true := by + exact unarySubtractionOutput_valid + physicalInterpolationVariableCountWord + (fun _ => [true]) + (affineCellQuery row column (encodeThreeCNF formula)) + (physicalFormulaVariableCount formula) 1 + (paperVariableArityPhysicalInterpolationVariableCountWord_valid + row column formula) + rfl + +/-- GapCVP reduction support. -/ +def physicalOrdinaryNodePrefixWord + (moment : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + true :: fourFamilyComputedUnaryProductOutput + physicalInterpolationVariableCountWord + moment.output input + +private noncomputable def paperVariableArityPhysicalOrdinaryNodePrefixWordComputable + (moment : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalOrdinaryNodePrefixWord moment) := + GapCVP.TMComposition.computableInPolyTime + (fourFamilyComputedUnaryProductComputable + paperVariableArityPhysicalInterpolationVariableCountWordComputable + moment.computer) + (GapCVP.SourceMachineCert.prependBitComputable + true) + +theorem paperVariableArityPhysicalOrdinaryNodePrefixWord_valid + (moment : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) (momentRank : ℕ) + (hmoment : moment.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate momentRank true) : + physicalOrdinaryNodePrefixWord moment + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFormulaVariableCount formula * + momentRank + 1) true := by + unfold physicalOrdinaryNodePrefixWord + rw [fourFamilyComputedUnaryProductOutput_valid + physicalInterpolationVariableCountWord + moment.output + (affineCellQuery row column (encodeThreeCNF formula)) + (physicalFormulaVariableCount formula) + momentRank + (paperVariableArityPhysicalInterpolationVariableCountWord_valid + row column formula) + hmoment] + simp only [List.replicate_succ] + +/-- GapCVP reduction support. -/ +noncomputable def physicalOrdinaryNodePrefixWidth + (moment : SourcePhysicalLagrangeWordComputer) : + SourceQaryMaskDynamicGridWidth where + output := physicalOrdinaryNodePrefixWord moment + computer := paperVariableArityPhysicalOrdinaryNodePrefixWordComputable moment + +/-- GapCVP reduction support. -/ +def physicalShiftedNodePrefixWord + (moment : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + true :: fourFamilyComputedUnaryProductOutput + physicalInterpolationShiftedVariableCountWord + moment.output input + +private noncomputable def paperVariableArityPhysicalShiftedNodePrefixWordComputable + (moment : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalShiftedNodePrefixWord moment) := + GapCVP.TMComposition.computableInPolyTime + (fourFamilyComputedUnaryProductComputable + paperVariableArityPhysicalInterpolationShiftedVariableCountWordComputable + moment.computer) + (GapCVP.SourceMachineCert.prependBitComputable + true) + +theorem paperVariableArityPhysicalShiftedNodePrefixWord_valid + (moment : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) (momentRank : ℕ) + (hmoment : moment.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate momentRank true) : + physicalShiftedNodePrefixWord moment + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((physicalFormulaVariableCount formula - 1) * + momentRank + 1) true := by + unfold physicalShiftedNodePrefixWord + rw [fourFamilyComputedUnaryProductOutput_valid + physicalInterpolationShiftedVariableCountWord + moment.output + (affineCellQuery row column (encodeThreeCNF formula)) + (physicalFormulaVariableCount formula - 1) + momentRank + (paperVariableArityPhysicalInterpolationShiftedVariableCountWord_valid + row column formula) + hmoment] + simp only [List.replicate_succ] + +/-- GapCVP reduction support. -/ +noncomputable def physicalShiftedNodePrefixWidth + (moment : SourcePhysicalLagrangeWordComputer) : + SourceQaryMaskDynamicGridWidth where + output := physicalShiftedNodePrefixWord moment + computer := paperVariableArityPhysicalShiftedNodePrefixWordComputable moment + +/-- GapCVP reduction support. -/ +def physicalInterpolationNodeParity + (width : SourceQaryMaskDynamicGridWidth) + {term : List Bool → List Bool} + (computer : BitTM term) : List Bool → List Bool := + compactPhysicalNodeParity width computer + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalInterpolationNodeParityComputable + (width : SourceQaryMaskDynamicGridWidth) + {term : List Bool → List Bool} + (computer : BitTM term) : + BitTM + (physicalInterpolationNodeParity width computer) := + compactPhysicalNodeParityComputable width computer + +theorem paperVariableArityPhysicalInterpolationNodeParity_valid + (width : SourceQaryMaskDynamicGridWidth) + {term : List Bool → List Bool} + (computer : BitTM term) + (input : List Bool) (count : ℕ) (value : ℕ → Bool) + (hwidth : width.output input = List.replicate count true) + (hterm : ∀ rank ∈ List.range count, + term (lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width input) = + [value rank]) : + physicalInterpolationNodeParity + width computer input = + [((List.range count).map value).foldl Bool.xor false] := by + exact compactPhysicalNodeParity_valid width computer input count value + hwidth hterm + +end PhysicalOrdinaryShiftedCoefficientSumTM + +namespace BinaryCompactPhysicalLagrangeNestedNodeTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryPhysicalWordRuntimeDegreeTM + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNestedNodeEnvelope + (width : SourceQaryMaskDynamicGridWidth) + (rank : ℕ) (source : List Bool) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource width source + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNestedNodeRank : List Bool → List Bool := + firstFieldContents + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalLagrangeNestedNodeRankComputable : + BitTM + compactPhysicalLagrangeNestedNodeRank := + firstFieldContentsComputable + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNestedNodeOuterCell : List Bool → List Bool := + firstFieldSuffix ∘ firstFieldSuffix + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalLagrangeNestedNodeOuterCellComputable : + BitTM + compactPhysicalLagrangeNestedNodeOuterCell := + factor400BinaryPhysicalWordRuntimeCompositionComputer + firstFieldSuffixComputable firstFieldSuffixComputable + +@[simp] theorem compactPhysicalLagrangeNestedNodeRank_query + (width : SourceQaryMaskDynamicGridWidth) + (rank : ℕ) (source : List Bool) : + compactPhysicalLagrangeNestedNodeRank + (compactPhysicalLagrangeNestedNodeEnvelope + width rank source) = + List.replicate rank true := by + simp only [compactPhysicalLagrangeNestedNodeRank, compactPhysicalLagrangeNestedNodeEnvelope, + firstFieldContents_valid] + +@[simp] theorem compactPhysicalLagrangeNestedNodeOuterCell_query + (width : SourceQaryMaskDynamicGridWidth) + (rank : ℕ) (source : List Bool) : + compactPhysicalLagrangeNestedNodeOuterCell + (compactPhysicalLagrangeNestedNodeEnvelope + width rank source) = source := by + simp only [compactPhysicalLagrangeNestedNodeOuterCell, compactPhysicalLagrangeNestedNodeEnvelope, + sourceQaryMaskDynamicGridBaseSource, Function.comp_apply, firstFieldSuffix_valid] + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNestedNodeOriginalSource : + List Bool → List Bool := + sourceExplicitAffineCellOriginalSource ∘ + compactPhysicalLagrangeNestedNodeOuterCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalLagrangeNestedNodeOriginalSourceComputable : + BitTM + compactPhysicalLagrangeNestedNodeOriginalSource := + factor400BinaryPhysicalWordRuntimeCompositionComputer + compactPhysicalLagrangeNestedNodeOuterCellComputable + factor400BinaryPhysicalWordCellOriginalSourceComputer + +@[simp] theorem compactPhysicalLagrangeNestedNodeOriginalSource_query + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) : + compactPhysicalLagrangeNestedNodeOriginalSource + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + encodeThreeCNF formula := by + simp only [compactPhysicalLagrangeNestedNodeOriginalSource, Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query, + sourceExplicitAffineCellOriginalSource_query] + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNestedOtherActualCell : + List Bool → List Bool := + compactPhysicalLagrangeNestedNodeOuterCell ∘ + compactPhysicalLagrangeNestedNodeOuterCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalLagrangeNestedOtherActualCellComputable : + BitTM + compactPhysicalLagrangeNestedOtherActualCell := + factor400BinaryPhysicalWordRuntimeCompositionComputer + compactPhysicalLagrangeNestedNodeOuterCellComputable + compactPhysicalLagrangeNestedNodeOuterCellComputable + +@[simp] theorem compactPhysicalLagrangeNestedOtherActualCell_query + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node : ℕ) (cell : List Bool) : + compactPhysicalLagrangeNestedOtherActualCell + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope + outerWidth node cell)) = cell := by + simp only [compactPhysicalLagrangeNestedOtherActualCell, Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query] + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNestedOtherOriginalSource : + List Bool → List Bool := + sourceExplicitAffineCellOriginalSource ∘ + compactPhysicalLagrangeNestedOtherActualCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalLagrangeNestedOtherOriginalSourceComputable : + BitTM + compactPhysicalLagrangeNestedOtherOriginalSource := + factor400BinaryPhysicalWordRuntimeCompositionComputer + compactPhysicalLagrangeNestedOtherActualCellComputable + factor400BinaryPhysicalWordCellOriginalSourceComputer + +@[simp] theorem compactPhysicalLagrangeNestedOtherOriginalSource_query + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node row column : ℕ) (formula : ThreeCNF) : + compactPhysicalLagrangeNestedOtherOriginalSource + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) = + encodeThreeCNF formula := by + simp only [compactPhysicalLagrangeNestedOtherOriginalSource, Function.comp_apply, + compactPhysicalLagrangeNestedOtherActualCell_query, + sourceExplicitAffineCellOriginalSource_query] + +/-- GapCVP reduction support. -/ +def compactPhysicalLagrangeNestedAnchorRank : List Bool → List Bool := + compactPhysicalLagrangeNestedNodeRank ∘ + compactPhysicalLagrangeNestedNodeOuterCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + compactPhysicalLagrangeNestedAnchorRankComputable : + BitTM + compactPhysicalLagrangeNestedAnchorRank := + factor400BinaryPhysicalWordRuntimeCompositionComputer + compactPhysicalLagrangeNestedNodeOuterCellComputable + compactPhysicalLagrangeNestedNodeRankComputable + +@[simp] theorem compactPhysicalLagrangeNestedAnchorRank_query + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node : ℕ) (cell : List Bool) : + compactPhysicalLagrangeNestedAnchorRank + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope + outerWidth node cell)) = + List.replicate node true := by + simp only [compactPhysicalLagrangeNestedAnchorRank, Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query, + compactPhysicalLagrangeNestedNodeRank_query] + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalLagrangeNestedNodeSourceWordComputer : + SourcePhysicalLagrangeWordComputer where + output := compactPhysicalLagrangeNestedNodeOriginalSource + computer := compactPhysicalLagrangeNestedNodeOriginalSourceComputable + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalLagrangeNestedOtherSourceWordComputer : + SourcePhysicalLagrangeWordComputer where + output := compactPhysicalLagrangeNestedOtherOriginalSource + computer := compactPhysicalLagrangeNestedOtherOriginalSourceComputable + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalLagrangeNestedOtherRankWordComputer : + SourcePhysicalLagrangeWordComputer where + output := compactPhysicalLagrangeNestedNodeRank + computer := compactPhysicalLagrangeNestedNodeRankComputable + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalLagrangeNestedAnchorRankWordComputer : + SourcePhysicalLagrangeWordComputer where + output := compactPhysicalLagrangeNestedAnchorRank + computer := compactPhysicalLagrangeNestedAnchorRankComputable + +end BinaryCompactPhysicalLagrangeNestedNodeTM + +namespace BinaryCompactPhysicalLagrangeMomentWeightTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryPhysicalLagrangeProductFoldTM +open GapCVP.BinaryCompactPhysicalLagrangeFactorStreamTM +open GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM + +private def compactPhysicalLagrangeMomentNodeFactorWord + (base : SourcePhysicalLagrangeWordComputer) : List Bool → List Bool := + base.output ∘ compactPhysicalLagrangeNestedNodeOuterCell + +private noncomputable def compactPhysicalLagrangeMomentNodeFactorComputable + (base : SourcePhysicalLagrangeWordComputer) : + BitTM + (compactPhysicalLagrangeMomentNodeFactorWord base) := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedNodeOuterCellComputable base.computer + +private noncomputable def compactPhysicalLagrangeMomentNodeFactorComputer + (base : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := compactPhysicalLagrangeMomentNodeFactorWord base + computer := compactPhysicalLagrangeMomentNodeFactorComputable base + +@[simp] private theorem compactPhysicalLagrangeMomentNodeFactorWord_valid + (base : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (rank : ℕ) (input : List Bool) : + compactPhysicalLagrangeMomentNodeFactorWord base + (compactPhysicalLagrangeNestedNodeEnvelope width rank input) = + base.output input := by + simp only [compactPhysicalLagrangeMomentNodeFactorWord, Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query] + +private theorem compactPhysicalLagrangeMomentFactorCatalogue_valid + {degree : ℕ} + (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (count : ℕ) + (value : GapCVP.Core.EffectiveBinaryField.Word degree) + (hwidth : width.output input = List.replicate count true) + (hvalue : base.output input = finiteWordBits value) : + compactPhysicalLagrangeNodeFactorCatalogue width + (compactPhysicalLagrangeMomentNodeFactorComputer base) input = + sourcePhysicalLagrangePackedFactorWords + (List.replicate count value) := by + rw [compactPhysicalLagrangeNodeFactorCatalogue_valid + width (compactPhysicalLagrangeMomentNodeFactorComputer base) + input count hwidth] + change + (List.range count).flatMap + (fun rank => lengthPrefixedWord + (compactPhysicalLagrangeMomentNodeFactorWord base + (compactPhysicalLagrangeNodeFactorQuery width input rank))) = + (List.replicate count value).flatMap + (fun factor => lengthPrefixedWord (finiteWordBits factor)) + have hfactor (rank : ℕ) : + compactPhysicalLagrangeMomentNodeFactorWord base + (compactPhysicalLagrangeNodeFactorQuery width input rank) = + finiteWordBits value := by + change + compactPhysicalLagrangeMomentNodeFactorWord base + (compactPhysicalLagrangeNestedNodeEnvelope width rank input) = _ + exact + (compactPhysicalLagrangeMomentNodeFactorWord_valid + base width rank input).trans hvalue + simp_rw [hfactor] + have hflat (amount : ℕ) : + (List.range amount).flatMap + (fun _ => lengthPrefixedWord (finiteWordBits value)) = + (List.replicate amount value).flatMap + (fun factor => lengthPrefixedWord (finiteWordBits factor)) := by + induction amount with + | zero => simp only [List.range_zero, List.flatMap_nil, List.replicate_zero] + | succ amount ih => + simpa only [List.range_succ, List.flatMap_append, List.flatMap_cons, List.flatMap_nil, + List.append_nil, + List.replicate_succ', List.append_cancel_right_eq] using + congrArg (fun words => words ++ lengthPrefixedWord (finiteWordBits value)) ih + exact hflat count + +end BinaryCompactPhysicalLagrangeMomentWeightTM + +namespace BinaryCompactPhysicalLagrangeNodeProductTM + +open Turing GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalLagrangeNestedNodePrefixWidth + (width : SourceQaryMaskDynamicGridWidth) : + SourceQaryMaskDynamicGridWidth where + output := width.output ∘ compactPhysicalLagrangeNestedNodeOuterCell + computer := GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedNodeOuterCellComputable width.computer + +@[simp] theorem compactPhysicalLagrangeNestedNodePrefixWidth_valid + (inner outer : SourceQaryMaskDynamicGridWidth) + (node : ℕ) (cell : List Bool) : + (compactPhysicalLagrangeNestedNodePrefixWidth inner).output + (compactPhysicalLagrangeNestedNodeEnvelope outer node cell) = + inner.output cell := by + simp only [compactPhysicalLagrangeNestedNodePrefixWidth, Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query] + +end BinaryCompactPhysicalLagrangeNodeProductTM + +namespace BinaryCompactPhysicalLagrangeMomentWeightTM + +open Turing GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryFieldBasis +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryCompactPhysicalLagrangeFactorStreamTM + +theorem compactPhysicalLagrangeIndexedOneWord + (degree : ℕ) (hdegree : 0 < degree) : + indexedWord degree + ⟨1, Nat.one_lt_two_pow (Nat.ne_of_gt hdegree)⟩ = + oneWord degree := by + funext bit + cases bit with + | mk index hindex => + cases index with + | zero => simp only [indexedWord, Nat.testBit, Nat.shiftRight_zero, Nat.and_self, + Nat.reduceBNe, oneWord, decide_true] + | succ index => + have hpower : 1 < 2 ^ (index + 1) := + Nat.one_lt_two_pow (Nat.succ_ne_zero index) + simp only [indexedWord, Nat.testBit, Nat.shiftRight_eq_div_pow, Nat.div_eq_of_lt hpower, + Nat.and_zero, + bne_self_eq_false, oneWord, Nat.add_eq_zero_iff, one_ne_zero, and_false, + decide_false] + +private theorem compactPhysicalLagrangeRepeatedMomentProduct + {degree : ℕ} + (value : GapCVP.Core.EffectiveBinaryField.Word degree) + (count : ℕ) : + (List.replicate count value).foldl + (GapCVP.Core.EffectiveBinaryField.multiplyMod + (GapCVP.Core.EffectiveBinaryField.irreducibleWord degree)) + (oneWord degree) = + sourceWordPow value count := by + induction count with + | zero => rfl + | succ count ih => + rw [List.replicate_succ', List.foldl_append, ih] + rfl + +private theorem compactPhysicalLagrangeMomentFactorProductWord_valid + {degree : ℕ} + (width : SourceQaryMaskDynamicGridWidth) + (lower initial original base : SourcePhysicalLagrangeWordComputer) + (input source : List Bool) (count : ℕ) + (lowerWord initialWord value : + GapCVP.Core.EffectiveBinaryField.Word degree) + (hwidth : width.output input = List.replicate count true) + (hlower : lower.output input = finiteWordBits lowerWord) + (hinitial : initial.output input = finiteWordBits initialWord) + (hsource : original.output input = source) + (hvalue : base.output input = finiteWordBits value) : + compactPhysicalLagrangeFactorProductWord + width lower initial original + (compactPhysicalLagrangeMomentNodeFactorComputer base) input = + finiteWordBits + ((List.replicate count value).foldl + (GapCVP.Core.EffectiveBinaryField.multiplyMod lowerWord) + initialWord) := by + have hcount : + width.output input = + List.replicate (List.replicate count value).length true := by + rw [List.length_replicate] + exact hwidth + have hcatalogue := compactPhysicalLagrangeMomentFactorCatalogue_valid + width base input count value hwidth hvalue + exact compactPhysicalLagrangeFactorProductWord_valid + width lower initial original + (compactPhysicalLagrangeMomentNodeFactorComputer base) + input lowerWord initialWord (List.replicate count value) source + hcount hlower hinitial hsource hcatalogue + +end BinaryCompactPhysicalLagrangeMomentWeightTM + +namespace SourceFieldMomentOperationsTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryDimensionTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryPhysicalRowBasisDivisionTM GapCVP.BinaryCompactPhysicalLagrangeFactorStreamTM +open GapCVP.BinaryCompactPhysicalLagrangeMomentWeightTM GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM +open GapCVP.PhysicalRefinementRowProjection +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine + +/-- GapCVP reduction support. -/ +def physicalFamilyStart + (family : Fin 4) (formula : ThreeCNF) : ℕ := + if family.val = 0 then 0 + else if family.val = 1 then + physicalFormulaGlobalBoundary formula + else if family.val = 2 then + physicalFormulaRefinementBoundary formula + else physicalFormulaOrdinaryBoundary formula + +private def physicalFamilyStartUnary + (family : Fin 4) : List Bool → List Bool := + if family.val = 0 then fun _ => [] + else if family.val = 1 then + physicalCellGlobalBoundaryUnary + else if family.val = 2 then + physicalCellRefinementBoundaryUnary + else physicalCellOrdinaryBoundaryUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalFamilyStartUnaryComputable + (family : Fin 4) : + BitTM + (physicalFamilyStartUnary family) := by + unfold physicalFamilyStartUnary + split + · exact sourceFixedWordComputable [] + next => + split + · exact paperVariableArityPhysicalCellGlobalBoundaryUnaryComputable + next => + split + · exact paperVariableArityPhysicalCellRefinementBoundaryUnaryComputable + · exact paperVariableArityPhysicalCellOrdinaryBoundaryUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalFamilyStartUnary_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalFamilyStartUnary family + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFamilyStart family formula) true := by + by_cases hzero : family.val = 0 + · simp only [physicalFamilyStartUnary, hzero, ↓reduceIte, physicalFamilyStart, + List.replicate_zero] + · by_cases hone : family.val = 1 + · simp only [physicalFamilyStartUnary, hone, one_ne_zero, ↓reduceIte, + paperVariableArityPhysicalCellGlobalBoundaryUnary_query, physicalFamilyStart] + · by_cases htwo : family.val = 2 + · simp only [physicalFamilyStartUnary, htwo, OfNat.ofNat_ne_zero, ↓reduceIte, + OfNat.ofNat_ne_one, + paperVariableArityPhysicalCellRefinementBoundaryUnary_query, physicalFamilyStart] + · simp only [physicalFamilyStartUnary, hzero, ↓reduceIte, hone, htwo, + paperVariableArityPhysicalCellOrdinaryBoundaryUnary_query, physicalFamilyStart] + +private def physicalMomentCellDegreeUnary : + List Bool → List Bool := + physicalCellSourceLift + physicalFamilyFieldDegreeUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalMomentCellDegreeUnaryComputable : + BitTM + physicalMomentCellDegreeUnary := + physicalCellSourceLiftComputable + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalMomentCellDegreeUnary_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalMomentCellDegreeUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physDegree formula) true := by + unfold physicalMomentCellDegreeUnary + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalFamilyFieldDegreeUnary_valid] + +/-- GapCVP reduction support. -/ +def physicalMomentCellGridCardinalityUnary : + List Bool → List Bool := + physicalCellSourceLift + physicalFamilyGridCardinalityUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalMomentCellGridCardinalityUnaryComputable : + BitTM + physicalMomentCellGridCardinalityUnary := + physicalCellSourceLiftComputable + paperVariableArityPhysicalFamilyGridCardinalityUnaryComputable + +@[simp] theorem paperVariableArityPhysicalMomentCellGridCardinalityUnary_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalMomentCellGridCardinalityUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physGridCard formula) true := by + unfold physicalMomentCellGridCardinalityUnary + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalFamilyGridCardinalityUnary_valid] + +/-- GapCVP reduction support. -/ +def physicalMomentCellMomentCountUnary : + List Bool → List Bool := + physicalCellSourceLift + physicalFamilyMomentCountUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalMomentCellMomentCountUnaryComputable : + BitTM + physicalMomentCellMomentCountUnary := + physicalCellSourceLiftComputable + paperVariableArityPhysicalFamilyMomentCountUnaryComputable + +@[simp] theorem paperVariableArityPhysicalMomentCellMomentCountUnary_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalMomentCellMomentCountUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFormulaMomentCount formula) true := by + unfold physicalMomentCellMomentCountUnary + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalFamilyMomentCountUnary_valid] + +private def physicalFamilyRowLocalOffsetWord + (family : Fin 4) : List Bool → List Bool := + unarySubtractionOutput sourceExplicitAffineCellRow + (physicalFamilyStartUnary family) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalFamilyRowLocalOffsetComputable + (family : Fin 4) : + BitTM + (physicalFamilyRowLocalOffsetWord family) := + unarySubtractionComputable sourceExplicitAffineCellRowComputable + (paperVariableArityPhysicalFamilyStartUnaryComputable family) + +@[simp] private theorem paperVariableArityPhysicalFamilyRowLocalOffsetWord_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalFamilyRowLocalOffsetWord family + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (row - physicalFamilyStart family formula) true := + unarySubtractionOutput_valid sourceExplicitAffineCellRow + (physicalFamilyStartUnary family) + (affineCellQuery row column + (encodeThreeCNF formula)) + row (physicalFamilyStart family formula) + (sourceExplicitAffineCellRow_query row column + (encodeThreeCNF formula)) + (paperVariableArityPhysicalFamilyStartUnary_valid + family row column formula) + +/-- GapCVP reduction support. -/ +def physicalFamilyRowFieldRankWord + (family : Fin 4) : List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + (physicalFamilyRowLocalOffsetWord family) + physicalMomentCellDegreeUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalFamilyRowFieldRankComputable + (family : Fin 4) : + BitTM + (physicalFamilyRowFieldRankWord family) := + sourcePhysicalComputedUnaryQuotientComputable + (paperVariableArityPhysicalFamilyRowLocalOffsetComputable family) + paperVariableArityPhysicalMomentCellDegreeUnaryComputable + +@[simp] theorem paperVariableArityPhysicalFamilyRowFieldRankWord_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalFamilyRowFieldRankWord family + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((row - physicalFamilyStart family formula) / + physDegree formula) true := + sourcePhysicalComputedUnaryQuotient_valid + (physicalFamilyRowLocalOffsetWord family) + physicalMomentCellDegreeUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + (row - physicalFamilyStart family formula) + (physDegree formula) + (physicalRefinementDegree_pos formula) + (paperVariableArityPhysicalFamilyRowLocalOffsetWord_valid + family row column formula) + (paperVariableArityPhysicalMomentCellDegreeUnary_valid + row column formula) + +/-- GapCVP reduction support. -/ +def physicalFamilyRowGridQuotientWord + (family : Fin 4) : List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + (physicalFamilyRowFieldRankWord family) + physicalMomentCellGridCardinalityUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalFamilyRowGridQuotientComputable + (family : Fin 4) : + BitTM + (physicalFamilyRowGridQuotientWord family) := + sourcePhysicalComputedUnaryQuotientComputable + (paperVariableArityPhysicalFamilyRowFieldRankComputable family) + paperVariableArityPhysicalMomentCellGridCardinalityUnaryComputable + +@[simp] theorem paperVariableArityPhysicalFamilyRowGridQuotientWord_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalFamilyRowGridQuotientWord family + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (((row - physicalFamilyStart family formula) / + physDegree formula) / + physGridCard formula) true := + sourcePhysicalComputedUnaryQuotient_valid + (physicalFamilyRowFieldRankWord family) + physicalMomentCellGridCardinalityUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + ((row - physicalFamilyStart family formula) / + physDegree formula) + (physGridCard formula) + (physicalRefinementGridCard_pos formula) + (paperVariableArityPhysicalFamilyRowFieldRankWord_valid + family row column formula) + (paperVariableArityPhysicalMomentCellGridCardinalityUnary_valid + row column formula) + +/-- GapCVP reduction support. -/ +def physicalFamilyRowMoment + (family : Fin 4) (row : ℕ) (formula : ThreeCNF) : ℕ := + (((row - physicalFamilyStart family formula) / + physDegree formula) / + physGridCard formula) % + physicalFormulaMomentCount formula + +theorem physicalFormulaMomentCount_pos + (formula : ThreeCNF) : + 0 < physicalFormulaMomentCount formula := by + change 0 < physicalFormulaSize formula ^ 30 + 1 + omega + +/-- GapCVP reduction support. -/ +def physicalFamilyRowMomentRankWord + (family : Fin 4) : List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + (physicalFamilyRowGridQuotientWord family) + physicalMomentCellMomentCountUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalFamilyRowMomentRankComputable + (family : Fin 4) : + BitTM + (physicalFamilyRowMomentRankWord family) := + sourcePhysicalComputedUnaryRemainderComputable + (paperVariableArityPhysicalFamilyRowGridQuotientComputable family) + paperVariableArityPhysicalMomentCellMomentCountUnaryComputable + +/-- GapCVP reduction support. -/ +noncomputable def physicalFamilyRowMomentRankComputer + (family : Fin 4) : SourcePhysicalLagrangeWordComputer where + output := physicalFamilyRowMomentRankWord family + computer := paperVariableArityPhysicalFamilyRowMomentRankComputable family + +@[simp] theorem paperVariableArityPhysicalFamilyRowMomentRankWord_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalFamilyRowMomentRankWord family + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFamilyRowMoment family row formula) true := + sourcePhysicalComputedUnaryRemainder_valid + (physicalFamilyRowGridQuotientWord family) + physicalMomentCellMomentCountUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + (((row - physicalFamilyStart family formula) / + physDegree formula) / + physGridCard formula) + (physicalFormulaMomentCount formula) + (physicalFormulaMomentCount_pos formula) + (paperVariableArityPhysicalFamilyRowGridQuotientWord_valid + family row column formula) + (paperVariableArityPhysicalMomentCellMomentCountUnary_valid + row column formula) + +private noncomputable def physicalFamilyRowMomentWidth + (family : Fin 4) : SourceQaryMaskDynamicGridWidth where + output := physicalFamilyRowMomentRankWord family + computer := paperVariableArityPhysicalFamilyRowMomentRankComputable family + +private theorem paperVariableArityPhysicalFamilyRowMomentWidth_output + (family : Fin 4) : + (physicalFamilyRowMomentWidth family).output = + physicalFamilyRowMomentRankWord family := by + dsimp only [physicalFamilyRowMomentWidth] + +@[simp] private theorem paperVariableArityPhysicalFamilyRowMomentWidth_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + (physicalFamilyRowMomentWidth family).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFamilyRowMoment family row formula) true := by + rw [paperVariableArityPhysicalFamilyRowMomentWidth_output] + exact paperVariableArityPhysicalFamilyRowMomentRankWord_valid + family row column formula + +private noncomputable def paperVariableArityPhysicalMomentUnitRankComputer : + SourcePhysicalLagrangeWordComputer where + output := fun _ => [true] + computer := sourceFixedWordComputable [true] + +private def physicalMomentUnitWord : List Bool → List Bool := + physicalCellFieldWordAt + paperVariableArityPhysicalMomentUnitRankComputer + +private noncomputable def paperVariableArityPhysicalMomentUnitWordComputable : + BitTM + physicalMomentUnitWord := + physicalCellFieldWordAtComputable + paperVariableArityPhysicalMomentUnitRankComputer + +private noncomputable def paperVariableArityPhysicalMomentUnitComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalMomentUnitWord + computer := paperVariableArityPhysicalMomentUnitWordComputable + +@[simp] private theorem paperVariableArityPhysicalMomentUnitWord_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalMomentUnitWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (oneWord + (sourceIrreducibleFormulaDegree formula)) := by + have hdegree : + 0 < sourceIrreducibleFormulaDegree formula := + sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)) + let index : Fin + (2 ^ sourceIrreducibleFormulaDegree formula) := + ⟨1, Nat.one_lt_two_pow (Nat.ne_of_gt hdegree)⟩ + have hword := physicalCellFieldWordAt_valid + paperVariableArityPhysicalMomentUnitRankComputer + row column formula index (by rfl) + unfold physicalMomentUnitWord + rw [hword] + congr 1 + exact compactPhysicalLagrangeIndexedOneWord + (sourceIrreducibleFormulaDegree formula) hdegree + +private noncomputable def physicalMomentOriginalSourceComputer : + SourcePhysicalLagrangeWordComputer := + compactPhysicalLagrangeOriginalSourceComputer + +@[simp] private theorem paperVariableArityPhysicalMomentOriginalSourceComputer_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalMomentOriginalSourceComputer.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + encodeThreeCNF formula := by + exact sourceExplicitAffineCellOriginalSource_query + row column (encodeThreeCNF formula) + +/-- GapCVP reduction support. -/ +def physicalFamilyMomentPowerWord + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + compactPhysicalLagrangeFactorProductWord + (physicalFamilyRowMomentWidth family) + physicalCellSelectedModulusComputer + paperVariableArityPhysicalMomentUnitComputer + physicalMomentOriginalSourceComputer + (compactPhysicalLagrangeMomentNodeFactorComputer base) + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalFamilyMomentPowerComputable + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalFamilyMomentPowerWord family base) := + compactPhysicalLagrangeFactorProductComputable + (physicalFamilyRowMomentWidth family) + physicalCellSelectedModulusComputer + paperVariableArityPhysicalMomentUnitComputer + physicalMomentOriginalSourceComputer + (compactPhysicalLagrangeMomentNodeFactorComputer base) + +/-- GapCVP reduction support. -/ +noncomputable def physicalFamilyMomentPowerComputer + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalFamilyMomentPowerWord family base + computer := paperVariableArityPhysicalFamilyMomentPowerComputable + family base + +theorem paperVariableArityPhysicalFamilyMomentPowerWord_valid + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (value : GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula)) + (hvalue : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + physicalFamilyMomentPowerWord family base + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (sourceWordPow value + (physicalFamilyRowMoment family row formula)) := by + unfold physicalFamilyMomentPowerWord + rw [← compactPhysicalLagrangeRepeatedMomentProduct] + apply compactPhysicalLagrangeMomentFactorProductWord_valid + (physicalFamilyRowMomentWidth family) + physicalCellSelectedModulusComputer + paperVariableArityPhysicalMomentUnitComputer + physicalMomentOriginalSourceComputer base + (affineCellQuery row column + (encodeThreeCNF formula)) + (encodeThreeCNF formula) + (physicalFamilyRowMoment family row formula) + (irreducibleWord + (sourceIrreducibleFormulaDegree formula)) + (oneWord + (sourceIrreducibleFormulaDegree formula)) value + · exact paperVariableArityPhysicalFamilyRowMomentWidth_valid + family row column formula + · exact paperVariableArityPhysicalCellSelectedModulusWord_valid + row column formula + · exact paperVariableArityPhysicalMomentUnitWord_valid + row column formula + · exact paperVariableArityPhysicalMomentOriginalSourceComputer_valid + row column formula + · exact hvalue + +end SourceFieldMomentOperationsTM + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part15.lean b/LeanPool/GapCVP/Part15.lean new file mode 100644 index 000000000..9832a3209 --- /dev/null +++ b/LeanPool/GapCVP/Part15.lean @@ -0,0 +1,7711 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part14 + +/-! # GapCVP proof, part 15 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace PhysicalInterpolationDirectMomentBitTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryPhysicalRowBasisDivisionTM GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalGlobalRefinementCoefficientTM GapCVP.SourceFieldMomentOperationsTM +open GapCVP.PhysicalMatrixCellTM + +private def physicalInterpolationRowGridRankWord + (family : Fin 4) : List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + (physicalFamilyRowFieldRankWord family) + physicalMomentCellGridCardinalityUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationRowGridRankWordComputable + (family : Fin 4) : + BitTM + (physicalInterpolationRowGridRankWord family) := + sourcePhysicalComputedUnaryRemainderComputable + (paperVariableArityPhysicalFamilyRowFieldRankComputable family) + paperVariableArityPhysicalMomentCellGridCardinalityUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalInterpolationRowGridRankWord_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationRowGridRankWord family + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (((row - physicalFamilyStart family formula) / + physDegree formula) % + physGridCard formula) true := by + exact sourcePhysicalComputedUnaryRemainder_valid + (physicalFamilyRowFieldRankWord family) + physicalMomentCellGridCardinalityUnary + (affineCellQuery row column (encodeThreeCNF formula)) + ((row - physicalFamilyStart family formula) / + physDegree formula) + (physGridCard formula) + (physicalCoefficientGridCardinality_pos formula) + (paperVariableArityPhysicalFamilyRowFieldRankWord_valid + family row column formula) + (paperVariableArityPhysicalMomentCellGridCardinalityUnary_valid + row column formula) + +private def physicalInterpolationDirectGridMatchBit + (family : Fin 4) : List Bool → List Bool := + physicalCoefficientUnaryEquality + (physicalInterpolationRowGridRankWord family) + physicalColumnGridRankUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationDirectGridMatchBitComputable + (family : Fin 4) : + BitTM + (physicalInterpolationDirectGridMatchBit family) := + paperVariableArityPhysicalCoefficientUnaryEqualityComputable + (paperVariableArityPhysicalInterpolationRowGridRankWordComputable family) + physicalColumnGridRankUnaryComputable + +@[simp] theorem + paperVariableArityPhysicalInterpolationDirectGridMatchBit_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationDirectGridMatchBit family + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + ((((row - physicalFamilyStart family formula) / + physDegree formula) % + physGridCard formula) = + ((column / physFieldCard formula) % + physGridCard formula))] := by + exact physicalCoefficientUnaryEquality_valid + (physicalInterpolationRowGridRankWord family) + physicalColumnGridRankUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (((row - physicalFamilyStart family formula) / + physDegree formula) % + physGridCard formula) + ((column / physFieldCard formula) % + physGridCard formula) + (paperVariableArityPhysicalInterpolationRowGridRankWord_valid + family row column formula) + (paperVariableArityPhysicalColumnGridRankUnary_query + row column formula) + +/-- GapCVP reduction support. -/ +def physicalFamilyDirectMomentBit + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (physicalInterpolationDirectGridMatchBit family) + (physicalMatrixCoefficientBit + physicalMatrixSelectedBasisRankComputer + (physicalFamilyMomentPowerComputer family base)) + +private noncomputable def paperVariableArityPhysicalFamilyDirectMomentBitComputable + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalFamilyDirectMomentBit family base) := + fourFamilyBooleanAndComputable + (paperVariableArityPhysicalInterpolationDirectGridMatchBitComputable family) + (paperVariableArityPhysicalMatrixCoefficientBitComputable + physicalMatrixSelectedBasisRankComputer + (physicalFamilyMomentPowerComputer family base)) + +private theorem paperVariableArityPhysicalFamilyMomentPowerComputer_output + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + (physicalFamilyMomentPowerComputer family base).output = + physicalFamilyMomentPowerWord family base := by + dsimp only [physicalFamilyMomentPowerComputer] + +private theorem paperVariableArityPhysicalFamilyMomentPowerComputer_valid + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (hvalue : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + (physicalFamilyMomentPowerComputer family base).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (sourceWordPow value + (physicalFamilyRowMoment family row formula)) := by + rw [paperVariableArityPhysicalFamilyMomentPowerComputer_output] + exact paperVariableArityPhysicalFamilyMomentPowerWord_valid + family base row column formula value hvalue + +private theorem paperVariableArityPhysicalFamilyMomentBasisBit_valid + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (index : Fin (physDegree formula)) + (hindex : index.val = + row % physDegree formula) + (hvalue : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + physicalMatrixCoefficientBit + physicalMatrixSelectedBasisRankComputer + (physicalFamilyMomentPowerComputer family base) + (affineCellQuery row column + (encodeThreeCNF formula)) = + [(sourceWordPow value + (physicalFamilyRowMoment family row formula)) + index] := by + apply paperVariableArityPhysicalMatrixCoefficientBit_valid + physicalMatrixSelectedBasisRankComputer + (physicalFamilyMomentPowerComputer family base) + row column formula + (sourceWordPow value + (physicalFamilyRowMoment family row formula)) + index.val index.isLt + · rw [hindex] + exact paperVariableArityPhysicalMatrixSelectedBasisRankComputer_query + row column formula + · exact paperVariableArityPhysicalFamilyMomentPowerComputer_valid + family base row column formula value hvalue + +theorem paperVariableArityPhysicalFamilyDirectMomentBit_valid + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (index : Fin (physDegree formula)) + (hindex : index.val = + row % physDegree formula) + (hvalue : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + physicalFamilyDirectMomentBit family base + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + ((((row - physicalFamilyStart family formula) / + physDegree formula) % + physGridCard formula) = + ((column / physFieldCard formula) % + physGridCard formula)) && + (sourceWordPow value + (physicalFamilyRowMoment family row formula)) + index] := by + let query := affineCellQuery row column + (encodeThreeCNF formula) + exact fourFamilyBooleanAndOutput_bits + (physicalInterpolationDirectGridMatchBit family) + (physicalMatrixCoefficientBit + physicalMatrixSelectedBasisRankComputer + (physicalFamilyMomentPowerComputer family base)) + query + (decide + ((((row - physicalFamilyStart family formula) / + physDegree formula) % + physGridCard formula) = + ((column / physFieldCard formula) % + physGridCard formula))) + ((sourceWordPow value + (physicalFamilyRowMoment family row formula)) + index) + (paperVariableArityPhysicalInterpolationDirectGridMatchBit_valid + family row column formula) + (paperVariableArityPhysicalFamilyMomentBasisBit_valid + family base row column formula value index hindex hvalue) + +end PhysicalInterpolationDirectMomentBitTM + +namespace PhysicalMaskedInterpolationNodeParityTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryCompactPhysicalFieldCoefficientBitTM +open GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalGlobalRefinementCoefficientTM +open GapCVP.PhysicalMatrixCellTM GapCVP.SourceFieldMomentOperationsTM +open GapCVP.PhysicalOrdinaryShiftedCoefficientSumTM GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +private def physicalInterpolationOuterColumnGridRank : + List Bool → List Bool := + physicalColumnGridRankUnary ∘ + compactPhysicalLagrangeNestedNodeOuterCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationOuterColumnGridRankComputable : + BitTM + physicalInterpolationOuterColumnGridRank := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedNodeOuterCellComputable + physicalColumnGridRankUnaryComputable + +private def physicalInterpolationNodeColumnGridMask : + List Bool → List Bool := + physicalCoefficientUnaryEquality + compactPhysicalLagrangeNestedNodeRank + physicalInterpolationOuterColumnGridRank + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNodeColumnGridMaskComputable : + BitTM + physicalInterpolationNodeColumnGridMask := + paperVariableArityPhysicalCoefficientUnaryEqualityComputable + compactPhysicalLagrangeNestedNodeRankComputable + paperVariableArityPhysicalInterpolationOuterColumnGridRankComputable + +private theorem paperVariableArityPhysicalInterpolationNodeColumnGridMask_valid + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationNodeColumnGridMask + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + [decide + (node = + ((column / physFieldCard formula) % + physGridCard formula))] := by + apply physicalCoefficientUnaryEquality_valid + compactPhysicalLagrangeNestedNodeRank + physicalInterpolationOuterColumnGridRank + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) + node + ((column / physFieldCard formula) % + physGridCard formula) + · exact compactPhysicalLagrangeNestedNodeRank_query width node + (affineCellQuery row column + (encodeThreeCNF formula)) + · unfold physicalInterpolationOuterColumnGridRank + rw [Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query] + exact paperVariableArityPhysicalColumnGridRankUnary_query + row column formula + +private def physicalInterpolationNestedBasisRankWord : + List Bool → List Bool := + (physicalMatrixBasisRankComputer + physicalMatrixFieldDegreeComputer).output ∘ + compactPhysicalLagrangeNestedNodeOuterCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedBasisRankWordComputable : + BitTM + physicalInterpolationNestedBasisRankWord := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedNodeOuterCellComputable + (physicalMatrixBasisRankComputer + physicalMatrixFieldDegreeComputer).computer + +private noncomputable def paperVariableArityPhysicalInterpolationNestedBasisRankComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedBasisRankWord + computer := + paperVariableArityPhysicalInterpolationNestedBasisRankWordComputable + +private theorem paperVariableArityPhysicalInterpolationNestedBasisRankWord_valid + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationNestedBasisRankWord + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + List.replicate + (row % physDegree formula) true := by + unfold physicalInterpolationNestedBasisRankWord + rw [Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query] + exact paperVariableArityPhysicalMatrixBasisRankComputer_query + physicalMatrixFieldDegreeComputer + row column formula + (physDegree formula) + (GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula))) + (paperVariableArityPhysicalMatrixFieldDegreeComputer_query + row column formula) + +/-- GapCVP reduction support. -/ +def physicalInterpolationRowBasisIndex + (row : ℕ) (formula : ThreeCNF) : + Fin (physDegree formula) := + ⟨row % physDegree formula, + Nat.mod_lt _ + (GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)))⟩ + +private def physicalInterpolationNodeWeightBasisBit + (weight : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + compactPhysicalFieldCoefficientPreparedBit + paperVariableArityPhysicalInterpolationNestedBasisRankComputer + weight compactPhysicalLagrangeNestedNodeSourceWordComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNodeWeightBasisBitComputable + (weight : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationNodeWeightBasisBit weight) := + compactPhysicalFieldCoefficientPreparedBitComputable + paperVariableArityPhysicalInterpolationNestedBasisRankComputer + weight compactPhysicalLagrangeNestedNodeSourceWordComputer + +private theorem paperVariableArityPhysicalInterpolationNodeWeightBasisBit_valid + (weight : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) + (word : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (correctWeight : + weight.output + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = finiteWordBits word) : + physicalInterpolationNodeWeightBasisBit weight + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + [word (physicalInterpolationRowBasisIndex + row formula)] := by + unfold physicalInterpolationNodeWeightBasisBit + apply compactPhysicalFieldCoefficientPreparedBit_bounded_valid + paperVariableArityPhysicalInterpolationNestedBasisRankComputer + weight compactPhysicalLagrangeNestedNodeSourceWordComputer + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) + formula word + (row % physDegree formula) + (physicalInterpolationRowBasisIndex row formula).isLt + · exact paperVariableArityPhysicalInterpolationNestedBasisRankWord_valid + width node row column formula + · exact correctWeight + · exact compactPhysicalLagrangeNestedNodeOriginalSource_query + width node row column formula + +private def physicalMaskedNodeInterpolationBit + (weight : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + physicalInterpolationNodeColumnGridMask + (physicalInterpolationNodeWeightBasisBit weight) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalMaskedNodeInterpolationBitComputable + (weight : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalMaskedNodeInterpolationBit weight) := + fourFamilyBooleanAndComputable + paperVariableArityPhysicalInterpolationNodeColumnGridMaskComputable + (paperVariableArityPhysicalInterpolationNodeWeightBasisBitComputable + weight) + +private theorem paperVariableArityPhysicalMaskedNodeInterpolationBit_valid + (weight : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) + (word : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (correctWeight : + weight.output + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = finiteWordBits word) : + physicalMaskedNodeInterpolationBit weight + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + [decide + (node = + ((column / physFieldCard formula) % + physGridCard formula)) && + word (physicalInterpolationRowBasisIndex + row formula)] := by + unfold physicalMaskedNodeInterpolationBit + exact fourFamilyBooleanAndOutput_bits + physicalInterpolationNodeColumnGridMask + (physicalInterpolationNodeWeightBasisBit weight) + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) + (decide + (node = + ((column / physFieldCard formula) % + physGridCard formula))) + (word (physicalInterpolationRowBasisIndex + row formula)) + (paperVariableArityPhysicalInterpolationNodeColumnGridMask_valid + width node row column formula) + (paperVariableArityPhysicalInterpolationNodeWeightBasisBit_valid + weight width node row column formula word correctWeight) + +/-- GapCVP reduction support. -/ +noncomputable def physicalOrdinaryInterpolationMomentComputer : + SourcePhysicalLagrangeWordComputer := + physicalFamilyRowMomentRankComputer (2 : Fin 4) + +/-- GapCVP reduction support. -/ +noncomputable def physicalShiftedInterpolationMomentComputer : + SourcePhysicalLagrangeWordComputer := + physicalFamilyRowMomentRankComputer (3 : Fin 4) + +/-- GapCVP reduction support. -/ +def physicalOrdinaryInterpolationNodeCount + (row : ℕ) (formula : ThreeCNF) : ℕ := + physicalFormulaVariableCount formula * + physicalFamilyRowMoment (2 : Fin 4) row formula + 1 + +/-- GapCVP reduction support. -/ +def physicalShiftedInterpolationNodeCount + (row : ℕ) (formula : ThreeCNF) : ℕ := + (physicalFormulaVariableCount formula - 1) * + physicalFamilyRowMoment (3 : Fin 4) row formula + 1 + +private def physicalMaskedInterpolationNodeValue + (row column : ℕ) (formula : ThreeCNF) + (word : ℕ → GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (node : ℕ) : Bool := + decide + (node = + ((column / physFieldCard formula) % + physGridCard formula)) && + word node + (physicalInterpolationRowBasisIndex row formula) + +private theorem paperVariableArityPhysicalOrdinaryInterpolationMomentComputer_output : + physicalOrdinaryInterpolationMomentComputer.output = + physicalFamilyRowMomentRankWord (2 : Fin 4) := by + dsimp only [physicalOrdinaryInterpolationMomentComputer, + physicalFamilyRowMomentRankComputer] + +private theorem paperVariableArityPhysicalOrdinaryInterpolationMomentComputer_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalOrdinaryInterpolationMomentComputer.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFamilyRowMoment (2 : Fin 4) + row formula) true := by + rw [paperVariableArityPhysicalOrdinaryInterpolationMomentComputer_output] + exact paperVariableArityPhysicalFamilyRowMomentRankWord_valid + (2 : Fin 4) row column formula + +private theorem paperVariableArityPhysicalShiftedInterpolationMomentComputer_output : + physicalShiftedInterpolationMomentComputer.output = + physicalFamilyRowMomentRankWord (3 : Fin 4) := by + dsimp only [physicalShiftedInterpolationMomentComputer, + physicalFamilyRowMomentRankComputer] + +private theorem paperVariableArityPhysicalShiftedInterpolationMomentComputer_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalShiftedInterpolationMomentComputer.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalFamilyRowMoment (3 : Fin 4) + row formula) true := by + rw [paperVariableArityPhysicalShiftedInterpolationMomentComputer_output] + exact paperVariableArityPhysicalFamilyRowMomentRankWord_valid + (3 : Fin 4) row column formula + +private theorem paperVariableArityPhysicalOrdinaryInterpolationNodeWidth_output : + (physicalOrdinaryNodePrefixWidth + physicalOrdinaryInterpolationMomentComputer).output = + physicalOrdinaryNodePrefixWord + physicalOrdinaryInterpolationMomentComputer := by + dsimp only [physicalOrdinaryNodePrefixWidth] + +theorem paperVariableArityPhysicalOrdinaryInterpolationNodeWidth_valid + (row column : ℕ) (formula : ThreeCNF) : + (physicalOrdinaryNodePrefixWidth + physicalOrdinaryInterpolationMomentComputer).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalOrdinaryInterpolationNodeCount + row formula) true := by + rw [paperVariableArityPhysicalOrdinaryInterpolationNodeWidth_output] + exact paperVariableArityPhysicalOrdinaryNodePrefixWord_valid + physicalOrdinaryInterpolationMomentComputer + row column formula + (physicalFamilyRowMoment (2 : Fin 4) row formula) + (paperVariableArityPhysicalOrdinaryInterpolationMomentComputer_valid + row column formula) + +private theorem paperVariableArityPhysicalShiftedInterpolationNodeWidth_output : + (physicalShiftedNodePrefixWidth + physicalShiftedInterpolationMomentComputer).output = + physicalShiftedNodePrefixWord + physicalShiftedInterpolationMomentComputer := by + dsimp only [physicalShiftedNodePrefixWidth] + +theorem paperVariableArityPhysicalShiftedInterpolationNodeWidth_valid + (row column : ℕ) (formula : ThreeCNF) : + (physicalShiftedNodePrefixWidth + physicalShiftedInterpolationMomentComputer).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedInterpolationNodeCount + row formula) true := by + rw [paperVariableArityPhysicalShiftedInterpolationNodeWidth_output] + exact paperVariableArityPhysicalShiftedNodePrefixWord_valid + physicalShiftedInterpolationMomentComputer + row column formula + (physicalFamilyRowMoment (3 : Fin 4) row formula) + (paperVariableArityPhysicalShiftedInterpolationMomentComputer_valid + row column formula) + +private theorem paperVariableArityPhysicalMaskedInterpolationParity_valid + (width : SourceQaryMaskDynamicGridWidth) + (weight : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (count : ℕ) (value : ℕ → Bool) + (hwidth : width.output input = List.replicate count true) + (hterm : ∀ node ∈ List.range count, + physicalMaskedNodeInterpolationBit weight + (compactPhysicalLagrangeNestedNodeEnvelope width node input) = + [value node]) : + physicalInterpolationNodeParity width + (paperVariableArityPhysicalMaskedNodeInterpolationBitComputable + weight) input = + [((List.range count).map value).foldl Bool.xor false] := by + apply paperVariableArityPhysicalInterpolationNodeParity_valid width + (paperVariableArityPhysicalMaskedNodeInterpolationBitComputable weight) + input count value hwidth + intro node member + change + physicalMaskedNodeInterpolationBit weight + (compactPhysicalLagrangeNestedNodeEnvelope width node input) = + [value node] + exact hterm node member + +end PhysicalMaskedInterpolationNodeParityTM + +namespace Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine + +open Turing GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldBasis +open GapCVP.BinaryModularReductionTM GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinarySelectedIrreducibleWordTM +open GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalCellVariableCountLiftComputable : + BitTM + (physicalCellSourceLift + physicalFamilyVariableCountUnary) := + physicalCellSourceLiftComputable + paperVariableArityPhysicalFamilyVariableCountUnaryComputable + +private def physicalCellGridRankWord + (rank : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + physicalCellSourceLift + physicalFamilyVariableCountUnary input ++ + rank.output input + +private noncomputable def paperVariableArityPhysicalCellGridRankWordComputable + (rank : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalCellGridRankWord rank) := by + cases rank with + | mk rankWord rankComputer => + exact factor400BinaryIrreduciblePhysicalAppendComputer + (first := physicalCellSourceLift + physicalFamilyVariableCountUnary) + (second := rankWord) + paperVariableArityPhysicalCellVariableCountLiftComputable + rankComputer + +private noncomputable def physicalCellGridRankComputer + (rank : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalCellGridRankWord rank + computer := paperVariableArityPhysicalCellGridRankWordComputable rank + +private theorem paperVariableArityPhysicalCellGridRankComputer_output + (rank : SourcePhysicalLagrangeWordComputer) : + (physicalCellGridRankComputer rank).output = + physicalCellGridRankWord rank := by + dsimp only [physicalCellGridRankComputer] + +private theorem paperVariableArityPhysicalCellGridRankWord_valid + (rank : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) (position : ℕ) + (hrank : rank.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + physicalCellGridRankWord rank + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((srcFormula formula).variableCount + position) + true := by + unfold physicalCellGridRankWord + rw [paperVariableArityPhysicalCellSourceLift_query, + paperVariableArityPhysicalFamilyVariableCountUnary_valid, hrank] + exact (List.replicate_add _ _ _).symm + +private def physicalCellGridWordAt + (rank : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + physicalCellFieldWordAt + (physicalCellGridRankComputer rank) + +private noncomputable def paperVariableArityPhysicalCellGridWordAtComputable + (rank : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalCellGridWordAt rank) := + physicalCellFieldWordAtComputable + (physicalCellGridRankComputer rank) + +private theorem paperVariableArityPhysicalCellGridWordAt_valid + (rank : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (point : Fin + (2 ^ sourceIrreducibleFormulaDegree formula - + (srcFormula formula).variableCount)) + (hrank : rank.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate point.val true) : + physicalCellGridWordAt rank + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (indexedWord (sourceIrreducibleFormulaDegree formula) + (evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) point)) := by + let index := evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) point + have hindex : + (physicalCellGridRankComputer rank).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate index.val true := by + rw [paperVariableArityPhysicalCellGridRankComputer_output] + exact paperVariableArityPhysicalCellGridRankWord_valid + rank row column formula point.val hrank + exact physicalCellFieldWordAt_valid + (physicalCellGridRankComputer rank) + row column formula index hindex + +end Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine + +namespace PhysicalInterpolationNodeGridMaskTM + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.CLStructuralPrefixWriter GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceFourFamilyDiagonalMembershipPredicateTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryFieldBasis GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalCellGridWordTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.FormulaBridge +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine + +/-- GapCVP reduction support. -/ +abbrev PaperVariableArityPhysicalInterpolationGridIndex + (formula : ThreeCNF) := + Fin (2 ^ sourceIrreducibleFormulaDegree formula - + (srcFormula formula).variableCount) + +private def physicalInterpolationRebuiltGridCell + (rank source : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + lengthPrefixedWord (rank.output input) ++ + lengthPrefixedWord [] ++ source.output input + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationRebuiltGridCellComputable + (rank source : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationRebuiltGridCell rank source) := by + have hprefix := GapCVP.TMComposition.computableInPolyTime + rank.computer structuralPrefixWriterComputable + have hrecords := physicalCellGridAppendComputer + hprefix (sourceFixedWordComputable (lengthPrefixedWord [])) + have hphysical := physicalCellGridAppendComputer hrecords source.computer + change BitTM + (fun input => + lengthPrefixedWord (rank.output input) ++ + lengthPrefixedWord [] ++ source.output input) + simpa only [List.append_assoc, Function.comp_apply] using hphysical + +private theorem paperVariableArityPhysicalInterpolationRebuiltGridCell_valid + (rank source : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (formula : ThreeCNF) (position : ℕ) + (hrank : rank.output input = List.replicate position true) + (hsource : source.output input = encodeThreeCNF formula) : + physicalInterpolationRebuiltGridCell rank source input = + affineCellQuery position 0 + (encodeThreeCNF formula) := by + simp only [physicalInterpolationRebuiltGridCell, hrank, hsource, List.append_assoc, + affineCellQuery, + List.replicate_zero] + +private noncomputable def paperVariableArityPhysicalInterpolationGridCellRowComputer : + SourcePhysicalLagrangeWordComputer where + output := sourceExplicitAffineCellRow + computer := sourceExplicitAffineCellRowComputable + +private def physicalInterpolationRebuiltGridWord + (rank source : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + physicalCellGridWordAt + paperVariableArityPhysicalInterpolationGridCellRowComputer ∘ + physicalInterpolationRebuiltGridCell rank source + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationRebuiltGridWordComputable + (rank source : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationRebuiltGridWord rank source) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityPhysicalInterpolationRebuiltGridCellComputable + rank source) + (paperVariableArityPhysicalCellGridWordAtComputable + paperVariableArityPhysicalInterpolationGridCellRowComputer) + +private noncomputable def paperVariableArityPhysicalInterpolationRebuiltGridWordComputer + (rank source : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationRebuiltGridWord + rank source + computer := paperVariableArityPhysicalInterpolationRebuiltGridWordComputable + rank source + +private theorem paperVariableArityPhysicalInterpolationRebuiltGridWord_valid + (rank source : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (formula : ThreeCNF) + (point : PaperVariableArityPhysicalInterpolationGridIndex formula) + (hrank : rank.output input = List.replicate point.val true) + (hsource : source.output input = encodeThreeCNF formula) : + physicalInterpolationRebuiltGridWord rank source input = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) point)) := by + unfold physicalInterpolationRebuiltGridWord + rw [Function.comp_apply, + paperVariableArityPhysicalInterpolationRebuiltGridCell_valid + rank source input formula point.val hrank hsource] + apply paperVariableArityPhysicalCellGridWordAt_valid + paperVariableArityPhysicalInterpolationGridCellRowComputer + point.val 0 formula point + exact sourceExplicitAffineCellRow_query + point.val 0 (encodeThreeCNF formula) + +private noncomputable def physicalInterpolationNestedOtherGridComputer : + SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalInterpolationRebuiltGridWordComputer + compactPhysicalLagrangeNestedOtherRankWordComputer + compactPhysicalLagrangeNestedOtherSourceWordComputer + +private theorem paperVariableArityPhysicalInterpolationNestedOtherGridComputer_valid + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (other node : PaperVariableArityPhysicalInterpolationGridIndex formula) : + physicalInterpolationNestedOtherGridComputer.output + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula)))) = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) other)) := by + apply paperVariableArityPhysicalInterpolationRebuiltGridWord_valid + compactPhysicalLagrangeNestedOtherRankWordComputer + compactPhysicalLagrangeNestedOtherSourceWordComputer + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula)))) formula other + · exact compactPhysicalLagrangeNestedNodeRank_query + innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) + · exact compactPhysicalLagrangeNestedOtherOriginalSource_query + innerWidth outerWidth other.val node.val row column formula + +private noncomputable def physicalInterpolationNestedAnchorGridComputer : + SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalInterpolationRebuiltGridWordComputer + compactPhysicalLagrangeNestedAnchorRankWordComputer + compactPhysicalLagrangeNestedOtherSourceWordComputer + +private theorem paperVariableArityPhysicalInterpolationNestedAnchorGridComputer_valid + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (other node : PaperVariableArityPhysicalInterpolationGridIndex formula) : + physicalInterpolationNestedAnchorGridComputer.output + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula)))) = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) node)) := by + apply paperVariableArityPhysicalInterpolationRebuiltGridWord_valid + compactPhysicalLagrangeNestedAnchorRankWordComputer + compactPhysicalLagrangeNestedOtherSourceWordComputer + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula)))) formula node + · exact compactPhysicalLagrangeNestedAnchorRank_query + innerWidth outerWidth other.val node.val + (affineCellQuery row column + (encodeThreeCNF formula)) + · exact compactPhysicalLagrangeNestedOtherOriginalSource_query + innerWidth outerWidth other.val node.val row column formula + +private def paperVariableArityPhysicalInterpolationNestedOtherSelfMask : + List Bool → List Bool := + fourFamilyComputedUnaryEqBitOutput + compactPhysicalLagrangeNestedNodeRank + compactPhysicalLagrangeNestedAnchorRank + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedOtherSelfMaskComputable : + BitTM + paperVariableArityPhysicalInterpolationNestedOtherSelfMask := + fourFamilyComputedUnaryEqBitComputable + compactPhysicalLagrangeNestedNodeRankComputable + compactPhysicalLagrangeNestedAnchorRankComputable + +private theorem paperVariableArityPhysicalInterpolationNestedOtherSelfMask_valid + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node : ℕ) (cell : List Bool) : + paperVariableArityPhysicalInterpolationNestedOtherSelfMask + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node cell)) = + [decide (other = node)] := by + exact fourFamilyComputedUnaryEqBitOutput_valid + compactPhysicalLagrangeNestedNodeRank + compactPhysicalLagrangeNestedAnchorRank + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node cell)) + other node + (compactPhysicalLagrangeNestedNodeRank_query innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node cell)) + (compactPhysicalLagrangeNestedAnchorRank_query + innerWidth outerWidth other node cell) + +private noncomputable def paperVariableArityPhysicalInterpolationFieldOneRankComputer : + SourcePhysicalLagrangeWordComputer where + output := fun _ => [true] + computer := sourceFixedWordComputable [true] + +private def physicalInterpolationCellFieldOneWord : + List Bool → List Bool := + physicalCellFieldWordAt + paperVariableArityPhysicalInterpolationFieldOneRankComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationCellFieldOneWordComputable : + BitTM + physicalInterpolationCellFieldOneWord := + physicalCellFieldWordAtComputable + paperVariableArityPhysicalInterpolationFieldOneRankComputer + +private theorem paperVariableArityPhysicalInterpolationCellFieldOneWord_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationCellFieldOneWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (oneWord + (sourceIrreducibleFormulaDegree formula)) := by + let degree := sourceIrreducibleFormulaDegree formula + have positive : 0 < degree := + GapCVP.Core.sourceFieldExponent_pos + (GapCVP.Core.sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)) + let unit : Fin (2 ^ degree) := + ⟨1, Nat.one_lt_pow (Nat.ne_of_gt positive) (by norm_num)⟩ + have indexed : indexedWord degree unit = oneWord degree := by + funext bit + change Nat.testBit 1 bit.val = decide (bit.val = 0) + simpa only [Bool.toNat_true, Bool.and_true] using Nat.testBit_bool_toNat true bit.val + unfold physicalInterpolationCellFieldOneWord + rw [physicalCellFieldWordAt_valid + paperVariableArityPhysicalInterpolationFieldOneRankComputer + row column formula unit (by rfl)] + exact congrArg finiteWordBits indexed + +private def physicalInterpolationNestedOtherFieldOneWord : + List Bool → List Bool := + physicalInterpolationCellFieldOneWord ∘ + compactPhysicalLagrangeNestedOtherActualCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedOtherFieldOneWordComputable : + BitTM + physicalInterpolationNestedOtherFieldOneWord := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedOtherActualCellComputable + paperVariableArityPhysicalInterpolationCellFieldOneWordComputable + +private theorem paperVariableArityPhysicalInterpolationNestedOtherFieldOneWord_valid + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationNestedOtherFieldOneWord + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) = + finiteWordBits + (oneWord + (sourceIrreducibleFormulaDegree formula)) := by + unfold physicalInterpolationNestedOtherFieldOneWord + rw [Function.comp_apply, + compactPhysicalLagrangeNestedOtherActualCell_query] + exact paperVariableArityPhysicalInterpolationCellFieldOneWord_valid + row column formula + +end PhysicalInterpolationNodeGridMaskTM + +namespace PhysicalInterpolationNodeFactorTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.SourceFourFamilyTaggedPredicateDispatchTM GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldBasis GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryPhysicalRowBasisDivisionTM GapCVP.BinaryCompactPhysicalFieldWordXorTM +open GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalRefinementRowProjection +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.SourceFieldMomentOperationsTM GapCVP.PhysicalInterpolationNodeGridMaskTM +open GapCVP.Factor400BinaryConstructiveSourcePlaces + +/-- GapCVP reduction support. -/ +def physicalInterpolationFamilyRowGridPosition + (family : Fin 4) (row : ℕ) (formula : ThreeCNF) : + PaperVariableArityPhysicalInterpolationGridIndex formula := + ⟨((row - physicalFamilyStart family formula) / + physDegree formula) % + physGridCard formula, + by + change + ((row - physicalFamilyStart family formula) / + physDegree formula) % + physGridCard formula < + physGridCard formula + exact Nat.mod_lt _ + (physicalRefinementGridCard_pos formula)⟩ + +private def physicalInterpolationCellRowGridRankWord + (family : Fin 4) : List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + (physicalFamilyRowFieldRankWord family) + physicalMomentCellGridCardinalityUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationCellRowGridRankWordComputable + (family : Fin 4) : + BitTM + (physicalInterpolationCellRowGridRankWord family) := + sourcePhysicalComputedUnaryRemainderComputable + (paperVariableArityPhysicalFamilyRowFieldRankComputable family) + paperVariableArityPhysicalMomentCellGridCardinalityUnaryComputable + +@[simp] theorem + paperVariableArityPhysicalInterpolationCellRowGridRankWord_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationCellRowGridRankWord family + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalInterpolationFamilyRowGridPosition + family row formula).val true := by + unfold physicalInterpolationCellRowGridRankWord + exact sourcePhysicalComputedUnaryRemainder_valid + (physicalFamilyRowFieldRankWord family) + physicalMomentCellGridCardinalityUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + ((row - physicalFamilyStart family formula) / + physDegree formula) + (physGridCard formula) + (physicalRefinementGridCard_pos formula) + (paperVariableArityPhysicalFamilyRowFieldRankWord_valid + family row column formula) + (paperVariableArityPhysicalMomentCellGridCardinalityUnary_valid + row column formula) + +private def physicalInterpolationNestedRowGridRankWord + (family : Fin 4) : List Bool → List Bool := + physicalInterpolationCellRowGridRankWord family ∘ + compactPhysicalLagrangeNestedOtherActualCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedRowGridRankWordComputable + (family : Fin 4) : + BitTM + (physicalInterpolationNestedRowGridRankWord + family) := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedOtherActualCellComputable + (paperVariableArityPhysicalInterpolationCellRowGridRankWordComputable + family) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedRowGridRankComputer + (family : Fin 4) : SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedRowGridRankWord + family + computer := + paperVariableArityPhysicalInterpolationNestedRowGridRankWordComputable + family + +@[simp] theorem + paperVariableArityPhysicalInterpolationNestedRowGridRankWord_valid + (family : Fin 4) + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationNestedRowGridRankWord family + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) = + List.replicate + (physicalInterpolationFamilyRowGridPosition + family row formula).val true := by + unfold physicalInterpolationNestedRowGridRankWord + rw [Function.comp_apply, + compactPhysicalLagrangeNestedOtherActualCell_query] + exact paperVariableArityPhysicalInterpolationCellRowGridRankWord_valid + family row column formula + +private noncomputable def physicalInterpolationNestedRowGridComputer + (family : Fin 4) : SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalInterpolationRebuiltGridWordComputer + (paperVariableArityPhysicalInterpolationNestedRowGridRankComputer family) + compactPhysicalLagrangeNestedOtherSourceWordComputer + +private theorem paperVariableArityPhysicalInterpolationNestedRowGridComputer_valid + (family : Fin 4) + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (other node : PaperVariableArityPhysicalInterpolationGridIndex formula) : + (physicalInterpolationNestedRowGridComputer + family).output + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula)))) = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) + (physicalInterpolationFamilyRowGridPosition + family row formula))) := by + apply paperVariableArityPhysicalInterpolationRebuiltGridWord_valid + (paperVariableArityPhysicalInterpolationNestedRowGridRankComputer + family) + compactPhysicalLagrangeNestedOtherSourceWordComputer + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula)))) formula + (physicalInterpolationFamilyRowGridPosition + family row formula) + · exact + paperVariableArityPhysicalInterpolationNestedRowGridRankWord_valid + family innerWidth outerWidth other.val node.val row column formula + · exact compactPhysicalLagrangeNestedOtherOriginalSource_query + innerWidth outerWidth other.val node.val row column formula + +private def physicalInterpolationNestedOtherDegreeWord : + List Bool → List Bool := + physicalFamilyFieldDegreeUnary ∘ + compactPhysicalLagrangeNestedOtherOriginalSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedOtherDegreeWordComputable : + BitTM + physicalInterpolationNestedOtherDegreeWord := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedOtherOriginalSourceComputable + paperVariableArityPhysicalFamilyFieldDegreeUnaryComputable + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedOtherDegreeComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedOtherDegreeWord + computer := + paperVariableArityPhysicalInterpolationNestedOtherDegreeWordComputable + +@[simp] theorem + paperVariableArityPhysicalInterpolationNestedOtherDegreeWord_valid + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationNestedOtherDegreeWord + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) = + List.replicate + (sourceIrreducibleFormulaDegree formula) true := by + unfold physicalInterpolationNestedOtherDegreeWord + rw [Function.comp_apply, + compactPhysicalLagrangeNestedOtherOriginalSource_query, + paperVariableArityPhysicalFamilyFieldDegreeUnary_valid] + +private def physicalInterpolationNestedDifferenceWord + (left right : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + compactPhysicalFieldWordXorWithDegree + paperVariableArityPhysicalInterpolationNestedOtherDegreeComputer + left right + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedDifferenceWordComputable + (left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationNestedDifferenceWord + left right) := + compactPhysicalFieldWordXorWithDegreeComputable + paperVariableArityPhysicalInterpolationNestedOtherDegreeComputer + left right + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedDifferenceComputer + (left right : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedDifferenceWord + left right + computer := + paperVariableArityPhysicalInterpolationNestedDifferenceWordComputable + left right + +private theorem paperVariableArityPhysicalInterpolationNestedDifferenceWord_valid + (left right : SourcePhysicalLagrangeWordComputer) + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node row column : ℕ) (formula : ThreeCNF) + (leftWord rightWord : GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula)) + (hleft : left.output + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) = finiteWordBits leftWord) + (hright : right.output + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) = finiteWordBits rightWord) : + physicalInterpolationNestedDifferenceWord left right + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) = + finiteWordBits + (compactPhysicalFieldWordXorValue leftWord rightWord) := by + exact compactPhysicalFieldWordXorWithDegree_valid + paperVariableArityPhysicalInterpolationNestedOtherDegreeComputer + left right + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) + (sourceIrreducibleFormulaDegree formula) + leftWord rightWord + (paperVariableArityPhysicalInterpolationNestedOtherDegreeWord_valid + innerWidth outerWidth other node row column formula) + hleft hright + +private def physicalInterpolationNestedEraseSelection : + List Bool → List Bool := + flatPhysicalPrependComputedRecordOutput + paperVariableArityPhysicalInterpolationNestedOtherSelfMask + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedEraseSelectionComputable : + BitTM + physicalInterpolationNestedEraseSelection := + flatPhysicalPrependComputedRecordComputable + paperVariableArityPhysicalInterpolationNestedOtherSelfMaskComputable + +@[simp] theorem + paperVariableArityPhysicalInterpolationNestedEraseSelection_valid + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node : ℕ) (cell : List Bool) : + physicalInterpolationNestedEraseSelection + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node cell)) = + lengthPrefixedWord [decide (other = node)] ++ + compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope + outerWidth node cell) := by + simp only [physicalInterpolationNestedEraseSelection, flatPhysicalPrependComputedRecordOutput_eq, + paperVariableArityPhysicalInterpolationNestedOtherSelfMask_valid] + +private def paperVariableArityPhysicalInterpolationNestedEraseOneBranch : + List Bool → List Bool := + fourFamilyTaggedGuardedWorkerWord [true] + physicalInterpolationNestedOtherFieldOneWord ∘ + physicalInterpolationNestedEraseSelection + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedEraseOneBranchComputable : + BitTM + paperVariableArityPhysicalInterpolationNestedEraseOneBranch := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalInterpolationNestedEraseSelectionComputable + (fourFamilyTaggedGuardedWorkerComputable [true] + paperVariableArityPhysicalInterpolationNestedOtherFieldOneWordComputable) + +private def paperVariableArityPhysicalInterpolationNestedEraseOtherBranch + (factor : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + fourFamilyTaggedGuardedWorkerWord [false] factor.output ∘ + physicalInterpolationNestedEraseSelection + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedEraseOtherBranchComputable + (factor : SourcePhysicalLagrangeWordComputer) : + BitTM + (paperVariableArityPhysicalInterpolationNestedEraseOtherBranch + factor) := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalInterpolationNestedEraseSelectionComputable + (fourFamilyTaggedGuardedWorkerComputable [false] + factor.computer) + +private def physicalInterpolationNestedEraseFactorWord + (factor : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + paperVariableArityPhysicalInterpolationNestedEraseOneBranch input ++ + paperVariableArityPhysicalInterpolationNestedEraseOtherBranch + factor input + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedEraseFactorWordComputable + (factor : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationNestedEraseFactorWord + factor) := + pointwiseAppendComputable + paperVariableArityPhysicalInterpolationNestedEraseOneBranchComputable + (paperVariableArityPhysicalInterpolationNestedEraseOtherBranchComputable + factor) + +private theorem paperVariableArityPhysicalInterpolationNestedEraseFactorWord_valid + (factor : SourcePhysicalLagrangeWordComputer) + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (other node row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationNestedEraseFactorWord factor + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) = + if other = node then + finiteWordBits + (oneWord + (sourceIrreducibleFormulaDegree formula)) + else + factor.output + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node + (affineCellQuery row column + (encodeThreeCNF formula)))) := by + unfold physicalInterpolationNestedEraseFactorWord + paperVariableArityPhysicalInterpolationNestedEraseOneBranch + paperVariableArityPhysicalInterpolationNestedEraseOtherBranch + rw [Function.comp_apply, Function.comp_apply] + rw [paperVariableArityPhysicalInterpolationNestedEraseSelection_valid] + by_cases hequal : other = node + · simp only [hequal, decide_true, sourceFourFamilyTaggedGuardedWorkerWord_valid, ↓reduceIte, + paperVariableArityPhysicalInterpolationNestedOtherFieldOneWord_valid, List.cons.injEq, + Bool.false_eq_true, and_true, + List.append_nil] + · simp only [hequal, decide_false, sourceFourFamilyTaggedGuardedWorkerWord_valid, + List.cons.injEq, + Bool.true_eq_false, and_true, ↓reduceIte, List.nil_append] + +private abbrev physicalInterpolationNodeGridWord + (formula : ThreeCNF) + (point : PaperVariableArityPhysicalInterpolationGridIndex formula) : + GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula) := + indexedWord + (sourceIrreducibleFormulaDegree formula) + (evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) point) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNumeratorNodeDifferenceComputer + (family : Fin 4) : SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalInterpolationNestedDifferenceComputer + (physicalInterpolationNestedRowGridComputer family) + physicalInterpolationNestedOtherGridComputer + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationDenominatorNodeDifferenceComputer : + SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalInterpolationNestedDifferenceComputer + physicalInterpolationNestedAnchorGridComputer + physicalInterpolationNestedOtherGridComputer + +private def physicalInterpolationNumeratorNodeFactorWord + (family : Fin 4) : List Bool → List Bool := + physicalInterpolationNestedEraseFactorWord + (paperVariableArityPhysicalInterpolationNumeratorNodeDifferenceComputer + family) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNumeratorNodeFactorWordComputable + (family : Fin 4) : + BitTM + (physicalInterpolationNumeratorNodeFactorWord + family) := + paperVariableArityPhysicalInterpolationNestedEraseFactorWordComputable + (paperVariableArityPhysicalInterpolationNumeratorNodeDifferenceComputer + family) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNumeratorNodeFactorComputer + (family : Fin 4) : SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNumeratorNodeFactorWord + family + computer := + paperVariableArityPhysicalInterpolationNumeratorNodeFactorWordComputable + family + +private def physicalInterpolationDenominatorNodeFactorWord : + List Bool → List Bool := + physicalInterpolationNestedEraseFactorWord + paperVariableArityPhysicalInterpolationDenominatorNodeDifferenceComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationDenominatorNodeFactorWordComputable : + BitTM + physicalInterpolationDenominatorNodeFactorWord := + paperVariableArityPhysicalInterpolationNestedEraseFactorWordComputable + paperVariableArityPhysicalInterpolationDenominatorNodeDifferenceComputer + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationDenominatorNodeFactorComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationDenominatorNodeFactorWord + computer := + paperVariableArityPhysicalInterpolationDenominatorNodeFactorWordComputable + +private theorem paperVariableArityPhysicalInterpolationNumeratorNodeFactorWord_valid + (family : Fin 4) + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (other node : PaperVariableArityPhysicalInterpolationGridIndex formula) : + physicalInterpolationNumeratorNodeFactorWord family + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula)))) = + finiteWordBits + (if other = node then + oneWord (sourceIrreducibleFormulaDegree formula) + else + compactPhysicalFieldWordXorValue + (physicalInterpolationNodeGridWord formula + (physicalInterpolationFamilyRowGridPosition + family row formula)) + (physicalInterpolationNodeGridWord + formula other)) := by + unfold physicalInterpolationNumeratorNodeFactorWord + rw [paperVariableArityPhysicalInterpolationNestedEraseFactorWord_valid] + by_cases hequal : other = node + · simp only [hequal, ↓reduceIte] + · have hval : other.val ≠ node.val := by + intro hvalues + exact hequal (Fin.ext hvalues) + rw [ite_eq_right hval] + have hfactor := + paperVariableArityPhysicalInterpolationNestedDifferenceWord_valid + (physicalInterpolationNestedRowGridComputer + family) + physicalInterpolationNestedOtherGridComputer + innerWidth outerWidth other.val node.val row column formula + (physicalInterpolationNodeGridWord formula + (physicalInterpolationFamilyRowGridPosition + family row formula)) + (physicalInterpolationNodeGridWord formula other) + (paperVariableArityPhysicalInterpolationNestedRowGridComputer_valid + family innerWidth outerWidth row column formula other node) + (paperVariableArityPhysicalInterpolationNestedOtherGridComputer_valid + innerWidth outerWidth row column formula other node) + simp only [paperVariableArityPhysicalInterpolationNumeratorNodeDifferenceComputer, + paperVariableArityPhysicalInterpolationNestedDifferenceComputer] + simpa only [hequal, ↓reduceIte] using hfactor + +theorem + paperVariableArityPhysicalInterpolationDenominatorNodeFactorWord_valid + (innerWidth outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (other node : PaperVariableArityPhysicalInterpolationGridIndex formula) : + physicalInterpolationDenominatorNodeFactorWord + (compactPhysicalLagrangeNestedNodeEnvelope innerWidth other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula)))) = + finiteWordBits + (if other = node then + oneWord (sourceIrreducibleFormulaDegree formula) + else + compactPhysicalFieldWordXorValue + (physicalInterpolationNodeGridWord + formula node) + (physicalInterpolationNodeGridWord + formula other)) := by + unfold physicalInterpolationDenominatorNodeFactorWord + rw [paperVariableArityPhysicalInterpolationNestedEraseFactorWord_valid] + by_cases hequal : other = node + · simp only [hequal, ↓reduceIte] + · have hval : other.val ≠ node.val := by + intro hvalues + exact hequal (Fin.ext hvalues) + rw [ite_eq_right hval] + have hfactor := + paperVariableArityPhysicalInterpolationNestedDifferenceWord_valid + physicalInterpolationNestedAnchorGridComputer + physicalInterpolationNestedOtherGridComputer + innerWidth outerWidth other.val node.val row column formula + (physicalInterpolationNodeGridWord formula node) + (physicalInterpolationNodeGridWord formula other) + (paperVariableArityPhysicalInterpolationNestedAnchorGridComputer_valid + innerWidth outerWidth row column formula other node) + (paperVariableArityPhysicalInterpolationNestedOtherGridComputer_valid + innerWidth outerWidth row column formula other node) + simp only [paperVariableArityPhysicalInterpolationDenominatorNodeDifferenceComputer, + paperVariableArityPhysicalInterpolationNestedDifferenceComputer] + simpa only [hequal, ↓reduceIte] using hfactor + +end PhysicalInterpolationNodeFactorTM + +namespace BinaryCompactPhysicalLagrangeNodeProductAlgebra + +open scoped BigOperators + +open GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryFieldInverseAlgebra + +private theorem compactPhysicalLagrangeSelectedWordFold_sourceWordValue + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (initial : EffectiveBinaryField.Word + (sourceFieldExponent + (sourceSizeParameter encodingLength formula))) + (factors : List (EffectiveBinaryField.Word + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)))) : + sourceWordValue encodingLength formula + (factors.foldl + (EffectiveBinaryField.multiplyMod + (EffectiveBinaryField.irreducibleWord + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)))) initial) = + sourceWordValue encodingLength formula initial * + (factors.map (sourceWordValue encodingLength formula)).prod := by + induction factors generalizing initial with + | nil => simp only [List.foldl_nil, List.map_nil, List.prod_nil, mul_one] + | cons factor remaining ih => + simp only [List.foldl_cons, List.map_cons, List.prod_cons] + rw [ih, sourceWordValue_multiplyMod] + simp only [mul_assoc] + +private theorem compactPhysicalLagrangeSelectedWordProduct_sourceWordValue + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (factors : List (EffectiveBinaryField.Word + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)))) : + sourceWordValue encodingLength formula + (factors.foldl + (EffectiveBinaryField.multiplyMod + (EffectiveBinaryField.irreducibleWord + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)))) + (oneWord + (sourceFieldExponent + (sourceSizeParameter encodingLength formula)))) = + (factors.map (sourceWordValue encodingLength formula)).prod := by + rw [compactPhysicalLagrangeSelectedWordFold_sourceWordValue, + sourceWordValue_oneWord, one_mul] + +private theorem compactPhysicalLagrangeRangeMap_prod + {K : Type*} [CommMonoid K] + (value : ℕ → K) (count : ℕ) : + ((List.range count).map value).prod = + ∏ index : Fin count, value index.val := by + rw [Fin.prod_univ_eq_prod_range] + induction count with + | zero => simp only [List.range_zero, List.map_nil, List.prod_nil, Finset.range_zero, + Finset.prod_empty] + | succ count ih => + rw [List.range_succ, List.map_append, List.prod_append, + Finset.prod_range_succ] + simpa only [List.map_cons, List.map_nil, List.prod_cons, List.prod_nil, mul_one] using + congrArg (fun product => product * value count) ih + +end BinaryCompactPhysicalLagrangeNodeProductAlgebra + +namespace PhysicalFieldWordSemantics + +open GapCVP.Core GapCVP.Core.EffectiveBinaryField +open GapCVP.BinaryCompactPhysicalFieldBasisCoordinates GapCVP.BinaryFieldInverseAlgebra +open GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics + +private theorem paperVariableArityPhysicalBinaryCoordinate_zero_or_one + (value : ZMod 2) : value = 0 ∨ value = 1 := by + exact GapCVP.Core.effectiveBinary_eq_zero_or_one value + +private theorem paperVariableArityPhysicalBitValue_decide + (value : ZMod 2) : + bitValue (decide (value = 1)) = value := by + rcases paperVariableArityPhysicalBinaryCoordinate_zero_or_one value with + zero | one + · simp only [bitValue, zero, zero_ne_one, decide_false, Bool.false_eq_true, ↓reduceIte] + · simp only [bitValue, one, decide_true, ↓reduceIte] + +private theorem paperVariableArityPhysicalSourceWordValue_injective + (encodingLength : ℕ) (formula : ThreeCNF) : + Function.Injective + (sourceWordValue encodingLength + (srcFormula formula)) := by + intro left right equal + apply funext + intro index + have coordinate := congrArg + (fun value : PaperVariableArityPhysicalWordField + encodingLength formula => + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + encodingLength + (srcFormula formula)).equivFun + value index) equal + rw [sourceFormulaFieldBasis_sourceWordValue_coordinate, + sourceFormulaFieldBasis_sourceWordValue_coordinate] at coordinate + cases leftBit : left index <;> + cases rightBit : right index <;> + simp_all [bitValue] + +end PhysicalFieldWordSemantics + +namespace PhysicalLagrangeNodeProductAlgebra + +open scoped BigOperators + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.BinaryCompactPhysicalFieldWordXorTM +open GapCVP.BinaryCompactPhysicalLagrangeNodeProductAlgebra GapCVP.BinaryFieldBasis +open GapCVP.BinaryFieldInverseAlgebra GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalOrdinaryShiftedCoefficientTM GapCVP.BinarySourceCoordinateOrder +open GapCVP.Factor400BinaryConstructiveSourcePlaces + +/-- GapCVP reduction support. -/ +abbrev PaperVariableArityPhysicalLagrangeNodeGridIndex + (formula : ThreeCNF) := + Fin (2 ^ physDegree formula - + (srcFormula formula).variableCount) + +/-- GapCVP reduction support. -/ +def physicalLagrangeNodeEvaluationWord + (formula : ThreeCNF) + (point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) : + PaperVariableArityPhysicalInterpolationWord formula := + indexedWord (physDegree formula) + (evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) point) + +theorem physicalLagrangeNodeEvaluationWord_sourceField + (formula : ThreeCNF) + (point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeEvaluationWord + formula point) = + sourceFormulaEvaluationWord (encodeThreeCNF formula).length + (srcFormula formula) point := by + rfl + +private def physicalLagrangeNodeSelectedWordProduct + (formula : ThreeCNF) + (factors : List (PaperVariableArityPhysicalInterpolationWord formula)) : + PaperVariableArityPhysicalInterpolationWord formula := + factors.foldl + (multiplyMod + (irreducibleWord + (physDegree formula))) + (oneWord (physDegree formula)) + +private theorem paperVariableArityPhysicalLagrangeNodeSelectedWordProduct_sourceField + (formula : ThreeCNF) + (factors : List (PaperVariableArityPhysicalInterpolationWord formula)) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeSelectedWordProduct + formula factors) = + (factors.map + (sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula))).prod := by + exact compactPhysicalLagrangeSelectedWordProduct_sourceWordValue + (encodeThreeCNF formula).length + (srcFormula formula) factors + +private def physicalLagrangeNumeratorNodeFactorValue + (formula : ThreeCNF) + (node point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (other : ℕ) : PaperVariableArityPhysicalInterpolationWord formula := + if other = node.val then + oneWord (physDegree formula) + else if bounded : other < + 2 ^ physDegree formula - + (srcFormula formula).variableCount then + compactPhysicalFieldWordXorValue + (physicalLagrangeNodeEvaluationWord + formula point) + (physicalLagrangeNodeEvaluationWord + formula ⟨other, bounded⟩) + else oneWord (physDegree formula) + +private def physicalLagrangeNumeratorNodeFactorValues + (formula : ThreeCNF) + (node point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (count : ℕ) : + List (PaperVariableArityPhysicalInterpolationWord formula) := + (List.range count).map + (physicalLagrangeNumeratorNodeFactorValue + formula node point) + +private def physicalLagrangeDenominatorNodeFactorValue + (formula : ThreeCNF) + (node : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (other : ℕ) : PaperVariableArityPhysicalInterpolationWord formula := + physicalLagrangeNumeratorNodeFactorValue + formula node node other + +private def physicalLagrangeDenominatorNodeFactorValues + (formula : ThreeCNF) + (node : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (count : ℕ) : + List (PaperVariableArityPhysicalInterpolationWord formula) := + (List.range count).map + (physicalLagrangeDenominatorNodeFactorValue + formula node) + +private theorem paperVariableArityPhysicalLagrangeNumeratorNodeFactorValues_sourceField + (formula : ThreeCNF) (count : ℕ) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) + (point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeNumeratorNodeFactorValues + formula (Fin.castLE bounded node) point count)) = + ∏ other ∈ (Finset.univ.erase node), + (sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) point - + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded other)) := by + classical + rw [paperVariableArityPhysicalLagrangeNodeSelectedWordProduct_sourceField] + unfold physicalLagrangeNumeratorNodeFactorValues + rw [List.map_map, compactPhysicalLagrangeRangeMap_prod] + let gridValue := fun other : Fin count => + sourceFormulaEvaluationWord (encodeThreeCNF formula).length + (srcFormula formula) point - + sourceFormulaEvaluationWord (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded other) + have factorValue (other : Fin count) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNumeratorNodeFactorValue + formula (Fin.castLE bounded node) point other.val) = + if other = node then 1 else gridValue other := by + by_cases equal : other = node + · subst other + simp only [physicalLagrangeNumeratorNodeFactorValue, Fin.val_castLE, ↓reduceIte, + sourceWordValue_oneWord] + · have rankBound : other.val < + 2 ^ physDegree formula - + (srcFormula formula).variableCount := + lt_of_lt_of_le other.isLt bounded + have different : other.val ≠ node.val := by + intro same + exact equal (Fin.ext same) + have samePoint : + (⟨other.val, rankBound⟩ : + PaperVariableArityPhysicalLagrangeNodeGridIndex formula) = + Fin.castLE bounded other := by + apply Fin.ext + rfl + simp only [physicalLagrangeNumeratorNodeFactorValue, + Fin.val_castLE, different, ↓reduceIte, dite_eq_left rankBound, + ite_eq_right equal, gridValue] + rw [compactPhysicalFieldWordXorValue_sourceWordValue_sub, + physicalLagrangeNodeEvaluationWord_sourceField, + physicalLagrangeNodeEvaluationWord_sourceField, + samePoint] + calc + ∏ other : Fin count, + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNumeratorNodeFactorValue + formula (Fin.castLE bounded node) point other.val) = + ∏ other : Fin count, + if other = node then 1 else gridValue other := by + exact Finset.prod_congr rfl + (fun other _ => factorValue other) + _ = ∏ other ∈ (Finset.univ.erase node), gridValue other := by + calc + (∏ other : Fin count, + if other = node then 1 else gridValue other) = + (∏ other ∈ (Finset.univ.erase node), + if other = node then 1 else gridValue other) := + (Finset.prod_erase (Finset.univ : Finset (Fin count)) + (f := fun other => if other = node then 1 else gridValue other) + (by simp only [↓reduceIte])).symm + _ = ∏ other ∈ (Finset.univ.erase node), gridValue other := by + apply Finset.prod_congr rfl + intro other present + simp only [Finset.mem_erase.mp present |>.1, ↓reduceIte] + +private theorem paperVariableArityPhysicalLagrangeDenominatorNodeFactorValues_sourceField + (formula : ThreeCNF) (count : ℕ) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count)) = + ∏ other ∈ (Finset.univ.erase node), + (sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded node) - + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded other)) := by + exact paperVariableArityPhysicalLagrangeNumeratorNodeFactorValues_sourceField + formula count bounded node (Fin.castLE bounded node) + +end PhysicalLagrangeNodeProductAlgebra + +namespace PhysicalLagrangeNodeProductCatalogueCorrectness + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryPhysicalLagrangeProductFoldTM +open GapCVP.BinaryCompactPhysicalFieldWordXorTM +open GapCVP.BinaryCompactPhysicalLagrangeFactorStreamTM +open GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM +open GapCVP.BinaryCompactPhysicalLagrangeNodeProductTM GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalLagrangeNodeProductAlgebra +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +private theorem physicalLagrangeNumeratorNodeFactorValue_fin + (formula : ThreeCNF) + (node point other : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) : + (if other = node then oneWord (physDegree formula) + else compactPhysicalFieldWordXorValue + (physicalLagrangeNodeEvaluationWord formula point) + (physicalLagrangeNodeEvaluationWord formula other)) = + physicalLagrangeNumeratorNodeFactorValue formula node point other.val := by + by_cases equal : other = node + · simp only [equal, ↓reduceIte, physicalLagrangeNumeratorNodeFactorValue] + · have different : other.val ≠ node.val := fun same => equal (Fin.ext same) + rw [ite_eq_right equal] + unfold physicalLagrangeNumeratorNodeFactorValue + rw [ite_eq_right different, dite_eq_left other.isLt] + +private theorem compactPhysicalLagrangeNodeFactorCatalogue_map + {degree : ℕ} + (width : SourceQaryMaskDynamicGridWidth) + (computer : SourcePhysicalLagrangeWordComputer) + (input : List Bool) (count : ℕ) + (factors : ℕ → GapCVP.Core.EffectiveBinaryField.Word degree) + (hwidth : width.output input = List.replicate count true) + (hfactor : ∀ rank, rank < count → computer.output + (compactPhysicalLagrangeNodeFactorQuery width input rank) = + finiteWordBits (factors rank)) : + compactPhysicalLagrangeNodeFactorCatalogue width computer input = + sourcePhysicalLagrangePackedFactorWords + ((List.range count).map factors) := by + rw [compactPhysicalLagrangeNodeFactorCatalogue_valid + width computer input count hwidth] + unfold sourcePhysicalLagrangePackedFactorWords + rw [List.flatMap_map] + apply List.flatMap_congr + intro rank present + exact congrArg lengthPrefixedWord + (hfactor rank (List.mem_range.mp present)) + +private theorem paperVariableArityPhysicalInterpolationNumeratorNodeCatalogue_valid + (family : Fin 4) + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (node : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) : + compactPhysicalLagrangeNodeFactorCatalogue + (compactPhysicalLagrangeNestedNodePrefixWidth width) + (paperVariableArityPhysicalInterpolationNumeratorNodeFactorComputer + family) + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + sourcePhysicalLagrangePackedFactorWords + (physicalLagrangeNumeratorNodeFactorValues + formula node + (physicalInterpolationFamilyRowGridPosition + family row formula) count) := by + let cell := affineCellQuery row column (encodeThreeCNF formula) + let outer := compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val cell + let inner := compactPhysicalLagrangeNestedNodePrefixWidth width + apply compactPhysicalLagrangeNodeFactorCatalogue_map inner + (paperVariableArityPhysicalInterpolationNumeratorNodeFactorComputer family) + outer count (physicalLagrangeNumeratorNodeFactorValue formula node + (physicalInterpolationFamilyRowGridPosition family row formula)) + · exact compactPhysicalLagrangeNestedNodePrefixWidth_valid + width outerWidth node.val cell ▸ correctWidth + · intro rank present + let other : PaperVariableArityPhysicalLagrangeNodeGridIndex formula := + ⟨rank, lt_of_lt_of_le present bounded⟩ + change physicalInterpolationNumeratorNodeFactorWord family + (compactPhysicalLagrangeNestedNodeEnvelope inner other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val cell)) = _ + rw [paperVariableArityPhysicalInterpolationNumeratorNodeFactorWord_valid + family inner outerWidth row column formula other node] + exact congrArg finiteWordBits + (physicalLagrangeNumeratorNodeFactorValue_fin formula node + (physicalInterpolationFamilyRowGridPosition family row formula) other) + +private theorem paperVariableArityPhysicalInterpolationDenominatorNodeCatalogue_valid + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (node : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) : + compactPhysicalLagrangeNodeFactorCatalogue + (compactPhysicalLagrangeNestedNodePrefixWidth width) + paperVariableArityPhysicalInterpolationDenominatorNodeFactorComputer + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + sourcePhysicalLagrangePackedFactorWords + (physicalLagrangeDenominatorNodeFactorValues + formula node count) := by + let cell := affineCellQuery row column (encodeThreeCNF formula) + let outer := compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val cell + let inner := compactPhysicalLagrangeNestedNodePrefixWidth width + apply compactPhysicalLagrangeNodeFactorCatalogue_map inner + paperVariableArityPhysicalInterpolationDenominatorNodeFactorComputer + outer count (physicalLagrangeDenominatorNodeFactorValue formula node) + · exact compactPhysicalLagrangeNestedNodePrefixWidth_valid + width outerWidth node.val cell ▸ correctWidth + · intro rank present + let other : PaperVariableArityPhysicalLagrangeNodeGridIndex formula := + ⟨rank, lt_of_lt_of_le present bounded⟩ + change physicalInterpolationDenominatorNodeFactorWord + (compactPhysicalLagrangeNestedNodeEnvelope inner other.val + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val cell)) = _ + rw [paperVariableArityPhysicalInterpolationDenominatorNodeFactorWord_valid + inner outerWidth row column formula other node] + exact congrArg finiteWordBits + (physicalLagrangeNumeratorNodeFactorValue_fin formula node node other) + +end PhysicalLagrangeNodeProductCatalogueCorrectness + +namespace PhysicalInterpolationNestedNodeProductTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryPhysicalLagrangeProductFoldTM +open GapCVP.BinaryCompactPhysicalLagrangeFactorStreamTM +open GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM +open GapCVP.BinaryCompactPhysicalLagrangeNodeProductTM GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine +open GapCVP.PhysicalInterpolationNodeGridMaskTM GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalLagrangeNodeProductAlgebra +open GapCVP.PhysicalLagrangeNodeProductCatalogueCorrectness +open GapCVP.BinarySourceFieldMultiplicationTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +private def physicalInterpolationNestedNodeSelectedModulusWord : + List Bool → List Bool := + sourceSelectedIrreducibleWord ∘ + compactPhysicalLagrangeNestedNodeOriginalSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputable : + BitTM + physicalInterpolationNestedNodeSelectedModulusWord := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedNodeOriginalSourceComputable + paperVariableAritySourceSelectedIrreducibleWordComputable + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedNodeSelectedModulusWord + computer := + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputable + +theorem + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer_output + (input : List Bool) : + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer.output + input = + physicalInterpolationNestedNodeSelectedModulusWord + input := by + rfl + +@[simp] theorem + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusWord_valid + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationNestedNodeSelectedModulusWord + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (irreducibleWord + (sourceIrreducibleFormulaDegree formula)) := by + unfold physicalInterpolationNestedNodeSelectedModulusWord + rw [Function.comp_apply, + compactPhysicalLagrangeNestedNodeOriginalSource_query] + exact paperVariableAritySourceSelectedIrreducibleWord_valid formula + +private def physicalInterpolationNestedNodeFieldOneWord : + List Bool → List Bool := + physicalInterpolationCellFieldOneWord ∘ + compactPhysicalLagrangeNestedNodeOuterCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputable : + BitTM + physicalInterpolationNestedNodeFieldOneWord := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedNodeOuterCellComputable + paperVariableArityPhysicalInterpolationCellFieldOneWordComputable + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedNodeFieldOneWord + computer := + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputable + +@[simp] theorem + paperVariableArityPhysicalInterpolationNestedNodeFieldOneWord_valid + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationNestedNodeFieldOneWord + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (oneWord (sourceIrreducibleFormulaDegree formula)) := by + unfold physicalInterpolationNestedNodeFieldOneWord + rw [Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query] + exact paperVariableArityPhysicalInterpolationCellFieldOneWord_valid + row column formula + +private def paperVariableArityPhysicalInterpolationNestedNodeInverseQuery + (operand : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + lengthPrefixedWord (operand.output input) ++ + compactPhysicalLagrangeNestedNodeOriginalSource input + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeInverseQueryComputable + (operand : SourcePhysicalLagrangeWordComputer) : + BitTM + (paperVariableArityPhysicalInterpolationNestedNodeInverseQuery + operand) := by + exact pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable operand) + compactPhysicalLagrangeNestedNodeOriginalSourceComputable + +private def physicalInterpolationNestedNodeInverseWord + (operand : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + sourceSelectedFieldInverseWord ∘ + paperVariableArityPhysicalInterpolationNestedNodeInverseQuery operand + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeInverseWordComputable + (operand : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationNestedNodeInverseWord + operand) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityPhysicalInterpolationNestedNodeInverseQueryComputable + operand) + paperVariableAritySourceSelectedFieldInverseComputable + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeInverseComputer + (operand : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedNodeInverseWord + operand + computer := + paperVariableArityPhysicalInterpolationNestedNodeInverseWordComputable + operand + +private theorem paperVariableArityPhysicalInterpolationNestedNodeInverseWord_valid + (operand : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) + (value : GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula)) + (correctOperand : operand.output + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = finiteWordBits value) : + physicalInterpolationNestedNodeInverseWord operand + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits (sourceInverseWord value) := by + unfold physicalInterpolationNestedNodeInverseWord + paperVariableArityPhysicalInterpolationNestedNodeInverseQuery + rw [Function.comp_apply, correctOperand, + compactPhysicalLagrangeNestedNodeOriginalSource_query] + exact paperVariableAritySourceSelectedFieldInverseWord_valid + formula value + +private def paperVariableArityPhysicalInterpolationNestedNodeMultiplyQuery + (lower left right : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : List Bool := + factor400BinarySourceFieldQuery + (lower.output input) (left.output input) (right.output input) + (compactPhysicalLagrangeNestedNodeOriginalSource input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeMultiplyQueryComputable + (lower left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (paperVariableArityPhysicalInterpolationNestedNodeMultiplyQuery + lower left right) := by + have hright := pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable right) + compactPhysicalLagrangeNestedNodeOriginalSourceComputable + have hmiddle := pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable left) hright + have hcomplete := pointwiseAppendComputable + (sourcePhysicalLagrangePrefixedComputable lower) hmiddle + change BitTM + (fun input => factor400BinarySourceFieldQuery + (lower.output input) (left.output input) (right.output input) + (compactPhysicalLagrangeNestedNodeOriginalSource input)) + simpa only [factor400BinarySourceFieldQuery, List.append_assoc, + sourcePhysicalLagrangePrefixedOutput] using + hcomplete + +private def physicalInterpolationNestedNodeMultiplyWord + (left right : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + binarySourceMultiplyModWord ∘ + paperVariableArityPhysicalInterpolationNestedNodeMultiplyQuery + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer + left right + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeMultiplyWordComputable + (left right : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationNestedNodeMultiplyWord + left right) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityPhysicalInterpolationNestedNodeMultiplyQueryComputable + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer + left right) + binarySourceMultiplyModComputable + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeMultiplyComputer + (left right : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedNodeMultiplyWord + left right + computer := + paperVariableArityPhysicalInterpolationNestedNodeMultiplyWordComputable + left right + +private theorem paperVariableArityPhysicalInterpolationNestedNodeMultiplyWord_valid + (left right : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) + (leftWord rightWord : GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula)) + (correctLeft : left.output + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = finiteWordBits leftWord) + (correctRight : right.output + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = finiteWordBits rightWord) : + physicalInterpolationNestedNodeMultiplyWord + left right + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (multiplyMod + (irreducibleWord + (sourceIrreducibleFormulaDegree formula)) + leftWord rightWord) := by + unfold physicalInterpolationNestedNodeMultiplyWord + paperVariableArityPhysicalInterpolationNestedNodeMultiplyQuery + rw [Function.comp_apply, correctLeft, correctRight, + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer_output, + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusWord_valid, + compactPhysicalLagrangeNestedNodeOriginalSource_query] + exact binarySourceMultiplyModWord_valid + (irreducibleWord + (sourceIrreducibleFormulaDegree formula)) + leftWord rightWord (encodeThreeCNF formula) + +private def physicalInterpolationNestedNumeratorNodeProductWord + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) : + List Bool → List Bool := + compactPhysicalLagrangeFactorProductWord + (compactPhysicalLagrangeNestedNodePrefixWidth width) + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputer + compactPhysicalLagrangeNestedNodeSourceWordComputer + (paperVariableArityPhysicalInterpolationNumeratorNodeFactorComputer family) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputable + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) : + BitTM + (physicalInterpolationNestedNumeratorNodeProductWord + family width) := + compactPhysicalLagrangeFactorProductComputable + (compactPhysicalLagrangeNestedNodePrefixWidth width) + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputer + compactPhysicalLagrangeNestedNodeSourceWordComputer + (paperVariableArityPhysicalInterpolationNumeratorNodeFactorComputer family) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) : + SourcePhysicalLagrangeWordComputer where + output := + physicalInterpolationNestedNumeratorNodeProductWord + family width + computer := + paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputable + family width + +private def physicalInterpolationNestedDenominatorNodeProductWord + (width : SourceQaryMaskDynamicGridWidth) : + List Bool → List Bool := + compactPhysicalLagrangeFactorProductWord + (compactPhysicalLagrangeNestedNodePrefixWidth width) + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputer + compactPhysicalLagrangeNestedNodeSourceWordComputer + paperVariableArityPhysicalInterpolationDenominatorNodeFactorComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductComputable + (width : SourceQaryMaskDynamicGridWidth) : + BitTM + (physicalInterpolationNestedDenominatorNodeProductWord + width) := + compactPhysicalLagrangeFactorProductComputable + (compactPhysicalLagrangeNestedNodePrefixWidth width) + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputer + compactPhysicalLagrangeNestedNodeSourceWordComputer + paperVariableArityPhysicalInterpolationDenominatorNodeFactorComputer + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductComputer + (width : SourceQaryMaskDynamicGridWidth) : + SourcePhysicalLagrangeWordComputer where + output := + physicalInterpolationNestedDenominatorNodeProductWord + width + computer := + paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductComputable + width + +private theorem physicalInterpolationNestedNodeProductWord_valid + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (node : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (count : ℕ) + (factors : List (GapCVP.Core.EffectiveBinaryField.Word (physDegree formula))) + (computer : SourcePhysicalLagrangeWordComputer) + (correctWidth : width.output + (affineCellQuery row column (encodeThreeCNF formula)) = + List.replicate count true) + (factorLength : factors.length = count) + (correctFactors : compactPhysicalLagrangeNodeFactorCatalogue + (compactPhysicalLagrangeNestedNodePrefixWidth width) computer + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column (encodeThreeCNF formula))) = + sourcePhysicalLagrangePackedFactorWords factors) : + compactPhysicalLagrangeFactorProductWord + (compactPhysicalLagrangeNestedNodePrefixWidth width) + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputer + compactPhysicalLagrangeNestedNodeSourceWordComputer computer + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column (encodeThreeCNF formula))) = + finiteWordBits (physicalLagrangeNodeSelectedWordProduct formula factors) := by + let cell := affineCellQuery row column (encodeThreeCNF formula) + let outer := compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val cell + let inner := compactPhysicalLagrangeNestedNodePrefixWidth width + apply compactPhysicalLagrangeFactorProductWord_valid inner + paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusComputer + paperVariableArityPhysicalInterpolationNestedNodeFieldOneComputer + compactPhysicalLagrangeNestedNodeSourceWordComputer computer outer + (irreducibleWord (physDegree formula)) (oneWord (physDegree formula)) + factors (encodeThreeCNF formula) + · simpa only [factorLength] using + compactPhysicalLagrangeNestedNodePrefixWidth_valid + width outerWidth node.val cell ▸ correctWidth + · exact paperVariableArityPhysicalInterpolationNestedNodeSelectedModulusWord_valid + outerWidth node.val row column formula + · exact paperVariableArityPhysicalInterpolationNestedNodeFieldOneWord_valid + outerWidth node.val row column formula + · exact compactPhysicalLagrangeNestedNodeOriginalSource_query + outerWidth node.val row column formula + · exact correctFactors + +theorem + paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductWord_valid + (family : Fin 4) + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (node : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) : + physicalInterpolationNestedNumeratorNodeProductWord + family width + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeNumeratorNodeFactorValues + formula node + (physicalInterpolationFamilyRowGridPosition + family row formula) count)) := by + apply physicalInterpolationNestedNodeProductWord_valid + width outerWidth row column formula node count + (physicalLagrangeNumeratorNodeFactorValues formula node + (physicalInterpolationFamilyRowGridPosition family row formula) count) + (paperVariableArityPhysicalInterpolationNumeratorNodeFactorComputer family) + correctWidth + · simp only [physicalLagrangeNumeratorNodeFactorValues, List.length_map, List.length_range] + · exact paperVariableArityPhysicalInterpolationNumeratorNodeCatalogue_valid + family width outerWidth row column formula node count correctWidth bounded + +theorem + paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductWord_valid + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (node : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) : + physicalInterpolationNestedDenominatorNodeProductWord + width + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeDenominatorNodeFactorValues + formula node count)) := by + apply physicalInterpolationNestedNodeProductWord_valid + width outerWidth row column formula node count + (physicalLagrangeDenominatorNodeFactorValues formula node count) + paperVariableArityPhysicalInterpolationDenominatorNodeFactorComputer + correctWidth + · simp only [physicalLagrangeDenominatorNodeFactorValues, List.length_map, List.length_range] + · exact paperVariableArityPhysicalInterpolationDenominatorNodeCatalogue_valid + width outerWidth row column formula node count correctWidth bounded + +end PhysicalInterpolationNestedNodeProductTM + +namespace PhysicalLagrangeNodeDenominatorNonzero + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryFieldBasis GapCVP.BinaryFieldInverseAlgebra +open GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFieldWordSemantics +open GapCVP.PhysicalLagrangeNodeProductAlgebra GapCVP.BinarySourceCoordinateOrder +open GapCVP.Factor400BinaryConstructiveSourcePlaces + +private theorem paperVariableArityPhysicalLagrangeNodeEvaluationWord_injective + (formula : ThreeCNF) : + Function.Injective + (physicalLagrangeNodeEvaluationWord formula) := by + intro first second equal + apply + (evaluationWordIndex + (variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula))).injective + apply indexedWord_injective + (physDegree formula) + exact equal + +private theorem paperVariableArityPhysicalLagrangeNodeEvaluationSourceValue_injective + (formula : ThreeCNF) : + Function.Injective + (fun point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula => + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeEvaluationWord + formula point)) := by + intro first second equal + apply paperVariableArityPhysicalLagrangeNodeEvaluationWord_injective formula + apply paperVariableArityPhysicalSourceWordValue_injective + (encodeThreeCNF formula).length formula + exact equal + +theorem + paperVariableArityPhysicalLagrangeNodeEvaluationSourceValue_ne_variableAnchor + (formula : ThreeCNF) + (point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (anchor : Fin (srcFormula formula).variableCount) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeEvaluationWord + formula point) ≠ + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + (encodeThreeCNF formula).length + (srcFormula formula) anchor := by + rw [physicalLagrangeNodeEvaluationWord_sourceField] + exact sourceFormulaEvaluationWord_ne_variablePlace + (encodeThreeCNF formula).length + (srcFormula formula) point anchor + +theorem + paperVariableArityPhysicalLagrangeNodeEvaluationSourceValue_sub_variableAnchor_ne_zero + (formula : ThreeCNF) + (point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (anchor : Fin (srcFormula formula).variableCount) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeEvaluationWord + formula point) - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + (encodeThreeCNF formula).length + (srcFormula formula) anchor ≠ 0 := by + exact sub_ne_zero.mpr + (paperVariableArityPhysicalLagrangeNodeEvaluationSourceValue_ne_variableAnchor + formula point anchor) + +private theorem paperVariableArityPhysicalLagrangeDenominatorNodeFactors_sourceField_ne_zero + (formula : ThreeCNF) + (count : ℕ) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) : + (∏ other ∈ (Finset.univ.erase node), + (sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded node) - + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded other))) ≠ 0 := by + classical + apply Finset.prod_ne_zero_iff.mpr + intro other present + apply sub_ne_zero.mpr + intro equal + have same : Fin.castLE bounded node = Fin.castLE bounded other := by + apply paperVariableArityPhysicalLagrangeNodeEvaluationSourceValue_injective + formula + simpa only + [physicalLagrangeNodeEvaluationWord_sourceField] + using equal + have sameNode : node = other := by + apply Fin.ext + exact congrArg + (fun point : PaperVariableArityPhysicalLagrangeNodeGridIndex formula => + point.val) same + exact (Finset.mem_erase.mp present).1 sameNode.symm + +private theorem paperVariableArityPhysicalLagrangeDenominatorNodeProduct_sourceField_ne_zero + (formula : ThreeCNF) + (count : ℕ) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count)) ≠ 0 := by + rw [paperVariableArityPhysicalLagrangeDenominatorNodeFactorValues_sourceField] + exact paperVariableArityPhysicalLagrangeDenominatorNodeFactors_sourceField_ne_zero + formula count bounded node + +private theorem paperVariableArityPhysicalLagrangeDenominatorInverse_sourceField + (formula : ThreeCNF) + (count : ℕ) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (sourceInverseWord + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count))) = + (∏ other ∈ (Finset.univ.erase node), + (sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded node) - + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded other)))⁻¹ := by + rw [sourceWordValue_sourceInverseWord + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count)) + (paperVariableArityPhysicalLagrangeDenominatorNodeProduct_sourceField_ne_zero + formula count bounded node)] + rw [paperVariableArityPhysicalLagrangeDenominatorNodeFactorValues_sourceField] + +end PhysicalLagrangeNodeDenominatorNonzero + +namespace PhysicalInterpolationNodeWeightTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.SourceFieldMomentOperationsTM GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalLagrangeNodeProductAlgebra GapCVP.PhysicalInterpolationNestedNodeProductTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +private def physicalInterpolationNestedNodeMomentWord + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + physicalFamilyMomentPowerWord family base ∘ + compactPhysicalLagrangeNestedNodeOuterCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeMomentWordComputable + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationNestedNodeMomentWord + family base) := + GapCVP.TMComposition.computableInPolyTime + compactPhysicalLagrangeNestedNodeOuterCellComputable + (paperVariableArityPhysicalFamilyMomentPowerComputable family base) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedNodeMomentComputer + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationNestedNodeMomentWord + family base + computer := + paperVariableArityPhysicalInterpolationNestedNodeMomentWordComputable + family base + +private theorem paperVariableArityPhysicalInterpolationNestedNodeMomentWord_valid + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) + (value : GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula)) + (correctBase : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + physicalInterpolationNestedNodeMomentWord + family base + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (sourceWordPow value + (physicalFamilyRowMoment family row formula)) := by + unfold physicalInterpolationNestedNodeMomentWord + rw [Function.comp_apply, + compactPhysicalLagrangeNestedNodeOuterCell_query] + exact paperVariableArityPhysicalFamilyMomentPowerWord_valid + family base row column formula value correctBase + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + (width : SourceQaryMaskDynamicGridWidth) : + SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalInterpolationNestedNodeInverseComputer + (paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductComputer + width) + +private def paperVariableArityPhysicalInterpolationNodeWeightWord + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + physicalInterpolationNestedNodeMultiplyWord + (paperVariableArityPhysicalInterpolationNestedNodeMultiplyComputer + (paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + family width) + (paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + width)) + (paperVariableArityPhysicalInterpolationNestedNodeMomentComputer + family base) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalInterpolationNodeWeightWordComputable + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) : + BitTM + (paperVariableArityPhysicalInterpolationNodeWeightWord + family width base) := + paperVariableArityPhysicalInterpolationNestedNodeMultiplyWordComputable + (paperVariableArityPhysicalInterpolationNestedNodeMultiplyComputer + (paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + family width) + (paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + width)) + (paperVariableArityPhysicalInterpolationNestedNodeMomentComputer + family base) + +private noncomputable def physicalInterpolationNodeWeightComputer + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) : + SourcePhysicalLagrangeWordComputer where + output := paperVariableArityPhysicalInterpolationNodeWeightWord + family width base + computer := paperVariableArityPhysicalInterpolationNodeWeightWordComputable + family width base + +/-- GapCVP reduction support. -/ +def physicalInterpolationNodeWeightSourceWord + (family : Fin 4) (row : ℕ) (formula : ThreeCNF) + (count : ℕ) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) : + GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula) := + multiplyMod + (irreducibleWord (physDegree formula)) + (multiplyMod + (irreducibleWord (physDegree formula)) + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeNumeratorNodeFactorValues + formula (Fin.castLE bounded node) + (physicalInterpolationFamilyRowGridPosition + family row formula) count)) + (sourceInverseWord + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count)))) + (sourceWordPow value + (physicalFamilyRowMoment family row formula)) + +theorem + paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer_valid + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) : + (paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + width).output + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (sourceInverseWord + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count))) := by + let cell := affineCellQuery row column + (encodeThreeCNF formula) + let outer := compactPhysicalLagrangeNestedNodeEnvelope + outerWidth node.val cell + let denominator := physicalLagrangeNodeSelectedWordProduct + formula (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count) + have correctDenominator : + (paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductComputer + width).output outer = finiteWordBits denominator := by + change + physicalInterpolationNestedDenominatorNodeProductWord + width outer = finiteWordBits denominator + simpa only [outer, cell, denominator, Fin.val_castLE] using + paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductWord_valid + width outerWidth row column formula + (Fin.castLE bounded node) count correctWidth bounded + change physicalInterpolationNestedNodeInverseWord + (paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductComputer + width) outer = finiteWordBits (sourceInverseWord denominator) + exact paperVariableArityPhysicalInterpolationNestedNodeInverseWord_valid + (paperVariableArityPhysicalInterpolationNestedDenominatorNodeProductComputer + width) + outerWidth node.val row column formula denominator correctDenominator + +end PhysicalInterpolationNodeWeightTM + +namespace PhysicalInterpolationNodeWeightCorrectness + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM GapCVP.SourceFieldMomentOperationsTM +open GapCVP.PhysicalInterpolationNodeFactorTM GapCVP.PhysicalLagrangeNodeProductAlgebra +open GapCVP.PhysicalInterpolationNestedNodeProductTM GapCVP.PhysicalInterpolationNodeWeightTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +theorem + paperVariableArityPhysicalInterpolationNestedNumeratorNodeComputer_valid + (family : Fin 4) + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) : + (paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + family width).output + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeNumeratorNodeFactorValues + formula (Fin.castLE bounded node) + (physicalInterpolationFamilyRowGridPosition + family row formula) count)) := by + change + physicalInterpolationNestedNumeratorNodeProductWord + family width + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = _ + simpa only [Fin.val_castLE] using + paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductWord_valid + family width outerWidth row column formula + (Fin.castLE bounded node) count correctWidth bounded + +private theorem paperVariableArityPhysicalInterpolationNestedNodeMomentComputer_output + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) + (input : List Bool) : + (paperVariableArityPhysicalInterpolationNestedNodeMomentComputer + family base).output input = + physicalInterpolationNestedNodeMomentWord + family base input := by + dsimp only [paperVariableArityPhysicalInterpolationNestedNodeMomentComputer] + +private theorem paperVariableArityPhysicalInterpolationNestedNodeMomentComputer_valid + (family : Fin 4) (base : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (node row column : ℕ) (formula : ThreeCNF) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (correctBase : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + (paperVariableArityPhysicalInterpolationNestedNodeMomentComputer + family base).output + (compactPhysicalLagrangeNestedNodeEnvelope width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (sourceWordPow value + (physicalFamilyRowMoment family row formula)) := by + rw [paperVariableArityPhysicalInterpolationNestedNodeMomentComputer_output] + exact paperVariableArityPhysicalInterpolationNestedNodeMomentWord_valid + family base width node row column formula value correctBase + +theorem + paperVariableArityPhysicalInterpolationNestedNumeratorInverseComputer_valid + (family : Fin 4) + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (row column : ℕ) (formula : ThreeCNF) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) : + (paperVariableArityPhysicalInterpolationNestedNodeMultiplyComputer + (paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + family width) + (paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + width)).output + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (multiplyMod + (irreducibleWord (physDegree formula)) + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeNumeratorNodeFactorValues + formula (Fin.castLE bounded node) + (physicalInterpolationFamilyRowGridPosition + family row formula) count)) + (sourceInverseWord + (physicalLagrangeNodeSelectedWordProduct formula + (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count)))) := by + change physicalInterpolationNestedNodeMultiplyWord + (paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + family width) + (paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + width) + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = _ + apply paperVariableArityPhysicalInterpolationNestedNodeMultiplyWord_valid + (paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + family width) + (paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + width) + outerWidth node.val row column formula + · exact + paperVariableArityPhysicalInterpolationNestedNumeratorNodeComputer_valid + family width outerWidth row column formula + count correctWidth bounded node + · exact + paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer_valid + width outerWidth row column formula count correctWidth bounded node + +private theorem paperVariableArityPhysicalInterpolationNodeWeightWord_valid + (family : Fin 4) + (width outerWidth : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (correctBase : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + paperVariableArityPhysicalInterpolationNodeWeightWord family width base + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (physicalInterpolationNodeWeightSourceWord + family row formula count bounded node value) := by + let numerator := physicalLagrangeNodeSelectedWordProduct + formula (physicalLagrangeNumeratorNodeFactorValues + formula (Fin.castLE bounded node) + (physicalInterpolationFamilyRowGridPosition + family row formula) count) + let denominator := physicalLagrangeNodeSelectedWordProduct + formula (physicalLagrangeDenominatorNodeFactorValues + formula (Fin.castLE bounded node) count) + let moment := sourceWordPow value + (physicalFamilyRowMoment family row formula) + change physicalInterpolationNestedNodeMultiplyWord + (paperVariableArityPhysicalInterpolationNestedNodeMultiplyComputer + (paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + family width) + (paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + width)) + (paperVariableArityPhysicalInterpolationNestedNodeMomentComputer + family base) + (compactPhysicalLagrangeNestedNodeEnvelope outerWidth node.val + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (multiplyMod + (irreducibleWord (physDegree formula)) + (multiplyMod + (irreducibleWord (physDegree formula)) + numerator (sourceInverseWord denominator)) moment) + apply paperVariableArityPhysicalInterpolationNestedNodeMultiplyWord_valid + (paperVariableArityPhysicalInterpolationNestedNodeMultiplyComputer + (paperVariableArityPhysicalInterpolationNestedNumeratorNodeProductComputer + family width) + (paperVariableArityPhysicalInterpolationNestedDenominatorInverseComputer + width)) + (paperVariableArityPhysicalInterpolationNestedNodeMomentComputer + family base) + outerWidth node.val row column formula + · exact + paperVariableArityPhysicalInterpolationNestedNumeratorInverseComputer_valid + family width outerWidth row column formula + count correctWidth bounded node + · exact paperVariableArityPhysicalInterpolationNestedNodeMomentComputer_valid + family base outerWidth node.val row column formula value correctBase + +end PhysicalInterpolationNodeWeightCorrectness + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryFieldBasis +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryPhysicalRowBasisDivisionTM +open GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM +open GapCVP.PhysicalGlobalRefinementCoefficientTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine +open GapCVP.SourceFieldMomentOperationsTM GapCVP.PhysicalInterpolationDirectMomentBitTM +open GapCVP.PhysicalOrdinaryShiftedCoefficientSumTM +open GapCVP.PhysicalMaskedInterpolationNodeParityTM GapCVP.PhysicalInterpolationNodeWeightTM +open GapCVP.PhysicalInterpolationNodeWeightCorrectness + +private def physicalBooleanOrOutput + (first second : List Bool → List Bool) : List Bool → List Bool := + sourceFourFamilyBooleanOrOutput first second + +private noncomputable def paperVariableArityPhysicalBooleanOrComputable + {first second : List Bool → List Bool} + (firstComputer : BitTM first) + (secondComputer : BitTM second) : + BitTM + (physicalBooleanOrOutput first second) := + sourceFourFamilyBooleanOrComputable firstComputer secondComputer + +private theorem paperVariableArityPhysicalBooleanOrOutput_bits + (first second : List Bool → List Bool) + (input : List Bool) (firstBit secondBit : Bool) + (firstCorrect : first input = [firstBit]) + (secondCorrect : second input = [secondBit]) : + physicalBooleanOrOutput first second input = + [firstBit || secondBit] := + fourFamilyBooleanOrOutput_bits first second input firstBit secondBit + firstCorrect secondCorrect + +/-- GapCVP reduction support. -/ +def physicalBooleanXorOutput + (first second : List Bool → List Bool) : List Bool → List Bool := + physicalBooleanOrOutput + (sourceFourFamilyBooleanAndOutput first + (sourceFourFamilyBooleanNotOutput second)) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput first) second) + +private noncomputable def paperVariableArityPhysicalBooleanXorComputable + {first second : List Bool → List Bool} + (firstComputer : BitTM first) + (secondComputer : BitTM second) : + BitTM + (physicalBooleanXorOutput first second) := + paperVariableArityPhysicalBooleanOrComputable + (fourFamilyBooleanAndComputable + firstComputer + (fourFamilyBooleanNotOutputComputable secondComputer)) + (fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable firstComputer) + secondComputer) + +private theorem paperVariableArityPhysicalBooleanXorOutput_bits + (first second : List Bool → List Bool) + (input : List Bool) (firstBit secondBit : Bool) + (firstCorrect : first input = [firstBit]) + (secondCorrect : second input = [secondBit]) : + physicalBooleanXorOutput first second input = + [Bool.xor firstBit secondBit] := by + have firstNegation := fourFamilyBooleanNotOutput_bit + first input firstBit firstCorrect + have secondNegation := fourFamilyBooleanNotOutput_bit + second input secondBit secondCorrect + have leftTerm := fourFamilyBooleanAndOutput_bits + first (sourceFourFamilyBooleanNotOutput second) + input firstBit (!secondBit) firstCorrect secondNegation + have rightTerm := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput first) second + input (!firstBit) secondBit firstNegation secondCorrect + have result := paperVariableArityPhysicalBooleanOrOutput_bits + (sourceFourFamilyBooleanAndOutput first + (sourceFourFamilyBooleanNotOutput second)) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput first) second) + input (firstBit && !secondBit) ((!firstBit) && secondBit) + leftTerm rightTerm + change physicalBooleanOrOutput + (sourceFourFamilyBooleanAndOutput first + (sourceFourFamilyBooleanNotOutput second)) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput first) second) input = _ + cases firstBit <;> cases secondBit <;> exact result + +private noncomputable def physicalInterpolationColumnFieldRankComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalColumnFieldValueRankUnary + computer := paperVariableArityPhysicalColumnFieldValueRankUnaryComputable + +private theorem paperVariableArityPhysicalInterpolationColumnFieldRankComputer_output : + physicalInterpolationColumnFieldRankComputer.output = + physicalColumnFieldValueRankUnary := by + dsimp only [physicalInterpolationColumnFieldRankComputer] + +private def physicalInterpolationColumnFieldWord : + List Bool → List Bool := + physicalCellFieldWordAt + physicalInterpolationColumnFieldRankComputer + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationColumnFieldWordComputable : + BitTM + physicalInterpolationColumnFieldWord := + physicalCellFieldWordAtComputable + physicalInterpolationColumnFieldRankComputer + +/-- GapCVP reduction support. -/ +noncomputable def physicalInterpolationColumnFieldComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationColumnFieldWord + computer := paperVariableArityPhysicalInterpolationColumnFieldWordComputable + +private theorem paperVariableArityPhysicalInterpolationColumnFieldComputer_output : + physicalInterpolationColumnFieldComputer.output = + physicalInterpolationColumnFieldWord := by + dsimp only [physicalInterpolationColumnFieldComputer] + +private theorem paperVariableArityPhysicalInterpolationColumnFieldWord_valid + (row column : ℕ) (formula : ThreeCNF) + (index : Fin + (2 ^ sourceIrreducibleFormulaDegree formula)) + (correctIndex : index.val = + column % physFieldCard formula) : + physicalInterpolationColumnFieldWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + index) := by + unfold physicalInterpolationColumnFieldWord + apply physicalCellFieldWordAt_valid + physicalInterpolationColumnFieldRankComputer + row column formula index + rw [paperVariableArityPhysicalInterpolationColumnFieldRankComputer_output, + paperVariableArityPhysicalColumnFieldValueRankUnary_query, + correctIndex] + +private def physicalInterpolationFamilyTypeRankUnary + (family : Fin 4) : List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + (physicalFamilyRowGridQuotientWord family) + physicalMomentCellMomentCountUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationFamilyTypeRankUnaryComputable + (family : Fin 4) : + BitTM + (physicalInterpolationFamilyTypeRankUnary family) := + sourcePhysicalComputedUnaryQuotientComputable + (paperVariableArityPhysicalFamilyRowGridQuotientComputable family) + paperVariableArityPhysicalMomentCellMomentCountUnaryComputable + +private theorem paperVariableArityPhysicalInterpolationFamilyTypeRankUnary_valid + (family : Fin 4) (row column : ℕ) (formula : ThreeCNF) : + physicalInterpolationFamilyTypeRankUnary family + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((((row - physicalFamilyStart family formula) / + physDegree formula) / + physGridCard formula) / + physicalFormulaMomentCount formula) true := by + exact sourcePhysicalComputedUnaryQuotient_valid + (physicalFamilyRowGridQuotientWord family) + physicalMomentCellMomentCountUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + (((row - physicalFamilyStart family formula) / + physDegree formula) / + physGridCard formula) + (physicalFormulaMomentCount formula) + (physicalFormulaMomentCount_pos formula) + (paperVariableArityPhysicalFamilyRowGridQuotientWord_valid + family row column formula) + (paperVariableArityPhysicalMomentCellMomentCountUnary_valid + row column formula) + +/-- GapCVP reduction support. -/ +noncomputable def physicalInterpolationFamilyTypeRankComputer + (family : Fin 4) : SourcePhysicalLagrangeWordComputer where + output := physicalInterpolationFamilyTypeRankUnary family + computer := + paperVariableArityPhysicalInterpolationFamilyTypeRankUnaryComputable family + +/-- GapCVP reduction support. -/ +def physicalInterpolationExpectedTypeMatchBit + (expected : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + physicalCoefficientUnaryEquality + expected.output physicalColumnTypeRankUnary + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationExpectedTypeMatchBitComputable + (expected : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationExpectedTypeMatchBit expected) := + paperVariableArityPhysicalCoefficientUnaryEqualityComputable + expected.computer paperVariableArityPhysicalColumnTypeRankUnaryComputable + +/-- GapCVP reduction support. -/ +def physicalInterpolationNodeCorrectionBit + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + physicalInterpolationNodeParity width + (paperVariableArityPhysicalMaskedNodeInterpolationBitComputable + (physicalInterpolationNodeWeightComputer + family width base)) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalInterpolationNodeCorrectionBitComputable + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalInterpolationNodeCorrectionBit + family width base) := + paperVariableArityPhysicalInterpolationNodeParityComputable width + (paperVariableArityPhysicalMaskedNodeInterpolationBitComputable + (physicalInterpolationNodeWeightComputer + family width base)) + +/-- GapCVP reduction support. -/ +def physicalInterpolationNodeSourceWord + (family : Fin 4) (row : ℕ) (formula : ThreeCNF) + (count : ℕ) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (node : ℕ) : + GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula) := + if valid : node < count then + physicalInterpolationNodeWeightSourceWord + family row formula count bounded ⟨node, valid⟩ value + else + fun _ => false + +private theorem paperVariableArityPhysicalInterpolationNodeCorrectionBit_valid + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (correctBase : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + physicalInterpolationNodeCorrectionBit + family width base + (affineCellQuery row column + (encodeThreeCNF formula)) = + [((List.range count).map + (physicalMaskedInterpolationNodeValue + row column formula + (physicalInterpolationNodeSourceWord + family row formula count bounded value))).foldl + Bool.xor false] := by + unfold physicalInterpolationNodeCorrectionBit + apply paperVariableArityPhysicalMaskedInterpolationParity_valid + width + (physicalInterpolationNodeWeightComputer + family width base) + (affineCellQuery row column + (encodeThreeCNF formula)) + count + (physicalMaskedInterpolationNodeValue + row column formula + (physicalInterpolationNodeSourceWord + family row formula count bounded value)) + correctWidth + intro node member + have valid : node < count := List.mem_range.mp member + have actualWeight : + (physicalInterpolationNodeWeightComputer + family width base).output + (GapCVP.BinaryCompactPhysicalLagrangeNestedNodeTM.compactPhysicalLagrangeNestedNodeEnvelope + width node + (affineCellQuery row column + (encodeThreeCNF formula))) = + finiteWordBits + (physicalInterpolationNodeWeightSourceWord + family row formula count bounded ⟨node, valid⟩ value) := by + dsimp only [physicalInterpolationNodeWeightComputer] + exact paperVariableArityPhysicalInterpolationNodeWeightWord_valid + family width width base row column formula count correctWidth + bounded ⟨node, valid⟩ value correctBase + simpa only [physicalMaskedInterpolationNodeValue, + physicalInterpolationNodeSourceWord, + dite_eq_left valid] using + paperVariableArityPhysicalMaskedNodeInterpolationBit_valid + (physicalInterpolationNodeWeightComputer + family width base) + width node row column formula + (physicalInterpolationNodeWeightSourceWord + family row formula count bounded ⟨node, valid⟩ value) + actualWeight + +/-- GapCVP reduction support. -/ +def physicalSourceInterpolationFamilyCheckBit + (family : Fin 4) (marker : List Bool → List Bool) + (expected : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) : + List Bool → List Bool := + sourceFourFamilyBooleanAndOutput marker + (sourceFourFamilyBooleanAndOutput + (physicalInterpolationExpectedTypeMatchBit expected) + (physicalBooleanXorOutput + (physicalFamilyDirectMomentBit family base) + (physicalInterpolationNodeCorrectionBit + family width base))) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalSourceInterpolationFamilyCheckBitComputable + (family : Fin 4) (marker : List Bool → List Bool) + (markerComputer : BitTM marker) + (expected : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) : + BitTM + (physicalSourceInterpolationFamilyCheckBit + family marker expected width base) := + fourFamilyBooleanAndComputable markerComputer + (fourFamilyBooleanAndComputable + (paperVariableArityPhysicalInterpolationExpectedTypeMatchBitComputable + expected) + (paperVariableArityPhysicalBooleanXorComputable + (paperVariableArityPhysicalFamilyDirectMomentBitComputable + family base) + (paperVariableArityPhysicalInterpolationNodeCorrectionBitComputable + family width base))) + +theorem paperVariableArityPhysicalSourceInterpolationFamilyCheckBit_bits + (family : Fin 4) (marker : List Bool → List Bool) + (expected : SourcePhysicalLagrangeWordComputer) + (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) + (input : List Bool) + (markerBit expectedBit directBit correctionBit : Bool) + (markerCorrect : marker input = [markerBit]) + (expectedCorrect : + physicalInterpolationExpectedTypeMatchBit + expected input = [expectedBit]) + (directCorrect : + physicalFamilyDirectMomentBit family base input = + [directBit]) + (correctionCorrect : + physicalInterpolationNodeCorrectionBit + family width base input = [correctionBit]) : + physicalSourceInterpolationFamilyCheckBit + family marker expected width base input = + [markerBit && + (expectedBit && Bool.xor directBit correctionBit)] := by + exact fourFamilyBooleanAndOutput_bits + marker + (sourceFourFamilyBooleanAndOutput + (physicalInterpolationExpectedTypeMatchBit expected) + (physicalBooleanXorOutput + (physicalFamilyDirectMomentBit family base) + (physicalInterpolationNodeCorrectionBit + family width base))) + input markerBit + (expectedBit && Bool.xor directBit correctionBit) markerCorrect + (fourFamilyBooleanAndOutput_bits + (physicalInterpolationExpectedTypeMatchBit expected) + (physicalBooleanXorOutput + (physicalFamilyDirectMomentBit family base) + (physicalInterpolationNodeCorrectionBit + family width base)) + input expectedBit (Bool.xor directBit correctionBit) + expectedCorrect + (paperVariableArityPhysicalBooleanXorOutput_bits + (physicalFamilyDirectMomentBit family base) + (physicalInterpolationNodeCorrectionBit + family width base) + input directBit correctionBit directCorrect correctionCorrect)) + +/-- GapCVP reduction support. -/ +def physicalOrdinaryCheckBit : List Bool → List Bool := + physicalSourceInterpolationFamilyCheckBit + (2 : Fin 4) + physicalOrdinaryRowMarker + (physicalInterpolationFamilyTypeRankComputer (2 : Fin 4)) + (physicalOrdinaryNodePrefixWidth + physicalOrdinaryInterpolationMomentComputer) + physicalInterpolationColumnFieldComputer + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalOrdinaryCheckBitComputable : + BitTM + physicalOrdinaryCheckBit := + paperVariableArityPhysicalSourceInterpolationFamilyCheckBitComputable + (2 : Fin 4) + physicalOrdinaryRowMarker + paperVariableArityPhysicalOrdinaryRowMarkerComputable + (physicalInterpolationFamilyTypeRankComputer (2 : Fin 4)) + (physicalOrdinaryNodePrefixWidth + physicalOrdinaryInterpolationMomentComputer) + physicalInterpolationColumnFieldComputer + +end PhysicalOrdinaryShiftedCheckBitInstantiation + +namespace BinaryPhysicalLagrangeParityEntry + +open scoped BigOperators + +open Polynomial GapCVP.BinaryReedSolomonParity + +theorem constructiveParityMatrix_apply_eq_orderedNodeProducts + {K : Type*} [Field K] + {gridCardinality degreeBound : ℕ} + (points : Fin gridCardinality → K) + (hdegree : degreeBound < gridCardinality) + (row column : Fin gridCardinality) : + constructiveParityMatrix points hdegree row column = + (if row = column then (1 : K) else 0) - + ∑ node : Fin (degreeBound + 1), + (if Fin.castLE (Nat.succ_le_of_lt hdegree) node = column + then (1 : K) else 0) * + ∏ other ∈ (Finset.univ.erase node), + (points + (Fin.castLE (Nat.succ_le_of_lt hdegree) node) - + points + (Fin.castLE (Nat.succ_le_of_lt hdegree) other))⁻¹ * + (points row - + points + (Fin.castLE (Nat.succ_le_of_lt hdegree) other)) := by + classical + simp only [constructiveParityMatrix, LinearMap.toMatrix'_apply, + constructiveParityLinearMap_apply, + Pi.single_apply, orderedInterpolationPolynomial, orderedInterpolationPrefix, + Nat.succ_eq_add_one, LinearMap.coe_mk, + AddHom.coe_mk, Lagrange.interpolate_apply, MonoidWithZeroHom.map_ite_one_zero, + Lagrange.basis, + Lagrange.basisDivisor, orderedInterpolationNode, ite_mul, one_mul, zero_mul, eval_finsetSum, + sub_right_inj] + apply Finset.sum_congr rfl + intro node _ + split_ifs with hnode + · simp only [eval_prod, eval_mul, eval_C, eval_sub, eval_X] + · simp only [eval_zero] + +end BinaryPhysicalLagrangeParityEntry + +namespace PhysicalSelectedInterpolationCoefficientProjection + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryReedSolomonParity +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.PhysicalColumnOrder +open GapCVP.MatrixEntrySemantics + +attribute [local instance] Classical.propDecidable + +@[simp] private theorem paperVariableArityPhysicalWordCoordinateDelta_eq_selectedCoordinate + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) + (tableType : sourceSATTableType + (srcFormula formula)) + (point : sourceSATGridPoint + (PaperVariableArityPhysicalWordGrid encodingLength formula)) + (value : PaperVariableArityPhysicalWordField + encodingLength formula) : + physicalWordCoordinateDelta + encodingLength formula column tableType point value = + if (tableType, point, value) = + sourceCoordinateWordOrder + encodingLength formula column + then 1 else 0 := by + simp only [physicalWordCoordinateDelta, physicalCoordinateIndex, Equiv.symm_apply_eq] + +private theorem paperVariableArityPhysicalWordCoordinateDelta_sum_field + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) + (tableType : sourceSATTableType + (srcFormula formula)) + (point : sourceSATGridPoint + (PaperVariableArityPhysicalWordGrid encodingLength formula)) + (weight : PaperVariableArityPhysicalWordField encodingLength formula → + PaperVariableArityPhysicalWordField encodingLength formula) : + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + physicalWordCoordinateDelta + encodingLength formula column tableType point value * + weight value = + if tableType = + (sourceCoordinateWordOrder + encodingLength formula column).1 ∧ + point = + (sourceCoordinateWordOrder + encodingLength formula column).2.1 + then weight + (sourceCoordinateWordOrder + encodingLength formula column).2.2 + else 0 := by + classical + simp_rw [paperVariableArityPhysicalWordCoordinateDelta_eq_selectedCoordinate] + by_cases htype : + tableType = + (sourceCoordinateWordOrder + encodingLength formula column).1 + · by_cases hpoint : + point = + (sourceCoordinateWordOrder + encodingLength formula column).2.1 + · subst tableType + subst point + simp only [Prod.ext_iff, true_and, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', + Finset.mem_univ, + ↓reduceIte, and_self] + · simp only [Prod.ext_iff, hpoint, false_and, and_false, ↓reduceIte, zero_mul, + Finset.sum_const_zero] + · simp only [Prod.ext_iff, htype, false_and, ↓reduceIte, zero_mul, Finset.sum_const_zero] + +private theorem paperVariableArityPhysicalWordCoordinateDelta_sum_dependentOrderedGrid + (encodingLength : ℕ) (formula : ThreeCNF) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) + (tableType : sourceSATTableType + (srcFormula formula)) + {gridCardinality : ℕ} + (gridOrder : Fin gridCardinality ≃ + sourceSATGridPoint + (PaperVariableArityPhysicalWordGrid encodingLength formula)) + (parity : Fin gridCardinality → + PaperVariableArityPhysicalWordField encodingLength formula) + (weight : Fin gridCardinality → + PaperVariableArityPhysicalWordField encodingLength formula → + PaperVariableArityPhysicalWordField encodingLength formula) : + (∑ position : Fin gridCardinality, + parity position * + ∑ value : PaperVariableArityPhysicalWordField + encodingLength formula, + physicalWordCoordinateDelta + encodingLength formula column tableType + (gridOrder position) value * weight position value) = + if tableType = + (sourceCoordinateWordOrder + encodingLength formula column).1 + then parity + (gridOrder.symm + (sourceCoordinateWordOrder + encodingLength formula column).2.1) * + weight + (gridOrder.symm + (sourceCoordinateWordOrder + encodingLength formula column).2.1) + (sourceCoordinateWordOrder + encodingLength formula column).2.2 + else 0 := by + classical + simp_rw [paperVariableArityPhysicalWordCoordinateDelta_sum_field] + by_cases htype : + tableType = + (sourceCoordinateWordOrder + encodingLength formula column).1 + · subst tableType + simp only [(gridOrder.eq_symm_apply).symm, true_and, mul_ite, mul_zero, + Finset.sum_ite_eq', + Finset.mem_univ, ↓reduceIte] + · simp only [htype, false_and, ↓reduceIte, mul_zero, Finset.sum_const_zero] + +private theorem paperVariableArityPhysicalWordOrdinaryFieldCoefficient_eq_selectedCoordinate + (encodingLength : ℕ) (formula : ThreeCNF) + (tableType : sourceSATTableType + (srcFormula formula)) + (moment : Fin + (explicitMomentBudget encodingLength + (srcFormula formula) + 1)) + (row : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)))) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula + (.inr (.inr (.inl (tableType, moment)))) row column = + if tableType = + (sourceCoordinateWordOrder + encodingLength formula column).1 + then + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) index).val) + (explicitOrdinaryDegree_lt_grid encodingLength + (srcFormula formula) moment) + row + ((sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula)).symm + (sourceCoordinateWordOrder + encodingLength formula column).2.1) * + (sourceCoordinateWordOrder + encodingLength formula column).2.2 ^ moment.val + else 0 := by + rw [paperVariableArityPhysicalWordOrdinaryFieldCoefficient] + exact paperVariableArityPhysicalWordCoordinateDelta_sum_dependentOrderedGrid + encodingLength formula column tableType + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula)) + (fun position => + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) index).val) + (explicitOrdinaryDegree_lt_grid encodingLength + (srcFormula formula) moment) + row position) + (fun _ value => value ^ moment.val) + +theorem paperVariableArityPhysicalWordShiftedFieldCoefficient_eq_selectedCoordinate + (encodingLength : ℕ) (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) + (tuple : ((srcFormula + formula).clauses.get clause).SatisfyingLocalTuple) + (localVariable : ((srcFormula + formula).clauses.get clause).LocalVariable) + (moment : Fin + (explicitMomentBudget encodingLength + (srcFormula formula) + 1)) + (row : Fin (Fintype.card + (ExplicitGridPoint encodingLength + (srcFormula formula)))) + (column : Fin + (PaperVariableArityPhysicalWordDimension encodingLength formula)) : + physicalWordFamilyFieldCoefficient + encodingLength formula + (.inr (.inr (.inr + ⟨clause, tuple, localVariable, moment⟩))) row column = + if (Sum.inr ⟨clause, tuple⟩ : + sourceSATTableType (srcFormula formula)) = + (sourceCoordinateWordOrder + encodingLength formula column).1 + then + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) index).val) + (explicitShiftedDegree_lt_grid encodingLength + (srcFormula formula) moment) + row + ((sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula)).symm + (sourceCoordinateWordOrder + encodingLength formula column).2.1) * + (((sourceCoordinateWordOrder + encodingLength formula column).2.2 - + sourceSATFieldBit + (K := PaperVariableArityPhysicalWordField + encodingLength formula) + (tuple.val localVariable)) / + ((sourceCoordinateWordOrder + encodingLength formula column).2.1.val - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength (srcFormula formula) + localVariable.val)) ^ moment.val + else 0 := by + rw [paperVariableArityPhysicalWordShiftedFieldCoefficient] + simpa only [Equiv.apply_symm_apply] using + paperVariableArityPhysicalWordCoordinateDelta_sum_dependentOrderedGrid + encodingLength formula column + (Sum.inr ⟨clause, tuple⟩ : + sourceSATTableType (srcFormula formula)) + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula)) + (fun position => + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) index).val) + (explicitShiftedDegree_lt_grid encodingLength + (srcFormula formula) moment) + row position) + (fun position value => + ((value - + sourceSATFieldBit + (K := PaperVariableArityPhysicalWordField + encodingLength formula) + (tuple.val localVariable)) / + ((sourceFormulaExplicitGridOrder encodingLength + (srcFormula formula) position).val - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + encodingLength (srcFormula formula) + localVariable.val)) ^ moment.val) + +end PhysicalSelectedInterpolationCoefficientProjection + +namespace PhysicalInterpolationNodeParitySemanticCorrectness + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField + +private theorem paperVariableArityPhysicalBoolXorFold_bitValue_aux + (bits : List Bool) (initial : Bool) : + bitValue (bits.foldl Bool.xor initial) = + bitValue initial + (bits.map bitValue).sum := by + induction bits generalizing initial with + | nil => simp only [List.foldl_nil, List.map_nil, List.sum_nil, add_zero] + | cons bit remaining ih => + simp only [List.foldl_cons, List.map_cons, List.sum_cons] + rw [ih, bitValue_xor] + simp only [add_assoc] + +private theorem paperVariableArityPhysicalBoolXorFold_bitValue + (bits : List Bool) : + bitValue (bits.foldl Bool.xor false) = + (bits.map bitValue).sum := by + simpa only [bitValue, Bool.false_eq_true, ↓reduceIte, zero_add] using + paperVariableArityPhysicalBoolXorFold_bitValue_aux bits false + +end PhysicalInterpolationNodeParitySemanticCorrectness + +namespace PhysicalMaskedInterpolationNodeParitySemanticCorrectness + +open GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.BinaryCompactPhysicalFieldBasisCoordinates GapCVP.BinaryFieldInverseAlgebra +open GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationNodeParitySemanticCorrectness +open GapCVP.PhysicalOrdinaryShiftedCoefficientTM + +private theorem paperVariableArityPhysicalFiniteMaskedBasisBitParity_sourceField + (formula : ThreeCNF) + (terms : List + (Bool × PaperVariableArityPhysicalInterpolationWord formula)) + (index : Fin (physDegree formula)) : + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + ((terms.map (fun term => + if term.1 then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) term.2 + else 0)).sum) index = + bitValue + ((terms.map (fun term => term.1 && term.2 index)).foldl + Bool.xor false) := by + rw [paperVariableArityPhysicalBoolXorFold_bitValue] + induction terms with + | nil => + simp only [List.map_nil, List.sum_nil] + rw [map_zero] + rfl + | cons term remaining ih => + rcases term with ⟨mask, word⟩ + cases mask + · simpa only [List.map_cons, Bool.false_eq_true, ↓reduceIte, List.sum_cons, zero_add, + Module.Basis.equivFun_apply, Bool.false_and, bitValue, List.map_map] using ih + · simp only [List.map_cons, List.sum_cons, Bool.true_and, ↓reduceIte] + rw [map_add] + change + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) word) index + + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + ((remaining.map (fun item => + if item.1 then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) item.2 + else 0)).sum) index = + bitValue (word index) + + ((remaining.map + (fun item => item.1 && item.2 index)).map bitValue).sum + rw [ih] + exact congrArg (fun value => + value + ((remaining.map + (fun item => item.1 && item.2 index)).map bitValue).sum) + (sourceFormulaFieldBasis_sourceWordValue_coordinate + (encodeThreeCNF formula).length + (srcFormula formula) word index) + +private theorem paperVariableArityPhysicalFiniteMaskedBasisBitParity_decide + (formula : ThreeCNF) + (terms : List + (Bool × PaperVariableArityPhysicalInterpolationWord formula)) + (index : Fin (physDegree formula)) : + ((terms.map (fun term => term.1 && term.2 index)).foldl + Bool.xor false) = + decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + ((terms.map (fun term => + if term.1 then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) term.2 + else 0)).sum) index = (1 : ZMod 2)) := by + rw [paperVariableArityPhysicalFiniteMaskedBasisBitParity_sourceField] + generalize + ((terms.map (fun term => term.1 && term.2 index)).foldl + Bool.xor false) = bit + cases bit <;> decide + +private theorem paperVariableArityPhysicalMaskedGridNodeBasisParity_decide + (formula : ThreeCNF) (count grid : ℕ) + (index : Fin (physDegree formula)) + (word : ℕ → PaperVariableArityPhysicalInterpolationWord formula) : + (((List.range count).map (fun node => + decide (node = grid) && word node index)).foldl + Bool.xor false) = + decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (((List.range count).map (fun node => + if node = grid then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) (word node) + else 0)).sum) index = (1 : ZMod 2)) := by + have actual := paperVariableArityPhysicalFiniteMaskedBasisBitParity_decide + formula + ((List.range count).map + (fun node => (decide (node = grid), word node))) index + simpa only [List.map_map, Function.comp_def, + Prod.fst, Prod.snd, decide_eq_true_eq] using actual + +end PhysicalMaskedInterpolationNodeParitySemanticCorrectness + +namespace PhysicalInterpolationNodeWeightSourceFieldCorrectness + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryFieldInverseAlgebra GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalInterpolationNodeWeightTM GapCVP.PhysicalLagrangeNodeDenominatorNonzero +open GapCVP.PhysicalLagrangeNodeProductAlgebra GapCVP.SourceFieldMomentOperationsTM +open GapCVP.BinarySourceCoordinateOrder + +theorem paperVariableArityPhysicalInterpolationNodeWeightSourceWord_sourceField + (family : Fin 4) + (row : ℕ) + (formula : ThreeCNF) + (count : ℕ) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (node : Fin count) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeWeightSourceWord + family row formula count bounded node value) = + (∏ other ∈ (Finset.univ.erase node), + (sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationFamilyRowGridPosition + family row formula) - + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded other))) * + (∏ other ∈ (Finset.univ.erase node), + (sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded node) - + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE bounded other)))⁻¹ * + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) value ^ + physicalFamilyRowMoment family row formula := by + unfold physicalInterpolationNodeWeightSourceWord + rw [sourceWordValue_multiplyMod, sourceWordValue_multiplyMod, + paperVariableArityPhysicalLagrangeNumeratorNodeFactorValues_sourceField, + paperVariableArityPhysicalLagrangeDenominatorInverse_sourceField, + sourceWordValue_sourceWordPow] + +end PhysicalInterpolationNodeWeightSourceFieldCorrectness + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open Turing GapCVP.Core GapCVP.BinaryEncoding +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalMaskedInterpolationNodeParitySemanticCorrectness + +theorem paperVariableArityPhysicalInterpolationNodeCorrectionBit_sourceField_valid + (family : Fin 4) (width : SourceQaryMaskDynamicGridWidth) + (base : SourcePhysicalLagrangeWordComputer) + (row column : ℕ) (formula : ThreeCNF) + (count : ℕ) + (correctWidth : width.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate count true) + (bounded : count ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (correctBase : base.output + (affineCellQuery row column + (encodeThreeCNF formula)) = finiteWordBits value) : + physicalInterpolationNodeCorrectionBit + family width base + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (((List.range count).map (fun node => + if node = + (column / + physFieldCard formula) % + physGridCard formula + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + family row formula count bounded value node) + else 0)).sum) + (physicalInterpolationRowBasisIndex + row formula) = (1 : ZMod 2))] := by + calc + physicalInterpolationNodeCorrectionBit + family width base + (affineCellQuery row column + (encodeThreeCNF formula)) = + [((List.range count).map + (physicalMaskedInterpolationNodeValue + row column formula + (physicalInterpolationNodeSourceWord + family row formula count bounded value))).foldl + Bool.xor false] := + paperVariableArityPhysicalInterpolationNodeCorrectionBit_valid + family width base row column formula count correctWidth bounded + value correctBase + _ = _ := by + congr 1 + change + (((List.range count).map (fun node => + decide + (node = + (column / + physFieldCard formula) % + physGridCard formula) && + physicalInterpolationNodeSourceWord + family row formula count bounded value node + (physicalInterpolationRowBasisIndex + row formula))).foldl Bool.xor false) = _ + exact paperVariableArityPhysicalMaskedGridNodeBasisParity_decide + formula count + ((column / + physFieldCard formula) % + physGridCard formula) + (physicalInterpolationRowBasisIndex row formula) + (physicalInterpolationNodeSourceWord + family row formula count bounded value) + +end PhysicalOrdinaryShiftedCheckBitInstantiation + +namespace ShiftedTupleBetaTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert +open GapCVP.OutputPolynomialCompositionClosure GapCVP.SourceCanonicalFixedWordTuringTM +open GapCVP.SourceIndexedClauseLookupTM GapCVP.SourceIndexedClauseSignTM +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryPhysicalRowBasisDivisionTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingTM +open GapCVP.SourcePreprocessingSemantics GapCVP.ClauseOffsetTM + +/-- GapCVP reduction support. -/ +structure PaperVariableArityShiftedTupleRankComputers where + /-- GapCVP reduction support. -/ + clause : SourcePhysicalLagrangeWordComputer + /-- GapCVP reduction support. -/ + tuple : SourcePhysicalLagrangeWordComputer + /-- GapCVP reduction support. -/ + variablePosition : SourcePhysicalLagrangeWordComputer + +private def paperShiftedTupleRetainedSource : + List Bool → List Bool := + paperPreprocessingFilteredFormulaWord ∘ + sourceExplicitAffineCellOriginalSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleRetainedSourceComputable : + BitTM + paperShiftedTupleRetainedSource := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + paperSourcePreprocessingFilteredFormulaWordComputable + +@[simp] private theorem paperVariableArityShiftedTupleRetainedSource_query + (row column : ℕ) (formula : ThreeCNF) : + paperShiftedTupleRetainedSource + (affineCellQuery row column + (encodeThreeCNF formula)) = + encodeThreeCNF (noTautClauses formula) := by + unfold paperShiftedTupleRetainedSource + rw [Function.comp_apply, + sourceExplicitAffineCellOriginalSource_query, + paperSourcePreprocessingFilteredFormulaWord_valid] + +private def paperVariableArityShiftedTupleClauseQuery + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) : List Bool := + ranks.clause.output input ++ + false :: paperShiftedTupleRetainedSource input + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleClauseQueryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperVariableArityShiftedTupleClauseQuery ranks) := by + have retained := GapCVP.TMComposition.computableInPolyTime + paperVariableArityShiftedTupleRetainedSourceComputable + (prependBitComputable false) + exact pointwiseAppendComputable ranks.clause.computer retained + +private def paperShiftedTupleOriginalClauseWord + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + sourceOriginalIndexedClauseOutput ∘ + paperVariableArityShiftedTupleClauseQuery ranks + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleOriginalClauseWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleOriginalClauseWord ranks) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityShiftedTupleClauseQueryComputable ranks) + sourceOriginalIndexedClauseComputable + +private theorem paperShiftedTupleOriginalClauseWord_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) : + paperShiftedTupleOriginalClauseWord ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + encodeThreeClause + ((noTautClauses formula).get + ⟨rank, hbound⟩) := by + unfold paperShiftedTupleOriginalClauseWord + paperVariableArityShiftedTupleClauseQuery + rw [Function.comp_apply, hrank, + paperVariableArityShiftedTupleRetainedSource_query] + exact sourceOriginalIndexedClauseOutput_valid + rank (noTautClauses formula) hbound + +/-- GapCVP reduction support. -/ +def paperShiftedTupleNormalizedArityUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + paperVariableArityClauseArityUnary ∘ + paperShiftedTupleOriginalClauseWord ranks + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleNormalizedArityUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleNormalizedArityUnary ranks) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityShiftedTupleOriginalClauseWordComputable ranks) + paperClauseArityUnaryComputable + +theorem paperVariableArityShiftedTupleNormalizedArityUnary_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) : + paperShiftedTupleNormalizedArityUnary ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length true := by + unfold paperShiftedTupleNormalizedArityUnary + rw [Function.comp_apply, + paperShiftedTupleOriginalClauseWord_query + ranks row column formula rank hbound hrank] + simpa only [List.append_nil] using + (paperVariableArityClauseArityUnary_valid + ((noTautClauses formula).get + ⟨rank, hbound⟩) []) + +/-- GapCVP reduction support. -/ +def paperShiftedTupleGuardedSourceWord + (marker selected : List Bool → List Bool) + (input : List Bool) : List Bool := + markerConditionalOutput selected [] (marker input ++ input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleGuardedSourceWordComputable + {marker selected : List Bool → List Bool} + (hmarker : BitTM marker) + (hselected : BitTM selected) : + BitTM + (paperShiftedTupleGuardedSourceWord marker selected) := by + have archived := pointwiseAppendComputable hmarker + (Turing.idComputableInPolyTime bitEncoding) + exact GapCVP.TMComposition.computableInPolyTime + archived (markerConditionalComputable hselected []) + +theorem paperShiftedTupleGuardedSourceWord_valid + (marker selected : List Bool → List Bool) + (input : List Bool) (bit : Bool) + (hmarker : marker input = [bit]) : + paperShiftedTupleGuardedSourceWord + marker selected input = + if bit then selected input else [] := by + unfold paperShiftedTupleGuardedSourceWord + rw [hmarker] + cases bit <;> rfl + +/-- GapCVP reduction support. -/ +def paperShiftedTupleConstantUnary + (value : ℕ) : List Bool → List Bool := + fun _ => List.replicate value true + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleConstantUnaryComputable + (value : ℕ) : + BitTM + (paperShiftedTupleConstantUnary value) := + sourceFixedWordComputable (List.replicate value true) + +private def paperShiftedTupleOriginalSignWord + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : List Bool → List Bool := + paperSourceClauseSignWord position ∘ + paperShiftedTupleOriginalClauseWord ranks + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleOriginalSignWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : + BitTM + (paperShiftedTupleOriginalSignWord ranks position) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityShiftedTupleOriginalClauseWordComputable ranks) + (paperSourceClauseSignWordComputable position) + +private def paperShiftedTupleOriginalSecondKeepBit + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + paperSourceClauseSecondKeepMarker ∘ + paperShiftedTupleOriginalClauseWord ranks + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleOriginalSecondKeepBitComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleOriginalSecondKeepBit ranks) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityShiftedTupleOriginalClauseWordComputable ranks) + paperSourceClauseSecondKeepMarkerComputable + +private def paperShiftedTupleSelectedSourceBit + (marker first second : List Bool → List Bool) : + List Bool → List Bool := + sourceFourFamilyBooleanOrOutput + (sourceFourFamilyBooleanAndOutput marker first) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput marker) second) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleSelectedSourceBitComputable + {marker first second : List Bool → List Bool} + (hmarker : BitTM marker) + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (paperShiftedTupleSelectedSourceBit + marker first second) := + sourceFourFamilyBooleanOrComputable + (fourFamilyBooleanAndComputable hmarker hfirst) + (fourFamilyBooleanAndComputable + (fourFamilyBooleanNotOutputComputable hmarker) hsecond) + +private theorem paperVariableArityShiftedTupleSelectedSourceBit_valid + (marker first second : List Bool → List Bool) + (input : List Bool) (selector firstBit secondBit : Bool) + (hselector : marker input = [selector]) + (hfirst : first input = [firstBit]) + (hsecond : second input = [secondBit]) : + paperShiftedTupleSelectedSourceBit + marker first second input = + [if selector then firstBit else secondBit] := by + have hnot := fourFamilyBooleanNotOutput_bit + marker input selector hselector + have hleft := fourFamilyBooleanAndOutput_bits + marker first input selector firstBit hselector hfirst + have hright := fourFamilyBooleanAndOutput_bits + (sourceFourFamilyBooleanNotOutput marker) second input + (!selector) secondBit hnot hsecond + unfold paperShiftedTupleSelectedSourceBit + have selected := fourFamilyBooleanOrOutput_bits + (sourceFourFamilyBooleanAndOutput marker first) + (sourceFourFamilyBooleanAndOutput + (sourceFourFamilyBooleanNotOutput marker) second) + input (selector && firstBit) ((!selector) && secondBit) + hleft hright + cases selector <;> simpa using selected + +private def paperShiftedTupleNormalizedSignWord + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : List Bool → List Bool := + if position.val = 0 then + paperShiftedTupleOriginalSignWord ranks 0 + else if position.val = 1 then + paperShiftedTupleSelectedSourceBit + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalSignWord ranks 1) + (paperShiftedTupleOriginalSignWord ranks 2) + else + paperShiftedTupleOriginalSignWord ranks 2 + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleNormalizedSignWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : + BitTM + (paperShiftedTupleNormalizedSignWord ranks position) := by + unfold paperShiftedTupleNormalizedSignWord + split + · exact paperVariableArityShiftedTupleOriginalSignWordComputable + ranks 0 + next => + split + · exact paperVariableArityShiftedTupleSelectedSourceBitComputable + (paperVariableArityShiftedTupleOriginalSecondKeepBitComputable ranks) + (paperVariableArityShiftedTupleOriginalSignWordComputable ranks 1) + (paperVariableArityShiftedTupleOriginalSignWordComputable ranks 2) + · exact paperVariableArityShiftedTupleOriginalSignWordComputable + ranks 2 + +private def paperShiftedTupleNormalizedPositionBit + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + (paperShiftedTupleConstantUnary position.val) + (paperShiftedTupleNormalizedArityUnary ranks) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleNormalizedPositionBitComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : + BitTM + (paperShiftedTupleNormalizedPositionBit ranks position) := + fourFamilyComputedUnaryLessBitComputable + (paperVariableArityShiftedTupleConstantUnaryComputable position.val) + (paperVariableArityShiftedTupleNormalizedArityUnaryComputable ranks) + +private def paperShiftedTupleRejectedPositionBit + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : List Bool → List Bool := + sourceFourFamilyBooleanAndOutput + (paperShiftedTupleNormalizedPositionBit ranks position) + (sourceFourFamilyBooleanNotOutput + (paperShiftedTupleNormalizedSignWord ranks position)) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleRejectedPositionBitComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : + BitTM + (paperShiftedTupleRejectedPositionBit ranks position) := + fourFamilyBooleanAndComputable + (paperVariableArityShiftedTupleNormalizedPositionBitComputable + ranks position) + (fourFamilyBooleanNotOutputComputable + (paperVariableArityShiftedTupleNormalizedSignWordComputable + ranks position)) + +private theorem paperVariableArityShiftedTupleRejectedPositionBit_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) + (input : List Bool) (present sign : Bool) + (hpresent : paperShiftedTupleNormalizedPositionBit + ranks position input = [present]) + (hsign : paperShiftedTupleNormalizedSignWord + ranks position input = [sign]) : + paperShiftedTupleRejectedPositionBit + ranks position input = [present && !sign] := by + unfold paperShiftedTupleRejectedPositionBit + exact fourFamilyBooleanAndOutput_bits + (paperShiftedTupleNormalizedPositionBit ranks position) + (sourceFourFamilyBooleanNotOutput + (paperShiftedTupleNormalizedSignWord ranks position)) + input present (!sign) hpresent + (fourFamilyBooleanNotOutput_bit + (paperShiftedTupleNormalizedSignWord ranks position) + input sign hsign) + +private def paperShiftedTupleRejectedWeightedUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : List Bool → List Bool := + paperShiftedTupleGuardedSourceWord + (paperShiftedTupleRejectedPositionBit ranks position) + (paperShiftedTupleConstantUnary (2 ^ position.val)) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleRejectedWeightedUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : + BitTM + (paperShiftedTupleRejectedWeightedUnary + ranks position) := + paperVariableArityShiftedTupleGuardedSourceWordComputable + (paperVariableArityShiftedTupleRejectedPositionBitComputable + ranks position) + (paperVariableArityShiftedTupleConstantUnaryComputable + (2 ^ position.val)) + +private theorem paperVariableArityShiftedTupleRejectedWeightedUnary_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) (input : List Bool) + (present sign : Bool) + (hpresent : paperShiftedTupleNormalizedPositionBit + ranks position input = [present]) + (hsign : paperShiftedTupleNormalizedSignWord + ranks position input = [sign]) : + paperShiftedTupleRejectedWeightedUnary + ranks position input = + List.replicate + (if present && !sign then 2 ^ position.val else 0) true := by + unfold paperShiftedTupleRejectedWeightedUnary + rw [paperShiftedTupleGuardedSourceWord_valid + (paperShiftedTupleRejectedPositionBit ranks position) + (paperShiftedTupleConstantUnary (2 ^ position.val)) + input (present && !sign) + (paperVariableArityShiftedTupleRejectedPositionBit_valid + ranks position input present sign hpresent hsign)] + cases present <;> cases sign <;> + simp [paperShiftedTupleConstantUnary] + +private def paperShiftedTupleRejectedRankUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + (fourFamilyComputedUnarySumOutput + (paperShiftedTupleRejectedWeightedUnary ranks 0) + (paperShiftedTupleRejectedWeightedUnary ranks 1)) + (paperShiftedTupleRejectedWeightedUnary ranks 2) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleRejectedRankUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleRejectedRankUnary ranks) := + fourFamilyComputedUnarySumComputable + (fourFamilyComputedUnarySumComputable + (paperVariableArityShiftedTupleRejectedWeightedUnaryComputable + ranks 0) + (paperVariableArityShiftedTupleRejectedWeightedUnaryComputable + ranks 1)) + (paperVariableArityShiftedTupleRejectedWeightedUnaryComputable + ranks 2) + +/-- GapCVP reduction support. -/ +def paperShiftedTupleRejectedNatural + (arity : ℕ) (sign : Fin 3 → Bool) : ℕ := + (if 0 < arity && !(sign 0) then 1 else 0) + + (if 1 < arity && !(sign 1) then 2 else 0) + + (if 2 < arity && !(sign 2) then 4 else 0) + +private theorem paperVariableArityShiftedTupleRejectedRankUnary_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) (arity : ℕ) (sign : Fin 3 → Bool) + (harity : paperShiftedTupleNormalizedArityUnary + ranks input = List.replicate arity true) + (hsign : ∀ position : Fin 3, + paperShiftedTupleNormalizedSignWord + ranks position input = [sign position]) : + paperShiftedTupleRejectedRankUnary ranks input = + List.replicate + (paperShiftedTupleRejectedNatural arity sign) true := by + have hpresent (position : Fin 3) : + paperShiftedTupleNormalizedPositionBit + ranks position input = [decide (position.val < arity)] := by + exact fourFamilyComputedUnaryLessBitOutput_valid + (paperShiftedTupleConstantUnary position.val) + (paperShiftedTupleNormalizedArityUnary ranks) + input position.val arity rfl harity + have hzero := paperVariableArityShiftedTupleRejectedWeightedUnary_valid + ranks 0 input (decide ((0 : Fin 3).val < arity)) + (sign 0) (hpresent 0) (hsign 0) + have hone := paperVariableArityShiftedTupleRejectedWeightedUnary_valid + ranks 1 input (decide ((1 : Fin 3).val < arity)) + (sign 1) (hpresent 1) (hsign 1) + have htwo := paperVariableArityShiftedTupleRejectedWeightedUnary_valid + ranks 2 input (decide ((2 : Fin 3).val < arity)) + (sign 2) (hpresent 2) (hsign 2) + have hfirst := fourFamilyComputedUnarySumOutput_valid + (paperShiftedTupleRejectedWeightedUnary ranks 0) + (paperShiftedTupleRejectedWeightedUnary ranks 1) + input + (if decide ((0 : Fin 3).val < arity) && !(sign 0) + then 2 ^ (0 : Fin 3).val else 0) + (if decide ((1 : Fin 3).val < arity) && !(sign 1) + then 2 ^ (1 : Fin 3).val else 0) + hzero hone + have hfull := fourFamilyComputedUnarySumOutput_valid + (fourFamilyComputedUnarySumOutput + (paperShiftedTupleRejectedWeightedUnary ranks 0) + (paperShiftedTupleRejectedWeightedUnary ranks 1)) + (paperShiftedTupleRejectedWeightedUnary ranks 2) + input + ((if decide ((0 : Fin 3).val < arity) && !(sign 0) + then 2 ^ (0 : Fin 3).val else 0) + + (if decide ((1 : Fin 3).val < arity) && !(sign 1) + then 2 ^ (1 : Fin 3).val else 0)) + (if decide ((2 : Fin 3).val < arity) && !(sign 2) + then 2 ^ (2 : Fin 3).val else 0) + hfirst htwo + simpa only [paperShiftedTupleRejectedRankUnary, Fin.isValue, paperShiftedTupleRejectedNatural, + Bool.and_eq_true, decide_eq_true_eq, Bool.not_eq_eq_eq_not, Bool.not_true, + Fin.coe_ofNat_eq_mod, Nat.zero_mod, + pow_zero, Nat.one_mod, pow_one, Nat.mod_succ, Nat.reducePow] using hfull + +private def paperVariableArityShiftedTupleBeforeRejectedBit + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + ranks.tuple.output + (paperShiftedTupleRejectedRankUnary ranks) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleBeforeRejectedBitComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperVariableArityShiftedTupleBeforeRejectedBit ranks) := + fourFamilyComputedUnaryLessBitComputable + ranks.tuple.computer + (paperVariableArityShiftedTupleRejectedRankUnaryComputable ranks) + +private def paperShiftedTupleSkipUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + sourceOriginalClauseBooleanUnaryOutput ∘ + sourceFourFamilyBooleanNotOutput + (paperVariableArityShiftedTupleBeforeRejectedBit ranks) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleSkipUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleSkipUnary ranks) := + GapCVP.TMComposition.computableInPolyTime + (fourFamilyBooleanNotOutputComputable + (paperVariableArityShiftedTupleBeforeRejectedBitComputable ranks)) + sourceOriginalClauseBooleanUnaryComputable + +private def paperShiftedTupleSatisfyingWordRankUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + ranks.tuple.output + (paperShiftedTupleSkipUnary ranks) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleSatisfyingWordRankUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleSatisfyingWordRankUnary ranks) := + fourFamilyComputedUnarySumComputable + ranks.tuple.computer + (paperVariableArityShiftedTupleSkipUnaryComputable ranks) + +private theorem paperVariableArityShiftedTupleSatisfyingWordRankUnary_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) (arity tuple : ℕ) (sign : Fin 3 → Bool) + (harity : paperShiftedTupleNormalizedArityUnary + ranks input = List.replicate arity true) + (hsign : ∀ position : Fin 3, + paperShiftedTupleNormalizedSignWord + ranks position input = [sign position]) + (htuple : ranks.tuple.output input = List.replicate tuple true) : + paperShiftedTupleSatisfyingWordRankUnary ranks input = + List.replicate + (tuple + + if tuple < paperShiftedTupleRejectedNatural arity sign + then 0 else 1) true := by + have rejected := paperVariableArityShiftedTupleRejectedRankUnary_valid + ranks input arity sign harity hsign + have comparison := fourFamilyComputedUnaryLessBitOutput_valid + ranks.tuple.output + (paperShiftedTupleRejectedRankUnary ranks) + input tuple + (paperShiftedTupleRejectedNatural arity sign) + htuple rejected + have inverted := fourFamilyBooleanNotOutput_bit + (paperVariableArityShiftedTupleBeforeRejectedBit ranks) + input + (decide + (tuple < paperShiftedTupleRejectedNatural arity sign)) + comparison + have skip : + paperShiftedTupleSkipUnary ranks input = + List.replicate + (if tuple < paperShiftedTupleRejectedNatural arity sign + then 0 else 1) true := by + unfold paperShiftedTupleSkipUnary + rw [Function.comp_apply, inverted, + sourceOriginalClauseBooleanUnaryOutput_bit] + by_cases hless : + tuple < paperShiftedTupleRejectedNatural arity sign + · simp only [hless, decide_true, Bool.not_true, Bool.false_eq_true, ↓reduceIte, + List.replicate_zero] + · simp only [hless, decide_false, Bool.not_false, ↓reduceIte, List.replicate_one] + exact fourFamilyComputedUnarySumOutput_valid + ranks.tuple.output + (paperShiftedTupleSkipUnary ranks) + input tuple + (if tuple < paperShiftedTupleRejectedNatural arity sign + then 0 else 1) htuple skip + +private def paperShiftedTupleLocalPowerNumeratorUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + (fourFamilyComputedUnaryProductOutput + ranks.variablePosition.output ranks.variablePosition.output) + (fourFamilyComputedUnarySumOutput + ranks.variablePosition.output + (paperShiftedTupleConstantUnary 2)) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleLocalPowerNumeratorUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleLocalPowerNumeratorUnary ranks) := + fourFamilyComputedUnarySumComputable + (fourFamilyComputedUnaryProductComputable + ranks.variablePosition.computer ranks.variablePosition.computer) + (fourFamilyComputedUnarySumComputable + ranks.variablePosition.computer + (paperVariableArityShiftedTupleConstantUnaryComputable 2)) + +private theorem paperVariableArityShiftedTupleLocalPowerNumeratorUnary_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) (position : ℕ) + (hposition : ranks.variablePosition.output input = + List.replicate position true) : + paperShiftedTupleLocalPowerNumeratorUnary ranks input = + List.replicate (position * position + (position + 2)) true := by + have product := fourFamilyComputedUnaryProductOutput_valid + ranks.variablePosition.output ranks.variablePosition.output + input position position hposition hposition + have offset := fourFamilyComputedUnarySumOutput_valid + ranks.variablePosition.output + (paperShiftedTupleConstantUnary 2) + input position 2 hposition rfl + exact fourFamilyComputedUnarySumOutput_valid + (fourFamilyComputedUnaryProductOutput + ranks.variablePosition.output ranks.variablePosition.output) + (fourFamilyComputedUnarySumOutput + ranks.variablePosition.output + (paperShiftedTupleConstantUnary 2)) + input (position * position) (position + 2) product offset + +private def paperShiftedTupleLocalBinaryPowerUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + (paperShiftedTupleLocalPowerNumeratorUnary ranks) + (paperShiftedTupleConstantUnary 2) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleLocalBinaryPowerUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleLocalBinaryPowerUnary ranks) := + sourcePhysicalComputedUnaryQuotientComputable + (paperVariableArityShiftedTupleLocalPowerNumeratorUnaryComputable ranks) + (paperVariableArityShiftedTupleConstantUnaryComputable 2) + +private theorem paperVariableArityShiftedTupleBoundedBinaryPower + (position : ℕ) (hposition : position < 3) : + (position * position + (position + 2)) / 2 = 2 ^ position := by + interval_cases position <;> norm_num + +private theorem paperVariableArityShiftedTupleLocalBinaryPowerUnary_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) (position : ℕ) + (hposition : position < 3) + (hrank : ranks.variablePosition.output input = + List.replicate position true) : + paperShiftedTupleLocalBinaryPowerUnary ranks input = + List.replicate (2 ^ position) true := by + unfold paperShiftedTupleLocalBinaryPowerUnary + rw [sourcePhysicalComputedUnaryQuotient_valid + (paperShiftedTupleLocalPowerNumeratorUnary ranks) + (paperShiftedTupleConstantUnary 2) + input (position * position + (position + 2)) 2 (by norm_num) + (paperVariableArityShiftedTupleLocalPowerNumeratorUnary_valid + ranks input position hrank) rfl, + paperVariableArityShiftedTupleBoundedBinaryPower position hposition] + +private def paperVariableArityShiftedTupleSatisfyingPositionQuotientUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + (paperShiftedTupleSatisfyingWordRankUnary ranks) + (paperShiftedTupleLocalBinaryPowerUnary ranks) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleSatisfyingPositionQuotientUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperVariableArityShiftedTupleSatisfyingPositionQuotientUnary ranks) := + sourcePhysicalComputedUnaryQuotientComputable + (paperVariableArityShiftedTupleSatisfyingWordRankUnaryComputable ranks) + (paperVariableArityShiftedTupleLocalBinaryPowerUnaryComputable ranks) + +private def paperVariableArityShiftedTupleSatisfyingPositionDigitUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + (paperVariableArityShiftedTupleSatisfyingPositionQuotientUnary ranks) + (paperShiftedTupleConstantUnary 2) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleSatisfyingPositionDigitUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperVariableArityShiftedTupleSatisfyingPositionDigitUnary ranks) := + sourcePhysicalComputedUnaryRemainderComputable + (paperVariableArityShiftedTupleSatisfyingPositionQuotientUnaryComputable + ranks) + (paperVariableArityShiftedTupleConstantUnaryComputable 2) + +/-- GapCVP reduction support. -/ +def paperShiftedTupleBetaBit + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + fourFamilyComputedUnaryLessBitOutput + (paperShiftedTupleConstantUnary 0) + (paperVariableArityShiftedTupleSatisfyingPositionDigitUnary ranks) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityShiftedTupleBetaBitComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleBetaBit ranks) := + fourFamilyComputedUnaryLessBitComputable + (paperVariableArityShiftedTupleConstantUnaryComputable 0) + (paperVariableArityShiftedTupleSatisfyingPositionDigitUnaryComputable + ranks) + +private theorem paperVariableArityShiftedTupleBinaryDigitComparison + (value position : ℕ) : + decide (0 < value / 2 ^ position % 2) = value.testBit position := by + rw [Nat.testBit_eq_decide_div_mod_eq] + apply Bool.decide_congr + have bound : value / 2 ^ position % 2 < 2 := + Nat.mod_lt _ (by norm_num) + omega + +theorem paperVariableArityShiftedTupleBetaBit_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) (arity tuple position : ℕ) + (sign : Fin 3 → Bool) + (hposition : position < 3) + (harity : paperShiftedTupleNormalizedArityUnary + ranks input = List.replicate arity true) + (hsign : ∀ slot : Fin 3, + paperShiftedTupleNormalizedSignWord + ranks slot input = [sign slot]) + (htuple : ranks.tuple.output input = List.replicate tuple true) + (hlocal : ranks.variablePosition.output input = + List.replicate position true) : + paperShiftedTupleBetaBit ranks input = + [(tuple + + if tuple < paperShiftedTupleRejectedNatural arity sign + then 0 else 1).testBit position] := by + let assignment := tuple + + if tuple < paperShiftedTupleRejectedNatural arity sign + then 0 else 1 + have satisfying := paperVariableArityShiftedTupleSatisfyingWordRankUnary_valid + ranks input arity tuple sign harity hsign htuple + have power := paperVariableArityShiftedTupleLocalBinaryPowerUnary_valid + ranks input position hposition hlocal + have quotient := sourcePhysicalComputedUnaryQuotient_valid + (paperShiftedTupleSatisfyingWordRankUnary ranks) + (paperShiftedTupleLocalBinaryPowerUnary ranks) + input assignment (2 ^ position) (by positivity) satisfying power + have digit := sourcePhysicalComputedUnaryRemainder_valid + (paperVariableArityShiftedTupleSatisfyingPositionQuotientUnary ranks) + (paperShiftedTupleConstantUnary 2) + input (assignment / 2 ^ position) 2 (by norm_num) + quotient rfl + have beta := fourFamilyComputedUnaryLessBitOutput_valid + (paperShiftedTupleConstantUnary 0) + (paperVariableArityShiftedTupleSatisfyingPositionDigitUnary ranks) + input 0 (assignment / 2 ^ position % 2) rfl digit + change paperShiftedTupleBetaBit ranks input = + [assignment.testBit position] + exact beta.trans (congrArg (fun bit : Bool => [bit]) + (paperVariableArityShiftedTupleBinaryDigitComparison + assignment position)) + +end ShiftedTupleBetaTM + +namespace SatisfyingWordSourceRankSemantics + +open GapCVP.SourceOrder GapCVP.ShiftedTupleBetaTM + +/-- GapCVP reduction support. -/ +def paperVariableArityBoundedSourceSign + (arity : ℕ) (harity : arity ≤ 3) + (sign : Fin 3 → Bool) : Fin arity → Bool := + fun position => + sign ⟨position.val, Nat.lt_of_lt_of_le position.isLt harity⟩ + +private theorem paperVariableArityShiftedTupleRejectedNatural_lt + (arity : ℕ) (harity : arity ≤ 3) + (sign : Fin 3 → Bool) : + paperShiftedTupleRejectedNatural arity sign < 2 ^ arity := by + interval_cases arity <;> + cases hzero : sign 0 <;> + cases hone : sign 1 <;> + cases htwo : sign 2 <;> + simp [paperShiftedTupleRejectedNatural, + hzero, hone, htwo] + +private def paperVariableArityShiftedTupleRejectedSourceWord + (arity : ℕ) (harity : arity ≤ 3) + (sign : Fin 3 → Bool) : Fin (2 ^ arity) := + ⟨paperShiftedTupleRejectedNatural arity sign, + paperVariableArityShiftedTupleRejectedNatural_lt arity harity sign⟩ + +private theorem paperVariableArityRejectedWord_eq_shiftedTupleRejectedSourceWord + (arity : ℕ) (harity : arity ≤ 3) + (sign : Fin 3 → Bool) : + paperVariableArityRejectedWord arity + (paperVariableArityBoundedSourceSign arity harity sign) = + paperVariableArityShiftedTupleRejectedSourceWord + arity harity sign := by + apply (paperVariableArityBooleanWordOrder arity).injective + rw [show + paperVariableArityBooleanWordOrder arity + (paperVariableArityRejectedWord arity + (paperVariableArityBoundedSourceSign arity harity sign)) = + (fun position : Fin arity => + !(paperVariableArityBoundedSourceSign + arity harity sign position)) by + simp only [paperVariableArityRejectedWord, Equiv.apply_symm_apply]] + change + (fun position : Fin arity => + !(paperVariableArityBoundedSourceSign + arity harity sign position)) = + (fun position : Fin arity => + (paperVariableArityShiftedTupleRejectedSourceWord + arity harity sign).val.testBit position.val) + funext position + interval_cases arity <;> + fin_cases position <;> + cases hzero : sign 0 <;> + cases hone : sign 1 <;> + cases htwo : sign 2 <;> + simp only [paperVariableArityBoundedSourceSign, + paperVariableArityShiftedTupleRejectedSourceWord, + paperShiftedTupleRejectedNatural, + hzero, hone, htwo, Fin.mk_one, Fin.reduceFinMk, + Fin.isValue, Nat.reducePow, Bool.not_eq_eq_eq_not] <;> + decide + +private theorem paperVariableArityShiftedTupleRejectedNatural_eq_rejectedWord_val + (arity : ℕ) (harity : arity ≤ 3) + (sign : Fin 3 → Bool) : + paperShiftedTupleRejectedNatural arity sign = + (paperVariableArityRejectedWord arity + (paperVariableArityBoundedSourceSign + arity harity sign)).val := by + rw [paperVariableArityRejectedWord_eq_shiftedTupleRejectedSourceWord] + rfl + +private theorem paperVariableAritySuccAbove_val + {count : ℕ} (removed : Fin (count + 1)) + (tuple : Fin count) : + (removed.succAbove tuple).val = + tuple.val + if tuple.val < removed.val then 0 else 1 := by + by_cases h : tuple.val < removed.val <;> + simp [Fin.succAbove, Fin.lt_def, h] + +private theorem paperVariableAritySatisfyingWordOrder_apply_eq_testBit + (arity : ℕ) (sign : Fin arity → Bool) + (tuple : Fin (2 ^ arity - 1)) + (position : Fin arity) : + (paperSatisfyingWordOrder arity sign tuple).val position = + (tuple.val + + if tuple.val < (paperVariableArityRejectedWord arity sign).val + then 0 else 1).testBit position.val := by + have positive : 0 < 2 ^ arity := by positivity + have cardinality : 2 ^ arity - 1 + 1 = 2 ^ arity := by omega + let correction : + Fin (2 ^ arity - 1 + 1) ≃ Fin (2 ^ arity) := + finCongr cardinality + let removed : Fin (2 ^ arity - 1 + 1) := + correction.symm (paperVariableArityRejectedWord arity sign) + change + (correction (removed.succAbove tuple)).val.testBit position.val = _ + change + (removed.succAbove tuple).val.testBit position.val = _ + rw [paperVariableAritySuccAbove_val] + have hremoved : + removed.val = (paperVariableArityRejectedWord arity sign).val := by + rfl + rw [hremoved] + +theorem paperVariableAritySatisfyingWordOrder_apply_eq_shiftedTupleBetaBit + (arity : ℕ) (harity : arity ≤ 3) + (sign : Fin 3 → Bool) + (tuple : Fin (2 ^ arity - 1)) + (position : Fin arity) : + (paperSatisfyingWordOrder arity + (paperVariableArityBoundedSourceSign + arity harity sign) tuple).val position = + (tuple.val + + if tuple.val < + paperShiftedTupleRejectedNatural arity sign + then 0 else 1).testBit position.val := by + rw [paperVariableAritySatisfyingWordOrder_apply_eq_testBit, + ← paperVariableArityShiftedTupleRejectedNatural_eq_rejectedWord_val + arity harity sign] + +end SatisfyingWordSourceRankSemantics + +namespace PhysicalInterpolationRowFamilyProjection + +open scoped BigOperators + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.FormulaBridge GapCVP.ClauseOffsetTM +open GapCVP.ShiftedTupleTM GapCVP.SourceOrder GapCVP.CanonicalOffsetIdentity +open GapCVP.PhysicalRowOrderProjection GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalRefinementRowProjection +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalRowCountMachine + +/-- GapCVP reduction support. -/ +abbrev physicalInterpolationMomentBudget + (formula : ThreeCNF) : ℕ := + explicitMomentBudget (encodeThreeCNF formula).length + (srcFormula formula) + +private abbrev physicalInterpolationMomentCount + (formula : ThreeCNF) : ℕ := + physicalInterpolationMomentBudget formula + 1 + +private abbrev physicalOrdinaryInterpolationTagCount + (formula : ThreeCNF) : ℕ := + (1 + paperVariableArityLocalTagCount formula) * + physicalInterpolationMomentCount formula + +/-- GapCVP reduction support. -/ +abbrev physicalShiftedInterpolationTagCount + (formula : ThreeCNF) : ℕ := + paperShiftedFamilyTagCount formula + (physicalInterpolationMomentBudget formula) + +/-- GapCVP reduction support. -/ +abbrev physicalInterpolationBlockWidth + (formula : ThreeCNF) : ℕ := + physGridCard formula * + physDegree formula + +private def physicalOrdinaryDependentFamilyIndex + (formula : ThreeCNF) + (tag : Fin + (physicalOrdinaryInterpolationTagCount formula)) : + Fin (paperExplicitFamilyTagCount + (encodeThreeCNF formula).length formula) := by + change Fin + (1 + ((srcFormula formula).clauses.length + + (physicalOrdinaryInterpolationTagCount formula + + physicalShiftedInterpolationTagCount formula))) + exact Fin.natAdd 1 + (Fin.natAdd (srcFormula formula).clauses.length + (Fin.castAdd + (physicalShiftedInterpolationTagCount formula) + tag)) + +/-- GapCVP reduction support. -/ +def physicalShiftedDependentFamilyIndex + (formula : ThreeCNF) + (tag : Fin + (physicalShiftedInterpolationTagCount formula)) : + Fin (paperExplicitFamilyTagCount + (encodeThreeCNF formula).length formula) := by + change Fin + (1 + ((srcFormula formula).clauses.length + + (physicalOrdinaryInterpolationTagCount formula + + physicalShiftedInterpolationTagCount formula))) + exact Fin.natAdd 1 + (Fin.natAdd (srcFormula formula).clauses.length + (Fin.natAdd + (physicalOrdinaryInterpolationTagCount formula) + tag)) + +@[simp] private theorem paperVariableArityPhysicalOrdinaryDependentFamilyIndex_val + (formula : ThreeCNF) + (tag : Fin + (physicalOrdinaryInterpolationTagCount formula)) : + (physicalOrdinaryDependentFamilyIndex + formula tag).val = + 1 + (srcFormula formula).clauses.length + + tag.val := by + change + 1 + ((srcFormula formula).clauses.length + + tag.val) = _ + omega + +@[simp] private theorem paperVariableArityPhysicalShiftedDependentFamilyIndex_val + (formula : ThreeCNF) + (tag : Fin + (physicalShiftedInterpolationTagCount formula)) : + (physicalShiftedDependentFamilyIndex + formula tag).val = + 1 + (srcFormula formula).clauses.length + + (physicalOrdinaryInterpolationTagCount formula + + tag.val) := by + change + 1 + ((srcFormula formula).clauses.length + + (physicalOrdinaryInterpolationTagCount formula + + tag.val)) = _ + omega + +private theorem paperVariableArityPhysicalOrdinaryDependentFamilyWordOrder + (formula : ThreeCNF) + (tag : Fin + (physicalOrdinaryInterpolationTagCount formula)) : + paperExplicitFamilyWordOrder + (encodeThreeCNF formula).length formula + (physicalOrdinaryDependentFamilyIndex + formula tag) = + .inr (.inr (.inl + (paperOrdinaryFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + tag))) := by + change + (finSumFinEquiv.symm.trans + (Equiv.sumCongr finOneEquiv _)) + (Fin.natAdd 1 + (Fin.natAdd (srcFormula formula).clauses.length + (Fin.castAdd + (physicalShiftedInterpolationTagCount formula) + tag))) = _ + simp only [Equiv.trans_apply, + finSumFinEquiv_symm_apply_natAdd, + finSumFinEquiv_symm_apply_castAdd, + Equiv.sumCongr_apply, Sum.map_inr, Sum.map_inl] + +theorem paperVariableArityPhysicalShiftedDependentFamilyWordOrder + (formula : ThreeCNF) + (tag : Fin + (physicalShiftedInterpolationTagCount formula)) : + paperExplicitFamilyWordOrder + (encodeThreeCNF formula).length formula + (physicalShiftedDependentFamilyIndex + formula tag) = + .inr (.inr (.inr + (paperShiftedFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + tag))) := by + change + (finSumFinEquiv.symm.trans + (Equiv.sumCongr finOneEquiv _)) + (Fin.natAdd 1 + (Fin.natAdd (srcFormula formula).clauses.length + (Fin.natAdd + (physicalOrdinaryInterpolationTagCount formula) + tag))) = _ + simp only [Equiv.trans_apply, + finSumFinEquiv_symm_apply_natAdd, + Equiv.sumCongr_apply, Sum.map_inr] + +private theorem paperVariableArityPhysicalOrdinaryDependentFamilyBlockCount + (formula : ThreeCNF) + (tag : Fin + (physicalOrdinaryInterpolationTagCount formula)) : + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (physicalOrdinaryDependentFamilyIndex + formula tag) = + physicalInterpolationBlockWidth formula := by + unfold paperExplicitBinaryFamilyBlockCount + rw [paperVariableArityPhysicalOrdinaryDependentFamilyWordOrder] + change + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) * + physDegree formula = _ + rw [physicalRefinementGridCard_eq] + +theorem paperVariableArityPhysicalShiftedDependentFamilyBlockCount + (formula : ThreeCNF) + (tag : Fin + (physicalShiftedInterpolationTagCount formula)) : + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (physicalShiftedDependentFamilyIndex + formula tag) = + physicalInterpolationBlockWidth formula := by + unfold paperExplicitBinaryFamilyBlockCount + rw [paperVariableArityPhysicalShiftedDependentFamilyWordOrder] + change + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) * + physDegree formula = _ + rw [physicalRefinementGridCard_eq] + +private theorem paperVariableArityPhysicalInterpolationRefinementPrefix + (formula : ThreeCNF) + (hbound : + 1 + (srcFormula formula).clauses.length ≤ + paperExplicitFamilyTagCount + (encodeThreeCNF formula).length formula) : + (∑ index : Fin + (1 + (srcFormula formula).clauses.length), + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (Fin.castLE hbound index)) = + physicalFormulaRefinementBoundary formula := by + rw [Fin.sum_univ_add, Fin.sum_univ_one] + have first : + (Fin.castLE hbound + (Fin.castAdd + (srcFormula formula).clauses.length + (0 : Fin 1))) = + (⟨0, physicalFamilyTagCount_pos + (encodeThreeCNF formula).length formula⟩ : + Fin (paperExplicitFamilyTagCount + (encodeThreeCNF formula).length formula)) := by + apply Fin.ext + rfl + rw [first, physicalFirstFamilyBlockCount, + physicalRefinementGridCard_eq] + have blocks : + (∑ index : Fin + (srcFormula formula).clauses.length, + paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + (Fin.castLE hbound (Fin.natAdd 1 index))) = + ∑ _index : Fin + (srcFormula formula).clauses.length, + physicalRefinementBlockWidth formula := by + apply Finset.sum_congr rfl + intro index _ + have selected : + (Fin.castLE hbound (Fin.natAdd 1 index)) = + physicalRefinementFamilyIndex + (encodeThreeCNF formula).length formula index := by + apply Fin.ext + rw [paperVariableArityPhysicalRefinementFamilyIndex_val] + rfl + rw [selected, + physicalRefinementFamilySourceBlockCount] + rw [blocks, paperVariableAritySourceFormula_clauses_length] + simp only [physicalRefinementBlockWidth, Nat.mul_assoc, Finset.sum_const, Finset.card_univ, + Fintype.card_fin, smul_eq_mul, + physicalFormulaRefinementBoundary, physicalFormulaGlobalBoundary] + +private theorem paperVariableArityPhysicalInterpolationOrdinaryBoundary_eq + (formula : ThreeCNF) : + physicalFormulaOrdinaryBoundary formula = + physicalFormulaRefinementBoundary formula + + physicalOrdinaryInterpolationTagCount formula * + physicalInterpolationBlockWidth formula := by + change + physicalFormulaRefinementBoundary formula + + (1 + sourceClauseWeightSum + (noTautClauses formula)) * + physicalFormulaMomentCount formula * + physGridCard formula * + physDegree formula = _ + rw [sourceClauseWeightSum_eq_localTagCount] + change + physicalFormulaRefinementBoundary formula + + (1 + paperVariableArityLocalTagCount formula) * + physicalInterpolationMomentCount formula * + physGridCard formula * + physDegree formula = + physicalFormulaRefinementBoundary formula + + ((1 + paperVariableArityLocalTagCount formula) * + physicalInterpolationMomentCount formula) * + (physGridCard formula * + physDegree formula) + ring + +theorem paperVariableArityPhysicalInterpolationRowCount_eq + (formula : ThreeCNF) : + paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula = + physicalFormulaOrdinaryBoundary formula + + physicalShiftedInterpolationTagCount formula * + physicalInterpolationBlockWidth formula := by + rw [paperVariableArityExplicitBinaryRowWordCount_eq_fourFamily] + change + physicalFormulaOrdinaryBoundary formula + + paperShiftedSourceClauseWeightSum + (noTautClauses formula) * + physicalInterpolationMomentCount formula * + physGridCard formula * + physDegree formula = + physicalFormulaOrdinaryBoundary formula + + paperShiftedFamilyTagCount formula + (physicalInterpolationMomentBudget formula) * + (physGridCard formula * + physDegree formula) + rw [paperVariableArityShiftedFamilyTagCount_eq_sourceWeight] + change + physicalFormulaOrdinaryBoundary formula + + physicalFormulaShiftedTupleCount formula * + physicalInterpolationMomentCount formula * + physGridCard formula * + physDegree formula = + physicalFormulaOrdinaryBoundary formula + + (physicalFormulaShiftedTupleCount formula * + physicalInterpolationMomentCount formula) * + (physGridCard formula * + physDegree formula) + ring + +private theorem paperVariableArityPhysicalOrdinaryDependentFamilyPrefix + (formula : ThreeCNF) + (tag : Fin + (physicalOrdinaryInterpolationTagCount formula)) : + physicalSigmaPrefix + (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula) + (physicalOrdinaryDependentFamilyIndex + formula tag) = + physicalFormulaRefinementBoundary formula + + tag.val * + physicalInterpolationBlockWidth formula := by + let count := (srcFormula formula).clauses.length + let familyCount := paperExplicitFamilyTagCount + (encodeThreeCNF formula).length formula + let blockCount := paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + let width := physicalInterpolationBlockWidth formula + have hstrict : 1 + count + tag.val < familyCount := by + have bounded := + (physicalOrdinaryDependentFamilyIndex + formula tag).isLt + rw [paperVariableArityPhysicalOrdinaryDependentFamilyIndex_val] + at bounded + simpa only [count, familyCount] using bounded + have hwhole : 1 + count + tag.val ≤ familyCount := hstrict.le + have hfirst : 1 + count ≤ familyCount := by omega + let candidate : Fin familyCount := + ⟨1 + count + tag.val, hstrict⟩ + have hcandidate : + physicalOrdinaryDependentFamilyIndex + formula tag = candidate := by + apply Fin.ext + rw [paperVariableArityPhysicalOrdinaryDependentFamilyIndex_val] + rw [hcandidate] + unfold physicalSigmaPrefix + change + (∑ index : Fin (1 + count + tag.val), + blockCount (Fin.castLE hwhole index)) = + physicalFormulaRefinementBoundary formula + + tag.val * width + rw [Fin.sum_univ_add] + have refinement : + (∑ index : Fin (1 + count), + blockCount (Fin.castLE hwhole + (Fin.castAdd tag.val index))) = + physicalFormulaRefinementBoundary formula := by + have original := + paperVariableArityPhysicalInterpolationRefinementPrefix + formula hfirst + calc + (∑ index : Fin (1 + count), + blockCount (Fin.castLE hwhole + (Fin.castAdd tag.val index))) = + ∑ index : Fin (1 + count), + blockCount (Fin.castLE hfirst index) := by + apply Finset.sum_congr rfl + intro index _ + congr 1 + _ = physicalFormulaRefinementBoundary formula := + original + have ordinary : + (∑ index : Fin tag.val, + blockCount (Fin.castLE hwhole + (Fin.natAdd (1 + count) index))) = + ∑ _index : Fin tag.val, width := by + apply Finset.sum_congr rfl + intro index _ + let selected : Fin + (physicalOrdinaryInterpolationTagCount formula) := + ⟨index.val, Nat.lt_trans index.isLt tag.isLt⟩ + have heq : + Fin.castLE hwhole (Fin.natAdd (1 + count) index) = + physicalOrdinaryDependentFamilyIndex + formula selected := by + apply Fin.ext + rw [paperVariableArityPhysicalOrdinaryDependentFamilyIndex_val] + change 1 + count + index.val = + 1 + count + selected.val + rfl + rw [heq] + exact paperVariableArityPhysicalOrdinaryDependentFamilyBlockCount + formula selected + rw [refinement, ordinary] + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, smul_eq_mul] + +theorem paperVariableArityPhysicalShiftedDependentFamilyPrefix + (formula : ThreeCNF) + (tag : Fin + (physicalShiftedInterpolationTagCount formula)) : + physicalSigmaPrefix + (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula) + (physicalShiftedDependentFamilyIndex + formula tag) = + physicalFormulaOrdinaryBoundary formula + + tag.val * + physicalInterpolationBlockWidth formula := by + let count := (srcFormula formula).clauses.length + let ordinaryCount := + physicalOrdinaryInterpolationTagCount formula + let familyCount := paperExplicitFamilyTagCount + (encodeThreeCNF formula).length formula + let blockCount := paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula + let width := physicalInterpolationBlockWidth formula + have hstrict : + 1 + count + ordinaryCount + tag.val < familyCount := by + have bounded := + (physicalShiftedDependentFamilyIndex + formula tag).isLt + rw [paperVariableArityPhysicalShiftedDependentFamilyIndex_val] + at bounded + simp only [count, ordinaryCount, familyCount] at bounded ⊢ + omega + have hwhole : + 1 + count + ordinaryCount + tag.val ≤ familyCount := hstrict.le + have hbefore : 1 + count + ordinaryCount ≤ familyCount := by omega + have hfirst : 1 + count ≤ familyCount := by omega + let candidate : Fin familyCount := + ⟨1 + count + ordinaryCount + tag.val, hstrict⟩ + have hcandidate : + physicalShiftedDependentFamilyIndex + formula tag = candidate := by + apply Fin.ext + rw [paperVariableArityPhysicalShiftedDependentFamilyIndex_val] + dsimp [candidate, count, ordinaryCount] + omega + rw [hcandidate] + unfold physicalSigmaPrefix + change + (∑ index : Fin (1 + count + ordinaryCount + tag.val), + blockCount (Fin.castLE hwhole index)) = + physicalFormulaOrdinaryBoundary formula + + tag.val * width + rw [Fin.sum_univ_add] + have before : + (∑ index : Fin (1 + count + ordinaryCount), + blockCount (Fin.castLE hwhole + (Fin.castAdd tag.val index))) = + physicalFormulaOrdinaryBoundary formula := by + have reduced : + (∑ index : Fin (1 + count + ordinaryCount), + blockCount (Fin.castLE hbefore index)) = + physicalFormulaOrdinaryBoundary formula := by + rw [Fin.sum_univ_add] + have refinement : + (∑ index : Fin (1 + count), + blockCount (Fin.castLE hbefore + (Fin.castAdd ordinaryCount index))) = + physicalFormulaRefinementBoundary formula := by + calc + (∑ index : Fin (1 + count), + blockCount (Fin.castLE hbefore + (Fin.castAdd ordinaryCount index))) = + ∑ index : Fin (1 + count), + blockCount (Fin.castLE hfirst index) := by + apply Finset.sum_congr rfl + intro index _ + congr 1 + _ = physicalFormulaRefinementBoundary formula := + paperVariableArityPhysicalInterpolationRefinementPrefix + formula hfirst + have ordinary : + (∑ index : Fin ordinaryCount, + blockCount (Fin.castLE hbefore + (Fin.natAdd (1 + count) index))) = + ∑ _index : Fin ordinaryCount, width := by + apply Finset.sum_congr rfl + intro index _ + have selected : + Fin.castLE hbefore (Fin.natAdd (1 + count) index) = + physicalOrdinaryDependentFamilyIndex + formula index := by + apply Fin.ext + rw [paperVariableArityPhysicalOrdinaryDependentFamilyIndex_val] + change 1 + count + index.val = 1 + count + index.val + rfl + rw [selected] + exact paperVariableArityPhysicalOrdinaryDependentFamilyBlockCount + formula index + rw [refinement, ordinary] + rw [paperVariableArityPhysicalInterpolationOrdinaryBoundary_eq] + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, smul_eq_mul, + Nat.add_left_cancel_iff] + rfl + calc + (∑ index : Fin (1 + count + ordinaryCount), + blockCount (Fin.castLE hwhole + (Fin.castAdd tag.val index))) = + ∑ index : Fin (1 + count + ordinaryCount), + blockCount (Fin.castLE hbefore index) := by + apply Finset.sum_congr rfl + intro index _ + congr 1 + _ = physicalFormulaOrdinaryBoundary formula := + reduced + have shifted : + (∑ index : Fin tag.val, + blockCount (Fin.castLE hwhole + (Fin.natAdd (1 + count + ordinaryCount) index))) = + ∑ _index : Fin tag.val, width := by + apply Finset.sum_congr rfl + intro index _ + let selected : Fin + (physicalShiftedInterpolationTagCount formula) := + ⟨index.val, Nat.lt_trans index.isLt tag.isLt⟩ + have heq : + Fin.castLE hwhole + (Fin.natAdd (1 + count + ordinaryCount) index) = + physicalShiftedDependentFamilyIndex + formula selected := by + apply Fin.ext + rw [paperVariableArityPhysicalShiftedDependentFamilyIndex_val] + dsimp [count, ordinaryCount, selected] + omega + rw [heq] + exact paperVariableArityPhysicalShiftedDependentFamilyBlockCount + formula selected + rw [before, shifted] + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, smul_eq_mul] + +end PhysicalInterpolationRowFamilyProjection + +namespace PhysicalOrdinaryInterpolationRowTagCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationRowFamilyProjection GapCVP.PhysicalRefinementRowProjection +open GapCVP.PhysicalRowOrderProjection GapCVP.SourceOrder + +private theorem paperVariableArityPhysicalOrdinaryFamilySourceTypeWordRank + (formula : ThreeCNF) + (momentBudget : ℕ) + (tag : Fin + ((1 + paperVariableArityLocalTagCount formula) * + (momentBudget + 1))) : + ((sourceTypeWordOrder formula).symm + ((paperOrdinaryFamilyWordOrder formula + momentBudget tag).1)).val = tag.val / (momentBudget + 1) := by + simp only [paperOrdinaryFamilyWordOrder, finProdFinEquiv, Equiv.symm_mk, Equiv.trans_apply, + Equiv.coe_fn_mk, + Equiv.prodCongr_apply, Equiv.coe_refl, Prod.map_apply, id_eq, Equiv.symm_apply_apply, + Fin.coe_divNat] + +private theorem paperVariableArityPhysicalOrdinarySourceInterpolationBlockWidth_pos + (formula : ThreeCNF) : + 0 < physicalInterpolationBlockWidth formula := + Nat.mul_pos + (physicalRefinementGridCard_pos formula) + (physicalRefinementDegree_pos formula) + +private def physicalOrdinarySourceRowFamilyCoordinate + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + Fin (physicalOrdinaryInterpolationTagCount formula) := by + refine + ⟨(row.val - physicalFormulaRefinementBoundary formula) / + physicalInterpolationBlockWidth formula, ?_⟩ + apply (Nat.div_lt_iff_lt_mul + (paperVariableArityPhysicalOrdinarySourceInterpolationBlockWidth_pos + formula)).mpr + rw [paperVariableArityPhysicalInterpolationOrdinaryBoundary_eq] + at inOrdinary + omega + +private theorem paperVariableArityPhysicalOrdinarySourceRowDecodedFamilyIndex + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row = + physicalOrdinaryDependentFamilyIndex formula + (physicalOrdinarySourceRowFamilyCoordinate + formula row inOrdinary) := by + apply (paperVariableArityPhysicalSigmaFamilyIndex_eq_iff + (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula) row _).mpr + rw [paperVariableArityPhysicalOrdinaryDependentFamilyPrefix, + paperVariableArityPhysicalOrdinaryDependentFamilyBlockCount] + let width := physicalInterpolationBlockWidth formula + let offset := row.val - physicalFormulaRefinementBoundary formula + have positive : 0 < width := + paperVariableArityPhysicalOrdinarySourceInterpolationBlockWidth_pos formula + have lower := Nat.div_mul_le_self offset width + have upper := Nat.lt_div_mul_add positive (a := offset) + have restore : offset + physicalFormulaRefinementBoundary formula = row.val := + Nat.sub_add_cancel inOrdinary.1 + change physicalFormulaRefinementBoundary formula + + (offset / width) * width ≤ row.val ∧ + row.val < physicalFormulaRefinementBoundary formula + + (offset / width) * width + width + omega + +private theorem paperVariableArityPhysicalOrdinarySourceRowDecodedFamily + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 = + .inr (.inr (.inl + (paperOrdinaryFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + (physicalOrdinarySourceRowFamilyCoordinate + formula row inOrdinary)))) := by + rw [physicalRowOrder_family, + paperVariableArityPhysicalOrdinarySourceRowDecodedFamilyIndex, + paperVariableArityPhysicalOrdinaryDependentFamilyWordOrder] + +end PhysicalOrdinaryInterpolationRowTagCorrectness + +namespace PhysicalOrdinaryInterpolationCheckFieldCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.FormulaBridge +open GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationRowFamilyProjection +open GapCVP.PhysicalOrdinaryInterpolationRowTagCorrectness +open GapCVP.PhysicalSelectedInterpolationCoefficientProjection GapCVP.SourceOrder +open GapCVP.BinaryReedSolomonParity + +/-- GapCVP reduction support. -/ +def physicalOrdinarySourceRowTableMoment + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + sourceSATTableType (srcFormula formula) × + Fin (physicalInterpolationMomentBudget formula + 1) := + paperOrdinaryFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + (physicalOrdinarySourceRowFamilyCoordinate + formula row inOrdinary) + +/-- GapCVP reduction support. -/ +def physicalOrdinarySourceRowGrid + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + Fin (Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula))) := by + let decoded := physicalWordDecodedRow + (encodeThreeCNF formula).length formula row + refine ⟨decoded.2.1.val, ?_⟩ + have bounded := decoded.2.1.isLt + have family := paperVariableArityPhysicalOrdinarySourceRowDecodedFamily + formula row inOrdinary + change decoded.1 = _ at family + have rowCount : + explicitFamilyRowCount + (encodeThreeCNF formula).length + (srcFormula formula) decoded.1 = + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) := by + rw [family] + exact lt_of_lt_of_eq bounded rowCount + +theorem paperVariableArityPhysicalOrdinarySourceRowFieldCoefficient_eq_selected + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + physicalWordFamilyFieldCoefficient + (encodeThreeCNF formula).length formula + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.1 + column = + if (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).1 = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 + then + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val) + (explicitOrdinaryDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2) + (physicalOrdinarySourceRowGrid + formula row inOrdinary) + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1) * + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val + else 0 := by + let tableMoment := physicalOrdinarySourceRowTableMoment + formula row inOrdinary + let grid := physicalOrdinarySourceRowGrid + formula row inOrdinary + have family := paperVariableArityPhysicalOrdinarySourceRowDecodedFamily + formula row inOrdinary + have selected := + paperVariableArityPhysicalWordOrdinaryFieldCoefficient_eq_selectedCoordinate + (encodeThreeCNF formula).length formula + tableMoment.1 tableMoment.2 grid column + generalize decodedEquality : + physicalWordDecodedRow + (encodeThreeCNF formula).length formula row = decoded + at family ⊢ + rcases decoded with ⟨decodedFamily, decodedRow, decodedBasis⟩ + have exactFamily : decodedFamily = + .inr (.inr (.inl tableMoment)) := family + subst decodedFamily + have exactGrid : decodedRow = grid := by + apply Fin.ext + change decodedRow.val = grid.val + change decodedRow.val = + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.1.val + exact (congrArg + (fun value => value.2.1.val) decodedEquality).symm + subst decodedRow + exact selected + +end PhysicalOrdinaryInterpolationCheckFieldCorrectness + +namespace PhysicalOrdinaryInterpolationTypeMatchCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.MatrixEntrySemantics GapCVP.PhysicalColumnOrderProjection +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalInterpolationRowFamilyProjection +open GapCVP.PhysicalOrdinaryInterpolationRowTagCorrectness GapCVP.SourceOrder + +private theorem paperVariableArityPhysicalOrdinaryFamilySourceTypeCardWordRank + (formula : ThreeCNF) + (momentBudget : ℕ) + (tag : Fin + ((1 + paperVariableArityLocalTagCount formula) * + (momentBudget + 1))) : + ((sourceTypeCardWordOrder formula).symm + ((paperOrdinaryFamilyWordOrder formula + momentBudget tag).1)).val = tag.val / (momentBudget + 1) := by + simpa only [sourceTypeCardWordOrder, Equiv.symm_trans, finCongr_symm, Equiv.trans_apply, + finCongr_apply, + Fin.val_cast] using paperVariableArityPhysicalOrdinaryFamilySourceTypeWordRank formula + momentBudget tag + +private theorem paperVariableArityPhysicalOrdinarySourceRowTypeCardWordRank + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + ((sourceTypeCardWordOrder formula).symm + ((paperOrdinaryFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + (physicalOrdinarySourceRowFamilyCoordinate + formula row inOrdinary)).1)).val = + (((row.val - + physicalFormulaRefinementBoundary formula) / + physDegree formula) / + physGridCard formula) / + physicalFormulaMomentCount formula := by + rw [paperVariableArityPhysicalOrdinaryFamilySourceTypeCardWordRank] + change + ((row.val - physicalFormulaRefinementBoundary formula) / + (physGridCard formula * + physDegree formula)) / + physicalFormulaMomentCount formula = _ + congr 1 + rw [Nat.div_div_eq_div_mul, Nat.mul_comm] + +private theorem paperVariableArityPhysicalOrdinarySourceRowTable_eq_column_iff + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + (paperOrdinaryFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + (physicalOrdinarySourceRowFamilyCoordinate + formula row inOrdinary)).1 = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 ↔ + (((row.val - + physicalFormulaRefinementBoundary formula) / + physDegree formula) / + physGridCard formula) / + physicalFormulaMomentCount formula = + (column.val / + physFieldCard formula) / + physGridCard formula := by + let rowType := + (paperOrdinaryFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + (physicalOrdinarySourceRowFamilyCoordinate + formula row inOrdinary)).1 + let columnType := + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 + have rowRank := paperVariableArityPhysicalOrdinarySourceRowTypeCardWordRank + formula row inOrdinary + have columnRank := sourceCoordinateTypeWordRank + (encodeThreeCNF formula).length formula column + rw [physicalFormulaFieldCardinality_eq_card, + physicalFormulaGridCardinality_eq_card] at columnRank + change rowType = columnType ↔ _ + constructor + · intro equal + have ranks := congrArg + (fun sourceType => + ((sourceTypeCardWordOrder formula).symm + sourceType).val) equal + exact rowRank.symm.trans (ranks.trans columnRank) + · intro ranks + apply (sourceTypeCardWordOrder formula).symm.injective + apply Fin.ext + exact rowRank.trans (ranks.trans columnRank.symm) + +end PhysicalOrdinaryInterpolationTypeMatchCorrectness + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open Turing GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalGlobalRefinementCoefficientTM GapCVP.SourceFieldMomentOperationsTM + +private theorem paperVariableArityPhysicalInterpolationFamilyTypeRankComputer_output + (family : Fin 4) : + (physicalInterpolationFamilyTypeRankComputer + family).output = + physicalInterpolationFamilyTypeRankUnary family := by + dsimp only [physicalInterpolationFamilyTypeRankComputer] + +private theorem paperVariableArityPhysicalOrdinaryExpectedTypeMatchBit_valid + (formula : ThreeCNF) (row column : ℕ) : + physicalInterpolationExpectedTypeMatchBit + (physicalInterpolationFamilyTypeRankComputer + (2 : Fin 4)) + (affineCellQuery row column + (encodeThreeCNF formula)) = + [decide + (((((row - physicalFamilyStart + (2 : Fin 4) formula) / + physDegree formula) / + physGridCard formula) / + physicalFormulaMomentCount formula) = + ((column / + physFieldCard formula) / + physGridCard formula))] := by + unfold physicalInterpolationExpectedTypeMatchBit + apply physicalCoefficientUnaryEquality_valid + (physicalInterpolationFamilyTypeRankComputer + (2 : Fin 4)).output + physicalColumnTypeRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) + ((((row - physicalFamilyStart + (2 : Fin 4) formula) / + physDegree formula) / + physGridCard formula) / + physicalFormulaMomentCount formula) + ((column / physFieldCard formula) / + physGridCard formula) + · rw [paperVariableArityPhysicalInterpolationFamilyTypeRankComputer_output] + exact paperVariableArityPhysicalInterpolationFamilyTypeRankUnary_valid + (2 : Fin 4) row column formula + · exact paperVariableArityPhysicalColumnTypeRankUnary_query + row column formula + +end PhysicalOrdinaryShiftedCheckBitInstantiation + +namespace PhysicalOrdinaryInterpolationRowGridBasisCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationRowFamilyProjection +open GapCVP.PhysicalOrdinaryInterpolationCheckFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationRowTagCorrectness GapCVP.PhysicalRowOrderProjection +open GapCVP.SourceOrder + +private theorem paperVariableArityPhysicalOrdinarySourceRowDependentBlockRank + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val = + (row.val - physicalFormulaRefinementBoundary formula) % + physicalInterpolationBlockWidth formula := by + have rank := physicalRowDependentRank_eq_prefix + (encodeThreeCNF formula).length formula row + change row.val = physicalSigmaPrefix _ + (physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row) + + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val at rank + have prefixEquality := congrArg + (physicalSigmaPrefix (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula)) + (paperVariableArityPhysicalOrdinarySourceRowDecodedFamilyIndex formula row inOrdinary) + rw [paperVariableArityPhysicalOrdinaryDependentFamilyPrefix] at prefixEquality + rw [prefixEquality] at rank + let width := physicalInterpolationBlockWidth formula + let offset := row.val - physicalFormulaRefinementBoundary formula + change row.val = physicalFormulaRefinementBoundary formula + + (offset / width) * width + + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val at rank + have decomposition := Nat.mod_add_div' offset width + have restore : offset + physicalFormulaRefinementBoundary formula = row.val := + Nat.sub_add_cancel inOrdinary.1 + change (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val = offset % width + omega + +theorem paperVariableArityPhysicalOrdinarySourceRowGrid_val + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + (physicalOrdinarySourceRowGrid + formula row inOrdinary).val = + ((row.val - physicalFormulaRefinementBoundary formula) / + physDegree formula) % + physGridCard formula := by + change + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.1.val = _ + rw [physicalRowOrder_fieldRow, + paperVariableArityPhysicalOrdinarySourceRowDependentBlockRank + formula row inOrdinary] + change + ((row.val - physicalFormulaRefinementBoundary formula) % + (physGridCard formula * + physDegree formula)) / + physDegree formula = _ + exact Nat.mod_mul_left_div_self + (row.val - physicalFormulaRefinementBoundary formula) + (physDegree formula) + (physGridCard formula) + +theorem paperVariableArityPhysicalOrdinarySourceRowBasis_val + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.2.val = + row.val % physDegree formula := by + exact physicalRowOrder_basis_val + (encodeThreeCNF formula).length formula row + +theorem paperVariableArityPhysicalOrdinarySourceRowMoment_val + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val = + (((row.val - physicalFormulaRefinementBoundary formula) / + physDegree formula) / + physGridCard formula) % + physicalFormulaMomentCount formula := by + change + ((paperOrdinaryFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + (physicalOrdinarySourceRowFamilyCoordinate + formula row inOrdinary)).2).val = _ + simp only [paperOrdinaryFamilyWordOrder, + Equiv.trans_apply, Equiv.prodCongr_apply, + finProdFinEquiv_symm_apply] + change + ((row.val - physicalFormulaRefinementBoundary formula) / + (physGridCard formula * + physDegree formula)) % + physicalFormulaMomentCount formula = _ + congr 1 + rw [Nat.div_div_eq_div_mul, Nat.mul_comm] + +end PhysicalOrdinaryInterpolationRowGridBasisCorrectness + +namespace PhysicalInterpolationNodeCountBounds + +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalColumnOrderProjection +open GapCVP.SourceFieldMomentOperationsTM GapCVP.PhysicalMaskedInterpolationNodeParityTM + +private def paperVariableArityPhysicalInterpolationSourceMomentIndex + (family : Fin 4) (row : ℕ) (formula : ThreeCNF) : + Fin (explicitMomentBudget (encodeThreeCNF formula).length + (srcFormula formula) + 1) := by + refine ⟨physicalFamilyRowMoment family row formula, ?_⟩ + change physicalFamilyRowMoment family row formula < + physicalFormulaMomentCount formula + unfold physicalFamilyRowMoment + exact Nat.mod_lt _ + (physicalFormulaMomentCount_pos formula) + +theorem physicalInterpolationExplicitGridCardinality_eq + (formula : ThreeCNF) : + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) = + 2 ^ physDegree formula - + (srcFormula formula).variableCount := by + calc + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) = + (GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaGrid + (encodeThreeCNF formula).length + (srcFormula formula)).card := by + simp only [ExplicitGridPoint, Fintype.card_coe] + _ = physGridCard formula := + physicalFormulaGridCardinality_eq_card formula + _ = 2 ^ physDegree formula - + (srcFormula formula).variableCount := by + change 2 ^ physDegree formula - + paperVariableArityVariableCount formula = _ + rw [paperVariableAritySourceFormula_variableCount] + +theorem physicalOrdinaryInterpolationNodeCount_le_grid + (formula : ThreeCNF) (row : ℕ) : + physicalOrdinaryInterpolationNodeCount row formula ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount := by + have degree := explicitOrdinaryDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) + (paperVariableArityPhysicalInterpolationSourceMomentIndex + (2 : Fin 4) row formula) + rw [physicalInterpolationExplicitGridCardinality_eq] + at degree + change + (srcFormula formula).variableCount * + physicalFamilyRowMoment (2 : Fin 4) row formula < + 2 ^ physDegree formula - + (srcFormula formula).variableCount at degree + unfold physicalOrdinaryInterpolationNodeCount + change paperVariableArityVariableCount formula * + physicalFamilyRowMoment (2 : Fin 4) row formula + 1 ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount + rw [paperVariableAritySourceFormula_variableCount] at degree + exact Nat.succ_le_of_lt degree + +theorem physicalShiftedInterpolationNodeCount_le_grid + (formula : ThreeCNF) (row : ℕ) : + physicalShiftedInterpolationNodeCount row formula ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount := by + have degree := explicitShiftedDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) + (paperVariableArityPhysicalInterpolationSourceMomentIndex + (3 : Fin 4) row formula) + rw [physicalInterpolationExplicitGridCardinality_eq] + at degree + change + ((srcFormula formula).variableCount - 1) * + physicalFamilyRowMoment (3 : Fin 4) row formula < + 2 ^ physDegree formula - + (srcFormula formula).variableCount at degree + unfold physicalShiftedInterpolationNodeCount + change (paperVariableArityVariableCount formula - 1) * + physicalFamilyRowMoment (3 : Fin 4) row formula + 1 ≤ + 2 ^ physDegree formula - + (srcFormula formula).variableCount + rw [paperVariableAritySourceFormula_variableCount] at degree + exact Nat.succ_le_of_lt degree + +end PhysicalInterpolationNodeCountBounds + +namespace BinaryCompactSourceVariableRankTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceMachineCert GapCVP.SourceFormulaStructuralDecoder +open GapCVP.OutputBoundedDependentRecordFold GapCVP.SourceNormalizedVariableRankScanTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinarySourceVariableCompaction +open GapCVP.BinaryCompactRankPrefixIdentity GapCVP.BinaryCompactSourceFirstOccurrenceTM + +private def compactSourceVariableRankPreparation (input : List Bool) : List Bool := + sourceNormalizedVariableRankOutput input ++ + false :: compactFirstOccurrenceScanSeed (firstFieldSuffix input) + +private noncomputable def compactSourceVariableRankPreparationComputable : + BitTM + compactSourceVariableRankPreparation := by + have hseed := GapCVP.TMComposition.computableInPolyTime + firstFieldSuffixComputable compactFirstOccurrenceScanSeedComputable + have hdelimited := GapCVP.TMComposition.computableInPolyTime + hseed (prependBitComputable false) + exact pointwiseAppendComputable + sourceNormalizedVariableRankComputable hdelimited + +private def compactSourceVariableRankUnary : List Bool → List Bool := + compactFirstOccurrenceCounter ∘ + boundedRecordFoldOutput compactFirstOccurrenceScanStep ∘ + compactSourceVariableRankPreparation + +private noncomputable def compactSourceVariableRankUnaryComputable : + BitTM + compactSourceVariableRankUnary := by + have hfold := GapCVP.TMComposition.computableInPolyTime + compactSourceVariableRankPreparationComputable + compactFirstOccurrenceScanFoldComputable + exact GapCVP.TMComposition.computableInPolyTime + hfold compactFirstOccurrenceCounterComputable + +private theorem compactSourceVariableRawRank_le_literalLength + (formula : ThreeCNF) (name : ℕ) : + variableRank formula name ≤ + (sourceNormalizedVariableLiteralList formula).length := by + unfold variableRank + calc + (formulaVariables formula).idxOf name ≤ + (formulaVariables formula).length := List.idxOf_le_length + _ = (sourceNormalizedVariableLiteralList formula).length := by + rw [← sourceNormalizedVariableLiteralList_variables, + List.length_map] + +private theorem compactSourceVariableRankPreparation_valid + (formula : ThreeCNF) (name : ℕ) : + compactSourceVariableRankPreparation + (sourceNormalizedVariableRankQuery name formula) = + unaryBoundedFoldWord (variableRank formula name) + (compactFirstOccurrenceValidState formula 0 0 + (sourceNormalizedVariableLiteralList formula)) := by + unfold compactSourceVariableRankPreparation + rw [sourceNormalizedVariableRankOutput_valid] + have hsource : + firstFieldSuffix + (sourceNormalizedVariableRankQuery name formula) = + encodeThreeCNF formula := by + simp only [sourceNormalizedVariableRankQuery, firstFieldSuffix_valid] + rw [hsource, compactFirstOccurrenceScanSeed_valid] + rfl + +private theorem compactSourceVariableRankUnary_valid + (formula : ThreeCNF) (name : ℕ) : + compactSourceVariableRankUnary + (sourceNormalizedVariableRankQuery name formula) = + List.replicate (compactVariableRank formula name) true := by + unfold compactSourceVariableRankUnary + rw [Function.comp_apply, Function.comp_apply, + compactSourceVariableRankPreparation_valid] + simp only [boundedRecordFoldOutput, parseUnaryBoundedFold_word] + rw [compactFirstOccurrenceValidState_iterate + formula (variableRank formula name) + (compactSourceVariableRawRank_le_literalLength formula name)] + rw [compactFirstOccurrenceValidState_counter, + ← compactVariableRank_eq_firstOccurrencePrefixCount] + +end BinaryCompactSourceVariableRankTM + +namespace ShiftedTupleBetaSourceCorrectness + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedRankTaggedSquareBasisPairTM +open GapCVP.SourceNormalizedVariableRankScanTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryCompactSourceVariableRankTM +open GapCVP.BinarySourceVariableCompaction GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingTM GapCVP.SourcePreprocessingSemantics +open GapCVP.SourcePreprocessingPairwiseIdentity +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine +open GapCVP.ShiftedTupleBetaTM + +private theorem paperVariableArityShiftedTupleOriginalSignWord_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : Fin 3) : + paperShiftedTupleOriginalSignWord ranks position + (affineCellQuery row column + (encodeThreeCNF formula)) = + [(((noTautClauses formula).get + ⟨rank, hbound⟩) position).2] := by + unfold paperShiftedTupleOriginalSignWord + rw [Function.comp_apply, + paperShiftedTupleOriginalClauseWord_query + ranks row column formula rank hbound hrank] + simpa only [List.get_eq_getElem, List.append_nil] using + paperSourceClauseSignWord_valid position ((noTautClauses formula).get ⟨rank, hbound⟩) [] + +private theorem paperVariableArityShiftedTupleOriginalSecondKeepBit_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) : + paperShiftedTupleOriginalSecondKeepBit ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + [!(decide + (((noTautClauses formula).get + ⟨rank, hbound⟩) 0 = + ((noTautClauses formula).get + ⟨rank, hbound⟩) 1))] := by + unfold paperShiftedTupleOriginalSecondKeepBit + rw [Function.comp_apply, + paperShiftedTupleOriginalClauseWord_query + ranks row column formula rank hbound hrank] + simpa only [List.get_eq_getElem, Fin.isValue, List.append_nil] using + paperSourceClauseSecondKeepMarker_valid ((noTautClauses formula).get ⟨rank, hbound⟩) [] + +private def paperShiftedTupleOriginalVariableWord + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : List Bool → List Bool := + paperSourceClauseVariableWord position ∘ + paperShiftedTupleOriginalClauseWord ranks + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedTupleOriginalVariableWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : + BitTM + (paperShiftedTupleOriginalVariableWord ranks position) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityShiftedTupleOriginalClauseWordComputable ranks) + (paperSourceClauseVariableWordComputable position) + +private theorem paperVariableArityShiftedTupleOriginalVariableWord_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : Fin 3) : + paperShiftedTupleOriginalVariableWord ranks position + (affineCellQuery row column + (encodeThreeCNF formula)) = + Computability.encodeNat + (((noTautClauses formula).get + ⟨rank, hbound⟩) position).1 := by + unfold paperShiftedTupleOriginalVariableWord + rw [Function.comp_apply, + paperShiftedTupleOriginalClauseWord_query + ranks row column formula rank hbound hrank] + simpa only [List.get_eq_getElem, List.append_nil] using + paperSourceClauseVariableWord_valid position ((noTautClauses formula).get ⟨rank, hbound⟩) [] + +private def paperShiftedTupleSelectedSourceWord + (marker first second : List Bool → List Bool) + (input : List Bool) : List Bool := + paperShiftedTupleGuardedSourceWord marker first input ++ + paperShiftedTupleGuardedSourceWord + (sourceFourFamilyBooleanNotOutput marker) second input + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedTupleSelectedSourceWordComputable + {marker first second : List Bool → List Bool} + (hmarker : BitTM marker) + (hfirst : BitTM first) + (hsecond : BitTM second) : + BitTM + (paperShiftedTupleSelectedSourceWord + marker first second) := + pointwiseAppendComputable + (paperVariableArityShiftedTupleGuardedSourceWordComputable + hmarker hfirst) + (paperVariableArityShiftedTupleGuardedSourceWordComputable + (fourFamilyBooleanNotOutputComputable hmarker) hsecond) + +private theorem paperVariableArityShiftedTupleSelectedSourceWord_valid + (marker first second : List Bool → List Bool) + (input : List Bool) (selector : Bool) + (hmarker : marker input = [selector]) : + paperShiftedTupleSelectedSourceWord + marker first second input = + if selector then first input else second input := by + have hnot := fourFamilyBooleanNotOutput_bit + marker input selector hmarker + unfold paperShiftedTupleSelectedSourceWord + rw [paperShiftedTupleGuardedSourceWord_valid + marker first input selector hmarker, + paperShiftedTupleGuardedSourceWord_valid + (sourceFourFamilyBooleanNotOutput marker) second + input (!selector) hnot] + cases selector <;> simp + +private def paperShiftedTupleNormalizedVariableWord + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : List Bool → List Bool := + if position.val = 0 then + paperShiftedTupleOriginalVariableWord ranks 0 + else if position.val = 1 then + paperShiftedTupleSelectedSourceWord + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalVariableWord ranks 1) + (paperShiftedTupleOriginalVariableWord ranks 2) + else + paperShiftedTupleOriginalVariableWord ranks 2 + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedTupleNormalizedVariableWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : + BitTM + (paperShiftedTupleNormalizedVariableWord + ranks position) := by + unfold paperShiftedTupleNormalizedVariableWord + split + · exact paperVariableArityShiftedTupleOriginalVariableWordComputable + ranks 0 + next => + split + · exact paperVariableArityShiftedTupleSelectedSourceWordComputable + (paperVariableArityShiftedTupleOriginalSecondKeepBitComputable ranks) + (paperVariableArityShiftedTupleOriginalVariableWordComputable ranks 1) + (paperVariableArityShiftedTupleOriginalVariableWordComputable ranks 2) + · exact paperVariableArityShiftedTupleOriginalVariableWordComputable + ranks 2 + +/-- GapCVP reduction support. -/ +def paperShiftedTuplePotentialNormalizedLiteral + (clause : ThreeClause) (position : Fin 3) : Literal := + if position.val = 0 then clause 0 + else if position.val = 1 then + if clause 0 = clause 1 then clause 2 else clause 1 + else clause 2 + +theorem paperVariableArityShiftedTuplePotentialNormalizedLiteral_get + (clause : ThreeClause) (position : Fin 3) + (hposition : position.val < + (paperSourceNormalizedClause clause).length) : + paperShiftedTuplePotentialNormalizedLiteral + clause position = + (paperSourceNormalizedClause clause).get + ⟨position.val, hposition⟩ := by + have hlength := hposition + rw [paperSourceNormalizedClause_pairwise clause] at hlength + fin_cases position <;> + by_cases hfirst : clause 0 = clause 1 <;> + by_cases hsecond : clause 0 = clause 2 <;> + by_cases hthird : clause 1 = clause 2 <;> + simp_all [paperShiftedTuplePotentialNormalizedLiteral, + paperSourceNormalizedClause_pairwise] + +theorem paperVariableArityShiftedTupleNormalizedSignWord_potential_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : Fin 3) : + paperShiftedTupleNormalizedSignWord ranks position + (affineCellQuery row column + (encodeThreeCNF formula)) = + [(paperShiftedTuplePotentialNormalizedLiteral + ((noTautClauses formula).get + ⟨rank, hbound⟩) position).2] := by + let clause : ThreeClause := + (noTautClauses formula).get ⟨rank, hbound⟩ + let input := affineCellQuery row column + (encodeThreeCNF formula) + have hzero := paperVariableArityShiftedTupleOriginalSignWord_query + ranks row column formula rank hbound hrank 0 + have hone := paperVariableArityShiftedTupleOriginalSignWord_query + ranks row column formula rank hbound hrank 1 + have htwo := paperVariableArityShiftedTupleOriginalSignWord_query + ranks row column formula rank hbound hrank 2 + have hkeep := paperVariableArityShiftedTupleOriginalSecondKeepBit_query + ranks row column formula rank hbound hrank + have hselect := paperVariableArityShiftedTupleSelectedSourceBit_valid + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalSignWord ranks 1) + (paperShiftedTupleOriginalSignWord ranks 2) + input (!(decide (clause 0 = clause 1))) + (clause 1).2 (clause 2).2 hkeep hone htwo + fin_cases position + · simpa only [paperShiftedTupleNormalizedSignWord, ↓reduceIte, Fin.isValue, + paperShiftedTuplePotentialNormalizedLiteral, List.get_eq_getElem] using hzero + · by_cases hequal : clause 0 = clause 1 + · change paperShiftedTupleSelectedSourceBit + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalSignWord ranks 1) + (paperShiftedTupleOriginalSignWord ranks 2) + input = + [(paperShiftedTuplePotentialNormalizedLiteral + clause 1).2] + simpa only [Fin.isValue, paperShiftedTuplePotentialNormalizedLiteral, Fin.coe_ofNat_eq_mod, + Nat.one_mod, + one_ne_zero, ↓reduceIte, hequal, decide_true, Bool.not_true, Bool.false_eq_true] + using hselect + · change paperShiftedTupleSelectedSourceBit + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalSignWord ranks 1) + (paperShiftedTupleOriginalSignWord ranks 2) + input = + [(paperShiftedTuplePotentialNormalizedLiteral + clause 1).2] + simpa only [Fin.isValue, paperShiftedTuplePotentialNormalizedLiteral, Fin.coe_ofNat_eq_mod, + Nat.one_mod, + one_ne_zero, ↓reduceIte, hequal, decide_false, Bool.not_false] using hselect + · simpa only [paperShiftedTupleNormalizedSignWord, OfNat.ofNat_ne_zero, ↓reduceIte, + OfNat.ofNat_ne_one, + Fin.isValue, paperShiftedTuplePotentialNormalizedLiteral, List.get_eq_getElem] using htwo + +private theorem paperVariableArityShiftedTupleNormalizedVariableWord_potential_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : Fin 3) : + paperShiftedTupleNormalizedVariableWord ranks position + (affineCellQuery row column + (encodeThreeCNF formula)) = + Computability.encodeNat + (paperShiftedTuplePotentialNormalizedLiteral + ((noTautClauses formula).get + ⟨rank, hbound⟩) position).1 := by + let clause : ThreeClause := + (noTautClauses formula).get ⟨rank, hbound⟩ + let input := affineCellQuery row column + (encodeThreeCNF formula) + have hzero := paperVariableArityShiftedTupleOriginalVariableWord_query + ranks row column formula rank hbound hrank 0 + have hone := paperVariableArityShiftedTupleOriginalVariableWord_query + ranks row column formula rank hbound hrank 1 + have htwo := paperVariableArityShiftedTupleOriginalVariableWord_query + ranks row column formula rank hbound hrank 2 + have hkeep := paperVariableArityShiftedTupleOriginalSecondKeepBit_query + ranks row column formula rank hbound hrank + have hselect := paperVariableArityShiftedTupleSelectedSourceWord_valid + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalVariableWord ranks 1) + (paperShiftedTupleOriginalVariableWord ranks 2) + input (!(decide (clause 0 = clause 1))) hkeep + fin_cases position + · simpa only [paperShiftedTupleNormalizedVariableWord, ↓reduceIte, Fin.isValue, + paperShiftedTuplePotentialNormalizedLiteral, List.get_eq_getElem] using hzero + · by_cases hequal : clause 0 = clause 1 + · change paperShiftedTupleSelectedSourceWord + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalVariableWord ranks 1) + (paperShiftedTupleOriginalVariableWord ranks 2) + input = Computability.encodeNat + (paperShiftedTuplePotentialNormalizedLiteral + clause 1).1 + simp only [paperShiftedTuplePotentialNormalizedLiteral, + Fin.isValue, ↓reduceIte, hequal] + calc + paperShiftedTupleSelectedSourceWord + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalVariableWord ranks 1) + (paperShiftedTupleOriginalVariableWord ranks 2) + input = + paperShiftedTupleOriginalVariableWord + ranks 2 input := by simpa only [Fin.isValue, hequal, decide_true, Bool.not_true, + Bool.false_eq_true, ↓reduceIte] using hselect + _ = Computability.encodeNat (clause 2).1 := by + simpa only [Fin.isValue, List.get_eq_getElem, input, clause] using htwo + · change paperShiftedTupleSelectedSourceWord + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalVariableWord ranks 1) + (paperShiftedTupleOriginalVariableWord ranks 2) + input = Computability.encodeNat + (paperShiftedTuplePotentialNormalizedLiteral + clause 1).1 + simp only [paperShiftedTuplePotentialNormalizedLiteral, + Fin.isValue, ↓reduceIte, hequal] + calc + paperShiftedTupleSelectedSourceWord + (paperShiftedTupleOriginalSecondKeepBit ranks) + (paperShiftedTupleOriginalVariableWord ranks 1) + (paperShiftedTupleOriginalVariableWord ranks 2) + input = + paperShiftedTupleOriginalVariableWord + ranks 1 input := by simpa only [Fin.isValue, hequal, decide_false, Bool.not_false, + ↓reduceIte] using hselect + _ = Computability.encodeNat (clause 1).1 := by + simpa only [Fin.isValue, List.get_eq_getElem, input, clause] using hone + · simpa only [paperShiftedTupleNormalizedVariableWord, OfNat.ofNat_ne_zero, ↓reduceIte, + OfNat.ofNat_ne_one, + Fin.isValue, paperShiftedTuplePotentialNormalizedLiteral, List.get_eq_getElem] using htwo + +private theorem paperVariableArityShiftedTupleNormalizedVariableWord_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : Fin 3) + (hposition : position.val < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) : + paperShiftedTupleNormalizedVariableWord ranks position + (affineCellQuery row column + (encodeThreeCNF formula)) = + Computability.encodeNat + ((paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).get + ⟨position.val, hposition⟩).1 := by + rw [paperVariableArityShiftedTupleNormalizedVariableWord_potential_query + ranks row column formula rank hbound hrank position, + paperVariableArityShiftedTuplePotentialNormalizedLiteral_get + ((noTautClauses formula).get + ⟨rank, hbound⟩) position hposition] + +private def paperShiftedTupleLocalPositionMarker + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : List Bool → List Bool := + maskComputedWordEquality + ranks.variablePosition.output + (paperShiftedTupleConstantUnary position.val) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedTupleLocalPositionMarkerComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) + (position : Fin 3) : + BitTM + (paperShiftedTupleLocalPositionMarker + ranks position) := + maskComputedWordEqualityComputable + ranks.variablePosition.computer + (paperVariableArityShiftedTupleConstantUnaryComputable position.val) + +private theorem paperVariableArityShiftedTupleLocalPositionMarker_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (slot : Fin 3) (input : List Bool) (position : ℕ) + (hposition : ranks.variablePosition.output input = + List.replicate position true) : + paperShiftedTupleLocalPositionMarker ranks slot input = + [decide (position = slot.val)] := by + unfold paperShiftedTupleLocalPositionMarker + rw [sourceQaryMaskSquareComputedWordEquality_valid, hposition] + simp only [paperShiftedTupleConstantUnary, List.replicate_inj, or_true, and_true] + +private def paperShiftedTupleSelectedNormalizedVariableWord + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) : List Bool := + paperShiftedTupleGuardedSourceWord + (paperShiftedTupleLocalPositionMarker ranks 0) + (paperShiftedTupleNormalizedVariableWord ranks 0) + input ++ + (paperShiftedTupleGuardedSourceWord + (paperShiftedTupleLocalPositionMarker ranks 1) + (paperShiftedTupleNormalizedVariableWord ranks 1) + input ++ + paperShiftedTupleGuardedSourceWord + (paperShiftedTupleLocalPositionMarker ranks 2) + (paperShiftedTupleNormalizedVariableWord ranks 2) + input) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedTupleSelectedNormalizedVariableWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleSelectedNormalizedVariableWord ranks) := + pointwiseAppendComputable + (paperVariableArityShiftedTupleGuardedSourceWordComputable + (paperVariableArityShiftedTupleLocalPositionMarkerComputable ranks 0) + (paperVariableArityShiftedTupleNormalizedVariableWordComputable ranks 0)) + (pointwiseAppendComputable + (paperVariableArityShiftedTupleGuardedSourceWordComputable + (paperVariableArityShiftedTupleLocalPositionMarkerComputable ranks 1) + (paperVariableArityShiftedTupleNormalizedVariableWordComputable ranks 1)) + (paperVariableArityShiftedTupleGuardedSourceWordComputable + (paperVariableArityShiftedTupleLocalPositionMarkerComputable ranks 2) + (paperVariableArityShiftedTupleNormalizedVariableWordComputable ranks 2))) + +private theorem paperVariableArityShiftedTupleSelectedNormalizedVariableWord_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (hposition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) + (hlocal : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + paperShiftedTupleSelectedNormalizedVariableWord ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + Computability.encodeNat + ((paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).get + ⟨position, hposition⟩).1 := by + let input := affineCellQuery row column + (encodeThreeCNF formula) + have hzero := paperVariableArityShiftedTupleLocalPositionMarker_valid + ranks 0 input position hlocal + have hone := paperVariableArityShiftedTupleLocalPositionMarker_valid + ranks 1 input position hlocal + have htwo := paperVariableArityShiftedTupleLocalPositionMarker_valid + ranks 2 input position hlocal + change paperShiftedTupleSelectedNormalizedVariableWord + ranks input = _ + unfold paperShiftedTupleSelectedNormalizedVariableWord + rw [paperShiftedTupleGuardedSourceWord_valid + (paperShiftedTupleLocalPositionMarker ranks 0) + (paperShiftedTupleNormalizedVariableWord ranks 0) + input (decide (position = 0)) hzero, + paperShiftedTupleGuardedSourceWord_valid + (paperShiftedTupleLocalPositionMarker ranks 1) + (paperShiftedTupleNormalizedVariableWord ranks 1) + input (decide (position = 1)) hone, + paperShiftedTupleGuardedSourceWord_valid + (paperShiftedTupleLocalPositionMarker ranks 2) + (paperShiftedTupleNormalizedVariableWord ranks 2) + input (decide (position = 2)) htwo] + have hthree : position < 3 := lt_of_lt_of_le hposition + (paperNormalizedClause_length_le_three + ((noTautClauses formula).get + ⟨rank, hbound⟩)) + have hcases : position = 0 ∨ position = 1 ∨ position = 2 := by + omega + rcases hcases with hcase | hcase | hcase + · subst position + simpa only [decide_true, ↓reduceIte, Fin.isValue, zero_ne_one, decide_false, + Bool.false_eq_true, + OfNat.zero_ne_ofNat, List.append_nil, List.get_eq_getElem, Fin.coe_ofNat_eq_mod, + Nat.zero_mod] using + paperVariableArityShiftedTupleNormalizedVariableWord_query ranks row column formula rank + hbound hrank 0 hposition + · subst position + simpa only [one_ne_zero, decide_false, Bool.false_eq_true, ↓reduceIte, decide_true, + Fin.isValue, + OfNat.one_ne_ofNat, List.append_nil, List.nil_append, List.get_eq_getElem, + Fin.coe_ofNat_eq_mod, Nat.one_mod] using + paperVariableArityShiftedTupleNormalizedVariableWord_query ranks row column formula rank + hbound hrank 1 hposition + · subst position + simpa only [OfNat.ofNat_ne_zero, decide_false, Bool.false_eq_true, ↓reduceIte, + OfNat.ofNat_ne_one, + decide_true, Fin.isValue, List.nil_append, List.get_eq_getElem, Fin.coe_ofNat_eq_mod, + Nat.mod_succ] using + paperVariableArityShiftedTupleNormalizedVariableWord_query ranks row column formula rank + hbound hrank 2 hposition + +private def paperShiftedTupleRetainedAnchorRankQuery + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) : List Bool := + lengthPrefixedWord + (paperShiftedTupleSelectedNormalizedVariableWord + ranks input) ++ + paperShiftedTupleRetainedSource input + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedTupleRetainedAnchorRankQueryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleRetainedAnchorRankQuery ranks) := by + have hname := GapCVP.TMComposition.computableInPolyTime + (paperVariableArityShiftedTupleSelectedNormalizedVariableWordComputable + ranks) + structuralPrefixWriterComputable + exact pointwiseAppendComputable hname + paperVariableArityShiftedTupleRetainedSourceComputable + +private theorem paperVariableArityShiftedTupleRetainedAnchorRankQuery_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (hposition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) + (hlocal : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + paperShiftedTupleRetainedAnchorRankQuery ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + sourceNormalizedVariableRankQuery + ((paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).get + ⟨position, hposition⟩).1 + (noTautClauses formula) := by + unfold paperShiftedTupleRetainedAnchorRankQuery + rw [paperVariableArityShiftedTupleSelectedNormalizedVariableWord_query + ranks row column formula rank hbound hrank position hposition hlocal, + paperVariableArityShiftedTupleRetainedSource_query] + rfl + +private def paperShiftedTupleRetainedAnchorRankUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + compactSourceVariableRankUnary ∘ + paperShiftedTupleRetainedAnchorRankQuery ranks + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedTupleRetainedAnchorRankUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleRetainedAnchorRankUnary ranks) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityShiftedTupleRetainedAnchorRankQueryComputable ranks) + compactSourceVariableRankUnaryComputable + +private theorem paperVariableArityShiftedTupleRetainedAnchorRankUnary_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (hposition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) + (hlocal : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + paperShiftedTupleRetainedAnchorRankUnary ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (compactVariableRank (noTautClauses formula) + ((paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).get + ⟨position, hposition⟩).1) true := by + unfold paperShiftedTupleRetainedAnchorRankUnary + rw [Function.comp_apply, + paperVariableArityShiftedTupleRetainedAnchorRankQuery_query + ranks row column formula rank hbound hrank + position hposition hlocal] + exact compactSourceVariableRankUnary_valid + (noTautClauses formula) + ((paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).get + ⟨position, hposition⟩).1 + +private noncomputable def paperShiftedTupleRetainedAnchorRankComputer + (ranks : PaperVariableArityShiftedTupleRankComputers) : + SourcePhysicalLagrangeWordComputer where + output := paperShiftedTupleRetainedAnchorRankUnary ranks + computer := + paperVariableArityShiftedTupleRetainedAnchorRankUnaryComputable ranks + +/-- GapCVP reduction support. -/ +def paperShiftedTupleRetainedAnchorFieldWord + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + physicalCellFieldWordAt + (paperShiftedTupleRetainedAnchorRankComputer ranks) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedTupleRetainedAnchorFieldWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleRetainedAnchorFieldWord ranks) := + physicalCellFieldWordAtComputable + (paperShiftedTupleRetainedAnchorRankComputer ranks) + +/-- GapCVP reduction support. -/ +noncomputable def paperShiftedTupleRetainedAnchorFieldComputer + (ranks : PaperVariableArityShiftedTupleRankComputers) : + SourcePhysicalLagrangeWordComputer where + output := paperShiftedTupleRetainedAnchorFieldWord ranks + computer := + paperVariableArityShiftedTupleRetainedAnchorFieldWordComputable ranks + +end ShiftedTupleBetaSourceCorrectness + +namespace SourceVariableRankBridge + +open Turing GapCVP.SourceMachineCert GapCVP.BinarySourceVariableCompaction +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.SourcePreprocessingPairwiseIdentity GapCVP.FormulaBridge + +private theorem paperVariableArityReverseNameEquality_false + {first second : ℕ} (hne : first ≠ second) : + (second == first) = false := by + exact beq_eq_false_iff_ne.mpr (Ne.symm hne) + +private theorem paperVariableAritySignedTripleFirstOccurrence_prefix_suffix + (seen : List ℕ) (first second third : Literal) + (suffix : List ℕ) : + (seen ++ [first.1, second.1, third.1] ++ suffix).eraseDups = + (seen ++ ([first, second, third].eraseDups).map Prod.fst ++ + suffix).eraseDups := by + classical + rw [paperSourceEraseDupsThree_pairwise] + by_cases hfirst : first = second <;> + by_cases hsecond : first = third <;> + by_cases hthird : second = third <;> + by_cases hname : first.1 = second.1 <;> + by_cases hseenFirst : first.1 ∈ seen <;> + by_cases hseenSecond : second.1 ∈ seen <;> + by_cases hseenThird : third.1 ∈ seen <;> + simp_all [List.eraseDups_append, List.removeAll, + List.eraseDups_cons, + paperVariableArityReverseNameEquality_false] + +private theorem paperVariableAritySignedClauseStreamFirstOccurrence + (clauses : List ThreeClause) (seen suffix : List ℕ) : + (seen ++ formulaVariables clauses ++ suffix).eraseDups = + (seen ++ + (clauses.flatMap fun clause => + (paperSourceNormalizedClause clause).map Prod.fst) ++ + suffix).eraseDups := by + induction clauses generalizing seen with + | nil => + simp only [formulaVariables, Fin.isValue, List.flatMap_nil, List.append_nil] + | cons clause remaining ih => + have head := paperVariableAritySignedTripleFirstOccurrence_prefix_suffix + seen (clause 0) (clause 1) (clause 2) + (formulaVariables remaining ++ suffix) + have rest := ih + (seen ++ (paperSourceNormalizedClause clause).map Prod.fst) + calc + (seen ++ formulaVariables (clause :: remaining) ++ suffix).eraseDups = + (seen ++ [(clause 0).1, (clause 1).1, (clause 2).1] ++ + (formulaVariables remaining ++ suffix)).eraseDups := by + simp only [formulaVariables, Fin.isValue, List.flatMap_cons, List.cons_append, + List.nil_append, + List.append_assoc] + _ = (seen ++ (paperSourceNormalizedClause clause).map Prod.fst ++ + (formulaVariables remaining ++ suffix)).eraseDups := by + simpa only [Fin.isValue, List.append_assoc, List.cons_append, List.nil_append, + paperSourceNormalizedClause, + paperSourceClauseLiterals] using head + _ = (seen ++ (paperSourceNormalizedClause clause).map Prod.fst ++ + ((remaining.flatMap fun item => + (paperSourceNormalizedClause item).map Prod.fst) ++ + suffix)).eraseDups := by + simpa only [List.append_assoc] using rest + _ = (seen ++ + ((clause :: remaining).flatMap fun item => + (paperSourceNormalizedClause item).map Prod.fst) ++ + suffix).eraseDups := by + simp only [List.append_assoc, List.flatMap_cons] + +private theorem paperVariableArityRetainedOccurringVariables_eq + (formula : ThreeCNF) : + occurringVariables + (noTautClauses formula) = + paperNormalizedOccurringVariables formula := by + have source := paperVariableAritySignedClauseStreamFirstOccurrence + (noTautClauses formula) [] [] + simpa only [occurringVariables, paperNormalizedOccurringVariables, + paperSourceNormalizedVariables, + paperSourceNormalizedClauses, List.flatMap_map, List.nil_append, List.append_nil] + using source + +private theorem paperVariableArityCompactVariableRank_eq + (formula : ThreeCNF) (name : ℕ) : + compactVariableRank + (noTautClauses formula) name = + paperVariableArityVariableRank formula name := by + unfold compactVariableRank paperVariableArityVariableRank + rw [paperVariableArityRetainedOccurringVariables_eq] + +end SourceVariableRankBridge + +namespace ShiftedTupleAnchorSourceFieldCorrectness + +open Turing GapCVP.BinaryEncoding GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.FormulaBridge GapCVP.SourceVariableRankBridge +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine +open GapCVP.ShiftedTupleBetaTM GapCVP.ShiftedTupleBetaSourceCorrectness + +theorem paperShiftedTupleRetainedNormalizedClause_mem + (formula : ThreeCNF) (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) : + paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩) ∈ paperSourceNormalizedClauses formula := by + unfold paperSourceNormalizedClauses + apply List.mem_map.mpr + exact ⟨(noTautClauses formula).get + ⟨rank, hbound⟩, + List.get_mem _ ⟨rank, hbound⟩, rfl⟩ + +/-- GapCVP reduction support. -/ +def paperShiftedTupleSelectedSourceVariableIndex + (formula : ThreeCNF) (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (position : ℕ) + (hposition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) : + Fin (paperVariableArityVariableCount formula) := + ⟨paperVariableArityVariableRank formula + ((paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).get ⟨position, hposition⟩).1, + paperVariableArityVariableRank_lt formula + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)) + (paperShiftedTupleRetainedNormalizedClause_mem + formula rank hbound) + ((paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).get ⟨position, hposition⟩) + (List.get_mem _ ⟨position, hposition⟩)⟩ + +private theorem paperVariableArityShiftedTupleRetainedAnchorRankUnary_paper_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (hposition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) + (hlocal : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + paperShiftedTupleRetainedAnchorRankUnary ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (paperVariableArityVariableRank formula + ((paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).get + ⟨position, hposition⟩).1) true := by + rw [paperVariableArityShiftedTupleRetainedAnchorRankUnary_query + ranks row column formula rank hbound hrank + position hposition hlocal, + paperVariableArityCompactVariableRank_eq] + +private theorem paperVariableArityShiftedTupleRetainedAnchorRankComputer_output + (ranks : PaperVariableArityShiftedTupleRankComputers) : + (paperShiftedTupleRetainedAnchorRankComputer ranks).output = + paperShiftedTupleRetainedAnchorRankUnary ranks := by + dsimp only [paperShiftedTupleRetainedAnchorRankComputer] + +/-- GapCVP reduction support. -/ +def paperShiftedTupleSelectedSourceVariableWord + (formula : ThreeCNF) (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (position : ℕ) + (hposition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) : + GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula) := + sourceFormulaVariableWord (encodeThreeCNF formula).length + (srcFormula formula) + (paperShiftedTupleSelectedSourceVariableIndex + formula rank hbound position hposition) + +theorem paperVariableArityShiftedTupleRetainedAnchorFieldWord_query + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (hrank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (hposition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) + (hlocal : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + paperShiftedTupleRetainedAnchorFieldWord ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (paperShiftedTupleSelectedSourceVariableWord + formula rank hbound position hposition) := by + let index := sourceFormulaVariableWordIndex + (encodeThreeCNF formula).length + (srcFormula formula) + (paperShiftedTupleSelectedSourceVariableIndex + formula rank hbound position hposition) + have hsource : + (paperShiftedTupleRetainedAnchorRankComputer ranks).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate index.val true := by + rw [paperVariableArityShiftedTupleRetainedAnchorRankComputer_output, + paperVariableArityShiftedTupleRetainedAnchorRankUnary_paper_query + ranks row column formula rank hbound hrank + position hposition hlocal] + rfl + have emitted := physicalCellFieldWordAt_valid + (paperShiftedTupleRetainedAnchorRankComputer ranks) + row column formula index hsource + simpa only [index, + sourceIrreducibleFormulaDegree, + paperShiftedTupleRetainedAnchorFieldWord, + paperShiftedTupleSelectedSourceVariableWord, + sourceFormulaVariableWord] using emitted + +theorem paperVariableArityShiftedTupleSelectedSourceVariableWord_sourceField + (formula : ThreeCNF) (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) + (position : ℕ) + (hposition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, hbound⟩)).length) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (paperShiftedTupleSelectedSourceVariableWord + formula rank hbound position hposition) = + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + (encodeThreeCNF formula).length + (srcFormula formula) + (paperShiftedTupleSelectedSourceVariableIndex + formula rank hbound position hposition) := by + rfl + +end ShiftedTupleAnchorSourceFieldCorrectness + +namespace ShiftedTupleBetaSourceFieldCorrectness + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.SourceIndexedClauseSignTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldBasis GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryCompactPhysicalLagrangeMomentWeightTM GapCVP.FormulaBridge +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine +open GapCVP.ShiftedTupleBetaTM + +private def paperShiftedTupleBetaRankUnary + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + sourceOriginalClauseBooleanUnaryOutput ∘ + paperShiftedTupleBetaBit ranks + +private noncomputable def paperVariableArityShiftedTupleBetaRankUnaryComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleBetaRankUnary ranks) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityShiftedTupleBetaBitComputable ranks) + sourceOriginalClauseBooleanUnaryComputable + +private theorem paperVariableArityShiftedTupleBetaRankUnary_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (input : List Bool) (bit : Bool) + (hbit : paperShiftedTupleBetaBit ranks input = [bit]) : + paperShiftedTupleBetaRankUnary ranks input = + List.replicate (if bit then 1 else 0) true := by + unfold paperShiftedTupleBetaRankUnary + rw [Function.comp_apply, hbit] + exact sourceOriginalClauseBooleanUnaryOutput_bit bit + +private noncomputable def paperShiftedTupleBetaRankComputer + (ranks : PaperVariableArityShiftedTupleRankComputers) : + SourcePhysicalLagrangeWordComputer where + output := paperShiftedTupleBetaRankUnary ranks + computer := paperVariableArityShiftedTupleBetaRankUnaryComputable ranks + +private theorem paperVariableArityShiftedTupleBetaRankComputer_output + (ranks : PaperVariableArityShiftedTupleRankComputers) : + (paperShiftedTupleBetaRankComputer ranks).output = + paperShiftedTupleBetaRankUnary ranks := by + dsimp only [paperShiftedTupleBetaRankComputer] + +private theorem paperVariableArityShiftedTupleSourceFieldDegree_pos + (formula : ThreeCNF) : + 0 < sourceIrreducibleFormulaDegree formula := by + unfold sourceIrreducibleFormulaDegree + exact sourceFieldExponent_pos + (sourceSizeParameter_ge_one_hundred + (encodeThreeCNF formula).length + (srcFormula formula)) + +/-- GapCVP reduction support. -/ +def paperShiftedTupleBetaFieldIndex + (formula : ThreeCNF) (bit : Bool) : + Fin (2 ^ sourceIrreducibleFormulaDegree formula) := by + refine ⟨if bit then 1 else 0, ?_⟩ + cases bit + · simp only [Bool.false_eq_true, ↓reduceIte, Order.lt_two_iff, zero_le, pow_pos] + · exact Nat.one_lt_two_pow + (Nat.ne_of_gt + (paperVariableArityShiftedTupleSourceFieldDegree_pos formula)) + +/-- GapCVP reduction support. -/ +def paperShiftedTupleBetaFieldWord + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + physicalCellFieldWordAt + (paperShiftedTupleBetaRankComputer ranks) + +private noncomputable def paperVariableArityShiftedTupleBetaFieldWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (paperShiftedTupleBetaFieldWord ranks) := + physicalCellFieldWordAtComputable + (paperShiftedTupleBetaRankComputer ranks) + +/-- GapCVP reduction support. -/ +noncomputable def paperShiftedTupleBetaFieldComputer + (ranks : PaperVariableArityShiftedTupleRankComputers) : + SourcePhysicalLagrangeWordComputer where + output := paperShiftedTupleBetaFieldWord ranks + computer := paperVariableArityShiftedTupleBetaFieldWordComputable ranks + +theorem paperVariableArityShiftedTupleBetaFieldComputer_output + (ranks : PaperVariableArityShiftedTupleRankComputers) : + (paperShiftedTupleBetaFieldComputer ranks).output = + paperShiftedTupleBetaFieldWord ranks := by + dsimp only [paperShiftedTupleBetaFieldComputer] + +theorem paperVariableArityShiftedTupleBetaFieldWord_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) (bit : Bool) + (hbit : paperShiftedTupleBetaBit ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = [bit]) : + paperShiftedTupleBetaFieldWord ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (indexedWord (sourceIrreducibleFormulaDegree formula) + (paperShiftedTupleBetaFieldIndex formula bit)) := by + have hsource : + (paperShiftedTupleBetaRankComputer ranks).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (paperShiftedTupleBetaFieldIndex formula bit).val + true := by + rw [paperVariableArityShiftedTupleBetaRankComputer_output, + paperVariableArityShiftedTupleBetaRankUnary_valid + ranks (affineCellQuery row column + (encodeThreeCNF formula)) bit hbit] + rfl + exact physicalCellFieldWordAt_valid + (paperShiftedTupleBetaRankComputer ranks) + row column formula + (paperShiftedTupleBetaFieldIndex formula bit) + hsource + +private theorem paperVariableArityShiftedTupleIndexedZeroWord + (degree : ℕ) : + indexedWord degree ⟨0, by positivity⟩ = zeroWord degree := by + funext position + simp only [indexedWord, Nat.zero_testBit, zeroWord] + +private theorem paperVariableArityShiftedTupleZeroWord_sourceField + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) : + sourceWordValue encodingLength formula + (zeroWord + (sourceFieldExponent + (sourceSizeParameter encodingLength formula))) = 0 := by + unfold sourceWordValue + GapCVP.BinaryFieldBasis.wordElement + rw [wordPolynomial_zeroWord, map_zero, map_zero] + +theorem paperVariableArityShiftedTupleBetaIndexedWord_sourceField + (formula : ThreeCNF) (bit : Bool) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (indexedWord (sourceIrreducibleFormulaDegree formula) + (paperShiftedTupleBetaFieldIndex formula bit)) = + sourceSATFieldBit + (K := GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + (encodeThreeCNF formula).length + (srcFormula formula)) bit := by + cases bit + · have hzero : + indexedWord + (sourceIrreducibleFormulaDegree formula) + (paperShiftedTupleBetaFieldIndex formula false) = + zeroWord + (sourceIrreducibleFormulaDegree formula) := by + exact paperVariableArityShiftedTupleIndexedZeroWord + (sourceIrreducibleFormulaDegree formula) + rw [hzero] + change sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (zeroWord (sourceFieldExponent + (sourceSizeParameter (encodeThreeCNF formula).length + (srcFormula formula)))) = _ + rw [paperVariableArityShiftedTupleZeroWord_sourceField] + simp only [sourceSATFieldBit, Bool.false_eq_true, ↓reduceIte] + · have hdegree := paperVariableArityShiftedTupleSourceFieldDegree_pos formula + have hone : + indexedWord + (sourceIrreducibleFormulaDegree formula) + (paperShiftedTupleBetaFieldIndex formula true) = + oneWord + (sourceIrreducibleFormulaDegree formula) := by + exact compactPhysicalLagrangeIndexedOneWord + (sourceIrreducibleFormulaDegree formula) hdegree + rw [hone] + change sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (oneWord (sourceFieldExponent + (sourceSizeParameter (encodeThreeCNF formula).length + (srcFormula formula)))) = _ + rw [sourceWordValue_oneWord] + simp only [sourceSATFieldBit, ↓reduceIte] + +end ShiftedTupleBetaSourceFieldCorrectness + +namespace PhysicalShiftedInterpolationBaseTM + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldBasis GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinaryCompactPhysicalFieldWordXorTM GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalGlobalRefinementCoefficientTM GapCVP.PhysicalOrdinaryShiftedCoefficientTM +open GapCVP.PhysicalRefinementRowProjection +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine +open GapCVP.ShiftedTupleBetaTM GapCVP.ShiftedTupleBetaSourceCorrectness +open GapCVP.ShiftedTupleBetaSourceFieldCorrectness +open GapCVP.ShiftedTupleAnchorSourceFieldCorrectness + +private noncomputable def paperVariableArityPhysicalShiftedColumnValueRankComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalColumnFieldValueRankUnary + computer := paperVariableArityPhysicalColumnFieldValueRankUnaryComputable + +/-- GapCVP reduction support. -/ +def physicalShiftedColumnValueWord : + List Bool → List Bool := + physicalCellFieldWordAt + paperVariableArityPhysicalShiftedColumnValueRankComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedColumnValueWordComputable : + BitTM + physicalShiftedColumnValueWord := + physicalCellFieldWordAtComputable + paperVariableArityPhysicalShiftedColumnValueRankComputer + +/-- GapCVP reduction support. -/ +noncomputable def physicalShiftedColumnValueComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalShiftedColumnValueWord + computer := paperVariableArityPhysicalShiftedColumnValueWordComputable + +private def physicalShiftedColumnValueIndex + (formula : ThreeCNF) (column : ℕ) : + Fin (2 ^ sourceIrreducibleFormulaDegree formula) := + ⟨column % physFieldCard formula, + Nat.mod_lt _ + (physicalCoefficientFieldCardinality_pos formula)⟩ + +/-- GapCVP reduction support. -/ +def physicalShiftedColumnValueSourceWord + (formula : ThreeCNF) (column : ℕ) : + GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula) := + indexedWord (sourceIrreducibleFormulaDegree formula) + (physicalShiftedColumnValueIndex formula column) + +theorem paperVariableArityPhysicalShiftedColumnValueWord_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalShiftedColumnValueWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (physicalShiftedColumnValueSourceWord + formula column) := by + unfold physicalShiftedColumnValueWord + physicalShiftedColumnValueSourceWord + apply physicalCellFieldWordAt_valid + paperVariableArityPhysicalShiftedColumnValueRankComputer + row column formula + (physicalShiftedColumnValueIndex formula column) + change physicalColumnFieldValueRankUnary + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (column % physFieldCard formula) + true + exact paperVariableArityPhysicalColumnFieldValueRankUnary_query + row column formula + +private noncomputable def paperVariableArityPhysicalShiftedColumnGridRankComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalColumnGridRankUnary + computer := physicalColumnGridRankUnaryComputable + +/-- GapCVP reduction support. -/ +def physicalShiftedColumnGridWord : + List Bool → List Bool := + physicalCellGridWordAt + paperVariableArityPhysicalShiftedColumnGridRankComputer + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedColumnGridWordComputable : + BitTM + physicalShiftedColumnGridWord := + paperVariableArityPhysicalCellGridWordAtComputable + paperVariableArityPhysicalShiftedColumnGridRankComputer + +/-- GapCVP reduction support. -/ +noncomputable def physicalShiftedColumnGridComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalShiftedColumnGridWord + computer := paperVariableArityPhysicalShiftedColumnGridWordComputable + +/-- GapCVP reduction support. -/ +def physicalShiftedColumnGridIndex + (formula : ThreeCNF) (column : ℕ) : + Fin (2 ^ sourceIrreducibleFormulaDegree formula - + (srcFormula formula).variableCount) := + ⟨(column / physFieldCard formula) % + physGridCard formula, + Nat.mod_lt _ + (physicalRefinementGridCard_pos formula)⟩ + +/-- GapCVP reduction support. -/ +def physicalShiftedColumnGridSourceWord + (formula : ThreeCNF) (column : ℕ) : + GapCVP.Core.EffectiveBinaryField.Word + (sourceIrreducibleFormulaDegree formula) := + indexedWord (sourceIrreducibleFormulaDegree formula) + (evaluationWordIndex + (GapCVP.Factor400BinaryConstructiveSourcePlaces.variableCount_le_fieldWordCount + (encodeThreeCNF formula).length + (srcFormula formula)) + (physicalShiftedColumnGridIndex formula column)) + +theorem paperVariableArityPhysicalShiftedColumnGridWord_valid + (row column : ℕ) (formula : ThreeCNF) : + physicalShiftedColumnGridWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (physicalShiftedColumnGridSourceWord + formula column) := by + unfold physicalShiftedColumnGridWord + physicalShiftedColumnGridSourceWord + apply paperVariableArityPhysicalCellGridWordAt_valid + paperVariableArityPhysicalShiftedColumnGridRankComputer + row column formula + (physicalShiftedColumnGridIndex formula column) + simp only [paperVariableArityPhysicalShiftedColumnGridRankComputer, + physicalShiftedColumnGridIndex] + exact paperVariableArityPhysicalColumnGridRankUnary_query + row column formula + +/-- GapCVP reduction support. -/ +noncomputable def physicalShiftedInterpolationNumeratorComputer + (ranks : PaperVariableArityShiftedTupleRankComputers) : + SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalInterpolationDifferenceComputer + physicalShiftedColumnValueComputer + (paperShiftedTupleBetaFieldComputer ranks) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityPhysicalShiftedInterpolationDenominatorComputer + (ranks : PaperVariableArityShiftedTupleRankComputers) : + SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalInterpolationDifferenceComputer + physicalShiftedColumnGridComputer + (paperShiftedTupleRetainedAnchorFieldComputer ranks) + +/-- GapCVP reduction support. -/ +def physicalShiftedInterpolationBaseWord + (ranks : PaperVariableArityShiftedTupleRankComputers) : + List Bool → List Bool := + paperVariableArityPhysicalInterpolationProductWord + (physicalShiftedInterpolationNumeratorComputer ranks) + (paperVariableArityPhysicalCellInverseComputer + (paperVariableArityPhysicalShiftedInterpolationDenominatorComputer + ranks)) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedInterpolationBaseWordComputable + (ranks : PaperVariableArityShiftedTupleRankComputers) : + BitTM + (physicalShiftedInterpolationBaseWord ranks) := + paperVariableArityPhysicalInterpolationProductWordComputable + (physicalShiftedInterpolationNumeratorComputer ranks) + (paperVariableArityPhysicalCellInverseComputer + (paperVariableArityPhysicalShiftedInterpolationDenominatorComputer + ranks)) + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityPhysicalShiftedInterpolationBaseComputer + (ranks : PaperVariableArityShiftedTupleRankComputers) : + SourcePhysicalLagrangeWordComputer where + output := physicalShiftedInterpolationBaseWord ranks + computer := paperVariableArityPhysicalShiftedInterpolationBaseWordComputable + ranks + +/-- GapCVP reduction support. -/ +def physicalShiftedInterpolationBaseSourceWord + (formula : ThreeCNF) (column rank : ℕ) + (bounded : rank < (noTautClauses formula).length) + (position : ℕ) + (validPosition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, bounded⟩)).length) + (bit : Bool) : + GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula) := + multiplyMod + (irreducibleWord (physDegree formula)) + (compactPhysicalFieldWordXorValue + (physicalShiftedColumnValueSourceWord + formula column) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (paperShiftedTupleBetaFieldIndex formula bit))) + (sourceInverseWord + (compactPhysicalFieldWordXorValue + (physicalShiftedColumnGridSourceWord + formula column) + (paperShiftedTupleSelectedSourceVariableWord + formula rank bounded position validPosition))) + +end PhysicalShiftedInterpolationBaseTM + +namespace PhysicalInterpolationColumnSourceFieldCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryFieldBasis GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinarySourceCoordinateOrder GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalColumnOrderProjection +open GapCVP.PhysicalLagrangeNodeProductAlgebra GapCVP.PhysicalShiftedInterpolationBaseTM +open GapCVP.SourceOrder + +private theorem sourceIndexedWord_sourceFieldCardOrder_symm_val + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (index : Fin (2 ^ sourceFormulaWordDegree encodingLength formula)) : + ((sourceFormulaFieldCardOrder encodingLength formula).symm + (sourceWordValue encodingLength formula + (indexedWord + (sourceFormulaWordDegree encodingLength formula) index))).val = + index.val := by + change + ((((finCongr + (sourceFormulaFieldWordOrder_card encodingLength formula)).trans + (sourceFormulaFieldWordOrder encodingLength formula)).symm + ((sourceFormulaFieldWordOrder encodingLength formula) index))).val = + index.val + simp only [Equiv.symm_trans, finCongr_symm, Equiv.trans_apply, Equiv.symm_apply_apply, + finCongr_apply, + Fin.val_cast] + +private theorem sourceGridWord_sourceGridCardOrder_symm_val + (encodingLength : ℕ) (formula : GapCVP.Core.Formula) + (index : Fin + (2 ^ sourceFormulaWordDegree encodingLength formula - + formula.variableCount)) : + ((sourceFormulaGridOrder encodingLength formula).symm + (sourceFormulaGridWordOrder encodingLength formula index)).val = + index.val := by + change + ((((finCongr + (sourceFormulaGrid_card_eq_fieldWordCount encodingLength formula)).trans + (sourceFormulaGridWordOrder encodingLength formula)).symm + ((sourceFormulaGridWordOrder encodingLength formula) index))).val = + index.val + simp only [Equiv.symm_trans, finCongr_symm, Equiv.trans_apply, Equiv.symm_apply_apply, + finCongr_apply, + Fin.val_cast] + +theorem paperVariableArityPhysicalInterpolationColumnValueSourceWord_sourceField + (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnValueSourceWord + formula column.val) = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 := by + apply (sourceFormulaFieldCardOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm.injective + apply Fin.ext + calc + ((sourceFormulaFieldCardOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnValueSourceWord + formula column.val))).val = + (physicalShiftedColumnValueIndex + formula column.val).val := by + exact sourceIndexedWord_sourceFieldCardOrder_symm_val + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnValueIndex + formula column.val) + _ = column.val % + physFieldCard formula := by + rfl + _ = ((sourceFormulaFieldCardOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2)).val := by + symm + simpa only [physicalFormulaFieldCardinality_eq_card] + using paperVariableAritySourceCoordinateFieldWordRank + (encodeThreeCNF formula).length formula column + +private theorem paperVariableArityPhysicalInterpolationColumnGridPoint_eq_sourceCoordinate + (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) : + sourceFormulaGridWordOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnGridIndex + formula column.val) = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1 := by + apply (sourceFormulaGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm.injective + apply Fin.ext + calc + ((sourceFormulaGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceFormulaGridWordOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnGridIndex + formula column.val))).val = + (physicalShiftedColumnGridIndex + formula column.val).val := by + exact sourceGridWord_sourceGridCardOrder_symm_val + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnGridIndex + formula column.val) + _ = (column.val / + physFieldCard formula) % + physGridCard formula := by + rfl + _ = ((sourceFormulaGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1)).val := by + symm + simpa only + [physicalFormulaFieldCardinality_eq_card, + physicalFormulaGridCardinality_eq_card] + using sourceCoordinateGridWordRank + (encodeThreeCNF formula).length formula column + +theorem paperVariableArityPhysicalInterpolationColumnGridSourceWord_sourceField + (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnGridSourceWord + formula column.val) = + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1).val := by + calc + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnGridSourceWord + formula column.val) = + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnGridIndex + formula column.val) := by + exact physicalLagrangeNodeEvaluationWord_sourceField + formula + (physicalShiftedColumnGridIndex + formula column.val) + _ = ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1).val := by + exact congrArg Subtype.val + (paperVariableArityPhysicalInterpolationColumnGridPoint_eq_sourceCoordinate + formula column) + +end PhysicalInterpolationColumnSourceFieldCorrectness + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open Turing GapCVP.Core GapCVP.Core.EffectiveBinaryField GapCVP.BinaryEncoding +open GapCVP.SourceFourFamilyBooleanPredicateTM GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryCompactPhysicalFieldBasisCoordinates GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalFamilyMarkerTM GapCVP.PhysicalFieldWordSemantics +open GapCVP.PhysicalOrdinaryInterpolationCheckFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationTypeMatchCorrectness +open GapCVP.PhysicalShiftedInterpolationBaseTM GapCVP.SourceOrder +open GapCVP.SourceFieldMomentOperationsTM + +theorem paperVariableArityPhysicalSourceWordBasisCoordinate_decide + (formula : ThreeCNF) + (word : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) + (index : Fin (physDegree formula)) : + decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) word) + index = (1 : ZMod 2)) = word index := by + rw [sourceFormulaFieldBasis_sourceWordValue_coordinate] + cases word index <;> simp [bitValue] + +theorem paperVariableArityPhysicalSourceBasisCoordinate_sub_decide + (formula : ThreeCNF) + (first second : PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula) + (index : Fin (physDegree formula)) : + decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (first - second) index = (1 : ZMod 2)) = + Bool.xor + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + first index = (1 : ZMod 2))) + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + second index = (1 : ZMod 2))) := by + apply GapCVP.Core.EffectiveBinaryField.bitValue_injective + rw [GapCVP.Core.EffectiveBinaryField.bitValue_xor, + paperVariableArityPhysicalBitValue_decide, + paperVariableArityPhysicalBitValue_decide, + paperVariableArityPhysicalBitValue_decide, map_sub] + exact CharTwo.sub_eq_add _ _ + +private theorem paperVariableArityPhysicalBooleanAnd_false_of_first + (first second : List Bool → List Bool) + (input : List Bool) + (rejected : first input = [false]) : + sourceFourFamilyBooleanAndOutput first second input = [false] := by + change sourceFourFamilyBooleanAndPairWord + (first input ++ second input) = [false] + rw [rejected] + rfl + +theorem paperVariableArityPhysicalOrdinaryCheckBit_of_not_in_family + (formula : ThreeCNF) (row column : ℕ) + (outside : ¬ + (physicalFormulaRefinementBoundary formula ≤ row ∧ + row < physicalFormulaOrdinaryBoundary formula)) : + physicalOrdinaryCheckBit + (affineCellQuery row column + (encodeThreeCNF formula)) = [false] := by + let query := affineCellQuery row column + (encodeThreeCNF formula) + have rejected : + physicalOrdinaryRowMarker query = [false] := by + change physicalOrdinaryRowMarker + (affineCellQuery row column + (encodeThreeCNF formula)) = [false] + rw [paperVariableArityPhysicalOrdinaryRowMarker_query] + simp only [outside, decide_false] + unfold physicalOrdinaryCheckBit + physicalSourceInterpolationFamilyCheckBit + exact paperVariableArityPhysicalBooleanAnd_false_of_first + physicalOrdinaryRowMarker _ query rejected + +theorem paperVariableArityPhysicalOrdinaryColumnFieldComputer_valid + (formula : ThreeCNF) (row : ℕ) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalInterpolationColumnFieldComputer.output + (affineCellQuery row column.val + (encodeThreeCNF formula)) = + finiteWordBits + (physicalShiftedColumnValueSourceWord + formula column.val) := by + rw [paperVariableArityPhysicalInterpolationColumnFieldComputer_output] + exact paperVariableArityPhysicalInterpolationColumnFieldWord_valid + row column.val formula + (physicalShiftedColumnValueIndex + formula column.val) rfl + +theorem paperVariableArityPhysicalOrdinaryFamilyStart_eq_refinement + (formula : ThreeCNF) : + physicalFamilyStart (2 : Fin 4) formula = + physicalFormulaRefinementBoundary formula := by + rfl + +theorem paperVariableArityPhysicalOrdinaryExpectedTypeMatchBit_eq_sourceTable + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + physicalInterpolationExpectedTypeMatchBit + (physicalInterpolationFamilyTypeRankComputer + (2 : Fin 4)) + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalOrdinarySourceRowTableMoment + formula row inOrdinary).1 = + (GapCVP.SourceOrder.sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1)] := by + have actual := paperVariableArityPhysicalOrdinarySourceRowTable_eq_column_iff + formula row column inOrdinary + have computed := paperVariableArityPhysicalOrdinaryExpectedTypeMatchBit_valid + formula row.val column.val + rw [paperVariableArityPhysicalOrdinaryFamilyStart_eq_refinement] at computed + by_cases selected : + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).1 = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 + · have rank := actual.mp selected + simpa only [rank, selected, decide_true] using computed + · have rank : ¬ + ((((row.val - + physicalFormulaRefinementBoundary formula) / + physDegree formula) / + physGridCard formula) / + physicalFormulaMomentCount formula = + (column.val / + physFieldCard formula) / + physGridCard formula) := by + intro equal + exact selected (actual.mpr equal) + simpa only [rank, selected, decide_false] using computed + +end PhysicalOrdinaryShiftedCheckBitInstantiation + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part16.lean b/LeanPool/GapCVP/Part16.lean new file mode 100644 index 000000000..44757028b --- /dev/null +++ b/LeanPool/GapCVP/Part16.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part16B + +/-! # GapCVP proof, part 16 -/ diff --git a/LeanPool/GapCVP/Part16A.lean b/LeanPool/GapCVP/Part16A.lean new file mode 100644 index 000000000..88bdec68a --- /dev/null +++ b/LeanPool/GapCVP/Part16A.lean @@ -0,0 +1,6038 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part15 +import Mathlib.Data.List.Intervals + +/-! # GapCVP proof, part 16 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) +open GapCVP.PhysicalInterpolationColumnSourceFieldCorrectness + +namespace PhysicalOrdinaryInterpolationParityFieldCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem +open GapCVP.BinaryPhysicalLagrangeParityEntry GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationNodeCountBounds GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryInterpolationCheckFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationRowGridBasisCorrectness +open GapCVP.SourceFieldMomentOperationsTM GapCVP.SourceOrder GapCVP.BinaryReedSolomonParity +open GapCVP.BinarySourceCoordinateOrder + +private theorem paperVariableArityPhysicalOrderedLagrangeParity_eq_selectedCorrection + {K : Type*} [Field K] + {gridCardinality degreeBound : ℕ} + (points : Fin gridCardinality → K) + (hdegree : degreeBound < gridCardinality) + (row position : Fin gridCardinality) : + constructiveParityMatrix points hdegree row position = + (if row = position then (1 : K) else 0) - + if hposition : position.val < degreeBound + 1 then + ∏ other ∈ (Finset.univ.erase + (⟨position.val, hposition⟩ : Fin (degreeBound + 1))), + (points + (Fin.castLE (Nat.succ_le_of_lt hdegree) + (⟨position.val, hposition⟩ : Fin (degreeBound + 1))) - + points (Fin.castLE (Nat.succ_le_of_lt hdegree) other))⁻¹ * + (points row - + points (Fin.castLE (Nat.succ_le_of_lt hdegree) other)) + else 0 := by + classical + rw [constructiveParityMatrix_apply_eq_orderedNodeProducts] + congr 1 + by_cases hposition : position.val < degreeBound + 1 + · simp only [dite_eq_left hposition] + let selected : Fin (degreeBound + 1) := + ⟨position.val, hposition⟩ + have hcast (node : Fin (degreeBound + 1)) : + Fin.castLE (Nat.succ_le_of_lt hdegree) node = position ↔ + node = selected := by + constructor + · intro equality + apply Fin.ext + exact congrArg (fun value : Fin gridCardinality => value.val) equality + · intro equality + subst node + apply Fin.ext + rfl + simp_rw [ite_mul, one_mul, zero_mul, hcast] + simp only [Nat.succ_eq_add_one, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, Fin.castLE_mk, + Fin.eta, + selected] + · simp only [dite_eq_right hposition] + have hcast (node : Fin (degreeBound + 1)) : + Fin.castLE (Nat.succ_le_of_lt hdegree) node ≠ position := by + intro equality + apply hposition + have rank := congrArg Fin.val equality + simpa only [Fin.val_castLE] using (rank ▸ node.isLt) + simp only [Nat.succ_eq_add_one, hcast, ↓reduceIte, zero_mul, Finset.sum_const_zero] + +private theorem paperVariableArityPhysicalOrdinaryMaskedNodeSum_eq_selected + {K : Type*} [AddCommMonoid K] + (count grid : ℕ) (value : ℕ → K) : + (((List.range count).map (fun node => + if node = grid then value node else 0)).sum) = + if grid < count then value grid else 0 := by + change (∑ node ∈ Finset.range count, + if node = grid then value node else 0) = _ + simp only [Finset.sum_ite_eq', Finset.mem_range] + +private theorem paperVariableArityPhysicalExplicitGridOrder_value_eq_evaluation + (formula : ThreeCNF) + (index : Fin (Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)))) : + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val = + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) index) := by + rfl + +private theorem paperVariableArityPhysicalOrdinarySourceRowMoment_eq_family + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val = + physicalFamilyRowMoment (2 : Fin 4) + row.val formula := by + simpa only [physicalFamilyRowMoment, physicalFamilyStart, Fin.isValue, Fin.coe_ofNat_eq_mod, + Nat.reduceMod, + OfNat.ofNat_ne_zero, ↓reduceIte, OfNat.ofNat_ne_one] using + paperVariableArityPhysicalOrdinarySourceRowMoment_val formula row inOrdinary + +private theorem paperVariableArityPhysicalOrdinarySourceRowNodeCount + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + physicalOrdinaryInterpolationNodeCount + row.val formula = + (srcFormula formula).variableCount * + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val + 1 := by + unfold physicalOrdinaryInterpolationNodeCount + rw [paperVariableArityPhysicalOrdinarySourceRowMoment_eq_family + formula row inOrdinary] + +end PhysicalOrdinaryInterpolationParityFieldCorrectness + +open GapCVP.PhysicalOrdinaryInterpolationParityFieldCorrectness + +namespace PhysicalOrdinaryInterpolationSelectedSourceWeightCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryFieldInverseAlgebra +open GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationColumnSourceFieldCorrectness +open GapCVP.PhysicalInterpolationNodeCountBounds GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalInterpolationNodeWeightTM +open GapCVP.PhysicalInterpolationNodeWeightSourceFieldCorrectness +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryInterpolationCheckFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationParityFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationRowGridBasisCorrectness +open GapCVP.PhysicalShiftedInterpolationBaseTM GapCVP.SourceFieldMomentOperationsTM +open GapCVP.SourceOrder GapCVP.BinarySourceCoordinateOrder + +private def physicalOrdinaryInterpolationExplicitNode + (formula : ThreeCNF) (row : ℕ) + (node : Fin + (physicalOrdinaryInterpolationNodeCount row formula)) : + Fin (Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula))) := + Fin.castLE (by + rw [physicalInterpolationExplicitGridCardinality_eq] + exact physicalOrdinaryInterpolationNodeCount_le_grid + formula row) node + +private theorem paperVariableArityPhysicalOrdinaryInterpolationExplicitNode_value + (formula : ThreeCNF) (row : ℕ) + (node : Fin + (physicalOrdinaryInterpolationNodeCount row formula)) : + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row node)).val = + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (Fin.castLE + (physicalOrdinaryInterpolationNodeCount_le_grid + formula row) node) := by + rw [paperVariableArityPhysicalExplicitGridOrder_value_eq_evaluation] + congr 1 + +private theorem paperVariableArityPhysicalOrdinarySourceRowGridEvaluation + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinarySourceRowGrid + formula row inOrdinary)).val = + sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationFamilyRowGridPosition + (2 : Fin 4) row.val formula) := by + rw [paperVariableArityPhysicalExplicitGridOrder_value_eq_evaluation] + congr 1 + apply Fin.ext + change + (physicalOrdinarySourceRowGrid + formula row inOrdinary).val = + (((row.val - physicalFamilyStart + (2 : Fin 4) formula) / + physDegree formula) % + physGridCard formula) + simpa only [physicalFamilyStart, Fin.isValue, Fin.coe_ofNat_eq_mod, Nat.reduceMod, + OfNat.ofNat_ne_zero, + ↓reduceIte, OfNat.ofNat_ne_one] using paperVariableArityPhysicalOrdinarySourceRowGrid_val + formula row inOrdinary + +private theorem paperVariableArityPhysicalOrdinaryInterpolationNodeWeight_eq_explicitProducts + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) + (node : Fin (physicalOrdinaryInterpolationNodeCount + row.val formula)) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeWeightSourceWord + (2 : Fin 4) row.val formula + (physicalOrdinaryInterpolationNodeCount + row.val formula) + (physicalOrdinaryInterpolationNodeCount_le_grid + formula row.val) + node + (physicalShiftedColumnValueSourceWord + formula column.val)) = + (∏ other ∈ (Finset.univ.erase node), + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinarySourceRowGrid + formula row inOrdinary)).val - + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val other)).val)) * + (∏ other ∈ (Finset.univ.erase node), + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val node)).val - + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val other)).val))⁻¹ * + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val := by + rw [paperVariableArityPhysicalInterpolationNodeWeightSourceWord_sourceField] + simp_rw [paperVariableArityPhysicalOrdinarySourceRowGridEvaluation, + paperVariableArityPhysicalOrdinaryInterpolationExplicitNode_value, + paperVariableArityPhysicalInterpolationColumnValueSourceWord_sourceField, + paperVariableArityPhysicalOrdinarySourceRowMoment_eq_family] + +end PhysicalOrdinaryInterpolationSelectedSourceWeightCorrectness + +namespace PhysicalOrdinaryInterpolationSourceParityCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryFieldInverseAlgebra +open GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationNodeCountBounds GapCVP.PhysicalInterpolationNodeWeightTM +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryInterpolationCheckFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationParityFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationSelectedSourceWeightCorrectness +open GapCVP.PhysicalOrdinaryShiftedCheckBitInstantiation +open GapCVP.PhysicalShiftedInterpolationBaseTM GapCVP.SourceOrder GapCVP.BinaryReedSolomonParity + +private theorem paperVariableArityPhysicalOrdinaryErasedNodeProductAlgebra + {K : Type*} [Field K] + {ι : Type*} + (nodes : Finset ι) + (numerator denominator : ι → K) + (value : K) : + (nodes.prod (fun other => (denominator other)⁻¹ * numerator other)) * + value = + nodes.prod numerator * (nodes.prod denominator)⁻¹ * value := by + classical + rw [Finset.prod_mul_distrib, Finset.prod_inv_distrib] + ac_rfl + +private theorem paperVariableArityPhysicalOrdinarySelectedNodeWeightProduct + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) + (node : Fin (physicalOrdinaryInterpolationNodeCount + row.val formula)) : + (∏ other ∈ (Finset.univ.erase node), + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val node)).val - + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val other)).val)⁻¹ * + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinarySourceRowGrid + formula row inOrdinary)).val - + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val other)).val)) * + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val = + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeWeightSourceWord + (2 : Fin 4) row.val formula + (physicalOrdinaryInterpolationNodeCount + row.val formula) + (physicalOrdinaryInterpolationNodeCount_le_grid + formula row.val) node + (physicalShiftedColumnValueSourceWord + formula column.val)) := by + rw [paperVariableArityPhysicalOrdinaryInterpolationNodeWeight_eq_explicitProducts + formula row column inOrdinary node] + exact paperVariableArityPhysicalOrdinaryErasedNodeProductAlgebra + (Finset.univ.erase node) + (fun other => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinarySourceRowGrid + formula row inOrdinary)).val - + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val other)).val) + (fun other => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val node)).val - + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinaryInterpolationExplicitNode + formula row.val other)).val) + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val) + +private theorem paperVariableArityPhysicalOrdinaryParityCorrection_mul_masked_sum + {K ι : Type*} [Field K] [DecidableEq ι] + (matrix : K) (row position : ι) (value : K) + (count index : ℕ) (nodeValue : ℕ → K) + (correction : index < count → K) + (hparity : matrix = + (if row = position then 1 else 0) - + dite (index < count) correction (fun _ => 0)) + (hselected : ∀ selected : index < count, + correction selected * value = nodeValue index) : + matrix * value = + (if row = position then value else 0) - + (((List.range count).map (fun node => + if node = index then nodeValue node else 0)).sum) := by + rw [hparity, sub_mul, + paperVariableArityPhysicalOrdinaryMaskedNodeSum_eq_selected] + simp only [ite_mul, one_mul, zero_mul] + congr 1 + by_cases selected : index < count + · simp only [dite_eq_left selected, ite_eq_left selected] + exact hselected selected + · simp only [dite_eq_right selected, ite_eq_right selected, zero_mul] + +private theorem paperVariableArityPhysicalOrdinaryOrderedLagrangeParity_count + {K : Type*} [Field K] {gridCardinality degreeBound count : ℕ} + (points : Fin gridCardinality → K) + (hdegree : degreeBound < gridCardinality) + (hcount : count = degreeBound + 1) + (hcountGrid : count ≤ gridCardinality) + (row position : Fin gridCardinality) : + constructiveParityMatrix points hdegree row position = + (if row = position then (1 : K) else 0) - + if hposition : position.val < count then + ∏ other ∈ (Finset.univ.erase (⟨position.val, hposition⟩ : Fin count)), + (points (Fin.castLE hcountGrid + (⟨position.val, hposition⟩ : Fin count)) - + points (Fin.castLE hcountGrid other))⁻¹ * + (points row - points (Fin.castLE hcountGrid other)) + else 0 := by + subst count + simpa only [Order.lt_add_one_iff, Fin.castLE_mk, Fin.eta, Nat.succ_eq_add_one] using + paperVariableArityPhysicalOrderedLagrangeParity_eq_selectedCorrection points hdegree row + position + +private theorem paperVariableArityPhysicalOrdinaryInterpolationSourceParity_eq + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val) + (explicitOrdinaryDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2) + (physicalOrdinarySourceRowGrid + formula row inOrdinary) + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1) * + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val = + (if physicalOrdinarySourceRowGrid + formula row inOrdinary = + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1) + then + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val + else 0) - + (((List.range + (physicalOrdinaryInterpolationNodeCount + row.val formula)).map (fun node => + if node = + (((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1)).val + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + (2 : Fin 4) row.val formula + (physicalOrdinaryInterpolationNodeCount + row.val formula) + (physicalOrdinaryInterpolationNodeCount_le_grid + formula row.val) + (physicalShiftedColumnValueSourceWord + formula column.val) node) + else 0)).sum) := by + classical + let sourceMoment := + physicalOrdinarySourceRowTableMoment + formula row inOrdinary + let sourceRow := physicalOrdinarySourceRowGrid + formula row inOrdinary + let sourceColumn := sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column + let sourcePosition := + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm sourceColumn.2.1 + let count := physicalOrdinaryInterpolationNodeCount + row.val formula + have count_eq : + count = (srcFormula formula).variableCount * + sourceMoment.2.val + 1 := + paperVariableArityPhysicalOrdinarySourceRowNodeCount + formula row inOrdinary + have count_grid : count ≤ Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) := by + rw [count_eq] + exact Nat.succ_le_of_lt + (explicitOrdinaryDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) sourceMoment.2) + have parity := + paperVariableArityPhysicalOrdinaryOrderedLagrangeParity_count + (fun index => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val) + (explicitOrdinaryDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) sourceMoment.2) + count_eq count_grid sourceRow sourcePosition + change + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val) + (explicitOrdinaryDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) sourceMoment.2) + sourceRow sourcePosition * sourceColumn.2.2 ^ sourceMoment.2.val = + (if sourceRow = sourcePosition + then sourceColumn.2.2 ^ sourceMoment.2.val else 0) - + (((List.range count).map (fun node => + if node = sourcePosition.val then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + (2 : Fin 4) row.val formula count + (physicalOrdinaryInterpolationNodeCount_le_grid + formula row.val) + (physicalShiftedColumnValueSourceWord + formula column.val) node) + else 0)).sum) + apply paperVariableArityPhysicalOrdinaryParityCorrection_mul_masked_sum + _ sourceRow sourcePosition (sourceColumn.2.2 ^ sourceMoment.2.val) + count sourcePosition.val + (fun node => + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + (2 : Fin 4) row.val formula count + (physicalOrdinaryInterpolationNodeCount_le_grid + formula row.val) + (physicalShiftedColumnValueSourceWord + formula column.val) node)) + _ parity + intro selected + simp only [physicalInterpolationNodeSourceWord, + dite_eq_left selected] + exact paperVariableArityPhysicalOrdinarySelectedNodeWeightProduct + formula row column inOrdinary ⟨sourcePosition.val, selected⟩ + +end PhysicalOrdinaryInterpolationSourceParityCorrectness + +namespace PhysicalShiftedSourceColumnGridProjection + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.FormulaBridge +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalColumnOrderProjection GapCVP.SourceOrder + +private theorem physicalSourceColumnExplicitGridPosition_val + (formula : ThreeCNF) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) : + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1)).val = + (column.val / + physFieldCard formula) % + physGridCard formula := by + have genuine := sourceCoordinateGridWordRank + (encodeThreeCNF formula).length formula column + simpa only [sourceFormulaExplicitGridOrder, Equiv.symm_trans, finCongr_symm, Equiv.trans_apply, + finCongr_apply, Fin.val_cast, physicalFormulaFieldCardinality_eq_card, + physicalFormulaGridCardinality_eq_card] using + genuine + +end PhysicalShiftedSourceColumnGridProjection + +open GapCVP.PhysicalShiftedSourceColumnGridProjection + +namespace PhysicalOrdinaryInterpolationBinaryCheckBitCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryFieldInverseAlgebra +open GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics GapCVP.PhysicalColumnOrder +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalInterpolationNodeCountBounds +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryInterpolationCheckFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationParityFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationRowGridBasisCorrectness +open GapCVP.PhysicalOrdinaryInterpolationSourceParityCorrectness +open GapCVP.PhysicalOrdinaryShiftedCheckBitInstantiation +open GapCVP.PhysicalShiftedInterpolationBaseTM GapCVP.PhysicalShiftedSourceColumnGridProjection +open GapCVP.SourceFieldMomentOperationsTM GapCVP.SourceOrder + +private def physicalOrdinaryActualSourceCorrectionField + (formula : ThreeCNF) (row : ℕ) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula := + (((List.range + (physicalOrdinaryInterpolationNodeCount + row formula)).map (fun node => + if node = + (column.val / + physFieldCard formula) % + physGridCard formula + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + (2 : Fin 4) row formula + (physicalOrdinaryInterpolationNodeCount + row formula) + (physicalOrdinaryInterpolationNodeCount_le_grid + formula row) + (physicalShiftedColumnValueSourceWord + formula column.val) node) + else 0)).sum) + +private theorem paperVariableArityPhysicalOrdinaryActualSourceGridMatch_iff + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + physicalOrdinarySourceRowGrid + formula row inOrdinary = + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1 ↔ + (((row.val - + physicalFormulaRefinementBoundary formula) / + physDegree formula) % + physGridCard formula = + (column.val / + physFieldCard formula) % + physGridCard formula) := by + constructor + · intro matching + have ranks := congrArg Fin.val matching + rw [paperVariableArityPhysicalOrdinarySourceRowGrid_val, + physicalSourceColumnExplicitGridPosition_val] + at ranks + exact ranks + · intro matching + apply Fin.ext + rw [paperVariableArityPhysicalOrdinarySourceRowGrid_val, + physicalSourceColumnExplicitGridPosition_val] + exact matching + +private theorem paperVariableArityPhysicalOrdinaryActualDirectMomentBasis_decide + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (if physicalOrdinarySourceRowGrid + formula row inOrdinary = + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1 + then + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val + else 0) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2)) = + (decide + ((((row.val - + physicalFormulaRefinementBoundary formula) / + physDegree formula) % + physGridCard formula) = + ((column.val / + physFieldCard formula) % + physGridCard formula)) && + (sourceWordPow + (physicalShiftedColumnValueSourceWord + formula column.val) + (physicalFamilyRowMoment + (2 : Fin 4) row.val formula)) + (physicalInterpolationRowBasisIndex + row.val formula)) := by + classical + let sourceIndex := physicalInterpolationRowBasisIndex + row.val formula + let sourceWord := physicalShiftedColumnValueSourceWord + formula column.val + let sourceMoment := physicalFamilyRowMoment + (2 : Fin 4) row.val formula + have wordField : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (sourceWordPow sourceWord sourceMoment) = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val := by + rw [sourceWordValue_sourceWordPow, + paperVariableArityPhysicalInterpolationColumnValueSourceWord_sourceField, + paperVariableArityPhysicalOrdinarySourceRowMoment_eq_family] + by_cases matching : + physicalOrdinarySourceRowGrid + formula row inOrdinary = + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1 + · have physical := + (paperVariableArityPhysicalOrdinaryActualSourceGridMatch_iff + formula row column inOrdinary).mp matching + have coordinate := paperVariableArityPhysicalSourceWordBasisCoordinate_decide + formula (sourceWordPow sourceWord sourceMoment) sourceIndex + rw [wordField] at coordinate + rw [ite_eq_left matching] + simp only [physical, decide_true, Bool.true_and] + exact coordinate + · have physical : ¬ + (((row.val - + physicalFormulaRefinementBoundary formula) / + physDegree formula) % + physGridCard formula = + (column.val / + physFieldCard formula) % + physGridCard formula) := by + intro equal + exact matching + ((paperVariableArityPhysicalOrdinaryActualSourceGridMatch_iff + formula row column inOrdinary).mpr equal) + rw [ite_eq_right matching] + simp only [map_zero, Pi.zero_apply, zero_ne_one, decide_false, physical, Fin.isValue, + Bool.false_and] + +private theorem paperVariableArityPhysicalOrdinaryActualBinaryCheckBit_decide + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check row column = + (1 : ZMod 2)) = + (decide + ((physicalOrdinarySourceRowTableMoment + formula row inOrdinary).1 = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1) && + Bool.xor + (decide + ((((row.val - + physicalFormulaRefinementBoundary formula) / + physDegree formula) % + physGridCard formula) = + ((column.val / + physFieldCard formula) % + physGridCard formula)) && + (sourceWordPow + (physicalShiftedColumnValueSourceWord + formula column.val) + (physicalFamilyRowMoment + (2 : Fin 4) row.val formula)) + (physicalInterpolationRowBasisIndex + row.val formula)) + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (physicalOrdinaryActualSourceCorrectionField + formula row.val column) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2)))) := by + classical + have basis : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.2 = + physicalInterpolationRowBasisIndex + row.val formula := by + apply Fin.ext + exact paperVariableArityPhysicalOrdinarySourceRowBasis_val + formula row + rw [physicalWordBinaryCheckCoefficient, + paperVariableArityPhysicalOrdinarySourceRowFieldCoefficient_eq_selected + formula row column inOrdinary, basis] + by_cases matching : + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).1 = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 + · simp only [matching, ite_eq_left, decide_true, Bool.true_and] + have parity := paperVariableArityPhysicalOrdinaryInterpolationSourceParity_eq + formula row column inOrdinary + rw [physicalSourceColumnExplicitGridPosition_val] + at parity + rw [parity] + change + decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + ((if physicalOrdinarySourceRowGrid + formula row inOrdinary = + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1 + then + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 ^ + (physicalOrdinarySourceRowTableMoment + formula row inOrdinary).2.val + else 0) - + physicalOrdinaryActualSourceCorrectionField + formula row.val column) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2)) = _ + rw [paperVariableArityPhysicalSourceBasisCoordinate_sub_decide, + paperVariableArityPhysicalOrdinaryActualDirectMomentBasis_decide] + · rw [ite_eq_right matching] + simp only [Module.Basis.equivFun_apply, map_zero, Pi.zero_apply, zero_ne_one, decide_false, + matching, + Fin.isValue, Bool.false_and] + +end PhysicalOrdinaryInterpolationBinaryCheckBitCorrectness + +open GapCVP.PhysicalOrdinaryInterpolationBinaryCheckBitCorrectness + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryFieldInverseAlgebra GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics +open GapCVP.PhysicalColumnOrder GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM +open GapCVP.PhysicalInterpolationDirectMomentBitTM GapCVP.PhysicalInterpolationNodeCountBounds +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryShiftedCoefficientSumTM +open GapCVP.PhysicalOrdinaryInterpolationCheckFieldCorrectness +open GapCVP.PhysicalOrdinaryInterpolationBinaryCheckBitCorrectness +open GapCVP.PhysicalShiftedInterpolationBaseTM GapCVP.SourceFieldMomentOperationsTM +open GapCVP.SourceOrder + +private def physicalOrdinarySourceCorrectionField + (formula : ThreeCNF) (row : ℕ) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula := + physicalOrdinaryActualSourceCorrectionField + formula row column + +private theorem paperVariableArityPhysicalOrdinaryCorrectionBit_sourceCorrection + (formula : ThreeCNF) (row : ℕ) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalInterpolationNodeCorrectionBit + (2 : Fin 4) + (physicalOrdinaryNodePrefixWidth + physicalOrdinaryInterpolationMomentComputer) + physicalInterpolationColumnFieldComputer + (affineCellQuery row column.val + (encodeThreeCNF formula)) = + [decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (physicalOrdinarySourceCorrectionField + formula row column) + (physicalInterpolationRowBasisIndex + row formula) = (1 : ZMod 2))] := by + exact paperVariableArityPhysicalInterpolationNodeCorrectionBit_sourceField_valid + (2 : Fin 4) + (physicalOrdinaryNodePrefixWidth + physicalOrdinaryInterpolationMomentComputer) + physicalInterpolationColumnFieldComputer + row column.val formula + (physicalOrdinaryInterpolationNodeCount row formula) + (paperVariableArityPhysicalOrdinaryInterpolationNodeWidth_valid + row column.val formula) + (physicalOrdinaryInterpolationNodeCount_le_grid + formula row) + (physicalShiftedColumnValueSourceWord + formula column.val) + (paperVariableArityPhysicalOrdinaryColumnFieldComputer_valid + formula row column) + +private def physicalOrdinarySourceDirectBit + (formula : ThreeCNF) (row : ℕ) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : Bool := + decide + ((((row - physicalFamilyStart + (2 : Fin 4) formula) / + physDegree formula) % + physGridCard formula) = + ((column.val / + physFieldCard formula) % + physGridCard formula)) && + (sourceWordPow + (physicalShiftedColumnValueSourceWord + formula column.val) + (physicalFamilyRowMoment + (2 : Fin 4) row formula)) + (physicalInterpolationRowBasisIndex row formula) + +private theorem paperVariableArityPhysicalOrdinaryDirectMomentBit_sourceDirect + (formula : ThreeCNF) (row : ℕ) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalFamilyDirectMomentBit + (2 : Fin 4) + physicalInterpolationColumnFieldComputer + (affineCellQuery row column.val + (encodeThreeCNF formula)) = + [physicalOrdinarySourceDirectBit + formula row column] := by + exact paperVariableArityPhysicalFamilyDirectMomentBit_valid + (2 : Fin 4) + physicalInterpolationColumnFieldComputer + row column.val formula + (physicalShiftedColumnValueSourceWord + formula column.val) + (physicalInterpolationRowBasisIndex + row formula) + rfl + (paperVariableArityPhysicalOrdinaryColumnFieldComputer_valid + formula row column) + +private theorem paperVariableArityPhysicalOrdinaryCheckBit_actualSourceBits + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula) : + physicalOrdinaryCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalOrdinarySourceRowTableMoment + formula row inOrdinary).1 = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1) && + Bool.xor + (physicalOrdinarySourceDirectBit + formula row.val column) + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (physicalOrdinarySourceCorrectionField + formula row.val column) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2)))] := by + have marker : + physicalOrdinaryRowMarker + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = [true] := by + rw [paperVariableArityPhysicalOrdinaryRowMarker_query] + simp only [inOrdinary, and_self, decide_true] + have bits := paperVariableArityPhysicalSourceInterpolationFamilyCheckBit_bits + (2 : Fin 4) + physicalOrdinaryRowMarker + (physicalInterpolationFamilyTypeRankComputer + (2 : Fin 4)) + (physicalOrdinaryNodePrefixWidth + physicalOrdinaryInterpolationMomentComputer) + physicalInterpolationColumnFieldComputer + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) + true + (decide + ((physicalOrdinarySourceRowTableMoment + formula row inOrdinary).1 = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1)) + (physicalOrdinarySourceDirectBit + formula row.val column) + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (physicalOrdinarySourceCorrectionField + formula row.val column) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2))) + marker + (paperVariableArityPhysicalOrdinaryExpectedTypeMatchBit_eq_sourceTable + formula row column inOrdinary) + (paperVariableArityPhysicalOrdinaryDirectMomentBit_sourceDirect + formula row.val column) + (paperVariableArityPhysicalOrdinaryCorrectionBit_sourceCorrection + formula row.val column) + exact bits + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem paperVariableArityPhysicalOrdinaryCheckBit_valid + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalOrdinaryCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaRefinementBoundary formula ≤ + row.val ∧ + row.val < + physicalFormulaOrdinaryBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))] := by + by_cases inOrdinary : + physicalFormulaRefinementBoundary formula ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula + · have bits := paperVariableArityPhysicalOrdinaryCheckBit_actualSourceBits + formula row column inOrdinary + have direct : + physicalOrdinarySourceDirectBit + formula row.val column = + (decide + ((((row.val - + physicalFormulaRefinementBoundary formula) / + physDegree formula) % + physGridCard formula) = + ((column.val / + physFieldCard formula) % + physGridCard formula)) && + (sourceWordPow + (physicalShiftedColumnValueSourceWord + formula column.val) + (physicalFamilyRowMoment + (2 : Fin 4) row.val formula)) + (physicalInterpolationRowBasisIndex + row.val formula)) := by + unfold physicalOrdinarySourceDirectBit + rw [paperVariableArityPhysicalOrdinaryFamilyStart_eq_refinement] + have correction : + physicalOrdinarySourceCorrectionField + formula row.val column = + physicalOrdinaryActualSourceCorrectionField + formula row.val column := by + rfl + rw [direct, correction] at bits + have actual := paperVariableArityPhysicalOrdinaryActualBinaryCheckBit_decide + formula row column inOrdinary + calc + physicalOrdinaryCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))] := + bits.trans (congrArg (fun bit : Bool => [bit]) actual.symm) + _ = _ := by simp only [inOrdinary, + and_self, decide_true, + Bool.true_and] + · calc + physicalOrdinaryCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = [false] := + paperVariableArityPhysicalOrdinaryCheckBit_of_not_in_family + formula row.val column.val inOrdinary + _ = _ := by simp only [inOrdinary, decide_false, + Bool.false_and] + +end PhysicalOrdinaryShiftedCheckBitInstantiation + +namespace ShiftedClauseOffsetTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder GapCVP.SourceMachineCert +open GapCVP.SourceIndexedClauseLookupTM GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingTM GapCVP.ClauseOffsetTM GapCVP.RefinementClauseOffsetTM +open GapCVP.ShiftedTupleTM + +private noncomputable def paperShiftedPrefixRankWidth : + SourceQaryMaskDynamicGridWidth := + paperRefinementPrefixRankWidth + +@[simp] private theorem paperVariableArityShiftedPrefixRankWidth_output + (input : List Bool) : + paperShiftedPrefixRankWidth.output input = + firstFieldContents input := by + rfl + +private def paperVariableArityShiftedPrefixIndexedClauseQuery + (input : List Bool) : List Bool := + paperRefinementPrefixIndexedClauseQuery input + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedPrefixIndexedClauseQueryComputable : + BitTM + paperVariableArityShiftedPrefixIndexedClauseQuery := + paperVariableArityRefinementPrefixIndexedClauseQueryComputable + +private def paperShiftedClauseRankEnvelope + (formula : ThreeCNF) (rank : ℕ) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + paperShiftedRetainedClauseWidth + (encodeThreeCNF formula) + +private def paperVariableArityShiftedPrefixRankEnvelope + (formula : ThreeCNF) (outer inner : ℕ) : List Bool := + paperRefinementPrefixRankEnvelope formula outer inner + +@[simp] private theorem paperVariableArityShiftedPrefixIndexedClauseQuery_valid + (formula : ThreeCNF) (outer inner : ℕ) : + paperVariableArityShiftedPrefixIndexedClauseQuery + (paperVariableArityShiftedPrefixRankEnvelope formula outer inner) = + sourceOriginalIndexedClauseQuery inner + (noTautClauses formula) := + paperVariableArityRefinementPrefixIndexedClauseQuery_valid formula outer inner + +private def paperShiftedPrefixIndexedClauseWeightUnary : + List Bool → List Bool := + paperShiftedClauseWeightUnary ∘ + sourceOriginalIndexedClauseOutput ∘ + paperVariableArityShiftedPrefixIndexedClauseQuery + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedPrefixIndexedClauseWeightUnaryComputable : + BitTM + paperShiftedPrefixIndexedClauseWeightUnary := by + have indexed := GapCVP.TMComposition.computableInPolyTime + paperVariableArityShiftedPrefixIndexedClauseQueryComputable + sourceOriginalIndexedClauseComputable + exact GapCVP.TMComposition.computableInPolyTime + indexed paperVariableArityShiftedClauseWeightUnaryComputable + +private theorem paperVariableArityShiftedPrefixIndexedClauseWeightUnary_valid + (formula : ThreeCNF) (outer inner : ℕ) + (hinner : inner < (noTautClauses formula).length) : + paperShiftedPrefixIndexedClauseWeightUnary + (paperVariableArityShiftedPrefixRankEnvelope + formula outer inner) = + List.replicate + (paperShiftedSourceClauseWeight + ((noTautClauses formula).get + ⟨inner, hinner⟩)) true := by + unfold paperShiftedPrefixIndexedClauseWeightUnary + simp only [Function.comp_apply] + rw [paperVariableArityShiftedPrefixIndexedClauseQuery_valid, + sourceOriginalIndexedClauseOutput_valid inner + (noTautClauses formula) hinner] + simpa only [List.get_eq_getElem, List.append_nil] using + paperVariableArityShiftedClauseWeightUnary_valid ((noTautClauses formula).get ⟨inner, + hinner⟩) [] + +private def paperShiftedClauseOffsetUnary : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + paperShiftedPrefixRankWidth + paperVariableArityShiftedPrefixIndexedClauseWeightUnaryComputable + +private noncomputable def paperVariableArityShiftedClauseOffsetUnaryComputable : + BitTM + paperShiftedClauseOffsetUnary := + maskDynamicGridRecordCatalogueComputable + paperShiftedPrefixRankWidth + paperVariableArityShiftedPrefixIndexedClauseWeightUnaryComputable + +private theorem paperVariableArityShiftedClauseOffsetUnary_valid + (formula : ThreeCNF) (rank : ℕ) + (hbound : rank ≤ (noTautClauses formula).length) : + paperShiftedClauseOffsetUnary + (paperShiftedClauseRankEnvelope formula rank) = + List.replicate + (paperShiftedSourceClauseWeightSum + ((noTautClauses formula).take rank)) true := by + have hwidth : + paperShiftedPrefixRankWidth.output + (paperShiftedClauseRankEnvelope formula rank) = + List.replicate rank true := by + rw [paperVariableArityShiftedPrefixRankWidth_output] + simp only [paperShiftedClauseRankEnvelope, firstFieldContents_valid] + have catalogue := maskDynamicGridRecordCatalogueOutput_valid + paperShiftedPrefixRankWidth + paperVariableArityShiftedPrefixIndexedClauseWeightUnaryComputable + (paperShiftedClauseRankEnvelope formula rank) + rank hwidth + change maskDynamicGridRecordCatalogueOutput + paperShiftedPrefixRankWidth + paperVariableArityShiftedPrefixIndexedClauseWeightUnaryComputable + (paperShiftedClauseRankEnvelope formula rank) = _ + rw [catalogue] + rw [← paperVariableArityShiftedSourceClauseWeight_flatMap + ((noTautClauses formula).take rank)] + have hlength : + ((noTautClauses formula).take rank).length = rank := by + simp only [List.length_take, Nat.min_eq_left hbound] + rw [hlength] + apply List.flatMap_congr + intro inner hmem + have hlt : inner < rank := List.mem_range.mp hmem + have hinner : inner < + (noTautClauses formula).length := + Nat.lt_of_lt_of_le hlt hbound + change paperShiftedPrefixIndexedClauseWeightUnary + (paperVariableArityShiftedPrefixRankEnvelope + formula rank inner) = _ + rw [paperVariableArityShiftedPrefixIndexedClauseWeightUnary_valid + formula rank inner hinner] + simp only [paperShiftedIndexedSourceClauseWeight, + List.getElem?_take, ite_eq_left hlt, + List.getElem?_eq_getElem hinner, List.get_eq_getElem] + +private def paperShiftedSelectedOriginalClauseWord : + List Bool → List Bool := + sourceOriginalIndexedClauseOutput ∘ + paperShiftedIndexedClauseQuery + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityShiftedSelectedOriginalClauseWordComputable : + BitTM + paperShiftedSelectedOriginalClauseWord := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityShiftedIndexedClauseQueryComputable + sourceOriginalIndexedClauseComputable + +private theorem paperVariableArityShiftedSelectedOriginalClauseWord_valid + (formula : ThreeCNF) (rank : ℕ) + (hbound : rank < (noTautClauses formula).length) : + paperShiftedSelectedOriginalClauseWord + (paperShiftedClauseRankEnvelope formula rank) = + encodeThreeClause + ((noTautClauses formula).get + ⟨rank, hbound⟩) := by + unfold paperShiftedSelectedOriginalClauseWord + simp only [Function.comp_apply, + paperShiftedClauseRankEnvelope] + rw [paperVariableArityShiftedIndexedClauseQuery_valid, + sourceOriginalIndexedClauseOutput_valid rank + (noTautClauses formula) hbound] + +private def paperVariableArityShiftedSelectedClauseArityUnary : + List Bool → List Bool := + paperVariableArityClauseArityUnary ∘ + paperShiftedSelectedOriginalClauseWord + +private noncomputable def paperVariableArityShiftedSelectedClauseArityUnaryComputable : + BitTM + paperVariableArityShiftedSelectedClauseArityUnary := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityShiftedSelectedOriginalClauseWordComputable + paperClauseArityUnaryComputable + +end ShiftedClauseOffsetTM + +namespace PhysicalShiftedRowTupleRankTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM GapCVP.CLStructuralPrefixWriter +open GapCVP.CNFFlatPhysicalBinaryAppendTM GapCVP.BinaryDimensionTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryPhysicalRowBasisDivisionTM +open GapCVP.SourcePreprocessingTM GapCVP.SourcePreprocessingSemantics GapCVP.ClauseOffsetTM +open GapCVP.ShiftedTupleTM GapCVP.ShiftedClauseOffsetTM GapCVP.ShiftedTupleBetaTM +open GapCVP.PhysicalFamilyRowTM GapCVP.SourceFieldMomentOperationsTM + +private def physicalShiftedRowMixedTagWord : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + (physicalFamilyRowGridQuotientWord (3 : Fin 4)) + physicalMomentCellMomentCountUnary + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowMixedTagComputable : + BitTM + physicalShiftedRowMixedTagWord := + sourcePhysicalComputedUnaryQuotientComputable + (paperVariableArityPhysicalFamilyRowGridQuotientComputable (3 : Fin 4)) + paperVariableArityPhysicalMomentCellMomentCountUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalShiftedRowMixedTagWord_query + (row column : ℕ) (formula : ThreeCNF) : + physicalShiftedRowMixedTagWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + ((((row - physicalFormulaOrdinaryBoundary formula) / + physDegree formula) / + physGridCard formula) / + physicalFormulaMomentCount formula) true := by + unfold physicalShiftedRowMixedTagWord + apply sourcePhysicalComputedUnaryQuotient_valid + (physicalFamilyRowGridQuotientWord (3 : Fin 4)) + physicalMomentCellMomentCountUnary + (affineCellQuery row column (encodeThreeCNF formula)) + (((row - physicalFormulaOrdinaryBoundary formula) / + physDegree formula) / + physGridCard formula) + (physicalFormulaMomentCount formula) + (physicalFormulaMomentCount_pos formula) + · have start : + physicalFamilyStart (3 : Fin 4) formula = + physicalFormulaOrdinaryBoundary formula := by + simp only [physicalFamilyStart, Fin.isValue, Fin.coe_ofNat_eq_mod, Nat.mod_succ, + OfNat.ofNat_ne_zero, + ↓reduceIte, OfNat.ofNat_ne_one, OfNat.ofNat_eq_ofNat, Nat.succ_ne_self] + rw [← start] + exact paperVariableArityPhysicalFamilyRowGridQuotientWord_valid + (3 : Fin 4) row column formula + · exact paperVariableArityPhysicalMomentCellMomentCountUnary_valid + row column formula + +private def physicalShiftedRowRetainedCountWord : + List Bool → List Bool := + paperRetainedClauseCountUnary ∘ + sourceExplicitAffineCellOriginalSource + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowRetainedCountComputable : + BitTM + physicalShiftedRowRetainedCountWord := + GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + paperVariableArityRetainedClauseCountUnaryComputable + +@[simp] private theorem paperVariableArityPhysicalShiftedRowRetainedCountWord_query + (row column : ℕ) (formula : ThreeCNF) : + physicalShiftedRowRetainedCountWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate (noTautClauses formula).length true := by + unfold physicalShiftedRowRetainedCountWord + rw [Function.comp_apply, sourceExplicitAffineCellOriginalSource_query, + paperVariableArityRetainedClauseCountUnary_valid] + +private noncomputable def physicalShiftedRowRetainedClauseWidth : + SourceQaryMaskDynamicGridWidth where + output := physicalShiftedRowRetainedCountWord + computer := paperVariableArityPhysicalShiftedRowRetainedCountComputable + +@[simp] private theorem paperVariableArityPhysicalShiftedRowRetainedClauseWidth_output + (input : List Bool) : + physicalShiftedRowRetainedClauseWidth.output input = + physicalShiftedRowRetainedCountWord input := by + rfl + +private def physicalShiftedRowMixedTag + (formula : ThreeCNF) (row : ℕ) : ℕ := + (((row - physicalFormulaOrdinaryBoundary formula) / + physDegree formula) / + physGridCard formula) / + physicalFormulaMomentCount formula + +private def physicalShiftedRowClausePrefix + (formula : ThreeCNF) (rank : ℕ) : ℕ := + paperShiftedSourceClauseWeightSum + ((noTautClauses formula).take rank) + +private def physicalShiftedRowCandidateRankEnvelope + (formula : ThreeCNF) (row column rank : ℕ) : List Bool := + lengthPrefixedWord (List.replicate rank true) ++ + sourceQaryMaskDynamicGridBaseSource + physicalShiftedRowRetainedClauseWidth + (affineCellQuery row column (encodeThreeCNF formula)) + +private def physicalShiftedRowCandidateCell : + List Bool → List Bool := + paperSourcePreprocessingSuffixAt 2 + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowCandidateCellComputable : + BitTM + physicalShiftedRowCandidateCell := + paperPreprocessingSuffixAtComputable 2 + +@[simp] private theorem paperVariableArityPhysicalShiftedRowCandidateCell_query + (formula : ThreeCNF) (row column rank : ℕ) : + physicalShiftedRowCandidateCell + (physicalShiftedRowCandidateRankEnvelope + formula row column rank) = + affineCellQuery row column (encodeThreeCNF formula) := by + simp [physicalShiftedRowCandidateCell, + physicalShiftedRowCandidateRankEnvelope, + sourceQaryMaskDynamicGridBaseSource, + paperSourcePreprocessingSuffixAt, Function.iterate_succ_apply] + +private def physicalShiftedRowCandidateClauseEnvelope + (input : List Bool) : List Bool := + lengthPrefixedWord (firstFieldContents input) ++ + sourceQaryMaskDynamicGridBaseSource + paperShiftedRetainedClauseWidth + (sourceExplicitAffineCellOriginalSource + (physicalShiftedRowCandidateCell input)) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowCandidateClauseEnvelopeComputable : + BitTM + physicalShiftedRowCandidateClauseEnvelope := by + have rank := GapCVP.TMComposition.computableInPolyTime + firstFieldContentsComputable structuralPrefixWriterComputable + have source := GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalShiftedRowCandidateCellComputable + sourceExplicitAffineCellOriginalSourceComputable + have base := GapCVP.TMComposition.computableInPolyTime + source + (maskDynamicGridBaseSourceComputable + paperShiftedRetainedClauseWidth) + exact pointwiseAppendComputable rank base + +@[simp] theorem + paperVariableArityPhysicalShiftedRowCandidateClauseEnvelope_query + (formula : ThreeCNF) (row column rank : ℕ) : + physicalShiftedRowCandidateClauseEnvelope + (physicalShiftedRowCandidateRankEnvelope + formula row column rank) = + paperShiftedClauseRankEnvelope formula rank := by + simp [physicalShiftedRowCandidateClauseEnvelope, + physicalShiftedRowCandidateRankEnvelope, + paperShiftedClauseRankEnvelope, + sourceQaryMaskDynamicGridBaseSource, + physicalShiftedRowCandidateCell, + paperSourcePreprocessingSuffixAt, Function.iterate_succ_apply] + +private def physicalShiftedRowCandidatePrefixWord : + List Bool → List Bool := + paperShiftedClauseOffsetUnary ∘ + physicalShiftedRowCandidateClauseEnvelope + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowCandidatePrefixComputable : + BitTM + physicalShiftedRowCandidatePrefixWord := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalShiftedRowCandidateClauseEnvelopeComputable + paperVariableArityShiftedClauseOffsetUnaryComputable + +private theorem paperVariableArityPhysicalShiftedRowCandidatePrefixWord_query + (formula : ThreeCNF) (row column rank : ℕ) + (hbound : rank ≤ (noTautClauses formula).length) : + physicalShiftedRowCandidatePrefixWord + (physicalShiftedRowCandidateRankEnvelope + formula row column rank) = + List.replicate + (physicalShiftedRowClausePrefix formula rank) true := by + unfold physicalShiftedRowCandidatePrefixWord + rw [Function.comp_apply, + paperVariableArityPhysicalShiftedRowCandidateClauseEnvelope_query, + paperVariableArityShiftedClauseOffsetUnary_valid formula rank hbound] + rfl + +private def physicalShiftedRowCandidateMixedTagWord : + List Bool → List Bool := + physicalShiftedRowMixedTagWord ∘ + physicalShiftedRowCandidateCell + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowCandidateMixedTagComputable : + BitTM + physicalShiftedRowCandidateMixedTagWord := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalShiftedRowCandidateCellComputable + paperVariableArityPhysicalShiftedRowMixedTagComputable + +@[simp] theorem + paperVariableArityPhysicalShiftedRowCandidateMixedTagWord_query + (formula : ThreeCNF) (row column rank : ℕ) : + physicalShiftedRowCandidateMixedTagWord + (physicalShiftedRowCandidateRankEnvelope + formula row column rank) = + List.replicate + (physicalShiftedRowMixedTag formula row) true := by + unfold physicalShiftedRowCandidateMixedTagWord + rw [Function.comp_apply, + paperVariableArityPhysicalShiftedRowCandidateCell_query, + paperVariableArityPhysicalShiftedRowMixedTagWord_query] + rfl + +private def paperVariableArityPhysicalShiftedRowCandidatePrefixMarker : + List Bool → List Bool := + sourceFourFamilyBooleanNotOutput + (fourFamilyComputedUnaryLessBitOutput + physicalShiftedRowCandidateMixedTagWord + physicalShiftedRowCandidatePrefixWord) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowCandidatePrefixMarkerComputable : + BitTM + paperVariableArityPhysicalShiftedRowCandidatePrefixMarker := + fourFamilyBooleanNotOutputComputable + (fourFamilyComputedUnaryLessBitComputable + paperVariableArityPhysicalShiftedRowCandidateMixedTagComputable + paperVariableArityPhysicalShiftedRowCandidatePrefixComputable) + +private def physicalShiftedRowCandidatePrefixRecord : + List Bool → List Bool := + paperShiftedTupleGuardedSourceWord + paperVariableArityPhysicalShiftedRowCandidatePrefixMarker + (paperShiftedTupleConstantUnary 1) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowCandidatePrefixRecordComputable : + BitTM + physicalShiftedRowCandidatePrefixRecord := + paperVariableArityShiftedTupleGuardedSourceWordComputable + paperVariableArityPhysicalShiftedRowCandidatePrefixMarkerComputable + (paperVariableArityShiftedTupleConstantUnaryComputable 1) + +private theorem paperVariableArityPhysicalShiftedRowCandidatePrefixRecord_query + (formula : ThreeCNF) (row column rank : ℕ) + (hbound : rank ≤ (noTautClauses formula).length) : + physicalShiftedRowCandidatePrefixRecord + (physicalShiftedRowCandidateRankEnvelope + formula row column rank) = + if physicalShiftedRowMixedTag formula row < + physicalShiftedRowClausePrefix formula rank + then [] else [true] := by + let input := physicalShiftedRowCandidateRankEnvelope + formula row column rank + let tag := physicalShiftedRowMixedTag formula row + let sourceOffset := + physicalShiftedRowClausePrefix formula rank + have comparison := fourFamilyComputedUnaryLessBitOutput_valid + physicalShiftedRowCandidateMixedTagWord + physicalShiftedRowCandidatePrefixWord + input tag sourceOffset + (paperVariableArityPhysicalShiftedRowCandidateMixedTagWord_query + formula row column rank) + (paperVariableArityPhysicalShiftedRowCandidatePrefixWord_query + formula row column rank hbound) + have marker := fourFamilyBooleanNotOutput_bit + (fourFamilyComputedUnaryLessBitOutput + physicalShiftedRowCandidateMixedTagWord + physicalShiftedRowCandidatePrefixWord) + input (decide (tag < sourceOffset)) comparison + unfold physicalShiftedRowCandidatePrefixRecord + rw [paperShiftedTupleGuardedSourceWord_valid + paperVariableArityPhysicalShiftedRowCandidatePrefixMarker + (paperShiftedTupleConstantUnary 1) + input (!(decide (tag < sourceOffset))) marker] + by_cases reached : tag < sourceOffset + · simp only [reached, decide_true, Bool.not_true, Bool.false_eq_true, ↓reduceIte, tag, + sourceOffset] + · simp only [reached, decide_false, Bool.not_false, ↓reduceIte, paperShiftedTupleConstantUnary, + List.replicate_one, tag, sourceOffset] + +private def physicalShiftedRowAcceptedPrefixCountWord : + List Bool → List Bool := + maskDynamicGridRecordCatalogueOutput + physicalShiftedRowRetainedClauseWidth + paperVariableArityPhysicalShiftedRowCandidatePrefixRecordComputable + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowAcceptedPrefixCountComputable : + BitTM + physicalShiftedRowAcceptedPrefixCountWord := + maskDynamicGridRecordCatalogueComputable + physicalShiftedRowRetainedClauseWidth + paperVariableArityPhysicalShiftedRowCandidatePrefixRecordComputable + +private def physicalShiftedRowAcceptedPrefixCount + (formula : ThreeCNF) (row : ℕ) : ℕ := + ((List.range (noTautClauses formula).length).filter + fun rank => decide + (physicalShiftedRowClausePrefix formula rank ≤ + physicalShiftedRowMixedTag formula row)).length + +private theorem paperVariableArityPhysicalShiftedRowAcceptedPrefixFlatMap + (ranks : List ℕ) (tag : ℕ) (weightPrefix : ℕ → ℕ) : + ranks.flatMap (fun rank => + if tag < weightPrefix rank then [] else [true]) = + List.replicate + (ranks.filter (fun rank => decide (weightPrefix rank ≤ tag))).length + true := by + induction ranks with + | nil => rfl + | cons rank remaining induction => + by_cases less : tag < weightPrefix rank + · simp only [List.flatMap_cons, less, ↓reduceIte, induction, List.nil_append, Nat.not_le.mpr + less, decide_false, + Bool.false_eq_true, not_false_eq_true, List.filter_cons_of_neg] + · have reached : weightPrefix rank ≤ tag := Nat.le_of_not_gt less + simp only [List.flatMap_cons, less, ↓reduceIte, induction, List.cons_append, + List.nil_append, reached, + decide_true, List.filter_cons_of_pos, List.length_cons, List.replicate_succ] + +private theorem paperVariableArityPhysicalShiftedRowAcceptedPrefixCountWord_query + (formula : ThreeCNF) (row column : ℕ) : + physicalShiftedRowAcceptedPrefixCountWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowAcceptedPrefixCount formula row) + true := by + let input := affineCellQuery row column + (encodeThreeCNF formula) + let count := (noTautClauses formula).length + have width : + physicalShiftedRowRetainedClauseWidth.output input = + List.replicate count true := by + rw [paperVariableArityPhysicalShiftedRowRetainedClauseWidth_output, + paperVariableArityPhysicalShiftedRowRetainedCountWord_query] + have catalogue := maskDynamicGridRecordCatalogueOutput_valid + physicalShiftedRowRetainedClauseWidth + paperVariableArityPhysicalShiftedRowCandidatePrefixRecordComputable + input count width + unfold physicalShiftedRowAcceptedPrefixCountWord + rw [catalogue] + change + (List.range count).flatMap + (fun rank => physicalShiftedRowCandidatePrefixRecord + (physicalShiftedRowCandidateRankEnvelope + formula row column rank)) = + List.replicate + (physicalShiftedRowAcceptedPrefixCount + formula row) true + unfold physicalShiftedRowAcceptedPrefixCount + rw [← paperVariableArityPhysicalShiftedRowAcceptedPrefixFlatMap + (List.range (noTautClauses formula).length) + (physicalShiftedRowMixedTag formula row) + (physicalShiftedRowClausePrefix formula)] + apply List.flatMap_congr + intro rank membership + exact paperVariableArityPhysicalShiftedRowCandidatePrefixRecord_query + formula row column rank + (Nat.le_of_lt (List.mem_range.mp membership)) + +private def physicalShiftedRowClauseRankWord : + List Bool → List Bool := + unarySubtractionOutput + physicalShiftedRowAcceptedPrefixCountWord + (paperShiftedTupleConstantUnary 1) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowClauseRankComputable : + BitTM + physicalShiftedRowClauseRankWord := + unarySubtractionComputable + paperVariableArityPhysicalShiftedRowAcceptedPrefixCountComputable + (paperVariableArityShiftedTupleConstantUnaryComputable 1) + +private def physicalShiftedRowClauseRank + (formula : ThreeCNF) (row : ℕ) : ℕ := + physicalShiftedRowAcceptedPrefixCount formula row - 1 + +@[simp] private theorem paperVariableArityPhysicalShiftedRowClauseRankWord_query + (formula : ThreeCNF) (row column : ℕ) : + physicalShiftedRowClauseRankWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowClauseRank formula row) true := by + unfold physicalShiftedRowClauseRankWord + physicalShiftedRowClauseRank + apply unarySubtractionOutput_valid + physicalShiftedRowAcceptedPrefixCountWord + (paperShiftedTupleConstantUnary 1) + (affineCellQuery row column (encodeThreeCNF formula)) + (physicalShiftedRowAcceptedPrefixCount formula row) 1 + · exact paperVariableArityPhysicalShiftedRowAcceptedPrefixCountWord_query + formula row column + · rfl + +private def physicalShiftedRowSelectedClauseEnvelope + (input : List Bool) : List Bool := + lengthPrefixedWord + (physicalShiftedRowClauseRankWord input) ++ + sourceQaryMaskDynamicGridBaseSource + paperShiftedRetainedClauseWidth + (sourceExplicitAffineCellOriginalSource input) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowSelectedClauseEnvelopeComputable : + BitTM + physicalShiftedRowSelectedClauseEnvelope := by + have rank := GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalShiftedRowClauseRankComputable + structuralPrefixWriterComputable + have source := GapCVP.TMComposition.computableInPolyTime + sourceExplicitAffineCellOriginalSourceComputable + (maskDynamicGridBaseSourceComputable + paperShiftedRetainedClauseWidth) + exact pointwiseAppendComputable rank source + +@[simp] private theorem paperVariableArityPhysicalShiftedRowSelectedClauseEnvelope_query + (formula : ThreeCNF) (row column : ℕ) : + physicalShiftedRowSelectedClauseEnvelope + (affineCellQuery row column + (encodeThreeCNF formula)) = + paperShiftedClauseRankEnvelope formula + (physicalShiftedRowClauseRank formula row) := by + unfold physicalShiftedRowSelectedClauseEnvelope + paperShiftedClauseRankEnvelope + rw [paperVariableArityPhysicalShiftedRowClauseRankWord_query, + sourceExplicitAffineCellOriginalSource_query] + +private def physicalShiftedRowSelectedClauseArityWord : + List Bool → List Bool := + paperVariableArityShiftedSelectedClauseArityUnary ∘ + physicalShiftedRowSelectedClauseEnvelope + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowSelectedClauseArityComputable : + BitTM + physicalShiftedRowSelectedClauseArityWord := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalShiftedRowSelectedClauseEnvelopeComputable + paperVariableArityShiftedSelectedClauseArityUnaryComputable + +private def physicalShiftedRowSelectedClausePrefixWord : + List Bool → List Bool := + paperShiftedClauseOffsetUnary ∘ + physicalShiftedRowSelectedClauseEnvelope + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowSelectedClausePrefixComputable : + BitTM + physicalShiftedRowSelectedClausePrefixWord := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalShiftedRowSelectedClauseEnvelopeComputable + paperVariableArityShiftedClauseOffsetUnaryComputable + +private theorem paperVariableArityPhysicalShiftedRowSelectedClausePrefixWord_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row ≤ + (noTautClauses formula).length) : + physicalShiftedRowSelectedClausePrefixWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowClausePrefix formula + (physicalShiftedRowClauseRank formula row)) + true := by + unfold physicalShiftedRowSelectedClausePrefixWord + rw [Function.comp_apply, + paperVariableArityPhysicalShiftedRowSelectedClauseEnvelope_query, + paperVariableArityShiftedClauseOffsetUnary_valid _ _ hbound] + rfl + +private def physicalShiftedRowSelectedClauseArity + (formula : ThreeCNF) (row : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : ℕ := + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨physicalShiftedRowClauseRank formula row, + hbound⟩)).length + +private theorem paperVariableArityPhysicalShiftedRowSelectedClauseArityWord_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedRowSelectedClauseArityWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowSelectedClauseArity + formula row hbound) true := by + unfold physicalShiftedRowSelectedClauseArityWord + physicalShiftedRowSelectedClauseArity + rw [Function.comp_apply, + paperVariableArityPhysicalShiftedRowSelectedClauseEnvelope_query] + unfold paperVariableArityShiftedSelectedClauseArityUnary + rw [Function.comp_apply, + paperVariableArityShiftedSelectedOriginalClauseWord_valid + formula (physicalShiftedRowClauseRank formula row) + hbound] + have actual := paperVariableArityClauseArityUnary_valid + ((noTautClauses formula).get + ⟨physicalShiftedRowClauseRank formula row, + hbound⟩) [] + simpa only [List.append_nil] using actual + +private theorem paperVariableArityPhysicalShiftedRowSelectedClauseArity_pos + (formula : ThreeCNF) (row : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + 0 < physicalShiftedRowSelectedClauseArity + formula row hbound := by + unfold physicalShiftedRowSelectedClauseArity + exact List.length_pos_iff.mpr + (paperSourceNormalizedClause_ne_nil + ((noTautClauses formula).get + ⟨physicalShiftedRowClauseRank formula row, + hbound⟩)) + +private def physicalShiftedRowLocalTagWord : + List Bool → List Bool := + unarySubtractionOutput + physicalShiftedRowMixedTagWord + physicalShiftedRowSelectedClausePrefixWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowLocalTagComputable : + BitTM + physicalShiftedRowLocalTagWord := + unarySubtractionComputable + paperVariableArityPhysicalShiftedRowMixedTagComputable + paperVariableArityPhysicalShiftedRowSelectedClausePrefixComputable + +private def physicalShiftedRowLocalTag + (formula : ThreeCNF) (row : ℕ) : ℕ := + physicalShiftedRowMixedTag formula row - + physicalShiftedRowClausePrefix formula + (physicalShiftedRowClauseRank formula row) + +private theorem paperVariableArityPhysicalShiftedRowLocalTagWord_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row ≤ + (noTautClauses formula).length) : + physicalShiftedRowLocalTagWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowLocalTag formula row) true := by + unfold physicalShiftedRowLocalTagWord + physicalShiftedRowLocalTag + apply unarySubtractionOutput_valid + physicalShiftedRowMixedTagWord + physicalShiftedRowSelectedClausePrefixWord + (affineCellQuery row column (encodeThreeCNF formula)) + (physicalShiftedRowMixedTag formula row) + (physicalShiftedRowClausePrefix formula + (physicalShiftedRowClauseRank formula row)) + · exact paperVariableArityPhysicalShiftedRowMixedTagWord_query + row column formula + · exact paperVariableArityPhysicalShiftedRowSelectedClausePrefixWord_query + formula row column hbound + +private def physicalShiftedRowTupleRankWord : + List Bool → List Bool := + sourcePhysicalComputedUnaryQuotient + physicalShiftedRowLocalTagWord + physicalShiftedRowSelectedClauseArityWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowTupleRankComputable : + BitTM + physicalShiftedRowTupleRankWord := + sourcePhysicalComputedUnaryQuotientComputable + paperVariableArityPhysicalShiftedRowLocalTagComputable + paperVariableArityPhysicalShiftedRowSelectedClauseArityComputable + +private def physicalShiftedRowVariablePositionWord : + List Bool → List Bool := + sourcePhysicalComputedUnaryRemainder + physicalShiftedRowLocalTagWord + physicalShiftedRowSelectedClauseArityWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedRowVariablePositionComputable : + BitTM + physicalShiftedRowVariablePositionWord := + sourcePhysicalComputedUnaryRemainderComputable + paperVariableArityPhysicalShiftedRowLocalTagComputable + paperVariableArityPhysicalShiftedRowSelectedClauseArityComputable + +private def physicalShiftedRowTupleRank + (formula : ThreeCNF) (row : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : ℕ := + physicalShiftedRowLocalTag formula row / + physicalShiftedRowSelectedClauseArity + formula row hbound + +private def physicalShiftedRowVariablePosition + (formula : ThreeCNF) (row : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : ℕ := + physicalShiftedRowLocalTag formula row % + physicalShiftedRowSelectedClauseArity + formula row hbound + +private theorem paperVariableArityPhysicalShiftedRowTupleRankWord_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedRowTupleRankWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowTupleRank + formula row hbound) true := by + unfold physicalShiftedRowTupleRankWord + physicalShiftedRowTupleRank + apply sourcePhysicalComputedUnaryQuotient_valid + physicalShiftedRowLocalTagWord + physicalShiftedRowSelectedClauseArityWord + (affineCellQuery row column (encodeThreeCNF formula)) + (physicalShiftedRowLocalTag formula row) + (physicalShiftedRowSelectedClauseArity + formula row hbound) + (paperVariableArityPhysicalShiftedRowSelectedClauseArity_pos + formula row hbound) + · exact paperVariableArityPhysicalShiftedRowLocalTagWord_query + formula row column (Nat.le_of_lt hbound) + · exact paperVariableArityPhysicalShiftedRowSelectedClauseArityWord_query + formula row column hbound + +private theorem paperVariableArityPhysicalShiftedRowVariablePositionWord_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedRowVariablePositionWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowVariablePosition + formula row hbound) true := by + unfold physicalShiftedRowVariablePositionWord + physicalShiftedRowVariablePosition + apply sourcePhysicalComputedUnaryRemainder_valid + physicalShiftedRowLocalTagWord + physicalShiftedRowSelectedClauseArityWord + (affineCellQuery row column (encodeThreeCNF formula)) + (physicalShiftedRowLocalTag formula row) + (physicalShiftedRowSelectedClauseArity + formula row hbound) + (paperVariableArityPhysicalShiftedRowSelectedClauseArity_pos + formula row hbound) + · exact paperVariableArityPhysicalShiftedRowLocalTagWord_query + formula row column (Nat.le_of_lt hbound) + · exact paperVariableArityPhysicalShiftedRowSelectedClauseArityWord_query + formula row column hbound + +private noncomputable def physicalShiftedRowTupleRankComputers : + PaperVariableArityShiftedTupleRankComputers where + clause := + { output := physicalShiftedRowClauseRankWord + computer := paperVariableArityPhysicalShiftedRowClauseRankComputable } + tuple := + { output := physicalShiftedRowTupleRankWord + computer := paperVariableArityPhysicalShiftedRowTupleRankComputable } + variablePosition := + { output := physicalShiftedRowVariablePositionWord + computer := + paperVariableArityPhysicalShiftedRowVariablePositionComputable } + +@[simp] theorem + paperVariableArityPhysicalShiftedRowTupleRankComputers_clause_query + (formula : ThreeCNF) (row column : ℕ) : + physicalShiftedRowTupleRankComputers.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowClauseRank formula row) true := by + dsimp only [physicalShiftedRowTupleRankComputers] + exact paperVariableArityPhysicalShiftedRowClauseRankWord_query + formula row column + +private theorem paperVariableArityPhysicalShiftedRowTupleRankComputers_tuple_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedRowTupleRankComputers.tuple.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowTupleRank + formula row hbound) true := by + dsimp only [physicalShiftedRowTupleRankComputers] + exact paperVariableArityPhysicalShiftedRowTupleRankWord_query + formula row column hbound + +theorem + paperVariableArityPhysicalShiftedRowTupleRankComputers_variablePosition_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedRowTupleRankComputers.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedRowVariablePosition + formula row hbound) true := by + dsimp only [physicalShiftedRowTupleRankComputers] + exact paperVariableArityPhysicalShiftedRowVariablePositionWord_query + formula row column hbound + +private theorem paperVariableArityPhysicalShiftedRowVariablePosition_lt_arity + (formula : ThreeCNF) (row : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedRowVariablePosition formula row hbound < + physicalShiftedRowSelectedClauseArity + formula row hbound := by + unfold physicalShiftedRowVariablePosition + exact Nat.mod_lt _ + (paperVariableArityPhysicalShiftedRowSelectedClauseArity_pos + formula row hbound) + +private theorem paperVariableArityPhysicalShiftedRowVariablePosition_lt_three + (formula : ThreeCNF) (row : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedRowVariablePosition + formula row hbound < 3 := by + have arity := paperVariableArityPhysicalShiftedRowVariablePosition_lt_arity + formula row hbound + have bounded := paperNormalizedClause_length_le_three + ((noTautClauses formula).get + ⟨physicalShiftedRowClauseRank formula row, + hbound⟩) + change physicalShiftedRowVariablePosition + formula row hbound < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨physicalShiftedRowClauseRank formula row, + hbound⟩)).length at arity + omega + +end PhysicalShiftedRowTupleRankTM + +namespace PhysicalShiftedExpectedTypeRankTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFourFamilyInterpolationMembershipPredicateTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.ClauseOffsetTM GapCVP.ShiftedTupleBetaTM +open GapCVP.RefinementClauseOffsetTM GapCVP.PhysicalShiftedRowTupleRankTM + +private def physicalShiftedExpectedLocalTypePrefixWord : + List Bool → List Bool := + paperRefinementClauseOffsetUnary ∘ + physicalShiftedRowSelectedClauseEnvelope + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedExpectedLocalTypePrefixComputable : + BitTM + physicalShiftedExpectedLocalTypePrefixWord := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalShiftedRowSelectedClauseEnvelopeComputable + paperVariableArityRefinementClauseOffsetUnaryComputable + +private def physicalShiftedExpectedLocalTypePrefix + (formula : ThreeCNF) (row : ℕ) : ℕ := + sourceClauseWeightSum + ((noTautClauses formula).take + (physicalShiftedRowClauseRank formula row)) + +private theorem paperVariableArityPhysicalShiftedExpectedLocalTypePrefixWord_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row ≤ + (noTautClauses formula).length) : + physicalShiftedExpectedLocalTypePrefixWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedExpectedLocalTypePrefix + formula row) true := by + unfold physicalShiftedExpectedLocalTypePrefixWord + rw [Function.comp_apply, + paperVariableArityPhysicalShiftedRowSelectedClauseEnvelope_query] + change paperRefinementClauseOffsetUnary + (paperRefinementClauseRankEnvelope formula + (physicalShiftedRowClauseRank formula row)) = _ + exact paperVariableArityRefinementClauseOffsetUnary_valid + formula (physicalShiftedRowClauseRank formula row) + hbound + +private def physicalShiftedExpectedTableTypeRankWord : + List Bool → List Bool := + fourFamilyComputedUnarySumOutput + (paperShiftedTupleConstantUnary 1) + (fourFamilyComputedUnarySumOutput + physicalShiftedExpectedLocalTypePrefixWord + physicalShiftedRowTupleRankWord) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityPhysicalShiftedExpectedTableTypeRankComputable : + BitTM + physicalShiftedExpectedTableTypeRankWord := + fourFamilyComputedUnarySumComputable + (paperVariableArityShiftedTupleConstantUnaryComputable 1) + (fourFamilyComputedUnarySumComputable + paperVariableArityPhysicalShiftedExpectedLocalTypePrefixComputable + paperVariableArityPhysicalShiftedRowTupleRankComputable) + +private def physicalShiftedExpectedTableTypeRank + (formula : ThreeCNF) (row : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : ℕ := + 1 + (physicalShiftedExpectedLocalTypePrefix formula row + + physicalShiftedRowTupleRank formula row hbound) + +private theorem paperVariableArityPhysicalShiftedExpectedTableTypeRankWord_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedExpectedTableTypeRankWord + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedExpectedTableTypeRank + formula row hbound) true := by + let input := affineCellQuery row column + (encodeThreeCNF formula) + have predecessors := + paperVariableArityPhysicalShiftedExpectedLocalTypePrefixWord_query + formula row column (Nat.le_of_lt hbound) + have tuple := paperVariableArityPhysicalShiftedRowTupleRankWord_query + formula row column hbound + have localSum := fourFamilyComputedUnarySumOutput_valid + physicalShiftedExpectedLocalTypePrefixWord + physicalShiftedRowTupleRankWord input + (physicalShiftedExpectedLocalTypePrefix formula row) + (physicalShiftedRowTupleRank formula row hbound) + predecessors tuple + unfold physicalShiftedExpectedTableTypeRankWord + physicalShiftedExpectedTableTypeRank + exact fourFamilyComputedUnarySumOutput_valid + (paperShiftedTupleConstantUnary 1) + (fourFamilyComputedUnarySumOutput + physicalShiftedExpectedLocalTypePrefixWord + physicalShiftedRowTupleRankWord) + input 1 + (physicalShiftedExpectedLocalTypePrefix formula row + + physicalShiftedRowTupleRank formula row hbound) + rfl localSum + +private noncomputable def physicalShiftedExpectedTableTypeRankComputer : + SourcePhysicalLagrangeWordComputer where + output := physicalShiftedExpectedTableTypeRankWord + computer := paperVariableArityPhysicalShiftedExpectedTableTypeRankComputable + +private theorem paperVariableArityPhysicalShiftedExpectedTableTypeRankComputer_query + (formula : ThreeCNF) (row column : ℕ) + (hbound : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedExpectedTableTypeRankComputer.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + List.replicate + (physicalShiftedExpectedTableTypeRank + formula row hbound) true := by + dsimp only [physicalShiftedExpectedTableTypeRankComputer] + exact paperVariableArityPhysicalShiftedExpectedTableTypeRankWord_query + formula row column hbound + +end PhysicalShiftedExpectedTypeRankTM + +namespace PhysicalShiftedInterpolationBaseCorrectness + +open Turing GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows GapCVP.BinaryFieldBasis +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.BinaryCompactPhysicalFieldWordXorTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.PhysicalOrdinaryShiftedCoefficientTM +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldOperationsMachine +open GapCVP.ShiftedTupleBetaTM GapCVP.ShiftedTupleBetaSourceCorrectness +open GapCVP.ShiftedTupleBetaSourceFieldCorrectness +open GapCVP.ShiftedTupleAnchorSourceFieldCorrectness GapCVP.PhysicalShiftedInterpolationBaseTM + +private theorem paperVariableArityPhysicalShiftedColumnValueComputer_output + (input : List Bool) : + physicalShiftedColumnValueComputer.output input = + physicalShiftedColumnValueWord input := by + dsimp only [physicalShiftedColumnValueComputer] + +private theorem paperVariableArityPhysicalShiftedColumnGridComputer_output + (input : List Bool) : + physicalShiftedColumnGridComputer.output input = + physicalShiftedColumnGridWord input := by + dsimp only [physicalShiftedColumnGridComputer] + +private theorem paperVariableArityPhysicalShiftedBetaComputer_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) (bit : Bool) + (correctBit : paperShiftedTupleBetaBit ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = [bit]) : + (paperShiftedTupleBetaFieldComputer ranks).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (paperShiftedTupleBetaFieldIndex formula bit)) := by + rw [paperVariableArityShiftedTupleBetaFieldComputer_output] + exact paperVariableArityShiftedTupleBetaFieldWord_valid + ranks row column formula bit correctBit + +private theorem paperVariableArityPhysicalShiftedInterpolationNumeratorComputer_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) (bit : Bool) + (correctBit : paperShiftedTupleBetaBit ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = [bit]) : + (physicalShiftedInterpolationNumeratorComputer + ranks).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (compactPhysicalFieldWordXorValue + (physicalShiftedColumnValueSourceWord + formula column) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (paperShiftedTupleBetaFieldIndex formula bit))) := by + simp only [physicalShiftedInterpolationNumeratorComputer, + paperVariableArityPhysicalInterpolationDifferenceComputer] + apply paperVariableArityPhysicalInterpolationDifferenceWord_valid + physicalShiftedColumnValueComputer + (paperShiftedTupleBetaFieldComputer ranks) + row column formula + · rw [paperVariableArityPhysicalShiftedColumnValueComputer_output] + exact paperVariableArityPhysicalShiftedColumnValueWord_valid + row column formula + · exact paperVariableArityPhysicalShiftedBetaComputer_valid + ranks row column formula bit correctBit + +private theorem paperVariableArityPhysicalShiftedAnchorComputer_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (bounded : rank < (noTautClauses formula).length) + (correctRank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (validPosition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, bounded⟩)).length) + (correctPosition : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + (paperShiftedTupleRetainedAnchorFieldComputer ranks).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (paperShiftedTupleSelectedSourceVariableWord + formula rank bounded position validPosition) := by + change paperShiftedTupleRetainedAnchorFieldWord ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = _ + exact paperVariableArityShiftedTupleRetainedAnchorFieldWord_query + ranks row column formula rank bounded correctRank + position validPosition correctPosition + +private theorem paperVariableArityPhysicalShiftedInterpolationDenominatorComputer_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (bounded : rank < (noTautClauses formula).length) + (correctRank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (validPosition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, bounded⟩)).length) + (correctPosition : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + (paperVariableArityPhysicalShiftedInterpolationDenominatorComputer + ranks).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (compactPhysicalFieldWordXorValue + (physicalShiftedColumnGridSourceWord + formula column) + (paperShiftedTupleSelectedSourceVariableWord + formula rank bounded position validPosition)) := by + simp only [paperVariableArityPhysicalShiftedInterpolationDenominatorComputer, + paperVariableArityPhysicalInterpolationDifferenceComputer] + apply paperVariableArityPhysicalInterpolationDifferenceWord_valid + physicalShiftedColumnGridComputer + (paperShiftedTupleRetainedAnchorFieldComputer ranks) + row column formula + · rw [paperVariableArityPhysicalShiftedColumnGridComputer_output] + exact paperVariableArityPhysicalShiftedColumnGridWord_valid + row column formula + · exact paperVariableArityPhysicalShiftedAnchorComputer_valid + ranks row column formula rank bounded correctRank + position validPosition correctPosition + +private theorem paperVariableArityPhysicalShiftedInterpolationDenominatorInverse_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (bounded : rank < (noTautClauses formula).length) + (correctRank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (validPosition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, bounded⟩)).length) + (correctPosition : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) : + (paperVariableArityPhysicalCellInverseComputer + (paperVariableArityPhysicalShiftedInterpolationDenominatorComputer + ranks)).output + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (sourceInverseWord + (compactPhysicalFieldWordXorValue + (physicalShiftedColumnGridSourceWord + formula column) + (paperShiftedTupleSelectedSourceVariableWord + formula rank bounded position validPosition))) := by + change physicalCellInverseWord + (paperVariableArityPhysicalShiftedInterpolationDenominatorComputer + ranks) + (affineCellQuery row column + (encodeThreeCNF formula)) = _ + apply paperVariableArityPhysicalCellInverseWord_valid + (paperVariableArityPhysicalShiftedInterpolationDenominatorComputer + ranks) + row column formula + exact paperVariableArityPhysicalShiftedInterpolationDenominatorComputer_valid + ranks row column formula rank bounded correctRank + position validPosition correctPosition + +private theorem paperVariableArityPhysicalShiftedInterpolationBaseWord_valid + (ranks : PaperVariableArityShiftedTupleRankComputers) + (row column : ℕ) (formula : ThreeCNF) + (rank : ℕ) + (bounded : rank < (noTautClauses formula).length) + (correctRank : ranks.clause.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate rank true) + (position : ℕ) + (validPosition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, bounded⟩)).length) + (correctPosition : ranks.variablePosition.output + (affineCellQuery row column + (encodeThreeCNF formula)) = List.replicate position true) + (bit : Bool) + (correctBit : paperShiftedTupleBetaBit ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = [bit]) : + physicalShiftedInterpolationBaseWord ranks + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (physicalShiftedInterpolationBaseSourceWord + formula column rank bounded position validPosition bit) := by + unfold physicalShiftedInterpolationBaseWord + physicalShiftedInterpolationBaseSourceWord + apply paperVariableArityPhysicalInterpolationProductWord_valid + (physicalShiftedInterpolationNumeratorComputer ranks) + (paperVariableArityPhysicalCellInverseComputer + (paperVariableArityPhysicalShiftedInterpolationDenominatorComputer + ranks)) + row column formula + · exact paperVariableArityPhysicalShiftedInterpolationNumeratorComputer_valid + ranks row column formula bit correctBit + · exact paperVariableArityPhysicalShiftedInterpolationDenominatorInverse_valid + ranks row column formula rank bounded correctRank + position validPosition correctPosition + +end PhysicalShiftedInterpolationBaseCorrectness + +namespace PhysicalShiftedInterpolationBaseInstantiation + +open Turing GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryModularReductionTM GapCVP.BinaryPhysicalLagrangeCoefficientTM +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.PhysicalFamilyRowTM GapCVP.ShiftedTupleBetaTM +open GapCVP.ShiftedTupleBetaSourceCorrectness GapCVP.PhysicalShiftedRowTupleRankTM +open GapCVP.PhysicalShiftedInterpolationBaseTM +open GapCVP.PhysicalShiftedInterpolationBaseCorrectness + +private def physicalShiftedRowNormalizedSign + (formula : ThreeCNF) (row : ℕ) + (bounded : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) + (slot : Fin 3) : Bool := + (paperShiftedTuplePotentialNormalizedLiteral + ((noTautClauses formula).get + ⟨physicalShiftedRowClauseRank formula row, + bounded⟩) slot).2 + +private def physicalShiftedRowBetaBit + (formula : ThreeCNF) (row : ℕ) + (bounded : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : Bool := + let tuple := physicalShiftedRowTupleRank + formula row bounded + let arity := physicalShiftedRowSelectedClauseArity + formula row bounded + let sign := physicalShiftedRowNormalizedSign + formula row bounded + let assignment := tuple + + if tuple < paperShiftedTupleRejectedNatural arity sign + then 0 else 1 + assignment.testBit + (physicalShiftedRowVariablePosition + formula row bounded) + +private theorem paperVariableArityPhysicalShiftedRowBetaBit_query + (formula : ThreeCNF) (row column : ℕ) + (bounded : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + paperShiftedTupleBetaBit + physicalShiftedRowTupleRankComputers + (affineCellQuery row column + (encodeThreeCNF formula)) = + [physicalShiftedRowBetaBit + formula row bounded] := by + unfold physicalShiftedRowBetaBit + apply paperVariableArityShiftedTupleBetaBit_valid + physicalShiftedRowTupleRankComputers + (affineCellQuery row column (encodeThreeCNF formula)) + (physicalShiftedRowSelectedClauseArity + formula row bounded) + (physicalShiftedRowTupleRank + formula row bounded) + (physicalShiftedRowVariablePosition + formula row bounded) + (physicalShiftedRowNormalizedSign + formula row bounded) + · exact paperVariableArityPhysicalShiftedRowVariablePosition_lt_three + formula row bounded + · simpa only [physicalShiftedRowSelectedClauseArity] + using paperVariableArityShiftedTupleNormalizedArityUnary_query + physicalShiftedRowTupleRankComputers + row column formula + (physicalShiftedRowClauseRank formula row) + bounded + (paperVariableArityPhysicalShiftedRowTupleRankComputers_clause_query + formula row column) + · intro slot + exact paperVariableArityShiftedTupleNormalizedSignWord_potential_query + physicalShiftedRowTupleRankComputers + row column formula + (physicalShiftedRowClauseRank formula row) + bounded + (paperVariableArityPhysicalShiftedRowTupleRankComputers_clause_query + formula row column) + slot + · exact paperVariableArityPhysicalShiftedRowTupleRankComputers_tuple_query + formula row column bounded + · exact + paperVariableArityPhysicalShiftedRowTupleRankComputers_variablePosition_query + formula row column bounded + +private theorem physicalShiftedRowVariablePosition_lt_normalized + (formula : ThreeCNF) (row : ℕ) + (bounded : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedRowVariablePosition + formula row bounded < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨physicalShiftedRowClauseRank formula row, + bounded⟩)).length := by + exact paperVariableArityPhysicalShiftedRowVariablePosition_lt_arity + formula row bounded + +private def physicalShiftedCanonicalInterpolationBaseSourceWord + (formula : ThreeCNF) (row column : ℕ) + (bounded : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula) := + physicalShiftedInterpolationBaseSourceWord + formula column + (physicalShiftedRowClauseRank formula row) + bounded + (physicalShiftedRowVariablePosition + formula row bounded) + (physicalShiftedRowVariablePosition_lt_normalized + formula row bounded) + (physicalShiftedRowBetaBit formula row bounded) + +private noncomputable def physicalShiftedCanonicalInterpolationBaseComputer : + SourcePhysicalLagrangeWordComputer := + paperVariableArityPhysicalShiftedInterpolationBaseComputer + physicalShiftedRowTupleRankComputers + +private theorem paperVariableArityPhysicalShiftedCanonicalInterpolationBaseComputer_output + (input : List Bool) : + physicalShiftedCanonicalInterpolationBaseComputer.output + input = + physicalShiftedInterpolationBaseWord + physicalShiftedRowTupleRankComputers input := by + dsimp only [physicalShiftedCanonicalInterpolationBaseComputer, + paperVariableArityPhysicalShiftedInterpolationBaseComputer] + +private theorem paperVariableArityPhysicalShiftedCanonicalInterpolationBaseComputer_valid + (formula : ThreeCNF) (row column : ℕ) + (bounded : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + physicalShiftedCanonicalInterpolationBaseComputer.output + (affineCellQuery row column + (encodeThreeCNF formula)) = + finiteWordBits + (physicalShiftedCanonicalInterpolationBaseSourceWord + formula row column bounded) := by + rw [paperVariableArityPhysicalShiftedCanonicalInterpolationBaseComputer_output] + unfold physicalShiftedCanonicalInterpolationBaseSourceWord + exact paperVariableArityPhysicalShiftedInterpolationBaseWord_valid + physicalShiftedRowTupleRankComputers + row column formula + (physicalShiftedRowClauseRank formula row) + bounded + (paperVariableArityPhysicalShiftedRowTupleRankComputers_clause_query + formula row column) + (physicalShiftedRowVariablePosition + formula row bounded) + (physicalShiftedRowVariablePosition_lt_normalized + formula row bounded) + (paperVariableArityPhysicalShiftedRowTupleRankComputers_variablePosition_query + formula row column bounded) + (physicalShiftedRowBetaBit formula row bounded) + (paperVariableArityPhysicalShiftedRowBetaBit_query + formula row column bounded) + +end PhysicalShiftedInterpolationBaseInstantiation + +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open Turing GapCVP.PhysicalFamilyMarkerTM GapCVP.PhysicalOrdinaryShiftedCoefficientSumTM +open GapCVP.PhysicalMaskedInterpolationNodeParityTM GapCVP.PhysicalShiftedExpectedTypeRankTM +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation + +/-- Internal support shared across GapCVP continuation modules. -/ +def physicalShiftedCheckBit : List Bool → List Bool := + physicalSourceInterpolationFamilyCheckBit + (3 : Fin 4) + physicalShiftedRowMarker + physicalShiftedExpectedTableTypeRankComputer + (physicalShiftedNodePrefixWidth + physicalShiftedInterpolationMomentComputer) + physicalShiftedCanonicalInterpolationBaseComputer + +/-- Internal support shared across GapCVP continuation modules. -/ +noncomputable def paperVariableArityPhysicalShiftedCheckBitComputable : + BitTM + physicalShiftedCheckBit := + paperVariableArityPhysicalSourceInterpolationFamilyCheckBitComputable + (3 : Fin 4) + physicalShiftedRowMarker + paperVariableArityPhysicalShiftedRowMarkerComputable + physicalShiftedExpectedTableTypeRankComputer + (physicalShiftedNodePrefixWidth + physicalShiftedInterpolationMomentComputer) + physicalShiftedCanonicalInterpolationBaseComputer + +end PhysicalOrdinaryShiftedCheckBitInstantiation + +namespace PhysicalShiftedRowTupleRankBounds + +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourceOrder +open GapCVP.ShiftedTupleTM GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalRefinementRowProjection +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalRowCountMachine +open GapCVP.SourceFieldMomentOperationsTM GapCVP.PhysicalShiftedRowTupleRankTM + +private theorem paperVariableArityPhysicalShiftedRowWordCount_eq + (formula : ThreeCNF) : + paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula = + physicalFormulaOrdinaryBoundary formula + + (((paperShiftedSourceClauseWeightSum + (noTautClauses formula) * + physicalFormulaMomentCount formula) * + physGridCard formula) * + physDegree formula) := by + rw [paperVariableArityExplicitBinaryRowWordCount_eq_fourFamily] + +private theorem paperVariableArityPhysicalShiftedRowMixedTag_lt_of_row + (formula : ThreeCNF) (row : ℕ) + (hshifted : physicalFormulaOrdinaryBoundary formula ≤ row) + (hrow : row < paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula) : + physicalShiftedRowMixedTag formula row < + paperShiftedSourceClauseWeightSum + (noTautClauses formula) := by + have upper : + row < physicalFormulaOrdinaryBoundary formula + + (((paperShiftedSourceClauseWeightSum + (noTautClauses formula) * + physicalFormulaMomentCount formula) * + physGridCard formula) * + physDegree formula) := by + rw [← paperVariableArityPhysicalShiftedRowWordCount_eq] + exact hrow + have offset : + row - physicalFormulaOrdinaryBoundary formula < + (((paperShiftedSourceClauseWeightSum + (noTautClauses formula) * + physicalFormulaMomentCount formula) * + physGridCard formula) * + physDegree formula) := by + omega + unfold physicalShiftedRowMixedTag + apply (Nat.div_lt_iff_lt_mul + (physicalFormulaMomentCount_pos formula)).mpr + apply (Nat.div_lt_iff_lt_mul + (physicalRefinementGridCard_pos formula)).mpr + apply (Nat.div_lt_iff_lt_mul + (physicalRefinementDegree_pos formula)).mpr + exact offset + +private theorem paperVariableArityPhysicalShiftedRowAcceptedPrefixCount_le + (formula : ThreeCNF) (row : ℕ) : + physicalShiftedRowAcceptedPrefixCount formula row ≤ + (noTautClauses formula).length := by + unfold physicalShiftedRowAcceptedPrefixCount + have filtered := List.length_filter_le + (fun rank => decide + (physicalShiftedRowClausePrefix formula rank ≤ + physicalShiftedRowMixedTag formula row)) + (List.range (noTautClauses formula).length) + simpa only [List.length_range] using filtered + +private theorem paperVariableArityPhysicalShiftedRetainedClauseCount_pos_of_row + (formula : ThreeCNF) (row : ℕ) + (hshifted : physicalFormulaOrdinaryBoundary formula ≤ row) + (hrow : row < paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula) : + 0 < (noTautClauses formula).length := by + have mixed := paperVariableArityPhysicalShiftedRowMixedTag_lt_of_row + formula row hshifted hrow + by_contra notPositive + have zero : (noTautClauses formula).length = 0 := + Nat.eq_zero_of_not_pos notPositive + have empty : noTautClauses formula = [] := + List.length_eq_zero_iff.mp zero + rw [empty] at mixed + simp only [paperShiftedSourceClauseWeightSum, List.map_nil, List.sum_nil, not_lt_zero] at mixed + +private theorem paperVariableArityPhysicalShiftedRowClauseRank_lt_of_row + (formula : ThreeCNF) (row : ℕ) + (hshifted : physicalFormulaOrdinaryBoundary formula ≤ row) + (hrow : row < paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula) : + physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length := by + have positive := + paperVariableArityPhysicalShiftedRetainedClauseCount_pos_of_row + formula row hshifted hrow + have bounded := paperVariableArityPhysicalShiftedRowAcceptedPrefixCount_le + formula row + unfold physicalShiftedRowClauseRank + omega + +private theorem physicalShiftedRowClauseRank_lt_of_fin + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (hshifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + physicalShiftedRowClauseRank formula row.val < + (noTautClauses formula).length := + paperVariableArityPhysicalShiftedRowClauseRank_lt_of_row + formula row.val hshifted row.isLt + +end PhysicalShiftedRowTupleRankBounds + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFourFamilyBooleanPredicateTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.MatrixEntrySemantics +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM +open GapCVP.PhysicalGlobalRefinementCoefficientTM GapCVP.PhysicalShiftedExpectedTypeRankTM +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation GapCVP.PhysicalShiftedRowTupleRankTM +open GapCVP.SourceOrder GapCVP.BinarySourceTautologyNormalizationExact + +private theorem paperVariableArityPhysicalShiftedCheckBit_of_not_in_family + (formula : ThreeCNF) (row column : ℕ) + (outside : ¬ + physicalFormulaOrdinaryBoundary formula ≤ row) : + physicalShiftedCheckBit + (affineCellQuery row column + (encodeThreeCNF formula)) = [false] := by + let query := affineCellQuery row column + (encodeThreeCNF formula) + have rejected : + physicalShiftedRowMarker query = [false] := by + change physicalShiftedRowMarker + (affineCellQuery row column + (encodeThreeCNF formula)) = [false] + rw [paperVariableArityPhysicalShiftedRowMarker_query] + simp only [outside, decide_false] + unfold physicalShiftedCheckBit + physicalSourceInterpolationFamilyCheckBit + change sourceFourFamilyBooleanAndPairWord + (physicalShiftedRowMarker query ++ _) = [false] + rw [rejected] + rfl + +private theorem paperVariableArityPhysicalShiftedCheckBase_on_physical_row + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (bounded : physicalShiftedRowClauseRank + formula row.val < (noTautClauses formula).length) : + physicalShiftedCanonicalInterpolationBaseComputer.output + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + finiteWordBits + (physicalShiftedCanonicalInterpolationBaseSourceWord + formula row.val column.val bounded) := by + exact paperVariableArityPhysicalShiftedCanonicalInterpolationBaseComputer_valid + formula row.val column.val bounded + +private theorem paperVariableArityPhysicalShiftedExpectedTypeMatchBit_valid + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (bounded : physicalShiftedRowClauseRank + formula row.val < (noTautClauses formula).length) : + physicalInterpolationExpectedTypeMatchBit + physicalShiftedExpectedTableTypeRankComputer + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalShiftedExpectedTableTypeRank + formula row.val bounded = + (column.val / + physFieldCard formula) / + physGridCard formula)] := by + unfold physicalInterpolationExpectedTypeMatchBit + exact physicalCoefficientUnaryEquality_valid + physicalShiftedExpectedTableTypeRankComputer.output + physicalColumnTypeRankUnary + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) + (physicalShiftedExpectedTableTypeRank + formula row.val bounded) + ((column.val / + physFieldCard formula) / + physGridCard formula) + (paperVariableArityPhysicalShiftedExpectedTableTypeRankComputer_query + formula row.val column.val bounded) + (paperVariableArityPhysicalColumnTypeRankUnary_query + row.val column.val formula) + +end PhysicalOrdinaryShiftedCheckBitInstantiation + +namespace PhysicalShiftedInterpolationBaseSourceFieldCorrectness + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryFieldBasis GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryCompactPhysicalFieldWordXorTM GapCVP.BinarySourceCoordinateOrder +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.FormulaBridge +open GapCVP.Factor400BinaryConstructivePaperVariableAritySourceFieldArithmeticMachine +open GapCVP.PhysicalLagrangeNodeProductAlgebra GapCVP.PhysicalLagrangeNodeDenominatorNonzero +open GapCVP.ShiftedTupleAnchorSourceFieldCorrectness +open GapCVP.ShiftedTupleBetaSourceFieldCorrectness GapCVP.PhysicalShiftedRowTupleRankTM +open GapCVP.PhysicalShiftedInterpolationBaseTM +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation + +private theorem paperVariableArityPhysicalShiftedColumnGridSourceWord_eq_evaluationWord + (formula : ThreeCNF) (column : ℕ) : + physicalShiftedColumnGridSourceWord formula column = + physicalLagrangeNodeEvaluationWord formula + (physicalShiftedColumnGridIndex formula column) := by + rfl + +private theorem paperVariableArityPhysicalShiftedInterpolationDenominatorSourceValue_ne_zero + (formula : ThreeCNF) (column rank : ℕ) + (bounded : rank < (noTautClauses formula).length) + (position : ℕ) + (validPosition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, bounded⟩)).length) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (compactPhysicalFieldWordXorValue + (physicalShiftedColumnGridSourceWord + formula column) + (paperShiftedTupleSelectedSourceVariableWord + formula rank bounded position validPosition)) ≠ 0 := by + rw [compactPhysicalFieldWordXorValue_sourceWordValue_sub, + paperVariableArityPhysicalShiftedColumnGridSourceWord_eq_evaluationWord, + paperVariableArityShiftedTupleSelectedSourceVariableWord_sourceField] + exact + paperVariableArityPhysicalLagrangeNodeEvaluationSourceValue_sub_variableAnchor_ne_zero + formula + (physicalShiftedColumnGridIndex formula column) + (paperShiftedTupleSelectedSourceVariableIndex + formula rank bounded position validPosition) + +private theorem paperVariableArityPhysicalShiftedInterpolationNumeratorSourceWord_sourceField + (formula : ThreeCNF) (column : ℕ) (bit : Bool) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (compactPhysicalFieldWordXorValue + (physicalShiftedColumnValueSourceWord + formula column) + (indexedWord + (sourceIrreducibleFormulaDegree formula) + (paperShiftedTupleBetaFieldIndex formula bit))) = + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnValueSourceWord + formula column) - + sourceSATFieldBit + (K := GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + (encodeThreeCNF formula).length + (srcFormula formula)) bit := by + rw [compactPhysicalFieldWordXorValue_sourceWordValue_sub, + paperVariableArityShiftedTupleBetaIndexedWord_sourceField] + +private theorem paperVariableArityPhysicalShiftedInterpolationBaseSourceWord_sourceField + (formula : ThreeCNF) (column rank : ℕ) + (bounded : rank < (noTautClauses formula).length) + (position : ℕ) + (validPosition : position < + (paperSourceNormalizedClause + ((noTautClauses formula).get + ⟨rank, bounded⟩)).length) + (bit : Bool) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedInterpolationBaseSourceWord + formula column rank bounded position validPosition bit) = + (sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnValueSourceWord + formula column) - + sourceSATFieldBit + (K := GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + (encodeThreeCNF formula).length + (srcFormula formula)) bit) / + (sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnGridIndex + formula column) - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + (encodeThreeCNF formula).length + (srcFormula formula) + (paperShiftedTupleSelectedSourceVariableIndex + formula rank bounded position validPosition)) := by + unfold physicalShiftedInterpolationBaseSourceWord + rw [sourceWordValue_multiplyMod, + paperVariableArityPhysicalShiftedInterpolationNumeratorSourceWord_sourceField, + sourceWordValue_sourceInverseWord + (encodeThreeCNF formula).length + (srcFormula formula) + (compactPhysicalFieldWordXorValue + (physicalShiftedColumnGridSourceWord + formula column) + (paperShiftedTupleSelectedSourceVariableWord + formula rank bounded position validPosition)) + (paperVariableArityPhysicalShiftedInterpolationDenominatorSourceValue_ne_zero + formula column rank bounded position validPosition), + compactPhysicalFieldWordXorValue_sourceWordValue_sub, + paperVariableArityPhysicalShiftedColumnGridSourceWord_eq_evaluationWord, + physicalLagrangeNodeEvaluationWord_sourceField, + paperVariableArityShiftedTupleSelectedSourceVariableWord_sourceField, + div_eq_mul_inv] + +theorem + paperVariableArityPhysicalShiftedCanonicalInterpolationBaseSourceWord_sourceField + (formula : ThreeCNF) (row column : ℕ) + (bounded : physicalShiftedRowClauseRank formula row < + (noTautClauses formula).length) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedCanonicalInterpolationBaseSourceWord + formula row column bounded) = + (sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnValueSourceWord + formula column) - + sourceSATFieldBit + (K := GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + (encodeThreeCNF formula).length + (srcFormula formula)) + (physicalShiftedRowBetaBit + formula row bounded)) / + (sourceFormulaEvaluationWord + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedColumnGridIndex + formula column) - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + (encodeThreeCNF formula).length + (srcFormula formula) + (paperShiftedTupleSelectedSourceVariableIndex + formula + (physicalShiftedRowClauseRank formula row) + bounded + (physicalShiftedRowVariablePosition + formula row bounded) + (physicalShiftedRowVariablePosition_lt_normalized + formula row bounded))) := by + unfold physicalShiftedCanonicalInterpolationBaseSourceWord + exact paperVariableArityPhysicalShiftedInterpolationBaseSourceWord_sourceField + formula column + (physicalShiftedRowClauseRank formula row) + bounded + (physicalShiftedRowVariablePosition + formula row bounded) + (physicalShiftedRowVariablePosition_lt_normalized + formula row bounded) + (physicalShiftedRowBetaBit formula row bounded) + +end PhysicalShiftedInterpolationBaseSourceFieldCorrectness + +namespace PhysicalShiftedInterpolationParityFieldCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryReedSolomonParity +open GapCVP.BinarySourceCoordinateOrder GapCVP.FormulaBridge GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalLagrangeNodeProductAlgebra GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalInterpolationNodeWeightTM +open GapCVP.PhysicalInterpolationNodeWeightSourceFieldCorrectness +open GapCVP.PhysicalInterpolationNodeCountBounds GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryShiftedCheckBitInstantiation GapCVP.SourceFieldMomentOperationsTM + +private theorem paperVariableArityPhysicalShiftedOrderedLagrangeParity_eq_selectedCorrection + {K : Type*} [Field K] + {gridCardinality degreeBound : ℕ} + (points : Fin gridCardinality → K) + (degreeBounded : degreeBound < gridCardinality) + (row position : Fin gridCardinality) : + constructiveParityMatrix points degreeBounded row position = + (if row = position then (1 : K) else 0) - + if selected : position.val < degreeBound + 1 then + ∏ other ∈ (Finset.univ.erase + (⟨position.val, selected⟩ : Fin (degreeBound + 1))), + (points + (Fin.castLE (Nat.succ_le_of_lt degreeBounded) + (⟨position.val, selected⟩ : Fin (degreeBound + 1))) - + points (Fin.castLE (Nat.succ_le_of_lt degreeBounded) other))⁻¹ * + (points row - + points (Fin.castLE (Nat.succ_le_of_lt degreeBounded) other)) + else 0 := + paperVariableArityPhysicalOrderedLagrangeParity_eq_selectedCorrection + points degreeBounded row position + +private theorem paperVariableArityPhysicalShiftedOrderedLagrangeParity_mul + {K : Type*} [Field K] + {gridCardinality degreeBound : ℕ} + (points : Fin gridCardinality → K) + (degreeBounded : degreeBound < gridCardinality) + (row position : Fin gridCardinality) + (power : K) : + constructiveParityMatrix points degreeBounded row position * power = + (if row = position then power else 0) - + if selected : position.val < degreeBound + 1 then + (∏ other ∈ (Finset.univ.erase + (⟨position.val, selected⟩ : Fin (degreeBound + 1))), + (points row - + points (Fin.castLE (Nat.succ_le_of_lt degreeBounded) + other))) * + (∏ other ∈ (Finset.univ.erase + (⟨position.val, selected⟩ : Fin (degreeBound + 1))), + (points position - + points (Fin.castLE (Nat.succ_le_of_lt degreeBounded) + other)))⁻¹ * power + else 0 := by + rw [paperVariableArityPhysicalShiftedOrderedLagrangeParity_eq_selectedCorrection, + sub_mul] + simp only [ite_mul, one_mul, zero_mul] + by_cases selected : position.val < degreeBound + 1 + · simp only [dite_eq_left selected] + have same : + Fin.castLE (Nat.succ_le_of_lt degreeBounded) + (⟨position.val, selected⟩ : Fin (degreeBound + 1)) = position := by + apply Fin.ext + rfl + rw [same, Finset.prod_mul_distrib, Finset.prod_inv_distrib] + ac_rfl + · simp only [selected, ↓reduceDIte, zero_mul, sub_zero] + +private abbrev physicalShiftedSourceInterpolationDegree + (formula : ThreeCNF) (row : ℕ) : ℕ := + ((srcFormula formula).variableCount - 1) * + physicalFamilyRowMoment (3 : Fin 4) row formula + +private theorem paperVariableArityPhysicalShiftedInterpolationNodeCount_eq_sourceDegree + (formula : ThreeCNF) (row : ℕ) : + physicalShiftedInterpolationNodeCount row formula = + physicalShiftedSourceInterpolationDegree + formula row + 1 := by + unfold physicalShiftedInterpolationNodeCount + change + (paperVariableArityVariableCount formula - 1) * + physicalFamilyRowMoment (3 : Fin 4) row formula + 1 = + ((srcFormula formula).variableCount - 1) * + physicalFamilyRowMoment (3 : Fin 4) row formula + 1 + rw [paperVariableAritySourceFormula_variableCount] + +private theorem physicalShiftedSourceInterpolationDegree_lt_grid + (formula : ThreeCNF) (row : ℕ) : + physicalShiftedSourceInterpolationDegree formula row < + 2 ^ physDegree formula - + (srcFormula formula).variableCount := by + have bounded := physicalShiftedInterpolationNodeCount_le_grid + formula row + rw [paperVariableArityPhysicalShiftedInterpolationNodeCount_eq_sourceDegree] + at bounded + exact Nat.lt_of_succ_le bounded + +private noncomputable def physicalShiftedSourceGridPoints + (formula : ThreeCNF) : + PaperVariableArityPhysicalLagrangeNodeGridIndex formula → + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + (encodeThreeCNF formula).length + (srcFormula formula) := + sourceFormulaEvaluationWord (encodeThreeCNF formula).length + (srcFormula formula) + +private theorem paperVariableArityPhysicalShiftedLagrangeParity_mul_eq_selectedNodeWeight + (formula : ThreeCNF) (row : ℕ) + (position : PaperVariableArityPhysicalLagrangeNodeGridIndex formula) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) : + constructiveParityMatrix + (physicalShiftedSourceGridPoints formula) + (physicalShiftedSourceInterpolationDegree_lt_grid + formula row) + (physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row formula) + position * + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) value ^ + physicalFamilyRowMoment + (3 : Fin 4) row formula = + (if physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row formula = position + then sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) value ^ + physicalFamilyRowMoment + (3 : Fin 4) row formula + else 0) - + if selected : position.val < + physicalShiftedSourceInterpolationDegree + formula row + 1 then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeWeightSourceWord + (3 : Fin 4) row formula + (physicalShiftedSourceInterpolationDegree + formula row + 1) + (Nat.succ_le_of_lt + (physicalShiftedSourceInterpolationDegree_lt_grid + formula row)) + ⟨position.val, selected⟩ value) + else 0 := by + rw [paperVariableArityPhysicalShiftedOrderedLagrangeParity_mul] + by_cases selected : position.val < + physicalShiftedSourceInterpolationDegree + formula row + 1 + · simp only [dite_eq_left selected] + rw [paperVariableArityPhysicalInterpolationNodeWeightSourceWord_sourceField] + have same : + Fin.castLE + (Nat.succ_le_of_lt + (physicalShiftedSourceInterpolationDegree_lt_grid + formula row)) + (⟨position.val, selected⟩ : Fin + (physicalShiftedSourceInterpolationDegree + formula row + 1)) = position := by + apply Fin.ext + rfl + simp only [physicalShiftedSourceGridPoints] + rw [same] + · simp only [dite_eq_right selected] + +private theorem paperVariableArityPhysicalShiftedMaskedNodeSum_eq_selected + {K : Type*} [AddCommMonoid K] + (count grid : ℕ) (value : ℕ → K) : + (((List.range count).map (fun node => + if node = grid then value node else 0)).sum) = + if grid < count then value grid else 0 := by + change (∑ node ∈ Finset.range count, + if node = grid then value node else 0) = _ + simp only [Finset.sum_ite_eq', Finset.mem_range] + +private theorem paperVariableArityPhysicalShiftedMaskedSourceNodeWeightSum_eq_selected + (formula : ThreeCNF) (row column : ℕ) + (value : GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula)) : + (((List.range + (physicalShiftedInterpolationNodeCount row formula)).map + (fun node => + if node = + (column / + physFieldCard formula) % + physGridCard formula + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + (3 : Fin 4) row formula + (physicalShiftedInterpolationNodeCount + row formula) + (physicalShiftedInterpolationNodeCount_le_grid + formula row) + value node) + else 0)).sum) = + if selected : + (column / + physFieldCard formula) % + physGridCard formula < + physicalShiftedInterpolationNodeCount + row formula + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeWeightSourceWord + (3 : Fin 4) row formula + (physicalShiftedInterpolationNodeCount + row formula) + (physicalShiftedInterpolationNodeCount_le_grid + formula row) + ⟨(column / + physFieldCard formula) % + physGridCard formula, + selected⟩ value) + else 0 := by + rw [paperVariableArityPhysicalShiftedMaskedNodeSum_eq_selected] + split_ifs with selected + · simp only [physicalInterpolationNodeSourceWord, + dite_eq_left selected] + · rfl + +end PhysicalShiftedInterpolationParityFieldCorrectness + +namespace PhysicalShiftedInterpolationRowSourceProjection + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.FormulaBridge +open GapCVP.SourceOrder GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalRefinementRowProjection GapCVP.PhysicalRowOrderProjection +open GapCVP.PhysicalInterpolationRowFamilyProjection + +private theorem paperVariableArityPhysicalShiftedSourceInterpolationBlockWidth_pos + (formula : ThreeCNF) : + 0 < physicalInterpolationBlockWidth formula := + Nat.mul_pos + (physicalRefinementGridCard_pos formula) + (physicalRefinementDegree_pos formula) + +private def physicalShiftedSourceRowFamilyCoordinate + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + Fin (physicalShiftedInterpolationTagCount formula) := by + refine + ⟨(row.val - physicalFormulaOrdinaryBoundary formula) / + physicalInterpolationBlockWidth formula, ?_⟩ + apply (Nat.div_lt_iff_lt_mul + (paperVariableArityPhysicalShiftedSourceInterpolationBlockWidth_pos + formula)).mpr + have actualUpper : + row.val < physicalFormulaOrdinaryBoundary formula + + physicalShiftedInterpolationTagCount formula * + physicalInterpolationBlockWidth formula := by + calc + row.val < paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula := row.isLt + _ = physicalFormulaOrdinaryBoundary formula + + physicalShiftedInterpolationTagCount formula * + physicalInterpolationBlockWidth formula := + paperVariableArityPhysicalInterpolationRowCount_eq formula + omega + +private theorem paperVariableArityPhysicalShiftedSourceRowDecodedFamilyIndex + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row = + physicalShiftedDependentFamilyIndex formula + (physicalShiftedSourceRowFamilyCoordinate + formula row inShifted) := by + apply (paperVariableArityPhysicalSigmaFamilyIndex_eq_iff + (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula) row _).mpr + rw [paperVariableArityPhysicalShiftedDependentFamilyPrefix, + paperVariableArityPhysicalShiftedDependentFamilyBlockCount] + let width := physicalInterpolationBlockWidth formula + let offset := row.val - physicalFormulaOrdinaryBoundary formula + have positive : 0 < width := + paperVariableArityPhysicalShiftedSourceInterpolationBlockWidth_pos formula + have lower := Nat.div_mul_le_self offset width + have upper := Nat.lt_div_mul_add positive (a := offset) + have restore : offset + physicalFormulaOrdinaryBoundary formula = row.val := + Nat.sub_add_cancel inShifted + change physicalFormulaOrdinaryBoundary formula + + (offset / width) * width ≤ row.val ∧ + row.val < physicalFormulaOrdinaryBoundary formula + + (offset / width) * width + width + omega + +private def physicalShiftedSourceRowClauseTupleVariableMoment + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + (Σ clause : Fin (srcFormula formula).clauses.length, + Σ _tuple : + ((srcFormula formula).clauses.get clause).SatisfyingLocalTuple, + ((srcFormula formula).clauses.get clause).LocalVariable × + Fin (physicalInterpolationMomentBudget formula + 1)) := + paperShiftedFamilyWordOrder formula + (physicalInterpolationMomentBudget formula) + (physicalShiftedSourceRowFamilyCoordinate + formula row inShifted) + +private theorem paperVariableArityPhysicalShiftedSourceRowDecodedFamily + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 = + .inr (.inr (.inr + (physicalShiftedSourceRowClauseTupleVariableMoment + formula row inShifted))) := by + rw [physicalRowOrder_family] + rw [paperVariableArityPhysicalShiftedSourceRowDecodedFamilyIndex + formula row inShifted] + rw [paperVariableArityPhysicalShiftedDependentFamilyWordOrder] + rfl + +private def physicalShiftedSourceRowGrid + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + Fin (Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula))) := by + let decoded := physicalWordDecodedRow + (encodeThreeCNF formula).length formula row + refine ⟨decoded.2.1.val, ?_⟩ + have bounded := decoded.2.1.isLt + have family := paperVariableArityPhysicalShiftedSourceRowDecodedFamily + formula row inShifted + change decoded.1 = _ at family + have rowCount : + explicitFamilyRowCount + (encodeThreeCNF formula).length + (srcFormula formula) decoded.1 = + Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)) := by + rw [family] + exact lt_of_lt_of_eq bounded rowCount + +end PhysicalShiftedInterpolationRowSourceProjection + +namespace PhysicalShiftedInterpolationParityMaskedFieldCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryReedSolomonParity +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.FormulaBridge GapCVP.SourceOrder +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalInterpolationNodeCountBounds GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryShiftedCheckBitInstantiation +open GapCVP.PhysicalShiftedRowTupleRankBounds +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation +open GapCVP.PhysicalShiftedInterpolationBaseTM +open GapCVP.PhysicalShiftedInterpolationParityFieldCorrectness +open GapCVP.SourceFieldMomentOperationsTM + +private noncomputable def physicalShiftedFiniteRowCanonicalBaseSourceWord + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + GapCVP.Core.EffectiveBinaryField.Word + (physDegree formula) := + physicalShiftedCanonicalInterpolationBaseSourceWord + formula row.val column.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) + +private theorem paperVariableArityPhysicalShiftedFiniteRowParity_eq_maskedSourceCorrection + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + constructiveParityMatrix + (physicalShiftedSourceGridPoints formula) + (physicalShiftedSourceInterpolationDegree_lt_grid + formula row.val) + (physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula) + (physicalShiftedColumnGridIndex + formula column.val) * + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) ^ + physicalFamilyRowMoment + (3 : Fin 4) row.val formula = + (if physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula = + physicalShiftedColumnGridIndex + formula column.val + then sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) ^ + physicalFamilyRowMoment + (3 : Fin 4) row.val formula + else 0) - + (((List.range + (physicalShiftedInterpolationNodeCount + row.val formula)).map + (fun node => + if node = + (column.val / + physFieldCard formula) % + physGridCard formula + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + (3 : Fin 4) row.val formula + (physicalShiftedInterpolationNodeCount + row.val formula) + (physicalShiftedInterpolationNodeCount_le_grid + formula row.val) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) + node) + else 0)).sum) := by + rw [paperVariableArityPhysicalShiftedMaskedSourceNodeWeightSum_eq_selected] + have parity := + paperVariableArityPhysicalShiftedLagrangeParity_mul_eq_selectedNodeWeight + formula row.val + (physicalShiftedColumnGridIndex + formula column.val) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) + have nodeCount := + paperVariableArityPhysicalShiftedInterpolationNodeCount_eq_sourceDegree + formula row.val + cases nodeCount + exact parity + +end PhysicalShiftedInterpolationParityMaskedFieldCorrectness + +namespace PhysicalShiftedInterpolationRowFieldCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryReedSolomonParity +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.MatrixEntrySemantics +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalRowOrderProjection +open GapCVP.PhysicalInterpolationRowFamilyProjection +open GapCVP.PhysicalSelectedInterpolationCoefficientProjection +open GapCVP.PhysicalShiftedInterpolationRowSourceProjection + +private def physicalShiftedSourceRowClause + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + Fin (srcFormula formula).clauses.length := + (physicalShiftedSourceRowClauseTupleVariableMoment + formula row inShifted).1 + +private def physicalShiftedSourceRowTuple + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + ((srcFormula formula).clauses.get + (physicalShiftedSourceRowClause + formula row inShifted)).SatisfyingLocalTuple := + (physicalShiftedSourceRowClauseTupleVariableMoment + formula row inShifted).2.1 + +private def physicalShiftedSourceRowLocalVariable + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + ((srcFormula formula).clauses.get + (physicalShiftedSourceRowClause + formula row inShifted)).LocalVariable := + (physicalShiftedSourceRowClauseTupleVariableMoment + formula row inShifted).2.2.1 + +private def physicalShiftedSourceRowMoment + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + Fin (physicalInterpolationMomentBudget formula + 1) := + (physicalShiftedSourceRowClauseTupleVariableMoment + formula row inShifted).2.2.2 + +private theorem paperVariableArityPhysicalShiftedSourceRowDecodedFamily_components + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 = + .inr (.inr (.inr + ⟨physicalShiftedSourceRowClause + formula row inShifted, + physicalShiftedSourceRowTuple + formula row inShifted, + physicalShiftedSourceRowLocalVariable + formula row inShifted, + physicalShiftedSourceRowMoment + formula row inShifted⟩)) := by + exact paperVariableArityPhysicalShiftedSourceRowDecodedFamily + formula row inShifted + +private theorem paperVariableArityPhysicalShiftedSourceRowDependentBlockRank + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val = + (row.val - physicalFormulaOrdinaryBoundary formula) % + physicalInterpolationBlockWidth formula := by + have rank := physicalRowDependentRank_eq_prefix + (encodeThreeCNF formula).length formula row + change row.val = physicalSigmaPrefix _ + (physicalRowDependentFamilyIndex + (encodeThreeCNF formula).length formula row) + + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val at rank + have prefixEquality := congrArg + (physicalSigmaPrefix (paperExplicitBinaryFamilyBlockCount + (encodeThreeCNF formula).length formula)) + (paperVariableArityPhysicalShiftedSourceRowDecodedFamilyIndex formula row inShifted) + rw [paperVariableArityPhysicalShiftedDependentFamilyPrefix] at prefixEquality + rw [prefixEquality] at rank + let width := physicalInterpolationBlockWidth formula + let offset := row.val - physicalFormulaOrdinaryBoundary formula + change row.val = physicalFormulaOrdinaryBoundary formula + + (offset / width) * width + + (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val at rank + have decomposition := Nat.mod_add_div' offset width + have restore : offset + physicalFormulaOrdinaryBoundary formula = row.val := + Nat.sub_add_cancel inShifted + change (physicalRowDependentBlockRank + (encodeThreeCNF formula).length formula row).val = offset % width + omega + +private theorem paperVariableArityPhysicalShiftedSourceRowGrid_val + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + (physicalShiftedSourceRowGrid + formula row inShifted).val = + ((row.val - physicalFormulaOrdinaryBoundary formula) / + physDegree formula) % + physGridCard formula := by + change + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.1.val = _ + rw [physicalRowOrder_fieldRow, + paperVariableArityPhysicalShiftedSourceRowDependentBlockRank + formula row inShifted] + change + ((row.val - physicalFormulaOrdinaryBoundary formula) % + (physGridCard formula * + physDegree formula)) / + physDegree formula = _ + exact Nat.mod_mul_left_div_self + (row.val - physicalFormulaOrdinaryBoundary formula) + (physDegree formula) + (physGridCard formula) + +private theorem paperVariableArityPhysicalShiftedSourceRowBasis_val + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) : + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.2.val = + row.val % physDegree formula := by + exact physicalRowOrder_basis_val + (encodeThreeCNF formula).length formula row + +private theorem paperVariableArityPhysicalShiftedSourceRowFieldCoefficient_eq_selected + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + physicalWordFamilyFieldCoefficient + (encodeThreeCNF formula).length formula + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).1 + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.1 + column = + if (Sum.inr + ⟨physicalShiftedSourceRowClause + formula row inShifted, + physicalShiftedSourceRowTuple + formula row inShifted⟩ : + sourceSATTableType (srcFormula formula)) = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 + then + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val) + (explicitShiftedDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedSourceRowMoment + formula row inShifted)) + (physicalShiftedSourceRowGrid + formula row inShifted) + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1) * + (((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 - + sourceSATFieldBit + (K := PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula) + ((physicalShiftedSourceRowTuple + formula row inShifted).val + (physicalShiftedSourceRowLocalVariable + formula row inShifted))) / + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1.val - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedSourceRowLocalVariable + formula row inShifted).val)) ^ + (physicalShiftedSourceRowMoment + formula row inShifted).val + else 0 := by + let clause := physicalShiftedSourceRowClause + formula row inShifted + let tuple := physicalShiftedSourceRowTuple + formula row inShifted + let omitted := physicalShiftedSourceRowLocalVariable + formula row inShifted + let moment := physicalShiftedSourceRowMoment + formula row inShifted + let grid := physicalShiftedSourceRowGrid + formula row inShifted + have family := paperVariableArityPhysicalShiftedSourceRowDecodedFamily_components + formula row inShifted + have selected := + paperVariableArityPhysicalWordShiftedFieldCoefficient_eq_selectedCoordinate + (encodeThreeCNF formula).length formula + clause tuple omitted moment grid column + generalize decodedEquality : + physicalWordDecodedRow + (encodeThreeCNF formula).length formula row = decoded + at family ⊢ + rcases decoded with ⟨decodedFamily, decodedRow, decodedBasis⟩ + have exactFamily : decodedFamily = + .inr (.inr (.inr ⟨clause, tuple, omitted, moment⟩)) := family + subst decodedFamily + have exactGrid : decodedRow = grid := by + apply Fin.ext + change decodedRow.val = grid.val + change decodedRow.val = + (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.1.val + exact (congrArg (fun value => value.2.1.val) + decodedEquality).symm + subst decodedRow + exact selected + +end PhysicalShiftedInterpolationRowFieldCorrectness + +namespace PhysicalShiftedInterpolationRowDigitCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.PhysicalFamilyRowTM +open GapCVP.SourceFieldMomentOperationsTM GapCVP.PhysicalLagrangeNodeProductAlgebra +open GapCVP.PhysicalInterpolationNodeFactorTM GapCVP.PhysicalInterpolationNodeCountBounds +open GapCVP.PhysicalInterpolationRowFamilyProjection +open GapCVP.PhysicalShiftedInterpolationRowSourceProjection +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness + +private theorem paperVariableArityPhysicalShiftedSourceRowGrid_val_eq_family + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + (physicalShiftedSourceRowGrid + formula row inShifted).val = + (physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula).val := by + rw [paperVariableArityPhysicalShiftedSourceRowGrid_val + formula row inShifted] + change + ((row.val - physicalFormulaOrdinaryBoundary formula) / + physDegree formula) % + physGridCard formula = + ((row.val - physicalFamilyStart (3 : Fin 4) formula) / + physDegree formula) % + physGridCard formula + simp only [physicalFamilyStart, Fin.isValue, Fin.coe_ofNat_eq_mod, Nat.mod_succ, + OfNat.ofNat_ne_zero, + ↓reduceIte, OfNat.ofNat_ne_one, OfNat.ofNat_eq_ofNat, Nat.succ_ne_self] + +private def paperVariableArityPhysicalShiftedSourceRowNodeGrid + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + PaperVariableArityPhysicalLagrangeNodeGridIndex formula := by + refine ⟨(physicalShiftedSourceRowGrid + formula row inShifted).val, ?_⟩ + have bounded := (physicalShiftedSourceRowGrid + formula row inShifted).isLt + exact lt_of_lt_of_eq bounded + (physicalInterpolationExplicitGridCardinality_eq + formula) + +private theorem paperVariableArityPhysicalShiftedSourceRowNodeGrid_eq_family + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + paperVariableArityPhysicalShiftedSourceRowNodeGrid + formula row inShifted = + physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula := by + apply Fin.ext + exact paperVariableArityPhysicalShiftedSourceRowGrid_val_eq_family + formula row inShifted + +private theorem paperVariableArityPhysicalShiftedClauseWordMoment_val + (formula : ThreeCNF) (budget : ℕ) + (clause : Fin (srcFormula formula).clauses.length) + (tag : Fin (paperShiftedClauseTagCount + formula budget clause)) : + ((paperShiftedClauseWordOrder + formula budget clause tag).2.2).val = tag.val % (budget + 1) := by + change + (tag.val % + (paperFormulaClauseWidth formula clause * (budget + 1))) % + (budget + 1) = tag.val % (budget + 1) + exact Nat.mod_mod_of_dvd tag.val + (dvd_mul_left (budget + 1) + (paperFormulaClauseWidth formula clause)) + +private theorem paperVariableArityPhysicalShiftedClauseTagCount_moment_dvd + (formula : ThreeCNF) (budget : ℕ) + (clause : Fin (srcFormula formula).clauses.length) : + budget + 1 ∣ paperShiftedClauseTagCount + formula budget clause := by + refine ⟨(2 ^ paperFormulaClauseWidth formula clause - 1) * + paperFormulaClauseWidth formula clause, ?_⟩ + unfold paperShiftedClauseTagCount + ring + +private theorem paperVariableArityPhysicalShiftedSourceRowMoment_val + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + (physicalShiftedSourceRowMoment + formula row inShifted).val = + (((row.val - physicalFormulaOrdinaryBoundary formula) / + physDegree formula) / + physGridCard formula) % + physicalFormulaMomentCount formula := by + let budget := physicalInterpolationMomentBudget formula + let tag := physicalShiftedSourceRowFamilyCoordinate + formula row inShifted + let decoded : + (clause : Fin (srcFormula formula).clauses.length) × + Fin (paperShiftedClauseTagCount + formula budget clause) := finSigmaFinEquiv.symm tag + have rank : + tag.val = + (∑ index : Fin decoded.1.val, + paperShiftedClauseTagCount formula budget + (Fin.castLE decoded.1.isLt.le index)) + decoded.2.val := by + have actual := finSigmaFinEquiv_apply decoded + change + (finSigmaFinEquiv decoded).val = + (∑ index : Fin decoded.1.val, + paperShiftedClauseTagCount formula budget + (Fin.castLE decoded.1.isLt.le index)) + decoded.2.val at actual + rw [show finSigmaFinEquiv decoded = tag from + Equiv.apply_symm_apply _ tag] at actual + exact actual + have divisible : + budget + 1 ∣ + ∑ index : Fin decoded.1.val, + paperShiftedClauseTagCount formula budget + (Fin.castLE decoded.1.isLt.le index) := by + apply Finset.dvd_sum + intro index _ + exact paperVariableArityPhysicalShiftedClauseTagCount_moment_dvd + formula budget (Fin.castLE decoded.1.isLt.le index) + have sameMoment : + decoded.2.val % (budget + 1) = tag.val % (budget + 1) := by + rw [rank, Nat.add_mod, + Nat.mod_eq_zero_of_dvd divisible, Nat.zero_add, Nat.mod_mod] + change + ((paperShiftedClauseWordOrder formula budget + decoded.1 decoded.2).2.2).val = _ + rw [paperVariableArityPhysicalShiftedClauseWordMoment_val, + sameMoment] + change + ((row.val - physicalFormulaOrdinaryBoundary formula) / + (physGridCard formula * + physDegree formula)) % + physicalFormulaMomentCount formula = _ + congr 1 + rw [Nat.div_div_eq_div_mul, Nat.mul_comm] + +private theorem paperVariableArityPhysicalShiftedSourceRowMoment_eq_family + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + (physicalShiftedSourceRowMoment + formula row inShifted).val = + physicalFamilyRowMoment + (3 : Fin 4) row.val formula := by + rw [paperVariableArityPhysicalShiftedSourceRowMoment_val + formula row inShifted] + unfold physicalFamilyRowMoment + simp only [physicalFamilyStart, Fin.isValue, Fin.coe_ofNat_eq_mod, Nat.mod_succ, + OfNat.ofNat_ne_zero, + ↓reduceIte, OfNat.ofNat_ne_one, OfNat.ofNat_eq_ofNat, Nat.succ_ne_self] + +end PhysicalShiftedInterpolationRowDigitCorrectness + +namespace PhysicalShiftedInterpolationBinaryCheckBitCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryFieldInverseAlgebra GapCVP.FormulaBridge +open GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationNodeCountBounds GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryShiftedCheckBitInstantiation +open GapCVP.PhysicalShiftedInterpolationBaseTM +open GapCVP.PhysicalShiftedInterpolationParityMaskedFieldCorrectness +open GapCVP.SourceFieldMomentOperationsTM GapCVP.SourceOrder + +private noncomputable def paperVariableArityPhysicalShiftedActualSourceCorrectionField + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula := + (((List.range + (physicalShiftedInterpolationNodeCount + row.val formula)).map (fun node => + if node = + (column.val / + physFieldCard formula) % + physGridCard formula + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + (3 : Fin 4) row.val formula + (physicalShiftedInterpolationNodeCount + row.val formula) + (physicalShiftedInterpolationNodeCount_le_grid + formula row.val) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) node) + else 0)).sum) + +private theorem paperVariableArityPhysicalShiftedActualSourceGridMatch_iff + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula = + physicalShiftedColumnGridIndex + formula column.val ↔ + (((row.val - physicalFamilyStart + (3 : Fin 4) formula) / + physDegree formula) % + physGridCard formula = + (column.val / + physFieldCard formula) % + physGridCard formula) := by + constructor + · intro matching + exact congrArg Fin.val matching + · intro matching + exact Fin.ext matching + +private theorem paperVariableArityPhysicalShiftedActualDirectMomentBasis_decide + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (if physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula = + physicalShiftedColumnGridIndex + formula column.val + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) ^ + physicalFamilyRowMoment + (3 : Fin 4) row.val formula + else 0) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2)) = + (decide + ((((row.val - physicalFamilyStart + (3 : Fin 4) formula) / + physDegree formula) % + physGridCard formula) = + (column.val / + physFieldCard formula) % + physGridCard formula) && + (sourceWordPow + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) + (physicalFamilyRowMoment + (3 : Fin 4) row.val formula)) + (physicalInterpolationRowBasisIndex + row.val formula)) := by + classical + let sourceWord := physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted + let sourceMoment := physicalFamilyRowMoment + (3 : Fin 4) row.val formula + let sourceIndex := physicalInterpolationRowBasisIndex + row.val formula + by_cases matching : + physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula = + physicalShiftedColumnGridIndex + formula column.val + · have physical := + (paperVariableArityPhysicalShiftedActualSourceGridMatch_iff + formula row column).mp matching + have coordinate := paperVariableArityPhysicalSourceWordBasisCoordinate_decide + formula (sourceWordPow sourceWord sourceMoment) sourceIndex + rw [sourceWordValue_sourceWordPow] at coordinate + rw [ite_eq_left matching] + simp only [physical, decide_true, Bool.true_and] + exact coordinate + · have physical : ¬ + (((row.val - physicalFamilyStart + (3 : Fin 4) formula) / + physDegree formula) % + physGridCard formula = + (column.val / + physFieldCard formula) % + physGridCard formula) := by + intro equal + exact matching + ((paperVariableArityPhysicalShiftedActualSourceGridMatch_iff + formula row column).mpr equal) + rw [ite_eq_right matching] + simp only [map_zero, Pi.zero_apply, zero_ne_one, decide_false, Fin.isValue, physical, + Bool.false_and] + +end PhysicalShiftedInterpolationBinaryCheckBitCorrectness + +open GapCVP.PhysicalShiftedInterpolationBinaryCheckBitCorrectness + +namespace PhysicalShiftedInterpolationParityDecodedFieldCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryFieldInverseAlgebra +open GapCVP.BinaryReedSolomonParity GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationNodeCountBounds GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryShiftedCheckBitInstantiation +open GapCVP.PhysicalOrdinaryInterpolationParityFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationRowSourceProjection +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationRowDigitCorrectness +open GapCVP.PhysicalShiftedSourceColumnGridProjection +open GapCVP.PhysicalShiftedInterpolationParityFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationParityMaskedFieldCorrectness +open GapCVP.SourceFieldMomentOperationsTM + +private theorem paperVariableArityPhysicalShiftedExplicitGridParity_eq_sourceGridParity + (formula : ThreeCNF) (degree : ℕ) + (bounded : degree < Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula))) + (row position : Fin (Fintype.card + (ExplicitGridPoint (encodeThreeCNF formula).length + (srcFormula formula)))) : + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val) + bounded row position = + constructiveParityMatrix + (physicalShiftedSourceGridPoints formula) + (lt_of_lt_of_eq bounded + (physicalInterpolationExplicitGridCardinality_eq + formula)) + (Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) row) + (Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) position) := by + classical + rw [paperVariableArityPhysicalShiftedOrderedLagrangeParity_eq_selectedCorrection, + paperVariableArityPhysicalShiftedOrderedLagrangeParity_eq_selectedCorrection] + have sameRow : + (Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) row = + Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) position) ↔ row = position := by + constructor + · intro equal + apply Fin.ext + exact congrArg (fun value => value.val) equal + · intro equal + rw [equal] + simp only [sameRow] + by_cases selected : position.val < degree + 1 + · simp only [dite_eq_left selected] + have selectedCast : + (Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) position).val < degree + 1 := by + exact selected + simp only [dite_eq_left selectedCast] + simp_rw [paperVariableArityPhysicalExplicitGridOrder_value_eq_evaluation] + simp only [physicalShiftedSourceGridPoints] + have nodeCast (node : Fin (degree + 1)) : + Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) + (Fin.castLE (Nat.succ_le_of_lt bounded) node) = + Fin.castLE + (Nat.succ_le_of_lt + (lt_of_lt_of_eq bounded + (physicalInterpolationExplicitGridCardinality_eq + formula))) node := by + apply Fin.ext + rfl + have sameNode : + (⟨position.val, selected⟩ : Fin (degree + 1)) = + (⟨(Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) position).val, selectedCast⟩ : Fin (degree + 1)) := by + apply Fin.ext + rfl + rw [← sameNode] + simp_rw [nodeCast] + · simp only [selected, ↓reduceDIte, sub_zero, Fin.val_cast] + +private theorem paperVariableArityPhysicalShiftedDecodedRowParity_eq_maskedSourceCorrection + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (sourceFormulaDimension (encodeThreeCNF formula).length + (srcFormula formula))) + (inShifted : physicalFormulaOrdinaryBoundary formula ≤ + row.val) : + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val) + (explicitShiftedDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedSourceRowMoment + formula row inShifted)) + (physicalShiftedSourceRowGrid + formula row inShifted) + ((sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1)) * + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) ^ + (physicalShiftedSourceRowMoment + formula row inShifted).val = + (if physicalShiftedSourceRowGrid + formula row inShifted = + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1) + then sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) ^ + (physicalShiftedSourceRowMoment + formula row inShifted).val + else 0) - + (((List.range + (physicalShiftedInterpolationNodeCount + row.val formula)).map + (fun node => + if node = + (column.val / + physFieldCard formula) % + physGridCard formula + then + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalInterpolationNodeSourceWord + (3 : Fin 4) row.val formula + (physicalShiftedInterpolationNodeCount + row.val formula) + (physicalShiftedInterpolationNodeCount_le_grid + formula row.val) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) + node) + else 0)).sum) := by + let point := (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula)).symm + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1) + let degree := ((srcFormula formula).variableCount - 1) * + (physicalShiftedSourceRowMoment + formula row inShifted).val + have correctMoment := paperVariableArityPhysicalShiftedSourceRowMoment_eq_family + formula row inShifted + have correctColumn := + physicalSourceColumnExplicitGridPosition_val + formula column + have rowCast : + Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) + (physicalShiftedSourceRowGrid + formula row inShifted) = + physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula := + paperVariableArityPhysicalShiftedSourceRowNodeGrid_eq_family + formula row inShifted + have pointCast : + Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula) point = + GapCVP.PhysicalShiftedInterpolationBaseTM.physicalShiftedColumnGridIndex + formula column.val := by + apply Fin.ext + exact correctColumn + have parityTransport : + constructiveParityMatrix + (fun index => + (sourceFormulaExplicitGridOrder + (encodeThreeCNF formula).length + (srcFormula formula) index).val) + (explicitShiftedDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedSourceRowMoment + formula row inShifted)) + (physicalShiftedSourceRowGrid + formula row inShifted) point = + constructiveParityMatrix + (physicalShiftedSourceGridPoints formula) + (physicalShiftedSourceInterpolationDegree_lt_grid + formula row.val) + (physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula) + (GapCVP.PhysicalShiftedInterpolationBaseTM.physicalShiftedColumnGridIndex + formula column.val) := by + have transported := + paperVariableArityPhysicalShiftedExplicitGridParity_eq_sourceGridParity + formula degree + (explicitShiftedDegree_lt_grid + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedSourceRowMoment + formula row inShifted)) + (physicalShiftedSourceRowGrid + formula row inShifted) point + rw [rowCast, pointCast] at transported + simpa only [degree, correctMoment] using transported + have sameDirect : + (physicalShiftedSourceRowGrid + formula row inShifted = point) ↔ + (physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula = + GapCVP.PhysicalShiftedInterpolationBaseTM.physicalShiftedColumnGridIndex + formula column.val) := by + constructor + · intro equal + exact rowCast.symm.trans + ((congrArg + (Fin.cast + (physicalInterpolationExplicitGridCardinality_eq + formula)) equal).trans pointCast) + · intro equal + apply Fin.ext + have castEquality := rowCast.trans (equal.trans pointCast.symm) + exact congrArg (fun value => value.val) castEquality + have directEquality : + (if physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula = + GapCVP.PhysicalShiftedInterpolationBaseTM.physicalShiftedColumnGridIndex + formula column.val + then sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) ^ + physicalFamilyRowMoment + (3 : Fin 4) row.val formula + else 0) = + (if physicalShiftedSourceRowGrid + formula row inShifted = point + then sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) ^ + (physicalShiftedSourceRowMoment + formula row inShifted).val + else 0) := by + rw [correctMoment] + simp only [sameDirect] + calc + _ = constructiveParityMatrix + (physicalShiftedSourceGridPoints formula) + (physicalShiftedSourceInterpolationDegree_lt_grid + formula row.val) + (physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula) + (GapCVP.PhysicalShiftedInterpolationBaseTM.physicalShiftedColumnGridIndex + formula column.val) * + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) ^ + physicalFamilyRowMoment + (3 : Fin 4) row.val formula := by + rw [parityTransport, correctMoment] + _ = _ := by + rw [paperVariableArityPhysicalShiftedFiniteRowParity_eq_maskedSourceCorrection + formula row column inShifted, directEquality] + +end PhysicalShiftedInterpolationParityDecodedFieldCorrectness + +namespace PhysicalShiftedInterpolationRowCanonicalRankCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge GapCVP.ClauseOffsetTM +open GapCVP.ShiftedTupleTM GapCVP.CanonicalOffsetIdentity GapCVP.SourceClausePrefixBridge +open GapCVP.SourceOrder GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalColumnOrderProjection GapCVP.PhysicalInterpolationRowFamilyProjection +open GapCVP.PhysicalRefinementColumnTagSourceCorrectness GapCVP.PhysicalShiftedRowTupleRankTM +open GapCVP.PhysicalShiftedRowTupleRankBounds GapCVP.PhysicalShiftedExpectedTypeRankTM +open GapCVP.PhysicalShiftedInterpolationRowSourceProjection +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness + +private theorem paperVariableArityPhysicalShiftedRowClausePrefix_mono + (formula : ThreeCNF) (first second : ℕ) + (ordered : first ≤ second) : + physicalShiftedRowClausePrefix formula first ≤ + physicalShiftedRowClausePrefix formula second := by + obtain ⟨gap, rfl⟩ := Nat.exists_eq_add_of_le ordered + unfold physicalShiftedRowClausePrefix + paperShiftedSourceClauseWeightSum + rw [List.take_add, List.map_append, List.sum_append] + omega + +private theorem paperVariableArityPhysicalShiftedRowClausePrefix_succ + (formula : ThreeCNF) (rank : ℕ) + (bounded : rank < (noTautClauses formula).length) : + physicalShiftedRowClausePrefix formula (rank + 1) = + physicalShiftedRowClausePrefix formula rank + + paperShiftedSourceClauseWeight + ((noTautClauses formula).get + ⟨rank, bounded⟩) := by + unfold physicalShiftedRowClausePrefix + paperShiftedSourceClauseWeightSum + simp only [List.map_take] + have mappedBound : + rank < + ((noTautClauses formula).map + paperShiftedSourceClauseWeight).length := by + simpa only [List.length_map] using bounded + rw [← List.take_concat_get mappedBound] + simp only [List.getElem_map, List.concat_eq_append, List.sum_append, List.sum_cons, List.sum_nil, + add_zero, + List.get_eq_getElem] + +private theorem paperVariableArityPhysicalShiftedRangeFilter_le_length + (count index : ℕ) (bounded : index < count) : + ((List.range count).filter + (fun rank => decide (rank ≤ index))).length = index + 1 := by + rw [← List.Ico.zero_bot count] + simp_rw [← Nat.lt_succ_iff] + rw [List.Ico.filter_lt] + simp only [Nat.succ_eq_add_one, Nat.min_eq_right (Nat.succ_le_of_lt bounded), List.Ico.length, + tsub_zero] + +private theorem paperVariableArityPhysicalShiftedRowClauseRank_eq_of_interval + (formula : ThreeCNF) (row : ℕ) + (clause : Fin (noTautClauses formula).length) + (lower : physicalShiftedRowClausePrefix + formula clause.val ≤ physicalShiftedRowMixedTag + formula row) + (upper : physicalShiftedRowMixedTag formula row < + physicalShiftedRowClausePrefix + formula (clause.val + 1)) : + physicalShiftedRowClauseRank formula row = clause.val := by + have same (rank : ℕ) + (_membership : rank ∈ + List.range (noTautClauses formula).length) : + decide + (physicalShiftedRowClausePrefix formula rank ≤ + physicalShiftedRowMixedTag formula row) = + decide (rank ≤ clause.val) := by + apply Bool.decide_congr + constructor + · intro accepted + by_contra after + have ordered : clause.val + 1 ≤ rank := by omega + have later := paperVariableArityPhysicalShiftedRowClausePrefix_mono + formula (clause.val + 1) rank ordered + omega + · intro before + have earlier := paperVariableArityPhysicalShiftedRowClausePrefix_mono + formula rank clause.val before + omega + have filtered := List.filter_congr same + have actual := paperVariableArityPhysicalShiftedRangeFilter_le_length + (noTautClauses formula).length + clause.val clause.isLt + unfold physicalShiftedRowClauseRank + physicalShiftedRowAcceptedPrefixCount + rw [filtered, actual] + omega + +private theorem paperVariableArityPhysicalShiftedFiniteClauseWeight_eq + (formula : ThreeCNF) + (index : Fin (srcFormula formula).clauses.length) : + paperFormulaClauseWidth formula index * + (2 ^ paperFormulaClauseWidth formula index - 1) = + paperShiftedSourceClauseWeight + ((noTautClauses formula).get + (Fin.cast + (paperVariableAritySourceFormula_clauses_length formula) + index)) := by + let retainedIndex : Fin + (noTautClauses formula).length := + Fin.cast + (paperVariableAritySourceFormula_clauses_length formula) + index + have sameIndex : + paperRetainedOriginalClauseIndexOrder + formula retainedIndex = index := by + apply Fin.ext + rfl + have sameWidth := paperFormulaClauseWidth_retainedOriginal + formula retainedIndex + rw [sameIndex] at sameWidth + rw [sameWidth] + rfl + +private theorem paperVariableArityPhysicalShiftedIndexedClausePrefix_eq_weightSum + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) : + (∑ index : Fin clause.val, + paperShiftedSourceClauseWeight + ((noTautClauses formula).get + (sourceRetainedPrefixIndex + formula clause index))) = + paperShiftedSourceClauseWeightSum + ((noTautClauses formula).take clause.val) := by + let retained := noTautClauses formula + have retainedBound : clause.val ≤ retained.length := by + have strict : clause.val < retained.length := by + simpa only [srcFormula, + GapCVP.SourcePreprocessingSemantics.paperSourceNormalizedClauses, + List.length_map, List.length_attach, retained] using clause.isLt + exact strict.le + have takeLength : (retained.take clause.val).length = clause.val := by + simp only [List.length_take, Nat.min_eq_left retainedBound] + let order : Fin (retained.take clause.val).length ≃ Fin clause.val := + finCongr takeLength + let weight : Fin clause.val → ℕ := fun index => + paperShiftedSourceClauseWeight + (retained.get + (sourceRetainedPrefixIndex + formula clause index)) + change (∑ index : Fin clause.val, weight index) = _ + calc + (∑ index : Fin clause.val, weight index) = + ∑ index : Fin (retained.take clause.val).length, + weight (order index) := by + symm + exact order.sum_comp weight + _ = ∑ index : Fin (retained.take clause.val).length, + paperShiftedSourceClauseWeight + ((retained.take clause.val).get index) := by + apply Finset.sum_congr rfl + intro index _ + have sameClause : + retained.get + (sourceRetainedPrefixIndex + formula clause (order index)) = + (retained.take clause.val).get index := by + simp only [List.get_eq_getElem, List.getElem_take] + rfl + exact congrArg paperShiftedSourceClauseWeight sameClause + _ = paperShiftedSourceClauseWeightSum + (retained.take clause.val) := by + symm + exact sourceListWeightSum + (retained.take clause.val) + paperShiftedSourceClauseWeight + +private theorem paperVariableArityPhysicalShiftedDependentClausePrefix_eq_weightSum + (formula : ThreeCNF) (budget : ℕ) + (clause : Fin (srcFormula formula).clauses.length) : + (∑ index : Fin clause.val, + paperShiftedClauseTagCount formula budget + (Fin.castLE clause.isLt.le index)) = + physicalShiftedRowClausePrefix formula clause.val * + (budget + 1) := by + unfold paperShiftedClauseTagCount + calc + (∑ index : Fin clause.val, + (2 ^ paperFormulaClauseWidth formula + (Fin.castLE clause.isLt.le index) - 1) * + (paperFormulaClauseWidth formula + (Fin.castLE clause.isLt.le index) * (budget + 1))) = + ∑ index : Fin clause.val, + (paperFormulaClauseWidth formula + (Fin.castLE clause.isLt.le index) * + (2 ^ paperFormulaClauseWidth formula + (Fin.castLE clause.isLt.le index) - 1)) * (budget + 1) := by + apply Finset.sum_congr rfl + intro index _ + ring + _ = + (∑ index : Fin clause.val, + paperFormulaClauseWidth formula + (Fin.castLE clause.isLt.le index) * + (2 ^ paperFormulaClauseWidth formula + (Fin.castLE clause.isLt.le index) - 1)) * (budget + 1) := by + rw [Finset.sum_mul] + _ = + (∑ index : Fin clause.val, + paperShiftedSourceClauseWeight + ((noTautClauses formula).get + (sourceRetainedPrefixIndex + formula clause index))) * (budget + 1) := by + congr 1 + apply Finset.sum_congr rfl + intro index _ + exact paperVariableArityPhysicalShiftedFiniteClauseWeight_eq + formula (Fin.castLE clause.isLt.le index) + _ = physicalShiftedRowClausePrefix + formula clause.val * (budget + 1) := by + rw [paperVariableArityPhysicalShiftedIndexedClausePrefix_eq_weightSum + formula clause] + rfl + +private theorem paperVariableArityPhysicalShiftedClauseTupleWordRank + (formula : ThreeCNF) (budget : ℕ) + (clause : Fin (srcFormula formula).clauses.length) + (word : Fin (paperShiftedClauseTagCount + formula budget clause)) : + ((paperFormulaClauseTupleWordOrder formula clause).symm + ((paperShiftedClauseWordOrder + formula budget clause word).1)).val = + word.val / + (paperFormulaClauseWidth formula clause * + (budget + 1)) := by + change + ((paperFormulaClauseTupleWordOrder formula clause).symm + (paperFormulaClauseTupleWordOrder formula clause + ((finProdFinEquiv + (m := 2 ^ paperFormulaClauseWidth + formula clause - 1) + (n := paperFormulaClauseWidth formula clause * + (budget + 1))).symm word).1)).val = _ + rw [Equiv.symm_apply_apply] + rfl + +end PhysicalShiftedInterpolationRowCanonicalRankCorrectness + +namespace PhysicalShiftedInterpolationRowCanonicalSourceDigits + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact GapCVP.FormulaBridge +open GapCVP.ShiftedTupleTM GapCVP.SourceOrder GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationRowFamilyProjection GapCVP.PhysicalShiftedRowTupleRankTM +open GapCVP.PhysicalShiftedInterpolationRowSourceProjection +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationRowCanonicalRankCorrectness + +private theorem paperVariableArityPhysicalShiftedSourceRowClauseRank_eq + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalShiftedRowClauseRank formula row.val = + (physicalShiftedSourceRowClause + formula row inShifted).val := by + let budget := physicalInterpolationMomentBudget formula + let moment := budget + 1 + let tag := physicalShiftedSourceRowFamilyCoordinate + formula row inShifted + let decoded : + (clause : Fin (srcFormula formula).clauses.length) × + Fin (paperShiftedClauseTagCount + formula budget clause) := finSigmaFinEquiv.symm tag + let retainedClause : Fin (noTautClauses formula).length := + Fin.cast (paperVariableAritySourceFormula_clauses_length formula) + decoded.1 + let sourcePrefix := physicalShiftedRowClausePrefix + formula decoded.1.val + have positive : 0 < moment := by + dsimp [moment] + omega + have sigmaRank : + tag.val = + (∑ index : Fin decoded.1.val, + paperShiftedClauseTagCount formula budget + (Fin.castLE decoded.1.isLt.le index)) + decoded.2.val := by + have actual := finSigmaFinEquiv_apply decoded + change + (finSigmaFinEquiv decoded).val = + (∑ index : Fin decoded.1.val, + paperShiftedClauseTagCount formula budget + (Fin.castLE decoded.1.isLt.le index)) + decoded.2.val at actual + rw [show finSigmaFinEquiv decoded = tag from + Equiv.apply_symm_apply _ tag] at actual + exact actual + have rank : tag.val = sourcePrefix * moment + decoded.2.val := by + rw [sigmaRank, + paperVariableArityPhysicalShiftedDependentClausePrefix_eq_weightSum] + have mixedTag : + tag.val / moment = + physicalShiftedRowMixedTag formula row.val := by + change + ((row.val - physicalFormulaOrdinaryBoundary formula) / + (physGridCard formula * + physDegree formula)) / + physicalFormulaMomentCount formula = _ + congr 1 + rw [Nat.div_div_eq_div_mul, Nat.mul_comm] + have shiftedWeight : + paperShiftedClauseTagCount formula budget decoded.1 = + paperShiftedSourceClauseWeight + ((noTautClauses formula).get retainedClause) * + moment := by + calc + paperShiftedClauseTagCount formula budget decoded.1 = + (paperFormulaClauseWidth formula decoded.1 * + (2 ^ paperFormulaClauseWidth + formula decoded.1 - 1)) * moment := by + unfold paperShiftedClauseTagCount + dsimp [moment] + ring + _ = paperShiftedSourceClauseWeight + ((noTautClauses formula).get retainedClause) * + moment := by + rw [paperVariableArityPhysicalShiftedFiniteClauseWeight_eq + formula decoded.1] + have mixedDecomposition : + physicalShiftedRowMixedTag formula row.val = + sourcePrefix + decoded.2.val / moment := by + rw [← mixedTag, rank] + rw [show sourcePrefix * moment = moment * sourcePrefix by ac_rfl, + Nat.mul_add_div positive] + have inClause : + decoded.2.val / moment < + paperShiftedSourceClauseWeight + ((noTautClauses formula).get retainedClause) := by + apply (Nat.div_lt_iff_lt_mul positive).mpr + rw [← shiftedWeight] + exact decoded.2.isLt + have sameSourcePrefix : + physicalShiftedRowClausePrefix + formula retainedClause.val = sourcePrefix := by + rfl + have lower : + physicalShiftedRowClausePrefix + formula retainedClause.val ≤ + physicalShiftedRowMixedTag formula row.val := by + calc + physicalShiftedRowClausePrefix + formula retainedClause.val = sourcePrefix := sameSourcePrefix + _ ≤ sourcePrefix + decoded.2.val / moment := Nat.le_add_right _ _ + _ = physicalShiftedRowMixedTag formula row.val := + mixedDecomposition.symm + have upper : + physicalShiftedRowMixedTag formula row.val < + physicalShiftedRowClausePrefix + formula (retainedClause.val + 1) := by + calc + physicalShiftedRowMixedTag formula row.val = + sourcePrefix + decoded.2.val / moment := mixedDecomposition + _ < sourcePrefix + + paperShiftedSourceClauseWeight + ((noTautClauses formula).get retainedClause) := + Nat.add_lt_add_left inClause sourcePrefix + _ = physicalShiftedRowClausePrefix + formula (retainedClause.val + 1) := by + rw [paperVariableArityPhysicalShiftedRowClausePrefix_succ + formula retainedClause.val retainedClause.isLt, + sameSourcePrefix] + have selected := + paperVariableArityPhysicalShiftedRowClauseRank_eq_of_interval + formula row.val retainedClause lower upper + have sourceClause : + (physicalShiftedSourceRowClause + formula row inShifted).val = decoded.1.val := by + change + ((Equiv.sigmaCongrRight fun clause => + paperShiftedClauseWordOrder + formula budget clause) + (finSigmaFinEquiv.symm tag)).fst.val = decoded.1.val + rfl + exact selected.trans sourceClause.symm + +end PhysicalShiftedInterpolationRowCanonicalSourceDigits + +namespace PhysicalShiftedInterpolationLocalVariableWordRank + +open GapCVP.Core GapCVP.FormulaBridge GapCVP.SourceOrder + +private theorem paperVariableArityPhysicalShiftedClauseLocalVariableWordRank + (formula : ThreeCNF) (budget : ℕ) + (clause : Fin (srcFormula formula).clauses.length) + (word : Fin + (paperShiftedClauseTagCount formula budget clause)) : + ((paperFormulaClauseVariableWordOrder formula clause).symm + ((paperShiftedClauseWordOrder formula budget clause + word).2.1)).val = + (word.val / (budget + 1)) % + paperFormulaClauseWidth formula clause := by + change + ((paperFormulaClauseVariableWordOrder formula clause).symm + (paperFormulaClauseVariableWordOrder formula clause + ((finProdFinEquiv + (m := paperFormulaClauseWidth formula clause) + (n := budget + 1)).symm + ((finProdFinEquiv + (m := 2 ^ paperFormulaClauseWidth + formula clause - 1) + (n := paperFormulaClauseWidth formula clause * + (budget + 1))).symm word).2).1)).val = _ + rw [Equiv.symm_apply_apply] + exact Nat.mod_mul_left_div_self + word.val (budget + 1) + (paperFormulaClauseWidth formula clause) + +end PhysicalShiftedInterpolationLocalVariableWordRank + +namespace PhysicalShiftedInterpolationRowCanonicalSourceTupleDigits + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge GapCVP.CanonicalOffsetIdentity +open GapCVP.SourceOrder GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalInterpolationRowFamilyProjection GapCVP.PhysicalShiftedRowTupleRankTM +open GapCVP.PhysicalShiftedRowTupleRankBounds +open GapCVP.PhysicalShiftedInterpolationRowSourceProjection +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationRowCanonicalRankCorrectness +open GapCVP.PhysicalShiftedInterpolationRowCanonicalSourceDigits +open GapCVP.PhysicalShiftedInterpolationLocalVariableWordRank + +private def paperVariableArityPhysicalShiftedSourceRowCanonicalSigma + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + (clause : Fin (srcFormula formula).clauses.length) × + Fin (paperShiftedClauseTagCount formula + (physicalInterpolationMomentBudget formula) clause) := + finSigmaFinEquiv.symm + (physicalShiftedSourceRowFamilyCoordinate + formula row inShifted) + +private theorem paperVariableArityPhysicalShiftedSourceRowCanonicalMixedDigits + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalShiftedRowSelectedClauseArity + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + paperFormulaClauseWidth formula + (physicalShiftedSourceRowClause + formula row inShifted) ∧ + physicalShiftedRowLocalTag formula row.val = + (paperVariableArityPhysicalShiftedSourceRowCanonicalSigma + formula row inShifted).2.val / + physicalFormulaMomentCount formula := by + let budget := physicalInterpolationMomentBudget formula + let moment := budget + 1 + let tag := physicalShiftedSourceRowFamilyCoordinate + formula row inShifted + let decoded : + (clause : Fin (srcFormula formula).clauses.length) × + Fin (paperShiftedClauseTagCount + formula budget clause) := finSigmaFinEquiv.symm tag + let retainedClause : Fin (noTautClauses formula).length := + Fin.cast (paperVariableAritySourceFormula_clauses_length formula) + decoded.1 + let sourcePrefix := physicalShiftedRowClausePrefix + formula decoded.1.val + have positive : 0 < moment := by + dsimp [moment] + omega + have sourceClause : + physicalShiftedSourceRowClause + formula row inShifted = decoded.1 := by + apply Fin.ext + change + ((Equiv.sigmaCongrRight fun clause => + paperShiftedClauseWordOrder + formula budget clause) + (finSigmaFinEquiv.symm tag)).fst.val = decoded.1.val + rfl + have selectedClause : + physicalShiftedRowClauseRank formula row.val = + decoded.1.val := by + exact (paperVariableArityPhysicalShiftedSourceRowClauseRank_eq + formula row inShifted).trans (congrArg Fin.val sourceClause) + have sigmaRank : + tag.val = + (∑ index : Fin decoded.1.val, + paperShiftedClauseTagCount formula budget + (Fin.castLE decoded.1.isLt.le index)) + decoded.2.val := by + have actual := finSigmaFinEquiv_apply decoded + change + (finSigmaFinEquiv decoded).val = + (∑ index : Fin decoded.1.val, + paperShiftedClauseTagCount formula budget + (Fin.castLE decoded.1.isLt.le index)) + decoded.2.val at actual + rw [show finSigmaFinEquiv decoded = tag from + Equiv.apply_symm_apply _ tag] at actual + exact actual + have rank : tag.val = sourcePrefix * moment + decoded.2.val := by + rw [sigmaRank, + paperVariableArityPhysicalShiftedDependentClausePrefix_eq_weightSum] + have mixedTag : + tag.val / moment = + physicalShiftedRowMixedTag formula row.val := by + change + ((row.val - physicalFormulaOrdinaryBoundary formula) / + (physGridCard formula * + physDegree formula)) / + physicalFormulaMomentCount formula = _ + congr 1 + rw [Nat.div_div_eq_div_mul, Nat.mul_comm] + have mixedDecomposition : + physicalShiftedRowMixedTag formula row.val = + sourcePrefix + decoded.2.val / moment := by + rw [← mixedTag, rank] + rw [show sourcePrefix * moment = moment * sourcePrefix by ac_rfl, + Nat.mul_add_div positive] + have selectedWidth : + physicalShiftedRowSelectedClauseArity + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + paperFormulaClauseWidth formula decoded.1 := by + let actualRetained : Fin + (noTautClauses formula).length := + ⟨physicalShiftedRowClauseRank formula row.val, + physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted⟩ + have sameRetained : actualRetained = retainedClause := by + apply Fin.ext + exact selectedClause + have width := paperFormulaClauseWidth_retainedOriginal + formula retainedClause + have index : + paperRetainedOriginalClauseIndexOrder + formula retainedClause = decoded.1 := by + apply Fin.ext + rfl + rw [index] at width + change + (paperSourceNormalizedClause + ((noTautClauses formula).get + actualRetained)).length = _ + rw [sameRetained] + exact width.symm + have selectedLocalTag : + physicalShiftedRowLocalTag formula row.val = + decoded.2.val / moment := by + unfold physicalShiftedRowLocalTag + rw [selectedClause, mixedDecomposition] + change sourcePrefix + decoded.2.val / moment - sourcePrefix = _ + exact Nat.add_sub_cancel_left sourcePrefix (decoded.2.val / moment) + constructor + · rw [sourceClause] + exact selectedWidth + · change + physicalShiftedRowLocalTag formula row.val = + decoded.2.val / moment + exact selectedLocalTag + +private theorem paperVariableArityPhysicalShiftedSourceRowTupleRank_eq + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalShiftedRowTupleRank + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + ((paperFormulaClauseTupleWordOrder formula + (physicalShiftedSourceRowClause + formula row inShifted)).symm + (physicalShiftedSourceRowTuple + formula row inShifted)).val := by + let budget := physicalInterpolationMomentBudget formula + let moment := budget + 1 + let tag := physicalShiftedSourceRowFamilyCoordinate + formula row inShifted + let decoded : + (clause : Fin (srcFormula formula).clauses.length) × + Fin (paperShiftedClauseTagCount + formula budget clause) := finSigmaFinEquiv.symm tag + have digits := paperVariableArityPhysicalShiftedSourceRowCanonicalMixedDigits + formula row inShifted + unfold physicalShiftedRowTupleRank + rw [digits.2, digits.1, Nat.div_div_eq_div_mul] + rw [Nat.mul_comm (physicalFormulaMomentCount formula)] + change + decoded.2.val / + (paperFormulaClauseWidth formula decoded.1 * moment) = + ((paperFormulaClauseTupleWordOrder formula + ((finSigmaFinEquiv.symm tag).1)).symm + ((paperShiftedClauseWordOrder formula budget + (finSigmaFinEquiv.symm tag).1 + (finSigmaFinEquiv.symm tag).2).1)).val + symm + simpa only [decoded, moment] using + paperVariableArityPhysicalShiftedClauseTupleWordRank + formula budget decoded.1 decoded.2 + +private theorem paperVariableArityPhysicalShiftedSourceRowLocalVariableRank_eq + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalShiftedRowVariablePosition + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + ((paperFormulaClauseVariableWordOrder formula + (physicalShiftedSourceRowClause + formula row inShifted)).symm + (physicalShiftedSourceRowLocalVariable + formula row inShifted)).val := by + let budget := physicalInterpolationMomentBudget formula + let moment := budget + 1 + let tag := physicalShiftedSourceRowFamilyCoordinate + formula row inShifted + let decoded : + (clause : Fin (srcFormula formula).clauses.length) × + Fin (paperShiftedClauseTagCount + formula budget clause) := finSigmaFinEquiv.symm tag + have digits := paperVariableArityPhysicalShiftedSourceRowCanonicalMixedDigits + formula row inShifted + unfold physicalShiftedRowVariablePosition + rw [digits.2, digits.1] + change + decoded.2.val / moment % + paperFormulaClauseWidth formula decoded.1 = + ((paperFormulaClauseVariableWordOrder formula + ((finSigmaFinEquiv.symm tag).1)).symm + ((paperShiftedClauseWordOrder formula budget + (finSigmaFinEquiv.symm tag).1 + (finSigmaFinEquiv.symm tag).2).2.1)).val + symm + simpa only [decoded, moment] using + paperVariableArityPhysicalShiftedClauseLocalVariableWordRank + formula budget decoded.1 decoded.2 + +end PhysicalShiftedInterpolationRowCanonicalSourceTupleDigits + +namespace PhysicalShiftedInterpolationRowCanonicalRankCorrectness + +open scoped BigOperators + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge GapCVP.ClauseOffsetTM +open GapCVP.ShiftedTupleTM GapCVP.CanonicalOffsetIdentity GapCVP.SourceClausePrefixBridge +open GapCVP.SourceOrder GapCVP.MatrixEntrySemantics GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalColumnOrderProjection GapCVP.PhysicalInterpolationRowFamilyProjection +open GapCVP.PhysicalRefinementColumnTagSourceCorrectness GapCVP.PhysicalShiftedRowTupleRankTM +open GapCVP.PhysicalShiftedRowTupleRankBounds GapCVP.PhysicalShiftedExpectedTypeRankTM +open GapCVP.PhysicalShiftedInterpolationRowSourceProjection +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness + +open GapCVP.PhysicalShiftedInterpolationRowCanonicalSourceDigits +open GapCVP.PhysicalShiftedInterpolationRowCanonicalSourceTupleDigits + +private theorem paperVariableArityPhysicalShiftedSourceRowTable_eq_column_iff + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + (Sum.inr + ⟨physicalShiftedSourceRowClause + formula row inShifted, + physicalShiftedSourceRowTuple + formula row inShifted⟩ : + sourceSATTableType (srcFormula formula)) = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 ↔ + physicalShiftedExpectedTableTypeRank + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + (column.val / + physFieldCard formula) / + physGridCard formula := by + let sourceTable : sourceSATTableType + (srcFormula formula) := + Sum.inr + ⟨physicalShiftedSourceRowClause + formula row inShifted, + physicalShiftedSourceRowTuple + formula row inShifted⟩ + let columnTable := + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 + have clauseRank := + paperVariableArityPhysicalShiftedSourceRowClauseRank_eq + formula row inShifted + have tupleRank := + paperVariableArityPhysicalShiftedSourceRowTupleRank_eq + formula row inShifted + have sourceRank : + ((sourceTypeCardWordOrder formula).symm + sourceTable).val = + physicalShiftedExpectedTableTypeRank + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) := by + dsimp [sourceTable] + rw [paperVariableAritySourceLocalTypeWordRank, + finSigmaFinEquiv_apply, + paperVariableAritySourceDependentClausePrefix_eq_weightSum] + unfold physicalShiftedExpectedTableTypeRank + physicalShiftedExpectedLocalTypePrefix + rw [clauseRank, tupleRank] + have columnRank := sourceCoordinateTypeWordRank + (encodeThreeCNF formula).length formula column + rw [physicalFormulaFieldCardinality_eq_card, + physicalFormulaGridCardinality_eq_card] at columnRank + change sourceTable = columnTable ↔ _ + rw [← sourceRank, ← columnRank] + exact ⟨fun same => congrArg (fun value => + ((sourceTypeCardWordOrder formula).symm value).val) same, + fun same => (sourceTypeCardWordOrder formula).symm.injective + (Fin.ext same)⟩ + +end PhysicalShiftedInterpolationRowCanonicalRankCorrectness + +namespace PhysicalShiftedInterpolationBinaryHCoreCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineSystem GapCVP.BinaryFieldInverseAlgebra +open GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics GapCVP.PhysicalColumnOrder +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalInterpolationNodeFactorTM +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryShiftedCheckBitInstantiation +open GapCVP.PhysicalShiftedExpectedTypeRankTM +open GapCVP.PhysicalShiftedInterpolationBinaryCheckBitCorrectness +open GapCVP.PhysicalShiftedInterpolationBaseTM +open GapCVP.PhysicalShiftedInterpolationParityDecodedFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationParityMaskedFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationRowCanonicalRankCorrectness +open GapCVP.PhysicalShiftedInterpolationRowDigitCorrectness +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationRowSourceProjection +open GapCVP.PhysicalShiftedRowTupleRankBounds GapCVP.SourceFieldMomentOperationsTM +open GapCVP.SourceOrder GapCVP.PhysicalInterpolationNodeCountBounds + +private theorem paperVariableArityPhysicalShiftedActualBinaryCheckBit_decide_of_sourceRatio + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) + (correctRatio : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) = + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 - + sourceSATFieldBit + (K := PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula) + ((physicalShiftedSourceRowTuple + formula row inShifted).val + (physicalShiftedSourceRowLocalVariable + formula row inShifted))) / + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1.val - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedSourceRowLocalVariable + formula row inShifted).val)) : + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check row column = + (1 : ZMod 2)) = + (decide + (physicalShiftedExpectedTableTypeRank + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + (column.val / + physFieldCard formula) / + physGridCard formula) && + Bool.xor + (decide + ((((row.val - physicalFamilyStart + (3 : Fin 4) formula) / + physDegree formula) % + physGridCard formula) = + (column.val / + physFieldCard formula) % + physGridCard formula) && + (sourceWordPow + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) + (physicalFamilyRowMoment + (3 : Fin 4) row.val formula)) + (physicalInterpolationRowBasisIndex + row.val formula)) + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (paperVariableArityPhysicalShiftedActualSourceCorrectionField + formula row column inShifted) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2)))) := by + classical + have basis : (physicalWordDecodedRow + (encodeThreeCNF formula).length formula row).2.2 = + physicalInterpolationRowBasisIndex row.val formula := + Fin.ext (paperVariableArityPhysicalShiftedSourceRowBasis_val formula row) + rw [physicalWordBinaryCheckCoefficient, + paperVariableArityPhysicalShiftedSourceRowFieldCoefficient_eq_selected + formula row column inShifted, basis] + by_cases matching : + (Sum.inr ⟨physicalShiftedSourceRowClause formula row inShifted, + physicalShiftedSourceRowTuple formula row inShifted⟩ : + sourceSATTableType (srcFormula formula)) = + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).1 + · have expected := + (paperVariableArityPhysicalShiftedSourceRowTable_eq_column_iff + formula row column inShifted).mp matching + simp only [matching, ite_eq_left, expected, decide_true, Bool.true_and] + have sourceRow := paperVariableArityPhysicalShiftedSourceRowNodeGrid_eq_family + formula row inShifted + have sourceColumn : + Fin.cast (physicalInterpolationExplicitGridCardinality_eq formula) + ((sourceFormulaExplicitGridOrder (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1) = + physicalShiftedColumnGridIndex formula column.val := + Fin.ext (physicalSourceColumnExplicitGridPosition_val + formula column) + have sameGrid : + physicalShiftedSourceRowGrid formula row inShifted = + (sourceFormulaExplicitGridOrder (encodeThreeCNF formula).length + (srcFormula formula)).symm + (sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1 ↔ + physicalInterpolationFamilyRowGridPosition + (3 : Fin 4) row.val formula = + physicalShiftedColumnGridIndex formula column.val := by + constructor + · intro same + exact sourceRow.symm.trans ((congrArg + (Fin.cast (physicalInterpolationExplicitGridCardinality_eq + formula)) same).trans sourceColumn) + · intro same + exact Fin.cast_injective + (physicalInterpolationExplicitGridCardinality_eq formula) + (sourceRow.trans (same.trans sourceColumn.symm)) + rw [← correctRatio, + paperVariableArityPhysicalShiftedDecodedRowParity_eq_maskedSourceCorrection, + paperVariableArityPhysicalSourceBasisCoordinate_sub_decide] + simp only [sameGrid, + paperVariableArityPhysicalShiftedSourceRowMoment_eq_family] + rw [paperVariableArityPhysicalShiftedActualDirectMomentBasis_decide] + rfl + · have expected : ¬ + physicalShiftedExpectedTableTypeRank formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + (column.val / + physFieldCard formula) / + physGridCard formula := + fun same => matching + ((paperVariableArityPhysicalShiftedSourceRowTable_eq_column_iff + formula row column inShifted).mpr same) + simp only [List.get_eq_getElem, matching, ↓reduceIte, Module.Basis.equivFun_apply, map_zero, + Pi.zero_apply, zero_ne_one, decide_false, expected, Fin.isValue, Bool.false_and] + +end PhysicalShiftedInterpolationBinaryHCoreCorrectness + +namespace PhysicalShiftedCanonicalInterpolationBaseSourceWordSemanticBridge + +open GapCVP.SourcePreprocessingSemantics GapCVP.SourceOrder + +private theorem paperVariableAritySourceClauseTupleWordOrder_apply_localVariable + (formula : ThreeCNF) + (clause : List GapCVP.Literal) + (hclause : clause ∈ paperSourceNormalizedClauses formula) + (tuple : Fin (2 ^ clause.length - 1)) + (position : Fin clause.length) : + (sourceClauseTupleWordOrder + formula clause hclause tuple).val + (paperLocalVariableWordOrder + formula clause hclause position) = + (paperSatisfyingWordOrder clause.length + (fun index => (clause.get index).2) tuple).val position := by + simp only [sourceClauseTupleWordOrder, List.get_eq_getElem, + paperVariableAritySatisfyingLocalTupleWordEquiv, + paperLocalAssignmentWordOrder, Equiv.subtypeEquiv_symm, Equiv.arrowCongr_symm, + Equiv.symm_symm, Equiv.refl_symm, + Equiv.trans_apply, Equiv.subtypeEquiv_apply, Equiv.arrowCongr_apply, Equiv.coe_refl, + Function.comp_apply, + Equiv.symm_apply_apply, id_eq] + +end PhysicalShiftedCanonicalInterpolationBaseSourceWordSemanticBridge + +namespace PhysicalShiftedCanonicalRetainedClauseSourceCorrectness + +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.FormulaBridge GapCVP.CanonicalOffsetIdentity GapCVP.SourceOrder + +theorem paperFormulaRetainedClause_retainedOriginal + (formula : ThreeCNF) + (original : Fin (noTautClauses formula).length) : + (paperFormulaRetainedClause formula + (paperRetainedOriginalClauseIndexOrder + formula original)).val = + paperSourceNormalizedClause + ((noTautClauses formula).get original) := by + simp only [paperSourceNormalizedClauses, paperFormulaRetainedClause, Fin.cast, srcFormula, + paperRetainedOriginalClauseIndexOrder, finCongr, List.get_eq_getElem, List.getElem_attach, + List.getElem_map] + rfl + +end PhysicalShiftedCanonicalRetainedClauseSourceCorrectness + +open GapCVP.PhysicalShiftedCanonicalRetainedClauseSourceCorrectness + +local notation "retainedClause_source" => + paperFormulaRetainedClause_retainedOriginal + +namespace PhysicalShiftedCanonicalInterpolationBaseSourceFormulaTransport + +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.SourcePreprocessingSemantics +open GapCVP.FormulaBridge GapCVP.SourceOrder GapCVP.CanonicalOffsetIdentity +open GapCVP.PhysicalShiftedCanonicalInterpolationBaseSourceWordSemanticBridge + +private theorem paperVariableArityNormalizedClauseTupleTransport_sourceBit + (formula : ThreeCNF) + (normalized : List GapCVP.Literal) + (membership : normalized ∈ paperSourceNormalizedClauses formula) + (target : GapCVP.Core.Clause (paperVariableArityVariableCount formula)) + (equality : paperVariableAritySourceClause + formula normalized membership = target) + (tuple : Fin (2 ^ normalized.length - 1)) + (position : Fin normalized.length) : + ((equality ▸ sourceClauseTupleWordOrder + formula normalized membership) tuple).val + ((equality ▸ paperLocalVariableWordOrder + formula normalized membership) position) = + (paperSatisfyingWordOrder normalized.length + (fun index => (normalized.get index).2) tuple).val position := by + subst target + exact paperVariableAritySourceClauseTupleWordOrder_apply_localVariable + formula normalized membership tuple position + +private theorem paperVariableArityNormalizedClauseVariableTransport_sourceRank + (formula : ThreeCNF) + (normalized : List GapCVP.Literal) + (membership : normalized ∈ paperSourceNormalizedClauses formula) + (target : GapCVP.Core.Clause (paperVariableArityVariableCount formula)) + (equality : paperVariableAritySourceClause + formula normalized membership = target) + (position : Fin normalized.length) : + ((equality ▸ paperLocalVariableWordOrder + formula normalized membership) position).val.val = + paperVariableArityVariableRank formula + (normalized.get position).1 := by + subst target + rfl + +private theorem paperVariableArityFormulaClauseTupleWordOrder_sourceBit + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) + (tuple : Fin (2 ^ paperFormulaClauseWidth formula clause - 1)) + (position : Fin (paperFormulaClauseWidth formula clause)) : + (paperFormulaClauseTupleWordOrder + formula clause tuple).val + (paperFormulaClauseVariableWordOrder + formula clause position) = + (paperSatisfyingWordOrder + (paperFormulaClauseWidth formula clause) + (fun index => + ((paperFormulaRetainedClause + formula clause).val.get + ⟨index.val, by + exact index.isLt⟩).2) + tuple).val position := by + let retained := paperFormulaRetainedClause formula clause + have equality := paperFormulaRetainedClause_sourceClause + formula clause + change + (paperFormulaClauseTupleWordOrder + formula clause tuple).val + (paperFormulaClauseVariableWordOrder + formula clause position) = + (paperSatisfyingWordOrder retained.val.length + (fun index => (retained.val.get index).2) tuple).val position + unfold paperFormulaClauseTupleWordOrder + paperFormulaClauseVariableWordOrder + change + ((equality ▸ + sourceClauseTupleWordOrder + formula retained.val retained.property) tuple).val + ((equality ▸ + paperLocalVariableWordOrder + formula retained.val retained.property) position) = _ + exact paperVariableArityNormalizedClauseTupleTransport_sourceBit + formula retained.val retained.property + ((srcFormula formula).clauses.get clause) + equality tuple position + +private theorem paperVariableArityFormulaClauseVariableWordOrder_sourceVariableRank + (formula : ThreeCNF) + (clause : Fin (srcFormula formula).clauses.length) + (position : Fin (paperFormulaClauseWidth formula clause)) : + (paperFormulaClauseVariableWordOrder + formula clause position).val.val = + paperVariableArityVariableRank formula + (((paperFormulaRetainedClause formula clause).val.get + ⟨position.val, by + exact position.isLt⟩).1) := by + let retained := paperFormulaRetainedClause formula clause + have equality := paperFormulaRetainedClause_sourceClause + formula clause + change + (paperFormulaClauseVariableWordOrder + formula clause position).val.val = + paperVariableArityVariableRank formula + (retained.val.get position).1 + unfold paperFormulaClauseVariableWordOrder + change + ((equality ▸ + paperLocalVariableWordOrder + formula retained.val retained.property) position).val.val = _ + exact paperVariableArityNormalizedClauseVariableTransport_sourceRank + formula retained.val retained.property + ((srcFormula formula).clauses.get clause) + equality position + +end PhysicalShiftedCanonicalInterpolationBaseSourceFormulaTransport + +namespace PhysicalShiftedCanonicalBetaSourceCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge GapCVP.SourceOrder +open GapCVP.CanonicalOffsetIdentity GapCVP.SatisfyingWordSourceRankSemantics +open GapCVP.ShiftedTupleBetaTM GapCVP.ShiftedTupleBetaSourceCorrectness +open GapCVP.ShiftedTupleAnchorSourceFieldCorrectness GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalShiftedRowTupleRankTM GapCVP.PhysicalShiftedRowTupleRankBounds +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationRowCanonicalSourceDigits +open GapCVP.PhysicalShiftedInterpolationRowCanonicalSourceTupleDigits +open GapCVP.PhysicalShiftedCanonicalInterpolationBaseSourceFormulaTransport +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation + +private theorem paperVariableArityPhysicalShiftedSourceRowCanonicalBeta_eq + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalShiftedRowBetaBit + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + (physicalShiftedSourceRowTuple + formula row inShifted).val + (physicalShiftedSourceRowLocalVariable + formula row inShifted) := by + classical + let bounded := physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted + let sourceClause := physicalShiftedSourceRowClause + formula row inShifted + let original : Fin (noTautClauses formula).length := + ⟨physicalShiftedRowClauseRank formula row.val, + bounded⟩ + let tuple := + (paperFormulaClauseTupleWordOrder + formula sourceClause).symm + (physicalShiftedSourceRowTuple + formula row inShifted) + let position := + (paperFormulaClauseVariableWordOrder + formula sourceClause).symm + (physicalShiftedSourceRowLocalVariable + formula row inShifted) + have index : + paperRetainedOriginalClauseIndexOrder formula original = + sourceClause := by + apply Fin.ext + exact paperVariableArityPhysicalShiftedSourceRowClauseRank_eq + formula row inShifted + have width : + physicalShiftedRowSelectedClauseArity + formula row.val bounded = + paperFormulaClauseWidth formula sourceClause := by + unfold physicalShiftedRowSelectedClauseArity + rw [← index] + exact + (paperFormulaClauseWidth_retainedOriginal + formula original).symm + have tupleRank : + physicalShiftedRowTupleRank + formula row.val bounded = tuple.val := + paperVariableArityPhysicalShiftedSourceRowTupleRank_eq + formula row inShifted + have localRank : + physicalShiftedRowVariablePosition + formula row.val bounded = position.val := + paperVariableArityPhysicalShiftedSourceRowLocalVariableRank_eq + formula row inShifted + have retained : + (paperFormulaRetainedClause + formula sourceClause).val = + paperSourceNormalizedClause + ((noTautClauses formula).get original) := by + rw [← index] + exact retainedClause_source + formula original + have sign : + paperVariableArityBoundedSourceSign + (paperFormulaClauseWidth formula sourceClause) + (by + rw [← width] + exact paper_retainedClause_length_le_three formula + (paperSourceNormalizedClause + ((noTautClauses formula).get original)) + (paperShiftedTupleRetainedNormalizedClause_mem + formula original.val original.isLt)) + (physicalShiftedRowNormalizedSign + formula row.val bounded) = + (fun index : Fin + (paperFormulaClauseWidth formula sourceClause) => + ((paperFormulaRetainedClause + formula sourceClause).val.get + ⟨index.val, index.isLt⟩).2) := by + funext slot + unfold paperVariableArityBoundedSourceSign + physicalShiftedRowNormalizedSign + have normalized : + slot.val < + (paperSourceNormalizedClause + ((noTautClauses formula).get + original)).length := by + rw [← paperFormulaClauseWidth_retainedOriginal + formula original, index] + exact slot.isLt + have actual := + paperVariableArityShiftedTuplePotentialNormalizedLiteral_get + ((noTautClauses formula).get original) + ⟨slot.val, by + have bound := + paper_retainedClause_length_le_three formula + (paperSourceNormalizedClause + ((noTautClauses formula).get original)) + (paperShiftedTupleRetainedNormalizedClause_mem + formula original.val original.isLt) + exact Nat.lt_of_lt_of_le normalized bound⟩ + normalized + have bits := congrArg (fun literal : GapCVP.Literal => literal.2) + actual + simpa only [List.get_eq_getElem, Fin.eta, retained] using bits + have word := paperVariableAritySatisfyingWordOrder_apply_eq_shiftedTupleBetaBit + (paperFormulaClauseWidth formula sourceClause) + (by + rw [← width] + exact paper_retainedClause_length_le_three formula + (paperSourceNormalizedClause + ((noTautClauses formula).get original)) + (paperShiftedTupleRetainedNormalizedClause_mem + formula original.val original.isLt)) + (physicalShiftedRowNormalizedSign + formula row.val bounded) + tuple position + rw [sign] at word + have source := paperVariableArityFormulaClauseTupleWordOrder_sourceBit + formula sourceClause tuple position + rw [Equiv.apply_symm_apply, Equiv.apply_symm_apply] at source + unfold physicalShiftedRowBetaBit + change + (physicalShiftedRowTupleRank formula row.val bounded + + if physicalShiftedRowTupleRank formula row.val bounded < + paperShiftedTupleRejectedNatural + (physicalShiftedRowSelectedClauseArity + formula row.val bounded) + (physicalShiftedRowNormalizedSign + formula row.val bounded) + then 0 else 1).testBit + (physicalShiftedRowVariablePosition + formula row.val bounded) = _ + rw [tupleRank, localRank, width] + exact word.symm.trans source.symm + +end PhysicalShiftedCanonicalBetaSourceCorrectness + +namespace PhysicalShiftedCanonicalAnchorSourceCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinarySourceTautologyNormalizationExact +open GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge GapCVP.CanonicalOffsetIdentity +open GapCVP.SourceOrder GapCVP.ShiftedTupleAnchorSourceFieldCorrectness +open GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalShiftedRowTupleRankTM +open GapCVP.PhysicalShiftedRowTupleRankBounds +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationRowCanonicalSourceDigits +open GapCVP.PhysicalShiftedInterpolationRowCanonicalSourceTupleDigits +open GapCVP.PhysicalShiftedCanonicalInterpolationBaseSourceFormulaTransport + +private theorem paperVariableArityPhysicalShiftedRetainedGet_eq + {α : Type*} (first second : List α) + (same : first = second) + (firstIndex : Fin first.length) + (secondIndex : Fin second.length) + (rank : firstIndex.val = secondIndex.val) : + first.get firstIndex = second.get secondIndex := by + subst second + have equal : firstIndex = secondIndex := Fin.ext rank + rw [equal] + +private theorem paperVariableArityPhysicalShiftedSourceRowCanonicalAnchor_eq + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + paperShiftedTupleSelectedSourceVariableIndex + formula + (physicalShiftedRowClauseRank formula row.val) + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) + (physicalShiftedRowVariablePosition + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted)) + (physicalShiftedRowVariablePosition_lt_normalized + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted)) = + (physicalShiftedSourceRowLocalVariable + formula row inShifted).val := by + classical + let bounded := physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted + let sourceClause := physicalShiftedSourceRowClause + formula row inShifted + let original : Fin (noTautClauses formula).length := + ⟨physicalShiftedRowClauseRank formula row.val, + bounded⟩ + let sourcePosition := + (paperFormulaClauseVariableWordOrder + formula sourceClause).symm + (physicalShiftedSourceRowLocalVariable + formula row inShifted) + have sourceIndex : + paperRetainedOriginalClauseIndexOrder + formula original = sourceClause := by + apply Fin.ext + exact paperVariableArityPhysicalShiftedSourceRowClauseRank_eq + formula row inShifted + have retained : + (paperFormulaRetainedClause + formula sourceClause).val = + paperSourceNormalizedClause + ((noTautClauses formula).get original) := by + rw [← sourceIndex] + exact retainedClause_source + formula original + have positionRank : + physicalShiftedRowVariablePosition + formula row.val bounded = sourcePosition.val := + paperVariableArityPhysicalShiftedSourceRowLocalVariableRank_eq + formula row inShifted + let normalized := paperSourceNormalizedClause + ((noTautClauses formula).get original) + let retainedClause := + (paperFormulaRetainedClause + formula sourceClause).val + let physicalPosition : Fin normalized.length := + ⟨physicalShiftedRowVariablePosition + formula row.val bounded, + physicalShiftedRowVariablePosition_lt_normalized + formula row.val bounded⟩ + let retainedPosition : Fin retainedClause.length := + ⟨sourcePosition.val, by + exact sourcePosition.isLt⟩ + have sameLiteral : + normalized.get physicalPosition = + retainedClause.get retainedPosition := + paperVariableArityPhysicalShiftedRetainedGet_eq + normalized retainedClause retained.symm + physicalPosition retainedPosition positionRank + have source := + paperVariableArityFormulaClauseVariableWordOrder_sourceVariableRank + formula sourceClause sourcePosition + rw [Equiv.apply_symm_apply] at source + apply Fin.ext + change + paperVariableArityVariableRank formula + (normalized.get physicalPosition).1 = + (physicalShiftedSourceRowLocalVariable + formula row inShifted).val.val + rw [source] + exact congrArg (fun literal : GapCVP.Literal => + paperVariableArityVariableRank formula literal.1) sameLiteral + +end PhysicalShiftedCanonicalAnchorSourceCorrectness + +namespace PhysicalShiftedCanonicalInterpolationBaseSemanticCorrectness + +open GapCVP.Core hiding sourceFormulaField +open GapCVP.BinaryEncoding GapCVP.BinaryFieldInverseAlgebra +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.FormulaBridge GapCVP.SourceOrder +open GapCVP.PhysicalLagrangeNodeProductAlgebra GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalShiftedInterpolationRowFieldCorrectness +open GapCVP.PhysicalShiftedCanonicalBetaSourceCorrectness +open GapCVP.PhysicalShiftedCanonicalAnchorSourceCorrectness +open GapCVP.PhysicalShiftedInterpolationBaseSourceFieldCorrectness +open GapCVP.PhysicalInterpolationColumnSourceFieldCorrectness +open GapCVP.PhysicalShiftedInterpolationParityMaskedFieldCorrectness + +theorem + paperVariableArityPhysicalShiftedFiniteRowCanonicalBaseSourceWord_eq_decodedSourceRatio + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin (sourceFormulaDimension + (encodeThreeCNF formula).length + (srcFormula formula))) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + sourceWordValue (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) = + ((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.2 - + sourceSATFieldBit + (K := GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaField + (encodeThreeCNF formula).length + (srcFormula formula)) + ((physicalShiftedSourceRowTuple + formula row inShifted).val + (physicalShiftedSourceRowLocalVariable + formula row inShifted))) / + (((sourceCoordinateWordOrder + (encodeThreeCNF formula).length formula column).2.1).val - + GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaVariablePlace + (encodeThreeCNF formula).length + (srcFormula formula) + (physicalShiftedSourceRowLocalVariable + formula row inShifted).val) := by + unfold physicalShiftedFiniteRowCanonicalBaseSourceWord + rw [paperVariableArityPhysicalShiftedCanonicalInterpolationBaseSourceWord_sourceField, + paperVariableArityPhysicalInterpolationColumnValueSourceWord_sourceField + formula column, + paperVariableArityPhysicalShiftedSourceRowCanonicalBeta_eq + formula row inShifted, + paperVariableArityPhysicalShiftedSourceRowCanonicalAnchor_eq + formula row inShifted] + have grid := + paperVariableArityPhysicalInterpolationColumnGridSourceWord_sourceField + formula column + rw [paperVariableArityPhysicalShiftedColumnGridSourceWord_eq_evaluationWord, + physicalLagrangeNodeEvaluationWord_sourceField] at grid + rw [grid] + +end PhysicalShiftedCanonicalInterpolationBaseSemanticCorrectness + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics +open GapCVP.PhysicalColumnOrder GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM +open GapCVP.PhysicalInterpolationDirectMomentBitTM GapCVP.PhysicalInterpolationNodeCountBounds +open GapCVP.PhysicalMaskedInterpolationNodeParityTM +open GapCVP.PhysicalOrdinaryShiftedCoefficientSumTM GapCVP.PhysicalShiftedExpectedTypeRankTM +open GapCVP.PhysicalShiftedInterpolationBinaryCheckBitCorrectness +open GapCVP.PhysicalShiftedCanonicalInterpolationBaseSemanticCorrectness +open GapCVP.PhysicalShiftedInterpolationBinaryHCoreCorrectness +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation +open GapCVP.PhysicalShiftedInterpolationParityMaskedFieldCorrectness +open GapCVP.PhysicalShiftedRowTupleRankBounds GapCVP.SourceFieldMomentOperationsTM +open GapCVP.SourceOrder + +private noncomputable def physicalShiftedSourceCorrectionField + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + PaperVariableArityPhysicalWordField + (encodeThreeCNF formula).length formula := + paperVariableArityPhysicalShiftedActualSourceCorrectionField + formula row column inShifted + +private theorem paperVariableArityPhysicalShiftedFiniteRowBaseComputer_valid + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalShiftedCanonicalInterpolationBaseComputer.output + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + finiteWordBits + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) := by + exact paperVariableArityPhysicalShiftedCheckBase_on_physical_row + formula row column + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) + +private theorem paperVariableArityPhysicalShiftedCorrectionBit_sourceCorrection + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalInterpolationNodeCorrectionBit + (3 : Fin 4) + (physicalShiftedNodePrefixWidth + physicalShiftedInterpolationMomentComputer) + physicalShiftedCanonicalInterpolationBaseComputer + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (physicalShiftedSourceCorrectionField + formula row column inShifted) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2))] := by + exact paperVariableArityPhysicalInterpolationNodeCorrectionBit_sourceField_valid + (3 : Fin 4) + (physicalShiftedNodePrefixWidth + physicalShiftedInterpolationMomentComputer) + physicalShiftedCanonicalInterpolationBaseComputer + row.val column.val formula + (physicalShiftedInterpolationNodeCount + row.val formula) + (paperVariableArityPhysicalShiftedInterpolationNodeWidth_valid + row.val column.val formula) + (physicalShiftedInterpolationNodeCount_le_grid + formula row.val) + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) + (paperVariableArityPhysicalShiftedFiniteRowBaseComputer_valid + formula row column inShifted) + +private noncomputable def physicalShiftedSourceExpectedTypeBit + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + Bool := + decide + (physicalShiftedExpectedTableTypeRank + formula row.val + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) = + (column.val / + physFieldCard formula) / + physGridCard formula) + +private theorem paperVariableArityPhysicalShiftedExpectedTypeMatch_sourceExpected + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalInterpolationExpectedTypeMatchBit + physicalShiftedExpectedTableTypeRankComputer + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [physicalShiftedSourceExpectedTypeBit + formula row column inShifted] := by + exact paperVariableArityPhysicalShiftedExpectedTypeMatchBit_valid + formula row column + (physicalShiftedRowClauseRank_lt_of_fin + formula row inShifted) + +private noncomputable def physicalShiftedSourceDirectBit + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + Bool := + decide + ((((row.val - physicalFamilyStart + (3 : Fin 4) formula) / + physDegree formula) % + physGridCard formula) = + ((column.val / + physFieldCard formula) % + physGridCard formula)) && + (sourceWordPow + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) + (physicalFamilyRowMoment + (3 : Fin 4) row.val formula)) + (physicalInterpolationRowBasisIndex + row.val formula) + +private theorem paperVariableArityPhysicalShiftedDirectMomentBit_sourceDirect + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalFamilyDirectMomentBit + (3 : Fin 4) + physicalShiftedCanonicalInterpolationBaseComputer + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [physicalShiftedSourceDirectBit + formula row column inShifted] := by + exact paperVariableArityPhysicalFamilyDirectMomentBit_valid + (3 : Fin 4) + physicalShiftedCanonicalInterpolationBaseComputer + row.val column.val formula + (physicalShiftedFiniteRowCanonicalBaseSourceWord + formula row column inShifted) + (physicalInterpolationRowBasisIndex + row.val formula) + rfl + (paperVariableArityPhysicalShiftedFiniteRowBaseComputer_valid + formula row column inShifted) + +private theorem paperVariableArityPhysicalShiftedCheckBit_actualSourceBits + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val) : + physicalShiftedCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [physicalShiftedSourceExpectedTypeBit + formula row column inShifted && + Bool.xor + (physicalShiftedSourceDirectBit + formula row column inShifted) + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (physicalShiftedSourceCorrectionField + formula row column inShifted) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2)))] := by + have marker : + physicalShiftedRowMarker + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = [true] := by + rw [paperVariableArityPhysicalShiftedRowMarker_query] + simp only [inShifted, decide_true] + exact paperVariableArityPhysicalSourceInterpolationFamilyCheckBit_bits + (3 : Fin 4) + physicalShiftedRowMarker + physicalShiftedExpectedTableTypeRankComputer + (physicalShiftedNodePrefixWidth + physicalShiftedInterpolationMomentComputer) + physicalShiftedCanonicalInterpolationBaseComputer + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) + true + (physicalShiftedSourceExpectedTypeBit + formula row column inShifted) + (physicalShiftedSourceDirectBit + formula row column inShifted) + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (physicalShiftedSourceCorrectionField + formula row column inShifted) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2))) + marker + (paperVariableArityPhysicalShiftedExpectedTypeMatch_sourceExpected + formula row column inShifted) + (paperVariableArityPhysicalShiftedDirectMomentBit_sourceDirect + formula row column inShifted) + (paperVariableArityPhysicalShiftedCorrectionBit_sourceCorrection + formula row column inShifted) + +private theorem paperVariableArityPhysicalShiftedCheckBit_valid_of_binary + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) + (correct : ∀ inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val, + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2)) = + (physicalShiftedSourceExpectedTypeBit + formula row column inShifted && + Bool.xor + (physicalShiftedSourceDirectBit + formula row column inShifted) + (decide + ((GapCVP.Factor400BinaryConstructiveSourcePlaces.sourceFormulaFieldBasis + (encodeThreeCNF formula).length + (srcFormula formula)).equivFun + (physicalShiftedSourceCorrectionField + formula row column inShifted) + (physicalInterpolationRowBasisIndex + row.val formula) = (1 : ZMod 2))))) : + physicalShiftedCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaOrdinaryBoundary formula ≤ + row.val) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))] := by + by_cases inShifted : + physicalFormulaOrdinaryBoundary formula ≤ row.val + · have bits := paperVariableArityPhysicalShiftedCheckBit_actualSourceBits + formula row column inShifted + have actual := correct inShifted + calc + physicalShiftedCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))] := + bits.trans (congrArg (fun bit : Bool => [bit]) actual.symm) + _ = _ := by simp only [inShifted, + decide_true, Bool.true_and] + · calc + physicalShiftedCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = [false] := + paperVariableArityPhysicalShiftedCheckBit_of_not_in_family + formula row.val column.val inShifted + _ = _ := by simp only [inShifted, decide_false, + Bool.false_and] + +/-- Internal support shared across GapCVP continuation modules. -/ +theorem paperVariableArityPhysicalShiftedCheckBit_valid + (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)) : + physicalShiftedCheckBit + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaOrdinaryBoundary formula ≤ + row.val) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))] := by + apply paperVariableArityPhysicalShiftedCheckBit_valid_of_binary + formula row column + intro inShifted + have correction : + physicalShiftedSourceCorrectionField + formula row column inShifted = + paperVariableArityPhysicalShiftedActualSourceCorrectionField + formula row column inShifted := by + rfl + rw [correction] + have ratio := + paperVariableArityPhysicalShiftedFiniteRowCanonicalBaseSourceWord_eq_decodedSourceRatio + formula row column inShifted + exact paperVariableArityPhysicalShiftedActualBinaryCheckBit_decide_of_sourceRatio + formula row column inShifted ratio + +end PhysicalOrdinaryShiftedCheckBitInstantiation + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part16B.lean b/LeanPool/GapCVP/Part16B.lean new file mode 100644 index 000000000..0b05b147c --- /dev/null +++ b/LeanPool/GapCVP/Part16B.lean @@ -0,0 +1,1688 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part16A + +/-! # GapCVP proof, part 16, continuation 02 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) + +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +open GapCVP.PhysicalInterpolationColumnSourceFieldCorrectness + +open GapCVP.PhysicalOrdinaryInterpolationParityFieldCorrectness + +open GapCVP.PhysicalShiftedSourceColumnGridProjection + +open GapCVP.PhysicalOrdinaryInterpolationBinaryCheckBitCorrectness + +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation + +open GapCVP.PhysicalShiftedInterpolationBinaryCheckBitCorrectness + +open GapCVP.PhysicalShiftedCanonicalRetainedClauseSourceCorrectness + +local notation "retainedClause_source" => + paperFormulaRetainedClause_retainedOriginal + +namespace PhysicalOrdinaryShiftedCheckBitInstantiation + +open GapCVP.Core GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows + +open GapCVP.BinaryFieldInverseAlgebra GapCVP.BinaryModularReductionTM + +open GapCVP.BinaryPhysicalLagrangeCoefficientTM GapCVP.FormulaBridge GapCVP.MatrixEntrySemantics + +open GapCVP.PhysicalColumnOrder GapCVP.PhysicalFamilyRowTM GapCVP.PhysicalFamilyMarkerTM + +open GapCVP.PhysicalInterpolationDirectMomentBitTM GapCVP.PhysicalInterpolationNodeCountBounds + +open GapCVP.PhysicalMaskedInterpolationNodeParityTM + +open GapCVP.PhysicalOrdinaryShiftedCoefficientSumTM GapCVP.PhysicalShiftedExpectedTypeRankTM + +open GapCVP.PhysicalShiftedInterpolationBinaryCheckBitCorrectness + +open GapCVP.PhysicalShiftedCanonicalInterpolationBaseSemanticCorrectness + +open GapCVP.PhysicalShiftedInterpolationBinaryHCoreCorrectness + +open GapCVP.PhysicalShiftedInterpolationBaseInstantiation + +open GapCVP.PhysicalShiftedInterpolationParityMaskedFieldCorrectness + +open GapCVP.PhysicalShiftedRowTupleRankBounds GapCVP.SourceFieldMomentOperationsTM + +open GapCVP.SourceOrder + +end PhysicalOrdinaryShiftedCheckBitInstantiation + +namespace Factor400BinaryConstructivePaperVariableArityPhysicalMatrixCellInstantiation + +open Turing GapCVP.BinaryEncoding GapCVP.BinaryExplicitAffineRows GapCVP.CanonicalMatrixShape +open GapCVP.MatrixEntrySemantics GapCVP.PhysicalColumnOrder GapCVP.PhysicalFamilyRowTM +open GapCVP.PhysicalGlobalCoefficientCorrectness GapCVP.PhysicalGlobalRefinementCoefficientTM +open GapCVP.PhysicalMatrixCellTM GapCVP.PhysicalOrdinaryShiftedCheckBitInstantiation +open GapCVP.PhysicalRefinementCheckSourceCorrectness GapCVP.PhysicalRefinementGuardAbsorption +open GapCVP.SourceOrder + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalPhysicalMatrixCellComputerOfGuardedFamilies + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (global refinement ordinary shifted : List Bool → List Bool) + (globalComputer : BitTM global) + (refinementComputer : BitTM refinement) + (ordinaryComputer : BitTM ordinary) + (shiftedComputer : BitTM shifted) + (correctGlobal : ∀ (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)), + global (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (row.val < physicalFormulaGlobalBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) + (correctRefinement : ∀ (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)), + refinement (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) + (correctOrdinary : ∀ (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)), + ordinary (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaRefinementBoundary formula ≤ + row.val ∧ + row.val < + physicalFormulaOrdinaryBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) + (correctShifted : ∀ (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)), + shifted (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaOrdinaryBoundary formula ≤ + row.val) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) : + PaperVariableArityCanonicalBinaryMatrixCellComputer shape := + paperVariableArityCanonicalPhysicalMatrixCellComputerOfCheck shape + (physicalMatrixGuardedFourFamilyCheck + global refinement ordinary shifted) + (paperVariableArityPhysicalMatrixGuardedFourFamilyCheckComputable + global refinement ordinary shifted globalComputer + refinementComputer ordinaryComputer shiftedComputer) + (fun formula row column => + paperVariableArityPhysicalMatrixGuardedFourFamilyCheck_valid + global refinement ordinary shifted formula row column + (correctGlobal formula row column) + (correctRefinement formula row column) + (correctOrdinary formula row column) + (correctShifted formula row column)) + +/-- GapCVP reduction support. -/ +noncomputable def + paperVariableArityCanonicalPhysicalMatrixCellComputerOfActualGlobal + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (refinement ordinary shifted : List Bool → List Bool) + (refinementComputer : BitTM refinement) + (ordinaryComputer : BitTM ordinary) + (shiftedComputer : BitTM shifted) + (correctRefinement : ∀ (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)), + refinement (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaGlobalBoundary formula ≤ row.val ∧ + row.val < + physicalFormulaRefinementBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) + (correctOrdinary : ∀ (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)), + ordinary (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaRefinementBoundary formula ≤ + row.val ∧ + row.val < + physicalFormulaOrdinaryBoundary formula) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) + (correctShifted : ∀ (formula : ThreeCNF) + (row : Fin (paperExplicitBinaryRowWordCount + (encodeThreeCNF formula).length formula)) + (column : Fin + (PaperVariableArityPhysicalWordDimension + (encodeThreeCNF formula).length formula)), + shifted (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + [decide + (physicalFormulaOrdinaryBoundary formula ≤ + row.val) && + decide + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column = (1 : ZMod 2))]) : + PaperVariableArityCanonicalBinaryMatrixCellComputer shape := + paperVariableArityCanonicalPhysicalMatrixCellComputerOfGuardedFamilies + shape physicalGlobalCheckBit + refinement ordinary shifted + paperVariableArityPhysicalGlobalCheckBitComputable + refinementComputer ordinaryComputer shiftedComputer + paperVariableArityPhysicalGlobalCheckBit_valid + correctRefinement correctOrdinary correctShifted + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityCanonicalPhysicalMatrixCellComputer + (shape : PaperVariableArityCanonicalBinaryMatrixShape) : + PaperVariableArityCanonicalBinaryMatrixCellComputer shape := + paperVariableArityCanonicalPhysicalMatrixCellComputerOfActualGlobal + shape + physicalRefinementCheckBit + physicalOrdinaryCheckBit + physicalShiftedCheckBit + paperVariableArityPhysicalRefinementCheckBitComputable + paperVariableArityPhysicalOrdinaryCheckBitComputable + paperVariableArityPhysicalShiftedCheckBitComputable + paperVariableArityPhysicalRefinementCheckBit_valid + paperVariableArityPhysicalOrdinaryCheckBit_valid + paperVariableArityPhysicalShiftedCheckBit_valid + +end Factor400BinaryConstructivePaperVariableArityPhysicalMatrixCellInstantiation + +namespace Factor400BinaryPaperVariableArityUnconditionalPhysicalSourceMachine + +open GapCVP.OriginalThreeSATNPHardness GapCVP.CanonicalPhysicalMatrixShape +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalMatrixCellInstantiation +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.ExactPhysicalSourceTM + +/-- GapCVP reduction support. -/ +noncomputable def HasIntegerTarget (record : GapCVPInstance) : Bool := + @decide ( + ∀ index : Fin record.dimension, ∃ value : ℤ, record.target index = (value : ℚ) + ) (Classical.propDecidable _) +/-- GapCVP reduction support. -/ +def integerTargetGapCVP400Promise : PromiseProblem where + yes bits := + @decide ( + ∃ record : GapCVPInstance, + (binaryFinEncoding GapCVPInstance).encode record = bits ∧ + HasIntegerTarget record ∧ gapYES400 record + ) (Classical.propDecidable _) + no bits := + @decide ( + ∃ record : GapCVPInstance, + (binaryFinEncoding GapCVPInstance).encode record = bits ∧ + HasIntegerTarget record ∧ gapNO400 record + ) (Classical.propDecidable _) + disjoint bits positive negative := by + simp only [decide_eq_true_eq] at positive negative + obtain ⟨first, hfirst, _, hyes⟩ := positive + obtain ⟨second, hsecond, _, hno⟩ := negative + have same := + (binaryFinEncoding GapCVPInstance).encode_injective + (hfirst.trans hsecond.symm) + subst second + exact gapYES400_not_gapNO400 first hyes hno + +private theorem paperVariableArityPhysicalFormulaInstance_hasIntegerTarget + (encodingLength : ℕ) (formula : ThreeCNF) : + HasIntegerTarget (physicalFormulaInstance encodingLength formula) := by + simp only [HasIntegerTarget, + decide_eq_true_eq] at * + exact fun index => ⟨(physicalFormulaSystem + encodingLength formula).effectiveAffineRepresentative index, rfl⟩ + +private theorem canonicalYesInstance_hasIntegerTarget : + HasIntegerTarget SourceMachineRouting.canonicalYesInstance := by + simp only [HasIntegerTarget, + decide_eq_true_eq] at * + exact fun _ => ⟨0, rfl⟩ + +private theorem adaptedCanonicalNoInstance_hasIntegerTarget : + HasIntegerTarget Factor400BinaryCanonicalNo.adaptedCanonicalNoInstance := by + simp only [HasIntegerTarget, + decide_eq_true_eq] at * + exact fun _ => ⟨1, rfl⟩ + +private theorem paperVariableArityPhysicalSourceInstance_hasIntegerTarget + (input : List Bool) : + HasIntegerTarget (physicalSourceInstance input) := by + classical + unfold physicalSourceInstance + split + · exact adaptedCanonicalNoInstance_hasIntegerTarget + · split + · split + · exact adaptedCanonicalNoInstance_hasIntegerTarget + · split + · split + · exact canonicalYesInstance_hasIntegerTarget + · split + · exact paperVariableArityPhysicalFormulaInstance_hasIntegerTarget _ _ + · exact adaptedCanonicalNoInstance_hasIntegerTarget + · exact adaptedCanonicalNoInstance_hasIntegerTarget + · exact adaptedCanonicalNoInstance_hasIntegerTarget + +@[irreducible] private def paperVariableArityPhysicalSourceMapMachine : + BitTM + paperVariableArityPhysicalSourceMap := + paperVariableArityPhysicalSourceMapMachineOfCell + (paperVariableArityCanonicalPhysicalMatrixCellComputer + paperCanonicalPhysicalMatrixShape) + +private def paperVariableArityPhysicalSourceReduction : + PromiseReduction paperOriginalThreeSATLanguage gapCVP400Promise := + paperVariableArityPhysicalSourceReductionOfMachine + paperVariableArityPhysicalSourceMapMachine + +private def paperVariableArityPhysicalIntegerTargetSourceReduction : + PromiseReduction paperOriginalThreeSATLanguage integerTargetGapCVP400Promise := by + let strengthen (input : List Bool) {property : GapCVPInstance → Prop} + (witness : ∃ record, (binaryFinEncoding GapCVPInstance).encode record = + paperVariableArityPhysicalSourceMap input ∧ property record) : + ∃ record, (binaryFinEncoding GapCVPInstance).encode record = + paperVariableArityPhysicalSourceMap input ∧ + HasIntegerTarget record ∧ property record := by + obtain ⟨record, encoding, holds⟩ := witness + cases (binaryFinEncoding GapCVPInstance).encode_injective (encoding.trans rfl) + exact ⟨_, encoding, + paperVariableArityPhysicalSourceInstance_hasIntegerTarget input, holds⟩ + exact ⟨paperVariableArityPhysicalSourceMap, + ⟨paperVariableArityPhysicalSourceMapMachine⟩, + fun input satisfiable => by + simp only [integerTargetGapCVP400Promise, decide_eq_true_eq] + apply strengthen input + have witness := + paperVariableArityPhysicalSourceReduction.completeness input satisfiable + simp only [GapCVP.gapCVP400Promise, decide_eq_true_eq] at witness + change ∃ record : GapCVPInstance, + (binaryFinEncoding GapCVPInstance).encode record = + paperVariableArityPhysicalSourceMap input ∧ gapYES400 record at witness + exact witness, + fun input unsatisfiable => by + simp only [integerTargetGapCVP400Promise, decide_eq_true_eq] + apply strengthen input + have witness := + paperVariableArityPhysicalSourceReduction.soundness input unsatisfiable + simp only [GapCVP.gapCVP400Promise, decide_eq_true_eq] at witness + change ∃ record : GapCVPInstance, + (binaryFinEncoding GapCVPInstance).encode record = + paperVariableArityPhysicalSourceMap input ∧ gapNO400 record at witness + exact witness⟩ + +theorem paperVariableArityPhysicalIntegerTargetNPHardPromise : + NPHardPromise integerTargetGapCVP400Promise := + nphardPromise_of_nphard_of_promiseReduction paperOriginalThreeSATIsNPHard + paperVariableArityPhysicalIntegerTargetSourceReduction + polynomialTimeClosedUnderComposition + +end Factor400BinaryPaperVariableArityUnconditionalPhysicalSourceMachine + +namespace Factor400BinaryDecodingPromiseHardness + +open scoped BigOperators + +open GapCVP.Factor400BinaryCodeDecodingCorollary GapCVP.Factor400BinaryDecodingPromiseReduction + +private theorem one_le_binaryCodeGapFactor {blockLength : ℕ} + (hblock : 0 < blockLength) : + 1 ≤ binaryCodeGapFactor blockLength := by + unfold binaryCodeGapFactor + apply Real.one_le_rpow + · exact_mod_cast hblock + · norm_num + +theorem encodeBinaryNearestCodewordInstance_injective : + Function.Injective encodeBinaryNearestCodewordInstance := by + intro left right heq + have hdecode := congrArg decodeBinaryNearestCodewordInstance heq + simpa only [decodeBinaryNearestCodewordInstance_encode, Option.some.injEq] using hdecode + +theorem encodeBinarySyndromeDecodingInstance_injective : + Function.Injective encodeBinarySyndromeDecodingInstance := by + intro left right heq + have hdecode := congrArg decodeBinarySyndromeDecodingInstance heq + simpa only [decodeBinarySyndromeDecodingInstance_encode, Option.some.injEq] using hdecode + +/-- GapCVP reduction support. -/ +noncomputable def binaryNearestCodewordPromise : GapCVP.PromiseProblem where + yes bits := + @decide ( + ∃ record : BinaryNearestCodewordInstance, + encodeBinaryNearestCodewordInstance record = bits ∧ + 0 < record.blockLength ∧ 0 < record.radius ∧ + ∃ coefficients : Fin record.generatorRank → ZMod 2, + hammingNorm + (binaryNearestTarget record - + binaryNearestCodeword record coefficients) ≤ record.radius + ) (Classical.propDecidable _) + no bits := + @decide ( + ∃ record : BinaryNearestCodewordInstance, + encodeBinaryNearestCodewordInstance record = bits ∧ + 0 < record.blockLength ∧ 0 < record.radius ∧ + ∀ coefficients : Fin record.generatorRank → ZMod 2, + binaryCodeGapFactor record.blockLength * + (record.radius : ℝ) < + (hammingNorm + (binaryNearestTarget record - + binaryNearestCodeword record coefficients) : ℝ) + ) (Classical.propDecidable _) + disjoint bits hyes hno := by + simp only [decide_eq_true_eq] at hyes hno + rcases hyes with ⟨first, hfirst, hblock, _, coefficients, hshort⟩ + rcases hno with ⟨second, hsecond, _, _, hfar⟩ + have heq : first = second := + encodeBinaryNearestCodewordInstance_injective + (hfirst.trans hsecond.symm) + subst second + have hfactor := one_le_binaryCodeGapFactor hblock + have hradius : (0 : ℝ) ≤ (first.radius : ℝ) := by positivity + have hshortReal : + (hammingNorm (binaryNearestTarget first - + binaryNearestCodeword first coefficients) : ℝ) ≤ + (first.radius : ℝ) := by + exact_mod_cast hshort + have hscale : + (first.radius : ℝ) ≤ + binaryCodeGapFactor first.blockLength * + (first.radius : ℝ) := by + nlinarith + linarith [hfar coefficients] + +/-- GapCVP reduction support. -/ +noncomputable def binarySyndromeDecodingPromise : GapCVP.PromiseProblem where + yes bits := + @decide ( + ∃ record : BinarySyndromeDecodingInstance, + encodeBinarySyndromeDecodingInstance record = bits ∧ + 0 < record.blockLength ∧ 0 < record.radius ∧ + ∃ word : Fin record.blockLength → ZMod 2, + binarySyndromeProduct record word = binarySyndromeTarget record ∧ + hammingNorm word ≤ record.radius + ) (Classical.propDecidable _) + no bits := + @decide ( + ∃ record : BinarySyndromeDecodingInstance, + encodeBinarySyndromeDecodingInstance record = bits ∧ + 0 < record.blockLength ∧ 0 < record.radius ∧ + (∃ word : Fin record.blockLength → ZMod 2, + binarySyndromeProduct record word = binarySyndromeTarget record) ∧ + ∀ word : Fin record.blockLength → ZMod 2, + binarySyndromeProduct record word = binarySyndromeTarget record → + binaryCodeGapFactor record.blockLength * + (record.radius : ℝ) < (hammingNorm word : ℝ) + ) (Classical.propDecidable _) + disjoint bits hyes hno := by + simp only [decide_eq_true_eq] at hyes hno + rcases hyes with ⟨first, hfirst, hblock, _, word, hsolve, hshort⟩ + rcases hno with ⟨second, hsecond, _, _, _, hfar⟩ + have heq : first = second := + encodeBinarySyndromeDecodingInstance_injective + (hfirst.trans hsecond.symm) + subst second + have hfactor := one_le_binaryCodeGapFactor hblock + have hradius : (0 : ℝ) ≤ (first.radius : ℝ) := by positivity + have hshortReal : (hammingNorm word : ℝ) ≤ (first.radius : ℝ) := by + exact_mod_cast hshort + have hscale : + (first.radius : ℝ) ≤ + binaryCodeGapFactor first.blockLength * + (first.radius : ℝ) := by + nlinarith + linarith [hfar word hsolve] + +theorem integerSquaredNorm_eq_hammingNorm_binaryResidue + {n : ℕ} (vector : Fin n → ℤ) + (hbinary : ∀ index, vector index = 0 ∨ vector index = 1) : + GapCVP.Core.integerSquaredNorm vector = + hammingNorm (GapCVP.Core.binaryResidue vector) := by + have hlift : + binaryWordLift (GapCVP.Core.binaryResidue vector) = vector := by + funext index + rcases hbinary index with hzero | hone + · simp only [binaryWordLift, Core.binaryResidue, hzero, Int.cast_zero, ZMod.val_zero, + CharP.cast_eq_zero] + · simp only [binaryWordLift, Core.binaryResidue, hone, Int.cast_one, ZMod.val_one, + Nat.cast_one] + calc + GapCVP.Core.integerSquaredNorm vector = + GapCVP.Core.integerSquaredNorm + (binaryWordLift (GapCVP.Core.binaryResidue vector)) := by + rw [hlift] + _ = hammingNorm (GapCVP.Core.binaryResidue vector) := + integerSquaredNorm_binaryWordLift + (GapCVP.Core.binaryResidue vector) + +/-- GapCVP reduction support. -/ +def canonicalBinaryNearestCodewordNo : BinaryNearestCodewordInstance where + blockLength := 2 + generatorRank := 0 + generator _ index := Fin.elim0 index + target _ := 1 + radius := 1 + +private abbrev canonicalBinarySyndromeNo : BinarySyndromeDecodingInstance where + checkCount := 2 + blockLength := 2 + parityCheck row column := if row = column then 1 else 0 + syndrome _ := 1 + radius := 1 + +private theorem binaryCodeGapFactor_two_lt_two : binaryCodeGapFactor 2 < 2 := by + unfold binaryCodeGapFactor + apply Real.rpow_lt_self_of_one_lt + · norm_num + · norm_num + +theorem canonicalBinaryNearestCodewordNo_mem : + binaryNearestCodewordPromise.no + (encodeBinaryNearestCodewordInstance + canonicalBinaryNearestCodewordNo) := by + simp only [GapCVP.Factor400BinaryDecodingPromiseHardness.binaryNearestCodewordPromise, + decide_eq_true_eq] + refine ⟨canonicalBinaryNearestCodewordNo, rfl, by decide, + by decide, ?_⟩ + intro coefficients + have hcode : + binaryNearestCodeword canonicalBinaryNearestCodewordNo + coefficients = 0 := by + funext index + simp only [binaryNearestCodeword, canonicalBinaryNearestCodewordNo, + Pi.zero_apply] + exact Finset.sum_eq_zero fun column _ => Fin.elim0 column + have hweight : + hammingNorm + (binaryNearestTarget canonicalBinaryNearestCodewordNo - + binaryNearestCodeword canonicalBinaryNearestCodewordNo + coefficients) = 2 := by + rw [hcode, sub_zero] + change hammingNorm (fun _ : Fin 2 => (1 : ZMod 2)) = 2 + norm_num [hammingNorm] + rw [hweight] + simpa only [canonicalBinaryNearestCodewordNo, Nat.cast_one, mul_one, Nat.cast_ofNat, gt_iff_lt] + using + binaryCodeGapFactor_two_lt_two + +private theorem canonicalBinarySyndromeNo_mem : + binarySyndromeDecodingPromise.no + (encodeBinarySyndromeDecodingInstance + canonicalBinarySyndromeNo) := by + simp only [GapCVP.Factor400BinaryDecodingPromiseHardness.binarySyndromeDecodingPromise, + decide_eq_true_eq] + refine ⟨canonicalBinarySyndromeNo, rfl, by decide, + by decide, ?_, ?_⟩ + · refine ⟨fun _ => 1, ?_⟩ + funext row + fin_cases row <;> + decide + intro word hsolution + have hword : word = (fun _ : Fin 2 => (1 : ZMod 2)) := by + funext row + have hrow := congrFun hsolution row + fin_cases row <;> + norm_num [binarySyndromeProduct, canonicalBinarySyndromeNo, + Fin.sum_univ_two, binarySyndromeTarget] at hrow ⊢ + all_goals assumption + subst word + convert binaryCodeGapFactor_two_lt_two using 1 <;> + norm_num [canonicalBinarySyndromeNo, hammingNorm] + +end Factor400BinaryDecodingPromiseHardness + +namespace PaperSyndromeInstance + +open GapCVP.Factor400BinaryCodeDecodingCorollary GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.Factor400BinaryDecodingPromiseHardness +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.FormulaBridge +open GapCVP.FourFamilySoundness GapCVP.PhysicalColumnOrder GapCVP.PhysicalWordSoundness + +private abbrev paperVariableAritySyndromeInstance + (encodingLength : ℕ) (formula : ThreeCNF) : + BinarySyndromeDecodingInstance := + let system := physicalWordBinarySystem + encodingLength formula + { checkCount := system.rowCount + blockLength := system.dimension + parityCheck := system.check + syndrome := system.rightHandSide + radius := paperVariableArityIntegerRadius encodingLength formula } + +private theorem paperVariableAritySyndromeInstance_completeness + (encodingLength : ℕ) (formula : ThreeCNF) + (satisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + binarySyndromeDecodingPromise.yes + (encodeBinarySyndromeDecodingInstance + (paperVariableAritySyndromeInstance encodingLength formula)) := by + simp only [GapCVP.Factor400BinaryDecodingPromiseHardness.binarySyndromeDecodingPromise, + decide_eq_true_eq] + let system := physicalWordBinarySystem + encodingLength formula + obtain ⟨vector, solution, binary, weight⟩ := + paperVariableArityPhysicalWordBinarySystem_oneHot_of_satisfiable + encodingLength formula satisfiable + refine ⟨paperVariableAritySyndromeInstance encodingLength formula, + rfl, ?_, ?_, GapCVP.Core.binaryResidue vector, ?_, ?_⟩ + · exact sourceFormulaDimension_pos encodingLength + (srcFormula formula) + · exact paperVariableArityIntegerRadius_pos encodingLength formula + · change system.check.mulVec (GapCVP.Core.binaryResidue vector) = + system.rightHandSide + simpa only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] using solution + · change hammingNorm (GapCVP.Core.binaryResidue vector) ≤ + paperVariableArityIntegerRadius encodingLength formula + rw [← integerSquaredNorm_eq_hammingNorm_binaryResidue + vector binary, weight] + +private theorem paperVariableAritySyndromeInstance_soundness + (encodingLength : ℕ) (formula : ThreeCNF) + (consistent : + (physicalWordBinarySystem + encodingLength formula).effectiveReducedConsistent = true) + (unsatisfiable : ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + binarySyndromeDecodingPromise.no + (encodeBinarySyndromeDecodingInstance + (paperVariableAritySyndromeInstance encodingLength formula)) := by + simp only [GapCVP.Factor400BinaryDecodingPromiseHardness.binarySyndromeDecodingPromise, + decide_eq_true_eq] + let system := physicalWordBinarySystem + encodingLength formula + refine ⟨paperVariableAritySyndromeInstance encodingLength formula, + rfl, ?_, ?_, ?_, ?_⟩ + · exact sourceFormulaDimension_pos encodingLength + (srcFormula formula) + · exact paperVariableArityIntegerRadius_pos encodingLength formula + · refine ⟨GapCVP.Core.binaryResidue system.effectiveAffineRepresentative, ?_⟩ + change system.check.mulVec + (GapCVP.Core.binaryResidue system.effectiveAffineRepresentative) = + system.rightHandSide + simpa only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] using + system.effectiveAffineRepresentative_solves consistent + · intro word solves + apply lt_of_not_ge + intro short + apply unsatisfiable + apply paperVariableArityPhysicalWordBinarySystem_satisfiable_of_scaled_hamming + encodingLength formula (binaryWordLift word) + · simp only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] + change system.check.mulVec + (GapCVP.Core.binaryResidue (binaryWordLift word)) = + system.rightHandSide + rw [binaryResidue_binaryWordLift] + funext row + have equation := congrFun solves row + change + (∑ column : Fin system.dimension, + system.check row column * word column) = + system.rightHandSide row + exact equation + · rw [integerSquaredNorm_binaryWordLift] + have factor_nonnegative : + 0 ≤ binaryCodeGapFactor system.dimension := by + unfold binaryCodeGapFactor + positivity + have radius_nonnegative : + (0 : ℝ) ≤ (paperVariableArityIntegerRadius + encodingLength formula : ℝ) := by + positivity + change (hammingNorm word : ℝ) ≤ + 2 * binaryCodeGapFactor system.dimension * + (paperVariableArityIntegerRadius encodingLength formula : ℝ) + change (hammingNorm word : ℝ) ≤ + binaryCodeGapFactor system.dimension * + (paperVariableArityIntegerRadius encodingLength formula : ℝ) + at short + linarith [mul_nonneg factor_nonnegative radius_nonnegative] + +end PaperSyndromeInstance + +namespace Factor400BinaryDecodingPhysicalWordSourceTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.Factor400BinaryDecodingPromiseReduction GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.OutputPolynomialCompositionClosure GapCVP.OutputBoundedDependentRecordFold +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceFourFamilyMarkerRotationTM GapCVP.GaussianPackedStateTargetAtomTM +open GapCVP.GaussianAdaptiveEliminationCorrectness GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianPhysicalWordReducedAtomTM GapCVP.Factor400BinaryEffectiveBasisSerializerTM + +private def compactPhysicalDecodingBinaryIntegerAtom : List Bool → List Bool := + markerConditionalOutput + (fun _ : List Bool => encodeAtomic (1 : ℤ)) + (encodeAtomic (0 : ℤ)) + +private noncomputable def compactPhysicalDecodingBinaryIntegerAtomComputable : + BitTM + compactPhysicalDecodingBinaryIntegerAtom := + markerConditionalComputable + (sourceFixedWordComputable (encodeAtomic (1 : ℤ))) + (encodeAtomic (0 : ℤ)) + +@[simp] private theorem compactPhysicalDecodingBinaryIntegerAtom_false + (suffix : List Bool) : + compactPhysicalDecodingBinaryIntegerAtom (false :: suffix) = + encodeAtomic (0 : ℤ) := by + rfl + +@[simp] private theorem compactPhysicalDecodingBinaryIntegerAtom_true + (suffix : List Bool) : + compactPhysicalDecodingBinaryIntegerAtom (true :: suffix) = + encodeAtomic (1 : ℤ) := by + rfl + +private theorem compactPhysicalDecodingBinaryIntegerAtom_zmod + (value : ZMod 2) : + compactPhysicalDecodingBinaryIntegerAtom + [decide (value = (1 : ZMod 2))] = + encodeAtomic (value.val : ℤ) := by + rcases binaryField_zero_or_one value with hzero | hone + · simp only [hzero, zero_ne_one, decide_false, compactPhysicalDecodingBinaryIntegerAtom_false, + ZMod.val_zero, + CharP.cast_eq_zero] + · subst value + change encodeAtomic (1 : ℤ) = + encodeAtomic (((1 : ZMod 2).val : ℕ) : ℤ) + rfl + +/-- GapCVP reduction support. -/ +def compactPhysicalDecodingBinaryBasisAtom : List Bool → List Bool := + markerConditionalOutput + (markerConditionalOutput + (fun _ : List Bool => encodeAtomic (0 : ℤ)) + (encodeAtomic (1 : ℤ))) + (encodeAtomic (0 : ℤ)) + +/-- GapCVP reduction support. -/ +noncomputable def compactPhysicalDecodingBinaryBasisAtomComputable : + BitTM + compactPhysicalDecodingBinaryBasisAtom := + markerConditionalComputable + (markerConditionalComputable + (sourceFixedWordComputable (encodeAtomic (0 : ℤ))) + (encodeAtomic (1 : ℤ))) + (encodeAtomic (0 : ℤ)) + +theorem compactPhysicalDecodingBinaryBasisAtom_effective + (system : GapCVP.Core.BinaryAffineSystem) + (row column : Fin system.dimension) : + compactPhysicalDecodingBinaryBasisAtom + (effectiveGaussianStateBasisTag + system.effectiveGaussianState row column) = + encodeAtomic + (((system.effectiveSquareBasisMatrix row column : ZMod 2).val : ℤ)) := by + unfold effectiveGaussianStateBasisTag + rw [effectiveGaussianStatePivotRow_effective, + effectiveGaussianStatePivotRow_effective] + cases hrow : system.effectivePivotRowOption row with + | none => + cases hcolumn : system.effectivePivotRowOption column with + | none => + by_cases hdiagonal : row = column + · simp only [compactPhysicalDecodingBinaryBasisAtom, markerConditionalOutput, hdiagonal, + ↓reduceIte, + Core.BinaryAffineSystem.effectiveSquareBasisMatrix, hcolumn, Int.cast_one, + binaryIntegerLift_one] + · simp only [compactPhysicalDecodingBinaryBasisAtom, markerConditionalOutput, hdiagonal, + ↓reduceIte, + Core.BinaryAffineSystem.effectiveSquareBasisMatrix, hrow, hcolumn, Int.cast_zero, + binaryIntegerLift_zero] + | some pivot => + simp only [compactPhysicalDecodingBinaryBasisAtom, markerConditionalOutput, + Core.BinaryAffineSystem.effectiveSquareBasisMatrix, hrow, hcolumn, Int.cast_zero, + binaryIntegerLift_zero] + | some pivot => + cases hcolumn : system.effectivePivotRowOption column with + | none => + rcases GapCVP.Core.effectiveBinary_eq_zero_or_one + (system.effectiveGaussianState.system.check pivot column) + with hzero | hone + · simp only [compactPhysicalDecodingBinaryBasisAtom, markerConditionalOutput, hzero, + zero_ne_one, decide_false, + Core.BinaryAffineSystem.effectiveSquareBasisMatrix, hrow, hcolumn, ZMod.val_zero, + CharP.cast_eq_zero, Int.cast_zero] + · have hentry : + system.effectiveSquareBasisMatrix row column = (1 : ℤ) := by + simp only [GapCVP.Core.BinaryAffineSystem.effectiveSquareBasisMatrix, + hrow, hcolumn, hone, ZMod.val_one, Nat.cast_one] + simp only [compactPhysicalDecodingBinaryBasisAtom, markerConditionalOutput, hone, + decide_true, hentry, + Int.cast_one, binaryIntegerLift_one] + | some other => + by_cases hdiagonal : row = column + · simp only [compactPhysicalDecodingBinaryBasisAtom, markerConditionalOutput, hdiagonal, + ↓reduceIte, + Core.BinaryAffineSystem.effectiveSquareBasisMatrix, hcolumn, Int.cast_ofNat, + binaryIntegerLift_two] + · simp only [compactPhysicalDecodingBinaryBasisAtom, markerConditionalOutput, hdiagonal, + ↓reduceIte, + Core.BinaryAffineSystem.effectiveSquareBasisMatrix, hrow, hcolumn, Int.cast_zero, + binaryIntegerLift_zero] + +private theorem compactPhysicalDecodingAtomic_injective + {α : Type} [Encodable α] : + Function.Injective (encodeAtomic (α := α)) := by + intro first second hequality + have hdecoded := congrArg + (readAtomic (α := α)) hequality + have hfirst : readAtomic (encodeAtomic first) = + some (first, ([] : List Bool)) := by + simpa only [List.append_nil] using (readAtomic_append first []) + have hsecond : readAtomic (encodeAtomic second) = + some (second, ([] : List Bool)) := by + simpa only [List.append_nil] using (readAtomic_append second []) + rw [hfirst, hsecond] at hdecoded + exact congrArg Prod.fst (Option.some.inj hdecoded) + +private theorem compactPhysicalDecodingBinaryIntegerAtom_of_rational + (input : List Bool) (value : ℤ) + (hatom : effectiveTargetPackedAtom input = + encodeAtomic (value : ℚ)) : + compactPhysicalDecodingBinaryIntegerAtom input = + encodeAtomic value := by + cases input with + | nil => + have hrational : (0 : ℚ) = (value : ℚ) := + compactPhysicalDecodingAtomic_injective + (by simpa only [effectiveTargetPackedAtom, markerConditionalOutput] using hatom) + have hinteger : value = 0 := by + exact_mod_cast hrational.symm + simp only [compactPhysicalDecodingBinaryIntegerAtom, markerConditionalOutput, hinteger] + | cons bit suffix => + cases bit with + | false => + have hrational : (0 : ℚ) = (value : ℚ) := + compactPhysicalDecodingAtomic_injective + (by simpa only [effectiveTargetPackedAtom, markerConditionalOutput] using hatom) + have hinteger : value = 0 := by + exact_mod_cast hrational.symm + simp only [compactPhysicalDecodingBinaryIntegerAtom_false, hinteger] + | true => + have hrational : (1 : ℚ) = (value : ℚ) := + compactPhysicalDecodingAtomic_injective + (by simpa only [effectiveTargetPackedAtom, markerConditionalOutput] using hatom) + have hinteger : value = 1 := by + exact_mod_cast hrational.symm + simp only [compactPhysicalDecodingBinaryIntegerAtom_true, hinteger] + +/-- GapCVP reduction support. -/ +def compactPhysicalDecodingGaussianIntegerTargetAtom : + List Bool → List Bool := + compactPhysicalDecodingBinaryIntegerAtom ∘ + gaussianPackedIndexedTargetBit + +/-- GapCVP reduction support. -/ +noncomputable def + compactPhysicalDecodingGaussianIntegerTargetAtomComputable : + BitTM + compactPhysicalDecodingGaussianIntegerTargetAtom := + GapCVP.TMComposition.computableInPolyTime + gaussianPackedIndexedTargetBitComputable + compactPhysicalDecodingBinaryIntegerAtomComputable + +theorem compactPhysicalDecodingGaussianIntegerTargetAtom_effective + (system : GapCVP.Core.BinaryAffineSystem) + (column : Fin system.dimension) + (source : List Bool) : + compactPhysicalDecodingGaussianIntegerTargetAtom + (gaussianPackedIndexedStateWord column.val + (effectiveGaussianPackedStateWord + system.effectiveGaussianState source)) = + encodeAtomic (system.effectiveAffineRepresentative column) := by + unfold compactPhysicalDecodingGaussianIntegerTargetAtom + rw [Function.comp_apply] + apply compactPhysicalDecodingBinaryIntegerAtom_of_rational + exact gaussianPackedIndexedTargetAtom_effective + system column source + +private def compactPhysicalDecodingBinaryIntegerAtomBound : ℕ := + max (encodeAtomic (0 : ℤ)).length + (encodeAtomic (1 : ℤ)).length + +private theorem compactPhysicalDecodingBinaryIntegerAtom_length_le + (input : List Bool) : + (compactPhysicalDecodingBinaryIntegerAtom input).length ≤ + compactPhysicalDecodingBinaryIntegerAtomBound := by + cases input with + | nil => + change (encodeAtomic (0 : ℤ)).length ≤ + max (encodeAtomic (0 : ℤ)).length + (encodeAtomic (1 : ℤ)).length + exact Nat.le_max_left _ _ + | cons bit suffix => + cases bit with + | false => + change (encodeAtomic (0 : ℤ)).length ≤ + max (encodeAtomic (0 : ℤ)).length + (encodeAtomic (1 : ℤ)).length + exact Nat.le_max_left _ _ + | true => + change (encodeAtomic (1 : ℤ)).length ≤ + max (encodeAtomic (0 : ℤ)).length + (encodeAtomic (1 : ℤ)).length + exact Nat.le_max_right _ _ + +private theorem compactPhysicalDecodingAtomicRotation_length_le + (marker : List Bool → List Bool) (bound : ℕ) + (hmarker : ∀ input : List Bool, (marker input).length ≤ bound) + (input : List Bool) : + (fourFamilyOriginalMarkerRotationOutput + marker input).length ≤ input.length + bound := by + rw [sourceFourFamilyOriginalMarkerRotationOutput_eq] + have hfield := sourceFourFamilyFirstFieldSuffix_length_le + (input ++ marker (firstFieldContents input)) + have hatom := hmarker (firstFieldContents input) + simp only [List.length_append] at hfield + omega + +private theorem compactPhysicalDecodingAtomicRotation_iterate_length_le + (marker : List Bool → List Bool) (bound : ℕ) + (hmarker : ∀ input : List Bool, (marker input).length ≤ bound) + (seed : List Bool) (stage : ℕ) : + (((fourFamilyOriginalMarkerRotationOutput + marker)^[stage]) seed).length ≤ + seed.length + stage * bound := by + induction stage with + | zero => + simp only [Function.iterate_zero, id_eq, zero_mul, add_zero, Std.le_refl] + | succ stage ih => + rw [Function.iterate_succ_apply'] + have hstep := compactPhysicalDecodingAtomicRotation_length_le + marker bound hmarker + (((fourFamilyOriginalMarkerRotationOutput + marker)^[stage]) seed) + simp only [Nat.succ_mul] + omega + +private theorem compactPhysicalDecodingAtomicRotation_polynomiallyBounded + (marker : List Bool → List Bool) (bound : ℕ) + (hmarker : ∀ input : List Bool, (marker input).length ≤ bound) : + PolynomiallyBoundedFoldStates + (fourFamilyOriginalMarkerRotationOutput marker) + (Polynomial.C (bound + 1) * Polynomial.X) := by + simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, + decide_eq_true_eq] at * + intro input count seed hparse stage hstage + have hseed := sourceAtomicFoldSeed_length_le + input count seed hparse + have hcount := parsedUnaryFold_count_le_length + input count seed hparse + have hiterate := + compactPhysicalDecodingAtomicRotation_iterate_length_le + marker bound hmarker seed stage + have hstageBound : stage ≤ input.length := + hstage.trans hcount + have hproduct : stage * bound ≤ input.length * bound := + Nat.mul_le_mul_right bound hstageBound + simp only [Polynomial.eval_mul, Polynomial.eval_C, + Polynomial.eval_X, Nat.add_mul, one_mul] + have hcommuted : stage * bound ≤ bound * input.length := by + simpa only [Nat.mul_comm] using hproduct + omega + +private noncomputable def compactPhysicalDecodingBoundedAtomicFoldComputable + {marker : List Bool → List Bool} (bound : ℕ) + (computer : BitTM marker) + (hmarker : ∀ input : List Bool, (marker input).length ≤ bound) : + BitTM + (boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput marker)) := + boundedDependentRecordFoldComputable + (sourceFourFamilyOriginalMarkerRotationComputable computer) + (Polynomial.C (bound + 1) * Polynomial.X) + (compactPhysicalDecodingAtomicRotation_polynomiallyBounded + marker bound hmarker) + +private theorem compactPhysicalDecodingEncodeFinValues_eq_flatMap + {α : Type} [Encodable α] + (count : ℕ) (values : Fin count → α) : + encodeFinValues count values = + (List.finRange count).flatMap + (fun index => encodeAtomic (values index)) := by + induction count with + | zero => + simp only [encodeFinValues, List.finRange_zero, List.flatMap_nil] + | succ count ih => + rw [List.finRange_succ] + simp only [List.flatMap_cons, List.flatMap_map] + change + encodeAtomic (values 0) ++ + encodeFinValues count (fun index => values index.succ) = + encodeAtomic (values 0) ++ + (List.finRange count).flatMap + (fun index => encodeAtomic (values index.succ)) + rw [ih] + +private theorem compactPhysicalDecodingEncodeMatrixRows_eq_flatMap + (rows columns : ℕ) (matrix : Fin rows → Fin columns → ℤ) : + encodeMatrixRows rows columns matrix = + (List.finRange rows).flatMap fun row => + (List.finRange columns).flatMap fun column => + encodeAtomic (matrix row column) := by + induction rows with + | zero => + simp only [encodeMatrixRows, List.finRange_zero, List.flatMap_nil] + | succ rows ih => + rw [List.finRange_succ] + simp only [List.flatMap_cons, List.flatMap_map] + change + encodeFinValues columns (matrix 0) ++ + encodeMatrixRows rows columns + (fun row => matrix row.succ) = + (List.finRange columns).flatMap + (fun column => encodeAtomic (matrix 0 column)) ++ + (List.finRange rows).flatMap + (fun row => (List.finRange columns).flatMap + (fun column => encodeAtomic (matrix row.succ column))) + rw [compactPhysicalDecodingEncodeFinValues_eq_flatMap, + ih] + +private def compactPhysicalDecodingFiveFieldOutput + (first second radius firstPayload secondPayload : + List Bool → List Bool) (input : List Bool) : List Bool := + first input ++ + (second input ++ + (radius input ++ (firstPayload input ++ secondPayload input))) + +private noncomputable def compactPhysicalDecodingFiveFieldComputable + {first second radius firstPayload secondPayload : + List Bool → List Bool} + (hfirst : BitTM first) + (hsecond : BitTM second) + (hradius : BitTM radius) + (hfirstPayload : BitTM firstPayload) + (hsecondPayload : BitTM secondPayload) : + BitTM + (compactPhysicalDecodingFiveFieldOutput + first second radius firstPayload secondPayload) := by + have hphysical := pointwiseAppendComputable hfirst + (pointwiseAppendComputable hsecond + (pointwiseAppendComputable hradius + (pointwiseAppendComputable + hfirstPayload hsecondPayload))) + exact hphysical + +end Factor400BinaryDecodingPhysicalWordSourceTM + +namespace PaperBinaryCodingTM + +open Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder +open GapCVP.CLStructuralAtomicNaturalWriter GapCVP.Factor400BinaryCodeDecodingCorollary +open GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.Factor400BinaryDecodingPhysicalWordSourceTM GapCVP.FormulaBridge +open GapCVP.FourFamilySoundness GapCVP.PhysicalColumnOrder GapCVP.CanonicalMatrixShape +open GapCVP.CanonicalPhysicalMatrixShape GapCVP.CanonicalSourceCatalogue +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalRadiusMachine +open GapCVP.PaperSyndromeInstance GapCVP.BinaryExplicitAffineRows +open GapCVP.BinaryPhysicalWordPackedMatrixTM GapCVP.SourceFourFamilyMarkerRotationTM +open GapCVP.OutputBoundedDependentRecordFold + +private def paperCodingCheckCountAtomic : List Bool → List Bool := + structuralAtomicNaturalWord ∘ + paperCanonicalPhysicalMatrixShape.rows + +private noncomputable def paperVariableArityCodingCheckCountAtomicComputable : + BitTM + paperCodingCheckCountAtomic := + GapCVP.TMComposition.computableInPolyTime + paperCanonicalPhysicalMatrixShape.rowsComputable + structuralAtomicNaturalWriterComputable + +private theorem paperVariableArityCodingCheckCountAtomic_valid + (formula : ThreeCNF) : + paperCodingCheckCountAtomic (encodeThreeCNF formula) = + encodeAtomic + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rowCount := by + unfold paperCodingCheckCountAtomic Function.comp + rw [paperVariableArityCanonicalPhysicalMatrixShape_rows_valid formula] + simp only [structuralAtomicNaturalWord, + List.length_replicate] + +/-- GapCVP reduction support. -/ +def paperCodingBlockLengthAtomic : List Bool → List Bool := + structuralAtomicNaturalWord ∘ + paperCanonicalPhysicalMatrixShape.columns + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityCodingBlockLengthAtomicComputable : + BitTM + paperCodingBlockLengthAtomic := + GapCVP.TMComposition.computableInPolyTime + paperCanonicalPhysicalMatrixShape.columnsComputable + structuralAtomicNaturalWriterComputable + +theorem paperVariableArityCodingBlockLengthAtomic_valid + (formula : ThreeCNF) : + paperCodingBlockLengthAtomic (encodeThreeCNF formula) = + encodeAtomic + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).dimension := by + unfold paperCodingBlockLengthAtomic Function.comp + rw [paperVariableArityCanonicalPhysicalMatrixShape_columns_valid formula] + simp only [structuralAtomicNaturalWord, List.length_replicate] + +/-- GapCVP reduction support. -/ +def paperCodingRadiusAtomic : List Bool → List Bool := + structuralAtomicNaturalWord ∘ physicalOneHotWeightUnary + +/-- GapCVP reduction support. -/ +noncomputable def paperVariableArityCodingRadiusAtomicComputable : + BitTM + paperCodingRadiusAtomic := + GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalOneHotWeightUnaryComputable + structuralAtomicNaturalWriterComputable + +theorem paperVariableArityCodingRadiusAtomic_valid + (formula : ThreeCNF) : + paperCodingRadiusAtomic (encodeThreeCNF formula) = + encodeAtomic + (paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula) := by + unfold paperCodingRadiusAtomic Function.comp + rw [paperVariableArityPhysicalOneHotWeightUnary_valid formula] + simp only [structuralAtomicNaturalWord, List.length_replicate] + unfold paperVariableArityIntegerRadius sourceBinaryDecodingRadius + rw [paperVariableAritySourceFormula_clauses_length] + +private def paperCodingCheckIntegerMarker + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + List Bool → List Bool := + compactPhysicalDecodingBinaryIntegerAtom ∘ + paperCanonicalBinaryMatrixCheckMarker worker + +private noncomputable def paperVariableArityCodingCheckIntegerMarkerComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + BitTM + (paperCodingCheckIntegerMarker worker) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixCheckMarkerComputable worker) + compactPhysicalDecodingBinaryIntegerAtomComputable + +private theorem paperVariableArityCodingCheckIntegerMarker_length_le + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (input : List Bool) : + (paperCodingCheckIntegerMarker worker input).length ≤ + compactPhysicalDecodingBinaryIntegerAtomBound := + compactPhysicalDecodingBinaryIntegerAtom_length_le + (paperCanonicalBinaryMatrixCheckMarker worker input) + +private theorem paperVariableArityCodingCheckIntegerMarker_valid + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (formula : ThreeCNF) + (row : Fin + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rowCount) + (column : Fin + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).dimension) : + paperCodingCheckIntegerMarker worker + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + encodeAtomic + (((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check + row column).val : ℤ) := by + unfold paperCodingCheckIntegerMarker + rw [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixCheckMarker_valid + worker formula row column] + exact compactPhysicalDecodingBinaryIntegerAtom_zmod + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).check row column) + +private def paperCodingRhsIntegerMarker + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + List Bool → List Bool := + compactPhysicalDecodingBinaryIntegerAtom ∘ + paperCanonicalBinaryMatrixRhsMarker worker + +private noncomputable def paperVariableArityCodingRhsIntegerMarkerComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + BitTM + (paperCodingRhsIntegerMarker worker) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixRhsMarkerComputable worker) + compactPhysicalDecodingBinaryIntegerAtomComputable + +private theorem paperVariableArityCodingRhsIntegerMarker_length_le + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (input : List Bool) : + (paperCodingRhsIntegerMarker worker input).length ≤ + compactPhysicalDecodingBinaryIntegerAtomBound := + compactPhysicalDecodingBinaryIntegerAtom_length_le + (paperCanonicalBinaryMatrixRhsMarker worker input) + +private theorem paperVariableArityCodingRhsIntegerMarker_valid + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (formula : ThreeCNF) + (row : Fin + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rowCount) + (column : Fin + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).dimension) : + paperCodingRhsIntegerMarker worker + (affineCellQuery row.val column.val + (encodeThreeCNF formula)) = + encodeAtomic + (((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rightHandSide + row).val : ℤ) := by + unfold paperCodingRhsIntegerMarker + rw [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixRhsMarker_valid + worker formula row column] + exact compactPhysicalDecodingBinaryIntegerAtom_zmod + ((physicalWordBinarySystem + (encodeThreeCNF formula).length formula).rightHandSide row) + +private def paperCodingCheckIntegerFold + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + List Bool → List Bool := + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + (paperCodingCheckIntegerMarker worker)) ∘ + paperCanonicalBinaryMatrixCheckFoldPreparation + paperCanonicalPhysicalMatrixShape + +private noncomputable def paperVariableArityCodingCheckIntegerFoldComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + BitTM + (paperCodingCheckIntegerFold worker) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixCheckFoldPreparationComputable + paperCanonicalPhysicalMatrixShape) + (compactPhysicalDecodingBoundedAtomicFoldComputable + compactPhysicalDecodingBinaryIntegerAtomBound + (paperVariableArityCodingCheckIntegerMarkerComputable worker) + (paperVariableArityCodingCheckIntegerMarker_length_le worker)) + +private def paperCodingRhsIntegerFold + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + List Bool → List Bool := + boundedRecordFoldOutput + (fourFamilyOriginalMarkerRotationOutput + (paperCodingRhsIntegerMarker worker)) ∘ + paperCanonicalBinaryMatrixRhsFoldPreparation + paperCanonicalPhysicalMatrixShape + +private noncomputable def paperVariableArityCodingRhsIntegerFoldComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + BitTM + (paperCodingRhsIntegerFold worker) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCanonicalBinaryMatrixRhsFoldPreparationComputable + paperCanonicalPhysicalMatrixShape) + (compactPhysicalDecodingBoundedAtomicFoldComputable + compactPhysicalDecodingBinaryIntegerAtomBound + (paperVariableArityCodingRhsIntegerMarkerComputable worker) + (paperVariableArityCodingRhsIntegerMarker_length_le worker)) + +private def paperCodingCheckIntegerPayload + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + List Bool → List Bool := + firstFieldSuffix ∘ paperCodingCheckIntegerFold worker + +private noncomputable def paperVariableArityCodingCheckIntegerPayloadComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + BitTM + (paperCodingCheckIntegerPayload worker) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCodingCheckIntegerFoldComputable worker) + firstFieldSuffixComputable + +private def paperCodingRhsIntegerPayload + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + List Bool → List Bool := + firstFieldSuffix ∘ paperCodingRhsIntegerFold worker + +private noncomputable def paperVariableArityCodingRhsIntegerPayloadComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + BitTM + (paperCodingRhsIntegerPayload worker) := + GapCVP.TMComposition.computableInPolyTime + (paperVariableArityCodingRhsIntegerFoldComputable worker) + firstFieldSuffixComputable + +private theorem paperVariableArityCodingCheckIntegerFold_valid + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (formula : ThreeCNF) : + paperCodingCheckIntegerFold worker + (encodeThreeCNF formula) = + lengthPrefixedWord (encodeThreeCNF formula) ++ + (paperCanonicalBinaryMatrixCheckQueries + paperCanonicalPhysicalMatrixShape formula).flatMap + (paperCodingCheckIntegerMarker worker) := by + unfold paperCodingCheckIntegerFold + simp only [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixCheckFoldPreparation_valid + paperCanonicalPhysicalMatrixShape formula] + unfold sourcePhysicalWordPackedQueryPreparation + simpa only [fourFamilyOriginalMarkerStream] using + boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries (paperCodingCheckIntegerMarker + worker) + (paperCanonicalBinaryMatrixCheckQueries paperCanonicalPhysicalMatrixShape formula) + (lengthPrefixedWord (encodeThreeCNF formula)) + +private theorem paperVariableArityCodingRhsIntegerFold_valid + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (formula : ThreeCNF) : + paperCodingRhsIntegerFold worker + (encodeThreeCNF formula) = + lengthPrefixedWord (encodeThreeCNF formula) ++ + (paperCanonicalBinaryMatrixRhsQueries + paperCanonicalPhysicalMatrixShape formula).flatMap + (paperCodingRhsIntegerMarker worker) := by + unfold paperCodingRhsIntegerFold + simp only [Function.comp_apply, + paperVariableArityCanonicalBinaryMatrixRhsFoldPreparation_valid + paperCanonicalPhysicalMatrixShape formula] + unfold sourcePhysicalWordPackedQueryPreparation + simpa only [fourFamilyOriginalMarkerStream] using + boundedRecordFoldOutput_sourceFourFamilyOriginalMarkerQueries (paperCodingRhsIntegerMarker + worker) + (paperCanonicalBinaryMatrixRhsQueries paperCanonicalPhysicalMatrixShape formula) + (lengthPrefixedWord (encodeThreeCNF formula)) + +private theorem paperVariableArityCodingCheckIntegerPayload_valid + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (formula : ThreeCNF) : + paperCodingCheckIntegerPayload worker + (encodeThreeCNF formula) = + encodeMatrixRows + (paperVariableAritySyndromeInstance + (encodeThreeCNF formula).length formula).checkCount + (paperVariableAritySyndromeInstance + (encodeThreeCNF formula).length formula).blockLength + (fun row column => (((paperVariableAritySyndromeInstance + (encodeThreeCNF formula).length formula).parityCheck row column).val : ℤ)) := by + unfold paperCodingCheckIntegerPayload + rw [Function.comp_apply, + paperVariableArityCodingCheckIntegerFold_valid worker formula, + firstFieldSuffix_valid] + simp only [paperVariableAritySyndromeInstance, + paperCanonicalPhysicalMatrixShape] + rw [compactPhysicalDecodingEncodeMatrixRows_eq_flatMap] + unfold paperCanonicalBinaryMatrixCheckQueries + simp only [List.flatMap_assoc, List.flatMap_map] + apply List.flatMap_congr + intro row _ + apply List.flatMap_congr + intro column _ + exact paperVariableArityCodingCheckIntegerMarker_valid + worker formula row column + +private theorem paperVariableArityCodingRhsIntegerPayload_valid + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (formula : ThreeCNF) : + paperCodingRhsIntegerPayload worker + (encodeThreeCNF formula) = + encodeFinValues + (paperVariableAritySyndromeInstance + (encodeThreeCNF formula).length formula).checkCount + (fun row => (((paperVariableAritySyndromeInstance + (encodeThreeCNF formula).length formula).syndrome row).val : ℤ)) := by + unfold paperCodingRhsIntegerPayload + rw [Function.comp_apply, + paperVariableArityCodingRhsIntegerFold_valid worker formula, + firstFieldSuffix_valid] + simp only [paperVariableAritySyndromeInstance, + paperCanonicalPhysicalMatrixShape] + rw [compactPhysicalDecodingEncodeFinValues_eq_flatMap] + unfold paperCanonicalBinaryMatrixRhsQueries + simp only [List.flatMap_map] + apply List.flatMap_congr + intro row _ + let column : Fin + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).dimension := + ⟨0, paperCanonicalPhysicalMatrixShape.columnsPositive + formula⟩ + simpa only [ZMod.natCast_val] using + paperVariableArityCodingRhsIntegerMarker_valid + worker formula row column + +private def paperSyndromeStructuralSourceWord + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + List Bool → List Bool := + compactPhysicalDecodingFiveFieldOutput + paperCodingCheckCountAtomic + paperCodingBlockLengthAtomic + paperCodingRadiusAtomic + (paperCodingRhsIntegerPayload worker) + (paperCodingCheckIntegerPayload worker) + +private noncomputable def paperVariableAritySyndromeStructuralSourceWordComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + BitTM + (paperSyndromeStructuralSourceWord worker) := + compactPhysicalDecodingFiveFieldComputable + paperVariableArityCodingCheckCountAtomicComputable + paperVariableArityCodingBlockLengthAtomicComputable + paperVariableArityCodingRadiusAtomicComputable + (paperVariableArityCodingRhsIntegerPayloadComputable worker) + (paperVariableArityCodingCheckIntegerPayloadComputable worker) + +private theorem paperVariableAritySyndromeStructuralSourceWord_valid + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (formula : ThreeCNF) : + paperSyndromeStructuralSourceWord worker + (encodeThreeCNF formula) = + encodeBinarySyndromeDecodingInstance + (paperVariableAritySyndromeInstance + (encodeThreeCNF formula).length formula) := by + unfold paperSyndromeStructuralSourceWord + compactPhysicalDecodingFiveFieldOutput + rw [paperVariableArityCodingCheckCountAtomic_valid formula, + paperVariableArityCodingBlockLengthAtomic_valid formula, + paperVariableArityCodingRadiusAtomic_valid formula, + paperVariableArityCodingRhsIntegerPayload_valid worker formula, + paperVariableArityCodingCheckIntegerPayload_valid worker formula] + simp only [paperVariableAritySyndromeInstance, + encodeBinarySyndromeDecodingInstance, + List.append_assoc] + +end PaperBinaryCodingTM + +namespace Factor400BinaryDecodingPhysicalWordUnconditionalSyndromeFinal + +open GapCVP.BinaryEncoding GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.Factor400BinaryDecodingPromiseHardness GapCVP.OriginalThreeSATNPHardness +open GapCVP.CanonicalPhysicalMatrixShape +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalMatrixCellInstantiation +open GapCVP.PhysicalColumnOrder +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.GaussianExactSourceInitializer GapCVP.GaussianSourceConsistencyBridge +open GapCVP.PaperBinaryCodingTM GapCVP.PaperSyndromeInstance +open GapCVP.OutputPolynomialCompositionClosure GapCVP.SourceWholeOutputAssemblyTM + +private def paperSyndromeRoutedSourceMap + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (input : List Bool) : List Bool := + if constructiveCanonicalSourceMarker input then + if binaryGaussianSourceConsistencyGuard + paperCanonicalSourceBinarySystem input then + paperSyndromeStructuralSourceWord worker input + else + encodeBinarySyndromeDecodingInstance canonicalBinarySyndromeNo + else + encodeBinarySyndromeDecodingInstance canonicalBinarySyndromeNo + +private noncomputable def paperVariableAritySyndromeRoutedSourceComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + BitTM + (paperSyndromeRoutedSourceMap worker) := by + have consistency := sourcePreservingConditionalComputable + (gaussianPaperVariableArityAllInputExactConsistencyComputable worker) + (paperVariableAritySyndromeStructuralSourceWordComputable worker) + (encodeBinarySyndromeDecodingInstance canonicalBinarySyndromeNo) + exact sourcePreservingConditionalComputable + constructiveCanonicalSourceMarkerComputable + consistency + (encodeBinarySyndromeDecodingInstance canonicalBinarySyndromeNo) + +private theorem paperVariableAritySyndromeRoutedSource_completeness + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (input : List Bool) + (membership : paperOriginalThreeSATLanguage input) : + binarySyndromeDecodingPromise.yes + (paperSyndromeRoutedSourceMap worker input) := by + obtain ⟨formula, encoding, satisfiable⟩ := + (GapCVP.OriginalThreeSATNPHardness.paperOriginalThreeSATLanguage_iff input).mp membership + subst input + have consistent := + physicalFormulaSystem_consistent_of_satisfiable + (encodeThreeCNF formula).length formula satisfiable + have selected : binaryGaussianSourceConsistencyGuard + paperCanonicalSourceBinarySystem + (encodeThreeCNF formula) = true := by + simpa only [binaryGaussianSourceConsistencyGuard, paperCanonicalSourceBinarySystem, + decodeThreeCNF_encode, + ↓reduceIte, Core.BinaryAffineSystem.effectiveReducedConsistent_iff, physicalFormulaSystem] + using consistent + simpa only [paperSyndromeRoutedSourceMap, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, ↓reduceIte, selected, paperVariableAritySyndromeStructuralSourceWord_valid] + using + paperVariableAritySyndromeInstance_completeness (encodeThreeCNF formula).length formula + satisfiable + +private theorem paperVariableAritySyndromeRoutedSource_soundness + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + (input : List Bool) + (nonmembership : ¬ paperOriginalThreeSATLanguage input) : + binarySyndromeDecodingPromise.no + (paperSyndromeRoutedSourceMap worker input) := by + cases decoded : decodeThreeCNF input with + | none => + simpa only [paperSyndromeRoutedSourceMap, constructiveCanonicalSourceMarker, decoded, + Bool.false_eq_true, + ↓reduceIte] using canonicalBinarySyndromeNo_mem + | some formula => + by_cases canonical : encodeThreeCNF formula = input + · subst input + have unsatisfiable : ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + intro satisfiable + exact nonmembership + ((GapCVP.OriginalThreeSATNPHardness.paperOriginalThreeSATLanguage_iff + (encodeThreeCNF formula)).mpr ⟨formula, rfl, satisfiable⟩) + cases consistent : + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).effectiveReducedConsistent with + | false => + simpa only [paperSyndromeRoutedSourceMap, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, ↓reduceIte, binaryGaussianSourceConsistencyGuard, + paperCanonicalSourceBinarySystem, consistent, + Bool.false_eq_true] using canonicalBinarySyndromeNo_mem + | true => + simpa only [paperSyndromeRoutedSourceMap, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, ↓reduceIte, binaryGaussianSourceConsistencyGuard, + paperCanonicalSourceBinarySystem, consistent, + paperVariableAritySyndromeStructuralSourceWord_valid] using + paperVariableAritySyndromeInstance_soundness (encodeThreeCNF formula).length + formula consistent unsatisfiable + · simpa only [paperSyndromeRoutedSourceMap, constructiveCanonicalSourceMarker, decoded, + canonical, decide_false, + Bool.false_eq_true, ↓reduceIte] using canonicalBinarySyndromeNo_mem + +private noncomputable def paperVariableAritySyndromeSourceReduction + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) : + PromiseReduction paperOriginalThreeSATLanguage + binarySyndromeDecodingPromise where + map := paperSyndromeRoutedSourceMap worker + polynomial_time := + ⟨paperVariableAritySyndromeRoutedSourceComputable worker⟩ + completeness := paperVariableAritySyndromeRoutedSource_completeness worker + soundness := paperVariableAritySyndromeRoutedSource_soundness worker + +theorem binarySyndromeDecoding_nphard_unconditional : + NPHardPromise binarySyndromeDecodingPromise := + nphardPromise_of_nphard_of_promiseReduction + paperOriginalThreeSATIsNPHard + (paperVariableAritySyndromeSourceReduction + (paperVariableArityCanonicalPhysicalMatrixCellComputer + paperCanonicalPhysicalMatrixShape)) + polynomialTimeClosedUnderComposition + +end Factor400BinaryDecodingPhysicalWordUnconditionalSyndromeFinal + +namespace Factor400FinitePNormPromiseReduction + +open scoped BigOperators + +open GapCVP.Factor400FinitePNormCorollary GapCVP.Factor400BinaryCodeDecodingCorollary +open GapCVP.Factor400BinaryInstanceBridge + +theorem finitePGapFactor_rpow (p : ℚ) (hp : 1 ≤ p) + (I : GapCVPInstance) : + finitePGapFactor p I ^ (p : ℝ) = + binaryCodeGapFactor I.dimension := by + have hp_pos : (0 : ℚ) < p := lt_of_lt_of_le (by norm_num) hp + have hp_real : (0 : ℝ) < (p : ℝ) := by exact_mod_cast hp_pos + unfold finitePGapFactor binaryCodeGapFactor + rw [← Real.rpow_mul (by exact_mod_cast (Nat.zero_le I.dimension))] + congr 1 + field_simp + +/-- GapCVP reduction support. -/ +abbrev finitePCanonicalNoInstance : GapCVPInstance where + dimension := 1 + basis := !![(2 : ℤ)] + target _ := 1 + radius := 1 / 2 + +private theorem finitePCanonicalNoInstance_wellFormed : + gapCVPWellFormed finitePCanonicalNoInstance := by + simp only [GapCVP.gapCVPWellFormed, decide_eq_true_eq] at * + refine ⟨by norm_num [finitePCanonicalNoInstance], ?_, + by norm_num [finitePCanonicalNoInstance]⟩ + rw [Matrix.det_fin_one_of] + norm_num + +private def finitePCanonicalCoordinate : + Fin finitePCanonicalNoInstance.dimension := + ⟨0, by norm_num [finitePCanonicalNoInstance]⟩ + +/-- GapCVP reduction support. -/ +def finitePCanonicalNoWord : List Bool := + (binaryFinEncoding GapCVPInstance).encode finitePCanonicalNoInstance + +private theorem finitePCanonicalNo_distance (p : ℚ) (hp : 1 ≤ p) + (z : Fin finitePCanonicalNoInstance.dimension → ℤ) : + finitePLatticeDistance p + finitePCanonicalNoInstance z = + |(1 : ℝ) - 2 * (z finitePCanonicalCoordinate : ℝ)| := by + have hp_pos : (0 : ℚ) < p := lt_of_lt_of_le (by norm_num) hp + have hp_real : (0 : ℝ) < (p : ℝ) := by exact_mod_cast hp_pos + simpa only [finitePLatticeDistance, finitePNorm, + finitePCanonicalNoInstance, Fin.sum_univ_one, + Fin.default_eq_zero, Fin.isValue, finitePLatticeDiscrepancy, + Matrix.of_apply, Matrix.cons_val_zero, Matrix.cons_val_fin_one, + Rat.cast_one, Int.cast_ofNat, abs_nonneg, + finitePCanonicalCoordinate, Fin.zero_eta] using + Real.rpow_rpow_inv (abs_nonneg ((1 : ℝ) - 2 * (z finitePCanonicalCoordinate : ℝ))) + hp_real.ne' + +theorem finitePCanonicalNo_mem_no (p : ℚ) (hp : 1 ≤ p) : + (finitePGapCVPPromise p hp).no + finitePCanonicalNoWord := by + simp only [GapCVP.Factor400FinitePNormCorollary.finitePGapCVPPromise, decide_eq_true_eq] + refine ⟨finitePCanonicalNoInstance, + rfl, finitePCanonicalNoInstance_wellFormed, ?_⟩ + intro z + rw [finitePCanonicalNo_distance p hp z] + have h := GapCVP.Core.odd_integer_distance_gt_half + (z finitePCanonicalCoordinate) + simpa only [finitePGapFactor, finitePCanonicalNoInstance, one_div, Nat.cast_one, mul_inv_rev, + Real.one_rpow, + Rat.cast_inv, Rat.cast_ofNat, one_mul, gt_iff_lt] using h + +/-- GapCVP reduction support. -/ +def effectiveFinitePSignedDiscrepancy + (H : GapCVP.Core.BinaryAffineSystem) + (coefficients : Fin H.dimension → ℤ) : Fin H.dimension → ℤ := + H.effectiveAffineRepresentative - + H.effectiveSquareBasisMatrix.mulVec coefficients + +theorem effectiveFinitePSignedDiscrepancy_solves + (H : GapCVP.Core.BinaryAffineSystem) + (hconsistent : H.effectiveReducedConsistent = true) + (coefficients : Fin H.dimension → ℤ) : + H.Solves (effectiveFinitePSignedDiscrepancy H coefficients) := by + unfold effectiveFinitePSignedDiscrepancy + apply (GapCVP.Core.effectiveConstructionAInstance_solution_coset + H hconsistent (H.effectiveSquareBasisMatrix.mulVec coefficients)).mpr + exact ⟨coefficients, rfl⟩ + +theorem finitePLatticeDistance_effective_eq_signed_norm + (p : ℚ) (H : GapCVP.Core.BinaryAffineSystem) + (hdimension : 0 < H.dimension) + (radius : ℚ) (hradius : 0 < radius) + (coefficients : Fin H.dimension → ℤ) : + finitePLatticeDistance p + (effectiveGapCVPInstance H hdimension radius hradius) + coefficients = + finitePNorm p fun i => + (effectiveFinitePSignedDiscrepancy H coefficients i : ℝ) := by + unfold finitePLatticeDistance + congr 1 + funext i + change + ((H.effectiveAffineRepresentative i : ℚ) : ℝ) - + (∑ j : Fin H.dimension, + (H.effectiveSquareBasisMatrix i j : ℝ) * + (coefficients j : ℝ)) = + ((H.effectiveAffineRepresentative i - + (H.effectiveSquareBasisMatrix.mulVec coefficients) i : ℤ) : ℝ) + simp only [Rat.cast_intCast, Matrix.mulVec, dotProduct, Int.cast_sub, Int.cast_sum, Int.cast_mul] + +end Factor400FinitePNormPromiseReduction + + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part17.lean b/LeanPool/GapCVP/Part17.lean new file mode 100644 index 000000000..5b2c01beb --- /dev/null +++ b/LeanPool/GapCVP/Part17.lean @@ -0,0 +1,2342 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part16 + +/-! # GapCVP proof, part 17 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace Factor400FinitePRadiusBounds + +open GapCVP.Factor400FinitePNormCorollary GapCVP.Factor400FinitePRadiusArithmetic + +private theorem finiteP_inv_mul_num (p : ℚ) (hp : 1 ≤ p) : + (p : ℝ)⁻¹ * (p.num.natAbs : ℝ) = (p.den : ℝ) := by + rw [finitePExponent_cast p hp, inv_div] + apply div_mul_cancel₀ + exact_mod_cast (finitePExponent_num_pos p hp).ne' + +private theorem finitePRadius_power_bound (p : ℚ) (hp : 1 ≤ p) (R : ℕ) : + (R : ℝ) ^ p.den ≤ + (finitePRadius p R : ℝ) ^ p.num.natAbs := by + have hscale : 0 < (finitePRadiusScale p : ℝ) := by + exact_mod_cast finitePRadiusScale_pos p hp + have hnatural := finitePRadiusNumerator_spec p hp R + have hreal : + (finitePRadiusScale p : ℝ) ^ p.num.natAbs * + (R : ℝ) ^ p.den ≤ + (finitePRadiusNumerator p R : ℝ) ^ p.num.natAbs := by + exact_mod_cast hnatural + rw [finitePRadius_cast, div_pow] + apply (le_div_iff₀ (pow_pos hscale _)).mpr + simpa only [mul_comm] using hreal + +private theorem finitePRadius_lower + (p : ℚ) (hp : 1 ≤ p) (R : ℕ) (hR : 0 < R) : + (R : ℝ) ^ ((p : ℝ)⁻¹) ≤ (finitePRadius p R : ℝ) := by + have hnum : 0 < (p.num.natAbs : ℝ) := by + exact_mod_cast finitePExponent_num_pos p hp + have hradius : 0 ≤ (finitePRadius p R : ℝ) := by + exact_mod_cast (finitePRadius_pos p hp R hR).le + calc + (R : ℝ) ^ ((p : ℝ)⁻¹) = + (R : ℝ) ^ + ((p.den : ℝ) * (p.num.natAbs : ℝ)⁻¹) := by + rw [finitePExponent_cast p hp, inv_div] + rfl + _ = ((R : ℝ) ^ p.den) ^ (p.num.natAbs : ℝ)⁻¹ := by + rw [Real.rpow_mul (by positivity), Real.rpow_natCast] + _ ≤ (finitePRadius p R : ℝ) := by + apply (Real.rpow_inv_le_iff_of_pos + (by positivity) hradius hnum).mpr + simpa only [Real.rpow_natCast] using + finitePRadius_power_bound p hp R + +private theorem finiteP_root_rpow_num (p : ℚ) (hp : 1 ≤ p) (R : ℕ) : + ((R : ℝ) ^ ((p : ℝ)⁻¹)) ^ p.num.natAbs = + (R : ℝ) ^ p.den := by + calc + ((R : ℝ) ^ ((p : ℝ)⁻¹)) ^ p.num.natAbs = + (R : ℝ) ^ + ((p : ℝ)⁻¹ * (p.num.natAbs : ℝ)) := + (Real.rpow_mul_natCast (by positivity) + ((p : ℝ)⁻¹) p.num.natAbs).symm + _ = (R : ℝ) ^ (p.den : ℝ) := by + rw [finiteP_inv_mul_num p hp] + _ = (R : ℝ) ^ p.den := Real.rpow_natCast _ _ + +private theorem finitePRadius_floor_le_scaled_root + (p : ℚ) (hp : 1 ≤ p) (R : ℕ) : + (Nat.nthRoot p.num.natAbs + (finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) : ℝ) ≤ + (finitePRadiusScale p : ℝ) * + (R : ℝ) ^ ((p : ℝ)⁻¹) := by + have hnum := finitePExponent_num_pos p hp + have hscale : 0 ≤ (finitePRadiusScale p : ℝ) := by positivity + have hfloor := Nat.pow_nthRoot_le + (a := finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) + (n := p.num.natAbs) (Or.inl hnum.ne') + have hreal : + (Nat.nthRoot p.num.natAbs + (finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) : ℝ) + ^ p.num.natAbs ≤ + (finitePRadiusScale p : ℝ) ^ p.num.natAbs * + (R : ℝ) ^ p.den := by + exact_mod_cast hfloor + apply (pow_le_pow_iff_left₀ (by positivity) + (mul_nonneg hscale (by positivity)) hnum.ne').mp + rw [mul_pow, finiteP_root_rpow_num p hp R] + exact hreal + +private theorem finitePRadius_le_root_add_inv + (p : ℚ) (hp : 1 ≤ p) (R : ℕ) : + (finitePRadius p R : ℝ) ≤ + (R : ℝ) ^ ((p : ℝ)⁻¹) + + (finitePRadiusScale p : ℝ)⁻¹ := by + have hscale : 0 < (finitePRadiusScale p : ℝ) := by + exact_mod_cast finitePRadiusScale_pos p hp + have hnumerator : + finitePRadiusNumerator p R ≤ + Nat.nthRoot p.num.natAbs + (finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) + 1 := + finitePCeilingRoot_le_nthRoot_add_one p.num.natAbs + (finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) + have hnumerator_real : + (finitePRadiusNumerator p R : ℝ) ≤ + (Nat.nthRoot p.num.natAbs + (finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) : ℝ) + 1 := by + exact_mod_cast hnumerator + rw [finitePRadius_cast] + apply (div_le_iff₀ hscale).mpr + calc + (finitePRadiusNumerator p R : ℝ) ≤ + (Nat.nthRoot p.num.natAbs + (finitePRadiusScale p ^ p.num.natAbs * R ^ p.den) : ℝ) + 1 := + hnumerator_real + _ ≤ (finitePRadiusScale p : ℝ) * + (R : ℝ) ^ ((p : ℝ)⁻¹) + 1 := by + linarith [finitePRadius_floor_le_scaled_root p hp R] + _ = ((R : ℝ) ^ ((p : ℝ)⁻¹) + + (finitePRadiusScale p : ℝ)⁻¹) * + (finitePRadiusScale p : ℝ) := by + field_simp + +private theorem finitePRadius_overhead_exponent_le_quarter + (p : ℚ) (hp : 1 ≤ p) : + (p : ℝ) * (finitePRadiusScale p : ℝ)⁻¹ ≤ (1 : ℝ) / 4 := by + have hscale : 0 < (finitePRadiusScale p : ℝ) := by + exact_mod_cast finitePRadiusScale_pos p hp + change (p : ℝ) / (finitePRadiusScale p : ℝ) ≤ (1 : ℝ) / 4 + apply (div_le_div_iff₀ hscale (by norm_num)).mpr + linarith [four_mul_le_finitePRadiusScale p] + +private theorem exp_quarter_lt_two : Real.exp ((1 : ℝ) / 4) < 2 := by + have hbound := Real.exp_lt_two_add_div_two_sub + (x := (1 : ℝ) / 4) (by norm_num) (by norm_num) + calc + Real.exp ((1 : ℝ) / 4) < + (2 + (1 : ℝ) / 4) / (2 - (1 : ℝ) / 4) := hbound + _ < 2 := by norm_num + +private theorem finitePRadius_overhead_rpow_lt_two + (p : ℚ) (hp : 1 ≤ p) : + (1 + (finitePRadiusScale p : ℝ)⁻¹) ^ (p : ℝ) < 2 := by + have hp_real : 0 < (p : ℝ) := by + have hp' : 0 < p := lt_of_lt_of_le (by norm_num) hp + exact_mod_cast hp' + have hscale : 0 < (finitePRadiusScale p : ℝ) := by + exact_mod_cast finitePRadiusScale_pos p hp + have hbase : 0 < 1 + (finitePRadiusScale p : ℝ)⁻¹ := by + positivity + have hlog : + Real.log (1 + (finitePRadiusScale p : ℝ)⁻¹) ≤ + (finitePRadiusScale p : ℝ)⁻¹ := by + simpa only [add_sub_cancel_left] using + Real.log_le_sub_one_of_pos hbase + have hexponent : + Real.log (1 + (finitePRadiusScale p : ℝ)⁻¹) * + (p : ℝ) ≤ (1 : ℝ) / 4 := by + calc + Real.log (1 + (finitePRadiusScale p : ℝ)⁻¹) * + (p : ℝ) ≤ + (finitePRadiusScale p : ℝ)⁻¹ * (p : ℝ) := + mul_le_mul_of_nonneg_right hlog hp_real.le + _ = (p : ℝ) * (finitePRadiusScale p : ℝ)⁻¹ := by ring + _ ≤ (1 : ℝ) / 4 := + finitePRadius_overhead_exponent_le_quarter p hp + calc + (1 + (finitePRadiusScale p : ℝ)⁻¹) ^ (p : ℝ) = + Real.exp + (Real.log (1 + (finitePRadiusScale p : ℝ)⁻¹) * + (p : ℝ)) := Real.rpow_def_of_pos hbase _ + _ ≤ Real.exp ((1 : ℝ) / 4) := Real.exp_le_exp.mpr hexponent + _ < 2 := exp_quarter_lt_two + +private theorem finitePRadius_le_scaled_root + (p : ℚ) (hp : 1 ≤ p) (R : ℕ) (hR : 0 < R) : + (finitePRadius p R : ℝ) ≤ + (R : ℝ) ^ ((p : ℝ)⁻¹) * + (1 + (finitePRadiusScale p : ℝ)⁻¹) := by + have hp_real : 0 < (p : ℝ) := by + have hp' : 0 < p := lt_of_lt_of_le (by norm_num) hp + exact_mod_cast hp' + have hR_one : (1 : ℝ) ≤ (R : ℝ) := by + exact_mod_cast hR + have hroot_one : 1 ≤ (R : ℝ) ^ ((p : ℝ)⁻¹) := + Real.one_le_rpow hR_one (inv_nonneg.mpr hp_real.le) + have hscale_inv : 0 ≤ (finitePRadiusScale p : ℝ)⁻¹ := by + positivity + calc + (finitePRadius p R : ℝ) ≤ + (R : ℝ) ^ ((p : ℝ)⁻¹) + + (finitePRadiusScale p : ℝ)⁻¹ := + finitePRadius_le_root_add_inv p hp R + _ ≤ (R : ℝ) ^ ((p : ℝ)⁻¹) * + (1 + (finitePRadiusScale p : ℝ)⁻¹) := by + linarith [mul_nonneg + (sub_nonneg.mpr hroot_one) hscale_inv] + +private theorem finitePRadius_rpow_lt_two_mul + (p : ℚ) (hp : 1 ≤ p) (R : ℕ) (hR : 0 < R) : + (finitePRadius p R : ℝ) ^ (p : ℝ) < 2 * (R : ℝ) := by + have hp_real : 0 < (p : ℝ) := by + have hp' : 0 < p := lt_of_lt_of_le (by norm_num) hp + exact_mod_cast hp' + have hR_real : 0 < (R : ℝ) := by exact_mod_cast hR + have hradius : 0 ≤ (finitePRadius p R : ℝ) := by + exact_mod_cast (finitePRadius_pos p hp R hR).le + have hscaled := finitePRadius_le_scaled_root p hp R hR + have hpower := Real.rpow_le_rpow hradius hscaled hp_real.le + rw [Real.mul_rpow (by positivity) (by positivity), + Real.rpow_inv_rpow (by positivity) hp_real.ne'] at hpower + calc + (finitePRadius p R : ℝ) ^ (p : ℝ) ≤ + (R : ℝ) * + (1 + (finitePRadiusScale p : ℝ)⁻¹) ^ (p : ℝ) := hpower + _ < 2 * (R : ℝ) := by + linarith [mul_lt_mul_of_pos_left + (finitePRadius_overhead_rpow_lt_two p hp) hR_real] + +end Factor400FinitePRadiusBounds + +namespace Factor400FinitePNormSourceReduction + +open scoped BigOperators + +open GapCVP.Factor400FinitePNormCorollary GapCVP.Factor400FinitePNormPromiseReduction +open GapCVP.Factor400BinaryCodeDecodingCorollary GapCVP.Factor400BinaryDecodingPromiseReduction + +private theorem finitePNorm_of_binary_squaredNorm + (p : ℚ) (hp : 1 ≤ p) {n R : ℕ} + (vector : Fin n → ℤ) + (hbinary : ∀ index, vector index = 0 ∨ vector index = 1) + (hweight : GapCVP.Core.integerSquaredNorm vector = R) : + finitePNorm p (fun index => (vector index : ℝ)) = + (R : ℝ) ^ ((p : ℝ)⁻¹) := by + have hp_pos : (0 : ℚ) < p := lt_of_lt_of_le (by norm_num) hp + have hp_real : (0 : ℝ) < (p : ℝ) := by exact_mod_cast hp_pos + unfold finitePNorm + congr 1 + rw [← hweight] + unfold GapCVP.Core.integerSquaredNorm + push_cast + apply Finset.sum_congr rfl + intro index _ + rcases hbinary index with hzero | hone + · simp only [hzero, Int.cast_zero, abs_zero, ne_eq, hp_real.ne', not_false_eq_true, + Real.zero_rpow, + Int.natAbs_zero, CharP.cast_eq_zero, OfNat.ofNat_ne_zero, zero_pow] + · simp only [hone, Int.cast_one, abs_one, Real.one_rpow, isUnit_one, Int.natAbs_of_isUnit, + Nat.cast_one, + one_pow] + +private theorem finiteP_power_sum_le_scaled_binary_radius + (p : ℚ) (hp : 1 ≤ p) + (I : GapCVPInstance) (R : ℕ) + (radius : ℚ) (hradius : 0 ≤ radius) + (hradius_power : + (radius : ℝ) ^ (p : ℝ) ≤ 2 * (R : ℝ)) + (vector : Fin I.dimension → ℤ) + (hshort : + finitePNorm p (fun index => (vector index : ℝ)) ≤ + finitePGapFactor p I * (radius : ℝ)) : + (∑ index : Fin I.dimension, + |(vector index : ℝ)| ^ (p : ℝ)) ≤ + 2 * binaryCodeGapFactor I.dimension * (R : ℝ) := by + have hp_pos : (0 : ℚ) < p := lt_of_lt_of_le (by norm_num) hp + have hp_real : (0 : ℝ) < (p : ℝ) := by exact_mod_cast hp_pos + have hradius_real : (0 : ℝ) ≤ (radius : ℝ) := by + exact_mod_cast hradius + have hfactor : 0 ≤ finitePGapFactor p I := by + unfold finitePGapFactor + positivity + have hgap : 0 ≤ binaryCodeGapFactor I.dimension := by + unfold binaryCodeGapFactor + positivity + calc + (∑ index : Fin I.dimension, + |(vector index : ℝ)| ^ (p : ℝ)) = + finitePNorm p (fun index => (vector index : ℝ)) ^ (p : ℝ) := + (finitePNorm_rpow p hp_pos _).symm + _ ≤ (finitePGapFactor p I * (radius : ℝ)) ^ (p : ℝ) := + Real.rpow_le_rpow + (finitePNorm_nonneg p _) hshort hp_real.le + _ = finitePGapFactor p I ^ (p : ℝ) * + (radius : ℝ) ^ (p : ℝ) := + Real.mul_rpow hfactor hradius_real + _ = binaryCodeGapFactor I.dimension * + (radius : ℝ) ^ (p : ℝ) := by + rw [finitePGapFactor_rpow p hp I] + _ ≤ binaryCodeGapFactor I.dimension * + (2 * (R : ℝ)) := + mul_le_mul_of_nonneg_left hradius_power hgap + _ = 2 * binaryCodeGapFactor I.dimension * (R : ℝ) := by ring + +private theorem finiteP_binaryLift_squaredNorm_le_power_sum + (p : ℚ) (hp : 1 ≤ p) + {n : ℕ} (vector : Fin n → ℤ) : + (GapCVP.Core.integerSquaredNorm + (binaryWordLift (GapCVP.Core.binaryResidue vector)) : ℝ) ≤ + ∑ index : Fin n, |(vector index : ℝ)| ^ (p : ℝ) := by + calc + (GapCVP.Core.integerSquaredNorm + (binaryWordLift (GapCVP.Core.binaryResidue vector)) : ℝ) = + (hammingNorm (GapCVP.Core.binaryResidue vector) : ℝ) := by + exact_mod_cast integerSquaredNorm_binaryWordLift + (GapCVP.Core.binaryResidue vector) + _ = ((finitePSignedBinarySupport vector).card : ℝ) := by + simp only [hammingNorm, Core.binaryResidue, ne_eq, + finitePSignedBinarySupport] + congr 1 + _ ≤ ∑ index : Fin n, |(vector index : ℝ)| ^ (p : ℝ) := + finitePSignedBinarySupport_card_le_power_sum p hp vector + +private theorem finiteP_binaryLift_solves + (H : GapCVP.Core.BinaryAffineSystem) + (vector : Fin H.dimension → ℤ) + (hsolve : H.Solves vector) : + H.Solves (binaryWordLift (GapCVP.Core.binaryResidue vector)) := by + simp only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] at hsolve ⊢ + simpa only [binaryResidue_binaryWordLift] using hsolve + +end Factor400FinitePNormSourceReduction + +namespace Factor400FinitePNormUnconditional + +open scoped BigOperators + +open GapCVP.Factor400FinitePNormCorollary + +private theorem finitePCompactCanonicalYes_mem + (p : ℚ) (hp : 1 ≤ p) : + (finitePGapCVPPromise p hp).yes + SourceMachineRouting.canonicalYesWord := by + simp only [GapCVP.Factor400FinitePNormCorollary.finitePGapCVPPromise, decide_eq_true_eq] + have hp_pos : (0 : ℚ) < p := lt_of_lt_of_le (by norm_num) hp + have hp_real : (0 : ℝ) < (p : ℝ) := by exact_mod_cast hp_pos + refine ⟨SourceMachineRouting.canonicalYesInstance, rfl, + SourceMachineRouting.canonicalYesInstance_wellFormed, ?_⟩ + refine ⟨fun _ => 0, ?_⟩ + simp only [finitePLatticeDistance, finitePNorm, SourceMachineRouting.canonicalYesInstance, + finitePLatticeDiscrepancy, Rat.cast_zero, + Int.cast_zero, mul_zero, + Finset.sum_const_zero, sub_self, abs_zero, ne_eq, hp_real.ne', not_false_eq_true, + Real.zero_rpow, + inv_ne_zero hp_real.ne', Rat.cast_one, zero_le_one] + +end Factor400FinitePNormUnconditional + +namespace PaperFinitePNormSourceReduction + +open scoped BigOperators + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.Factor400BinaryCodeDecodingCorollary +open GapCVP.Factor400BinaryInstanceBridge GapCVP.Factor400BinaryConstructiveSourcePlaces +open GapCVP.BinarySourceTautologyNormalizationExact GapCVP.OriginalThreeSATNPHardness +open GapCVP.SourcePreprocessingSemantics GapCVP.SourcePreprocessingTM GapCVP.FormulaBridge +open GapCVP.FourFamilySoundness GapCVP.NormalizedRecordDecoder GapCVP.PhysicalWordSoundness +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.Factor400FinitePNormCorollary GapCVP.Factor400FinitePNormPromiseReduction +open GapCVP.Factor400FinitePNormSourceReduction GapCVP.Factor400FinitePNormUnconditional +open GapCVP.Factor400FinitePRadiusArithmetic GapCVP.Factor400FinitePRadiusBounds + +private abbrev paperFinitePPhysicalSystem + (encodingLength : ℕ) (formula : ThreeCNF) : BinaryAffineSystem := + physicalFormulaSystem encodingLength formula + +private theorem paperVariableArityFinitePPhysicalSystem_dimension + (encodingLength : ℕ) (formula : ThreeCNF) : + (paperFinitePPhysicalSystem + encodingLength formula).dimension = + sourceFormulaDimension encodingLength + (srcFormula formula) := by + rfl + +private theorem paperVariableArityFinitePPhysicalSystem_dimension_pos + (encodingLength : ℕ) (formula : ThreeCNF) : + 0 < (paperFinitePPhysicalSystem + encodingLength formula).dimension := + physicalFormulaSystem_dimension_pos + encodingLength formula + +private def paperFinitePPhysicalFormulaInstance + (p : ℚ) (hp : 1 ≤ p) + (encodingLength : ℕ) (formula : ThreeCNF) : GapCVPInstance := + effectiveGapCVPInstance + (paperFinitePPhysicalSystem encodingLength formula) + (paperVariableArityFinitePPhysicalSystem_dimension_pos + encodingLength formula) + (finitePRadius p + (paperVariableArityIntegerRadius encodingLength formula)) + (finitePRadius_pos p hp + (paperVariableArityIntegerRadius encodingLength formula) + (paperVariableArityIntegerRadius_pos encodingLength formula)) + +private theorem paperVariableArityFinitePPhysicalFormulaInstance_wellFormed + (p : ℚ) (hp : 1 ≤ p) + (encodingLength : ℕ) (formula : ThreeCNF) : + gapCVPWellFormed + (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula) := by + unfold paperFinitePPhysicalFormulaInstance + exact effectiveGapCVPInstance_wellFormed _ _ _ _ + +private theorem paperVariableArityFinitePPhysicalSystem_oneHot_of_satisfiable + (encodingLength : ℕ) (formula : ThreeCNF) + (satisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + ∃ values : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ, + (paperFinitePPhysicalSystem + encodingLength formula).Solves values ∧ + (∀ index, values index = 0 ∨ values index = 1) ∧ + integerSquaredNorm values = + paperVariableArityIntegerRadius encodingLength formula := by + exact paperVariableArityPhysicalFormulaSystem_oneHot_of_satisfiable + encodingLength formula satisfiable + +theorem + paperVariableArityFinitePPhysicalSystem_satisfiable_of_scaled_hamming + (encodingLength : ℕ) (formula : ThreeCNF) + (values : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ) + (solution : (paperFinitePPhysicalSystem + encodingLength formula).Solves values) + (short : + (integerSquaredNorm values : ℝ) ≤ + 2 * binaryCodeGapFactor + (sourceFormulaDimension encodingLength + (srcFormula formula)) * + (paperVariableArityIntegerRadius + encodingLength formula : ℝ)) : + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + exact + paperVariableArityPhysicalWordBinarySystem_satisfiable_of_scaled_hamming + encodingLength formula values solution short + +theorem + paperVariableArityFinitePPhysicalSystem_satisfiable_of_finiteP_short + (p : ℚ) (hp : 1 ≤ p) + (encodingLength : ℕ) (formula : ThreeCNF) + (values : Fin + (sourceFormulaDimension encodingLength + (srcFormula formula)) → ℤ) + (solution : + (paperFinitePPhysicalSystem + encodingLength formula).Solves values) + (short : + finitePNorm p (fun index => (values index : ℝ)) ≤ + finitePGapFactor p + (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula) * + (finitePRadius p + (paperVariableArityIntegerRadius + encodingLength formula) : ℝ)) : + ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + let R := paperVariableArityIntegerRadius encodingLength formula + let radius := finitePRadius p R + let lifted := binaryWordLift (binaryResidue values) + have hR : 0 < R := + paperVariableArityIntegerRadius_pos encodingLength formula + have hradius : 0 < radius := finitePRadius_pos p hp R hR + have hradiusPower : (radius : ℝ) ^ (p : ℝ) ≤ 2 * (R : ℝ) := + (finitePRadius_rpow_lt_two_mul p hp R hR).le + apply + paperVariableArityFinitePPhysicalSystem_satisfiable_of_scaled_hamming + encodingLength formula lifted + · exact finiteP_binaryLift_solves + (paperFinitePPhysicalSystem + encodingLength formula) values solution + · calc + (integerSquaredNorm lifted : ℝ) ≤ + ∑ index, |(values index : ℝ)| ^ (p : ℝ) := + finiteP_binaryLift_squaredNorm_le_power_sum p hp values + _ ≤ 2 * binaryCodeGapFactor + (sourceFormulaDimension encodingLength + (srcFormula formula)) * (R : ℝ) := by + exact finiteP_power_sum_le_scaled_binary_radius + p hp (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula) + R radius hradius.le hradiusPower values short + +theorem + paperVariableArityFinitePPhysicalFormulaInstance_close_of_satisfiable + (p : ℚ) (hp : 1 ≤ p) + (encodingLength : ℕ) (formula : ThreeCNF) + (satisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + ∃ coefficients : Fin + (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula).dimension → ℤ, + finitePLatticeDistance p + (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula) coefficients ≤ + ((paperFinitePPhysicalFormulaInstance + p hp encodingLength formula).radius : ℝ) := by + let H := paperFinitePPhysicalSystem + encodingLength formula + let R := paperVariableArityIntegerRadius encodingLength formula + let radius := finitePRadius p R + have hR : 0 < R := + paperVariableArityIntegerRadius_pos encodingLength formula + have hradius : 0 < radius := finitePRadius_pos p hp R hR + have hdimension : 0 < H.dimension := + paperVariableArityFinitePPhysicalSystem_dimension_pos + encodingLength formula + obtain ⟨values, solution, binary, weight⟩ := + paperVariableArityFinitePPhysicalSystem_oneHot_of_satisfiable + encodingLength formula satisfiable + have hdimensions : + H.dimension = sourceFormulaDimension + encodingLength (srcFormula formula) := + paperVariableArityFinitePPhysicalSystem_dimension + encodingLength formula + let valuesH : Fin H.dimension → ℤ := + fun index => values ((finCongr hdimensions) index) + have solutionH : H.Solves valuesH := by + change (paperFinitePPhysicalSystem + encodingLength formula).Solves _ + have valuesEqual : valuesH = values := by + funext index + rfl + rw [valuesEqual] + exact solution + have binaryH : ∀ index, valuesH index = 0 ∨ valuesH index = 1 := by + intro index + exact binary ((finCongr hdimensions) index) + have normTransport : + integerSquaredNorm valuesH = integerSquaredNorm values := by + unfold integerSquaredNorm + simpa [valuesH] using + Equiv.sum_comp (finCongr hdimensions) + (fun index => (values index).natAbs ^ 2) + have weightH : integerSquaredNorm valuesH = R := + normTransport.trans weight + have consistent : H.effectiveReducedConsistent = true := + (BinaryAffineSystem.effectiveReducedConsistent_iff_solvable + H).mpr ⟨valuesH, solutionH⟩ + have coset : + H.Solves + (H.effectiveAffineRepresentative - + (H.effectiveAffineRepresentative - valuesH)) := by + simpa using solutionH + obtain ⟨coefficients, representation⟩ := + (effectiveConstructionAInstance_solution_coset + H consistent + (H.effectiveAffineRepresentative - valuesH)).mp coset + have discrepancy : + effectiveFinitePSignedDiscrepancy H coefficients = valuesH := by + unfold effectiveFinitePSignedDiscrepancy + rw [representation] + simp + have norm : + finitePNorm p (fun index => (valuesH index : ℝ)) = + (R : ℝ) ^ ((p : ℝ)⁻¹) := + finitePNorm_of_binary_squaredNorm p hp valuesH binaryH weightH + have distance : + finitePLatticeDistance p + (effectiveGapCVPInstance H hdimension radius hradius) + coefficients ≤ (radius : ℝ) := by + rw [finitePLatticeDistance_effective_eq_signed_norm, + discrepancy, norm] + exact finitePRadius_lower p hp R hR + refine ⟨coefficients, ?_⟩ + simpa [paperFinitePPhysicalFormulaInstance, + effectiveGapCVPInstance, adaptGapCVPInstance, + GapCVP.Core.effectiveConstructionAInstance, + H, R, radius] using distance + +theorem + paperVariableArityFinitePPhysicalFormulaInstance_far_of_unsatisfiable + (p : ℚ) (hp : 1 ≤ p) + (encodingLength : ℕ) (formula : ThreeCNF) + (consistent : + (paperFinitePPhysicalSystem + encodingLength formula).effectiveReducedConsistent = true) + (unsatisfiable : ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + ∀ coefficients : Fin + (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula).dimension → ℤ, + finitePGapFactor p + (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula) * + ((paperFinitePPhysicalFormulaInstance + p hp encodingLength formula).radius : ℝ) < + finitePLatticeDistance p + (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula) coefficients := by + let H := paperFinitePPhysicalSystem + encodingLength formula + let R := paperVariableArityIntegerRadius encodingLength formula + let radius := finitePRadius p R + have hR : 0 < R := + paperVariableArityIntegerRadius_pos encodingLength formula + have hradius : 0 < radius := finitePRadius_pos p hp R hR + have hdimension : 0 < H.dimension := + paperVariableArityFinitePPhysicalSystem_dimension_pos + encodingLength formula + intro coefficients + apply lt_of_not_ge + intro short + have norm : + finitePNorm p (fun index => + (effectiveFinitePSignedDiscrepancy H coefficients index : ℝ)) ≤ + finitePGapFactor p + (paperFinitePPhysicalFormulaInstance + p hp encodingLength formula) * (radius : ℝ) := by + have distance := finitePLatticeDistance_effective_eq_signed_norm + p H hdimension radius hradius coefficients + simpa only [paperFinitePPhysicalFormulaInstance, ge_iff_le] using (distance ▸ short) + apply unsatisfiable + apply paperVariableArityFinitePPhysicalSystem_satisfiable_of_finiteP_short + p hp encodingLength formula + (effectiveFinitePSignedDiscrepancy H coefficients) + · exact effectiveFinitePSignedDiscrepancy_solves + H consistent coefficients + · exact norm + +private def paperFinitePSourceInstance + (p : ℚ) (hp : 1 ≤ p) (input : List Bool) : GapCVPInstance := by + classical + exact + match decodeThreeCNF input with + | none => finitePCanonicalNoInstance + | some formula => + if encodeThreeCNF formula = input then + match readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput input) with + | none => finitePCanonicalNoInstance + | some descriptor => + if descriptor.originalWord = input then + if descriptor.normalizedClauses = [] then + SourceMachineRouting.canonicalYesInstance + else + if (paperFinitePPhysicalSystem + input.length descriptor.originalFormula).effectiveReducedConsistent then + paperFinitePPhysicalFormulaInstance + p hp input.length descriptor.originalFormula + else + finitePCanonicalNoInstance + else + finitePCanonicalNoInstance + else + finitePCanonicalNoInstance + +private def paperVariableArityFinitePSourceMap + (p : ℚ) (hp : 1 ≤ p) (input : List Bool) : List Bool := + encodeGapCVPInstance + (paperFinitePSourceInstance p hp input) + +private theorem paperVariableArityFinitePSourceInstance_of_decode_none + (p : ℚ) (hp : 1 ≤ p) + (input : List Bool) + (decode : decodeThreeCNF input = none) : + paperFinitePSourceInstance p hp input = + finitePCanonicalNoInstance := by + simp only [paperFinitePSourceInstance, decode] + +private theorem paperVariableArityFinitePSourceInstance_of_noncanonical + (p : ℚ) (hp : 1 ≤ p) + (input : List Bool) (formula : ThreeCNF) + (decode : decodeThreeCNF input = some formula) + (noncanonical : encodeThreeCNF formula ≠ input) : + paperFinitePSourceInstance p hp input = + finitePCanonicalNoInstance := by + simp only [paperFinitePSourceInstance, decode, noncanonical, ↓reduceIte] + +private theorem paperVariableArityFinitePSourceInstance_of_normalized_empty + (p : ℚ) (hp : 1 ≤ p) + (input : List Bool) (formula : ThreeCNF) + (decode : decodeThreeCNF input = some formula) + (canonical : encodeThreeCNF formula = input) + (empty : paperSourceNormalizedClauses formula = []) : + paperFinitePSourceInstance p hp input = + SourceMachineRouting.canonicalYesInstance := by + unfold paperFinitePSourceInstance + simp only [decode, ite_eq_left canonical] + have descriptor : + readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput input) = + some + { retainedFormula := noTautClauses formula + normalizedClauses := paperSourceNormalizedClauses formula + originalFormula := formula + originalWord := encodeThreeCNF formula } := by + rw [← canonical] + exact readPaperVariableArityNormalizedSourceDescriptor_valid formula + rw [descriptor] + simp only [canonical, ↓reduceIte, empty] + +private theorem paperVariableArityFinitePSourceInstance_of_inconsistent + (p : ℚ) (hp : 1 ≤ p) + (input : List Bool) (formula : ThreeCNF) + (decode : decodeThreeCNF input = some formula) + (canonical : encodeThreeCNF formula = input) + (nonempty : paperSourceNormalizedClauses formula ≠ []) + (inconsistent : + (paperFinitePPhysicalSystem + input.length formula).effectiveReducedConsistent = false) : + paperFinitePSourceInstance p hp input = + finitePCanonicalNoInstance := by + unfold paperFinitePSourceInstance + simp only [decode, ite_eq_left canonical] + have descriptor : + readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput input) = + some + { retainedFormula := noTautClauses formula + normalizedClauses := paperSourceNormalizedClauses formula + originalFormula := formula + originalWord := encodeThreeCNF formula } := by + rw [← canonical] + exact readPaperVariableArityNormalizedSourceDescriptor_valid formula + rw [descriptor] + simp only [canonical, ↓reduceIte, nonempty, inconsistent, Bool.false_eq_true] + +private theorem paperVariableArityFinitePSourceInstance_of_consistent + (p : ℚ) (hp : 1 ≤ p) + (input : List Bool) (formula : ThreeCNF) + (decode : decodeThreeCNF input = some formula) + (canonical : encodeThreeCNF formula = input) + (nonempty : paperSourceNormalizedClauses formula ≠ []) + (consistent : + (paperFinitePPhysicalSystem + input.length formula).effectiveReducedConsistent = true) : + paperFinitePSourceInstance p hp input = + paperFinitePPhysicalFormulaInstance + p hp input.length formula := by + unfold paperFinitePSourceInstance + simp only [decode, ite_eq_left canonical] + have descriptor : + readPaperVariableArityNormalizedSourceDescriptor + (paperSourcePreprocessingOutput input) = + some + { retainedFormula := noTautClauses formula + normalizedClauses := paperSourceNormalizedClauses formula + originalFormula := formula + originalWord := encodeThreeCNF formula } := by + rw [← canonical] + exact readPaperVariableArityNormalizedSourceDescriptor_valid formula + rw [descriptor] + simp only [canonical, ↓reduceIte, nonempty, consistent] + +private theorem paperVariableArityFinitePSourceMap_completeness + (p : ℚ) (hp : 1 ≤ p) + (input : List Bool) + (satisfiable : paperOriginalThreeSATLanguage input) : + (finitePGapCVPPromise p hp).yes + (paperVariableArityFinitePSourceMap p hp input) := by + obtain ⟨formula, canonical, assignment⟩ := + (paperOriginalThreeSATLanguage_iff input).mp satisfiable + have decode : decodeThreeCNF input = some formula := by + rw [← canonical] + exact decodeThreeCNF_encode formula + by_cases empty : paperSourceNormalizedClauses formula = [] + · unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_normalized_empty + p hp input formula decode canonical empty] + exact finitePCompactCanonicalYes_mem p hp + · obtain ⟨vector, solution, _, _⟩ := + paperVariableArityFinitePPhysicalSystem_oneHot_of_satisfiable + input.length formula assignment + have consistent : + (paperFinitePPhysicalSystem + input.length formula).effectiveReducedConsistent = true := + (BinaryAffineSystem.effectiveReducedConsistent_iff_solvable + (paperFinitePPhysicalSystem + input.length formula)).mpr ⟨vector, solution⟩ + simp only [GapCVP.Factor400FinitePNormCorollary.finitePGapCVPPromise, decide_eq_true_eq] + refine ⟨paperFinitePPhysicalFormulaInstance + p hp input.length formula, ?_, + paperVariableArityFinitePPhysicalFormulaInstance_wellFormed + p hp input.length formula, ?_⟩ + · unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_consistent + p hp input formula decode canonical empty consistent] + rfl + · exact + paperVariableArityFinitePPhysicalFormulaInstance_close_of_satisfiable + p hp input.length formula assignment + +private theorem paperVariableArityFinitePSourceMap_soundness + (p : ℚ) (hp : 1 ≤ p) + (input : List Bool) + (unsatisfiable : ¬ paperOriginalThreeSATLanguage input) : + (finitePGapCVPPromise p hp).no + (paperVariableArityFinitePSourceMap p hp input) := by + classical + cases decode : decodeThreeCNF input with + | none => + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_decode_none + p hp input decode] + exact finitePCanonicalNo_mem_no p hp + | some formula => + by_cases canonical : encodeThreeCNF formula = input + · by_cases empty : paperSourceNormalizedClauses formula = [] + · exfalso + apply unsatisfiable + apply (paperOriginalThreeSATLanguage_iff input).mpr + exact ⟨formula, canonical, + paperVariableArityOriginal_satisfiable_of_normalized_empty + formula empty⟩ + · cases consistent : + (paperFinitePPhysicalSystem + input.length formula).effectiveReducedConsistent with + | false => + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_inconsistent + p hp input formula decode canonical empty consistent] + exact finitePCanonicalNo_mem_no p hp + | true => + have originalUnsatisfiable : + ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, + clauseSatisfied assignment clause := by + intro assignment + apply unsatisfiable + exact (paperOriginalThreeSATLanguage_iff input).mpr + ⟨formula, canonical, assignment⟩ + simp only [GapCVP.Factor400FinitePNormCorollary.finitePGapCVPPromise, + decide_eq_true_eq] + refine ⟨paperFinitePPhysicalFormulaInstance + p hp input.length formula, ?_, + paperVariableArityFinitePPhysicalFormulaInstance_wellFormed + p hp input.length formula, ?_⟩ + · unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_consistent + p hp input formula decode canonical empty consistent] + rfl + · exact + paperVariableArityFinitePPhysicalFormulaInstance_far_of_unsatisfiable + p hp input.length formula consistent + originalUnsatisfiable + · unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_noncanonical + p hp input formula decode canonical] + exact finitePCanonicalNo_mem_no p hp + +private def paperVariableArityFinitePSourceReductionOfMachine + (p : ℚ) (hp : 1 ≤ p) + (machine : BitTM (paperVariableArityFinitePSourceMap p hp)) : + PromiseReduction paperOriginalThreeSATLanguage + (finitePGapCVPPromise p hp) where + map := paperVariableArityFinitePSourceMap p hp + polynomial_time := ⟨machine⟩ + completeness := paperVariableArityFinitePSourceMap_completeness p hp + soundness := paperVariableArityFinitePSourceMap_soundness p hp + +private theorem paperVariableArityFiniteP_nphard_of_sourceMachine + (p : ℚ) (hp : 1 ≤ p) + (machine : BitTM (paperVariableArityFinitePSourceMap p hp)) : + NPHardPromise (finitePGapCVPPromise p hp) := + nphardPromise_of_nphard_of_promiseReduction + paperOriginalThreeSATIsNPHard + (paperVariableArityFinitePSourceReductionOfMachine p hp machine) + polynomialTimeClosedUnderComposition + +end PaperFinitePNormSourceReduction + +namespace Factor400PaperVariableArityFinitePNormUnconditional + +open Turing GapCVP.BinaryEncoding GapCVP.CNFBoundedRecordFoldTM +open GapCVP.SourceCanonicalFixedWordTuringTM GapCVP.OutputPolynomialCompositionClosure +open GapCVP.SourceWholeOutputAssemblyTM GapCVP.Factor400BinaryCodeDecodingCorollary +open GapCVP.SourcePreprocessingSemantics GapCVP.FormulaBridge GapCVP.FourFamilySoundness +open GapCVP.CanonicalMatrixShape GapCVP.CanonicalPhysicalMatrixShape +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalMatrixCellInstantiation +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalRadiusMachine +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.PhysicalNormalizedBranchTM GapCVP.PhysicalNormalizedCanonicalGuardTM +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianSourceConsistencyBridge +open GapCVP.GaussianExactSourceInitializer GapCVP.GaussianSourceInitializerInstantiation +open GapCVP.GaussianOutputSerializerTM GapCVP.ExactPhysicalSourceTM +open GapCVP.Factor400FinitePNormCorollary GapCVP.Factor400FinitePNormPromiseReduction +open GapCVP.Factor400FinitePRadiusArithmetic GapCVP.Factor400FinitePRadiusSourceTM +open GapCVP.Factor400FinitePRadiusRationalAtomTM GapCVP.PaperFinitePNormSourceReduction + +private theorem paperVariableArityPhysicalOneHotWeightUnary_eq_integerRadius + (formula : ThreeCNF) : + physicalOneHotWeightUnary + (encodeThreeCNF formula) = + List.replicate + (paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula) true := by + rw [paperVariableArityPhysicalOneHotWeightUnary_valid] + unfold paperVariableArityIntegerRadius sourceBinaryDecodingRadius + rw [paperVariableAritySourceFormula_clauses_length] + +private def paperFinitePThresholdUnary (p : ℚ) + (input : List Bool) : List Bool := + List.replicate + (finitePRadiusScale p ^ p.num.natAbs * + (physicalOneHotWeightUnary input).length ^ p.den) + true + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityFinitePThresholdUnaryComputable (p : ℚ) : + BitTM + (paperFinitePThresholdUnary p) := by + have physical := GapCVP.TMComposition.computableInPolyTime + paperVariableArityPhysicalOneHotWeightUnaryComputable + (polynomialValueUnaryComputable + (Polynomial.C (finitePRadiusScale p ^ p.num.natAbs) * + Polynomial.X ^ p.den)) + change BitTM + (fun input : List Bool => + List.replicate + (finitePRadiusScale p ^ p.num.natAbs * + (physicalOneHotWeightUnary input).length ^ p.den) + true) + simpa only [eq_natCast, Nat.cast_pow, Polynomial.eval_mul, Polynomial.eval_pow, + Polynomial.eval_natCast, + Nat.cast_id, Polynomial.eval_X, Function.comp_def] using physical + +private theorem paperVariableArityFinitePThresholdUnary_valid + (p : ℚ) (formula : ThreeCNF) : + paperFinitePThresholdUnary p + (encodeThreeCNF formula) = + List.replicate + (finitePRadiusScale p ^ p.num.natAbs * + paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula ^ p.den) + true := by + unfold paperFinitePThresholdUnary + rw [paperVariableArityPhysicalOneHotWeightUnary_eq_integerRadius formula] + simp only [List.length_replicate] + +private def paperFinitePNumeratorUnary (p : ℚ) : + List Bool → List Bool := + finitePNthRootUnaryOutput p.num.natAbs + (paperFinitePThresholdUnary p) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityFinitePNumeratorUnaryComputable (p : ℚ) : + BitTM + (paperFinitePNumeratorUnary p) := + finitePNthRootUnaryComputable p.num.natAbs + (paperVariableArityFinitePThresholdUnaryComputable p) + +private theorem paperVariableArityFinitePNumeratorUnary_valid + (p : ℚ) (hp : 1 ≤ p) (formula : ThreeCNF) : + paperFinitePNumeratorUnary p + (encodeThreeCNF formula) = + List.replicate + (finitePRadiusNumerator p + (paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula)) true := by + unfold paperFinitePNumeratorUnary + exact finitePNthRootUnaryOutput_valid p.num.natAbs + (finitePExponent_num_pos p hp) + (paperFinitePThresholdUnary p) + (encodeThreeCNF formula) + (finitePRadiusScale p ^ p.num.natAbs * + paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula ^ p.den) + (paperVariableArityFinitePThresholdUnary_valid p formula) + +private def paperVariableArityFinitePRadiusAtomicOutput (p : ℚ) : + List Bool → List Bool := + sourceReducedRationalAtomicOutput + (finitePRadiusScale p) (paperFinitePNumeratorUnary p) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityFinitePRadiusAtomicComputable (p : ℚ) : + BitTM + (paperVariableArityFinitePRadiusAtomicOutput p) := + sourceReducedRationalAtomicComputable + (finitePRadiusScale p) + (paperVariableArityFinitePNumeratorUnaryComputable p) + +private theorem paperVariableArityFinitePRadiusAtomicOutput_valid + (p : ℚ) (hp : 1 ≤ p) (formula : ThreeCNF) : + paperVariableArityFinitePRadiusAtomicOutput p + (encodeThreeCNF formula) = + encodeAtomic + (finitePRadius p + (paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula)) := by + unfold paperVariableArityFinitePRadiusAtomicOutput + have physical := sourceReducedRationalAtomicOutput_valid + (finitePRadiusScale p) + (paperFinitePNumeratorUnary p) + (encodeThreeCNF formula) + (finitePRadiusNumerator p + (paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula)) + (finitePRadiusScale_pos p hp) + (paperVariableArityFinitePNumeratorUnary_valid p hp formula) + simpa only [finitePRadius] using physical + +private noncomputable def paperFinitePPhysicalStructuralOutput + (p : ℚ) {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + List Bool → List Bool := + paperGaussianStructuralSourceWord shape + (paperVariableArityFinitePRadiusAtomicComputable p) + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell) + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityFinitePPhysicalStructuralOutputComputable + (p : ℚ) {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperFinitePPhysicalStructuralOutput p cell) := + paperVariableArityGaussianStructuralSourceWordComputable shape + (paperVariableArityFinitePRadiusAtomicComputable p) + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell) + +private theorem paperVariableArityFinitePPhysicalStructuralOutput_valid + (p : ℚ) (hp : 1 ≤ p) + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperFinitePPhysicalStructuralOutput p cell + (encodeThreeCNF formula) = + encodeGapCVPInstance + (paperFinitePPhysicalFormulaInstance p hp + (encodeThreeCNF formula).length formula) := by + unfold paperFinitePPhysicalStructuralOutput + have physical := + paperVariableArityGaussianStructuralSourceWord_eq_encodeGapCVPInstance + shape + (paperVariableArityFinitePRadiusAtomicComputable p) + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell) + formula + (finitePRadius p + (paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula)) + (finitePRadius_pos p hp + (paperVariableArityIntegerRadius + (encodeThreeCNF formula).length formula) + (paperVariableArityIntegerRadius_pos + (encodeThreeCNF formula).length formula)) + (paperVariableArityFinitePRadiusAtomicOutput_valid p hp formula) + (gaussianPaperVariableArityCanonicalSourceReducedStateOutput_effective + cell formula) + simpa only [paperFinitePPhysicalFormulaInstance, paperFinitePPhysicalSystem] using physical + +private def paperFinitePPhysicalRoutedOutput + (p : ℚ) {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : List Bool := + if physicalCanonicalNormalizedEmptyGuard input then + SourceMachineRouting.canonicalYesWord + else if physicalCanonicalNormalizedNonemptyGuard input then + if binaryGaussianSourceConsistencyGuard + paperCanonicalSourceBinarySystem input then + paperFinitePPhysicalStructuralOutput p cell input + else + finitePCanonicalNoWord + else + finitePCanonicalNoWord + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityFinitePPhysicalRoutedOutputComputable + (p : ℚ) {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperFinitePPhysicalRoutedOutput p cell) := by + have consistency := sourcePreservingConditionalComputable + (gaussianPaperVariableArityAllInputExactConsistencyComputable cell) + (paperVariableArityFinitePPhysicalStructuralOutputComputable p cell) + finitePCanonicalNoWord + have nonempty := sourcePreservingConditionalComputable + paperVariableArityPhysicalCanonicalNormalizedNonemptyGuardComputable + consistency finitePCanonicalNoWord + exact binaryGaussianDynamicBranchComputable + paperVariableArityPhysicalCanonicalNormalizedEmptyGuardComputable + (sourceFixedWordComputable SourceMachineRouting.canonicalYesWord) + nonempty + +private theorem paperVariableArityFinitePPhysicalRoutedOutput_eq_sourceMap + (p : ℚ) (hp : 1 ≤ p) + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : + paperFinitePPhysicalRoutedOutput p cell input = + paperVariableArityFinitePSourceMap p hp input := by + cases decoded : decodeThreeCNF input with + | none => + have canonical : constructiveCanonicalSourceMarker input = false := by + simp only [constructiveCanonicalSourceMarker, decoded] + have empty : + physicalCanonicalNormalizedEmptyGuard input = + false := by + simp only [physicalCanonicalNormalizedEmptyGuard, canonical, Bool.false_and] + have nonempty : + physicalCanonicalNormalizedNonemptyGuard input = + false := by + simp only [physicalCanonicalNormalizedNonemptyGuard, canonical, Bool.false_and] + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_decode_none + p hp input decoded] + simp only [paperFinitePPhysicalRoutedOutput, + empty, Bool.false_eq_true, ↓reduceIte, nonempty] + rfl + | some formula => + by_cases canonical : encodeThreeCNF formula = input + · subst input + by_cases empty : + paperSourceNormalizedClauses formula = [] + · have emptyGuard : + physicalCanonicalNormalizedEmptyGuard + (encodeThreeCNF formula) = true := by + simp only [physicalCanonicalNormalizedEmptyGuard, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, physicalNormalizedEmptyMarker, + paperVariableArityPhysicalNormalizedNonemptyMarker_valid, empty, ne_eq, + not_true_eq_false, decide_false, Bool.not_false, Bool.and_self] + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_normalized_empty + p hp (encodeThreeCNF formula) formula (by simp only [decodeThreeCNF_encode]) rfl empty] + simp only [paperFinitePPhysicalRoutedOutput, + emptyGuard, ↓reduceIte] + rfl + · have emptyGuard : + physicalCanonicalNormalizedEmptyGuard + (encodeThreeCNF formula) = false := by + simp only [physicalCanonicalNormalizedEmptyGuard, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, physicalNormalizedEmptyMarker, + paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, empty, + not_false_eq_true, Bool.not_true, Bool.and_false] + have nonemptyGuard : + physicalCanonicalNormalizedNonemptyGuard + (encodeThreeCNF formula) = true := by + simp only [physicalCanonicalNormalizedNonemptyGuard, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, + empty, not_false_eq_true, + Bool.and_self] + cases consistent : + (physicalFormulaSystem + (encodeThreeCNF formula).length + formula).effectiveReducedConsistent with + | false => + have finitePInconsistent : + (paperFinitePPhysicalSystem + (encodeThreeCNF formula).length + formula).effectiveReducedConsistent = false := by + simpa only [paperFinitePPhysicalSystem] using consistent + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_inconsistent + p hp (encodeThreeCNF formula) formula + (by simp only [decodeThreeCNF_encode]) rfl empty finitePInconsistent] + simp only [paperFinitePPhysicalRoutedOutput, + emptyGuard, Bool.false_eq_true, ↓reduceIte, + nonemptyGuard, + paperVariableArityExactPhysicalConsistencyGuard_encode, + consistent] + rfl + | true => + have finitePConsistent : + (paperFinitePPhysicalSystem + (encodeThreeCNF formula).length + formula).effectiveReducedConsistent = true := by + simpa only [paperFinitePPhysicalSystem, + Core.BinaryAffineSystem.effectiveReducedConsistent_iff] using + consistent + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_consistent + p hp (encodeThreeCNF formula) formula + (by simp only [decodeThreeCNF_encode]) rfl empty finitePConsistent] + simp only [paperFinitePPhysicalRoutedOutput, + emptyGuard, Bool.false_eq_true, ↓reduceIte, + nonemptyGuard, + paperVariableArityExactPhysicalConsistencyGuard_encode, + consistent] + exact paperVariableArityFinitePPhysicalStructuralOutput_valid + p hp cell formula + · have sourceGuard : + constructiveCanonicalSourceMarker input = false := by + simp only [constructiveCanonicalSourceMarker, decoded, canonical, decide_false] + have emptyGuard : + physicalCanonicalNormalizedEmptyGuard input = + false := by + simp only [physicalCanonicalNormalizedEmptyGuard, sourceGuard, Bool.false_and] + have nonemptyGuard : + physicalCanonicalNormalizedNonemptyGuard input = + false := by + simp only [physicalCanonicalNormalizedNonemptyGuard, sourceGuard, Bool.false_and] + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_noncanonical + p hp input formula decoded canonical] + simp only [paperFinitePPhysicalRoutedOutput, + emptyGuard, Bool.false_eq_true, ↓reduceIte, nonemptyGuard] + rfl + +@[irreducible] private noncomputable def paperVariableArityFinitePSourceMapMachine + (p : ℚ) (hp : 1 ≤ p) : + BitTM + (paperVariableArityFinitePSourceMap p hp) := by + let shape := paperCanonicalPhysicalMatrixShape + let cell := paperVariableArityCanonicalPhysicalMatrixCellComputer shape + have machine := + paperVariableArityFinitePPhysicalRoutedOutputComputable p cell + have equality : + paperFinitePPhysicalRoutedOutput p cell = + paperVariableArityFinitePSourceMap p hp := + funext (paperVariableArityFinitePPhysicalRoutedOutput_eq_sourceMap + p hp cell) + rwa [equality] at machine + +theorem paperVariableArityFinitePNPHardPromise + (p : ℚ) (hp : 1 ≤ p) : + NPHardPromise (finitePGapCVPPromise p hp) := + paperVariableArityFiniteP_nphard_of_sourceMachine p hp + (paperVariableArityFinitePSourceMapMachine p hp) + +end Factor400PaperVariableArityFinitePNormUnconditional + +namespace PaperNearestAffineGeneric + +open scoped BigOperators + +open GapCVP.Factor400BinaryCodeDecodingCorollary GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.Factor400BinaryDecodingPromiseHardness + +private noncomputable abbrev nearestInstanceOfAffine + (system : GapCVP.Core.BinaryAffineSystem) (radius : ℕ) : + BinaryNearestCodewordInstance where + blockLength := system.dimension + generatorRank := system.dimension + generator := fun row column => + (system.effectiveSquareBasisMatrix row column : ZMod 2) + target := fun row => (system.effectiveAffineRepresentative row : ZMod 2) + radius := radius + +private theorem nearestInstanceOfAffine_eq_basisResidue + (system : GapCVP.Core.BinaryAffineSystem) (radius : ℕ) + (coefficients : Fin system.dimension → ℤ) : + binaryNearestCodeword (nearestInstanceOfAffine system radius) + (GapCVP.Core.binaryResidue coefficients) = + GapCVP.Core.binaryResidue + (system.effectiveSquareBasisMatrix.mulVec coefficients) := by + funext index + change + (∑ column, + ((system.effectiveSquareBasisMatrix index column : ℤ) : ZMod 2) * + (coefficients column : ZMod 2)) = + ((system.effectiveSquareBasisMatrix.mulVec coefficients index : ℤ) : + ZMod 2) + simp only [Matrix.mulVec, dotProduct, Int.cast_sum, Int.cast_mul] + +private theorem nearestInstanceOfAffine_mem_kernel + (system : GapCVP.Core.BinaryAffineSystem) (radius : ℕ) + (coefficients : Fin system.dimension → ZMod 2) : + system.check.mulVec + (binaryNearestCodeword + (nearestInstanceOfAffine system radius) coefficients) = 0 := by + let lifted := binaryWordLift coefficients + have kernel : system.InLattice + (system.effectiveSquareBasisMatrix.mulVec lifted) := + (system.inLattice_iff_exists_effectiveSquareBasisMatrix _).mpr + ⟨lifted, rfl⟩ + have codeword : + binaryNearestCodeword + (nearestInstanceOfAffine system radius) coefficients = + GapCVP.Core.binaryResidue + (system.effectiveSquareBasisMatrix.mulVec lifted) := by + calc + binaryNearestCodeword + (nearestInstanceOfAffine system radius) coefficients = + binaryNearestCodeword + (nearestInstanceOfAffine system radius) + (GapCVP.Core.binaryResidue (binaryWordLift coefficients)) := + congrArg + (binaryNearestCodeword (nearestInstanceOfAffine system radius)) + (binaryResidue_binaryWordLift coefficients).symm + _ = GapCVP.Core.binaryResidue + (system.effectiveSquareBasisMatrix.mulVec + (binaryWordLift coefficients)) := + nearestInstanceOfAffine_eq_basisResidue + system radius (binaryWordLift coefficients) + rw [codeword] + simpa only [GapCVP.Core.BinaryAffineSystem.InLattice, decide_eq_true_eq] using kernel + +private theorem nearestInstanceOfAffine_residual_solves + (system : GapCVP.Core.BinaryAffineSystem) (radius : ℕ) + (consistent : system.effectiveReducedConsistent = true) + (coefficients : Fin system.dimension → ZMod 2) : + system.Solves + (binaryWordLift + (binaryNearestTarget (nearestInstanceOfAffine system radius) - + binaryNearestCodeword + (nearestInstanceOfAffine system radius) coefficients)) := by + simp only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] + have target : system.check.mulVec + (binaryNearestTarget (nearestInstanceOfAffine system radius)) = + system.rightHandSide := by + have representative := system.effectiveAffineRepresentative_solves consistent + simp only [GapCVP.Core.BinaryAffineSystem.Solves, decide_eq_true_eq] at representative + change system.check.mulVec + (GapCVP.Core.binaryResidue system.effectiveAffineRepresentative) = + system.rightHandSide + exact representative + have kernel := nearestInstanceOfAffine_mem_kernel + system radius coefficients + change system.check.mulVec + (GapCVP.Core.binaryResidue + (binaryWordLift + (binaryNearestTarget (nearestInstanceOfAffine system radius) - + binaryNearestCodeword + (nearestInstanceOfAffine system radius) coefficients))) = + system.rightHandSide + rw [binaryResidue_binaryWordLift] + funext row + change + (∑ column : Fin system.dimension, + system.check row column * + (binaryNearestTarget + (nearestInstanceOfAffine system radius) column - + binaryNearestCodeword + (nearestInstanceOfAffine system radius) coefficients column)) = + system.rightHandSide row + simp_rw [mul_sub] + rw [Finset.sum_sub_distrib] + calc + _ = system.rightHandSide row - 0 := by + congr 1 + · exact congrFun target row + · exact congrFun kernel row + _ = system.rightHandSide row := sub_zero _ + +private theorem nearestInstanceOfAffine_completeness + (system : GapCVP.Core.BinaryAffineSystem) (radius : ℕ) + (dimensionPositive : 0 < system.dimension) + (radiusPositive : 0 < radius) + (consistent : system.effectiveReducedConsistent = true) + (vector : Fin system.dimension → ℤ) + (solution : system.Solves vector) + (binary : ∀ index, vector index = 0 ∨ vector index = 1) + (weight : GapCVP.Core.integerSquaredNorm vector = radius) : + binaryNearestCodewordPromise.yes + (encodeBinaryNearestCodewordInstance + (nearestInstanceOfAffine system radius)) := by + simp only [GapCVP.Factor400BinaryDecodingPromiseHardness.binaryNearestCodewordPromise, + decide_eq_true_eq] + have representative := system.effectiveAffineRepresentative_solves consistent + have difference : + system.InLattice (system.effectiveAffineRepresentative - vector) := by + apply + (system.solves_sub_iff_inLattice representative + (system.effectiveAffineRepresentative - vector)).mp + simpa only [sub_sub_cancel] using solution + obtain ⟨coefficients, coefficientsCorrect⟩ := + (system.inLattice_iff_exists_effectiveSquareBasisMatrix + (system.effectiveAffineRepresentative - vector)).mp difference + refine ⟨nearestInstanceOfAffine system radius, rfl, + dimensionPositive, radiusPositive, + GapCVP.Core.binaryResidue coefficients, ?_⟩ + have codeword := nearestInstanceOfAffine_eq_basisResidue + system radius coefficients + have residual : + binaryNearestTarget (nearestInstanceOfAffine system radius) - + binaryNearestCodeword (nearestInstanceOfAffine system radius) + (GapCVP.Core.binaryResidue coefficients) = + GapCVP.Core.binaryResidue vector := by + calc + binaryNearestTarget (nearestInstanceOfAffine system radius) - + binaryNearestCodeword (nearestInstanceOfAffine system radius) + (GapCVP.Core.binaryResidue coefficients) = + GapCVP.Core.binaryResidue system.effectiveAffineRepresentative - + GapCVP.Core.binaryResidue + (system.effectiveSquareBasisMatrix.mulVec coefficients) := by + rw [codeword] + rfl + _ = GapCVP.Core.binaryResidue + (system.effectiveAffineRepresentative - + system.effectiveSquareBasisMatrix.mulVec coefficients) := + (GapCVP.Core.binaryResidue_sub + system.effectiveAffineRepresentative + (system.effectiveSquareBasisMatrix.mulVec coefficients)).symm + _ = GapCVP.Core.binaryResidue vector := by + rw [coefficientsCorrect] + simp only [sub_sub_cancel] + change + hammingNorm + (binaryNearestTarget (nearestInstanceOfAffine system radius) - + binaryNearestCodeword (nearestInstanceOfAffine system radius) + (GapCVP.Core.binaryResidue coefficients)) ≤ radius + rw [residual] + calc + hammingNorm (GapCVP.Core.binaryResidue vector) = + GapCVP.Core.integerSquaredNorm vector := + (integerSquaredNorm_eq_hammingNorm_binaryResidue vector binary).symm + _ = radius := weight + _ ≤ radius := le_rfl + +private theorem nearestInstanceOfAffine_soundness + (system : GapCVP.Core.BinaryAffineSystem) (radius : ℕ) + (dimensionPositive : 0 < system.dimension) + (radiusPositive : 0 < radius) + (consistent : system.effectiveReducedConsistent = true) + (soundness : ∀ vector : Fin system.dimension → ℤ, + system.Solves vector → + (GapCVP.Core.integerSquaredNorm vector : ℝ) ≤ + 2 * binaryCodeGapFactor system.dimension * (radius : ℝ) → False) : + binaryNearestCodewordPromise.no + (encodeBinaryNearestCodewordInstance + (nearestInstanceOfAffine system radius)) := by + simp only [GapCVP.Factor400BinaryDecodingPromiseHardness.binaryNearestCodewordPromise, + decide_eq_true_eq] + refine ⟨nearestInstanceOfAffine system radius, rfl, + dimensionPositive, radiusPositive, ?_⟩ + intro coefficients + apply lt_of_not_ge + intro short + let residual := + binaryNearestTarget (nearestInstanceOfAffine system radius) - + binaryNearestCodeword + (nearestInstanceOfAffine system radius) coefficients + apply soundness (binaryWordLift residual) + · exact nearestInstanceOfAffine_residual_solves + system radius consistent coefficients + · rw [integerSquaredNorm_binaryWordLift] + have factorNonnegative : 0 ≤ binaryCodeGapFactor system.dimension := by + unfold binaryCodeGapFactor + positivity + have radiusNonnegative : (0 : ℝ) ≤ (radius : ℝ) := by + positivity + change (hammingNorm residual : ℝ) ≤ + 2 * binaryCodeGapFactor system.dimension * (radius : ℝ) + change (hammingNorm residual : ℝ) ≤ + binaryCodeGapFactor system.dimension * (radius : ℝ) at short + linarith [mul_nonneg factorNonnegative radiusNonnegative] + +end PaperNearestAffineGeneric + +namespace PaperNearestInstance + +open GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.Factor400BinaryDecodingPromiseHardness +open GapCVP.Factor400BinaryConstructiveSourcePlaces GapCVP.FormulaBridge +open GapCVP.FourFamilySoundness GapCVP.PhysicalColumnOrder GapCVP.PhysicalWordSoundness +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.PaperNearestAffineGeneric + +private noncomputable def paperNearestFormulaInstance + (encodingLength : ℕ) (formula : ThreeCNF) : + BinaryNearestCodewordInstance := + nearestInstanceOfAffine + (physicalWordBinarySystem encodingLength formula) + (paperVariableArityIntegerRadius encodingLength formula) + +private theorem paperVariableArityNearestFormulaInstance_completeness + (encodingLength : ℕ) (formula : ThreeCNF) + (satisfiable : ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + binaryNearestCodewordPromise.yes + (encodeBinaryNearestCodewordInstance + (paperNearestFormulaInstance + encodingLength formula)) := by + let system := physicalWordBinarySystem + encodingLength formula + obtain ⟨vector, solution, binary, weight⟩ := + paperVariableArityPhysicalWordBinarySystem_oneHot_of_satisfiable + encodingLength formula satisfiable + refine nearestInstanceOfAffine_completeness + system (paperVariableArityIntegerRadius encodingLength formula) + ?_ ?_ ?_ vector ?_ ?_ ?_ + · exact sourceFormulaDimension_pos encodingLength + (srcFormula formula) + · exact paperVariableArityIntegerRadius_pos encodingLength formula + · exact physicalFormulaSystem_consistent_of_satisfiable + encodingLength formula satisfiable + · exact solution + · exact binary + · exact weight + +private theorem paperVariableArityNearestFormulaInstance_soundness + (encodingLength : ℕ) (formula : ThreeCNF) + (consistent : + (physicalWordBinarySystem + encodingLength formula).effectiveReducedConsistent = true) + (unsatisfiable : ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause) : + binaryNearestCodewordPromise.no + (encodeBinaryNearestCodewordInstance + (paperNearestFormulaInstance + encodingLength formula)) := by + let system := physicalWordBinarySystem + encodingLength formula + apply nearestInstanceOfAffine_soundness + system (paperVariableArityIntegerRadius encodingLength formula) + · exact sourceFormulaDimension_pos encodingLength + (srcFormula formula) + · exact paperVariableArityIntegerRadius_pos encodingLength formula + · exact consistent + · intro vector solution short + exact unsatisfiable + (paperVariableArityPhysicalWordBinarySystem_satisfiable_of_scaled_hamming + encodingLength formula vector solution short) + +end PaperNearestInstance + +namespace Factor400BinaryDecodingPhysicalWordGaussianPayloadTM + +open Turing GapCVP.BinaryEncoding GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.BinaryStructuralRecordTM GapCVP.BinaryGaussianStructuralRecordIndex +open GapCVP.Factor400BinaryEffectiveBasisSerializerTM GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.SourceWholeOutputValidBranchRecordTM +open GapCVP.SourceMixedRadixMaskSelectedFlatPreparationTM + +private def compactPhysicalNearestStructuralRecords + (record : BinaryNearestCodewordInstance) : List (List Bool) := + [encodeAtomic record.blockLength, encodeAtomic record.radius] ++ + sourceVectorStructuralRecords record.blockLength + (fun index => ((record.target index).val : ℤ)) ++ + sourceMatrixStructuralRecords record.blockLength + record.generatorRank + (fun row column => ((record.generator row column).val : ℤ)) + +private theorem compactPhysicalNearestStructuralRecords_length + (record : BinaryNearestCodewordInstance) + (hsquare : record.generatorRank = record.blockLength) : + (compactPhysicalNearestStructuralRecords record).length = + 2 + record.blockLength + record.blockLength * record.blockLength := by + simp only [compactPhysicalNearestStructuralRecords, List.cons_append, List.nil_append, + List.length_cons, + List.length_append, sourceVectorStructuralRecords_length, sourceMatrixStructuralRecords_length, + hsquare, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] + +private theorem compactPhysicalNearestStructuralRecords_flatten + (record : BinaryNearestCodewordInstance) + (hsquare : record.generatorRank = record.blockLength) : + encodeAtomic record.blockLength ++ + (compactPhysicalNearestStructuralRecords record).flatten = + encodeBinaryNearestCodewordInstance record := by + simp only [compactPhysicalNearestStructuralRecords, List.cons_append, List.nil_append, + List.flatten_cons, + List.flatten_append, sourceVectorStructuralRecords_flatten, + sourceMatrixStructuralRecords_flatten, + encodeBinaryNearestCodewordInstance, hsquare, List.append_assoc] + +private theorem compactPhysicalNearestStructuralRecords_getD_dimension + (record : BinaryNearestCodewordInstance) : + (compactPhysicalNearestStructuralRecords record).getD 0 [] = + encodeAtomic record.blockLength := by + rfl + +private theorem compactPhysicalNearestStructuralRecords_getD_radius + (record : BinaryNearestCodewordInstance) : + (compactPhysicalNearestStructuralRecords record).getD 1 [] = + encodeAtomic record.radius := by + rfl + +private theorem compactPhysicalNearestStructuralRecords_getD_target + (record : BinaryNearestCodewordInstance) + (index : Fin record.blockLength) : + (compactPhysicalNearestStructuralRecords record).getD + (2 + index.val) [] = + encodeAtomic (((record.target index).val : ℤ)) := by + let vector := sourceVectorStructuralRecords + record.blockLength (fun index => ((record.target index).val : ℤ)) + let matrix := sourceMatrixStructuralRecords + record.blockLength record.generatorRank + (fun row column => ((record.generator row column).val : ℤ)) + have hsplit : compactPhysicalNearestStructuralRecords record = + [encodeAtomic record.blockLength, encodeAtomic record.radius] ++ + (vector ++ matrix) := by + simp only [compactPhysicalNearestStructuralRecords, List.cons_append, List.nil_append, vector, + matrix] + rw [hsplit] + have hprefix : + ([encodeAtomic record.blockLength, + encodeAtomic record.radius] : List (List Bool)).length ≤ + 2 + index.val := by + simp only [List.length_cons, List.length_nil, zero_add, Nat.reduceAdd, le_add_iff_nonneg_right, + zero_le] + rw [List.getD_append_right + [encodeAtomic record.blockLength, encodeAtomic record.radius] + (vector ++ matrix) [] (2 + index.val) hprefix] + simp only [List.length_cons, List.length_nil, + Nat.reduceAdd, Nat.add_sub_cancel_left] + have hindex : index.val < vector.length := by + simp only [sourceVectorStructuralRecords_length, Fin.is_lt, vector] + rw [List.getD_append vector matrix [] index.val hindex] + exact sourceVectorStructuralRecords_getD + record.blockLength (fun index => ((record.target index).val : ℤ)) index + +private theorem compactPhysicalNearestStructuralRecords_getD_basis + (record : BinaryNearestCodewordInstance) + (row : Fin record.blockLength) + (column : Fin record.generatorRank) : + (compactPhysicalNearestStructuralRecords record).getD + (2 + record.blockLength + + row.val * record.generatorRank + column.val) [] = + encodeAtomic (((record.generator row column).val : ℤ)) := by + let vector := sourceVectorStructuralRecords + record.blockLength (fun index => ((record.target index).val : ℤ)) + let matrix := sourceMatrixStructuralRecords + record.blockLength record.generatorRank + (fun row column => ((record.generator row column).val : ℤ)) + have hsplit : compactPhysicalNearestStructuralRecords record = + [encodeAtomic record.blockLength, encodeAtomic record.radius] ++ + (vector ++ matrix) := by + simp only [compactPhysicalNearestStructuralRecords, List.cons_append, List.nil_append, vector, + matrix] + rw [hsplit] + have hprefix : + ([encodeAtomic record.blockLength, + encodeAtomic record.radius] : List (List Bool)).length ≤ + 2 + record.blockLength + + row.val * record.generatorRank + column.val := by + simp only [List.length_cons, List.length_nil] + omega + rw [List.getD_append_right + [encodeAtomic record.blockLength, encodeAtomic record.radius] + (vector ++ matrix) [] + (2 + record.blockLength + + row.val * record.generatorRank + column.val) hprefix] + have hfirst : + 2 + record.blockLength + + row.val * record.generatorRank + column.val - + ([encodeAtomic record.blockLength, + encodeAtomic record.radius] : List (List Bool)).length = + record.blockLength + + row.val * record.generatorRank + column.val := by + simp only [List.length_cons, List.length_nil] + omega + rw [hfirst] + have hvector : vector.length ≤ + record.blockLength + + row.val * record.generatorRank + column.val := by + simp only [vector, sourceVectorStructuralRecords_length] + omega + rw [List.getD_append_right vector matrix [] + (record.blockLength + + row.val * record.generatorRank + column.val) hvector] + have hsecond : + record.blockLength + + row.val * record.generatorRank + column.val - vector.length = + row.val * record.generatorRank + column.val := by + simp only [vector, sourceVectorStructuralRecords_length] + omega + rw [hsecond] + exact sourceMatrixStructuralRecords_getD + record.blockLength record.generatorRank + (fun row column => ((record.generator row column).val : ℤ)) + row column + +private theorem compactPhysicalStructuralSourceWord_eq_flattenRecords + (dimension : SourceQaryMaskDynamicGridWidth) + (atom : ConstructiveStructuralAtomComputer) + (input : List Bool) (width : ℕ) + (records : List (List Bool)) + (hdimension : dimension.output input = + List.replicate width true) + (hcount : records.length = 2 + width + width * width) + (hatoms : ∀ rank : ℕ, rank < records.length → + atom.output (constructiveStructuralRankQuery + dimension input rank) = records.getD rank []) : + constructiveStructuralSourceWord dimension atom input = + records.flatten := by + have hcounter : + constructiveStructuralRecordCountOutput dimension input = + List.replicate records.length true := by + rw [constructiveStructuralRecordCountOutput_valid + dimension input width hdimension, hcount] + have hdescriptors : + constructiveStructuralDescriptorOutput dimension atom input = + sourceFlatAtomicDescriptorStream records := + constructiveStructuralDescriptorOutput_eq_records + dimension atom input width records hdimension hcount hatoms + change effectiveSourceSerializerOutput + (constructiveStructuralRecordCountOutput dimension) + (constructiveStructuralDescriptorOutput dimension atom) input = _ + exact effectiveSourceSerializerOutput_eq_flatten + (constructiveStructuralRecordCountOutput dimension) + (constructiveStructuralDescriptorOutput dimension atom) + (fun _ => records) input hcounter hdescriptors + +end Factor400BinaryDecodingPhysicalWordGaussianPayloadTM + +namespace PaperNearestIntegerTargetAtom + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.Factor400BinaryDecodingPhysicalWordSourceTM +open GapCVP.GaussianPhysicalWordRankIndexTM +open GapCVP.Factor400BinaryCompactPhysicalGaussianOutputSerializerTM GapCVP.CanonicalMatrixShape +open GapCVP.BinaryStructuralRecordTM +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.GaussianOutputSerializerTM GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.SourceWholeOutputAssemblyTM + +private def paperNearestRankIntegerTargetAtom + (reduced : List Bool → List Bool) : List Bool → List Bool := + compactPhysicalDecodingGaussianIntegerTargetAtom ∘ + compactPhysicalGaussianRankTargetStateQuery reduced + +private noncomputable def paperVariableArityNearestRankIntegerTargetAtomComputable + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (paperNearestRankIntegerTargetAtom reduced) := + GapCVP.TMComposition.computableInPolyTime + (compactPhysicalGaussianRankTargetStateQueryComputable computer) + compactPhysicalDecodingGaussianIntegerTargetAtomComputable + +private theorem paperVariableArityNearestRankIntegerTargetAtom_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (formula : ThreeCNF) (rank : ℕ) + (index : Fin + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) + (indexCorrect : rank - 2 = index.val) + (actual : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) : + paperNearestRankIntegerTargetAtom reduced + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + encodeAtomic + ((physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveAffineRepresentative + index) := by + unfold paperNearestRankIntegerTargetAtom + rw [Function.comp_apply] + unfold compactPhysicalGaussianRankTargetStateQuery + rw [factor400PhysicalWordGaussianTargetCoordinateUnary_query, + paperGaussianRankReducedState_query + shape formula rank actual, indexCorrect] + exact compactPhysicalDecodingGaussianIntegerTargetAtom_effective + (physicalFormulaSystem + (encodeThreeCNF formula).length formula) + index (encodeThreeCNF formula) + +end PaperNearestIntegerTargetAtom + +namespace PaperNearestStructuralAtom + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.CLStructuralAtomicNaturalWriter +open GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.Factor400BinaryDecodingPhysicalWordSourceTM +open GapCVP.Factor400BinaryDecodingPhysicalWordGaussianPayloadTM GapCVP.BinaryStructuralRecordTM +open GapCVP.BinaryExplicitAffineRows GapCVP.BinaryGaussianStructuralAtomTM +open GapCVP.GaussianAdaptivePivotStepTM GapCVP.GaussianAdaptivePackedTraceCorrectness +open GapCVP.GaussianPackedStateBasisAtomTM +open GapCVP.Factor400BinaryCompactPhysicalGaussianOutputSerializerTM GapCVP.CanonicalMatrixShape +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.GaussianOutputSerializerTM GapCVP.SourceWholeOutputAssemblyTM +open GapCVP.PaperBinaryCodingTM GapCVP.PaperNearestInstance GapCVP.PaperNearestIntegerTargetAtom + +private def paperNearestRankBinaryBasisAtom + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (reduced : List Bool → List Bool) : List Bool → List Bool := + compactPhysicalDecodingBinaryBasisAtom ∘ + gaussianPackedIndexedBasisTag ∘ + paperGaussianRankBasisStateQuery shape reduced + +private noncomputable def paperVariableArityNearestRankBinaryBasisAtomComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (paperNearestRankBinaryBasisAtom shape reduced) := + GapCVP.TMComposition.computableInPolyTime + (GapCVP.TMComposition.computableInPolyTime + (paperVariableArityGaussianRankBasisStateQueryComputable shape computer) + gaussianPackedIndexedBasisTagComputable) + compactPhysicalDecodingBinaryBasisAtomComputable + +private theorem paperVariableArityNearestRankBinaryBasisAtom_query + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (formula : ThreeCNF) (rank : ℕ) + (row column : Fin + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension) + (rowCorrect : + (rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) / + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension = row.val) + (columnCorrect : + (rank - (2 + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension)) % + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).dimension = column.val) + (actual : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) : + paperNearestRankBinaryBasisAtom shape reduced + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + encodeAtomic + (((((physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveSquareBasisMatrix + row column : ℤ) : ZMod 2).val : ℤ)) := by + unfold paperNearestRankBinaryBasisAtom + simp only [Function.comp_apply] + unfold paperGaussianRankBasisStateQuery + rw [paperVariableArityGaussianBasisRowUnary_query + shape formula rank, + paperVariableArityGaussianBasisColumnUnary_query + shape formula rank, + paperGaussianRankReducedState_query + shape formula rank actual, + rowCorrect, columnCorrect] + simpa only [gaussianPackedIndexedBasisStateWord, + affineCellQuery, List.append_assoc] using + (show compactPhysicalDecodingBinaryBasisAtom + (gaussianPackedIndexedBasisTag + (gaussianPackedIndexedBasisStateWord row.val column.val + (effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)))) = + encodeAtomic + (((((physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveSquareBasisMatrix + row column : ℤ) : ZMod 2).val : ℤ)) by + rw [gaussianPackedIndexedBasisTag_state] + exact compactPhysicalDecodingBinaryBasisAtom_effective + (physicalFormulaSystem + (encodeThreeCNF formula).length formula) + row column) + +private def paperNearestStructuralAtomOutput + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + (reduced : List Bool → List Bool) : List Bool → List Bool := + binaryGaussianDynamicBranchOutput + (structuralRankLessBit structuralRankOneBound) + (paperGaussianRankDimensionAtomicOutput shape) + (binaryGaussianDynamicBranchOutput + (structuralRankLessBit structuralRankTwoBound) + (compactPhysicalGaussianRankRadiusAtom + paperCodingRadiusAtomic) + (binaryGaussianDynamicBranchOutput + (structuralRankLessBit + (paperGaussianRankTargetBound shape)) + (paperNearestRankIntegerTargetAtom reduced) + (paperNearestRankBinaryBasisAtom shape reduced))) + +private noncomputable def paperVariableArityNearestStructuralAtomComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (paperNearestStructuralAtomOutput shape reduced) := by + have tail := binaryGaussianDynamicBranchComputable + (structuralRankLessSelectionComputable + (paperVariableArityGaussianRankTargetBoundComputable shape)) + (paperVariableArityNearestRankIntegerTargetAtomComputable computer) + (paperVariableArityNearestRankBinaryBasisAtomComputable shape computer) + have radius := binaryGaussianDynamicBranchComputable + (structuralRankLessSelectionComputable + structuralRankTwoBoundComputable) + (compactPhysicalGaussianRankRadiusAtomComputable + paperVariableArityCodingRadiusAtomicComputable) + tail + exact binaryGaussianDynamicBranchComputable + (structuralRankLessSelectionComputable + structuralRankOneBoundComputable) + (paperVariableArityGaussianRankDimensionAtomicComputable shape) + radius + +/-- GapCVP reduction support. -/ +@[irreducible] noncomputable def + paperVariableArityNearestStructuralAtomComputer + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + ConstructiveStructuralAtomComputer := + compactPhysicalGaussianStructuralAtomComputerPack + (paperNearestStructuralAtomOutput shape reduced) + (paperVariableArityNearestStructuralAtomComputable shape computer) + +@[simp] private theorem paperVariableArityNearestStructuralAtomComputer_output + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) + (input : List Bool) : + (paperVariableArityNearestStructuralAtomComputer shape computer).output + input = + paperNearestStructuralAtomOutput shape reduced input := by + unfold paperVariableArityNearestStructuralAtomComputer + exact compactPhysicalGaussianStructuralAtomComputerPack_output + (paperNearestStructuralAtomOutput shape reduced) + (paperVariableArityNearestStructuralAtomComputable shape computer) + input + +private theorem paperVariableArityNearestStructuralAtomOutput_correct + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (formula : ThreeCNF) + (actual : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) + (rank : ℕ) + (bound : rank < + (compactPhysicalNearestStructuralRecords + (paperNearestFormulaInstance + (encodeThreeCNF formula).length formula)).length) : + paperNearestStructuralAtomOutput shape reduced + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + (encodeThreeCNF formula) rank) = + (compactPhysicalNearestStructuralRecords + (paperNearestFormulaInstance + (encodeThreeCNF formula).length formula)).getD rank [] := by + let source := encodeThreeCNF formula + let system := physicalFormulaSystem + source.length formula + let record := paperNearestFormulaInstance + source.length formula + let width := paperGaussianSourceDimensionWidth shape + let query := constructiveStructuralRankQuery width source rank + have one : + structuralRankLessBit structuralRankOneBound query = + decide (rank < 1) := + structuralRankOneDecision_query width source rank + have two : + structuralRankLessBit structuralRankTwoBound query = + decide (rank < 2) := + structuralRankTwoDecision_query width source rank + have boundary : + paperGaussianRankTargetBound shape query = + List.replicate (2 + system.dimension) true := by + exact paperVariableArityGaussianRankTargetBound_query + shape formula rank + have target : + structuralRankLessBit + (paperGaussianRankTargetBound shape) query = + decide (rank < 2 + system.dimension) := + structuralRankLessBit_valid + (paperGaussianRankTargetBound shape) + query rank (2 + system.dimension) + (structuralRankUnary_query width source rank) boundary + change paperNearestStructuralAtomOutput + shape reduced query = + (compactPhysicalNearestStructuralRecords record).getD rank [] + unfold paperNearestStructuralAtomOutput + binaryGaussianDynamicBranchOutput + rw [one] + by_cases zeroRank : rank < 1 + · rw [decide_eq_true zeroRank, ite_eq_left (by decide)] + have exactRank : rank = 0 := by omega + subst rank + change + paperGaussianRankDimensionAtomicOutput shape + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + source 0) = + (compactPhysicalNearestStructuralRecords record).getD 0 [] + unfold paperGaussianRankDimensionAtomicOutput + rw [Function.comp_apply, + paperGaussianRankDimensionUnary_query shape formula 0, + compactPhysicalNearestStructuralRecords_getD_dimension record] + simp only [structuralAtomicNaturalWord, List.length_replicate] + rfl + · rw [decide_eq_false zeroRank, ite_eq_right (by decide), two] + by_cases radiusRank : rank < 2 + · rw [decide_eq_true radiusRank, ite_eq_left (by decide)] + have exactRank : rank = 1 := by omega + subst rank + change compactPhysicalGaussianRankRadiusAtom + paperCodingRadiusAtomic + (constructiveStructuralRankQuery + (paperGaussianSourceDimensionWidth shape) + source 1) = + (compactPhysicalNearestStructuralRecords record).getD 1 [] + unfold compactPhysicalGaussianRankRadiusAtom + rw [Function.comp_apply, structuralRankOriginalSource_query, + paperVariableArityCodingRadiusAtomic_valid formula, + compactPhysicalNearestStructuralRecords_getD_radius record] + rfl + · rw [decide_eq_false radiusRank, ite_eq_right (by decide), target] + by_cases targetRank : rank < 2 + system.dimension + · rw [decide_eq_true targetRank, ite_eq_left (by decide)] + have indexBound : rank - 2 < system.dimension := by omega + let index : Fin system.dimension := ⟨rank - 2, indexBound⟩ + have exactRank : rank = 2 + index.val := by + dsimp [index] + omega + have atom := paperVariableArityNearestRankIntegerTargetAtom_query + shape formula rank index rfl actual + have exactRecord : + (compactPhysicalNearestStructuralRecords record).getD + rank [] = + encodeAtomic (system.effectiveAffineRepresentative index) := by + rw [exactRank, + compactPhysicalNearestStructuralRecords_getD_target + record index] + exact congrArg encodeAtomic + (binaryIntegerLift_intCast_of_zero_or_one + (system.effectiveAffineRepresentative_eq_zero_or_one index)) + rw [exactRecord] + exact atom + · rw [decide_eq_false targetRank, ite_eq_right (by decide)] + have positive : 0 < system.dimension := + physicalFormulaSystem_dimension_pos + source.length formula + have square : record.generatorRank = record.blockLength := by + rfl + have records : + rank < 2 + system.dimension + + system.dimension * system.dimension := by + have actualBound : rank < + (compactPhysicalNearestStructuralRecords record).length := by + simpa only [record, source] using bound + rw [compactPhysicalNearestStructuralRecords_length + record square] at actualBound + exact actualBound + have start : 2 + system.dimension ≤ rank := by omega + have offset : + rank - (2 + system.dimension) < + system.dimension * system.dimension := by omega + have rowBound : + (rank - (2 + system.dimension)) / system.dimension < + system.dimension := + (Nat.div_lt_iff_lt_mul positive).2 offset + let row : Fin system.dimension := + ⟨(rank - (2 + system.dimension)) / system.dimension, rowBound⟩ + let column : Fin system.dimension := + ⟨(rank - (2 + system.dimension)) % system.dimension, + Nat.mod_lt _ positive⟩ + have decomposition : + row.val * system.dimension + column.val = + rank - (2 + system.dimension) := by + dsimp [row, column] + rw [Nat.mul_comm] + exact Nat.div_add_mod _ _ + have exactRank : + rank = 2 + system.dimension + + row.val * system.dimension + column.val := by + omega + have atom := paperVariableArityNearestRankBinaryBasisAtom_query + shape formula rank row column rfl rfl actual + have exactRecord : + (compactPhysicalNearestStructuralRecords record).getD + rank [] = + encodeAtomic (((system.effectiveSquareBasisMatrix row column : ZMod 2).val : ℤ)) + := by + rw [exactRank] + exact compactPhysicalNearestStructuralRecords_getD_basis + record row column + rw [exactRecord] + exact atom + +end PaperNearestStructuralAtom + +namespace PaperNearestGaussianPayloadTM + +open Turing GapCVP.Core GapCVP.BinaryEncoding GapCVP.CNFFlatPhysicalBinaryAppendTM +open GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.Factor400BinaryDecodingPhysicalWordGaussianPayloadTM GapCVP.CanonicalMatrixShape +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.BinaryStructuralRecordTM GapCVP.GaussianSourceInitializerInstantiation +open GapCVP.GaussianAdaptivePackedTraceCorrectness GapCVP.GaussianOutputSerializerTM +open GapCVP.PaperBinaryCodingTM GapCVP.PaperNearestAffineGeneric GapCVP.PaperNearestInstance +open GapCVP.PaperNearestStructuralAtom + +private noncomputable def paperNearestStructuralSourceWord + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : List Bool → List Bool := + constructiveStructuralSourceWord + (paperGaussianSourceDimensionWidth shape) + (paperVariableArityNearestStructuralAtomComputer shape computer) + +private noncomputable def paperVariableArityNearestStructuralSourceWordComputable + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) : + BitTM + (paperNearestStructuralSourceWord shape computer) := + constructiveStructuralSourceWordComputable + (paperGaussianSourceDimensionWidth shape) + (paperVariableArityNearestStructuralAtomComputer shape computer) + +private theorem paperVariableArityNearestStructuralSourceWord_valid + (shape : PaperVariableArityCanonicalBinaryMatrixShape) + {reduced : List Bool → List Bool} + (computer : BitTM reduced) + (formula : ThreeCNF) + (actual : + reduced (encodeThreeCNF formula) = + effectiveGaussianPackedStateWord + (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveGaussianState + (encodeThreeCNF formula)) : + paperNearestStructuralSourceWord shape computer + (encodeThreeCNF formula) = + (compactPhysicalNearestStructuralRecords + (paperNearestFormulaInstance + (encodeThreeCNF formula).length formula)).flatten := by + let record := paperNearestFormulaInstance + (encodeThreeCNF formula).length formula + unfold paperNearestStructuralSourceWord + apply compactPhysicalStructuralSourceWord_eq_flattenRecords + (paperGaussianSourceDimensionWidth shape) + (paperVariableArityNearestStructuralAtomComputer shape computer) + (encodeThreeCNF formula) record.blockLength + (compactPhysicalNearestStructuralRecords record) + · simpa only [record, paperNearestFormulaInstance, + nearestInstanceOfAffine, physicalFormulaSystem] + using paperVariableArityGaussianSourceDimensionWidth_valid + shape formula + · exact compactPhysicalNearestStructuralRecords_length record rfl + · intro rank bound + rw [paperVariableArityNearestStructuralAtomComputer_output] + exact paperVariableArityNearestStructuralAtomOutput_correct + shape formula actual rank bound + +private noncomputable def paperVariableArityNearestStructuralOutput + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : List Bool := + paperCodingBlockLengthAtomic input ++ + paperNearestStructuralSourceWord shape + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell) + input + +private noncomputable def paperVariableArityNearestStructuralOutputComputable + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) : + BitTM + (paperVariableArityNearestStructuralOutput cell) := + pointwiseAppendComputable + paperVariableArityCodingBlockLengthAtomicComputable + (paperVariableArityNearestStructuralSourceWordComputable shape + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell)) + +private theorem paperVariableArityNearestStructuralOutput_valid + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (formula : ThreeCNF) : + paperVariableArityNearestStructuralOutput cell + (encodeThreeCNF formula) = + encodeBinaryNearestCodewordInstance + (paperNearestFormulaInstance + (encodeThreeCNF formula).length formula) := by + unfold paperVariableArityNearestStructuralOutput + rw [paperVariableArityCodingBlockLengthAtomic_valid formula, + paperVariableArityNearestStructuralSourceWord_valid shape + (gaussianPaperVariableArityCanonicalSourceReducedStateComputable cell) + formula + (gaussianPaperVariableArityCanonicalSourceReducedStateOutput_effective + cell formula)] + exact compactPhysicalNearestStructuralRecords_flatten + (paperNearestFormulaInstance + (encodeThreeCNF formula).length formula) rfl + +end PaperNearestGaussianPayloadTM + +namespace PaperNearestRoutedSource + +open GapCVP.BinaryEncoding GapCVP.Factor400BinaryDecodingPromiseReduction +open GapCVP.Factor400BinaryDecodingPromiseHardness GapCVP.OriginalThreeSATNPHardness +open GapCVP.CanonicalPhysicalMatrixShape GapCVP.PhysicalColumnOrder +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalSourceMap +open GapCVP.GaussianExactSourceInitializer GapCVP.GaussianSourceConsistencyBridge +open GapCVP.PaperNearestInstance GapCVP.OutputPolynomialCompositionClosure +open GapCVP.SourceWholeOutputAssemblyTM + +private def paperNearestRoutedSourceMap + (output : List Bool → List Bool) (input : List Bool) : List Bool := + if constructiveCanonicalSourceMarker input then + if binaryGaussianSourceConsistencyGuard + paperCanonicalSourceBinarySystem input then + output input + else + encodeBinaryNearestCodewordInstance canonicalBinaryNearestCodewordNo + else + encodeBinaryNearestCodewordInstance canonicalBinaryNearestCodewordNo + +private noncomputable def paperVariableArityNearestRoutedSourceComputable + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + {output : List Bool → List Bool} + (computer : BitTM output) : + BitTM + (paperNearestRoutedSourceMap output) := by + have consistency := sourcePreservingConditionalComputable + (gaussianPaperVariableArityAllInputExactConsistencyComputable worker) + computer + (encodeBinaryNearestCodewordInstance canonicalBinaryNearestCodewordNo) + exact sourcePreservingConditionalComputable + constructiveCanonicalSourceMarkerComputable consistency + (encodeBinaryNearestCodewordInstance canonicalBinaryNearestCodewordNo) + +private theorem paperVariableArityNearestRoutedSource_completeness + (output : List Bool → List Bool) + (valid : ∀ formula : ThreeCNF, + output (encodeThreeCNF formula) = + encodeBinaryNearestCodewordInstance + (paperNearestFormulaInstance + (encodeThreeCNF formula).length formula)) + (input : List Bool) + (membership : paperOriginalThreeSATLanguage input) : + binaryNearestCodewordPromise.yes + (paperNearestRoutedSourceMap output input) := by + obtain ⟨formula, encoding, satisfiable⟩ := + (GapCVP.OriginalThreeSATNPHardness.paperOriginalThreeSATLanguage_iff input).mp membership + subst input + have consistent := + physicalFormulaSystem_consistent_of_satisfiable + (encodeThreeCNF formula).length formula satisfiable + have selected : binaryGaussianSourceConsistencyGuard + paperCanonicalSourceBinarySystem + (encodeThreeCNF formula) = true := by + simpa only [binaryGaussianSourceConsistencyGuard, paperCanonicalSourceBinarySystem, + decodeThreeCNF_encode, + ↓reduceIte, Core.BinaryAffineSystem.effectiveReducedConsistent_iff, physicalFormulaSystem] + using consistent + simpa only [paperNearestRoutedSourceMap, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, ↓reduceIte, selected, valid formula] using + paperVariableArityNearestFormulaInstance_completeness (encodeThreeCNF formula).length formula + satisfiable + +private theorem paperVariableArityNearestRoutedSource_soundness + (output : List Bool → List Bool) + (valid : ∀ formula : ThreeCNF, + output (encodeThreeCNF formula) = + encodeBinaryNearestCodewordInstance + (paperNearestFormulaInstance + (encodeThreeCNF formula).length formula)) + (input : List Bool) + (nonmembership : ¬ paperOriginalThreeSATLanguage input) : + binaryNearestCodewordPromise.no + (paperNearestRoutedSourceMap output input) := by + cases decoded : decodeThreeCNF input with + | none => + simpa only [paperNearestRoutedSourceMap, constructiveCanonicalSourceMarker, decoded, + Bool.false_eq_true, + ↓reduceIte] using canonicalBinaryNearestCodewordNo_mem + | some formula => + by_cases canonical : encodeThreeCNF formula = input + · subst input + have unsatisfiable : ¬ ∃ assignment : ℕ → Bool, + ∀ clause ∈ formula, clauseSatisfied assignment clause := by + intro satisfiable + exact nonmembership + ((GapCVP.OriginalThreeSATNPHardness.paperOriginalThreeSATLanguage_iff + (encodeThreeCNF formula)).mpr ⟨formula, rfl, satisfiable⟩) + cases consistent : + (physicalWordBinarySystem + (encodeThreeCNF formula).length formula).effectiveReducedConsistent with + | false => + simpa only [paperNearestRoutedSourceMap, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, ↓reduceIte, binaryGaussianSourceConsistencyGuard, + paperCanonicalSourceBinarySystem, consistent, + Bool.false_eq_true] using canonicalBinaryNearestCodewordNo_mem + | true => + simpa only [paperNearestRoutedSourceMap, constructiveCanonicalSourceMarker, + decodeThreeCNF_encode, + decide_true, ↓reduceIte, binaryGaussianSourceConsistencyGuard, + paperCanonicalSourceBinarySystem, consistent, + valid formula] using + paperVariableArityNearestFormulaInstance_soundness (encodeThreeCNF formula).length + formula consistent unsatisfiable + · simpa only [paperNearestRoutedSourceMap, constructiveCanonicalSourceMarker, decoded, + canonical, decide_false, + Bool.false_eq_true, ↓reduceIte] using canonicalBinaryNearestCodewordNo_mem + +private noncomputable def paperVariableArityNearestSourceReduction + (worker : PaperVariableArityCanonicalPhysicalBinaryMatrixCellComputer) + {output : List Bool → List Bool} + (computer : BitTM output) + (valid : ∀ formula : ThreeCNF, + output (encodeThreeCNF formula) = + encodeBinaryNearestCodewordInstance + (paperNearestFormulaInstance + (encodeThreeCNF formula).length formula)) : + PromiseReduction paperOriginalThreeSATLanguage + binaryNearestCodewordPromise where + map := paperNearestRoutedSourceMap output + polynomial_time := + ⟨paperVariableArityNearestRoutedSourceComputable worker computer⟩ + completeness := paperVariableArityNearestRoutedSource_completeness + output valid + soundness := paperVariableArityNearestRoutedSource_soundness + output valid + +end PaperNearestRoutedSource + +namespace Factor400PaperVariableArityNearestUnconditional + +open GapCVP.Factor400BinaryDecodingPromiseHardness GapCVP.OriginalThreeSATNPHardness +open GapCVP.CanonicalPhysicalMatrixShape +open GapCVP.Factor400BinaryConstructivePaperVariableArityPhysicalMatrixCellInstantiation +open GapCVP.PaperNearestGaussianPayloadTM GapCVP.PaperNearestRoutedSource + +private noncomputable def paperVariableArityNearestUnconditionalSourceReduction : + PromiseReduction paperOriginalThreeSATLanguage binaryNearestCodewordPromise := + paperVariableArityNearestSourceReduction + (paperVariableArityCanonicalPhysicalMatrixCellComputer + paperCanonicalPhysicalMatrixShape) + (paperVariableArityNearestStructuralOutputComputable + (paperVariableArityCanonicalPhysicalMatrixCellComputer + paperCanonicalPhysicalMatrixShape)) + (paperVariableArityNearestStructuralOutput_valid + (paperVariableArityCanonicalPhysicalMatrixCellComputer + paperCanonicalPhysicalMatrixShape)) + +theorem binaryNearestCodeword_nphard_unconditional : + NPHardPromise binaryNearestCodewordPromise := + nphardPromise_of_nphard_of_promiseReduction + paperOriginalThreeSATIsNPHard + paperVariableArityNearestUnconditionalSourceReduction + polynomialTimeClosedUnderComposition + +end Factor400PaperVariableArityNearestUnconditional + +end GapCVP + +end diff --git a/LeanPool/GapCVP/Part18.lean b/LeanPool/GapCVP/Part18.lean new file mode 100644 index 000000000..4e50d8e42 --- /dev/null +++ b/LeanPool/GapCVP/Part18.lean @@ -0,0 +1,763 @@ +/- +Copyright (c) 2026 OpenAI and Dean Cureton. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: OpenAI, Dean Cureton +-/ + +import LeanPool.GapCVP.Part17 + +/-! # GapCVP proof, part 18 -/ + +noncomputable section + +open StateTransition (EvalsToInTime) +open scoped BigOperators + +namespace GapCVP + +open GapCVP.TraceGolf (oneStep rebound) + +namespace Comparator + +open GapCVP.Factor400BinaryDecodingPhysicalWordUnconditionalSyndromeFinal +open GapCVP.Factor400BinaryPaperVariableArityUnconditionalPhysicalSourceMachine +open GapCVP.Factor400PaperVariableArityFinitePNormUnconditional +open GapCVP.Factor400PaperVariableArityNearestUnconditional + +private theorem classicalDecide_eq_true_iff (proposition : Prop) : + @decide proposition (Classical.propDecidable proposition) = true ↔ + proposition := by + constructor + · exact @of_decide_eq_true proposition + (Classical.propDecidable proposition) + · exact @decide_eq_true proposition + (Classical.propDecidable proposition) + +private theorem classicalDecide_congr {first second : Prop} + (equivalent : first ↔ second) : + @decide first (Classical.propDecidable first) = true ↔ + @decide second (Classical.propDecidable second) = true := + (classicalDecide_eq_true_iff first).trans + (equivalent.trans (classicalDecide_eq_true_iff second).symm) + +private structure Instance where + dimension : ℕ + basis : Matrix (Fin dimension) (Fin dimension) ℤ + target : Fin dimension → ℚ + radius : ℚ + +export GapCVP.BinaryEncoding + (lengthPrefixedWord + readUnaryPrefix + readUnaryPrefix_replicate + readLengthPrefixedWord + readLengthPrefixedWord_append + encodeAtomic + readAtomic + readAtomic_append + encodeFinValues + readFinValues + readFinValues_append + encodeMatrixRows + readMatrixRows + readMatrixRows_append) + +export GapCVP (BitLanguage bitEncoding pairBitEncoding IsNP) + +private def encodeInstance (I : Instance) : List Bool := + encodeAtomic I.dimension ++ + encodeAtomic I.radius ++ + encodeFinValues I.dimension I.target ++ + encodeMatrixRows I.dimension I.dimension I.basis + +private def decodeInstance (bits : List Bool) : Option Instance := + match (readAtomic bits : Option (ℕ × List Bool)) with + | none => none + | some (dimension, afterDimension) => + match (readAtomic afterDimension : Option (ℚ × List Bool)) with + | none => none + | some (radius, afterRadius) => + match (readFinValues dimension afterRadius : + Option ((Fin dimension → ℚ) × List Bool)) with + | none => none + | some (target, afterTarget) => + match readMatrixRows dimension dimension afterTarget with + | some (basis, []) => + some { dimension, basis, target, radius } + | _ => none + +@[simp] private theorem decodeInstance_encode (record : Instance) : + decodeInstance (encodeInstance record) = some record := by + cases record with + | mk dimension basis target radius => + have matrix : + readMatrixRows dimension dimension + (encodeMatrixRows dimension dimension basis) = + some (basis, []) := by + change + readMatrixRows dimension dimension + (encodeMatrixRows dimension dimension + (fun row column => basis row column)) = + some ((fun row column => basis row column), []) + simpa only [List.append_nil] using + readMatrixRows_append (fun row column => basis row column) [] + simp only [decodeInstance, encodeInstance, List.append_assoc, readAtomic_append, + readFinValues_append, matrix] + +private theorem encodeInstance_injective : Function.Injective encodeInstance := by + intro first second same + simpa only [decodeInstance_encode, Option.some.injEq] using congrArg decodeInstance same + +private def wellFormed (record : Instance) : Bool := + @decide + (0 < record.dimension ∧ record.basis.det ≠ 0 ∧ 0 < record.radius) + (Classical.propDecidable _) + +private def hasIntegerTarget (record : Instance) : Bool := + @decide + (∀ index : Fin record.dimension, + ∃ value : ℤ, record.target index = (value : ℚ)) + (Classical.propDecidable _) + +private noncomputable def distanceSquared (I : Instance) + (vector : Fin I.dimension → ℤ) : ℝ := + ∑ i : Fin I.dimension, + (((∑ j : Fin I.dimension, + (I.basis i j : ℝ) * (vector j : ℝ)) - + (I.target i : ℝ)) ^ 2) + +private noncomputable def gapFactor400 (I : Instance) : ℝ := + (I.dimension : ℝ) ^ ((1 : ℝ) / 400) + +private def gapYES400 (record : Instance) : Bool := + @decide + (wellFormed record ∧ + ∃ vector : Fin record.dimension → ℤ, + distanceSquared record vector ≤ (record.radius : ℝ) ^ 2) + (Classical.propDecidable _) + +private def gapNO400 (record : Instance) : Bool := + @decide + (wellFormed record ∧ + ∀ vector : Fin record.dimension → ℤ, + (gapFactor400 record * (record.radius : ℝ)) ^ 2 < + distanceSquared record vector) + (Classical.propDecidable _) + +private theorem gapYES400_not_gapNO400 (record : Instance) + (positive : gapYES400 record) (negative : gapNO400 record) : False := by + have positive' : + wellFormed record = true ∧ + ∃ vector : Fin record.dimension → ℤ, + distanceSquared record vector ≤ (record.radius : ℝ) ^ 2 := by + apply (classicalDecide_eq_true_iff _).mp + exact positive + have negative' : + wellFormed record = true ∧ + ∀ vector : Fin record.dimension → ℤ, + (gapFactor400 record * (record.radius : ℝ)) ^ 2 < + distanceSquared record vector := by + apply (classicalDecide_eq_true_iff _).mp + exact negative + have well : + 0 < record.dimension ∧ record.basis.det ≠ 0 ∧ + 0 < record.radius := by + apply (classicalDecide_eq_true_iff _).mp + exact positive'.1 + obtain ⟨dimension, _, radius⟩ := well + obtain ⟨vector, close⟩ := positive'.2 + have factor : 1 ≤ gapFactor400 record := by + unfold gapFactor400 + apply Real.one_le_rpow + · exact_mod_cast dimension + · norm_num + have radiusReal : 0 < (record.radius : ℝ) := by + exact_mod_cast radius + have scaled : + (record.radius : ℝ) ≤ + gapFactor400 record * (record.radius : ℝ) := by + nlinarith + have squares : + (record.radius : ℝ) ^ 2 ≤ + (gapFactor400 record * (record.radius : ℝ)) ^ 2 := by + nlinarith [sq_nonneg (gapFactor400 record * (record.radius : ℝ)), + sq_nonneg (record.radius : ℝ)] + linarith [negative'.2 vector] + +private def yesLanguage (bits : List Bool) : Bool := + @decide + (∃ record : Instance, + encodeInstance record = bits ∧ + hasIntegerTarget record ∧ gapYES400 record) + (Classical.propDecidable _) + +private def noLanguage (bits : List Bool) : Bool := + @decide + (∃ record : Instance, + encodeInstance record = bits ∧ + hasIntegerTarget record ∧ gapNO400 record) + (Classical.propDecidable _) + +private structure PromiseProblem where + yes : BitLanguage + no : BitLanguage + disjoint : ∀ bits, yes bits → no bits → False + +/-- GapCVP reduction support. -/ +def gapCVP400Promise : PromiseProblem where + yes := yesLanguage + no := noLanguage + disjoint bits positive negative := by + simp only [yesLanguage, noLanguage, classicalDecide_eq_true_iff] + at positive negative + obtain ⟨first, hfirst, _, hyes⟩ := positive + obtain ⟨second, hsecond, _, hno⟩ := negative + have same := encodeInstance_injective (hfirst.trans hsecond.symm) + subst second + exact gapYES400_not_gapNO400 first hyes hno + +private structure BinaryNearestCodewordInstance where + blockLength : ℕ + generatorRank : ℕ + generator : Fin blockLength → Fin generatorRank → ZMod 2 + target : Fin blockLength → ZMod 2 + radius : ℕ + +private structure BinarySyndromeDecodingInstance where + checkCount : ℕ + blockLength : ℕ + parityCheck : Fin checkCount → Fin blockLength → ZMod 2 + syndrome : Fin checkCount → ZMod 2 + radius : ℕ + +private def encodeBinaryNearestCodewordInstance + (record : BinaryNearestCodewordInstance) : List Bool := + encodeAtomic record.blockLength ++ + encodeAtomic record.generatorRank ++ + encodeAtomic record.radius ++ + encodeFinValues record.blockLength + (fun index => ((record.target index).val : ℤ)) ++ + encodeMatrixRows record.blockLength record.generatorRank + (fun row column => ((record.generator row column).val : ℤ)) + +private def encodeBinarySyndromeDecodingInstance + (record : BinarySyndromeDecodingInstance) : List Bool := + encodeAtomic record.checkCount ++ + encodeAtomic record.blockLength ++ + encodeAtomic record.radius ++ + encodeFinValues record.checkCount + (fun row => ((record.syndrome row).val : ℤ)) ++ + encodeMatrixRows record.checkCount record.blockLength + (fun row column => ((record.parityCheck row column).val : ℤ)) + +private theorem binaryIntegerRepresentative_cast (value : ZMod 2) : + (((value.val : ℕ) : ℤ) : ZMod 2) = value := by + rw [Int.cast_natCast] + exact ZMod.natCast_zmod_val value + +private def decodeBinaryNearestCodewordInstance + (bits : List Bool) : Option BinaryNearestCodewordInstance := + match (readAtomic bits : Option (ℕ × List Bool)) with + | none => none + | some (blockLength, afterBlockLength) => + match (readAtomic afterBlockLength : Option (ℕ × List Bool)) with + | none => none + | some (generatorRank, afterGeneratorRank) => + match (readAtomic afterGeneratorRank : Option (ℕ × List Bool)) with + | none => none + | some (radius, afterRadius) => + match (readFinValues blockLength afterRadius : + Option ((Fin blockLength → ℤ) × List Bool)) with + | none => none + | some (target, afterTarget) => + match readMatrixRows blockLength generatorRank afterTarget with + | some (generator, []) => + some { + blockLength + generatorRank + generator := fun row column => + (generator row column : ZMod 2) + target := fun index => (target index : ZMod 2) + radius + } + | _ => none + +@[simp] private theorem decodeBinaryNearestCodewordInstance_encode + (record : BinaryNearestCodewordInstance) : + decodeBinaryNearestCodewordInstance + (encodeBinaryNearestCodewordInstance record) = some record := by + cases record with + | mk blockLength generatorRank generator target radius => + have matrix : + readMatrixRows blockLength generatorRank + (encodeMatrixRows blockLength generatorRank + (fun row column => ((generator row column).val : ℤ))) = + some ((fun row column => ((generator row column).val : ℤ)), []) := by + simpa only [ZMod.natCast_val, List.append_nil] using + readMatrixRows_append (fun row column => ((generator row column).val : ℤ)) [] + simp only [decodeBinaryNearestCodewordInstance, + encodeBinaryNearestCodewordInstance, List.append_assoc, + readAtomic_append, readFinValues_append, matrix, + binaryIntegerRepresentative_cast] + +private theorem encodeBinaryNearestCodewordInstance_injective : + Function.Injective encodeBinaryNearestCodewordInstance := by + intro first second same + simpa only [decodeBinaryNearestCodewordInstance_encode, Option.some.injEq] using + congrArg decodeBinaryNearestCodewordInstance same + +private def decodeBinarySyndromeDecodingInstance + (bits : List Bool) : Option BinarySyndromeDecodingInstance := + match (readAtomic bits : Option (ℕ × List Bool)) with + | none => none + | some (checkCount, afterCheckCount) => + match (readAtomic afterCheckCount : Option (ℕ × List Bool)) with + | none => none + | some (blockLength, afterBlockLength) => + match (readAtomic afterBlockLength : Option (ℕ × List Bool)) with + | none => none + | some (radius, afterRadius) => + match (readFinValues checkCount afterRadius : + Option ((Fin checkCount → ℤ) × List Bool)) with + | none => none + | some (syndrome, afterSyndrome) => + match readMatrixRows checkCount blockLength afterSyndrome with + | some (parityCheck, []) => + some { + checkCount + blockLength + parityCheck := fun row column => + (parityCheck row column : ZMod 2) + syndrome := fun row => (syndrome row : ZMod 2) + radius + } + | _ => none + +@[simp] private theorem decodeBinarySyndromeDecodingInstance_encode + (record : BinarySyndromeDecodingInstance) : + decodeBinarySyndromeDecodingInstance + (encodeBinarySyndromeDecodingInstance record) = some record := by + cases record with + | mk checkCount blockLength parityCheck syndrome radius => + have matrix : + readMatrixRows checkCount blockLength + (encodeMatrixRows checkCount blockLength + (fun row column => ((parityCheck row column).val : ℤ))) = + some ((fun row column => ((parityCheck row column).val : ℤ)), []) := by + simpa only [ZMod.natCast_val, List.append_nil] using + readMatrixRows_append (fun row column => ((parityCheck row column).val : ℤ)) [] + simp only [decodeBinarySyndromeDecodingInstance, + encodeBinarySyndromeDecodingInstance, List.append_assoc, + readAtomic_append, readFinValues_append, matrix, + binaryIntegerRepresentative_cast] + +private theorem encodeBinarySyndromeDecodingInstance_injective : + Function.Injective encodeBinarySyndromeDecodingInstance := by + intro first second same + simpa only [decodeBinarySyndromeDecodingInstance_encode, Option.some.injEq] using + congrArg decodeBinarySyndromeDecodingInstance same + +private def binaryNearestCodeword + (record : BinaryNearestCodewordInstance) + (coefficients : Fin record.generatorRank → ZMod 2) : + Fin record.blockLength → ZMod 2 := + fun index => ∑ column : Fin record.generatorRank, + record.generator index column * coefficients column + +private def binaryNearestTarget (record : BinaryNearestCodewordInstance) : + Fin record.blockLength → ZMod 2 := + record.target + +private def binarySyndromeProduct + (record : BinarySyndromeDecodingInstance) + (word : Fin record.blockLength → ZMod 2) : + Fin record.checkCount → ZMod 2 := + fun row => ∑ column : Fin record.blockLength, + record.parityCheck row column * word column + +private def binarySyndromeTarget (record : BinarySyndromeDecodingInstance) : + Fin record.checkCount → ZMod 2 := + record.syndrome + +private noncomputable def binaryCodeGapFactor (blockLength : ℕ) : ℝ := + (blockLength : ℝ) ^ ((1 : ℝ) / 200) + +/-- GapCVP reduction support. -/ +noncomputable def binaryNearestCodewordPromise : PromiseProblem where + yes bits := + @decide + (∃ record : BinaryNearestCodewordInstance, + encodeBinaryNearestCodewordInstance record = bits ∧ + 0 < record.blockLength ∧ 0 < record.radius ∧ + ∃ coefficients : Fin record.generatorRank → ZMod 2, + hammingNorm + (binaryNearestTarget record - + binaryNearestCodeword record coefficients) ≤ record.radius) + (Classical.propDecidable _) + no bits := + @decide + (∃ record : BinaryNearestCodewordInstance, + encodeBinaryNearestCodewordInstance record = bits ∧ + 0 < record.blockLength ∧ 0 < record.radius ∧ + ∀ coefficients : Fin record.generatorRank → ZMod 2, + binaryCodeGapFactor record.blockLength * + (record.radius : ℝ) < + (hammingNorm + (binaryNearestTarget record - + binaryNearestCodeword record coefficients) : ℝ)) + (Classical.propDecidable _) + disjoint bits positive negative := by + simp only [classicalDecide_eq_true_iff] at positive negative + obtain ⟨first, hfirst, dimension, _, coefficients, close⟩ := positive + obtain ⟨second, hsecond, _, _, far⟩ := negative + have same := + encodeBinaryNearestCodewordInstance_injective + (hfirst.trans hsecond.symm) + subst second + have factor : 1 ≤ binaryCodeGapFactor first.blockLength := by + unfold binaryCodeGapFactor + apply Real.one_le_rpow + · exact_mod_cast dimension + · norm_num + have radius : (0 : ℝ) ≤ (first.radius : ℝ) := by positivity + have closeReal : + (hammingNorm + (binaryNearestTarget first - + binaryNearestCodeword first coefficients) : ℝ) ≤ + (first.radius : ℝ) := by + exact_mod_cast close + nlinarith [far coefficients] + +/-- GapCVP reduction support. -/ +noncomputable def binarySyndromeDecodingPromise : PromiseProblem where + yes bits := + @decide + (∃ record : BinarySyndromeDecodingInstance, + encodeBinarySyndromeDecodingInstance record = bits ∧ + 0 < record.blockLength ∧ 0 < record.radius ∧ + ∃ word : Fin record.blockLength → ZMod 2, + binarySyndromeProduct record word = binarySyndromeTarget record ∧ + hammingNorm word ≤ record.radius) + (Classical.propDecidable _) + no bits := + @decide + (∃ record : BinarySyndromeDecodingInstance, + encodeBinarySyndromeDecodingInstance record = bits ∧ + 0 < record.blockLength ∧ 0 < record.radius ∧ + (∃ word : Fin record.blockLength → ZMod 2, + binarySyndromeProduct record word = binarySyndromeTarget record) ∧ + ∀ word : Fin record.blockLength → ZMod 2, + binarySyndromeProduct record word = binarySyndromeTarget record → + binaryCodeGapFactor record.blockLength * + (record.radius : ℝ) < (hammingNorm word : ℝ)) + (Classical.propDecidable _) + disjoint bits positive negative := by + simp only [classicalDecide_eq_true_iff] at positive negative + obtain ⟨first, hfirst, dimension, _, word, solution, close⟩ := positive + obtain ⟨second, hsecond, _, _, _, far⟩ := negative + have same := + encodeBinarySyndromeDecodingInstance_injective + (hfirst.trans hsecond.symm) + subst second + have factor : 1 ≤ binaryCodeGapFactor first.blockLength := by + unfold binaryCodeGapFactor + apply Real.one_le_rpow + · exact_mod_cast dimension + · norm_num + have radius : (0 : ℝ) ≤ (first.radius : ℝ) := by positivity + have closeReal : (hammingNorm word : ℝ) ≤ (first.radius : ℝ) := by + exact_mod_cast close + nlinarith [far word solution] + +private noncomputable def finitePNorm (p : ℚ) {n : ℕ} (vector : Fin n → ℝ) : ℝ := + (∑ i : Fin n, |vector i| ^ (p : ℝ)) ^ ((p : ℝ)⁻¹) + +private noncomputable def finitePLatticeDiscrepancy (I : Instance) + (vector : Fin I.dimension → ℤ) : Fin I.dimension → ℝ := fun i => + (I.target i : ℝ) - + ∑ j : Fin I.dimension, (I.basis i j : ℝ) * (vector j : ℝ) + +private noncomputable def finitePLatticeDistance (p : ℚ) (I : Instance) + (vector : Fin I.dimension → ℤ) : ℝ := + finitePNorm p (finitePLatticeDiscrepancy I vector) + +private noncomputable def finitePGapFactor (p : ℚ) (I : Instance) : ℝ := + (I.dimension : ℝ) ^ (((200 : ℝ) * (p : ℝ))⁻¹) + +/-- GapCVP reduction support. -/ +noncomputable def finitePGapCVPPromise (p : ℚ) (hp : 1 ≤ p) : PromiseProblem where + yes bits := + @decide + (∃ I : Instance, + encodeInstance I = bits ∧ + wellFormed I ∧ + ∃ vector : Fin I.dimension → ℤ, + finitePLatticeDistance p I vector ≤ (I.radius : ℝ)) + (Classical.propDecidable _) + no bits := + @decide + (∃ I : Instance, + encodeInstance I = bits ∧ + wellFormed I ∧ + ∀ vector : Fin I.dimension → ℤ, + finitePGapFactor p I * (I.radius : ℝ) < + finitePLatticeDistance p I vector) + (Classical.propDecidable _) + disjoint bits positive negative := by + have positive' : + ∃ record : Instance, + encodeInstance record = bits ∧ + wellFormed record = true ∧ + ∃ vector : Fin record.dimension → ℤ, + finitePLatticeDistance p record vector ≤ + (record.radius : ℝ) := by + apply (classicalDecide_eq_true_iff _).mp + exact positive + have negative' : + ∃ record : Instance, + encodeInstance record = bits ∧ + wellFormed record = true ∧ + ∀ vector : Fin record.dimension → ℤ, + finitePGapFactor p record * (record.radius : ℝ) < + finitePLatticeDistance p record vector := by + apply (classicalDecide_eq_true_iff _).mp + exact negative + obtain ⟨first, hfirst, wellDecision, vector, close⟩ := positive' + obtain ⟨second, hsecond, _, far⟩ := negative' + have well : + 0 < first.dimension ∧ first.basis.det ≠ 0 ∧ + 0 < first.radius := by + apply (classicalDecide_eq_true_iff _).mp + exact wellDecision + have same := encodeInstance_injective (hfirst.trans hsecond.symm) + subst second + have exponent : 0 ≤ (((200 : ℝ) * (p : ℝ))⁻¹) := by + have parameter : (0 : ℝ) < (p : ℝ) := by + exact_mod_cast (lt_of_lt_of_le (by norm_num : (0 : ℚ) < 1) hp) + positivity + have factor : 1 ≤ finitePGapFactor p first := by + unfold finitePGapFactor + apply Real.one_le_rpow + · exact_mod_cast well.1 + · exact exponent + have radius : 0 < (first.radius : ℝ) := by + exact_mod_cast well.2.2 + nlinarith [far vector] + +private structure PromiseReduction (language : BitLanguage) (problem : PromiseProblem) where + map : List Bool → List Bool + polynomial_time : Nonempty + (BitTM map) + completeness : ∀ input, language input → problem.yes (map input) + soundness : ∀ input, ¬ language input → problem.no (map input) + +/-- GapCVP reduction support. -/ +def IsNPHardPromise (problem : PromiseProblem) : Bool := + @decide + (∀ language : BitLanguage, + IsNP language → Nonempty (PromiseReduction language problem)) + (Classical.propDecidable _) + +private def toOriginal (I : Instance) : GapCVP.GapCVPInstance := + ⟨I.dimension, I.basis, I.target, I.radius⟩ + +private def ofOriginal (I : GapCVP.GapCVPInstance) : Instance := + ⟨I.dimension, I.basis, I.target, I.radius⟩ + +@[simp] private theorem toOriginal_ofOriginal (I : GapCVP.GapCVPInstance) : + toOriginal (ofOriginal I) = I := rfl + +private def toOriginalNearest (record : BinaryNearestCodewordInstance) : + GapCVP.Factor400BinaryDecodingPromiseReduction.BinaryNearestCodewordInstance := + ⟨record.blockLength, record.generatorRank, record.generator, + record.target, record.radius⟩ + +private def ofOriginalNearest + (record : GapCVP.Factor400BinaryDecodingPromiseReduction.BinaryNearestCodewordInstance) : + BinaryNearestCodewordInstance := + ⟨record.blockLength, record.generatorRank, record.generator, + record.target, record.radius⟩ + +@[simp] private theorem toOriginalNearest_ofOriginalNearest + (record : GapCVP.Factor400BinaryDecodingPromiseReduction.BinaryNearestCodewordInstance) : + toOriginalNearest (ofOriginalNearest record) = record := rfl + +private def toOriginalSyndrome (record : BinarySyndromeDecodingInstance) : + GapCVP.Factor400BinaryDecodingPromiseReduction.BinarySyndromeDecodingInstance := + ⟨record.checkCount, record.blockLength, record.parityCheck, + record.syndrome, record.radius⟩ + +private def ofOriginalSyndrome + (record : GapCVP.Factor400BinaryDecodingPromiseReduction.BinarySyndromeDecodingInstance) : + BinarySyndromeDecodingInstance := + ⟨record.checkCount, record.blockLength, record.parityCheck, + record.syndrome, record.radius⟩ + +@[simp] private theorem toOriginalSyndrome_ofOriginalSyndrome + (record : GapCVP.Factor400BinaryDecodingPromiseReduction.BinarySyndromeDecodingInstance) : + toOriginalSyndrome (ofOriginalSyndrome record) = record := rfl + +private theorem yesLanguage_iff_original (bits : List Bool) : + yesLanguage bits ↔ + integerTargetGapCVP400Promise.yes + bits := by + simp only [yesLanguage, hasIntegerTarget, gapYES400, wellFormed, + integerTargetGapCVP400Promise, HasIntegerTarget, + GapCVP.gapYES400, GapCVP.gapCVPWellFormed] + apply classicalDecide_congr + change (∃ _, _) ↔ ∃ _, _ + rw [(Function.RightInverse.surjective toOriginal_ofOriginal).exists] + exact exists_congr fun _ => by + simp only [encodeInstance, toOriginal] + rfl + +private theorem noLanguage_iff_original (bits : List Bool) : + noLanguage bits ↔ + integerTargetGapCVP400Promise.no + bits := by + simp only [noLanguage, hasIntegerTarget, gapNO400, wellFormed, + integerTargetGapCVP400Promise, HasIntegerTarget, + GapCVP.gapNO400, GapCVP.gapCVPWellFormed] + apply classicalDecide_congr + change (∃ _, _) ↔ ∃ _, _ + rw [(Function.RightInverse.surjective toOriginal_ofOriginal).exists] + exact exists_congr fun _ => by + simp only [encodeInstance, toOriginal] + rfl + +private theorem binaryNearestCodeword_yes_iff_original (bits : List Bool) : + binaryNearestCodewordPromise.yes bits ↔ + GapCVP.Factor400BinaryDecodingPromiseHardness.binaryNearestCodewordPromise.yes bits := by + simp only [binaryNearestCodewordPromise, + GapCVP.Factor400BinaryDecodingPromiseHardness.binaryNearestCodewordPromise] + apply classicalDecide_congr + change (∃ _, _) ↔ ∃ _, _ + rw [(Function.RightInverse.surjective toOriginalNearest_ofOriginalNearest).exists] + exact exists_congr fun _ => by + simp only [encodeBinaryNearestCodewordInstance, toOriginalNearest, + GapCVP.Factor400BinaryDecodingPromiseReduction.encodeBinaryNearestCodewordInstance] + rfl + +private theorem binaryNearestCodeword_no_iff_original (bits : List Bool) : + binaryNearestCodewordPromise.no bits ↔ + GapCVP.Factor400BinaryDecodingPromiseHardness.binaryNearestCodewordPromise.no bits := by + simp only [binaryNearestCodewordPromise, + GapCVP.Factor400BinaryDecodingPromiseHardness.binaryNearestCodewordPromise] + apply classicalDecide_congr + change (∃ _, _) ↔ ∃ _, _ + rw [(Function.RightInverse.surjective toOriginalNearest_ofOriginalNearest).exists] + exact exists_congr fun _ => by + simp only [encodeBinaryNearestCodewordInstance, toOriginalNearest, + GapCVP.Factor400BinaryDecodingPromiseReduction.encodeBinaryNearestCodewordInstance] + rfl + +private theorem binarySyndromeDecoding_yes_iff_original (bits : List Bool) : + binarySyndromeDecodingPromise.yes bits ↔ + GapCVP.Factor400BinaryDecodingPromiseHardness.binarySyndromeDecodingPromise.yes bits := by + simp only [binarySyndromeDecodingPromise, + GapCVP.Factor400BinaryDecodingPromiseHardness.binarySyndromeDecodingPromise] + apply classicalDecide_congr + change (∃ _, _) ↔ ∃ _, _ + rw [(Function.RightInverse.surjective toOriginalSyndrome_ofOriginalSyndrome).exists] + exact exists_congr fun _ => by + simp only [encodeBinarySyndromeDecodingInstance, toOriginalSyndrome, + GapCVP.Factor400BinaryDecodingPromiseReduction.encodeBinarySyndromeDecodingInstance] + rfl + +private theorem binarySyndromeDecoding_no_iff_original (bits : List Bool) : + binarySyndromeDecodingPromise.no bits ↔ + GapCVP.Factor400BinaryDecodingPromiseHardness.binarySyndromeDecodingPromise.no bits := by + simp only [binarySyndromeDecodingPromise, + GapCVP.Factor400BinaryDecodingPromiseHardness.binarySyndromeDecodingPromise] + apply classicalDecide_congr + change (∃ _, _) ↔ ∃ _, _ + rw [(Function.RightInverse.surjective toOriginalSyndrome_ofOriginalSyndrome).exists] + exact exists_congr fun _ => by + simp only [encodeBinarySyndromeDecodingInstance, toOriginalSyndrome, + GapCVP.Factor400BinaryDecodingPromiseReduction.encodeBinarySyndromeDecodingInstance] + rfl + +private theorem finiteP_yes_iff_original (p : ℚ) (hp : 1 ≤ p) + (bits : List Bool) : + (finitePGapCVPPromise p hp).yes bits ↔ + (GapCVP.Factor400FinitePNormCorollary.finitePGapCVPPromise p hp).yes bits := by + simp only [finitePGapCVPPromise, wellFormed, + GapCVP.Factor400FinitePNormCorollary.finitePGapCVPPromise, + GapCVP.gapCVPWellFormed] + apply classicalDecide_congr + change (∃ _, _) ↔ ∃ _, _ + rw [(Function.RightInverse.surjective toOriginal_ofOriginal).exists] + exact exists_congr fun _ => by + simp only [GapCVP.binaryFinEncoding, encodeInstance, toOriginal] + rfl + +private theorem finiteP_no_iff_original (p : ℚ) (hp : 1 ≤ p) + (bits : List Bool) : + (finitePGapCVPPromise p hp).no bits ↔ + (GapCVP.Factor400FinitePNormCorollary.finitePGapCVPPromise p hp).no bits := by + simp only [finitePGapCVPPromise, wellFormed, + GapCVP.Factor400FinitePNormCorollary.finitePGapCVPPromise, + GapCVP.gapCVPWellFormed] + apply classicalDecide_congr + change (∃ _, _) ↔ ∃ _, _ + rw [(Function.RightInverse.surjective toOriginal_ofOriginal).exists] + exact exists_congr fun _ => by + simp only [GapCVP.binaryFinEncoding, encodeInstance, toOriginal] + rfl + +private theorem isNPHardPromise_of_original + {problem : PromiseProblem} {original : GapCVP.PromiseProblem} + (hyes : ∀ bits, problem.yes bits ↔ original.yes bits) + (hno : ∀ bits, problem.no bits ↔ original.no bits) + (hard : GapCVP.NPHardPromise original) : + IsNPHardPromise problem := by + unfold IsNPHardPromise + apply (classicalDecide_eq_true_iff _).mpr + intro language hnp + have original_hnp : GapCVP.IsNP language := hnp + have original_hard : + ∀ language : GapCVP.BitLanguage, + GapCVP.IsNP language → + Nonempty (GapCVP.PromiseReduction language original) := by + apply (classicalDecide_eq_true_iff _).mp + exact hard + obtain ⟨reduction⟩ := original_hard language original_hnp + exact ⟨{ + map := reduction.map + polynomial_time := reduction.polynomial_time + completeness := fun input hinput => + (hyes _).mpr (reduction.completeness input hinput) + soundness := fun input hinput => + (hno _).mpr (reduction.soundness input hinput) + }⟩ + +theorem gapCVP400IsNPHard : IsNPHardPromise gapCVP400Promise := + isNPHardPromise_of_original yesLanguage_iff_original noLanguage_iff_original + paperVariableArityPhysicalIntegerTargetNPHardPromise + +theorem binaryNearestCodewordIsNPHard : + IsNPHardPromise binaryNearestCodewordPromise := + isNPHardPromise_of_original + binaryNearestCodeword_yes_iff_original + binaryNearestCodeword_no_iff_original + binaryNearestCodeword_nphard_unconditional + +theorem binarySyndromeDecodingIsNPHard : + IsNPHardPromise binarySyndromeDecodingPromise := + isNPHardPromise_of_original + binarySyndromeDecoding_yes_iff_original + binarySyndromeDecoding_no_iff_original + binarySyndromeDecoding_nphard_unconditional + +theorem finitePNormGapCVPIsNPHard (p : ℚ) (hp : 1 ≤ p) : + IsNPHardPromise (finitePGapCVPPromise p hp) := + isNPHardPromise_of_original + (finiteP_yes_iff_original p hp) + (finiteP_no_iff_original p hp) + (paperVariableArityFinitePNPHardPromise p hp) + +end Comparator + +end GapCVP + +end diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 95cc1ffd4..d81bf631e 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -7199,3 +7199,53 @@ projects: msc: - "60E15" - "52A20" + - slug: gap-cvp + title: Polynomial-factor hardness of the closest vector problem + summary: >- + Formalizes polynomial-factor NP-hardness of the closest vector problem + through an explicit reduction from 3-SAT. The development also derives + NP-hardness of binary nearest codeword, binary syndrome decoding, and + finite p-norm variants of GapCVP. It includes machine-level polynomial-time + bounds, binary encodings, affine systems, Reed--Solomon-style interpolation, + and the lattice and coding-theory reductions needed by the final results. + branch: computational complexity and lattice problems + entry_module: LeanPool.GapCVP + authors: + - OpenAI + - Dean Cureton + source: + title: Ten Advances in Mathematics and Theoretical Computer Science + authors: + - OpenAI + url: https://github.com/openai/ten-proofs + github_repo: openai/ten-proofs + commit: 94bc0feb6a9ff12c7d31d6de640a725c9d43d2b6 + license: Apache-2.0 + status: verified + provenance: mix + main_declarations: + - GapCVP.Comparator.gapCVP400IsNPHard + main_results: + - declaration: GapCVP.Comparator.gapCVP400IsNPHard + informal: >- + GapCVP with approximation factor 400 is NP-hard as a promise problem. + - declaration: GapCVP.Comparator.binaryNearestCodewordIsNPHard + informal: >- + Binary nearest codeword is NP-hard as a promise problem. + - declaration: GapCVP.Comparator.binarySyndromeDecodingIsNPHard + informal: >- + Binary syndrome decoding is NP-hard as a promise problem. + - declaration: GapCVP.Comparator.finitePNormGapCVPIsNPHard + informal: >- + For every rational p at least one, the finite p-norm version of + GapCVP is NP-hard as a promise problem. + tags: + - computational-complexity + - np-hardness + - lattice-problems + - coding-theory + msc: + - "68Q17" + - "68Q25" + - "11H06" + - "94B35" From a1d49771282a04f48dc969bbff435ce847efbb34 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 4 Sep 2026 16:58:19 +0000 Subject: [PATCH 2/3] Fix GapCVP semicolon spacing --- LeanPool/GapCVP/Part04E.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/LeanPool/GapCVP/Part04E.lean b/LeanPool/GapCVP/Part04E.lean index 61fc6cf62..ffd8b3029 100644 --- a/LeanPool/GapCVP/Part04E.lean +++ b/LeanPool/GapCVP/Part04E.lean @@ -523,8 +523,8 @@ private noncomputable def boundedDependentRecordFold_totalTrace have hbudget := boundedFold_malformedTotalBudget_le computer bound input.length have htotal := rebound hphysical hbudget - convert htotal using 1 ; - simp [boundedRecordFoldOutput, hparse] ; rfl + convert htotal using 1; + simp [boundedRecordFoldOutput, hparse]; rfl | some parsed => obtain ⟨count, seed⟩ := parsed have hinput := parseUnaryBoundedFold_eq_word From a7499683d7798153c347246a73c481701132ff35 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 4 Sep 2026 21:38:00 +0000 Subject: [PATCH 3/3] Deduplicate GapCVP machine traces --- LeanPool/GapCVP/Part01A.lean | 38 ++ LeanPool/GapCVP/Part01B.lean | 8 - LeanPool/GapCVP/Part03B.lean | 65 +- LeanPool/GapCVP/Part03C.lean | 103 +-- LeanPool/GapCVP/Part03F.lean | 1154 +++++++++++++++++++--------------- LeanPool/GapCVP/Part04B.lean | 803 ++--------------------- LeanPool/GapCVP/Part04C.lean | 6 - LeanPool/GapCVP/Part04E.lean | 6 - LeanPool/GapCVP/Part04F.lean | 66 +- LeanPool/GapCVP/Part05A.lean | 146 ++--- LeanPool/GapCVP/Part05B.lean | 67 +- LeanPool/GapCVP/Part05C.lean | 189 ++---- LeanPool/GapCVP/Part05D.lean | 18 +- LeanPool/GapCVP/Part05E.lean | 61 +- LeanPool/GapCVP/Part05F.lean | 72 +-- LeanPool/GapCVP/Part06B.lean | 82 +-- LeanPool/GapCVP/Part06D.lean | 6 +- LeanPool/GapCVP/Part07A.lean | 2 +- LeanPool/GapCVP/Part10B.lean | 6 +- LeanPool/GapCVP/Part12B.lean | 2 +- LeanPool/GapCVP/Part12C.lean | 2 +- LeanPool/GapCVP/Part13.lean | 169 ++--- LeanPool/GapCVP/Part16B.lean | 2 +- LeanPool/GapCVP/Part17.lean | 150 ++--- 24 files changed, 1171 insertions(+), 2052 deletions(-) diff --git a/LeanPool/GapCVP/Part01A.lean b/LeanPool/GapCVP/Part01A.lean index 862c0d59e..f5b663293 100644 --- a/LeanPool/GapCVP/Part01A.lean +++ b/LeanPool/GapCVP/Part01A.lean @@ -40,6 +40,44 @@ def oneStep {α : Type*} {step : α → Option α} (source target : α) evals_in_steps := transition steps_le_m := Nat.le_refl 1 +/-- Repeatedly composes supplied one-step traces while consuming a list. -/ +def sweepTrace {α β : Type*} (step : α → Option α) + (configuration : List β → α) + (transition : ∀ symbol remaining, + EvalsToInTime step (configuration (symbol :: remaining)) + (some (configuration remaining)) 1) + (symbols : List β) : + EvalsToInTime step (configuration symbols) (some (configuration [])) symbols.length := by + induction symbols with + | nil => + simpa only [List.length_nil] using EvalsToInTime.refl step (configuration []) + | cons symbol symbols ih => + simpa only [List.length_cons] using + EvalsToInTime.trans step _ _ _ _ _ (transition symbol symbols) ih + +/-- Repeatedly applies a one-step transition while consuming a list. -/ +def sweep {α β : Type*} (step : α → Option α) + (configuration : List β → α) + (transition : ∀ symbol remaining, + step (configuration (symbol :: remaining)) = some (configuration remaining)) + (symbols : List β) : + EvalsToInTime step (configuration symbols) (some (configuration [])) symbols.length := by + exact sweepTrace step configuration + (fun symbol remaining => oneStep _ _ (transition symbol remaining)) symbols + +/-- Consumes a list and then applies one final transition. -/ +def sweepThen {α β : Type*} (step : α → Option α) + (configuration : List β → α) + (transition : ∀ symbol remaining, + step (configuration (symbol :: remaining)) = some (configuration remaining)) + (symbols : List β) {target : α} + (finish : step (configuration []) = some target) : + EvalsToInTime step (configuration symbols) (some target) (symbols.length + 1) := by + have hsweep := sweep step configuration transition symbols + have hfinish := oneStep _ _ finish + simpa only [Nat.add_comm] using + EvalsToInTime.trans step _ _ _ _ _ hsweep hfinish + /-- GapCVP reduction support. -/ def rebound {α : Type*} {step : α → Option α} {source : α} {target : Option α} {oldBudget newBudget : ℕ} diff --git a/LeanPool/GapCVP/Part01B.lean b/LeanPool/GapCVP/Part01B.lean index a890d52cb..ba750bc16 100644 --- a/LeanPool/GapCVP/Part01B.lean +++ b/LeanPool/GapCVP/Part01B.lean @@ -30,18 +30,10 @@ open GapCVP.CLTableauSimulationCert GapCVP.CLFullTableauEmitter abbrev PairedInputBlock (tm : Turing.FinTM2) := Fin (blockSize tm) → PairedInputTag -instance instFintypePairedInputBlock - (tm : Turing.FinTM2) : Fintype (PairedInputBlock tm) := by - infer_instance - /-- GapCVP reduction support. -/ abbrev PhaseMaskBlock (tm : Turing.FinTM2) := Fin (blockSize tm) → Bool -instance instFintypePhaseMaskBlock - (tm : Turing.FinTM2) : Fintype (PhaseMaskBlock tm) := by - infer_instance - /-- GapCVP reduction support. -/ def pairedInputBlockAt (tm : Turing.FinTM2) (width : ℕ) (x certificate : List Bool) diff --git a/LeanPool/GapCVP/Part03B.lean b/LeanPool/GapCVP/Part03B.lean index 284026bcb..3c983d4c1 100644 --- a/LeanPool/GapCVP/Part03B.lean +++ b/LeanPool/GapCVP/Part03B.lean @@ -82,54 +82,23 @@ private def payload_failureTrace EvalsToInTime payloadDecoderMachine.step (payloadConfiguration 4 input counter reversed output) (some (Turing.haltList payloadDecoderMachine (false :: output))) (input.length + counter.length + reversed.length + 1) := by - induction input generalizing counter reversed output with - | cons bit input ih => - have hfirst := oneStep _ _ (payload_failure_drop_input bit input counter reversed output) - have hrest := ih counter reversed output - have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 - (input.length + counter.length + reversed.length + 1) - _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, - Nat.reduceAdd, - Nat.add_assoc] using hboth - | nil => - induction counter generalizing reversed output with - | cons bit counter ih => - have hfirst := oneStep _ _ (payload_failure_drop_counter bit counter reversed output) - have hrest : - EvalsToInTime payloadDecoderMachine.step - (payloadConfiguration 4 [] counter reversed output) - (some (Turing.haltList payloadDecoderMachine - (false :: output))) - (counter.length + reversed.length + 1) := by - simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using ih reversed - output - have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 - (counter.length + reversed.length + 1) - _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, - Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using hboth - | nil => - induction reversed generalizing output with - | cons bit reversed ih => - have hfirst := oneStep _ _ (payload_failure_drop_reversed bit reversed output) - have hrest : - EvalsToInTime payloadDecoderMachine.step - (payloadConfiguration 4 [] [] reversed output) - (some (Turing.haltList payloadDecoderMachine - (false :: output))) - (reversed.length + 1) := by - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using ih - output - have hboth := EvalsToInTime.trans payloadDecoderMachine.step 1 (reversed.length + 1) - _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, - zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd] using hboth - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using - oneStep _ _ (payload_failure_finish output) + have hinput := TraceGolf.sweep payloadDecoderMachine.step + (fun current => payloadConfiguration 4 current counter reversed output) + (fun bit remaining => payload_failure_drop_input bit remaining counter reversed output) + input + have hcounter := TraceGolf.sweep payloadDecoderMachine.step + (fun current => payloadConfiguration 4 [] current reversed output) + (fun bit remaining => payload_failure_drop_counter bit remaining reversed output) + counter + have hreversed := TraceGolf.sweep payloadDecoderMachine.step + (fun current => payloadConfiguration 4 [] [] current output) + (fun bit remaining => payload_failure_drop_reversed bit remaining output) + reversed + have hfinish := oneStep _ _ (payload_failure_finish output) + have hfirst := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ hinput hcounter + have hsecond := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ hfirst hreversed + have hfull := EvalsToInTime.trans payloadDecoderMachine.step _ _ _ _ _ hsecond hfinish + exact rebound hfull (by omega) private def payload_missingPrefixTrace (count : ℕ) (counter reversed output : List Bool) : diff --git a/LeanPool/GapCVP/Part03C.lean b/LeanPool/GapCVP/Part03C.lean index 0a9159c26..aae0e26fb 100644 --- a/LeanPool/GapCVP/Part03C.lean +++ b/LeanPool/GapCVP/Part03C.lean @@ -181,52 +181,23 @@ private def suffix_failureTrace EvalsToInTime suffixDecoderMachine.step (suffixConfiguration 5 input counter reversed output) (some (Turing.haltList suffixDecoderMachine output)) (input.length + counter.length + reversed.length + 1) := by - induction input generalizing counter reversed output with - | cons bit input ih => - have hfirst := oneStep _ _ (suffix_failure_drop_input bit input counter reversed output) - have hrest := ih counter reversed output - have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 - (input.length + counter.length + reversed.length + 1) - _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, - Nat.reduceAdd, - Nat.add_assoc] using hboth - | nil => - induction counter generalizing reversed output with - | cons bit counter ih => - have hfirst := oneStep _ _ (suffix_failure_drop_counter bit counter reversed output) - have hrest : - EvalsToInTime suffixDecoderMachine.step - (suffixConfiguration 5 [] counter reversed output) - (some (Turing.haltList suffixDecoderMachine output)) - (counter.length + reversed.length + 1) := by - simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using ih reversed - output - have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 - (counter.length + reversed.length + 1) - _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, - Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using hboth - | nil => - induction reversed generalizing output with - | cons bit reversed ih => - have hfirst := oneStep _ _ (suffix_failure_drop_reversed bit reversed output) - have hrest : - EvalsToInTime suffixDecoderMachine.step - (suffixConfiguration 5 [] [] reversed output) - (some (Turing.haltList suffixDecoderMachine output)) - (reversed.length + 1) := by - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using ih - output - have hboth := EvalsToInTime.trans suffixDecoderMachine.step 1 (reversed.length + 1) - _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, - zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd] using hboth - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using - oneStep _ _ (suffix_failure_finish output) + have hinput := TraceGolf.sweep suffixDecoderMachine.step + (fun current => suffixConfiguration 5 current counter reversed output) + (fun bit remaining => suffix_failure_drop_input bit remaining counter reversed output) + input + have hcounter := TraceGolf.sweep suffixDecoderMachine.step + (fun current => suffixConfiguration 5 [] current reversed output) + (fun bit remaining => suffix_failure_drop_counter bit remaining reversed output) + counter + have hreversed := TraceGolf.sweep suffixDecoderMachine.step + (fun current => suffixConfiguration 5 [] [] current output) + (fun bit remaining => suffix_failure_drop_reversed bit remaining output) + reversed + have hfinish := oneStep _ _ (suffix_failure_finish output) + have h01 := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ hinput hcounter + have h012 := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ h01 hreversed + have hfull := EvalsToInTime.trans suffixDecoderMachine.step _ _ _ _ _ h012 hfinish + exact rebound hfull (by omega) private def suffix_missingPrefixTrace (count : ℕ) (counter reversed output : List Bool) : @@ -742,34 +713,18 @@ private def variable_failureTrace (some (Turing.haltList variableClauseMachine (false :: List.replicate count true))) (input.length + counter.length + 1) := by - induction input generalizing counter count with - | cons bit input ih => - have hfirst := oneStep _ _ (variable_failure_drop_input bit input counter count) - have hrest := ih counter count - have hboth := EvalsToInTime.trans variableClauseMachine.step 1 - (input.length + counter.length + 1) - _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, - Nat.reduceAdd, - Nat.add_assoc] using hboth - | nil => - induction counter generalizing count with - | cons bit counter ih => - have hfirst := oneStep _ _ (variable_failure_drop_counter bit counter count) - have hrest : - EvalsToInTime variableClauseMachine.step (variableConfiguration 6 [] counter count) - (some (Turing.haltList variableClauseMachine - (false :: List.replicate count true))) - (counter.length + 1) := by - simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using ih count - have hboth := EvalsToInTime.trans variableClauseMachine.step 1 (counter.length + 1) - _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, - Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd] using hboth - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using - oneStep _ _ (variable_failure_finish count) + have hinput := TraceGolf.sweep variableClauseMachine.step + (fun current => variableConfiguration 6 current counter count) + (fun bit remaining => variable_failure_drop_input bit remaining counter count) + input + have hcounter := TraceGolf.sweep variableClauseMachine.step + (fun current => variableConfiguration 6 [] current count) + (fun bit remaining => variable_failure_drop_counter bit remaining count) + counter + have hfinish := oneStep _ _ (variable_failure_finish count) + have hfirst := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hinput hcounter + have hfull := EvalsToInTime.trans variableClauseMachine.step _ _ _ _ _ hfirst hfinish + exact rebound hfull (by omega) private def variableScanPhase (payload : Bool) (position : Fin 3) : Fin 7 := if payload then variablePayloadLabel position diff --git a/LeanPool/GapCVP/Part03F.lean b/LeanPool/GapCVP/Part03F.lean index 837e67087..01c5ede9e 100644 --- a/LeanPool/GapCVP/Part03F.lean +++ b/LeanPool/GapCVP/Part03F.lean @@ -24,161 +24,158 @@ open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceTotalStructuralDeco open GapCVP.CNFSortingDedup -private def delimitedCompare_cleanupTrace +namespace DelimitedCompareTrace + +/-- Lifts each old-machine step outside the specialized comparison phase. -/ +abbrev NonComparisonStepLift + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) := + ∀ {first next}, first.l ≠ some (6 : Fin 12) → + delimitedPairComparisonMachine.step first = some next → + EvalsToInTime chosenStep first (some next) 1 + +/-- Clears the six comparison work tapes using any compatible machine step. -/ +def cleanup (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) (lift : NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (input firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 7 outcome - input firstCounter firstReversed - secondCounter secondReversed firstForward secondForward - source sourcePrefix output) + EvalsToInTime chosenStep (delimitedCompareConfiguration 7 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) (some (delimitedCompareConfiguration 8 outcome input [] [] [] [] [] [] source sourcePrefix output)) (firstCounter.length + firstReversed.length + secondCounter.length + secondReversed.length + firstForward.length + secondForward.length + 1) := by - induction firstCounter with - | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_cleanup_firstCounter outcome bit - input remaining firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst ih - exact rebound hfull (by simp only [List.length_cons, add_le_add_iff_right, - Order.add_one_le_iff, add_lt_add_iff_right, - lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction firstReversed with - | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_cleanup_firstReversed outcome bit - input remaining secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst ih - exact rebound hfull (by simp only [List.length_nil, zero_add, List.length_cons, - add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, - Order.lt_one_iff]) - | nil => - induction secondCounter with - | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_cleanup_secondCounter outcome bit - input remaining secondReversed firstForward secondForward - source sourcePrefix output) - have hfull := EvalsToInTime.trans - delimitedPairComparisonMachine.step _ _ _ _ _ hfirst ih - exact rebound hfull (by simp only [List.length_nil, add_zero, zero_add, - List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, - Order.lt_one_iff]) - | nil => - induction secondReversed with - | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_cleanup_secondReversed outcome bit - input remaining firstForward secondForward - source sourcePrefix output) - have hfull := EvalsToInTime.trans - delimitedPairComparisonMachine.step _ _ _ _ _ hfirst ih - exact rebound hfull (by simp only [List.length_nil, add_zero, zero_add, - List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, - Order.lt_one_iff]) - | nil => - induction firstForward with - | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_cleanup_firstForward outcome bit - input remaining secondForward - source sourcePrefix output) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step - _ _ _ _ _ hfirst ih - exact rebound hfull (by simp only [List.length_nil, add_zero, zero_add, - List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, - Order.lt_one_iff]) - | nil => - induction secondForward with - | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_cleanup_secondForward - outcome bit input remaining - source sourcePrefix output) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step - _ _ _ _ _ hfirst ih - exact rebound hfull (by simp only [List.length_nil, add_zero, zero_add, - List.length_cons, Std.le_refl]) - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - zero_add] using - oneStep _ _ (delimitedCompare_cleanup_finish outcome input source - sourcePrefix output) + have hfirstCounter := TraceGolf.sweepTrace chosenStep + (fun current => delimitedCompareConfiguration 7 outcome input current firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output) + (fun bit remaining => lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_cleanup_firstCounter outcome bit input remaining firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output)) + firstCounter + have hfirstReversed := TraceGolf.sweepTrace chosenStep + (fun current => delimitedCompareConfiguration 7 outcome input [] current secondCounter + secondReversed firstForward secondForward source sourcePrefix output) + (fun bit remaining => lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_cleanup_firstReversed outcome bit input remaining secondCounter + secondReversed firstForward secondForward source sourcePrefix output)) + firstReversed + have hsecondCounter := TraceGolf.sweepTrace chosenStep + (fun current => delimitedCompareConfiguration 7 outcome input [] [] current secondReversed + firstForward secondForward source sourcePrefix output) + (fun bit remaining => lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_cleanup_secondCounter outcome bit input remaining secondReversed + firstForward secondForward source sourcePrefix output)) + secondCounter + have hsecondReversed := TraceGolf.sweepTrace chosenStep + (fun current => delimitedCompareConfiguration 7 outcome input [] [] [] current firstForward + secondForward source sourcePrefix output) + (fun bit remaining => lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_cleanup_secondReversed outcome bit input remaining firstForward + secondForward source sourcePrefix output)) + secondReversed + have hfirstForward := TraceGolf.sweepTrace chosenStep + (fun current => delimitedCompareConfiguration 7 outcome input [] [] [] [] current + secondForward source sourcePrefix output) + (fun bit remaining => lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_cleanup_firstForward outcome bit input remaining secondForward + source sourcePrefix output)) + firstForward + have hsecondForward := TraceGolf.sweepTrace chosenStep + (fun current => delimitedCompareConfiguration 7 outcome input [] [] [] [] [] current + source sourcePrefix output) + (fun bit remaining => lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_cleanup_secondForward outcome bit input remaining + source sourcePrefix output)) + secondForward + have hfinish := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_cleanup_finish outcome input source sourcePrefix output) + have h01 := EvalsToInTime.trans chosenStep _ _ _ _ _ hfirstCounter hfirstReversed + have h012 := EvalsToInTime.trans chosenStep _ _ _ _ _ h01 hsecondCounter + have h0123 := EvalsToInTime.trans chosenStep _ _ _ _ _ h012 hsecondReversed + have h01234 := EvalsToInTime.trans chosenStep _ _ _ _ _ h0123 hfirstForward + have h012345 := EvalsToInTime.trans chosenStep _ _ _ _ _ h01234 hsecondForward + have hfull := EvalsToInTime.trans chosenStep _ _ _ _ _ h012345 hfinish + exact rebound hfull (by omega) + +end DelimitedCompareTrace -private def delimitedCompare_trailingTrace +/-- Restores the trailing input using any compatible machine step. -/ +def DelimitedCompareTrace.trailing + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) (lift : NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (input source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 8 outcome + EvalsToInTime chosenStep (delimitedCompareConfiguration 8 outcome input [] [] [] [] [] [] source sourcePrefix output) (some (delimitedCompareConfiguration 9 outcome - [] [] [] [] [] [] [] - (input.reverse ++ source) + [] [] [] [] [] [] [] (input.reverse ++ source) (List.replicate input.length true ++ sourcePrefix) output)) (input.length + 1) := by induction input generalizing source sourcePrefix with | nil => - simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, - List.replicate_zero, - zero_add] using oneStep _ _ (delimitedCompare_trailing_finish outcome source sourcePrefix - output) + simpa only [List.reverse_nil, List.nil_append, List.length_nil, List.replicate_zero, + zero_add] using + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_trailing_finish outcome source sourcePrefix output) | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_trailing_step outcome bit - remaining source sourcePrefix output) - have hrest := ih (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, - List.nil_append, + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_trailing_step outcome bit remaining source sourcePrefix output) + have hrest := ih (source := bit :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.reverse_cons, List.append_assoc, List.cons_append, List.nil_append, List.length_cons, List.replicate_succ, Nat.add_assoc, Nat.reduceAdd, - replicate_append_bit_cons] using hfull + replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest -private def delimitedCompare_sourceTrace - (outcome : EncodedWordOrdering) - (source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 10 outcome +/-- Restores the saved source using any compatible machine step. -/ +def DelimitedCompareTrace.source + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (outcome : EncodedWordOrdering) (source sourcePrefix output : List Bool) : + EvalsToInTime chosenStep (delimitedCompareConfiguration 10 outcome [] [] [] [] [] [] [] source sourcePrefix output) (some (delimitedCompareConfiguration 11 outcome - [] [] [] [] [] [] [] [] sourcePrefix - (false :: (source.reverse ++ output)))) + [] [] [] [] [] [] [] [] sourcePrefix (false :: (source.reverse ++ output)))) (source.length + 1) := by induction source generalizing output with | nil => - simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, - zero_add] using - oneStep _ _ (delimitedCompare_source_finish outcome sourcePrefix output) + simpa only [List.reverse_nil, List.nil_append, List.length_nil, zero_add] using + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_source_finish outcome sourcePrefix output) | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_source_step outcome bit - remaining sourcePrefix output) + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_source_step outcome bit remaining sourcePrefix output) have hrest := ih (output := bit :: output) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, - List.nil_append, - List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + simpa only [List.reverse_cons, List.append_assoc, List.cons_append, List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest -private def delimitedCompare_prefixTrace - (outcome : EncodedWordOrdering) - (sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 11 outcome +/-- Restores prefix markers and halts using any compatible machine step. -/ +def DelimitedCompareTrace.prefix + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (outcome : EncodedWordOrdering) (sourcePrefix output : List Bool) : + EvalsToInTime chosenStep (delimitedCompareConfiguration 11 outcome [] [] [] [] [] [] [] [] sourcePrefix output) (some (Turing.haltList delimitedPairComparisonMachine (List.replicate sourcePrefix.length true ++ output))) (sourcePrefix.length + 1) := by induction sourcePrefix generalizing output with | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, - zero_add] using - oneStep _ _ (delimitedCompare_prefix_finish outcome output) + simpa only [List.length_nil, List.replicate_zero, List.nil_append, zero_add] using + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_prefix_finish outcome output) | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_prefix_step outcome bit remaining output) + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_prefix_step outcome bit remaining output) have hrest := ih (output := true :: output) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, - List.cons_append, Nat.add_assoc, - Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] using hfull + simpa only [List.length_cons, List.replicate_succ, List.cons_append, Nat.add_assoc, + Nat.reduceAdd, SourceStructuralDecoder.replicate_true_append_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest /-- GapCVP reduction support. -/ def delimitedCompareRestoredWord @@ -188,67 +185,88 @@ def delimitedCompareRestoredWord false :: (source.reverse ++ input ++ encodedWordOrderingWord outcome ++ output) -/-- Internal support shared across GapCVP continuation modules. -/ -def delimitedCompareFinishTrace +/-- Restores every saved tape and halts using any compatible machine step. -/ +def DelimitedCompareTrace.finish + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (input firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 7 outcome - input firstCounter firstReversed - secondCounter secondReversed firstForward secondForward - source sourcePrefix output) + EvalsToInTime chosenStep (delimitedCompareConfiguration 7 outcome + input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) (some (Turing.haltList delimitedPairComparisonMachine - (delimitedCompareRestoredWord outcome - input source sourcePrefix output))) + (delimitedCompareRestoredWord outcome input source sourcePrefix output))) (firstCounter.length + firstReversed.length + secondCounter.length + secondReversed.length + firstForward.length + secondForward.length + 3 * input.length + source.length + sourcePrefix.length + 5) := by - have hcleanup := delimitedCompare_cleanupTrace outcome + have hcleanup := DelimitedCompareTrace.cleanup chosenStep lift outcome input firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output - have htrailing := delimitedCompare_trailingTrace outcome + have htrailing := DelimitedCompareTrace.trailing chosenStep lift outcome input source sourcePrefix output - have houtcome := oneStep _ _ (delimitedCompare_outcome_step outcome + have houtcome := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_outcome_step outcome (input.reverse ++ source) (List.replicate input.length true ++ sourcePrefix) output) - have hsource := delimitedCompare_sourceTrace outcome + have hsource := DelimitedCompareTrace.source chosenStep lift outcome (input.reverse ++ source) (List.replicate input.length true ++ sourcePrefix) (encodedWordOrderingWord outcome ++ output) have hprefix : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 11 outcome + EvalsToInTime chosenStep (delimitedCompareConfiguration 11 outcome [] [] [] [] [] [] [] [] (List.replicate input.length true ++ sourcePrefix) - (false :: - ((input.reverse ++ source).reverse ++ - (encodedWordOrderingWord outcome ++ output)))) + (false :: ((input.reverse ++ source).reverse ++ + (encodedWordOrderingWord outcome ++ output)))) (some (Turing.haltList delimitedPairComparisonMachine - (delimitedCompareRestoredWord outcome - input source sourcePrefix output))) + (delimitedCompareRestoredWord outcome input source sourcePrefix output))) ((List.replicate input.length true ++ sourcePrefix).length + 1) := by - simpa only [FinTM2.step, Fin.isValue, List.reverse_append, List.reverse_reverse, - List.append_assoc, + simpa only [List.reverse_append, List.reverse_reverse, List.append_assoc, delimitedCompareRestoredWord, List.length_append, List.length_replicate] using - delimitedCompare_prefixTrace outcome (List.replicate input.length true ++ sourcePrefix) - (false :: ((input.reverse ++ source).reverse ++ (encodedWordOrderingWord outcome ++ - output))) - have hfirst := EvalsToInTime.trans - delimitedPairComparisonMachine.step _ _ _ _ _ hcleanup htrailing - have hsecond := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst houtcome - have hthird := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hsecond hsource - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hthird hprefix + DelimitedCompareTrace.prefix chosenStep lift outcome + (List.replicate input.length true ++ sourcePrefix) + (false :: ((input.reverse ++ source).reverse ++ + (encodedWordOrderingWord outcome ++ output))) + have hfirst := EvalsToInTime.trans chosenStep _ _ _ _ _ hcleanup htrailing + have hsecond := EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst houtcome + have hthird := EvalsToInTime.trans chosenStep _ _ _ _ _ hsecond hsource + have hfull := EvalsToInTime.trans chosenStep _ _ _ _ _ hthird hprefix apply rebound hfull - simp only [List.length_append, List.length_reverse, - List.length_replicate] + simp only [List.length_append, List.length_reverse, List.length_replicate] omega /-- Internal support shared across GapCVP continuation modules. -/ -def delimitedCompareFirstPrefixTrace +def delimitedCompareFinishTrace + (outcome : EncodedWordOrdering) + (input firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 7 outcome + input firstCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output) + (some (Turing.haltList delimitedPairComparisonMachine + (delimitedCompareRestoredWord outcome + input source sourcePrefix output))) + (firstCounter.length + firstReversed.length + + secondCounter.length + secondReversed.length + + firstForward.length + secondForward.length + + 3 * input.length + source.length + sourcePrefix.length + 5) := by + exact DelimitedCompareTrace.finish delimitedPairComparisonMachine.step + (fun _ transition => oneStep _ _ transition) outcome input firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output + +/-- Reads the first unary prefix using any compatible machine step. -/ +def DelimitedCompareTrace.firstPrefix + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (count : ℕ) (tail firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome + EvalsToInTime chosenStep (delimitedCompareConfiguration 0 outcome (List.replicate count true ++ false :: tail) firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) @@ -261,33 +279,51 @@ def delimitedCompareFirstPrefixTrace (count + 1) := by induction count generalizing firstCounter source sourcePrefix with | zero => - simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add, - List.replicate_one, + simpa only [List.replicate_zero, List.nil_append, zero_add, List.replicate_one, List.cons_append] using - oneStep _ _ - (delimitedCompare_firstPrefix_delimiter outcome tail firstCounter firstReversed - secondCounter secondReversed - firstForward secondForward source sourcePrefix output) + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPrefix_delimiter outcome tail firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output) | succ count ih => - have hfirst := oneStep _ _ (delimitedCompare_firstPrefix_true outcome - (List.replicate count true ++ false :: tail) - firstCounter firstReversed - secondCounter secondReversed firstForward secondForward - source sourcePrefix output) + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPrefix_true outcome + (List.replicate count true ++ false :: tail) firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output) have hrest := ih (firstCounter := true :: firstCounter) - (source := true :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, - Nat.reduceAdd, - replicate_append_bit_cons] using hfull + (source := true :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.replicate_succ, List.cons_append, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest /-- Internal support shared across GapCVP continuation modules. -/ -def delimitedCompareFirstMissingPrefixTrace +def delimitedCompareFirstPrefixTrace (outcome : EncodedWordOrdering) (count : ℕ) - (firstCounter firstReversed secondCounter secondReversed + (tail firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 1 outcome + tail (List.replicate count true ++ firstCounter) + firstReversed secondCounter secondReversed + firstForward secondForward + (false :: (List.replicate count true ++ source)) + (List.replicate (count + 1) true ++ sourcePrefix) output)) + (count + 1) := by + exact DelimitedCompareTrace.firstPrefix delimitedPairComparisonMachine.step + (fun _ transition => oneStep _ _ transition) outcome count tail firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output + +/-- Detects a missing first delimiter using any compatible machine step. -/ +def DelimitedCompareTrace.firstMissingPrefix + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (outcome : EncodedWordOrdering) (count : ℕ) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime chosenStep (delimitedCompareConfiguration 0 outcome (List.replicate count true) firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) @@ -300,29 +336,50 @@ def delimitedCompareFirstMissingPrefixTrace (count + 1) := by induction count generalizing firstCounter source sourcePrefix with | zero => - simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using - oneStep _ _ - (delimitedCompare_firstPrefix_missing outcome firstCounter firstReversed secondCounter - secondReversed firstForward - secondForward source sourcePrefix output) + simpa only [List.replicate_zero, List.nil_append, zero_add] using + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPrefix_missing outcome firstCounter firstReversed secondCounter + secondReversed firstForward secondForward source sourcePrefix output) | succ count ih => - have hfirst := oneStep _ _ (delimitedCompare_firstPrefix_true outcome - (List.replicate count true) - firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPrefix_true outcome (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed firstForward secondForward + source sourcePrefix output) have hrest := ih (firstCounter := true :: firstCounter) - (source := true :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, - Nat.reduceAdd, - replicate_append_bit_cons] using hfull + (source := true :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.replicate_succ, List.cons_append, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest + +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareFirstMissingPrefixTrace + (outcome : EncodedWordOrdering) (count : ℕ) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 7 .invalid + [] (List.replicate count true ++ firstCounter) + firstReversed secondCounter secondReversed + firstForward secondForward + (List.replicate count true ++ source) + (List.replicate count true ++ sourcePrefix) output)) + (count + 1) := by + exact DelimitedCompareTrace.firstMissingPrefix delimitedPairComparisonMachine.step + (fun _ transition => oneStep _ _ transition) outcome count firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output -private def delimitedCompare_firstPayloadTrace +/-- Reads the first payload using any compatible machine step. -/ +private def DelimitedCompareTrace.firstPayload + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (payload tail firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 1 outcome + EvalsToInTime chosenStep (delimitedCompareConfiguration 1 outcome (payload ++ tail) (List.replicate payload.length true) firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) @@ -334,28 +391,58 @@ private def delimitedCompare_firstPayloadTrace (payload.length + 1) := by induction payload generalizing firstReversed source sourcePrefix with | nil => - simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, - List.reverse_nil, + simpa only [List.nil_append, List.length_nil, List.replicate_zero, List.reverse_nil, zero_add] using - oneStep _ _ - (delimitedCompare_firstPayload_finish outcome tail firstReversed secondCounter - secondReversed firstForward - secondForward source sourcePrefix output) + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPayload_finish outcome tail firstReversed secondCounter + secondReversed firstForward secondForward source sourcePrefix output) | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_firstPayload_step outcome bit true - (remaining ++ tail) - (List.replicate remaining.length true) - firstReversed secondCounter secondReversed + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPayload_step outcome bit true (remaining ++ tail) + (List.replicate remaining.length true) firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) - have hrest := ih - (firstReversed := bit :: firstReversed) - (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, - List.replicate_succ, - List.reverse_cons, List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd, - replicate_append_bit_cons] using hfull + have hrest := ih (firstReversed := bit :: firstReversed) + (source := bit :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.cons_append, List.length_cons, List.replicate_succ, List.reverse_cons, + List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest + +/-- Reads an incomplete first payload using any compatible machine step. -/ +def DelimitedCompareTrace.firstPartialPayload + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (outcome : EncodedWordOrdering) + (payload remainingCounter firstReversed + secondCounter secondReversed firstForward secondForward + source sourcePrefix output : List Bool) : + EvalsToInTime chosenStep (delimitedCompareConfiguration 1 outcome + payload (List.replicate payload.length true ++ remainingCounter) + firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 1 outcome + [] remainingCounter (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + payload.length := by + induction payload generalizing firstReversed source sourcePrefix with + | nil => + simpa only [List.length_nil, List.replicate_zero, List.nil_append, List.reverse_nil] using + EvalsToInTime.refl chosenStep + (delimitedCompareConfiguration 1 outcome [] remainingCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_firstPayload_step outcome bit true remaining + (List.replicate remaining.length true ++ remainingCounter) firstReversed secondCounter + secondReversed firstForward secondForward source sourcePrefix output) + have hrest := ih (firstReversed := bit :: firstReversed) + (source := bit :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.length_cons, List.replicate_succ, List.cons_append, List.reverse_cons, + List.append_assoc, List.nil_append, replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest /-- Internal support shared across GapCVP continuation modules. -/ def delimitedCompareFirstPartialPayloadTrace @@ -374,29 +461,46 @@ def delimitedCompareFirstPartialPayloadTrace (payload.reverse ++ source) (List.replicate payload.length true ++ sourcePrefix) output)) payload.length := by - induction payload generalizing firstReversed source sourcePrefix with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, - List.reverse_nil] using - EvalsToInTime.refl delimitedPairComparisonMachine.step - (delimitedCompareConfiguration 1 outcome [] remainingCounter firstReversed - secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_firstPayload_step outcome bit true - remaining - (List.replicate remaining.length true ++ remainingCounter) - firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih - (firstReversed := bit :: firstReversed) - (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, - List.cons_append, - List.reverse_cons, List.append_assoc, List.nil_append, replicate_append_bit_cons] - using hfull + exact DelimitedCompareTrace.firstPartialPayload delimitedPairComparisonMachine.step + (fun _ transition => oneStep _ _ transition) outcome payload remainingCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output + +/-- Reads the second unary prefix using any compatible machine step. -/ +def DelimitedCompareTrace.secondPrefix + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (outcome : EncodedWordOrdering) (count : ℕ) + (tail firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime chosenStep (delimitedCompareConfiguration 2 outcome + (List.replicate count true ++ false :: tail) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 3 outcome + tail firstCounter firstReversed + (List.replicate count true ++ secondCounter) secondReversed + firstForward secondForward + (false :: (List.replicate count true ++ source)) + (List.replicate (count + 1) true ++ sourcePrefix) output)) + (count + 1) := by + induction count generalizing secondCounter source sourcePrefix with + | zero => + simpa only [List.replicate_zero, List.nil_append, zero_add, List.replicate_one, + List.cons_append] using + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPrefix_delimiter outcome tail firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output) + | succ count ih => + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPrefix_true outcome + (List.replicate count true ++ false :: tail) firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output) + have hrest := ih (secondCounter := true :: secondCounter) + (source := true :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.replicate_succ, List.cons_append, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest /-- Internal support shared across GapCVP continuation modules. -/ def delimitedCompareSecondPrefixTrace @@ -414,28 +518,45 @@ def delimitedCompareSecondPrefixTrace (false :: (List.replicate count true ++ source)) (List.replicate (count + 1) true ++ sourcePrefix) output)) (count + 1) := by + exact DelimitedCompareTrace.secondPrefix delimitedPairComparisonMachine.step + (fun _ transition => oneStep _ _ transition) outcome count tail firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output + +/-- Detects a missing second delimiter using any compatible machine step. -/ +def DelimitedCompareTrace.secondMissingPrefix + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (outcome : EncodedWordOrdering) (count : ℕ) + (firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime chosenStep (delimitedCompareConfiguration 2 outcome + (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 7 .invalid + [] firstCounter firstReversed + (List.replicate count true ++ secondCounter) secondReversed + firstForward secondForward + (List.replicate count true ++ source) + (List.replicate count true ++ sourcePrefix) output)) + (count + 1) := by induction count generalizing secondCounter source sourcePrefix with | zero => - simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add, - List.replicate_one, - List.cons_append] using - oneStep _ _ - (delimitedCompare_secondPrefix_delimiter outcome tail firstCounter firstReversed - secondCounter secondReversed - firstForward secondForward source sourcePrefix output) + simpa only [List.replicate_zero, List.nil_append, zero_add] using + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPrefix_missing outcome firstCounter firstReversed secondCounter + secondReversed firstForward secondForward source sourcePrefix output) | succ count ih => - have hfirst := oneStep _ _ (delimitedCompare_secondPrefix_true outcome - (List.replicate count true ++ false :: tail) - firstCounter firstReversed - secondCounter secondReversed firstForward secondForward + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPrefix_true outcome (List.replicate count true) + firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) have hrest := ih (secondCounter := true :: secondCounter) - (source := true :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, - Nat.reduceAdd, - replicate_append_bit_cons] using hfull + (source := true :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.replicate_succ, List.cons_append, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest /-- Internal support shared across GapCVP continuation modules. -/ def delimitedCompareSecondMissingPrefixTrace @@ -453,64 +574,81 @@ def delimitedCompareSecondMissingPrefixTrace (List.replicate count true ++ source) (List.replicate count true ++ sourcePrefix) output)) (count + 1) := by - induction count generalizing secondCounter source sourcePrefix with - | zero => - simpa only [FinTM2.step, Fin.isValue, List.replicate_zero, List.nil_append, zero_add] using - oneStep _ _ - (delimitedCompare_secondPrefix_missing outcome firstCounter firstReversed secondCounter - secondReversed - firstForward secondForward source sourcePrefix output) - | succ count ih => - have hfirst := oneStep _ _ (delimitedCompare_secondPrefix_true outcome - (List.replicate count true) - firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih (secondCounter := true :: secondCounter) - (source := true :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_assoc, - Nat.reduceAdd, - replicate_append_bit_cons] using hfull + exact DelimitedCompareTrace.secondMissingPrefix delimitedPairComparisonMachine.step + (fun _ transition => oneStep _ _ transition) outcome count firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output -private def delimitedCompare_secondPayloadTrace +/-- Reads the second payload using any compatible machine step. -/ +private def DelimitedCompareTrace.secondPayload + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (payload tail firstCounter firstReversed secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 3 outcome + EvalsToInTime chosenStep (delimitedCompareConfiguration 3 outcome (payload ++ tail) firstCounter firstReversed (List.replicate payload.length true) secondReversed firstForward secondForward source sourcePrefix output) (some (delimitedCompareConfiguration 4 outcome - tail firstCounter firstReversed - [] (payload.reverse ++ secondReversed) - firstForward secondForward - (payload.reverse ++ source) + tail firstCounter firstReversed [] (payload.reverse ++ secondReversed) + firstForward secondForward (payload.reverse ++ source) (List.replicate payload.length true ++ sourcePrefix) output)) (payload.length + 1) := by induction payload generalizing secondReversed source sourcePrefix with | nil => - simpa only [FinTM2.step, Fin.isValue, List.nil_append, List.length_nil, List.replicate_zero, - List.reverse_nil, + simpa only [List.nil_append, List.length_nil, List.replicate_zero, List.reverse_nil, zero_add] using - oneStep _ _ - (delimitedCompare_secondPayload_finish outcome tail firstCounter firstReversed - secondReversed firstForward - secondForward source sourcePrefix output) + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPayload_finish outcome tail firstCounter firstReversed + secondReversed firstForward secondForward source sourcePrefix output) | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_secondPayload_step outcome bit true - (remaining ++ tail) firstCounter firstReversed - (List.replicate remaining.length true) secondReversed + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPayload_step outcome bit true (remaining ++ tail) + firstCounter firstReversed (List.replicate remaining.length true) secondReversed firstForward secondForward source sourcePrefix output) - have hrest := ih - (secondReversed := bit :: secondReversed) - (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.cons_append, List.length_cons, - List.replicate_succ, - List.reverse_cons, List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd, - replicate_append_bit_cons] using hfull + have hrest := ih (secondReversed := bit :: secondReversed) + (source := bit :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.cons_append, List.length_cons, List.replicate_succ, List.reverse_cons, + List.append_assoc, List.nil_append, Nat.add_assoc, Nat.reduceAdd, + replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest + +/-- Reads an incomplete second payload using any compatible machine step. -/ +def DelimitedCompareTrace.secondPartialPayload + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (outcome : EncodedWordOrdering) + (payload remainingCounter firstCounter firstReversed + secondReversed firstForward secondForward + source sourcePrefix output : List Bool) : + EvalsToInTime chosenStep (delimitedCompareConfiguration 3 outcome + payload firstCounter firstReversed + (List.replicate payload.length true ++ remainingCounter) + secondReversed firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 3 outcome + [] firstCounter firstReversed remainingCounter + (payload.reverse ++ secondReversed) firstForward secondForward + (payload.reverse ++ source) + (List.replicate payload.length true ++ sourcePrefix) output)) + payload.length := by + induction payload generalizing secondReversed source sourcePrefix with + | nil => + simpa only [List.length_nil, List.replicate_zero, List.nil_append, List.reverse_nil] using + EvalsToInTime.refl chosenStep + (delimitedCompareConfiguration 3 outcome [] firstCounter firstReversed remainingCounter + secondReversed firstForward secondForward source sourcePrefix output) + | cons bit remaining ih => + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_secondPayload_step outcome bit true remaining firstCounter firstReversed + (List.replicate remaining.length true ++ remainingCounter) secondReversed firstForward + secondForward source sourcePrefix output) + have hrest := ih (secondReversed := bit :: secondReversed) + (source := bit :: source) (sourcePrefix := true :: sourcePrefix) + simpa only [List.length_cons, List.replicate_succ, List.cons_append, List.reverse_cons, + List.append_assoc, List.nil_append, replicate_append_bit_cons] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest /-- Internal support shared across GapCVP continuation modules. -/ def delimitedCompareSecondPartialPayloadTrace @@ -530,36 +668,19 @@ def delimitedCompareSecondPartialPayloadTrace (payload.reverse ++ source) (List.replicate payload.length true ++ sourcePrefix) output)) payload.length := by - induction payload generalizing secondReversed source sourcePrefix with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, - List.reverse_nil] using - EvalsToInTime.refl delimitedPairComparisonMachine.step - (delimitedCompareConfiguration 3 outcome [] firstCounter firstReversed remainingCounter - secondReversed - firstForward secondForward source sourcePrefix output) - | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_secondPayload_step outcome bit true - remaining firstCounter firstReversed - (List.replicate remaining.length true ++ remainingCounter) - secondReversed firstForward secondForward - source sourcePrefix output) - have hrest := ih - (secondReversed := bit :: secondReversed) - (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.length_cons, List.replicate_succ, - List.cons_append, - List.reverse_cons, List.append_assoc, List.nil_append, replicate_append_bit_cons] - using hfull + exact DelimitedCompareTrace.secondPartialPayload delimitedPairComparisonMachine.step + (fun _ transition => oneStep _ _ transition) outcome payload remainingCounter firstCounter + firstReversed secondReversed firstForward secondForward source sourcePrefix output -/-- Internal support shared across GapCVP continuation modules. -/ -def delimitedCompareFirstRecordTrace +/-- Reads the first length-prefixed record using any compatible machine step. -/ +def DelimitedCompareTrace.firstRecord + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (payload tail firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome + EvalsToInTime chosenStep (delimitedCompareConfiguration 0 outcome (lengthPrefixedWord payload ++ tail) [] firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) @@ -567,179 +688,173 @@ def delimitedCompareFirstRecordTrace tail [] (payload.reverse ++ firstReversed) secondCounter secondReversed firstForward secondForward ((lengthPrefixedWord payload).reverse ++ source) - (List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix) - output)) + (List.replicate (lengthPrefixedWord payload).length true ++ sourcePrefix) output)) (2 * payload.length + 2) := by - have hprefix := delimitedCompareFirstPrefixTrace outcome - payload.length (payload ++ tail) [] firstReversed - secondCounter secondReversed firstForward secondForward - source sourcePrefix output + have hprefix := DelimitedCompareTrace.firstPrefix chosenStep lift outcome + payload.length (payload ++ tail) [] firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output simp only [List.append_nil] at hprefix - have hpayload := delimitedCompare_firstPayloadTrace outcome - payload tail firstReversed secondCounter secondReversed - firstForward secondForward + have hpayload := DelimitedCompareTrace.firstPayload chosenStep lift outcome + payload tail firstReversed secondCounter secondReversed firstForward secondForward (false :: (List.replicate payload.length true ++ source)) - (List.replicate (payload.length + 1) true ++ sourcePrefix) - output - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hprefix hpayload - have hsource : - payload.reverse ++ - (false :: (List.replicate payload.length true ++ source)) = + (List.replicate (payload.length + 1) true ++ sourcePrefix) output + have hfull := EvalsToInTime.trans chosenStep _ _ _ _ _ hprefix hpayload + have hsource : payload.reverse ++ + (false :: (List.replicate payload.length true ++ source)) = (lengthPrefixedWord payload).reverse ++ source := by simp only [lengthPrefixedWord, List.reverse_append, List.reverse_cons, List.reverse_replicate, - List.append_assoc, List.cons_append, List.nil_append] - have hmarkers : - List.replicate payload.length true ++ - (List.replicate (payload.length + 1) true ++ sourcePrefix) = - List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix := by - have hlength : - payload.length + (payload.length + 1) = - (lengthPrefixedWord payload).length := by + List.append_assoc, List.cons_append, List.nil_append] + have hmarkers : List.replicate payload.length true ++ + (List.replicate (payload.length + 1) true ++ sourcePrefix) = + List.replicate (lengthPrefixedWord payload).length true ++ sourcePrefix := by + have hlength : payload.length + (payload.length + 1) = + (lengthPrefixedWord payload).length := by simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] rw [← List.append_assoc, ← List.replicate_add, hlength] rw [hsource, hmarkers] at hfull - have hcast : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome - (lengthPrefixedWord payload ++ tail) - [] firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - (some (delimitedCompareConfiguration 2 outcome - tail [] (payload.reverse ++ firstReversed) - secondCounter secondReversed firstForward secondForward - ((lengthPrefixedWord payload).reverse ++ source) - (List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix) - output)) - ((payload.length + 1) + (payload.length + 1)) := by - simpa only [lengthPrefixedWord, List.append_assoc, - List.cons_append] using hfull + have hcast : EvalsToInTime chosenStep + (delimitedCompareConfiguration 0 outcome (lengthPrefixedWord payload ++ tail) + [] firstReversed secondCounter secondReversed firstForward secondForward + source sourcePrefix output) + (some (delimitedCompareConfiguration 2 outcome tail [] + (payload.reverse ++ firstReversed) secondCounter secondReversed firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ sourcePrefix) output)) + ((payload.length + 1) + (payload.length + 1)) := by + simpa only [lengthPrefixedWord, List.append_assoc, List.cons_append] using hfull exact rebound hcast (by omega) -private def delimitedCompare_secondRecordTrace +/-- Internal support shared across GapCVP continuation modules. -/ +def delimitedCompareFirstRecordTrace (outcome : EncodedWordOrdering) - (payload tail firstCounter firstReversed secondReversed + (payload tail firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 outcome + EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 outcome (lengthPrefixedWord payload ++ tail) - firstCounter firstReversed [] secondReversed + [] firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) - (some (delimitedCompareConfiguration 4 outcome - tail firstCounter firstReversed [] - (payload.reverse ++ secondReversed) - firstForward secondForward + (some (delimitedCompareConfiguration 2 outcome + tail [] (payload.reverse ++ firstReversed) + secondCounter secondReversed firstForward secondForward ((lengthPrefixedWord payload).reverse ++ source) (List.replicate (lengthPrefixedWord payload).length true ++ sourcePrefix) output)) (2 * payload.length + 2) := by - have hprefix := delimitedCompareSecondPrefixTrace outcome - payload.length (payload ++ tail) firstCounter firstReversed [] - secondReversed firstForward secondForward - source sourcePrefix output + exact DelimitedCompareTrace.firstRecord delimitedPairComparisonMachine.step + (fun _ transition => oneStep _ _ transition) outcome payload tail firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output + +/-- Reads the second length-prefixed record using any compatible machine step. -/ +def DelimitedCompareTrace.secondRecord + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (outcome : EncodedWordOrdering) + (payload tail firstCounter firstReversed secondReversed + firstForward secondForward source sourcePrefix output : List Bool) : + EvalsToInTime chosenStep (delimitedCompareConfiguration 2 outcome + (lengthPrefixedWord payload ++ tail) + firstCounter firstReversed [] secondReversed + firstForward secondForward source sourcePrefix output) + (some (delimitedCompareConfiguration 4 outcome + tail firstCounter firstReversed [] (payload.reverse ++ secondReversed) + firstForward secondForward ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ sourcePrefix) output)) + (2 * payload.length + 2) := by + have hprefix := DelimitedCompareTrace.secondPrefix chosenStep lift outcome + payload.length (payload ++ tail) firstCounter firstReversed [] secondReversed + firstForward secondForward source sourcePrefix output simp only [List.append_nil] at hprefix - have hpayload := delimitedCompare_secondPayloadTrace outcome - payload tail firstCounter firstReversed secondReversed - firstForward secondForward + have hpayload := DelimitedCompareTrace.secondPayload chosenStep lift outcome + payload tail firstCounter firstReversed secondReversed firstForward secondForward (false :: (List.replicate payload.length true ++ source)) - (List.replicate (payload.length + 1) true ++ sourcePrefix) - output - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hprefix hpayload - have hsource : - payload.reverse ++ - (false :: (List.replicate payload.length true ++ source)) = + (List.replicate (payload.length + 1) true ++ sourcePrefix) output + have hfull := EvalsToInTime.trans chosenStep _ _ _ _ _ hprefix hpayload + have hsource : payload.reverse ++ + (false :: (List.replicate payload.length true ++ source)) = (lengthPrefixedWord payload).reverse ++ source := by simp only [lengthPrefixedWord, List.reverse_append, List.reverse_cons, List.reverse_replicate, - List.append_assoc, List.cons_append, List.nil_append] - have hmarkers : - List.replicate payload.length true ++ - (List.replicate (payload.length + 1) true ++ sourcePrefix) = - List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix := by - have hlength : - payload.length + (payload.length + 1) = - (lengthPrefixedWord payload).length := by + List.append_assoc, List.cons_append, List.nil_append] + have hmarkers : List.replicate payload.length true ++ + (List.replicate (payload.length + 1) true ++ sourcePrefix) = + List.replicate (lengthPrefixedWord payload).length true ++ sourcePrefix := by + have hlength : payload.length + (payload.length + 1) = + (lengthPrefixedWord payload).length := by simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] rw [← List.append_assoc, ← List.replicate_add, hlength] rw [hsource, hmarkers] at hfull - have hcast : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 outcome - (lengthPrefixedWord payload ++ tail) - firstCounter firstReversed [] secondReversed - firstForward secondForward source sourcePrefix output) - (some (delimitedCompareConfiguration 4 outcome - tail firstCounter firstReversed [] - (payload.reverse ++ secondReversed) - firstForward secondForward - ((lengthPrefixedWord payload).reverse ++ source) - (List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix) - output)) - ((payload.length + 1) + (payload.length + 1)) := by - simpa only [lengthPrefixedWord, List.append_assoc, - List.cons_append] using hfull + have hcast : EvalsToInTime chosenStep + (delimitedCompareConfiguration 2 outcome (lengthPrefixedWord payload ++ tail) + firstCounter firstReversed [] secondReversed firstForward secondForward + source sourcePrefix output) + (some (delimitedCompareConfiguration 4 outcome tail firstCounter firstReversed [] + (payload.reverse ++ secondReversed) firstForward secondForward + ((lengthPrefixedWord payload).reverse ++ source) + (List.replicate (lengthPrefixedWord payload).length true ++ sourcePrefix) output)) + ((payload.length + 1) + (payload.length + 1)) := by + simpa only [lengthPrefixedWord, List.append_assoc, List.cons_append] using hfull exact rebound hcast (by omega) -private def delimitedCompare_reverseFirstTrace +/-- Reverses the first payload using any compatible machine step. -/ +private def DelimitedCompareTrace.reverseFirst + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (input firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 4 outcome + EvalsToInTime chosenStep (delimitedCompareConfiguration 4 outcome input firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) (some (delimitedCompareConfiguration 5 outcome input firstCounter [] secondCounter secondReversed - (firstReversed.reverse ++ firstForward) secondForward - source sourcePrefix output)) + (firstReversed.reverse ++ firstForward) secondForward source sourcePrefix output)) (firstReversed.length + 1) := by induction firstReversed generalizing firstForward with | nil => - simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, - zero_add] using - oneStep _ _ - (delimitedCompare_reverseFirst_finish outcome input firstCounter secondCounter - secondReversed firstForward - secondForward source sourcePrefix output) + simpa only [List.reverse_nil, List.nil_append, List.length_nil, zero_add] using + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_reverseFirst_finish outcome input firstCounter secondCounter + secondReversed firstForward secondForward source sourcePrefix output) | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_reverseFirst_step outcome bit - input firstCounter remaining secondCounter secondReversed - firstForward secondForward source sourcePrefix output) + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_reverseFirst_step outcome bit input firstCounter remaining + secondCounter secondReversed firstForward secondForward source sourcePrefix output) have hrest := ih (firstForward := bit :: firstForward) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, - List.nil_append, - List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + simpa only [List.reverse_cons, List.append_assoc, List.cons_append, List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest -private def delimitedCompare_reverseSecondTrace +/-- Reverses the second payload using any compatible machine step. -/ +private def DelimitedCompareTrace.reverseSecond + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) (outcome : EncodedWordOrdering) (input firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 5 outcome + EvalsToInTime chosenStep (delimitedCompareConfiguration 5 outcome input firstCounter firstReversed secondCounter secondReversed firstForward secondForward source sourcePrefix output) (some (delimitedCompareConfiguration 6 outcome input firstCounter firstReversed secondCounter [] - firstForward (secondReversed.reverse ++ secondForward) - source sourcePrefix output)) + firstForward (secondReversed.reverse ++ secondForward) source sourcePrefix output)) (secondReversed.length + 1) := by induction secondReversed generalizing secondForward with | nil => - simpa only [FinTM2.step, Fin.isValue, List.reverse_nil, List.nil_append, List.length_nil, - zero_add] using - oneStep _ _ - (delimitedCompare_reverseSecond_finish outcome input firstCounter firstReversed - secondCounter firstForward - secondForward source sourcePrefix output) + simpa only [List.reverse_nil, List.nil_append, List.length_nil, zero_add] using + lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_reverseSecond_finish outcome input firstCounter firstReversed + secondCounter firstForward secondForward source sourcePrefix output) | cons bit remaining ih => - have hfirst := oneStep _ _ (delimitedCompare_reverseSecond_step outcome bit - input firstCounter firstReversed secondCounter remaining - firstForward secondForward source sourcePrefix output) + have hfirst := lift (by simp [delimitedCompareConfiguration]) + (delimitedCompare_reverseSecond_step outcome bit input firstCounter firstReversed + secondCounter remaining firstForward secondForward source sourcePrefix output) have hrest := ih (secondForward := bit :: secondForward) - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hrest - simpa only [FinTM2.step, Fin.isValue, List.reverse_cons, List.append_assoc, List.cons_append, - List.nil_append, - List.length_cons, Nat.add_assoc, Nat.reduceAdd] using hfull + simpa only [List.reverse_cons, List.append_assoc, List.cons_append, List.nil_append, + List.length_cons, Nat.add_assoc, Nat.reduceAdd] using + EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst hrest private def lexicographicEncodedWordResiduals : List Bool → List Bool → List Bool × List Bool @@ -927,6 +1042,97 @@ private theorem lexicographicEncodedWordResiduals_second_length_le using Nat.le_trans (ih second) (Nat.le_succ second.length) +/-- Parses both records, runs a supplied phase-six comparison, and restores the input. -/ +def DelimitedCompareTrace.validAssembly + (chosenStep : delimitedPairComparisonMachine.Cfg → + Option delimitedPairComparisonMachine.Cfg) + (lift : DelimitedCompareTrace.NonComparisonStepLift chosenStep) + (first second suffix firstResidual secondResidual : List Bool) + (comparisonOutcome : EncodedWordOrdering) (comparisonTime : ℕ) + (comparisonTrace : EvalsToInTime chosenStep + (delimitedCompareConfiguration 6 .invalid + suffix [] [] [] [] first second + ((lengthPrefixedWord second).reverse ++ (lengthPrefixedWord first).reverse) + (List.replicate (lengthPrefixedWord second).length true ++ + List.replicate (lengthPrefixedWord first).length true) []) + (some (delimitedCompareConfiguration 7 comparisonOutcome + suffix [] [] [] [] firstResidual secondResidual + ((lengthPrefixedWord second).reverse ++ (lengthPrefixedWord first).reverse) + (List.replicate (lengthPrefixedWord second).length true ++ + List.replicate (lengthPrefixedWord first).length true) [])) + comparisonTime) : + EvalsToInTime chosenStep + (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedPairComparisonMachine + (delimitedCompareRestoredWord comparisonOutcome suffix + ((lengthPrefixedWord second).reverse ++ (lengthPrefixedWord first).reverse) + (List.replicate (lengthPrefixedWord second).length true ++ + List.replicate (lengthPrefixedWord first).length true) []))) + ((2 * first.length + 2) + (2 * second.length + 2) + + (first.length + 1) + (second.length + 1) + comparisonTime + + (firstResidual.length + secondResidual.length + 3 * suffix.length + + ((lengthPrefixedWord second).reverse ++ + (lengthPrefixedWord first).reverse).length + + (List.replicate (lengthPrefixedWord second).length true ++ + List.replicate (lengthPrefixedWord first).length true).length + 5)) := by + let firstCode := lengthPrefixedWord first + let secondCode := lengthPrefixedWord second + let saved := secondCode.reverse ++ firstCode.reverse + let prefixMarkers := + List.replicate secondCode.length true ++ List.replicate firstCode.length true + have hfirst := DelimitedCompareTrace.firstRecord chosenStep lift .invalid first + (lengthPrefixedWord second ++ suffix) [] [] [] [] [] [] [] [] + have hfirst' : EvalsToInTime chosenStep + (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] []) + (some (delimitedCompareConfiguration 2 .invalid + (lengthPrefixedWord second ++ suffix) [] first.reverse [] [] [] [] + firstCode.reverse (List.replicate firstCode.length true) [])) + (2 * first.length + 2) := by + simpa [firstCode, List.append_assoc] using hfirst + have hsecond := DelimitedCompareTrace.secondRecord chosenStep lift .invalid second suffix + [] first.reverse [] [] [] firstCode.reverse (List.replicate firstCode.length true) [] + have hsecond' : EvalsToInTime chosenStep + (delimitedCompareConfiguration 2 .invalid + (lengthPrefixedWord second ++ suffix) [] first.reverse [] [] [] [] + firstCode.reverse (List.replicate firstCode.length true) []) + (some (delimitedCompareConfiguration 4 .invalid + suffix [] first.reverse [] second.reverse [] [] saved prefixMarkers [])) + (2 * second.length + 2) := by + simpa [firstCode, secondCode, saved, prefixMarkers] using hsecond + have hreverseFirst := DelimitedCompareTrace.reverseFirst chosenStep lift .invalid + suffix [] first.reverse [] second.reverse [] [] saved prefixMarkers [] + have hreverseFirst' : EvalsToInTime chosenStep + (delimitedCompareConfiguration 4 .invalid + suffix [] first.reverse [] second.reverse [] [] saved prefixMarkers []) + (some (delimitedCompareConfiguration 5 .invalid + suffix [] [] [] second.reverse first [] saved prefixMarkers [])) + (first.length + 1) := by + simpa using hreverseFirst + have hreverseSecond := DelimitedCompareTrace.reverseSecond chosenStep lift .invalid + suffix [] [] [] second.reverse first [] saved prefixMarkers [] + have hreverseSecond' : EvalsToInTime chosenStep + (delimitedCompareConfiguration 5 .invalid + suffix [] [] [] second.reverse first [] saved prefixMarkers []) + (some (delimitedCompareConfiguration 6 .invalid + suffix [] [] [] [] first second saved prefixMarkers [])) + (second.length + 1) := by + simpa using hreverseSecond + have hfinish := DelimitedCompareTrace.finish chosenStep lift comparisonOutcome + suffix [] [] [] [] firstResidual secondResidual saved prefixMarkers [] + have h01 := EvalsToInTime.trans chosenStep _ _ _ _ _ hfirst' hsecond' + have h012 := EvalsToInTime.trans chosenStep _ _ _ _ _ h01 hreverseFirst' + have h0123 := EvalsToInTime.trans chosenStep _ _ _ _ _ h012 hreverseSecond' + have h01234 := EvalsToInTime.trans chosenStep _ _ _ _ _ h0123 comparisonTrace + have hfull := EvalsToInTime.trans chosenStep _ _ _ _ _ h01234 hfinish + apply rebound hfull + simp only [firstCode, secondCode, saved, prefixMarkers, List.length_nil, zero_add, + List.length_append, List.length_reverse, List.length_replicate] + omega + /-- Internal support shared across GapCVP continuation modules. -/ def delimitedCompareValidTrace (first second suffix : List Bool) : @@ -944,67 +1150,17 @@ def delimitedCompareValidTrace let firstCode := lengthPrefixedWord first let secondCode := lengthPrefixedWord second let saved := secondCode.reverse ++ firstCode.reverse - let prefixMarkers := - List.replicate secondCode.length true ++ - List.replicate firstCode.length true - have hfirst : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 0 .invalid - (lengthPrefixedWord first ++ - lengthPrefixedWord second ++ suffix) - [] [] [] [] [] [] [] [] []) - (some (delimitedCompareConfiguration 2 .invalid - (lengthPrefixedWord second ++ suffix) - [] first.reverse [] [] [] [] - firstCode.reverse - (List.replicate firstCode.length true) [])) - (2 * first.length + 2) := by - simpa [firstCode, List.append_assoc] using - delimitedCompareFirstRecordTrace .invalid first - (lengthPrefixedWord second ++ suffix) - [] [] [] [] [] [] [] [] - have hsecond : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 2 .invalid - (lengthPrefixedWord second ++ suffix) - [] first.reverse [] [] [] [] - firstCode.reverse - (List.replicate firstCode.length true) []) - (some (delimitedCompareConfiguration 4 .invalid - suffix [] first.reverse [] second.reverse [] [] - saved prefixMarkers [])) - (2 * second.length + 2) := by - simpa [firstCode, secondCode, saved, prefixMarkers] using - delimitedCompare_secondRecordTrace .invalid second suffix - [] first.reverse [] [] [] - firstCode.reverse (List.replicate firstCode.length true) [] - have hreverseFirst : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 4 .invalid - suffix [] first.reverse [] second.reverse [] [] - saved prefixMarkers []) - (some (delimitedCompareConfiguration 5 .invalid - suffix [] [] [] second.reverse first [] - saved prefixMarkers [])) - (first.length + 1) := by - simpa using delimitedCompare_reverseFirstTrace .invalid - suffix [] first.reverse [] second.reverse [] [] - saved prefixMarkers [] - have hreverseSecond : - EvalsToInTime delimitedPairComparisonMachine.step (delimitedCompareConfiguration 5 .invalid - suffix [] [] [] second.reverse first [] - saved prefixMarkers []) - (some (delimitedCompareConfiguration 6 .invalid - suffix [] [] [] [] first second saved prefixMarkers [])) - (second.length + 1) := by - simpa using delimitedCompare_reverseSecondTrace .invalid - suffix [] [] [] second.reverse first [] - saved prefixMarkers [] + let prefixMarkers := List.replicate secondCode.length true ++ + List.replicate firstCode.length true have hcompare := delimitedCompare_wordsTrace .invalid first second suffix [] [] [] [] saved prefixMarkers [] - have hfinish := delimitedCompareFinishTrace - (lexicographicEncodedWordOrdering first second) - suffix [] [] [] [] + have hassembly := DelimitedCompareTrace.validAssembly + delimitedPairComparisonMachine.step (fun _ transition => oneStep _ _ transition) + first second suffix (lexicographicEncodedWordResiduals first second).1 (lexicographicEncodedWordResiduals first second).2 - saved prefixMarkers [] + (lexicographicEncodedWordOrdering first second) (first.length + 1) + (by simpa only [firstCode, secondCode, saved, prefixMarkers] using hcompare) have hprefixLength : suffix.length + prefixMarkers.length = (lengthPrefixedWord first ++ @@ -1026,21 +1182,13 @@ def delimitedCompareValidTrace rw [hprefixLength] simp [saved, firstCode, secondCode, lengthPrefixedWord, List.reverse_append, List.append_assoc] - rw [hrestored] at hfinish - have h01 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ hfirst hsecond - have h012 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h01 hreverseFirst - have h0123 := EvalsToInTime.trans - delimitedPairComparisonMachine.step _ _ _ _ _ h012 hreverseSecond - have h01234 := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h0123 hcompare - have hfull := EvalsToInTime.trans delimitedPairComparisonMachine.step _ _ _ _ _ h01234 hfinish - apply rebound hfull + rw [← hrestored] + apply rebound hassembly have hfirstResidual := lexicographicEncodedWordResiduals_first_length_le first second have hsecondResidual := lexicographicEncodedWordResiduals_second_length_le first second - simp only [saved, prefixMarkers, firstCode, secondCode, - List.length_append, List.length_reverse, - List.length_replicate, List.length_nil, + simp only [List.length_append, List.length_reverse, List.length_replicate, lengthPrefixedWord_length] omega diff --git a/LeanPool/GapCVP/Part04B.lean b/LeanPool/GapCVP/Part04B.lean index e3bea05b3..20468259b 100644 --- a/LeanPool/GapCVP/Part04B.lean +++ b/LeanPool/GapCVP/Part04B.lean @@ -34,212 +34,9 @@ private def certifiedNatural_liftStep oneStep first next ((certifiedNatural_step_eq_old first hphase).trans hstep) -private def certifiedNatural_cleanupTrace - (outcome : EncodedWordOrdering) - (input firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 7 outcome - input firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - (some (naturalCompareConfiguration 8 outcome - input [] [] [] [] [] [] source sourcePrefix output)) - (firstCounter.length + firstReversed.length + - secondCounter.length + secondReversed.length + - firstForward.length + secondForward.length + 1) := by - induction firstCounter with - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_cleanup_firstCounter outcome bit - input remaining firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - exact rebound (EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst ih) - (by simp only [List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, - lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction firstReversed with - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_cleanup_firstReversed outcome bit - input remaining secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - exact rebound (EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst ih) - (by simp only [List.length_nil, zero_add, List.length_cons, add_le_add_iff_right, - Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction secondCounter with - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, - Option.some.injEq, Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_cleanup_secondCounter outcome bit - input remaining secondReversed firstForward secondForward - source sourcePrefix output) - exact rebound (EvalsToInTime.trans - delimitedNaturalComparisonMachine.step - _ _ _ _ _ hfirst ih) - (by simp only [List.length_nil, add_zero, zero_add, List.length_cons, - add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction secondReversed with - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, - Option.some.injEq, Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_cleanup_secondReversed outcome bit - input remaining firstForward secondForward - source sourcePrefix output) - exact rebound (EvalsToInTime.trans - delimitedNaturalComparisonMachine.step - _ _ _ _ _ hfirst ih) - (by simp only [List.length_nil, add_zero, zero_add, List.length_cons, - add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction firstForward with - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, - Option.some.injEq, Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_cleanup_firstForward outcome bit - input remaining secondForward - source sourcePrefix output) - exact rebound (EvalsToInTime.trans - delimitedNaturalComparisonMachine.step - _ _ _ _ _ hfirst ih) - (by simp only [List.length_nil, add_zero, zero_add, List.length_cons, - add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction secondForward with - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, - Option.some.injEq, Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_cleanup_secondForward - outcome bit input remaining - source sourcePrefix output) - exact rebound (EvalsToInTime.trans - delimitedNaturalComparisonMachine.step - _ _ _ _ _ hfirst ih) - (by simp only [List.length_nil, add_zero, zero_add, List.length_cons, - Std.le_refl]) - | nil => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, - List.length_nil, add_zero, zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_cleanup_finish outcome input source sourcePrefix - output) - -private def certifiedNatural_trailingTrace - (outcome : EncodedWordOrdering) - (input source sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 8 outcome - input [] [] [] [] [] [] source sourcePrefix output) - (some (naturalCompareConfiguration 9 outcome - [] [] [] [] [] [] [] - (input.reverse ++ source) - (List.replicate input.length true ++ sourcePrefix) output)) - (input.length + 1) := by - induction input generalizing source sourcePrefix with - | nil => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_nil, - List.nil_append, - List.length_nil, List.replicate_zero, zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_trailing_finish outcome source sourcePrefix output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_trailing_step outcome bit - remaining source sourcePrefix output) - have hrest := ih (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_cons, - List.append_assoc, - List.cons_append, List.nil_append, List.length_cons, List.replicate_succ, Nat.add_assoc, - Nat.reduceAdd, - replicate_append_bit_cons] using EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest - -private def certifiedNatural_sourceTrace - (outcome : EncodedWordOrdering) - (source sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 10 outcome - [] [] [] [] [] [] [] source sourcePrefix output) - (some (naturalCompareConfiguration 11 outcome - [] [] [] [] [] [] [] [] sourcePrefix - (false :: (source.reverse ++ output)))) - (source.length + 1) := by - induction source generalizing output with - | nil => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_nil, - List.nil_append, - List.length_nil, zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_source_finish outcome sourcePrefix output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_source_step outcome bit - remaining sourcePrefix output) - have hrest := ih (output := bit :: output) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_cons, - List.append_assoc, - List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, Nat.reduceAdd] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest - -private def certifiedNatural_prefixTrace - (outcome : EncodedWordOrdering) - (sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 11 outcome - [] [] [] [] [] [] [] [] sourcePrefix output) - (some (Turing.haltList delimitedNaturalComparisonMachine - (List.replicate sourcePrefix.length true ++ output))) - (sourcePrefix.length + 1) := by - induction sourcePrefix generalizing output with - | nil => - simpa only [delimitedNaturalComparisonMachine, Fin.isValue, FinTM2.step, - naturalCompareConfiguration, - haltList, List.length_nil, List.replicate_zero, List.nil_append, eq_mpr_eq_cast, cast_eq, - dite_eq_ite, zero_add, - delimitedPairComparisonMachine] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_prefix_finish outcome output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_prefix_step outcome bit remaining output) - have hrest := ih (output := true :: output) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.length_cons, - List.replicate_succ, - List.cons_append, Nat.add_assoc, Nat.reduceAdd, - SourceStructuralDecoder.replicate_true_append_cons] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + + + private def certifiedNatural_finishTrace (outcome : EncodedWordOrdering) @@ -256,51 +53,18 @@ private def certifiedNatural_finishTrace secondCounter.length + secondReversed.length + firstForward.length + secondForward.length + 3 * input.length + source.length + sourcePrefix.length + 5) := by - have hcleanup := certifiedNatural_cleanupTrace outcome - input firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output - have htrailing := certifiedNatural_trailingTrace outcome - input source sourcePrefix output - have houtcome := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_outcome_step outcome - (input.reverse ++ source) - (List.replicate input.length true ++ sourcePrefix) output) - have hsource := certifiedNatural_sourceTrace outcome - (input.reverse ++ source) - (List.replicate input.length true ++ sourcePrefix) - (encodedWordOrderingWord outcome ++ output) - have hprefix : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 11 outcome - [] [] [] [] [] [] [] [] - (List.replicate input.length true ++ sourcePrefix) - (false :: - ((input.reverse ++ source).reverse ++ - (encodedWordOrderingWord outcome ++ output)))) - (some (Turing.haltList delimitedNaturalComparisonMachine - (delimitedCompareRestoredWord outcome - input source sourcePrefix output))) - ((List.replicate input.length true ++ sourcePrefix).length + 1) := by - simpa only [FinTM2.step, Fin.isValue, List.reverse_append, List.reverse_reverse, - List.append_assoc, - delimitedCompareRestoredWord, List.length_append, List.length_replicate] using - certifiedNatural_prefixTrace outcome (List.replicate input.length true ++ sourcePrefix) - (false :: ((input.reverse ++ source).reverse ++ (encodedWordOrderingWord outcome ++ - output))) - have hfirst := EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hcleanup htrailing - have hsecond := EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst houtcome - have hthird := EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hsecond hsource - have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hthird hprefix - apply rebound hfull - simp only [List.length_append, List.length_reverse, - List.length_replicate] - omega + change EvalsToInTime delimitedNaturalComparisonMachine.step + (delimitedCompareConfiguration 7 outcome input firstCounter firstReversed + secondCounter secondReversed firstForward secondForward source sourcePrefix output) + (some (Turing.haltList delimitedPairComparisonMachine + (delimitedCompareRestoredWord outcome input source sourcePrefix output))) + (firstCounter.length + firstReversed.length + + secondCounter.length + secondReversed.length + + firstForward.length + secondForward.length + + 3 * input.length + source.length + sourcePrefix.length + 5) + exact DelimitedCompareTrace.finish delimitedNaturalComparisonMachine.step + certifiedNatural_liftStep outcome input firstCounter firstReversed secondCounter + secondReversed firstForward secondForward source sourcePrefix output private def certifiedNatural_firstPrefixTrace (outcome : EncodedWordOrdering) (count : ℕ) @@ -317,31 +81,9 @@ private def certifiedNatural_firstPrefixTrace (false :: (List.replicate count true ++ source)) (List.replicate (count + 1) true ++ sourcePrefix) output)) (count + 1) := by - induction count generalizing firstCounter source sourcePrefix with - | zero => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_zero, - List.nil_append, - zero_add, List.replicate_one, List.cons_append] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_firstPrefix_delimiter outcome tail firstCounter firstReversed - secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - | succ count ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_firstPrefix_true outcome - (List.replicate count true ++ false :: tail) - firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih (firstCounter := true :: firstCounter) - (source := true :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_succ, - List.cons_append, - Nat.add_assoc, Nat.reduceAdd, replicate_append_bit_cons] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + exact DelimitedCompareTrace.firstPrefix delimitedNaturalComparisonMachine.step + certifiedNatural_liftStep outcome count tail firstCounter firstReversed secondCounter + secondReversed firstForward secondForward source sourcePrefix output private def certifiedNatural_firstMissingPrefixTrace (outcome : EncodedWordOrdering) (count : ℕ) @@ -358,74 +100,9 @@ private def certifiedNatural_firstMissingPrefixTrace (List.replicate count true ++ source) (List.replicate count true ++ sourcePrefix) output)) (count + 1) := by - induction count generalizing firstCounter source sourcePrefix with - | zero => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_zero, - List.nil_append, - zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_firstPrefix_missing outcome firstCounter firstReversed secondCounter - secondReversed firstForward - secondForward source sourcePrefix output) - | succ count ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_firstPrefix_true outcome - (List.replicate count true) - firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih (firstCounter := true :: firstCounter) - (source := true :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_succ, - List.cons_append, - Nat.add_assoc, Nat.reduceAdd, replicate_append_bit_cons] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest - -private def certifiedNatural_firstPayloadTrace - (outcome : EncodedWordOrdering) - (payload tail firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 1 outcome - (payload ++ tail) (List.replicate payload.length true) - firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - (some (naturalCompareConfiguration 2 outcome - tail [] (payload.reverse ++ firstReversed) - secondCounter secondReversed firstForward secondForward - (payload.reverse ++ source) - (List.replicate payload.length true ++ sourcePrefix) output)) - (payload.length + 1) := by - induction payload generalizing firstReversed source sourcePrefix with - | nil => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.nil_append, - List.length_nil, - List.replicate_zero, List.reverse_nil, zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_firstPayload_finish outcome tail firstReversed secondCounter - secondReversed firstForward - secondForward source sourcePrefix output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_firstPayload_step outcome bit true - (remaining ++ tail) (List.replicate remaining.length true) - firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih - (firstReversed := bit :: firstReversed) - (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.cons_append, - List.length_cons, - List.replicate_succ, List.reverse_cons, List.append_assoc, List.nil_append, - Nat.add_assoc, Nat.reduceAdd, - replicate_append_bit_cons] using EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + exact DelimitedCompareTrace.firstMissingPrefix delimitedNaturalComparisonMachine.step + certifiedNatural_liftStep outcome count firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output private def certifiedNatural_firstPartialPayloadTrace (outcome : EncodedWordOrdering) @@ -442,32 +119,9 @@ private def certifiedNatural_firstPartialPayloadTrace (payload.reverse ++ source) (List.replicate payload.length true ++ sourcePrefix) output)) payload.length := by - induction payload generalizing firstReversed source sourcePrefix with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, - List.reverse_nil] using - EvalsToInTime.refl delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 1 outcome [] remainingCounter firstReversed secondCounter - secondReversed firstForward - secondForward source sourcePrefix output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_firstPayload_step outcome bit true - remaining - (List.replicate remaining.length true ++ remainingCounter) - firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih (firstReversed := bit :: firstReversed) - (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.length_cons, - List.replicate_succ, - List.cons_append, List.reverse_cons, List.append_assoc, List.nil_append, - replicate_append_bit_cons] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + exact DelimitedCompareTrace.firstPartialPayload delimitedNaturalComparisonMachine.step + certifiedNatural_liftStep outcome payload remainingCounter firstReversed secondCounter + secondReversed firstForward secondForward source sourcePrefix output private def certifiedNatural_secondPrefixTrace (outcome : EncodedWordOrdering) (count : ℕ) @@ -484,31 +138,9 @@ private def certifiedNatural_secondPrefixTrace (false :: (List.replicate count true ++ source)) (List.replicate (count + 1) true ++ sourcePrefix) output)) (count + 1) := by - induction count generalizing secondCounter source sourcePrefix with - | zero => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_zero, - List.nil_append, - zero_add, List.replicate_one, List.cons_append] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_secondPrefix_delimiter outcome tail firstCounter firstReversed - secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - | succ count ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_secondPrefix_true outcome - (List.replicate count true ++ false :: tail) - firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih (secondCounter := true :: secondCounter) - (source := true :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_succ, - List.cons_append, - Nat.add_assoc, Nat.reduceAdd, replicate_append_bit_cons] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + exact DelimitedCompareTrace.secondPrefix delimitedNaturalComparisonMachine.step + certifiedNatural_liftStep outcome count tail firstCounter firstReversed secondCounter + secondReversed firstForward secondForward source sourcePrefix output private def certifiedNatural_secondMissingPrefixTrace (outcome : EncodedWordOrdering) (count : ℕ) @@ -525,74 +157,9 @@ private def certifiedNatural_secondMissingPrefixTrace (List.replicate count true ++ source) (List.replicate count true ++ sourcePrefix) output)) (count + 1) := by - induction count generalizing secondCounter source sourcePrefix with - | zero => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_zero, - List.nil_append, - zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_secondPrefix_missing outcome firstCounter firstReversed secondCounter - secondReversed - firstForward secondForward source sourcePrefix output) - | succ count ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_secondPrefix_true outcome - (List.replicate count true) - firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih (secondCounter := true :: secondCounter) - (source := true :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.replicate_succ, - List.cons_append, - Nat.add_assoc, Nat.reduceAdd, replicate_append_bit_cons] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest - -private def certifiedNatural_secondPayloadTrace - (outcome : EncodedWordOrdering) - (payload tail firstCounter firstReversed secondReversed - firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 3 outcome - (payload ++ tail) firstCounter firstReversed - (List.replicate payload.length true) secondReversed - firstForward secondForward source sourcePrefix output) - (some (naturalCompareConfiguration 4 outcome - tail firstCounter firstReversed [] - (payload.reverse ++ secondReversed) - firstForward secondForward - (payload.reverse ++ source) - (List.replicate payload.length true ++ sourcePrefix) output)) - (payload.length + 1) := by - induction payload generalizing secondReversed source sourcePrefix with - | nil => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.nil_append, - List.length_nil, - List.replicate_zero, List.reverse_nil, zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_secondPayload_finish outcome tail firstCounter firstReversed - secondReversed firstForward - secondForward source sourcePrefix output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_secondPayload_step outcome bit true - (remaining ++ tail) firstCounter firstReversed - (List.replicate remaining.length true) secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih (secondReversed := bit :: secondReversed) - (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.cons_append, - List.length_cons, - List.replicate_succ, List.reverse_cons, List.append_assoc, List.nil_append, - Nat.add_assoc, Nat.reduceAdd, - replicate_append_bit_cons] using EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + exact DelimitedCompareTrace.secondMissingPrefix delimitedNaturalComparisonMachine.step + certifiedNatural_liftStep outcome count firstCounter firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output private def certifiedNatural_secondPartialPayloadTrace (outcome : EncodedWordOrdering) @@ -611,32 +178,9 @@ private def certifiedNatural_secondPartialPayloadTrace (payload.reverse ++ source) (List.replicate payload.length true ++ sourcePrefix) output)) payload.length := by - induction payload generalizing secondReversed source sourcePrefix with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.replicate_zero, List.nil_append, - List.reverse_nil] using - EvalsToInTime.refl delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 3 outcome [] firstCounter firstReversed remainingCounter - secondReversed firstForward - secondForward source sourcePrefix output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_secondPayload_step outcome bit true - remaining firstCounter firstReversed - (List.replicate remaining.length true ++ remainingCounter) - secondReversed firstForward secondForward - source sourcePrefix output) - have hrest := ih (secondReversed := bit :: secondReversed) - (source := bit :: source) - (sourcePrefix := true :: sourcePrefix) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.length_cons, - List.replicate_succ, - List.cons_append, List.reverse_cons, List.append_assoc, List.nil_append, - replicate_append_bit_cons] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + exact DelimitedCompareTrace.secondPartialPayload delimitedNaturalComparisonMachine.step + certifiedNatural_liftStep outcome payload remainingCounter firstCounter firstReversed + secondReversed firstForward secondForward source sourcePrefix output private def certifiedNatural_firstRecordTrace (outcome : EncodedWordOrdering) @@ -653,183 +197,10 @@ private def certifiedNatural_firstRecordTrace (List.replicate (lengthPrefixedWord payload).length true ++ sourcePrefix) output)) (2 * payload.length + 2) := by - have hprefix := certifiedNatural_firstPrefixTrace outcome - payload.length (payload ++ tail) [] firstReversed - secondCounter secondReversed firstForward secondForward - source sourcePrefix output - simp only [List.append_nil] at hprefix - have hpayload := certifiedNatural_firstPayloadTrace outcome - payload tail firstReversed secondCounter secondReversed - firstForward secondForward - (false :: (List.replicate payload.length true ++ source)) - (List.replicate (payload.length + 1) true ++ sourcePrefix) output - have hfull := EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hprefix hpayload - have hsource : - payload.reverse ++ - (false :: (List.replicate payload.length true ++ source)) = - (lengthPrefixedWord payload).reverse ++ source := by - simp only [lengthPrefixedWord, List.reverse_append, List.reverse_cons, List.reverse_replicate, - List.append_assoc, List.cons_append, List.nil_append] - have hmarkers : - List.replicate payload.length true ++ - (List.replicate (payload.length + 1) true ++ sourcePrefix) = - List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix := by - have hlength : - payload.length + (payload.length + 1) = - (lengthPrefixedWord payload).length := by - simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] - rw [← List.append_assoc, ← List.replicate_add, hlength] - rw [hsource, hmarkers] at hfull - have hcast : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 0 outcome - (lengthPrefixedWord payload ++ tail) - [] firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - (some (naturalCompareConfiguration 2 outcome - tail [] (payload.reverse ++ firstReversed) - secondCounter secondReversed firstForward secondForward - ((lengthPrefixedWord payload).reverse ++ source) - (List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix) output)) - ((payload.length + 1) + (payload.length + 1)) := by - simpa only [lengthPrefixedWord, List.append_assoc, - List.cons_append] using hfull - exact rebound hcast (by omega) - -private def certifiedNatural_secondRecordTrace - (outcome : EncodedWordOrdering) - (payload tail firstCounter firstReversed secondReversed - firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 2 outcome - (lengthPrefixedWord payload ++ tail) - firstCounter firstReversed [] secondReversed - firstForward secondForward source sourcePrefix output) - (some (naturalCompareConfiguration 4 outcome - tail firstCounter firstReversed [] - (payload.reverse ++ secondReversed) - firstForward secondForward - ((lengthPrefixedWord payload).reverse ++ source) - (List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix) output)) - (2 * payload.length + 2) := by - have hprefix := certifiedNatural_secondPrefixTrace outcome - payload.length (payload ++ tail) firstCounter firstReversed [] - secondReversed firstForward secondForward source sourcePrefix output - simp only [List.append_nil] at hprefix - have hpayload := certifiedNatural_secondPayloadTrace outcome - payload tail firstCounter firstReversed secondReversed - firstForward secondForward - (false :: (List.replicate payload.length true ++ source)) - (List.replicate (payload.length + 1) true ++ sourcePrefix) output - have hfull := EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ hprefix hpayload - have hsource : - payload.reverse ++ - (false :: (List.replicate payload.length true ++ source)) = - (lengthPrefixedWord payload).reverse ++ source := by - simp only [lengthPrefixedWord, List.reverse_append, List.reverse_cons, List.reverse_replicate, - List.append_assoc, List.cons_append, List.nil_append] - have hmarkers : - List.replicate payload.length true ++ - (List.replicate (payload.length + 1) true ++ sourcePrefix) = - List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix := by - have hlength : - payload.length + (payload.length + 1) = - (lengthPrefixedWord payload).length := by - simp only [lengthPrefixedWord, List.length_append, List.length_replicate, List.length_cons] - rw [← List.append_assoc, ← List.replicate_add, hlength] - rw [hsource, hmarkers] at hfull - have hcast : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 2 outcome - (lengthPrefixedWord payload ++ tail) - firstCounter firstReversed [] secondReversed - firstForward secondForward source sourcePrefix output) - (some (naturalCompareConfiguration 4 outcome - tail firstCounter firstReversed [] - (payload.reverse ++ secondReversed) - firstForward secondForward - ((lengthPrefixedWord payload).reverse ++ source) - (List.replicate (lengthPrefixedWord payload).length true ++ - sourcePrefix) output)) - ((payload.length + 1) + (payload.length + 1)) := by - simpa only [lengthPrefixedWord, List.append_assoc, - List.cons_append] using hfull - exact rebound hcast (by omega) - -private def certifiedNatural_reverseFirstTrace - (outcome : EncodedWordOrdering) - (input firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 4 outcome - input firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - (some (naturalCompareConfiguration 5 outcome - input firstCounter [] secondCounter secondReversed - (firstReversed.reverse ++ firstForward) secondForward - source sourcePrefix output)) - (firstReversed.length + 1) := by - induction firstReversed generalizing firstForward with - | nil => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_nil, - List.nil_append, - List.length_nil, zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_reverseFirst_finish outcome input firstCounter secondCounter - secondReversed firstForward - secondForward source sourcePrefix output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_reverseFirst_step outcome bit - input firstCounter remaining secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - have hrest := ih (firstForward := bit :: firstForward) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_cons, - List.append_assoc, - List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, Nat.reduceAdd] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest - -private def certifiedNatural_reverseSecondTrace - (outcome : EncodedWordOrdering) - (input firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output : List Bool) : - EvalsToInTime delimitedNaturalComparisonMachine.step (naturalCompareConfiguration 5 outcome - input firstCounter firstReversed secondCounter secondReversed - firstForward secondForward source sourcePrefix output) - (some (naturalCompareConfiguration 6 outcome - input firstCounter firstReversed secondCounter [] - firstForward (secondReversed.reverse ++ secondForward) - source sourcePrefix output)) - (secondReversed.length + 1) := by - induction secondReversed generalizing secondForward with - | nil => - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_nil, - List.nil_append, - List.length_nil, zero_add] using - certifiedNatural_liftStep (by simp [delimitedCompareConfiguration]) - (delimitedCompare_reverseSecond_finish outcome input firstCounter firstReversed - secondCounter firstForward - secondForward source sourcePrefix output) - | cons bit remaining ih => - have hfirst := certifiedNatural_liftStep - (by simp only [delimitedCompareConfiguration, Fin.isValue, ne_eq, Option.some.injEq, - Fin.reduceEq, - not_false_eq_true]) - (delimitedCompare_reverseSecond_step outcome bit - input firstCounter firstReversed secondCounter remaining - firstForward secondForward source sourcePrefix output) - have hrest := ih (secondForward := bit :: secondForward) - simpa only [FinTM2.step, Fin.isValue, naturalCompareConfiguration, List.reverse_cons, - List.append_assoc, - List.cons_append, List.nil_append, List.length_cons, Nat.add_assoc, Nat.reduceAdd] using - EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hrest + exact DelimitedCompareTrace.firstRecord delimitedNaturalComparisonMachine.step + certifiedNatural_liftStep outcome payload tail firstReversed secondCounter secondReversed + firstForward secondForward source sourcePrefix output + private def certifiedNatural_validTrace (first second suffix : List Bool) : @@ -844,69 +215,35 @@ private def certifiedNatural_validTrace (24 * ((lengthPrefixedWord first ++ lengthPrefixedWord second ++ suffix).length + 1) + 24) := by + change EvalsToInTime delimitedNaturalComparisonMachine.step + (delimitedCompareConfiguration 0 .invalid + (lengthPrefixedWord first ++ lengthPrefixedWord second ++ suffix) + [] [] [] [] [] [] [] [] []) + (some (Turing.haltList delimitedPairComparisonMachine + (sourcePreservingDelimitedNaturalComparisonWord + (lengthPrefixedWord first ++ lengthPrefixedWord second ++ suffix)))) + (24 * ((lengthPrefixedWord first ++ + lengthPrefixedWord second ++ suffix).length + 1) + 24) let firstCode := lengthPrefixedWord first let secondCode := lengthPrefixedWord second let saved := secondCode.reverse ++ firstCode.reverse - let prefixMarkers := - List.replicate secondCode.length true ++ - List.replicate firstCode.length true - have hfirst : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 0 .invalid - (lengthPrefixedWord first ++ - lengthPrefixedWord second ++ suffix) - [] [] [] [] [] [] [] [] []) - (some (naturalCompareConfiguration 2 .invalid - (lengthPrefixedWord second ++ suffix) - [] first.reverse [] [] [] [] firstCode.reverse - (List.replicate firstCode.length true) [])) - (2 * first.length + 2) := by - simpa [firstCode, List.append_assoc] using - certifiedNatural_firstRecordTrace .invalid first - (lengthPrefixedWord second ++ suffix) - [] [] [] [] [] [] [] [] - have hsecond : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 2 .invalid - (lengthPrefixedWord second ++ suffix) - [] first.reverse [] [] [] [] firstCode.reverse - (List.replicate firstCode.length true) []) - (some (naturalCompareConfiguration 4 .invalid - suffix [] first.reverse [] second.reverse [] [] - saved prefixMarkers [])) - (2 * second.length + 2) := by - simpa [firstCode, secondCode, saved, prefixMarkers] using - certifiedNatural_secondRecordTrace .invalid second suffix - [] first.reverse [] [] [] - firstCode.reverse (List.replicate firstCode.length true) [] - have hreverseFirst : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 4 .invalid - suffix [] first.reverse [] second.reverse [] [] - saved prefixMarkers []) - (some (naturalCompareConfiguration 5 .invalid - suffix [] [] [] second.reverse first [] - saved prefixMarkers [])) - (first.length + 1) := by - simpa using certifiedNatural_reverseFirstTrace .invalid - suffix [] first.reverse [] second.reverse [] [] - saved prefixMarkers [] - have hreverseSecond : - EvalsToInTime delimitedNaturalComparisonMachine.step - (naturalCompareConfiguration 5 .invalid - suffix [] [] [] second.reverse first [] - saved prefixMarkers []) - (some (naturalCompareConfiguration 6 .invalid - suffix [] [] [] [] first second saved prefixMarkers [])) - (second.length + 1) := by - simpa using certifiedNatural_reverseSecondTrace .invalid - suffix [] [] [] second.reverse first [] - saved prefixMarkers [] + let prefixMarkers := List.replicate secondCode.length true ++ + List.replicate firstCode.length true have hcompare := naturalCompareWordsTraceInitial first second suffix [] [] [] [] saved prefixMarkers [] - have hfinish := certifiedNatural_finishTrace - (littleEndianNaturalOrdering first second) - suffix [] [] [] [] [] [] saved prefixMarkers [] + change @EvalsToInTime delimitedPairComparisonMachine.Cfg + delimitedNaturalComparisonMachine.step + (delimitedCompareConfiguration 6 .invalid + suffix [] [] [] [] first second saved prefixMarkers []) + (some (delimitedCompareConfiguration 7 + (littleEndianNaturalOrdering first second) + suffix [] [] [] [] [] [] saved prefixMarkers [])) + (first.length + second.length + 1) at hcompare + have hassembly := DelimitedCompareTrace.validAssembly + delimitedNaturalComparisonMachine.step certifiedNatural_liftStep + first second suffix [] [] (littleEndianNaturalOrdering first second) + (first.length + second.length + 1) + (by simpa only [firstCode, secondCode, saved, prefixMarkers] using hcompare) have hprefixLength : suffix.length + prefixMarkers.length = (lengthPrefixedWord first ++ @@ -928,20 +265,10 @@ private def certifiedNatural_validTrace rw [hprefixLength] simp [saved, firstCode, secondCode, lengthPrefixedWord, List.reverse_append, List.append_assoc] - rw [hrestored] at hfinish - have h01 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ hfirst hsecond - have h012 := EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ h01 hreverseFirst - have h0123 := EvalsToInTime.trans - delimitedNaturalComparisonMachine.step _ _ _ _ _ h012 hreverseSecond - have h01234 := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h0123 - hcompare - have hfull := EvalsToInTime.trans delimitedNaturalComparisonMachine.step _ _ _ _ _ h01234 hfinish - apply rebound hfull - simp only [saved, prefixMarkers, firstCode, secondCode, - List.length_append, List.length_reverse, - List.length_replicate, List.length_nil, - lengthPrefixedWord_length] + rw [← hrestored] + apply rebound hassembly + simp only [List.length_append, List.length_reverse, List.length_replicate, + List.length_nil, lengthPrefixedWord_length] omega private def certifiedNatural_missingFirstTrace (count : ℕ) : diff --git a/LeanPool/GapCVP/Part04C.lean b/LeanPool/GapCVP/Part04C.lean index 3af9aa835..c98821f59 100644 --- a/LeanPool/GapCVP/Part04C.lean +++ b/LeanPool/GapCVP/Part04C.lean @@ -18,12 +18,6 @@ namespace GapCVP open GapCVP.TraceGolf (oneStep rebound) -namespace CNFPolynomialRowMarkerTM - -open Computability Turing GapCVP.BinaryEncoding GapCVP.SourceFormulaStructuralDecoder - -end CNFPolynomialRowMarkerTM - namespace CLStructuralCNFOutputMachinesUnconditional open Computability Turing GapCVP.BinaryEncoding GapCVP.CNFSortingDedup diff --git a/LeanPool/GapCVP/Part04E.lean b/LeanPool/GapCVP/Part04E.lean index ffd8b3029..59484cfc4 100644 --- a/LeanPool/GapCVP/Part04E.lean +++ b/LeanPool/GapCVP/Part04E.lean @@ -18,12 +18,6 @@ namespace GapCVP open GapCVP.TraceGolf (oneStep rebound) -namespace CNFTypedRecordWorkerTM - -open Turing GapCVP.CL GapCVP.OutputBoundedDependentRecordFold - -end CNFTypedRecordWorkerTM - namespace OutputBoundedDependentRecordFold open Turing diff --git a/LeanPool/GapCVP/Part04F.lean b/LeanPool/GapCVP/Part04F.lean index 4829e7192..5d063185a 100644 --- a/LeanPool/GapCVP/Part04F.lean +++ b/LeanPool/GapCVP/Part04F.lean @@ -197,50 +197,28 @@ private def flatLiteralRecord_invalidTrace (some (Turing.haltList actualFlatLiteralRecordWorker [])) (input.length + count.length + reversed.length + markers.length + 1) := by - induction count generalizing input reversed markers with - | cons bit count ih => - have hfirst := oneStep _ _ (flatLiteralRecord_invalid_count sign bit - input count reversed markers) - have hrest := ih input reversed markers - exact rebound (EvalsToInTime.trans - actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest) - (by simp only [List.length_cons, add_le_add_iff_right, Order.add_one_le_iff, - add_lt_add_iff_right, - add_lt_add_iff_left, lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction reversed generalizing input markers with - | cons bit reversed ih => - have hfirst := oneStep _ _ (flatLiteralRecord_invalid_reversed sign bit - input reversed markers) - have hrest := ih input markers - exact rebound (EvalsToInTime.trans - actualFlatLiteralRecordWorker.step _ _ _ _ _ hfirst hrest) - (by simp only [List.length_nil, add_zero, List.length_cons, add_le_add_iff_right, - Order.add_one_le_iff, - add_lt_add_iff_right, add_lt_add_iff_left, lt_add_iff_pos_right, - Order.lt_one_iff]) - | nil => - induction markers generalizing input with - | cons bit markers ih => - have hfirst := oneStep _ _ (flatLiteralRecord_invalid_markers sign bit input markers) - have hrest := ih input - exact rebound (EvalsToInTime.trans - actualFlatLiteralRecordWorker.step _ _ _ _ _ - hfirst hrest) - (by simp only [List.length_nil, add_zero, List.length_cons, add_le_add_iff_right, - Order.add_one_le_iff, - add_lt_add_iff_left, lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction input with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using - oneStep _ _ (flatLiteralRecord_invalid_finish sign) - | cons bit input ih => - have hfirst := oneStep _ _ (flatLiteralRecord_invalid_input sign bit input) - exact rebound (EvalsToInTime.trans - actualFlatLiteralRecordWorker.step _ _ _ _ _ - hfirst ih) - (by simp only [List.length_nil, add_zero, List.length_cons, Std.le_refl]) + have hcount := TraceGolf.sweep actualFlatLiteralRecordWorker.step + (fun current => flatLiteralRecordConfiguration 7 sign input current reversed markers [] []) + (fun bit remaining => flatLiteralRecord_invalid_count + sign bit input remaining reversed markers) + count + have hreversed := TraceGolf.sweep actualFlatLiteralRecordWorker.step + (fun current => flatLiteralRecordConfiguration 7 sign input [] current markers [] []) + (fun bit remaining => flatLiteralRecord_invalid_reversed sign bit input remaining markers) + reversed + have hmarkers := TraceGolf.sweep actualFlatLiteralRecordWorker.step + (fun current => flatLiteralRecordConfiguration 7 sign input [] [] current [] []) + (fun bit remaining => flatLiteralRecord_invalid_markers sign bit input remaining) + markers + have hinput := TraceGolf.sweep actualFlatLiteralRecordWorker.step + (fun current => flatLiteralRecordConfiguration 7 sign current [] [] [] [] []) + (flatLiteralRecord_invalid_input sign) input + have hfinish := oneStep _ _ (flatLiteralRecord_invalid_finish sign) + have h01 := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ hcount hreversed + have h012 := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ h01 hmarkers + have h0123 := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ h012 hinput + have hfull := EvalsToInTime.trans actualFlatLiteralRecordWorker.step _ _ _ _ _ h0123 hfinish + exact rebound hfull (by omega) private def flatLiteralRecord_truncatedPayloadTrace (sign : Bool) (payload : List Bool) (count : ℕ) diff --git a/LeanPool/GapCVP/Part05A.lean b/LeanPool/GapCVP/Part05A.lean index 0871913a3..baec30ca0 100644 --- a/LeanPool/GapCVP/Part05A.lean +++ b/LeanPool/GapCVP/Part05A.lean @@ -129,99 +129,59 @@ private def unaryPair_failureTrace (input.length + first.length + second.length + matchedFirst.length + matchedSecond.length + base.length + outer.length + scratch.length + 1) := by - induction input generalizing first second matchedFirst - matchedSecond base outer scratch with - | cons bit input ih => - have hfirst := oneStep _ _ (unaryPair_failure_input_step bit input first second - matchedFirst matchedSecond base outer scratch) - have hrest := ih first second matchedFirst matchedSecond - base outer scratch - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, - Nat.reduceAdd, - Nat.add_assoc] using EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ - hfirst hrest - | nil => - induction first generalizing second matchedFirst matchedSecond - base outer scratch with - | cons bit first ih => - have hfirst := oneStep _ _ (unaryPair_failure_first_step bit first second - matchedFirst matchedSecond base outer scratch) - have hrest := ih second matchedFirst matchedSecond - base outer scratch - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, - Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest - | nil => - induction second generalizing matchedFirst matchedSecond - base outer scratch with - | cons bit second ih => - have hfirst := oneStep _ _ (unaryPair_failure_second_step bit second - matchedFirst matchedSecond base outer scratch) - have hrest := ih matchedFirst matchedSecond - base outer scratch - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, - zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest - | nil => - induction matchedFirst generalizing matchedSecond - base outer scratch with - | cons bit matchedFirst ih => - have hfirst := oneStep _ _ (unaryPair_failure_matchedFirst_step bit - matchedFirst matchedSecond base outer scratch) - have hrest := ih matchedSecond base outer scratch - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - List.length_cons, zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst hrest - | nil => - induction matchedSecond generalizing - base outer scratch with - | cons bit matchedSecond ih => - have hfirst := oneStep _ _ (unaryPair_failure_matchedSecond_step bit - matchedSecond base outer scratch) - have hrest := ih base outer scratch - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - List.length_cons, zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst - hrest - | nil => - induction base generalizing outer scratch with - | cons bit base ih => - have hfirst := oneStep _ _ (unaryPair_failure_base_step bit - base outer scratch) - have hrest := ih outer scratch - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - List.length_cons, zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst - hrest - | nil => - induction outer generalizing scratch with - | cons bit outer ih => - have hfirst := oneStep _ _ (unaryPair_failure_outer_step bit - outer scratch) - have hrest := ih scratch - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - List.length_cons, zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ - hfirst hrest - | nil => - induction scratch with - | cons bit scratch ih => - have hfirst := oneStep _ _ (unaryPair_failure_scratch_step - bit scratch) - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - List.length_cons, zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd] using EvalsToInTime.trans - actualUnaryPairIndexMachine.step _ _ _ _ _ hfirst ih - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - zero_add] using - oneStep _ _ unaryPair_failure_finish + have hinput := TraceGolf.sweep actualUnaryPairIndexMachine.step + (fun current => unaryPairConfiguration 11 current first second matchedFirst matchedSecond + base outer [] scratch) + (fun bit remaining => unaryPair_failure_input_step bit remaining first second matchedFirst + matchedSecond base outer scratch) + input + have hfirst := TraceGolf.sweep actualUnaryPairIndexMachine.step + (fun current => unaryPairConfiguration 11 [] current second matchedFirst matchedSecond + base outer [] scratch) + (fun bit remaining => unaryPair_failure_first_step bit remaining second matchedFirst + matchedSecond base outer scratch) + first + have hsecond := TraceGolf.sweep actualUnaryPairIndexMachine.step + (fun current => unaryPairConfiguration 11 [] [] current matchedFirst matchedSecond + base outer [] scratch) + (fun bit remaining => unaryPair_failure_second_step bit remaining matchedFirst matchedSecond + base outer scratch) + second + have hmatchedFirst := TraceGolf.sweep actualUnaryPairIndexMachine.step + (fun current => unaryPairConfiguration 11 [] [] [] current matchedSecond base outer [] scratch) + (fun bit remaining => unaryPair_failure_matchedFirst_step bit remaining matchedSecond + base outer scratch) + matchedFirst + have hmatchedSecond := TraceGolf.sweep actualUnaryPairIndexMachine.step + (fun current => unaryPairConfiguration 11 [] [] [] [] current base outer [] scratch) + (fun bit remaining => unaryPair_failure_matchedSecond_step bit remaining base outer scratch) + matchedSecond + have hbase := TraceGolf.sweep actualUnaryPairIndexMachine.step + (fun current => unaryPairConfiguration 11 [] [] [] [] [] current outer [] scratch) + (fun bit remaining => unaryPair_failure_base_step bit remaining outer scratch) + base + have houter := TraceGolf.sweep actualUnaryPairIndexMachine.step + (fun current => unaryPairConfiguration 11 [] [] [] [] [] [] current [] scratch) + (fun bit remaining => unaryPair_failure_outer_step bit remaining scratch) + outer + have hscratch := TraceGolf.sweep actualUnaryPairIndexMachine.step + (fun current => unaryPairConfiguration 11 [] [] [] [] [] [] [] [] current) + unaryPair_failure_scratch_step scratch + have hfinish := oneStep _ _ unaryPair_failure_finish + have h01 := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ hinput hfirst + have h012 := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ h01 hsecond + have h0123 := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + h012 hmatchedFirst + have h01234 := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + h0123 hmatchedSecond + have h012345 := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ h01234 hbase + have h0123456 := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + h012345 houter + have h01234567 := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + h0123456 hscratch + have hfull := EvalsToInTime.trans actualUnaryPairIndexMachine.step _ _ _ _ _ + h01234567 hfinish + exact rebound hfull (by omega) private def unaryPair_firstMissingTrace (count : ℕ) diff --git a/LeanPool/GapCVP/Part05B.lean b/LeanPool/GapCVP/Part05B.lean index e88d8334a..d89cb4797 100644 --- a/LeanPool/GapCVP/Part05B.lean +++ b/LeanPool/GapCVP/Part05B.lean @@ -18,12 +18,6 @@ namespace GapCVP open GapCVP.TraceGolf (oneStep rebound) -namespace CNFSourcePairPrefixWorkerTM - -open Computability Turing GapCVP.BinaryEncoding GapCVP.CNFUnaryPairIndexTM - -end CNFSourcePairPrefixWorkerTM - namespace CNFSourcePairPrefixWorkerTotalCert open Computability Turing GapCVP.SourceTotalStructuralDecoder GapCVP.CNFUnaryPairIndexTM @@ -171,46 +165,27 @@ private def sourcePairPrefix_failureTrace (some (Turing.haltList actualSourcePairPrefixMachine [])) (input.length + first.length + second.length + output.length + 1) := by - induction input generalizing first second output with - | cons bit input ih => - have hfirst := oneStep _ _ (sourcePairPrefix_failure_input_step bit input - first second output) - have hrest := ih first second output - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, - Nat.reduceAdd, - Nat.add_assoc] using EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ - hfirst hrest - | nil => - induction first generalizing second output with - | cons bit first ih => - have hfirst := oneStep _ _ (sourcePairPrefix_failure_first_step bit first - second output) - have hrest := ih second output - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, - Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest - | nil => - induction second generalizing output with - | cons bit second ih => - have hfirst := oneStep _ _ (sourcePairPrefix_failure_second_step bit - second output) - have hrest := ih output - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, - zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst hrest - | nil => - induction output with - | cons bit output ih => - have hfirst := oneStep _ _ (sourcePairPrefix_failure_output_step bit output) - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - List.length_cons, zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd] using EvalsToInTime.trans - actualSourcePairPrefixMachine.step _ _ _ _ _ hfirst ih - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using - oneStep _ _ sourcePairPrefix_failure_finish + have hinput := TraceGolf.sweep actualSourcePairPrefixMachine.step + (fun current => sourcePairPrefixConfiguration 5 current first second output) + (fun bit remaining => sourcePairPrefix_failure_input_step bit remaining first second output) + input + have hfirst := TraceGolf.sweep actualSourcePairPrefixMachine.step + (fun current => sourcePairPrefixConfiguration 5 [] current second output) + (fun bit remaining => sourcePairPrefix_failure_first_step bit remaining second output) + first + have hsecond := TraceGolf.sweep actualSourcePairPrefixMachine.step + (fun current => sourcePairPrefixConfiguration 5 [] [] current output) + (fun bit remaining => sourcePairPrefix_failure_second_step bit remaining output) + second + have houtput := TraceGolf.sweep actualSourcePairPrefixMachine.step + (fun current => sourcePairPrefixConfiguration 5 [] [] [] current) + sourcePairPrefix_failure_output_step output + have hfinish := oneStep _ _ sourcePairPrefix_failure_finish + have h01 := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ hinput hfirst + have h012 := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ h01 hsecond + have h0123 := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ h012 houtput + have hfull := EvalsToInTime.trans actualSourcePairPrefixMachine.step _ _ _ _ _ h0123 hfinish + exact rebound hfull (by omega) private def sourcePairPrefix_firstMissingTrace (count : ℕ) (first second output : List Bool) : diff --git a/LeanPool/GapCVP/Part05C.lean b/LeanPool/GapCVP/Part05C.lean index c759b23e3..58aff80ba 100644 --- a/LeanPool/GapCVP/Part05C.lean +++ b/LeanPool/GapCVP/Part05C.lean @@ -34,66 +34,33 @@ private def rationalRadius_failureTrace (some (Turing.haltList rationalRadiusMachine [false])) (rationalRadiusFailureMeasure input base outer restore output + 1) := by - induction input generalizing base outer restore output with - | cons bit input ih => - have hfirst := oneStep _ _ (rationalRadius_failure_input_step - bit input base outer restore output) - have hrest := ih base outer restore output - have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest - exact rebound hfull (by - simp only [rationalRadiusFailureMeasure, List.length_cons, add_le_add_iff_right, - Order.add_one_le_iff, - add_lt_add_iff_right, lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction base generalizing outer restore output with - | cons bit base ih => - have hfirst := oneStep _ _ (rationalRadius_failure_base_step - bit base outer restore output) - have hrest := ih outer restore output - have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest - exact rebound hfull (by - simp only [rationalRadiusFailureMeasure, List.length_nil, zero_add, List.length_cons, - add_le_add_iff_right, - Order.add_one_le_iff, add_lt_add_iff_right, lt_add_iff_pos_right, - Order.lt_one_iff]) - | nil => - induction outer generalizing restore output with - | cons bit outer ih => - have hfirst := oneStep _ _ (rationalRadius_failure_outer_step - bit outer restore output) - have hrest := ih restore output - have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hfirst hrest - exact rebound hfull (by - simp only [rationalRadiusFailureMeasure, List.length_nil, add_zero, zero_add, - List.length_cons, - add_le_add_iff_right, Order.add_one_le_iff, add_lt_add_iff_right, - lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction restore generalizing output with - | cons bit restore ih => - have hfirst := oneStep _ _ (rationalRadius_failure_restore_step - bit restore output) - have hrest := ih output - have hfull := EvalsToInTime.trans - rationalRadiusMachine.step _ _ _ _ _ hfirst hrest - exact rebound hfull (by - simp only [rationalRadiusFailureMeasure, List.length_nil, add_zero, zero_add, - List.length_cons, - add_le_add_iff_right, Order.add_one_le_iff, add_lt_add_iff_right, - lt_add_iff_pos_right, Order.lt_one_iff]) - | nil => - induction output with - | nil => - simpa only [FinTM2.step, Fin.isValue, rationalRadiusFailureMeasure, - List.length_nil, add_zero, zero_add] using - oneStep _ _ rationalRadius_failure_finish - | cons bit output ih => - have hfirst := oneStep _ _ (rationalRadius_failure_output_step bit output) - have hfull := EvalsToInTime.trans - rationalRadiusMachine.step _ _ _ _ _ hfirst ih - exact rebound hfull (by - simp only [rationalRadiusFailureMeasure, List.length_nil, add_zero, - zero_add, List.length_cons, Std.le_refl]) + have hinput := TraceGolf.sweep rationalRadiusMachine.step + (fun current => rationalRadiusConfiguration 6 current base outer restore output) + (fun bit remaining => rationalRadius_failure_input_step + bit remaining base outer restore output) + input + have hbase := TraceGolf.sweep rationalRadiusMachine.step + (fun current => rationalRadiusConfiguration 6 [] current outer restore output) + (fun bit remaining => rationalRadius_failure_base_step bit remaining outer restore output) + base + have houter := TraceGolf.sweep rationalRadiusMachine.step + (fun current => rationalRadiusConfiguration 6 [] [] current restore output) + (fun bit remaining => rationalRadius_failure_outer_step bit remaining restore output) + outer + have hrestore := TraceGolf.sweep rationalRadiusMachine.step + (fun current => rationalRadiusConfiguration 6 [] [] [] current output) + (fun bit remaining => rationalRadius_failure_restore_step bit remaining output) + restore + have houtput := TraceGolf.sweep rationalRadiusMachine.step + (fun current => rationalRadiusConfiguration 6 [] [] [] [] current) + rationalRadius_failure_output_step output + have hfinish := oneStep _ _ rationalRadius_failure_finish + have h01 := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ hinput hbase + have h012 := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ h01 houter + have h0123 := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ h012 hrestore + have h01234 := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ h0123 houtput + have hfull := EvalsToInTime.trans rationalRadiusMachine.step _ _ _ _ _ h01234 hfinish + exact rebound hfull (by simp only [rationalRadiusFailureMeasure]; omega) private def rationalRadius_copyTrace (count : ℕ) (outer restore output : List Bool) : @@ -607,12 +574,6 @@ noncomputable def constructiveCanonicalSourceMarkerComputable : rw [← hfunctions] exact validatedPreservedFormulaComputable -theorem sourceAtomicFoldSeed_length_le - (input : List Bool) (count : ℕ) (seed : List Bool) - (hparse : parseUnaryBoundedFold input = some (count, seed)) : - seed.length ≤ input.length := by - exact GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse - end SourceWholeOutputAssemblyTM namespace SourceWholeOutputValidBranchRecordTM @@ -682,7 +643,7 @@ private theorem sourceFlatAtomicRecordStep_polynomiallyBoundedFoldStates : simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage hstage - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have hiterate : ∀ number : ℕ, ((sourceFlatAtomicRecordStep^[number]) seed).length ≤ @@ -1007,31 +968,6 @@ private theorem sourceFlatAtomic_failure_finish : some (Turing.haltList sourceFlatAtomicRecordMachine []) := by sourceFlatAtomicStepTac -private def sourceFlatAtomicSweepTrace - {Configuration : Type*} - (step : Configuration → Option Configuration) - (configuration : List Bool → Configuration) - (hstep : ∀ (bit : Bool) (remaining : List Bool), - step (configuration (bit :: remaining)) = - some (configuration remaining)) - (symbols : List Bool) : - EvalsToInTime step (configuration symbols) - (some (configuration [])) - symbols.length := by - induction symbols with - | nil => - simpa only [List.length_nil] using EvalsToInTime.refl step (configuration []) - | cons bit symbols ih => - have hfirst : EvalsToInTime step - (configuration (bit :: symbols)) - (some (configuration symbols)) 1 := { - steps := 1 - evals_in_steps := hstep bit symbols - steps_le_m := Nat.le_refl 1 - } - have hfull := EvalsToInTime.trans step _ _ _ _ _ hfirst ih - simpa only [List.length_cons] using hfull - private def sourceFlatAtomicFailureBudget (input counter payload pending output : List Bool) : ℕ := input.length + counter.length + payload.length + @@ -1044,35 +980,35 @@ private def sourceFlatAtomic_failureTrace (some (Turing.haltList sourceFlatAtomicRecordMachine [])) (sourceFlatAtomicFailureBudget input counter payload pending output) := by - have hinput := sourceFlatAtomicSweepTrace + have hinput := TraceGolf.sweep sourceFlatAtomicRecordMachine.step (fun current => sourceFlatAtomicConfiguration 5 current counter payload pending output) (fun bit remaining => sourceFlatAtomic_failure_input_step bit remaining counter payload pending output) input - have hcounter := sourceFlatAtomicSweepTrace + have hcounter := TraceGolf.sweep sourceFlatAtomicRecordMachine.step (fun current => sourceFlatAtomicConfiguration 5 [] current payload pending output) (fun bit remaining => sourceFlatAtomic_failure_counter_step bit remaining payload pending output) counter - have hpayload := sourceFlatAtomicSweepTrace + have hpayload := TraceGolf.sweep sourceFlatAtomicRecordMachine.step (fun current => sourceFlatAtomicConfiguration 5 [] [] current pending output) (fun bit remaining => sourceFlatAtomic_failure_payload_step bit remaining pending output) payload - have hpending := sourceFlatAtomicSweepTrace + have hpending := TraceGolf.sweep sourceFlatAtomicRecordMachine.step (fun current => sourceFlatAtomicConfiguration 5 [] [] [] current output) (fun bit remaining => sourceFlatAtomic_failure_pending_step bit remaining output) pending - have houtput := sourceFlatAtomicSweepTrace + have houtput := TraceGolf.sweep sourceFlatAtomicRecordMachine.step (fun current => sourceFlatAtomicConfiguration 5 [] [] [] [] current) @@ -1089,13 +1025,6 @@ private def sourceFlatAtomic_failureTrace simp only [sourceFlatAtomicFailureBudget] omega) -/-- Internal support shared across GapCVP continuation modules. -/ -theorem sourceFlatAtomic_trueCounter_append - (count : ℕ) (counter : List Bool) : - List.replicate count true ++ true :: counter = - List.replicate (count + 1) true ++ counter := by - exact GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count counter - private def sourceFlatAtomic_prefixTrace (count : ℕ) (tail counter payload pending output : List Bool) : @@ -1117,7 +1046,7 @@ private def sourceFlatAtomic_prefixTrace have hrest := ih (true :: counter) have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step 1 (count + 1) _ _ _ hfirst hrest - rw [sourceFlatAtomic_trueCounter_append count counter] at hfull + rw [GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count counter] at hfull simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull @@ -1214,6 +1143,12 @@ private def sourceFlatAtomic_restoreTrace List.nil_append, List.length_cons, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull +private theorem sourceFlatAtomicDescriptor_reconstruct + (record pending : List Bool) : + List.replicate record.length true ++ false :: (record ++ pending) = + sourceFlatAtomicDescriptor record ++ pending := by + simp only [sourceFlatAtomicDescriptor, lengthPrefixedWord, List.append_assoc, List.cons_append] + private def sourceFlatAtomic_validTrace (record pending : List Bool) : EvalsToInTime sourceFlatAtomicRecordMachine.step (Turing.initList sourceFlatAtomicRecordMachine @@ -1241,32 +1176,13 @@ private def sourceFlatAtomic_validTrace have hsecond := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hfirst hemit have hthird := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hsecond hpending have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step _ _ _ _ _ hthird hrestore - have hinput : - List.replicate record.length true ++ - false :: (record ++ pending) = - sourceFlatAtomicDescriptor record ++ pending := by - simp only [sourceFlatAtomicDescriptor, lengthPrefixedWord, List.append_assoc, List.cons_append] - rw [hinput] at hfull + rw [sourceFlatAtomicDescriptor_reconstruct] at hfull exact rebound hfull (by simp only [List.length_reverse, sourceFlatAtomicDescriptor, lengthPrefixedWord, List.append_assoc, List.cons_append, List.length_append, List.length_replicate, List.length_cons] omega) -/-- Internal support shared across GapCVP continuation modules. -/ -theorem sourceFlatAtomic_readUnaryPrefix_some - (input : List Bool) (count : ℕ) (tail : List Bool) - (hread : readUnaryPrefix input = some (count, tail)) : - input = List.replicate count true ++ false :: tail := by - exact GapCVP.SourceInterpolationRowTM.readUnaryPrefix_some_decompose input count tail hread - -/-- Internal support shared across GapCVP continuation modules. -/ -theorem sourceFlatAtomic_readUnaryPrefix_none - (input : List Bool) - (hread : readUnaryPrefix input = none) : - input = List.replicate input.length true := by - exact GapCVP.SourceInterpolationRowTM.readUnaryPrefix_none_eq_replicate input hread - private def sourceFlatAtomic_missingPrefixTrace (count : ℕ) (counter payload pending output : List Bool) : EvalsToInTime sourceFlatAtomicRecordMachine.step (sourceFlatAtomicConfiguration 0 @@ -1286,7 +1202,7 @@ private def sourceFlatAtomic_missingPrefixTrace have hrest := ih (true :: counter) have hfull := EvalsToInTime.trans sourceFlatAtomicRecordMachine.step 1 (count + 1) _ _ _ hfirst hrest - rw [sourceFlatAtomic_trueCounter_append count counter] at hfull + rw [GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count counter] at hfull simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull @@ -1337,6 +1253,11 @@ private def sourceFlatAtomic_truncatedPayloadTrace private noncomputable def sourceFlatAtomicTimePolynomial : Polynomial ℕ := 8 * Polynomial.X + 16 +private theorem sourceFlatAtomicTimePolynomial_eval (inputLength : ℕ) : + sourceFlatAtomicTimePolynomial.eval inputLength = 8 * inputLength + 16 := by + simp only [sourceFlatAtomicTimePolynomial, Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_ofNat, Polynomial.eval_X] + private noncomputable def sourceFlatAtomic_totalTrace (input : List Bool) : EvalsToInTime sourceFlatAtomicRecordMachine.step (Turing.initList sourceFlatAtomicRecordMachine input) @@ -1345,7 +1266,7 @@ private noncomputable def sourceFlatAtomic_totalTrace (input : List Bool) : (sourceFlatAtomicTimePolynomial.eval input.length) := by cases hprefix : readUnaryPrefix input with | none => - have hshape := sourceFlatAtomic_readUnaryPrefix_none + have hshape := GapCVP.SourceInterpolationRowTM.readUnaryPrefix_none_eq_replicate input hprefix have hscan := sourceFlatAtomic_missingPrefixTrace input.length [] [] [] [] @@ -1360,12 +1281,11 @@ private noncomputable def sourceFlatAtomic_totalTrace (input : List Bool) : rw [houtput] exact rebound hfull (by simp only [sourceFlatAtomicFailureBudget, List.length_nil, zero_add, add_zero, - sourceFlatAtomicTimePolynomial, - Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_ofNat, Polynomial.eval_X] + sourceFlatAtomicTimePolynomial_eval] omega) | some parsed => obtain ⟨count, tail⟩ := parsed - have hshape := sourceFlatAtomic_readUnaryPrefix_some + have hshape := GapCVP.SourceInterpolationRowTM.readUnaryPrefix_some_decompose input count tail hprefix by_cases hcomplete : count ≤ tail.length · have hread : @@ -1384,9 +1304,7 @@ private noncomputable def sourceFlatAtomic_totalTrace (input : List Bool) : simp only [sourceFlatAtomicRecordStep, hread] rw [houtput] exact rebound hphysical (by - simp only [sourceFlatAtomicTimePolynomial, Polynomial.eval_add, Polynomial.eval_mul, - Polynomial.eval_ofNat, - Polynomial.eval_X, Nat.reduceLeDiff] + simp only [sourceFlatAtomicTimePolynomial_eval, Nat.reduceLeDiff] omega) · have hshort : tail.length < count := by omega let missing : ℕ := count - tail.length - 1 @@ -1413,10 +1331,7 @@ private noncomputable def sourceFlatAtomic_totalTrace (input : List Bool) : rw [houtput] exact rebound hfull (by simp only [sourceFlatAtomicFailureBudget, List.length_nil, List.length_replicate, - zero_add, - List.length_reverse, add_zero, sourceFlatAtomicTimePolynomial, Polynomial.eval_add, - Polynomial.eval_mul, - Polynomial.eval_ofNat, Polynomial.eval_X] + zero_add, List.length_reverse, add_zero, sourceFlatAtomicTimePolynomial_eval] have hlength := congrArg List.length hshape simp only [List.length_append, List.length_replicate, List.length_cons] at hlength diff --git a/LeanPool/GapCVP/Part05D.lean b/LeanPool/GapCVP/Part05D.lean index 217121adf..d09fbe229 100644 --- a/LeanPool/GapCVP/Part05D.lean +++ b/LeanPool/GapCVP/Part05D.lean @@ -44,7 +44,7 @@ private def sourceGridIndex_prefixTrace have hrest := ih (true :: counter) have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step 1 (count + 1) _ _ _ hfirst hrest - rw [sourceFlatAtomic_trueCounter_append count counter] at hfull + rw [GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count counter] at hfull simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull @@ -114,8 +114,8 @@ private def sourceGridIndex_copyTrace have hrest := ih (true :: scratch) (true :: output) have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step 1 (count + 1) _ _ _ hfirst hrest - rw [sourceFlatAtomic_trueCounter_append count scratch, - sourceFlatAtomic_trueCounter_append count output] at hfull + rw [GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count scratch, + GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count output] at hfull simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull @@ -139,8 +139,8 @@ private def sourceGridIndex_templateRestoreTrace have hrest := ih (true :: counter) (true :: output) have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step 1 (count + 1) _ _ _ hfirst hrest - rw [sourceFlatAtomic_trueCounter_append count counter, - sourceFlatAtomic_trueCounter_append count output] at hfull + rw [GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count counter, + GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count output] at hfull simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull @@ -213,7 +213,7 @@ private def sourceGridIndex_missingPrefixTrace have hrest := ih (true :: counter) have hfull := EvalsToInTime.trans sourceCanonicalUnaryGridIndexMachine.step 1 (count + 1) _ _ _ hfirst hrest - rw [sourceFlatAtomic_trueCounter_append count counter] at hfull + rw [GapCVP.CNFUnaryPairIndexTotalCert.unaryPair_replicate_append_true count counter] at hfull simpa only [FinTM2.step, Fin.isValue, List.replicate_succ, List.cons_append, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using hfull @@ -251,7 +251,7 @@ private noncomputable def sourceCanonicalUnaryGridIndex_totalTrace (sourceCanonicalUnaryGridIndexTimePolynomial.eval input.length) := by cases hread : readUnaryPrefix input with | none => - have hshape := sourceFlatAtomic_readUnaryPrefix_none + have hshape := GapCVP.SourceInterpolationRowTM.readUnaryPrefix_none_eq_replicate input hread have hprefix := sourceGridIndex_missingPrefixTrace input.length [] @@ -272,7 +272,7 @@ private noncomputable def sourceCanonicalUnaryGridIndex_totalTrace omega) | some parsed => obtain ⟨count, source⟩ := parsed - have hshape := sourceFlatAtomic_readUnaryPrefix_some + have hshape := GapCVP.SourceInterpolationRowTM.readUnaryPrefix_some_decompose input count source hread have hprefix := sourceGridIndex_prefixTrace count source [] [] [] [] @@ -1366,7 +1366,7 @@ theorem guardedRotation_readUnaryPrefix_some_reconstruct (input : List Bool) (count : ℕ) (tail : List Bool) (hread : readUnaryPrefix input = some (count, tail)) : input = List.replicate count true ++ false :: tail := by - exact GapCVP.SourceWholeOutputValidBranchRecordTM.sourceFlatAtomic_readUnaryPrefix_some + exact GapCVP.SourceInterpolationRowTM.readUnaryPrefix_some_decompose input count tail hread theorem guardedRotation_readLengthPrefixedWord_some_reconstruct diff --git a/LeanPool/GapCVP/Part05E.lean b/LeanPool/GapCVP/Part05E.lean index 5786d410c..d371f729b 100644 --- a/LeanPool/GapCVP/Part05E.lean +++ b/LeanPool/GapCVP/Part05E.lean @@ -30,47 +30,26 @@ private def flatAdjacentRecord_failureTrace (flatAdjacentRecordConfiguration 6 input first second counter) (some (Turing.haltList actualFlatAdjacentRecordSwapMachine [])) (input.length + first.length + second.length + counter.length + 1) := by - induction input generalizing first second counter with - | cons bit input ih => - have hfirst := oneStep _ _ (flatAdjacentRecord_failure_input - bit input first second counter) - have hrest := ih first second counter - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, - Nat.reduceAdd, - Nat.add_assoc] using EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ - _ hfirst hrest - | nil => - induction first generalizing second counter with - | cons bit first ih => - have hfirst := oneStep _ _ (flatAdjacentRecord_failure_first - bit first second counter) - have hrest := ih second counter - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, - Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst hrest - | nil => - induction second generalizing counter with - | cons bit second ih => - have hfirst := oneStep _ _ (flatAdjacentRecord_failure_second bit second counter) - have hrest := ih counter - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, - zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst - hrest - | nil => - induction counter with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using - oneStep _ _ flatAdjacentRecord_failure_finish - | cons bit counter ih => - have hfirst := oneStep _ _ (flatAdjacentRecord_failure_counter bit counter) - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, - List.length_cons, zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd] using - EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hfirst - ih + have hinput := TraceGolf.sweep actualFlatAdjacentRecordSwapMachine.step + (fun current => flatAdjacentRecordConfiguration 6 current first second counter) + (fun bit remaining => flatAdjacentRecord_failure_input bit remaining first second counter) + input + have hfirst := TraceGolf.sweep actualFlatAdjacentRecordSwapMachine.step + (fun current => flatAdjacentRecordConfiguration 6 [] current second counter) + (fun bit remaining => flatAdjacentRecord_failure_first bit remaining second counter) + first + have hsecond := TraceGolf.sweep actualFlatAdjacentRecordSwapMachine.step + (fun current => flatAdjacentRecordConfiguration 6 [] [] current counter) + (fun bit remaining => flatAdjacentRecord_failure_second bit remaining counter) + second + have hcounter := TraceGolf.sweepThen actualFlatAdjacentRecordSwapMachine.step + (fun current => flatAdjacentRecordConfiguration 6 [] [] [] current) + flatAdjacentRecord_failure_counter counter flatAdjacentRecord_failure_finish + have h01 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ hinput hfirst + have h012 := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ h01 hsecond + have hfull := EvalsToInTime.trans actualFlatAdjacentRecordSwapMachine.step _ _ _ _ _ + h012 hcounter + exact rebound hfull (by omega) private def flatAdjacentRecord_firstPrefixTrace (count : ℕ) (tail first second counter : List Bool) : diff --git a/LeanPool/GapCVP/Part05F.lean b/LeanPool/GapCVP/Part05F.lean index 3876afa72..78e77994a 100644 --- a/LeanPool/GapCVP/Part05F.lean +++ b/LeanPool/GapCVP/Part05F.lean @@ -36,25 +36,17 @@ private def cappedUnaryMinimum_successTrace (some (Turing.haltList actualCappedUnaryMinimumMachine output)) (input.length + first.length + 1) := by - induction input generalizing first with - | cons bit input ih => - have hfirst := oneStep _ _ (cappedUnaryMinimum_success_input bit input first output) - have hrest := ih first - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, - Nat.reduceAdd, - Nat.add_assoc] using EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ - hfirst hrest - | nil => - induction first with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using - oneStep _ _ (cappedUnaryMinimum_success_finish output) - | cons bit first ih => - have hfirst := oneStep _ _ (cappedUnaryMinimum_success_first bit first output) - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, - Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd] using EvalsToInTime.trans - actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst ih + have hinput := TraceGolf.sweep actualCappedUnaryMinimumMachine.step + (fun current => cappedUnaryMinimumConfiguration 2 current first output) + (fun bit remaining => cappedUnaryMinimum_success_input bit remaining first output) + input + have hfirst := TraceGolf.sweepThen actualCappedUnaryMinimumMachine.step + (fun current => cappedUnaryMinimumConfiguration 2 [] current output) + (fun bit remaining => cappedUnaryMinimum_success_first bit remaining output) + first (cappedUnaryMinimum_success_finish output) + exact rebound + (EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hinput hfirst) + (by omega) private def cappedUnaryMinimum_failureTrace (input first output : List Bool) : @@ -62,34 +54,20 @@ private def cappedUnaryMinimum_failureTrace (cappedUnaryMinimumConfiguration 3 input first output) (some (Turing.haltList actualCappedUnaryMinimumMachine [])) (input.length + first.length + output.length + 1) := by - induction input generalizing first output with - | cons bit input ih => - have hfirst := oneStep _ _ (cappedUnaryMinimum_failure_input bit input first output) - have hrest := ih first output - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_comm, Nat.add_left_comm, - Nat.reduceAdd, - Nat.add_assoc] using EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ - hfirst hrest - | nil => - induction first generalizing output with - | cons bit first ih => - have hfirst := oneStep _ _ (cappedUnaryMinimum_failure_first bit first output) - have hrest := ih output - simpa only [FinTM2.step, Fin.isValue, List.length_nil, List.length_cons, zero_add, - Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd, Nat.add_assoc] using - EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst hrest - | nil => - induction output with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, zero_add] using - oneStep _ _ cappedUnaryMinimum_failure_finish - | cons bit output ih => - have hfirst := oneStep _ _ (cappedUnaryMinimum_failure_output bit output) - simpa only [FinTM2.step, Fin.isValue, List.length_nil, add_zero, List.length_cons, - zero_add, Nat.add_comm, - Nat.add_left_comm, Nat.reduceAdd] using EvalsToInTime.trans - actualCappedUnaryMinimumMachine.step _ _ _ _ _ hfirst ih + have hinput := TraceGolf.sweep actualCappedUnaryMinimumMachine.step + (fun current => cappedUnaryMinimumConfiguration 3 current first output) + (fun bit remaining => cappedUnaryMinimum_failure_input bit remaining first output) + input + have hfirst := TraceGolf.sweep actualCappedUnaryMinimumMachine.step + (fun current => cappedUnaryMinimumConfiguration 3 [] current output) + (fun bit remaining => cappedUnaryMinimum_failure_first bit remaining output) + first + have houtput := TraceGolf.sweepThen actualCappedUnaryMinimumMachine.step + (fun current => cappedUnaryMinimumConfiguration 3 [] [] current) + cappedUnaryMinimum_failure_output output cappedUnaryMinimum_failure_finish + have h01 := EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ hinput hfirst + have hfull := EvalsToInTime.trans actualCappedUnaryMinimumMachine.step _ _ _ _ _ h01 houtput + exact rebound hfull (by omega) private def cappedUnaryMinimum_firstTrace (count : ℕ) (tail first output : List Bool) : diff --git a/LeanPool/GapCVP/Part06B.lean b/LeanPool/GapCVP/Part06B.lean index 95d2dc2cb..a2674974a 100644 --- a/LeanPool/GapCVP/Part06B.lean +++ b/LeanPool/GapCVP/Part06B.lean @@ -274,17 +274,12 @@ private def sourceIntegerMultiplication_failureInputTrace (some (sourceIntegerMultiplicationConfiguration 7 [] left right restore output)) (input.length + 1) := by - induction input with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using - oneStep _ _ (sourceIntegerMultiplication_failure_input_finish left right restore output) - | cons bit input ih => - have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_input_step - bit input left right restore output) - have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step - _ _ _ _ _ hfirst ih - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] - using hfull + exact TraceGolf.sweepThen sourceUnaryIntegerMultiplicationMachine.step + (fun current => sourceIntegerMultiplicationConfiguration 6 + current left right restore output) + (fun bit remaining => sourceIntegerMultiplication_failure_input_step + bit remaining left right restore output) + input (sourceIntegerMultiplication_failure_input_finish left right restore output) private def sourceIntegerMultiplication_failureLeftTrace (left right restore output : List Bool) : @@ -294,17 +289,12 @@ private def sourceIntegerMultiplication_failureLeftTrace (some (sourceIntegerMultiplicationConfiguration 8 [] [] right restore output)) (left.length + 1) := by - induction left with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using - oneStep _ _ (sourceIntegerMultiplication_failure_left_finish right restore output) - | cons bit left ih => - have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_left_step - bit left right restore output) - have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step - _ _ _ _ _ hfirst ih - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] - using hfull + exact TraceGolf.sweepThen sourceUnaryIntegerMultiplicationMachine.step + (fun current => sourceIntegerMultiplicationConfiguration 7 + [] current right restore output) + (fun bit remaining => sourceIntegerMultiplication_failure_left_step + bit remaining right restore output) + left (sourceIntegerMultiplication_failure_left_finish right restore output) private def sourceIntegerMultiplication_failureRightTrace (right restore output : List Bool) : @@ -314,17 +304,12 @@ private def sourceIntegerMultiplication_failureRightTrace (some (sourceIntegerMultiplicationConfiguration 9 [] [] [] restore output)) (right.length + 1) := by - induction right with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using - oneStep _ _ (sourceIntegerMultiplication_failure_right_finish restore output) - | cons bit right ih => - have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_right_step - bit right restore output) - have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step - _ _ _ _ _ hfirst ih - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] - using hfull + exact TraceGolf.sweepThen sourceUnaryIntegerMultiplicationMachine.step + (fun current => sourceIntegerMultiplicationConfiguration 8 + [] [] current restore output) + (fun bit remaining => sourceIntegerMultiplication_failure_right_step + bit remaining restore output) + right (sourceIntegerMultiplication_failure_right_finish restore output) private def sourceIntegerMultiplication_failureRestoreTrace (restore output : List Bool) : @@ -334,17 +319,11 @@ private def sourceIntegerMultiplication_failureRestoreTrace (some (sourceIntegerMultiplicationConfiguration 10 [] [] [] [] output)) (restore.length + 1) := by - induction restore with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using - oneStep _ _ (sourceIntegerMultiplication_failure_restore_finish output) - | cons bit restore ih => - have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_restore_step - bit restore output) - have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step - _ _ _ _ _ hfirst ih - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] - using hfull + exact TraceGolf.sweepThen sourceUnaryIntegerMultiplicationMachine.step + (fun current => sourceIntegerMultiplicationConfiguration 9 [] [] [] current output) + (fun bit remaining => sourceIntegerMultiplication_failure_restore_step + bit remaining output) + restore (sourceIntegerMultiplication_failure_restore_finish output) private def sourceIntegerMultiplication_failureOutputTrace (output : List Bool) : @@ -354,17 +333,10 @@ private def sourceIntegerMultiplication_failureOutputTrace (some (Turing.haltList sourceUnaryIntegerMultiplicationMachine [])) (output.length + 1) := by - induction output with - | nil => - simpa only [FinTM2.step, Fin.isValue, List.length_nil, zero_add] using - oneStep _ _ sourceIntegerMultiplication_failure_finish - | cons bit output ih => - have hfirst := oneStep _ _ (sourceIntegerMultiplication_failure_output_step - bit output) - have hfull := EvalsToInTime.trans sourceUnaryIntegerMultiplicationMachine.step - _ _ _ _ _ hfirst ih - simpa only [FinTM2.step, Fin.isValue, List.length_cons, Nat.add_assoc, Nat.reduceAdd] - using hfull + exact TraceGolf.sweepThen sourceUnaryIntegerMultiplicationMachine.step + (fun current => sourceIntegerMultiplicationConfiguration 10 [] [] [] [] current) + sourceIntegerMultiplication_failure_output_step output + sourceIntegerMultiplication_failure_finish private def sourceIntegerMultiplication_failureTrace (input left right restore output : List Bool) : diff --git a/LeanPool/GapCVP/Part06D.lean b/LeanPool/GapCVP/Part06D.lean index b829950a9..174919413 100644 --- a/LeanPool/GapCVP/Part06D.lean +++ b/LeanPool/GapCVP/Part06D.lean @@ -638,7 +638,7 @@ private theorem sourceOriginalIndexedClauseSuffix_polynomiallyBoundedFoldStates simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage _ - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have hiterate : ∀ number : ℕ, ((clauseSuffix^[number]) seed).length ≤ seed.length := by @@ -1274,7 +1274,7 @@ private theorem sourceAnchoredGridRecord_polynomiallyBoundedFoldStates simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage hstage - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have hcount := parsedUnaryFold_count_le_length input count seed hparse @@ -2134,7 +2134,7 @@ private theorem fiveFamilyOriginalBitTail_polynomiallyBoundedFoldStates : simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage _ - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse simpa only [Polynomial.eval_X, ge_iff_le] using (fiveFamilyOriginalBitTail_iterate_length_le seed stage).trans hseed diff --git a/LeanPool/GapCVP/Part07A.lean b/LeanPool/GapCVP/Part07A.lean index 21f3b61d8..224e35432 100644 --- a/LeanPool/GapCVP/Part07A.lean +++ b/LeanPool/GapCVP/Part07A.lean @@ -444,7 +444,7 @@ private theorem sourceFourFamilyOriginalMarkerRotation_polynomiallyBoundedFoldSt simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage hstage - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have hcount := parsedUnaryFold_count_le_length input count seed hparse diff --git a/LeanPool/GapCVP/Part10B.lean b/LeanPool/GapCVP/Part10B.lean index 0a27ada7f..fb247c2cf 100644 --- a/LeanPool/GapCVP/Part10B.lean +++ b/LeanPool/GapCVP/Part10B.lean @@ -318,7 +318,7 @@ private theorem sourceNormalizedVariableScanStep_polynomiallyBoundedFoldStates : simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage hstage - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have hcount := parsedUnaryFold_count_le_length input count seed hparse @@ -855,7 +855,7 @@ private theorem compactFirstOccurrenceScanStep_polynomiallyBoundedFoldStates : simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage hstage - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have hcount := parsedUnaryFold_count_le_length input count seed hparse @@ -3792,7 +3792,7 @@ private theorem sourcePhysicalLagrangeProduct_polynomiallyBoundedFoldStates : simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage _ - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have hstage := sourcePhysicalLagrangeProduct_iterate_length_le seed stage diff --git a/LeanPool/GapCVP/Part12B.lean b/LeanPool/GapCVP/Part12B.lean index 217ec0dca..160c8c386 100644 --- a/LeanPool/GapCVP/Part12B.lean +++ b/LeanPool/GapCVP/Part12B.lean @@ -940,7 +940,7 @@ private theorem paperSourcePreprocessing_polynomiallyBoundedFoldStates : simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed hparse stage hstage - have seedBound := sourceAtomicFoldSeed_length_le + have seedBound := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have countBound := parsedUnaryFold_count_le_length input count seed hparse diff --git a/LeanPool/GapCVP/Part12C.lean b/LeanPool/GapCVP/Part12C.lean index 97e398f97..938693eaf 100644 --- a/LeanPool/GapCVP/Part12C.lean +++ b/LeanPool/GapCVP/Part12C.lean @@ -1487,7 +1487,7 @@ private theorem paperVariableArityClauseOffset_polynomiallyBoundedFoldStates : simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] intro input count seed parsed stage bounded - have seedBound := sourceAtomicFoldSeed_length_le + have seedBound := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed parsed have countBound := parsedUnaryFold_count_le_length input count seed parsed diff --git a/LeanPool/GapCVP/Part13.lean b/LeanPool/GapCVP/Part13.lean index 2e5dd2cdf..8e7665e83 100644 --- a/LeanPool/GapCVP/Part13.lean +++ b/LeanPool/GapCVP/Part13.lean @@ -4227,106 +4227,119 @@ private def paperExactPhysicalRoutedOutput rw [paperVariableArityCanonicalSourceBinarySystem_encode] rfl -private theorem paperVariableArityExactPhysicalRoutedOutput_eq_sourceMap - {shape : PaperVariableArityCanonicalBinaryMatrixShape} - (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) +/-- Identifies the shared physical routing tree from its five semantic branches. -/ +theorem physicalRoutedOutput_eq_sourceMap + (structuralOutput sourceMap : List Bool → List Bool) (noWord : List Bool) + (decodeNone : ∀ input, decodeThreeCNF input = none → noWord = sourceMap input) + (noncanonical : ∀ input formula, decodeThreeCNF input = some formula → + encodeThreeCNF formula ≠ input → noWord = sourceMap input) + (normalizedEmpty : ∀ formula, paperSourceNormalizedClauses formula = [] → + SourceMachineRouting.canonicalYesWord = sourceMap (encodeThreeCNF formula)) + (inconsistent : ∀ formula, paperSourceNormalizedClauses formula ≠ [] → + (physicalFormulaSystem (encodeThreeCNF formula).length + formula).effectiveReducedConsistent = false → + noWord = sourceMap (encodeThreeCNF formula)) + (consistent : ∀ formula, paperSourceNormalizedClauses formula ≠ [] → + (physicalFormulaSystem (encodeThreeCNF formula).length + formula).effectiveReducedConsistent = true → + structuralOutput (encodeThreeCNF formula) = sourceMap (encodeThreeCNF formula)) (input : List Bool) : - paperExactPhysicalRoutedOutput cell input = - paperVariableArityPhysicalSourceMap input := by + (if physicalCanonicalNormalizedEmptyGuard input then + SourceMachineRouting.canonicalYesWord + else if physicalCanonicalNormalizedNonemptyGuard input then + if binaryGaussianSourceConsistencyGuard paperCanonicalSourceBinarySystem input then + structuralOutput input + else noWord + else noWord) = sourceMap input := by cases decoded : decodeThreeCNF input with | none => have canonical : constructiveCanonicalSourceMarker input = false := by simp only [constructiveCanonicalSourceMarker, decoded] - have empty : - physicalCanonicalNormalizedEmptyGuard input = - false := by + have empty : physicalCanonicalNormalizedEmptyGuard input = false := by simp only [physicalCanonicalNormalizedEmptyGuard, canonical, Bool.false_and] - have nonempty : - physicalCanonicalNormalizedNonemptyGuard input = - false := by + have nonempty : physicalCanonicalNormalizedNonemptyGuard input = false := by simp only [physicalCanonicalNormalizedNonemptyGuard, canonical, Bool.false_and] - unfold paperVariableArityPhysicalSourceMap - rw [paperVariableArityPhysicalSourceInstance_of_decode_none - input decoded] - simp only [paperExactPhysicalRoutedOutput, - empty, Bool.false_eq_true, ↓reduceIte, nonempty] - rfl + simpa only [empty, Bool.false_eq_true, ↓reduceIte, nonempty] using + decodeNone input decoded | some formula => by_cases canonical : encodeThreeCNF formula = input · subst input by_cases empty : paperSourceNormalizedClauses formula = [] · have emptyGuard : - physicalCanonicalNormalizedEmptyGuard - (encodeThreeCNF formula) = true := by + physicalCanonicalNormalizedEmptyGuard (encodeThreeCNF formula) = true := by simp only [physicalCanonicalNormalizedEmptyGuard, constructiveCanonicalSourceMarker, - decodeThreeCNF_encode, - decide_true, physicalNormalizedEmptyMarker, - paperVariableArityPhysicalNormalizedNonemptyMarker_valid, empty, ne_eq, - not_true_eq_false, decide_false, Bool.not_false, Bool.and_self] - unfold paperVariableArityPhysicalSourceMap - rw [paperVariableArityPhysicalSourceInstance_of_normalized_empty - (encodeThreeCNF formula) formula (by simp only [decodeThreeCNF_encode]) rfl empty] - simp only [paperExactPhysicalRoutedOutput, - emptyGuard, ↓reduceIte] - rfl + decodeThreeCNF_encode, decide_true, physicalNormalizedEmptyMarker, + paperVariableArityPhysicalNormalizedNonemptyMarker_valid, empty, ne_eq, + not_true_eq_false, decide_false, Bool.not_false, Bool.and_self] + simpa only [emptyGuard, ↓reduceIte] using normalizedEmpty formula empty · have emptyGuard : - physicalCanonicalNormalizedEmptyGuard - (encodeThreeCNF formula) = false := by + physicalCanonicalNormalizedEmptyGuard (encodeThreeCNF formula) = false := by simp only [physicalCanonicalNormalizedEmptyGuard, constructiveCanonicalSourceMarker, - decodeThreeCNF_encode, - decide_true, physicalNormalizedEmptyMarker, - paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, empty, - not_false_eq_true, Bool.not_true, Bool.and_false] + decodeThreeCNF_encode, decide_true, physicalNormalizedEmptyMarker, + paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, empty, + not_false_eq_true, Bool.not_true, Bool.and_false] have nonemptyGuard : - physicalCanonicalNormalizedNonemptyGuard - (encodeThreeCNF formula) = true := by + physicalCanonicalNormalizedNonemptyGuard (encodeThreeCNF formula) = true := by simp only [physicalCanonicalNormalizedNonemptyGuard, constructiveCanonicalSourceMarker, - decodeThreeCNF_encode, - decide_true, paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, - empty, not_false_eq_true, - Bool.and_self] - cases consistent : - (physicalFormulaSystem - (encodeThreeCNF formula).length - formula).effectiveReducedConsistent with + decodeThreeCNF_encode, decide_true, + paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, empty, + not_false_eq_true, Bool.and_self] + cases consistency : (physicalFormulaSystem + (encodeThreeCNF formula).length formula).effectiveReducedConsistent with | false => - unfold paperVariableArityPhysicalSourceMap - rw [paperVariableArityPhysicalSourceInstance_of_inconsistent - (encodeThreeCNF formula) formula - (by simp only [decodeThreeCNF_encode]) rfl empty consistent] - simp only [paperExactPhysicalRoutedOutput, - emptyGuard, Bool.false_eq_true, ↓reduceIte, - nonemptyGuard, paperVariableArityExactPhysicalConsistencyGuard_encode, - consistent] - rfl + simpa only [emptyGuard, Bool.false_eq_true, ↓reduceIte, nonemptyGuard, + paperVariableArityExactPhysicalConsistencyGuard_encode, consistency] using + inconsistent formula empty consistency | true => - unfold paperVariableArityPhysicalSourceMap - rw [paperVariableArityPhysicalSourceInstance_of_consistent - (encodeThreeCNF formula) formula - (by simp only [decodeThreeCNF_encode]) rfl empty consistent] - simp only [paperExactPhysicalRoutedOutput, - emptyGuard, Bool.false_eq_true, ↓reduceIte, - nonemptyGuard, paperVariableArityExactPhysicalConsistencyGuard_encode, - consistent] - exact paperVariableArityExactPhysicalStructuralOutput_valid - cell formula - · have sourceGuard : - constructiveCanonicalSourceMarker input = false := by + simpa only [emptyGuard, Bool.false_eq_true, ↓reduceIte, nonemptyGuard, + paperVariableArityExactPhysicalConsistencyGuard_encode, consistency] using + consistent formula empty consistency + · have sourceGuard : constructiveCanonicalSourceMarker input = false := by simp only [constructiveCanonicalSourceMarker, decoded, canonical, decide_false] - have emptyGuard : - physicalCanonicalNormalizedEmptyGuard input = - false := by + have emptyGuard : physicalCanonicalNormalizedEmptyGuard input = false := by simp only [physicalCanonicalNormalizedEmptyGuard, sourceGuard, Bool.false_and] - have nonemptyGuard : - physicalCanonicalNormalizedNonemptyGuard input = - false := by + have nonemptyGuard : physicalCanonicalNormalizedNonemptyGuard input = false := by simp only [physicalCanonicalNormalizedNonemptyGuard, sourceGuard, Bool.false_and] - unfold paperVariableArityPhysicalSourceMap - rw [paperVariableArityPhysicalSourceInstance_of_noncanonical - input formula decoded canonical] - simp only [paperExactPhysicalRoutedOutput, - emptyGuard, Bool.false_eq_true, ↓reduceIte, nonemptyGuard] - rfl + simpa only [emptyGuard, Bool.false_eq_true, ↓reduceIte, nonemptyGuard] using + noncanonical input formula decoded canonical + +private theorem paperVariableArityExactPhysicalRoutedOutput_eq_sourceMap + {shape : PaperVariableArityCanonicalBinaryMatrixShape} + (cell : PaperVariableArityCanonicalBinaryMatrixCellComputer shape) + (input : List Bool) : + paperExactPhysicalRoutedOutput cell input = + paperVariableArityPhysicalSourceMap input := by + unfold paperExactPhysicalRoutedOutput + apply physicalRoutedOutput_eq_sourceMap + (paperExactPhysicalStructuralOutput cell) + paperVariableArityPhysicalSourceMap + Factor400BinaryCanonicalNo.adaptedCanonicalNoWord + · intro source decode + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_decode_none source decode] + rfl + · intro source formula decode noncanonical + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_noncanonical + source formula decode noncanonical] + rfl + · intro formula empty + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_normalized_empty + (encodeThreeCNF formula) formula (by simp only [decodeThreeCNF_encode]) rfl empty] + rfl + · intro formula nonempty inconsistent + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_inconsistent + (encodeThreeCNF formula) formula (by simp only [decodeThreeCNF_encode]) + rfl nonempty inconsistent] + rfl + · intro formula nonempty consistent + unfold paperVariableArityPhysicalSourceMap + rw [paperVariableArityPhysicalSourceInstance_of_consistent + (encodeThreeCNF formula) formula (by simp only [decodeThreeCNF_encode]) + rfl nonempty consistent] + exact paperVariableArityExactPhysicalStructuralOutput_valid cell formula /-- GapCVP reduction support. -/ @[irreducible] noncomputable def diff --git a/LeanPool/GapCVP/Part16B.lean b/LeanPool/GapCVP/Part16B.lean index 0b05b147c..52edd4c1d 100644 --- a/LeanPool/GapCVP/Part16B.lean +++ b/LeanPool/GapCVP/Part16B.lean @@ -962,7 +962,7 @@ private theorem compactPhysicalDecodingAtomicRotation_polynomiallyBounded simp only [GapCVP.OutputBoundedDependentRecordFold.PolynomiallyBoundedFoldStates, decide_eq_true_eq] at * intro input count seed hparse stage hstage - have hseed := sourceAtomicFoldSeed_length_le + have hseed := GapCVP.CNFTypedRecordWorkerTM.parsedUnaryFold_seed_length_le input count seed hparse have hcount := parsedUnaryFold_count_le_length input count seed hparse diff --git a/LeanPool/GapCVP/Part17.lean b/LeanPool/GapCVP/Part17.lean index 5b2c01beb..bb5d19857 100644 --- a/LeanPool/GapCVP/Part17.lean +++ b/LeanPool/GapCVP/Part17.lean @@ -1097,115 +1097,47 @@ private theorem paperVariableArityFinitePPhysicalRoutedOutput_eq_sourceMap (input : List Bool) : paperFinitePPhysicalRoutedOutput p cell input = paperVariableArityFinitePSourceMap p hp input := by - cases decoded : decodeThreeCNF input with - | none => - have canonical : constructiveCanonicalSourceMarker input = false := by - simp only [constructiveCanonicalSourceMarker, decoded] - have empty : - physicalCanonicalNormalizedEmptyGuard input = - false := by - simp only [physicalCanonicalNormalizedEmptyGuard, canonical, Bool.false_and] - have nonempty : - physicalCanonicalNormalizedNonemptyGuard input = - false := by - simp only [physicalCanonicalNormalizedNonemptyGuard, canonical, Bool.false_and] - unfold paperVariableArityFinitePSourceMap - rw [paperVariableArityFinitePSourceInstance_of_decode_none - p hp input decoded] - simp only [paperFinitePPhysicalRoutedOutput, - empty, Bool.false_eq_true, ↓reduceIte, nonempty] - rfl - | some formula => - by_cases canonical : encodeThreeCNF formula = input - · subst input - by_cases empty : - paperSourceNormalizedClauses formula = [] - · have emptyGuard : - physicalCanonicalNormalizedEmptyGuard - (encodeThreeCNF formula) = true := by - simp only [physicalCanonicalNormalizedEmptyGuard, constructiveCanonicalSourceMarker, - decodeThreeCNF_encode, - decide_true, physicalNormalizedEmptyMarker, - paperVariableArityPhysicalNormalizedNonemptyMarker_valid, empty, ne_eq, - not_true_eq_false, decide_false, Bool.not_false, Bool.and_self] - unfold paperVariableArityFinitePSourceMap - rw [paperVariableArityFinitePSourceInstance_of_normalized_empty - p hp (encodeThreeCNF formula) formula (by simp only [decodeThreeCNF_encode]) rfl empty] - simp only [paperFinitePPhysicalRoutedOutput, - emptyGuard, ↓reduceIte] - rfl - · have emptyGuard : - physicalCanonicalNormalizedEmptyGuard - (encodeThreeCNF formula) = false := by - simp only [physicalCanonicalNormalizedEmptyGuard, constructiveCanonicalSourceMarker, - decodeThreeCNF_encode, - decide_true, physicalNormalizedEmptyMarker, - paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, empty, - not_false_eq_true, Bool.not_true, Bool.and_false] - have nonemptyGuard : - physicalCanonicalNormalizedNonemptyGuard - (encodeThreeCNF formula) = true := by - simp only [physicalCanonicalNormalizedNonemptyGuard, constructiveCanonicalSourceMarker, - decodeThreeCNF_encode, - decide_true, paperVariableArityPhysicalNormalizedNonemptyMarker_valid, ne_eq, - empty, not_false_eq_true, - Bool.and_self] - cases consistent : - (physicalFormulaSystem - (encodeThreeCNF formula).length - formula).effectiveReducedConsistent with - | false => - have finitePInconsistent : - (paperFinitePPhysicalSystem - (encodeThreeCNF formula).length - formula).effectiveReducedConsistent = false := by - simpa only [paperFinitePPhysicalSystem] using consistent - unfold paperVariableArityFinitePSourceMap - rw [paperVariableArityFinitePSourceInstance_of_inconsistent - p hp (encodeThreeCNF formula) formula - (by simp only [decodeThreeCNF_encode]) rfl empty finitePInconsistent] - simp only [paperFinitePPhysicalRoutedOutput, - emptyGuard, Bool.false_eq_true, ↓reduceIte, - nonemptyGuard, - paperVariableArityExactPhysicalConsistencyGuard_encode, - consistent] - rfl - | true => - have finitePConsistent : - (paperFinitePPhysicalSystem - (encodeThreeCNF formula).length - formula).effectiveReducedConsistent = true := by - simpa only [paperFinitePPhysicalSystem, - Core.BinaryAffineSystem.effectiveReducedConsistent_iff] using - consistent - unfold paperVariableArityFinitePSourceMap - rw [paperVariableArityFinitePSourceInstance_of_consistent - p hp (encodeThreeCNF formula) formula - (by simp only [decodeThreeCNF_encode]) rfl empty finitePConsistent] - simp only [paperFinitePPhysicalRoutedOutput, - emptyGuard, Bool.false_eq_true, ↓reduceIte, - nonemptyGuard, - paperVariableArityExactPhysicalConsistencyGuard_encode, - consistent] - exact paperVariableArityFinitePPhysicalStructuralOutput_valid - p hp cell formula - · have sourceGuard : - constructiveCanonicalSourceMarker input = false := by - simp only [constructiveCanonicalSourceMarker, decoded, canonical, decide_false] - have emptyGuard : - physicalCanonicalNormalizedEmptyGuard input = - false := by - simp only [physicalCanonicalNormalizedEmptyGuard, sourceGuard, Bool.false_and] - have nonemptyGuard : - physicalCanonicalNormalizedNonemptyGuard input = - false := by - simp only [physicalCanonicalNormalizedNonemptyGuard, sourceGuard, Bool.false_and] - unfold paperVariableArityFinitePSourceMap - rw [paperVariableArityFinitePSourceInstance_of_noncanonical - p hp input formula decoded canonical] - simp only [paperFinitePPhysicalRoutedOutput, - emptyGuard, Bool.false_eq_true, ↓reduceIte, nonemptyGuard] - rfl + unfold paperFinitePPhysicalRoutedOutput + apply physicalRoutedOutput_eq_sourceMap + (paperFinitePPhysicalStructuralOutput p cell) + (paperVariableArityFinitePSourceMap p hp) + finitePCanonicalNoWord + · intro source decode + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_decode_none p hp source decode] + rfl + · intro source formula decode noncanonical + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_noncanonical + p hp source formula decode noncanonical] + rfl + · intro formula empty + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_normalized_empty + p hp (encodeThreeCNF formula) formula + (by simp only [decodeThreeCNF_encode]) rfl empty] + rfl + · intro formula nonempty inconsistent + have finitePInconsistent : + (paperFinitePPhysicalSystem (encodeThreeCNF formula).length + formula).effectiveReducedConsistent = false := by + simpa only [paperFinitePPhysicalSystem] using inconsistent + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_inconsistent + p hp (encodeThreeCNF formula) formula + (by simp only [decodeThreeCNF_encode]) rfl nonempty finitePInconsistent] + rfl + · intro formula nonempty consistent + have finitePConsistent : + (paperFinitePPhysicalSystem (encodeThreeCNF formula).length + formula).effectiveReducedConsistent = true := by + simpa only [paperFinitePPhysicalSystem, + Core.BinaryAffineSystem.effectiveReducedConsistent_iff] using consistent + unfold paperVariableArityFinitePSourceMap + rw [paperVariableArityFinitePSourceInstance_of_consistent + p hp (encodeThreeCNF formula) formula + (by simp only [decodeThreeCNF_encode]) rfl nonempty finitePConsistent] + exact paperVariableArityFinitePPhysicalStructuralOutput_valid p hp cell formula @[irreducible] private noncomputable def paperVariableArityFinitePSourceMapMachine (p : ℚ) (hp : 1 ≤ p) :