From 7561dbb29f55517442972272018d1e5113a8fa13 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:07:45 +0000 Subject: [PATCH 01/40] wip(universal): interfaces for the O(t log t) windowed simulation (#800) --- Complexity.lean | 4 + .../Turing/MultiTape/Combinators/DivConq.lean | 103 ++++++++++++++++ .../MultiTape/Combinators/StackLoop.lean | 106 ++++++++++++++++ .../MultiTape/Combinators/TakeDropUnary.lean | 37 ++++++ .../Turing/MultiTape/Universal/Windowed.lean | 116 ++++++++++++++++++ 5 files changed, 366 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean diff --git a/Complexity.lean b/Complexity.lean index d8bc086f06..ac64a214f5 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1493,6 +1493,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.BlockTrace public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Append public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Comp public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.CopyWord +public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.DivConq public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Encoding public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Foldl public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Id @@ -1500,8 +1501,10 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Ite public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.IterateWhile public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.MultiPass public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Reverse +public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.StackLoop public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.StepMachine public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.StreamFold +public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TakeDropUnary public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TidyNormalForm public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TidyZeroSpace public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Transducer @@ -1841,6 +1844,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Universal.PolyT public import Complexity.Computability.Machines.Turing.MultiTape.Universal.ResourceBound public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Space public import Complexity.Computability.Machines.Turing.MultiTape.Universal.SpaceBudget +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Windowed public import Complexity.Computability.Machines.Turing.SingleTape.Partrec public import Complexity.Computability.Machines.Turing.SingleTape.PostTuringMachine public import Complexity.Computability.Machines.Turing.TM2.ConfigBound diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean new file mode 100644 index 0000000000..5db7616153 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.StackLoop + +/-! +# Divide and conquer + +A divide-and-conquer recursion (`Turing.MultiTapeTM.DivConq`) solves a base problem directly and +otherwise solves a first subproblem, derives a second subproblem and some saved data from the +problem and the first solution, solves the second subproblem, and combines the saved data with the +second solution. Its evaluation with a cost is the inductive relation +`Turing.MultiTapeTM.DivConq.Eval`: a node costs its two subproblems plus a cost of its own. + +If the parts are tidily computable, the solution is tidily computable within the cost of the +evaluation, when the cost of every node covers the costs of its parts and the lengths of the words +it touches (`Turing.MultiTapeTM.ComputableTidilyInO.divConq`). The machine runs the recursion as a +`Turing.MultiTapeTM.StackLoop`, keeping the pending problems and saved data on a stack, so a node +does not pay for the frames of its ancestors. + +## Main definitions + +* `Turing.MultiTapeTM.DivConq`: the parts of a divide-and-conquer recursion. +* `Turing.MultiTapeTM.DivConq.Eval`: evaluation with a cost. + +## Main results + +* `Turing.MultiTapeTM.ComputableTidilyInO.divConq`: divide and conquer within the cost of the + evaluation. +-/ + +public section + +namespace Turing.MultiTapeTM + +/-- The parts of a divide-and-conquer recursion: a test for base problems, their solutions, the +first subproblem, the second subproblem and saved data from the problem and the first solution, +and the solution from the saved data and the second solution. -/ +structure DivConq (α β γ : Type) where + /-- Whether a problem is solved directly. -/ + isBase : α → Bool + /-- The solution of a base problem. -/ + base : α → β + /-- The first subproblem. -/ + left : α → α + /-- The second subproblem and the saved data, from the problem and the first solution. -/ + mid : α × β → α × γ + /-- The solution, from the saved data and the second solution. -/ + join : γ × β → β + +namespace DivConq + +variable {α β γ : Type} + +/-- `D.Eval cb cn a b c`: the recursion solves `a` with `b`, at cost `c`, where a base problem `a` +costs `cb a` and a node `a` with solutions `b₁` and `b₂` of its subproblems costs `cn a b₁ b₂` on +top of its subproblems. -/ +inductive Eval (D : DivConq α β γ) (cb : α → ℕ) (cn : α → β → β → ℕ) : α → β → ℕ → Prop + /-- A base problem. -/ + | base {a : α} : D.isBase a = true → Eval D cb cn a (D.base a) (cb a) + /-- A node: the first subproblem, then the second. -/ + | node {a : α} {b₁ b₂ : β} {c₁ c₂ : ℕ} : D.isBase a = false → + Eval D cb cn (D.left a) b₁ c₁ → Eval D cb cn (D.mid (a, b₁)).1 b₂ c₂ → + Eval D cb cn a (D.join ((D.mid (a, b₁)).2, b₂)) (c₁ + c₂ + cn a b₁ b₂) + +end DivConq + +/-- **Divide and conquer.** If the parts of a divide-and-conquer recursion are tidily computable +and every input `x` is solved with `F x` at cost `C x`, then `F` is tidily computable within the +cost of the evaluation plus the initialization. The cost of a base problem must cover its test, +its solution and the lengths of the problem and its solution; the cost of a node must cover its +test, the first subproblem, the middle and the combination, and the lengths of all the values they +read and write. -/ +theorem ComputableTidilyInO.divConq {δ α β γ : Type} {encIn : δ ↪ List Bool} + {encA : α ↪ List Bool} {encB : β ↪ List Bool} {encG : γ ↪ List Bool} (D : DivConq α β γ) + {init : δ → α} {F : δ → β} {C : δ → ℕ} {cb : α → ℕ} {cn : α → β → β → ℕ} + {Ti Si : δ → ℕ} {Tt St Tb Sb Tl Sl : α → ℕ} {Tm Sm : α × β → ℕ} {Tj Sj : γ × β → ℕ} + (hinit : ComputableTidilyInO init encIn encA Ti Si) + (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) + (hbase : ComputableTidilyInO D.base encA encB Tb Sb) + (hleft : ComputableTidilyInO D.left encA encA Tl Sl) + (hmid : ComputableTidilyInO D.mid (encPair encA encB) (encPair encA encG) Tm Sm) + (hjoin : ComputableTidilyInO D.join (encPair encG encB) encB Tj Sj) + (hcb : ∀ a, D.isBase a = true → + Tt a + St a + Tb a + Sb a + (encA a).length + (encB (D.base a)).length + 1 ≤ cb a) + (hcn : ∀ a b₁ b₂, D.isBase a = false → + Tt a + St a + Tl a + Sl a + Tm (a, b₁) + Sm (a, b₁) + + Tj ((D.mid (a, b₁)).2, b₂) + Sj ((D.mid (a, b₁)).2, b₂) + + (encA a).length + (encA (D.left a)).length + (encB b₁).length + + (encA (D.mid (a, b₁)).1).length + (encG (D.mid (a, b₁)).2).length + (encB b₂).length + + (encB (D.join ((D.mid (a, b₁)).2, b₂))).length + 1 ≤ cn a b₁ b₂) + (heval : ∀ x, D.Eval cb cn (init x) (F x) (C x)) : + ComputableTidilyInO F encIn encB (fun x => (encIn x).length + Ti x + Si x + C x) + (fun x => (encIn x).length + Ti x + Si x + C x) := + sorry + +end Turing.MultiTapeTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean new file mode 100644 index 0000000000..42ac39eeb6 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic + +/-! +# Loops with a stack of frames + +A stack loop (`Turing.MultiTapeTM.StackLoop`) keeps a current value and a stack of frames. While +`halt` is false at the current value, a round pops the top frame (`none` on an empty stack), +applies `round` to it and the current value, pushes the returned frames (the first one ends on +top) and continues with the returned value. + +The machine keeps the stack on its own work tape, so a round touches only the current value, the +popped frame and the pushed frames: its cost does not depend on the frames deeper in the stack. +This makes recursive algorithms such as divide and conquer computable within the sum of the costs +of their calls, rather than paying for the whole recursion state on every round. + +## Main definitions + +* `Turing.MultiTapeTM.StackLoop`: the round and the halting test of a stack loop. +* `Turing.MultiTapeTM.StackLoop.step`: one round on a value and a stack. + +## Main results + +* `Turing.MultiTapeTM.ComputableTidilyInO.stackLoop`: if the initial value, the halting test and + the round are tidily computable, so is the value at which the loop halts with an empty stack, + within the sum over the rounds of their costs and the lengths of the words they touch. +-/ + +public section + +namespace Turing.MultiTapeTM + +/-- A loop with a stack of frames: a halting test on the current value, and a round taking the +popped top frame (`none` on an empty stack) and the current value to the frames to push, the +first one ending on top, and the next value. -/ +structure StackLoop (α γ : Type) where + /-- Whether the loop stops at the current value. -/ + halt : α → Bool + /-- A round: from the popped frame and the current value, the pushed frames and the next + value. -/ + round : Option γ × α → List γ × α + +namespace StackLoop + +variable {α γ : Type} + +/-- The input of a round on the value `s.1` and the stack `s.2`, top first: the top frame, if +any, and the value. -/ +@[expose] def roundInput (s : α × List γ) : Option γ × α := (s.2.head?, s.1) + +/-- One round on a value and a stack, top first: pop the top frame, apply the round, push the +returned frames. -/ +@[expose] def step (L : StackLoop α γ) (s : α × List γ) : α × List γ := + ((L.round (roundInput s)).2, (L.round (roundInput s)).1 ++ s.2.tail) + +end StackLoop + +open StackLoop + +/-- **Stack loops.** If the initial value, the halting test and the round of a stack loop are +tidily computable, and from the initial value with an empty stack the loop halts after `n x` +rounds with an empty stack, then the halting value is tidily computable. The time and space are +the costs of the initialization, plus, for every round and the final halting test, the costs of +the halting test and of the round together with the lengths of the words they read and write. + +The frames are kept on a separate work tape: a round pays for the popped and pushed frames only, +not for the rest of the stack. -/ +theorem ComputableTidilyInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} + {encA : α ↪ List Bool} {encG : γ ↪ List Bool} (L : StackLoop α γ) + {init : δ → α} {Ti Si : δ → ℕ} {Th Sh : α → ℕ} {Tr Sr : Option γ × α → ℕ} (n : δ → ℕ) + (hinit : ComputableTidilyInO init encIn encA Ti Si) + (hhalt : ComputableTidilyInO L.halt encA encBool Th Sh) + (hround : ComputableTidilyInO L.round (encPair (encOption encG) encA) + (encPair (encList encG) encA) Tr Sr) + (hrun : ∀ x, ∀ i < n x, L.halt (L.step^[i] (init x, [])).1 = false) + (hstop : ∀ x, L.halt (L.step^[n x] (init x, [])).1 = true) + (hempty : ∀ x, (L.step^[n x] (init x, [])).2 = []) : + ComputableTidilyInO (fun x => (L.step^[n x] (init x, [])).1) encIn encA + (fun x => (encIn x).length + Ti x + Si x + + ∑ i ∈ Finset.range (n x + 1), + (Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + + (encA (L.step^[i] (init x, [])).1).length) + + ∑ i ∈ Finset.range (n x), + (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + + (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length)) + (fun x => (encIn x).length + Ti x + Si x + + ∑ i ∈ Finset.range (n x + 1), + (Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + + (encA (L.step^[i] (init x, [])).1).length) + + ∑ i ∈ Finset.range (n x), + (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + + (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length)) := + sorry + +end Turing.MultiTapeTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean new file mode 100644 index 0000000000..a4b0682210 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Lists + +/-! +# Taking and dropping list elements in linear time + +STUB: interface for the linear-time unary take/drop primitives. To be replaced by the native +machine and its proofs. +-/ + +public section + +namespace Turing.MultiTapeTM.ComputableTidilyInDegree + +variable {α : Type} + +/-- Taking the first `n` elements, with `n` in unary, in linear time. -/ +theorem takeUnary (enc : α ↪ List Bool) : + ComputableTidilyInDegree (fun p : List α × ℕ => p.1.take p.2) + (encPair (encList enc) encUnary) (encList enc) 1 1 := + sorry + +/-- Dropping the first `n` elements, with `n` in unary, in linear time. -/ +theorem dropUnaryLin (enc : α ↪ List Bool) : + ComputableTidilyInDegree (fun p : List α × ℕ => p.1.drop p.2) + (encPair (encList enc) encUnary) (encList enc) 1 1 := + sorry + +end Turing.MultiTapeTM.ComputableTidilyInDegree diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean new file mode 100644 index 0000000000..70f40e9947 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Machine + +/-! +# Windowed simulation + +In `n` steps, a head reads only cells within distance `n` of where it started. The windowed +simulation exploits this to simulate `n` steps on *windows*: for every tape, the zipper of the +cells within distance `n` of its head. It cuts the windows of radius `⌈n / 2⌉` around the heads, +simulates the first `⌈n / 2⌉` steps on them recursively, pastes the result back, and does the same +for the remaining `⌊n / 2⌋` steps. A single step is `Turing.MultiTapeTM.Universal.stepWith`. + +Cutting and pasting take time linear in the window, so `n` steps take time `O(n log n)` for a +fixed machine; that cost analysis is in a separate module. This module defines the simulation and +proves that it computes the universal function. + +A windowed configuration (`Turing.MultiTapeTM.Universal.Windowed.Win`) holds the state, then the +input window followed by the work windows. The `head` fields of the window zippers are not used. +Input cells are coded so that a step can be taken without the position of the input head: +`some 0` is the left end at position `0`, `some (a + 1)` the input symbol `a`, and `none` a blank +after the input. + +## Main definitions + +* `Turing.MultiTapeTM.Universal.Windowed.extract`, `.restore`: cutting windows and pasting them + back. +* `Turing.MultiTapeTM.Universal.Windowed.wstep`: one step on windows. +* `Turing.MultiTapeTM.Universal.Windowed.sim`: the recursive simulation of `n` steps. +* `Turing.MultiTapeTM.Universal.Windowed.initWin`: the windows of the initial configuration. + +## Main results + +* `Turing.MultiTapeTM.Universal.Windowed.universal_eq_sim`: the windowed simulation of `t` steps + from the radius-`t` windows of the initial configuration computes the universal function. +-/ + +public section + +namespace Turing.MultiTapeTM.Universal.Windowed + +/-- A windowed configuration: the state, then the input window followed by the work windows. -/ +abbrev Win := Option ℕ × List Tape + +/-- The cells of `t` within distance `r` of its head, as a zipper with head field `0`. -/ +@[expose] def cut (r : ℕ) (t : Tape) : Tape := ⟨0, t.left.take r, t.right.take (r + 1)⟩ + +/-- The window `inner`, cut from `outer` with radius `r` and then run, with the cells of `outer` +beyond distance `r` of its head put back around it. -/ +@[expose] def paste (r : ℕ) (outer inner : Tape) : Tape := + ⟨0, inner.left ++ outer.left.drop r, inner.right ++ outer.right.drop (r + 1)⟩ + +/-- The windows of radius `r`. -/ +@[expose] def extract (r : ℕ) (w : Win) : Win := (w.1, w.2.map (cut r)) + +/-- The windows `inner`, extracted from `outer` with radius `r` and then run, pasted back. -/ +@[expose] def restore (r : ℕ) (outer inner : Win) : Win := + (inner.1, List.zipWith (paste r) outer.2 inner.2) + +/-- The input symbol of a coded input cell. -/ +@[expose] def inSym (c : Option ℕ) : Option ℕ := c.bind fun v => if v = 0 then none else some (v - 1) + +/-- A stand-in for the position of the input head on a coded input cell: `0` at the left end and +`1` elsewhere. `Turing.MultiTapeTM.Universal.moveInput` distinguishes only these cases. -/ +@[expose] def inPos (c : Option ℕ) : ℕ := if c = some 0 then 0 else 1 + +/-- The input window, moved as the input head moved from `p` to `p'`. -/ +@[expose] def moveIn (t : Tape) (p p' : ℕ) : Tape := + if p' = p + 1 then t.move .pos else if p' + 1 = p then t.move .neg else t + +/-- One step on a windowed configuration, and the symbol it emits. -/ +@[expose] def wstep (d : Desc) (w : Win) : Win × Option ℕ := + match w.2 with + | [] => (w, none) + | i :: ts => + (((stepWith d ⟨w.1, inPos i.read, ts⟩ (inSym i.read)).1.state, + moveIn i (inPos i.read) (stepWith d ⟨w.1, inPos i.read, ts⟩ (inSym i.read)).1.inputPos :: + (stepWith d ⟨w.1, inPos i.read, ts⟩ (inSym i.read)).1.workTapes), + (stepWith d ⟨w.1, inPos i.read, ts⟩ (inSym i.read)).2) + +/-- The number of steps of the first half of a block of `n` steps. -/ +@[expose] def firstHalf (n : ℕ) : ℕ := n - n / 2 + +/-- The windowed simulation of `n` steps, and the symbols emitted. -/ +@[expose] def sim (d : Desc) : ℕ → Win → Win × List ℕ + | 0, w => (w, []) + | 1, w => ((wstep d w).1, (wstep d w).2.toList) + | n + 2, w => + let r₁ := sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w) + let w₁ := restore (firstHalf (n + 2)) w r₁.1 + let r₂ := sim d ((n + 2) / 2) (extract ((n + 2) / 2) w₁) + (restore ((n + 2) / 2) w₁ r₂.1, r₁.2 ++ r₂.2) +termination_by n => n +decreasing_by all_goals first | omega | (simp only [firstHalf]; omega) + +/-- The windows of the initial configuration on the input `x`: the input head on the first input +symbol, after the left end, and blank work tapes. -/ +@[expose] def initWin (d : Desc) (x : List ℕ) : Win := + (some d.q₀, ⟨0, [some 0], x.map fun a => some (a + 1)⟩ :: List.replicate d.tapes ⟨0, [], []⟩) + +/-- **The windowed simulation computes the universal function**: started from the radius-`t` +windows of the initial configuration, `t` windowed steps give the output and the halting status +after `t` steps. -/ +theorem universal_eq_sim (d : Desc) (x : List ℕ) (t : ℕ) : + universal (d, x, t) = ((sim d t (extract t (initWin d x))).2, + (sim d t (extract t (initWin d x))).1.1.isNone) := + sorry + +end Turing.MultiTapeTM.Universal.Windowed From c29c9b600795542e59d111fe86407353765b6775 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:20:22 +0000 Subject: [PATCH 02/40] wip(divconq): trace lemma and case-analysis certificates --- .../Turing/MultiTape/Combinators/DivConq.lean | 139 ++++++++ .../MultiTape/Complexity/BigO/Cases.lean | 302 ++++++++++++++++++ 2 files changed, 441 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 5db7616153..43bab3271b 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -69,6 +69,145 @@ inductive Eval (D : DivConq α β γ) (cb : α → ℕ) (cn : α → β → β Eval D cb cn (D.left a) b₁ c₁ → Eval D cb cn (D.mid (a, b₁)).1 b₂ c₂ → Eval D cb cn a (D.join ((D.mid (a, b₁)).2, b₂)) (c₁ + c₂ + cn a b₁ b₂) +/-! ### The recursion as a stack loop -/ + +/-- The values of the stack loop: a call on a problem, a returned solution, and the final +solution. -/ +abbrev Val (α β : Type) := α ⊕ (β ⊕ β) + +/-- The frames of the stack loop: a problem whose first subproblem is being solved, or the data +saved while its second subproblem is solved. -/ +abbrev Frame (α γ : Type) := α ⊕ γ + +variable (D : DivConq α β γ) + +/-- A round on a call: a base problem returns its solution; otherwise the problem is saved and its +first subproblem called. The popped frame is pushed back. -/ +@[expose] def roundCall (p : Option (Frame α γ) × α) : List (Frame α γ) × Val α β := + if D.isBase p.2 then (p.1.toList, .inr (.inl (D.base p.2))) + else (.inl p.2 :: p.1.toList, .inl (D.left p.2)) + +/-- A round on a returned solution: with an empty stack it is final; after a first subproblem the +second is called, saving the data; after a second subproblem the solution is combined. -/ +@[expose] def roundRet (p : Option (Frame α γ) × β) : List (Frame α γ) × Val α β := + match p.1 with + | none => ([], .inr (.inr p.2)) + | some (.inl a) => ([.inr (D.mid (a, p.2)).2], .inl (D.mid (a, p.2)).1) + | some (.inr g) => ([], .inr (.inl (D.join (g, p.2)))) + +/-- The recursion as a stack loop, halting at a final solution. -/ +@[expose] def loop : StackLoop (Val α β) (Frame α γ) where + halt v := match v with + | .inr (.inr _) => true + | _ => false + round p := match p.2 with + | .inl a => D.roundCall (p.1, a) + | .inr (.inl b) => D.roundRet (p.1, b) + | .inr (.inr b) => (p.1.toList, .inr (.inr b)) + +omit D in +lemma toList_head?_append_tail (stk : List (Frame α γ)) : stk.head?.toList ++ stk.tail = stk := by + cases stk <;> rfl + +/-- **The trace of an evaluation.** If every round costs at most `R` of its input, and `R` is +bounded on the rounds of base problems and nodes as below, then from a call on `a` the loop +returns the solution of `a`, above an untouched stack, within rounds whose total cost is at most +`A * c` plus `B` times the size of the frame below, plus `B`. -/ +theorem eval_trace {cb : α → ℕ} {cn : α → β → β → ℕ} {R : Option (Frame α γ) × Val α β → ℕ} + {fsize : Option (Frame α γ) → ℕ} {B : ℕ} + (hbase : ∀ o a, D.isBase a = true → R (o, .inl a) ≤ B * (fsize o + 1) + B * cb a) + (hcall : ∀ o a b₁ b₂, D.isBase a = false → + R (o, .inl a) ≤ B * (fsize o + 1) + B * cn a b₁ b₂) + (hmid : ∀ a b₁ b₂, D.isBase a = false → R (some (.inl a), .inr (.inl b₁)) ≤ B * cn a b₁ b₂) + (hjoin : ∀ a b₁ b₂, D.isBase a = false → + R (some (.inr (D.mid (a, b₁)).2), .inr (.inl b₂)) ≤ B * cn a b₁ b₂) + (hframe : ∀ a b₁ b₂, D.isBase a = false → + fsize (some (.inl a)) + fsize (some (.inr (D.mid (a, b₁)).2)) + 2 ≤ cn a b₁ b₂) + {a : α} {b : β} {c : ℕ} (h : D.Eval cb cn a b c) (stk : List (Frame α γ)) : + ∃ m, (D.loop.step^[m] (.inl a, stk) = (.inr (.inl b), stk)) ∧ + (∀ i < m, D.loop.halt (D.loop.step^[i] (.inl a, stk)).1 = false) ∧ + ∑ i ∈ Finset.range m, R (StackLoop.roundInput (D.loop.step^[i] (.inl a, stk))) ≤ + 4 * B * c + B * (fsize stk.head? + 1) := by + induction h generalizing stk with + | @base a ha => + refine ⟨1, ?_, fun i hi => ?_, ?_⟩ + · simp [StackLoop.step, StackLoop.roundInput, loop, roundCall, ha, toList_head?_append_tail] + · obtain rfl : i = 0 := by omega + rfl + · simp only [Finset.range_one, Finset.sum_singleton, Function.iterate_zero, id_eq] + have := hbase stk.head? a ha + simp only [StackLoop.roundInput] + nlinarith + | @node a b₁ b₂ c₁ c₂ ha h₁ h₂ ih₁ ih₂ => + -- the call round, the first subproblem, the middle round, the second subproblem, the join + obtain ⟨m₁, hm₁, hh₁, hs₁⟩ := ih₁ (.inl a :: stk) + obtain ⟨m₂, hm₂, hh₂, hs₂⟩ := ih₂ (.inr (D.mid (a, b₁)).2 :: stk) + have hcallStep : D.loop.step (.inl a, stk) = (.inl (D.left a), .inl a :: stk) := by + simp [StackLoop.step, StackLoop.roundInput, loop, roundCall, ha, toList_head?_append_tail] + have hmidStep : D.loop.step (.inr (.inl b₁), .inl a :: stk) = + (.inl (D.mid (a, b₁)).1, .inr (D.mid (a, b₁)).2 :: stk) := by + simp [StackLoop.step, StackLoop.roundInput, loop, roundRet] + have hjoinStep : D.loop.step (.inr (.inl b₂), .inr (D.mid (a, b₁)).2 :: stk) = + (.inr (.inl (D.join ((D.mid (a, b₁)).2, b₂))), stk) := by + simp [StackLoop.step, StackLoop.roundInput, loop, roundRet] + -- the positions of the phases + have e₁ : D.loop.step^[m₁ + 1] (.inl a, stk) = (.inr (.inl b₁), .inl a :: stk) := by + rw [Function.iterate_add_apply, Function.iterate_one, hcallStep, hm₁] + have e₂ : D.loop.step^[m₂ + 1 + (m₁ + 1)] (.inl a, stk) = + (.inr (.inl b₂), .inr (D.mid (a, b₁)).2 :: stk) := by + rw [Function.iterate_add_apply, e₁, Function.iterate_add_apply, Function.iterate_one, + hmidStep, hm₂] + refine ⟨1 + (m₂ + 1 + (m₁ + 1)), ?_, fun i hi => ?_, ?_⟩ + · rw [Function.iterate_add_apply, e₂, Function.iterate_one, hjoinStep] + · -- every round before the end is on a call or a returned solution with a nonempty stack + rcases Nat.lt_or_ge i (m₁ + 1) with hi₁ | hi₁ + · rcases Nat.eq_zero_or_pos i with rfl | hi₀ + · rfl + · obtain ⟨j, rfl⟩ : ∃ j, i = j + 1 := ⟨i - 1, by omega⟩ + rw [Function.iterate_add_apply, Function.iterate_one, hcallStep] + exact hh₁ j (by omega) + · rcases Nat.lt_or_ge i (m₂ + 1 + (m₁ + 1)) with hi₂ | hi₂ + · obtain ⟨j, rfl⟩ : ∃ j, i = j + (m₁ + 1) := ⟨i - (m₁ + 1), by omega⟩ + rw [Function.iterate_add_apply, e₁] + rcases Nat.eq_zero_or_pos j with rfl | hj₀ + · rfl + · obtain ⟨l, rfl⟩ : ∃ l, j = l + 1 := ⟨j - 1, by omega⟩ + rw [Function.iterate_add_apply, Function.iterate_one, hmidStep] + exact hh₂ l (by omega) + · obtain rfl : i = m₂ + 1 + (m₁ + 1) := by omega + rw [e₂] + rfl + · -- the costs of the phases + have hsplit : ∑ i ∈ Finset.range (1 + (m₂ + 1 + (m₁ + 1))), + R (StackLoop.roundInput (D.loop.step^[i] (.inl a, stk))) = + R (stk.head?, .inl a) + + ∑ i ∈ Finset.range m₁, + R (StackLoop.roundInput (D.loop.step^[i] (.inl (D.left a), .inl a :: stk))) + + R (some (.inl a), .inr (.inl b₁)) + + ∑ i ∈ Finset.range m₂, + R (StackLoop.roundInput (D.loop.step^[i] (.inl (D.mid (a, b₁)).1, + .inr (D.mid (a, b₁)).2 :: stk))) + + R (some (.inr (D.mid (a, b₁)).2), .inr (.inl b₂)) := by + rw [show 1 + (m₂ + 1 + (m₁ + 1)) = 1 + m₁ + 1 + m₂ + 1 by omega, Finset.sum_range_succ, + Finset.sum_range_add, Finset.sum_range_succ, Finset.sum_range_add, Finset.sum_range_one] + simp only [Function.iterate_zero, id_eq, StackLoop.roundInput] + have hA : ∀ x, D.loop.step^[1 + x] (.inl a, stk) = + D.loop.step^[x] (.inl (D.left a), .inl a :: stk) := fun x => by + rw [add_comm, Function.iterate_add_apply, Function.iterate_one, hcallStep] + have hB : ∀ x, D.loop.step^[1 + m₁ + 1 + x] (.inl a, stk) = + D.loop.step^[x] (.inl (D.mid (a, b₁)).1, .inr (D.mid (a, b₁)).2 :: stk) := + fun x => by + rw [show 1 + m₁ + 1 + x = x + 1 + (m₁ + 1) by omega, Function.iterate_add_apply, e₁, + Function.iterate_add_apply, Function.iterate_one, hmidStep] + simp only [hA, hB, hm₁, hm₂, List.head?_cons] + rw [hsplit] + have h₀ := hcall stk.head? a b₁ b₂ ha + have h₃ := hmid a b₁ b₂ ha + have h₄ := hjoin a b₁ b₂ ha + have h₅ := hframe a b₁ b₂ ha + simp only [List.head?_cons] at hs₁ hs₂ + nlinarith + end DivConq /-- **Divide and conquer.** If the parts of a divide-and-conquer recursion are tidily computable diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean new file mode 100644 index 0000000000..142654f056 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean @@ -0,0 +1,302 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Sum +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Ite + +/-! +# Case analysis on a component, within given bounds + +Case analysis on the second component of a pair, when that component is a tagged sum +(`Turing.MultiTapeTM.encSum`) or an option (`Turing.MultiTapeTM.encOption`). Each branch need only be computable on its own case, and only the +branch taken is charged, plus the length of the encoded input. No default values of the component +types are needed: the branches run on the inputs of their case only. + +## Main results + +* `Turing.MultiTapeTM.ComputableTidilyInO.sumElimSnd`: case analysis on a sum component. +* `Turing.MultiTapeTM.ComputableTidilyInO.optionElimSnd`: case analysis on an option component. +-/ + +public section + +namespace Turing.MultiTapeTM.ComputableTidilyInO + +variable {π α β ε : Type} {encP : π ↪ List Bool} {encA : α ↪ List Bool} {encB : β ↪ List Bool} + {encE : ε ↪ List Bool} + +/-- A function whose encoded value is obtained from the encoded input by keeping its leading frame +and dropping `k` symbols after it, in linear time. -/ +private lemma keepFrame_drop {σ : Type} {encS : σ ↪ List Bool} {h : σ → π × α} (k : ℕ) + (hh : ∀ s, ∃ u, encS s = frame (encP (h s).1) ++ u ∧ encA (h s).2 = u.drop k) : + ComputableTidilyInO h encS (encPair encP encA) (fun s => (encS s).length) + (fun s => (encS s).length) := by + have hlen : ∀ s, (encP (h s).1).length + (encA (h s).2).length ≤ (encS s).length := fun s => by + obtain ⟨u, hs, hu⟩ := hh s + rw [hs, hu, List.length_append, length_frame, List.length_drop] + omega + have h₁ : ComputableTidilyInO (fun s => (h s).1) encS (encFramed encP) + (fun s => (encS s).length) (fun s => (encS s).length) := by + have hu : ComputableTidilyInO (fun s => (h s).1) encS encP (fun s => (encS s).length) + (fun s => (encS s).length) := + of_linear (.of_unframe fun s => by + obtain ⟨u, hs, -⟩ := hh s + rw [hs, unframe_frame_append]) + refine ((of_linear (.of_frame (f := fun x : π => x) (encIn := encP) + (encOut := encFramed encP) fun _ => rfl)).comp hu).mono 2 (fun s => ?_) (fun s => ?_) <;> + · have := hlen s + omega + -- the word after the frame, then `k` symbols dropped + have hd : ComputableTidilyInO (fun s => dropFrame (encS s)) encS encBits + (fun s => (encS s).length) (fun s => (encS s).length) := + of_linear (.of_dropFrame fun s => rfl) + have hdrop : ∀ k : ℕ, ComputableTidilyInO (fun s => (dropFrame (encS s)).drop k) encS encBits + (fun s => (encS s).length) (fun s => (encS s).length) := by + intro k + induction k with + | zero => simpa using hd + | succ k ih => + refine (((of_linear (.of_tail (f := List.tail) (encIn := encBits) (encOut := encBits) + fun _ => rfl)).comp ih).of_enc_eq (g := fun s => (dropFrame (encS s)).drop (k + 1)) + fun s => by simp [encBits, List.tail_drop]).mono 2 (fun s => ?_) (fun s => ?_) <;> + · have : ((dropFrame (encS s)).drop k).length ≤ (encS s).length := by + obtain ⟨u, hs, -⟩ := hh s + rw [hs, dropFrame_frame_append, List.length_drop, List.length_append] + omega + simp only [encBits, Function.Embedding.refl_apply] + omega + have h₂ : ComputableTidilyInO (fun s => (h s).2) encS encA (fun s => (encS s).length) + (fun s => (encS s).length) := + (hdrop k).of_enc_eq fun s => by + obtain ⟨u, hs, hu⟩ := hh s + rw [hu, hs, dropFrame_frame_append] + rfl + exact (h₁.append h₂ fun s => rfl).mono 2 (fun s => by omega) (fun s => by omega) + +/-- **Case analysis on a sum component.** If `f` is computable on the left case and `g` on the +right case, so is the case analysis, within the bounds of the branch taken plus the length of the +encoded input. -/ +theorem sumElimSnd {f : π × α → ε} {g : π × β → ε} {Tf Sf : π × α → ℕ} {Tg Sg : π × β → ℕ} + (hf : ComputableTidilyInO f (encPair encP encA) encE Tf Sf) + (hg : ComputableTidilyInO g (encPair encP encB) encE Tg Sg) : + ComputableTidilyInO + (fun p : π × (α ⊕ β) => p.2.elim (fun a => f (p.1, a)) (fun b => g (p.1, b))) + (encPair encP (encSum encA encB)) encE + (fun p => (encPair encP (encSum encA encB) p).length + + p.2.elim (fun a => Tf (p.1, a)) (fun b => Tg (p.1, b))) + (fun p => (encPair encP (encSum encA encB) p).length + + p.2.elim (fun a => Sf (p.1, a)) (fun b => Sg (p.1, b))) := by + set enc := encPair encP (encSum encA encB) + set F := fun p : π × (α ⊕ β) => p.2.elim (fun a => f (p.1, a)) (fun b => g (p.1, b)) + -- the test + have htest : ComputableTidilyInO (fun p : π × (α ⊕ β) => p.2.isLeft) enc encBool + (fun p => (enc p).length) (fun p => (enc p).length) := by + refine ((ComputableInO.isLeft_deg encA encB).inO_one.tidy.comp + (snd encP (encSum encA encB))).mono 2 (fun p => ?_) (fun p => ?_) <;> + · simp only [enc, length_encPair] + omega + -- the two branches, on their cases + let L : {p : π × (α ⊕ β) // p.2.isLeft = true} → π × α := + fun p => (p.1.1, p.1.2.getLeft (by simpa using p.2)) + let R : {p : π × (α ⊕ β) // p.2.isLeft = false} → π × β := + fun p => (p.1.1, p.1.2.getRight (by simpa using p.2)) + have hL := keepFrame_drop (encP := encP) (encA := encA) (encS := (Function.Embedding.subtype _).trans enc) (h := L) 1 + fun ⟨⟨x, s⟩, hs⟩ => by + cases s with + | inl a => exact ⟨false :: encA a, by simp [enc, L], rfl⟩ + | inr b => simp at hs + have hR := keepFrame_drop (encP := encP) (encA := encB) (encS := (Function.Embedding.subtype _).trans enc) (h := R) 1 + fun ⟨⟨x, s⟩, hs⟩ => by + cases s with + | inl a => simp at hs + | inr b => exact ⟨true :: encB b, by simp [enc, R], rfl⟩ + obtain ⟨c₀, h₀, -⟩ := htest + obtain ⟨c₁, h₁, l₁⟩ := hf.comp hL + obtain ⟨c₂, h₂, l₂⟩ := hg.comp hR + have hF₁ : ∀ q : {p : π × (α ⊕ β) // p.2.isLeft = true}, F q.1 = (f ∘ L) q := by + rintro ⟨⟨x, s⟩, hs⟩ + cases s with + | inl a => rfl + | inr b => simp at hs + have hF₂ : ∀ q : {p : π × (α ⊕ β) // p.2.isLeft = false}, F q.1 = (g ∘ R) q := by + rintro ⟨⟨x, s⟩, hs⟩ + cases s with + | inl a => simp at hs + | inr b => rfl + let Tl : π × (α ⊕ β) → ℕ := fun p => p.2.elim (fun a => Tf (p.1, a)) (fun _ => 0) + let Sl : π × (α ⊕ β) → ℕ := fun p => p.2.elim (fun a => Sf (p.1, a)) (fun _ => 0) + let Tr : π × (α ⊕ β) → ℕ := fun p => p.2.elim (fun _ => 0) (fun b => Tg (p.1, b)) + let Sr : π × (α ⊕ β) → ℕ := fun p => p.2.elim (fun _ => 0) (fun b => Sg (p.1, b)) + have hlenL : ∀ q : {p : π × (α ⊕ β) // p.2.isLeft = true}, + ((Function.Embedding.subtype _).trans enc q).length = (enc q.1).length := fun _ => rfl + have hlenR : ∀ q : {p : π × (α ⊕ β) // p.2.isLeft = false}, + ((Function.Embedding.subtype _).trans enc q).length = (enc q.1).length := fun _ => rfl + obtain ⟨k, h⟩ := ComputableTidilyInTimeAndSpace.ite h₀ (f := F) (g := F) + (tf := fun p => c₁ * ((enc p).length + Tl p + 1)) + (sf := fun p => c₁ * ((enc p).length + Sl p + 1)) + (tg := fun p => c₂ * ((enc p).length + Tr p + 1)) + (sg := fun p => c₂ * ((enc p).length + Sr p + 1)) + ((h₁.of_enc_eq fun q => by rw [Function.comp_apply, hF₁ q]).mono + (fun ⟨⟨x, s⟩, hs⟩ => by + cases s with + | inl a => exact le_of_eq rfl + | inr b => simp at hs) + (fun ⟨⟨x, s⟩, hs⟩ => by + cases s with + | inl a => exact le_of_eq rfl + | inr b => simp at hs)) + ((h₂.of_enc_eq fun q => by rw [Function.comp_apply, hF₂ q]).mono + (fun ⟨⟨x, s⟩, hs⟩ => by + cases s with + | inl a => simp at hs + | inr b => exact le_of_eq rfl) + (fun ⟨⟨x, s⟩, hs⟩ => by + cases s with + | inl a => simp at hs + | inr b => exact le_of_eq rfl)) + have hFeq : (fun x => if x.2.isLeft then F x else F x) = F := funext fun _ => by + split_ifs <;> rfl + rw [hFeq] at h + refine of_bounds h (c₀ + c₁ + c₂ + k + 1) (fun p => ?_) (fun p => ?_) (fun p => ?_) + · obtain ⟨x, s⟩ := p + cases s <;> simp only [Tl, Tr, Sum.isLeft_inl, Sum.isLeft_inr, Sum.elim_inl, Sum.elim_inr, + ite_true, ite_false, Bool.false_eq_true] <;> nlinarith + · obtain ⟨x, s⟩ := p + cases s <;> simp only [Sl, Sr, Sum.isLeft_inl, Sum.isLeft_inr, Sum.elim_inl, Sum.elim_inr, + ite_true, ite_false, Bool.false_eq_true] <;> nlinarith + · obtain ⟨x, s⟩ := p + cases s with + | inl a => + have := l₁ ⟨(x, .inl a), rfl⟩ + simp only [Function.comp_apply, L, Sum.getLeft_inl] at this + simp only [F, Sum.elim_inl] + nlinarith [hlenL ⟨(x, .inl a), rfl⟩] + | inr b => + have := l₂ ⟨(x, .inr b), rfl⟩ + simp only [Function.comp_apply, R, Sum.getRight_inr] at this + simp only [F, Sum.elim_inr] + nlinarith [hlenR ⟨(x, .inr b), rfl⟩] + +/-- **Case analysis on an option component.** If `f` is computable on the first component in the +`none` case and `g` on the pair in the `some` case, so is the case analysis, within the bounds of +the branch taken plus the length of the encoded input. -/ +theorem optionElimSnd {f : π → ε} {g : π × α → ε} {Tf Sf : π → ℕ} {Tg Sg : π × α → ℕ} + (hf : ComputableTidilyInO f encP encE Tf Sf) + (hg : ComputableTidilyInO g (encPair encP encA) encE Tg Sg) : + ComputableTidilyInO (fun p : π × Option α => p.2.elim (f p.1) (fun a => g (p.1, a))) + (encPair encP (encOption encA)) encE + (fun p => (encPair encP (encOption encA) p).length + + p.2.elim (Tf p.1) (fun a => Tg (p.1, a))) + (fun p => (encPair encP (encOption encA) p).length + + p.2.elim (Sf p.1) (fun a => Sg (p.1, a))) := by + set enc := encPair encP (encOption encA) + set F := fun p : π × Option α => p.2.elim (f p.1) (fun a => g (p.1, a)) + -- the test + have htest : ComputableTidilyInO (fun p : π × Option α => p.2.isSome) enc encBool + (fun p => (enc p).length) (fun p => (enc p).length) := by + have he : ComputableTidilyInO (fun p : π × Option α => p.2.isNone) enc encBool + (fun p => (enc p).length) (fun p => (enc p).length) := by + have hd : ComputableTidilyInO (fun p : π × Option α => dropFrame (enc p)) enc encBits + (fun p => (enc p).length) (fun p => (enc p).length) := + of_linear (.of_dropFrame fun p => rfl) + refine ((of_linear (.of_isEmpty (f := List.isEmpty) (encIn := encBits) fun _ => rfl)).comp + hd).of_enc_eq (fun p => ?_) |>.mono 2 (fun p => ?_) (fun p => ?_) + · obtain ⟨x, _ | a⟩ := p <;> simp [enc, dropFrame_frame_append] + all_goals + simp only [enc, encPair_apply, dropFrame_frame_append, encBits, + Function.Embedding.refl_apply, List.length_append, length_frame] + omega + refine ((ComputableTidilyInDegree.of_finite (encIn := encBool) (encMid := encBool) + Bool.not).inO_one.comp + he).of_enc_eq (fun p => ?_) |>.mono 2 (fun p => ?_) (fun p => ?_) + · obtain ⟨x, _ | a⟩ := p <;> rfl + all_goals simp only [encBool_apply, List.length_singleton]; omega + -- the two branches, on their cases + let N : {p : π × Option α // p.2.isSome = false} → π := fun p => p.1.1 + let S : {p : π × Option α // p.2.isSome = true} → π × α := + fun p => (p.1.1, p.1.2.get p.2) + have hN : ComputableTidilyInO N ((Function.Embedding.subtype _).trans enc) encP + (fun s => ((Function.Embedding.subtype _).trans enc s).length) + (fun s => ((Function.Embedding.subtype _).trans enc s).length) := + of_linear (.of_unframe fun ⟨⟨x, o⟩, _⟩ => by simp [enc, N, unframe_frame_append]) + have hS := keepFrame_drop (encP := encP) (encA := encA) + (encS := (Function.Embedding.subtype _).trans enc) (h := S) 1 + fun ⟨⟨x, o⟩, ho⟩ => by + cases o with + | none => simp at ho + | some a => exact ⟨true :: encA a, by simp [enc, S], rfl⟩ + obtain ⟨c₀, h₀, -⟩ := htest + obtain ⟨c₁, h₁, l₁⟩ := hg.comp hS + obtain ⟨c₂, h₂, l₂⟩ := hf.comp hN + have hF₁ : ∀ q : {p : π × Option α // p.2.isSome = true}, F q.1 = (g ∘ S) q := by + rintro ⟨⟨x, o⟩, ho⟩ + cases o with + | none => simp at ho + | some a => rfl + have hF₂ : ∀ q : {p : π × Option α // p.2.isSome = false}, F q.1 = (f ∘ N) q := by + rintro ⟨⟨x, o⟩, ho⟩ + cases o with + | none => rfl + | some a => simp at ho + let Ts : π × Option α → ℕ := fun p => p.2.elim 0 (fun a => Tg (p.1, a)) + let Ss : π × Option α → ℕ := fun p => p.2.elim 0 (fun a => Sg (p.1, a)) + let Tn : π × Option α → ℕ := fun p => p.2.elim (Tf p.1) (fun _ => 0) + let Sn : π × Option α → ℕ := fun p => p.2.elim (Sf p.1) (fun _ => 0) + have hlenS : ∀ q : {p : π × Option α // p.2.isSome = true}, + ((Function.Embedding.subtype _).trans enc q).length = (enc q.1).length := fun _ => rfl + have hlenN : ∀ q : {p : π × Option α // p.2.isSome = false}, + ((Function.Embedding.subtype _).trans enc q).length = (enc q.1).length := fun _ => rfl + obtain ⟨k, h⟩ := ComputableTidilyInTimeAndSpace.ite h₀ (f := F) (g := F) + (tf := fun p => c₁ * ((enc p).length + Ts p + 1)) + (sf := fun p => c₁ * ((enc p).length + Ss p + 1)) + (tg := fun p => c₂ * ((enc p).length + Tn p + 1)) + (sg := fun p => c₂ * ((enc p).length + Sn p + 1)) + ((h₁.of_enc_eq fun q => by rw [Function.comp_apply, hF₁ q]).mono + (fun ⟨⟨x, o⟩, ho⟩ => by + cases o with + | none => simp at ho + | some a => exact le_of_eq rfl) + (fun ⟨⟨x, o⟩, ho⟩ => by + cases o with + | none => simp at ho + | some a => exact le_of_eq rfl)) + ((h₂.of_enc_eq fun q => by rw [Function.comp_apply, hF₂ q]).mono + (fun ⟨⟨x, o⟩, ho⟩ => by + cases o with + | none => exact le_of_eq rfl + | some a => simp at ho) + (fun ⟨⟨x, o⟩, ho⟩ => by + cases o with + | none => exact le_of_eq rfl + | some a => simp at ho)) + have hFeq : (fun x => if x.2.isSome then F x else F x) = F := funext fun _ => by + split_ifs <;> rfl + rw [hFeq] at h + refine of_bounds h (c₀ + c₁ + c₂ + k + 1) (fun p => ?_) (fun p => ?_) (fun p => ?_) + · obtain ⟨x, o⟩ := p + cases o <;> simp only [Ts, Tn, Option.isSome_none, Option.isSome_some, Option.elim_none, + Option.elim_some, ite_true, ite_false, Bool.false_eq_true] <;> nlinarith + · obtain ⟨x, o⟩ := p + cases o <;> simp only [Ss, Sn, Option.isSome_none, Option.isSome_some, Option.elim_none, + Option.elim_some, ite_true, ite_false, Bool.false_eq_true] <;> nlinarith + · obtain ⟨x, o⟩ := p + cases o with + | none => + have := l₂ ⟨(x, none), rfl⟩ + simp only [Function.comp_apply, N] at this + simp only [F, Option.elim_none] + nlinarith [hlenN ⟨(x, none), rfl⟩] + | some a => + have := l₁ ⟨(x, some a), rfl⟩ + simp only [Function.comp_apply, S, Option.get_some] at this + simp only [F, Option.elim_some] + nlinarith [hlenS ⟨(x, some a), rfl⟩] + +end Turing.MultiTapeTM.ComputableTidilyInO From ab67a9a76354e10a1f6595527e08035fb29dab53 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:22:59 +0000 Subject: [PATCH 03/40] wip: plain-form interfaces; case-analysis certificates --- .../Turing/MultiTape/Combinators/DivConq.lean | 69 ++++++++++++++++--- .../MultiTape/Combinators/StackLoop.lean | 18 ++--- .../MultiTape/Combinators/TakeDropUnary.lean | 4 +- .../MultiTape/Complexity/BigO/Cases.lean | 44 ++++++++++-- 4 files changed, 110 insertions(+), 25 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 43bab3271b..0142958ef8 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -20,7 +20,7 @@ second solution. Its evaluation with a cost is the inductive relation If the parts are tidily computable, the solution is tidily computable within the cost of the evaluation, when the cost of every node covers the costs of its parts and the lengths of the words -it touches (`Turing.MultiTapeTM.ComputableTidilyInO.divConq`). The machine runs the recursion as a +it touches (`Turing.MultiTapeTM.ComputableInO.divConq`). The machine runs the recursion as a `Turing.MultiTapeTM.StackLoop`, keeping the pending problems and saved data on a stack, so a node does not pay for the frames of its ancestors. @@ -31,7 +31,7 @@ does not pay for the frames of its ancestors. ## Main results -* `Turing.MultiTapeTM.ComputableTidilyInO.divConq`: divide and conquer within the cost of the +* `Turing.MultiTapeTM.ComputableInO.divConq`: divide and conquer within the cost of the evaluation. -/ @@ -210,22 +210,71 @@ theorem eval_trace {cb : α → ℕ} {cn : α → β → β → ℕ} {R : Option end DivConq +/-! ### Certificates for the rounds -/ + +namespace DivConq + +open ComputableTidilyInO + +variable {α β γ : Type} {encA : α ↪ List Bool} {encB : β ↪ List Bool} {encG : γ ↪ List Bool} + +/-- The encoding of the values of the loop. -/ +abbrev encVal (encA : α ↪ List Bool) (encB : β ↪ List Bool) : Val α β ↪ List Bool := + encSum encA (encSum encB encB) + +/-- The encoding of the frames of the loop. -/ +abbrev encFrame (encA : α ↪ List Bool) (encG : γ ↪ List Bool) : Frame α γ ↪ List Bool := + encSum encA encG + +/-- `Option.toList`, in linear time. -/ +lemma toList_inO {δ : Type} {enc : δ ↪ List Bool} : + ComputableTidilyInO (Option.toList (α := δ)) (encOption enc) (encList enc) + (fun o => (encOption enc o).length) (fun o => (encOption enc o).length) := by + have htail : ComputableTidilyInO List.tail encBits encBits (fun w => w.length) + (fun w => w.length) := + of_linear (.of_tail (f := List.tail) (encIn := encBits) (encOut := encBits) fun _ => rfl) + have hframe : ComputableTidilyInO frame encBits encBits (fun w => w.length) + (fun w => w.length) := + of_linear (.of_frame (f := frame) (encIn := encBits) (encOut := encBits) fun _ => rfl) + have hft : ComputableTidilyInO (fun w : List Bool => frame w.tail) encBits encBits + (fun w => w.length) (fun w => w.length) := + (hframe.comp htail).mono 2 (fun w => by simp [encBits]; omega) + (fun w => by simp [encBits]; omega) + have hw : ComputableTidilyInO (fun w : List Bool => if w.isEmpty then [] else frame w.tail) + encBits encBits (fun w => w.length) (fun w => w.length) := + ((of_linear (.of_isEmpty (f := List.isEmpty) (encIn := encBits) fun _ => rfl)).ite + (const (encMid := encBits) []) hft).mono 2 (fun w => by split_ifs <;> simp [encBits] <;> + omega) (fun w => by split_ifs <;> simp [encBits] <;> omega) + refine (hw.comp (of_linear (.of_eq (f := fun o : Option δ => encOption enc o) + (encIn := encOption enc) (encMid := encBits) fun _ => rfl))).of_enc_eq (fun o => ?_) |>.mono + 2 (fun o => ?_) (fun o => ?_) + · cases o <;> simp [encBits] + all_goals simp only [Function.comp_apply, encBits, Function.Embedding.refl_apply]; omega + +end DivConq + +end Turing.MultiTapeTM + +namespace Turing.MultiTapeTM + +namespace DivConq + /-- **Divide and conquer.** If the parts of a divide-and-conquer recursion are tidily computable and every input `x` is solved with `F x` at cost `C x`, then `F` is tidily computable within the cost of the evaluation plus the initialization. The cost of a base problem must cover its test, its solution and the lengths of the problem and its solution; the cost of a node must cover its test, the first subproblem, the middle and the combination, and the lengths of all the values they read and write. -/ -theorem ComputableTidilyInO.divConq {δ α β γ : Type} {encIn : δ ↪ List Bool} +theorem ComputableInO.divConq {δ α β γ : Type} {encIn : δ ↪ List Bool} {encA : α ↪ List Bool} {encB : β ↪ List Bool} {encG : γ ↪ List Bool} (D : DivConq α β γ) {init : δ → α} {F : δ → β} {C : δ → ℕ} {cb : α → ℕ} {cn : α → β → β → ℕ} {Ti Si : δ → ℕ} {Tt St Tb Sb Tl Sl : α → ℕ} {Tm Sm : α × β → ℕ} {Tj Sj : γ × β → ℕ} - (hinit : ComputableTidilyInO init encIn encA Ti Si) - (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) - (hbase : ComputableTidilyInO D.base encA encB Tb Sb) - (hleft : ComputableTidilyInO D.left encA encA Tl Sl) - (hmid : ComputableTidilyInO D.mid (encPair encA encB) (encPair encA encG) Tm Sm) - (hjoin : ComputableTidilyInO D.join (encPair encG encB) encB Tj Sj) + (hinit : ComputableInO init encIn encA Ti Si) + (hisBase : ComputableInO D.isBase encA encBool Tt St) + (hbase : ComputableInO D.base encA encB Tb Sb) + (hleft : ComputableInO D.left encA encA Tl Sl) + (hmid : ComputableInO D.mid (encPair encA encB) (encPair encA encG) Tm Sm) + (hjoin : ComputableInO D.join (encPair encG encB) encB Tj Sj) (hcb : ∀ a, D.isBase a = true → Tt a + St a + Tb a + Sb a + (encA a).length + (encB (D.base a)).length + 1 ≤ cb a) (hcn : ∀ a b₁ b₂, D.isBase a = false → @@ -235,7 +284,7 @@ theorem ComputableTidilyInO.divConq {δ α β γ : Type} {encIn : δ ↪ List Bo (encA (D.mid (a, b₁)).1).length + (encG (D.mid (a, b₁)).2).length + (encB b₂).length + (encB (D.join ((D.mid (a, b₁)).2, b₂))).length + 1 ≤ cn a b₁ b₂) (heval : ∀ x, D.Eval cb cn (init x) (F x) (C x)) : - ComputableTidilyInO F encIn encB (fun x => (encIn x).length + Ti x + Si x + C x) + ComputableInO F encIn encB (fun x => (encIn x).length + Ti x + Si x + C x) (fun x => (encIn x).length + Ti x + Si x + C x) := sorry diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean index 42ac39eeb6..1772b1d143 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean @@ -30,8 +30,8 @@ of their calls, rather than paying for the whole recursion state on every round. ## Main results -* `Turing.MultiTapeTM.ComputableTidilyInO.stackLoop`: if the initial value, the halting test and - the round are tidily computable, so is the value at which the loop halts with an empty stack, +* `Turing.MultiTapeTM.ComputableInO.stackLoop`: if the initial value, the halting test and + the round are computable, so is the value at which the loop halts with an empty stack, within the sum over the rounds of their costs and the lengths of the words they touch. -/ @@ -67,24 +67,24 @@ end StackLoop open StackLoop /-- **Stack loops.** If the initial value, the halting test and the round of a stack loop are -tidily computable, and from the initial value with an empty stack the loop halts after `n x` -rounds with an empty stack, then the halting value is tidily computable. The time and space are +computable, and from the initial value with an empty stack the loop halts after `n x` +rounds with an empty stack, then the halting value is computable. The time and space are the costs of the initialization, plus, for every round and the final halting test, the costs of the halting test and of the round together with the lengths of the words they read and write. The frames are kept on a separate work tape: a round pays for the popped and pushed frames only, not for the rest of the stack. -/ -theorem ComputableTidilyInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} +theorem ComputableInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} {encA : α ↪ List Bool} {encG : γ ↪ List Bool} (L : StackLoop α γ) {init : δ → α} {Ti Si : δ → ℕ} {Th Sh : α → ℕ} {Tr Sr : Option γ × α → ℕ} (n : δ → ℕ) - (hinit : ComputableTidilyInO init encIn encA Ti Si) - (hhalt : ComputableTidilyInO L.halt encA encBool Th Sh) - (hround : ComputableTidilyInO L.round (encPair (encOption encG) encA) + (hinit : ComputableInO init encIn encA Ti Si) + (hhalt : ComputableInO L.halt encA encBool Th Sh) + (hround : ComputableInO L.round (encPair (encOption encG) encA) (encPair (encList encG) encA) Tr Sr) (hrun : ∀ x, ∀ i < n x, L.halt (L.step^[i] (init x, [])).1 = false) (hstop : ∀ x, L.halt (L.step^[n x] (init x, [])).1 = true) (hempty : ∀ x, (L.step^[n x] (init x, [])).2 = []) : - ComputableTidilyInO (fun x => (L.step^[n x] (init x, [])).1) encIn encA + ComputableInO (fun x => (L.step^[n x] (init x, [])).1) encIn encA (fun x => (encIn x).length + Ti x + Si x + ∑ i ∈ Finset.range (n x + 1), (Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean index a4b0682210..a90703cc46 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean @@ -23,8 +23,8 @@ namespace Turing.MultiTapeTM.ComputableTidilyInDegree variable {α : Type} /-- Taking the first `n` elements, with `n` in unary, in linear time. -/ -theorem takeUnary (enc : α ↪ List Bool) : - ComputableTidilyInDegree (fun p : List α × ℕ => p.1.take p.2) +theorem _root_.Turing.MultiTapeTM.ComputableInDegree.takeUnary (enc : α ↪ List Bool) : + ComputableInDegree (fun p : List α × ℕ => p.1.take p.2) (encPair (encList enc) encUnary) (encList enc) 1 1 := sorry diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean index 142654f056..5a2e707b8f 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean @@ -21,8 +21,8 @@ types are needed: the branches run on the inputs of their case only. ## Main results -* `Turing.MultiTapeTM.ComputableTidilyInO.sumElimSnd`: case analysis on a sum component. -* `Turing.MultiTapeTM.ComputableTidilyInO.optionElimSnd`: case analysis on an option component. +* `Turing.MultiTapeTM.ComputableInO.sumElimSnd`: case analysis on a sum component. +* `Turing.MultiTapeTM.ComputableInO.optionElimSnd`: case analysis on an option component. -/ public section @@ -83,7 +83,7 @@ private lemma keepFrame_drop {σ : Type} {encS : σ ↪ List Bool} {h : σ → /-- **Case analysis on a sum component.** If `f` is computable on the left case and `g` on the right case, so is the case analysis, within the bounds of the branch taken plus the length of the encoded input. -/ -theorem sumElimSnd {f : π × α → ε} {g : π × β → ε} {Tf Sf : π × α → ℕ} {Tg Sg : π × β → ℕ} +private theorem sumElimSnd_tidy {f : π × α → ε} {g : π × β → ε} {Tf Sf : π × α → ℕ} {Tg Sg : π × β → ℕ} (hf : ComputableTidilyInO f (encPair encP encA) encE Tf Sf) (hg : ComputableTidilyInO g (encPair encP encB) encE Tg Sg) : ComputableTidilyInO @@ -187,7 +187,7 @@ theorem sumElimSnd {f : π × α → ε} {g : π × β → ε} {Tf Sf : π × α /-- **Case analysis on an option component.** If `f` is computable on the first component in the `none` case and `g` on the pair in the `some` case, so is the case analysis, within the bounds of the branch taken plus the length of the encoded input. -/ -theorem optionElimSnd {f : π → ε} {g : π × α → ε} {Tf Sf : π → ℕ} {Tg Sg : π × α → ℕ} +private theorem optionElimSnd_tidy {f : π → ε} {g : π × α → ε} {Tf Sf : π → ℕ} {Tg Sg : π × α → ℕ} (hf : ComputableTidilyInO f encP encE Tf Sf) (hg : ComputableTidilyInO g (encPair encP encA) encE Tg Sg) : ComputableTidilyInO (fun p : π × Option α => p.2.elim (f p.1) (fun a => g (p.1, a))) @@ -300,3 +300,39 @@ theorem optionElimSnd {f : π → ε} {g : π × α → ε} {Tf Sf : π → ℕ} nlinarith [hlenS ⟨(x, some a), rfl⟩] end Turing.MultiTapeTM.ComputableTidilyInO + +namespace Turing.MultiTapeTM.ComputableInO + +variable {π α β ε : Type} {encP : π ↪ List Bool} {encA : α ↪ List Bool} {encB : β ↪ List Bool} + {encE : ε ↪ List Bool} + +/-- **Case analysis on a sum component.** If `f` is computable on the left case and `g` on the +right case, so is the case analysis, within the bounds of the branch taken plus the length of the +encoded input. -/ +theorem sumElimSnd {f : π × α → ε} {g : π × β → ε} {Tf Sf : π × α → ℕ} {Tg Sg : π × β → ℕ} + (hf : ComputableInO f (encPair encP encA) encE Tf Sf) + (hg : ComputableInO g (encPair encP encB) encE Tg Sg) : + ComputableInO + (fun p : π × (α ⊕ β) => p.2.elim (fun a => f (p.1, a)) (fun b => g (p.1, b))) + (encPair encP (encSum encA encB)) encE + (fun p => (encPair encP (encSum encA encB) p).length + + p.2.elim (fun a => Tf (p.1, a)) (fun b => Tg (p.1, b))) + (fun p => (encPair encP (encSum encA encB) p).length + + p.2.elim (fun a => Sf (p.1, a)) (fun b => Sg (p.1, b))) := + (ComputableTidilyInO.sumElimSnd_tidy hf.tidy hg.tidy).computableInO + +/-- **Case analysis on an option component.** If `f` is computable on the first component in the +`none` case and `g` on the pair in the `some` case, so is the case analysis, within the bounds of +the branch taken plus the length of the encoded input. -/ +theorem optionElimSnd {f : π → ε} {g : π × α → ε} {Tf Sf : π → ℕ} {Tg Sg : π × α → ℕ} + (hf : ComputableInO f encP encE Tf Sf) + (hg : ComputableInO g (encPair encP encA) encE Tg Sg) : + ComputableInO (fun p : π × Option α => p.2.elim (f p.1) (fun a => g (p.1, a))) + (encPair encP (encOption encA)) encE + (fun p => (encPair encP (encOption encA) p).length + + p.2.elim (Tf p.1) (fun a => Tg (p.1, a))) + (fun p => (encPair encP (encOption encA) p).length + + p.2.elim (Sf p.1) (fun a => Sg (p.1, a))) := + (ComputableTidilyInO.optionElimSnd_tidy hf.tidy hg.tidy).computableInO + +end Turing.MultiTapeTM.ComputableInO From 6b42e261478160eac415832625ead75305aaeddf Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:20:02 +0000 Subject: [PATCH 04/40] wip(universal): interfaces for the windowed cost analysis (#800) --- .../MultiTape/Universal/WindowedBound.lean | 156 ++++++++++++++++++ .../MultiTape/Universal/WindowedInit.lean | 43 +++++ .../MultiTape/Universal/WindowedParts.lean | 67 ++++++++ 3 files changed, 266 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean new file mode 100644 index 0000000000..bbf6dc718c --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Windowed + +/-! +# The size of windowed configurations + +Encodings of windowed configurations and of the problems, solutions and saved data of the +divide-and-conquer form of the windowed simulation, and bounds on their sizes. + +A windowed configuration satisfies `Turing.MultiTapeTM.Universal.Windowed.WInv D B h L` when its +state is at most `D`, it has at most `D + 1` windows, the heads of its windows are within `h` of +`0`, every window holds at most `L` cells and every cell is at most `B`. Its encoded length is then +at most `winBound D B h L`. The windowed simulation of `n` steps with a description of length at +most `B` preserves the bounds on the state and the cells, moves the heads by at most one, adds at +most `2 * n` cells to every window, and emits at most `n` symbols, each at most the length of the +description. + +## Main definitions + +* `Turing.MultiTapeTM.Universal.Windowed.eWin`: the encoding of windowed configurations. +* `Turing.MultiTapeTM.Universal.Windowed.cells`: the number of cells of a window. +* `Turing.MultiTapeTM.Universal.Windowed.WInv`: bounds on a windowed configuration. +* `Turing.MultiTapeTM.Universal.Windowed.winBound`: the resulting bound on its encoded length. + +## Main results + +* `Turing.MultiTapeTM.Universal.Windowed.length_eWin_le`: the size of a windowed configuration. +* `Turing.MultiTapeTM.Universal.Windowed.WInv.sim`: the bounds after the windowed simulation. +* `Turing.MultiTapeTM.Universal.Windowed.WInv.restore_sim`: the bounds after simulating on cut + windows and pasting them back. +-/ + +public section + +namespace Turing.MultiTapeTM.Universal.Windowed + +/-! ### Encodings -/ + +/-- Windowed configurations: the state and the windows. -/ +abbrev eWin : Win ↪ List Bool := encPair eSym (encList eTape) + +/-- Problems of the divide-and-conquer simulation: the description, the number of steps in unary +and the windows. -/ +abbrev Prob := Desc × ℕ × Win + +/-- The encoding of problems. -/ +abbrev eProb : Prob ↪ List Bool := encPair eDesc (encPair encUnary eWin) + +/-- Solutions: the windows after the steps and the emitted symbols. -/ +abbrev Sol := Win × List ℕ + +/-- The encoding of solutions. -/ +abbrev eSol : Sol ↪ List Bool := encPair eWin (encList encUnary) + +/-- Saved data: the number of steps of the second half, the windows after the first half and the +symbols it emitted. -/ +abbrev Saved := ℕ × Win × List ℕ + +/-- The encoding of saved data. -/ +abbrev eSaved : Saved ↪ List Bool := encPair encUnary (encPair eWin (encList encUnary)) + +/-! ### Bounds -/ + +/-- The number of cells of a window. -/ +@[expose] def cells (t : Tape) : ℕ := t.left.length + t.right.length + +/-- Bounds on a windowed configuration: the state is at most `D`, there are at most `D + 1` +windows, their heads are within `h` of `0`, they hold at most `L` cells each, and every cell is at +most `B`. -/ +structure WInv (D B h L : ℕ) (w : Win) : Prop where + state : w.1.getD 0 ≤ D + tapes : w.2.length ≤ D + 1 + head : ∀ t ∈ w.2, t.head.natAbs ≤ h + cells : ∀ t ∈ w.2, cells t ≤ L + val : ∀ t ∈ w.2, ∀ o ∈ t.left ++ t.right, o.getD 0 ≤ B + +/-- The bound on the encoded length of a windowed configuration satisfying `WInv D B h L`. -/ +@[expose] def winBound (D B h L : ℕ) : ℕ := + 2 * D + 3 + (D + 1) * (4 * h + 4 * L * (2 * B + 3) + 9) + +/-- **The size of a windowed configuration.** -/ +theorem length_eWin_le {D B h L : ℕ} {w : Win} (hw : WInv D B h L w) : + (eWin w).length ≤ winBound D B h L := + sorry + +/-- Weakening the bounds. -/ +theorem WInv.mono {D B h L h' L' : ℕ} {w : Win} (hw : WInv D B h L w) (hh : h ≤ h') + (hL : L ≤ L') : WInv D B h' L' w := + sorry + +/-- Cutting windows of radius `r`: the heads are at `0` and every window holds at most `2 * r + 1` +cells, and at most as many as before. -/ +theorem WInv.extract {D B h L : ℕ} {w : Win} (hw : WInv D B h L w) (r : ℕ) : + WInv D B 0 (min L (2 * r + 1)) (Windowed.extract r w) := + sorry + +/-- The windows of the initial configuration. -/ +theorem winv_initWin (d : Desc) (x : List ℕ) : + WInv (descLen d) (descLen d + listMax id x + 1) 0 (x.length + 1) (initWin d x) := + sorry + +/-- The windowed simulation keeps the number of windows. -/ +theorem length_sim (d : Desc) (n : ℕ) (w : Win) : (sim d n w).1.2.length = w.2.length := + sorry + +/-- **The bounds after the windowed simulation** of `n` steps, for a description of length at most +`B`: the heads move by at most one and every window gains at most `2 * n` cells. -/ +theorem WInv.sim {d : Desc} {B h L : ℕ} (hDB : descLen d ≤ B) {w : Win} + (hw : WInv (descLen d) B h L w) (n : ℕ) : + WInv (descLen d) B (h + 1) (L + 2 * n) (Windowed.sim d n w).1 := + sorry + +/-- **The bounds after simulating on cut windows and pasting them back**: simulating `m` steps on +the windows of radius `r` and pasting the result back adds at most `2 * m` cells to every window, +and puts the heads at `0`. -/ +theorem WInv.restore_sim {d : Desc} {B h L : ℕ} (hDB : descLen d ≤ B) {w : Win} + (hw : WInv (descLen d) B h L w) (r m : ℕ) : + WInv (descLen d) B 0 (L + 2 * m) (restore r w (Windowed.sim d m (Windowed.extract r w)).1) := + sorry + +/-- The windowed simulation of `n` steps emits at most `n` symbols. -/ +theorem length_sim_out (d : Desc) (n : ℕ) (w : Win) : (sim d n w).2.length ≤ n := + sorry + +/-- The symbols emitted by the windowed simulation are at most the length of the description. -/ +theorem le_of_mem_sim_out {d : Desc} {n : ℕ} {w : Win} {o : ℕ} (ho : o ∈ (sim d n w).2) : + o ≤ descLen d := + sorry + +/-- The size of the emitted symbols. -/ +theorem length_encList_sim_out_le (d : Desc) (n : ℕ) (w : Win) : + (encList encUnary (sim d n w).2).length ≤ n * (2 * descLen d + 1) := + sorry + +/-- The windowed simulation of `n + 2` steps: the first half on cut windows, pasted back, then the +second half. -/ +theorem sim_add_two (d : Desc) (n : ℕ) (w : Win) : + sim d (n + 2) w = + (restore ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1) + (sim d ((n + 2) / 2) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))).1, + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).2 ++ + (sim d ((n + 2) / 2) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))).2) := + sorry + +end Turing.MultiTapeTM.Universal.Windowed diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean new file mode 100644 index 0000000000..b225e71a77 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedBound + +/-! +# The cost of the initial windows + +From the input of the universal function — a description `d`, an input `x` and a number of steps +`t` in binary — the first problem of the windowed simulation is the description, `t` in unary and +the windows of radius `t` of the initial configuration. It is computable in time +`O(N + (D + 1) ^ 3 + (t + 1) * (L + 1))` for the encoded input length `N`, the length `D` of the +description and the length `L` of `t` in binary: `t` is converted to unary by doubling, the input +symbols are recoded by a finite-state rewrite in linear time, and the input window is cut with a +linear-time take. + +## Main results + +* `Turing.MultiTapeTM.Universal.Windowed.initProb_inO`: the first problem. +-/ + +public section + +namespace Turing.MultiTapeTM.Universal.Windowed + +/-- **The first problem of the windowed simulation**, in time linear in the encoded input, cubic in +the length of the description and `O((t + 1) * (L + 1))` for `t` steps written with `L` binary +digits. -/ +theorem initProb_inO : + ComputableInO (fun i : Desc × List ℕ × ℕ => ((i.1, i.2.2, extract i.2.2 (initWin i.1 i.2.1)) : + Prob)) eIn eProb + (fun i => (eIn i).length + (descLen i.1 + 1) ^ 3 + (i.2.2 + 1) * ((encNat i.2.2).length + 1)) + (fun i => (eIn i).length + (descLen i.1 + 1) ^ 3 + + (i.2.2 + 1) * ((encNat i.2.2).length + 1)) := + sorry + +end Turing.MultiTapeTM.Universal.Windowed diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean new file mode 100644 index 0000000000..945e800780 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedBound + +/-! +# The cost of cutting, pasting and stepping windows + +Cutting windows (`Turing.MultiTapeTM.Universal.Windowed.extract`) and pasting them back +(`Turing.MultiTapeTM.Universal.Windowed.restore`) take time linear in the encoded windows for each +window, so time `O((K + 1) * N)` for `K` windows of total encoded length `N`; every operation on +the cells of a window is linear in their encoded length. A windowed step +(`Turing.MultiTapeTM.Universal.Windowed.wstep`) takes time cubic in the encoded description and +windows. Halving a number of steps in unary takes linear time. + +## Main results + +* `Turing.MultiTapeTM.Universal.Windowed.extract_inO`, `.restore_inO`: cutting and pasting. +* `Turing.MultiTapeTM.Universal.Windowed.wstep_inO`: a windowed step. +* `Turing.MultiTapeTM.Universal.Windowed.firstHalf_inO`, `.half_inO`: halving in unary. +-/ + +public section + +namespace Turing.MultiTapeTM.Universal.Windowed + +/-- **Cutting windows** of radius `r`, in time linear in the encoded windows for each window. -/ +theorem extract_inO : + ComputableInO (fun p : ℕ × Win => extract p.1 p.2) (encPair encUnary eWin) eWin + (fun p => (p.2.2.length + 1) * ((encPair encUnary eWin p).length + 1)) + (fun p => (p.2.2.length + 1) * ((encPair encUnary eWin p).length + 1)) := + sorry + +/-- **Pasting windows back**, in time linear in the encoded windows for each window. -/ +theorem restore_inO : + ComputableInO (fun p : ℕ × Win × Win => restore p.1 p.2.1 p.2.2) + (encPair encUnary (encPair eWin eWin)) eWin + (fun p => (p.2.1.2.length + 1) * ((encPair encUnary (encPair eWin eWin) p).length + 1)) + (fun p => (p.2.1.2.length + 1) * ((encPair encUnary (encPair eWin eWin) p).length + 1)) := + sorry + +/-- **A windowed step**, in time cubic in the encoded description and windows. -/ +theorem wstep_inO : + ComputableInO (fun p : Desc × Win => wstep p.1 p.2) (encPair eDesc eWin) (encPair eWin eSym) + (fun p => ((encPair eDesc eWin p).length + 1) ^ 3) + (fun p => ((encPair eDesc eWin p).length + 1) ^ 3) := + sorry + +/-- The first half of a number of steps, in unary, in linear time. -/ +theorem firstHalf_inO : + ComputableInO firstHalf encUnary encUnary (fun n => (encUnary n).length) + (fun n => (encUnary n).length) := + sorry + +/-- Half a number of steps, rounded down, in unary, in linear time. -/ +theorem half_inO : + ComputableInO (· / 2) encUnary encUnary (fun n => (encUnary n).length) + (fun n => (encUnary n).length) := + sorry + +end Turing.MultiTapeTM.Universal.Windowed From be90c090baa076f56f2c41ce97768ec2829a0b5c Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:24:25 +0000 Subject: [PATCH 05/40] wip: local copy of the plain divConq stub (coordinator's WIP file does not build) --- .../Turing/MultiTape/Combinators/DivConq.lean | 188 ------------------ 1 file changed, 188 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 0142958ef8..59a3745546 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -69,196 +69,8 @@ inductive Eval (D : DivConq α β γ) (cb : α → ℕ) (cn : α → β → β Eval D cb cn (D.left a) b₁ c₁ → Eval D cb cn (D.mid (a, b₁)).1 b₂ c₂ → Eval D cb cn a (D.join ((D.mid (a, b₁)).2, b₂)) (c₁ + c₂ + cn a b₁ b₂) -/-! ### The recursion as a stack loop -/ - -/-- The values of the stack loop: a call on a problem, a returned solution, and the final -solution. -/ -abbrev Val (α β : Type) := α ⊕ (β ⊕ β) - -/-- The frames of the stack loop: a problem whose first subproblem is being solved, or the data -saved while its second subproblem is solved. -/ -abbrev Frame (α γ : Type) := α ⊕ γ - -variable (D : DivConq α β γ) - -/-- A round on a call: a base problem returns its solution; otherwise the problem is saved and its -first subproblem called. The popped frame is pushed back. -/ -@[expose] def roundCall (p : Option (Frame α γ) × α) : List (Frame α γ) × Val α β := - if D.isBase p.2 then (p.1.toList, .inr (.inl (D.base p.2))) - else (.inl p.2 :: p.1.toList, .inl (D.left p.2)) - -/-- A round on a returned solution: with an empty stack it is final; after a first subproblem the -second is called, saving the data; after a second subproblem the solution is combined. -/ -@[expose] def roundRet (p : Option (Frame α γ) × β) : List (Frame α γ) × Val α β := - match p.1 with - | none => ([], .inr (.inr p.2)) - | some (.inl a) => ([.inr (D.mid (a, p.2)).2], .inl (D.mid (a, p.2)).1) - | some (.inr g) => ([], .inr (.inl (D.join (g, p.2)))) - -/-- The recursion as a stack loop, halting at a final solution. -/ -@[expose] def loop : StackLoop (Val α β) (Frame α γ) where - halt v := match v with - | .inr (.inr _) => true - | _ => false - round p := match p.2 with - | .inl a => D.roundCall (p.1, a) - | .inr (.inl b) => D.roundRet (p.1, b) - | .inr (.inr b) => (p.1.toList, .inr (.inr b)) - -omit D in -lemma toList_head?_append_tail (stk : List (Frame α γ)) : stk.head?.toList ++ stk.tail = stk := by - cases stk <;> rfl - -/-- **The trace of an evaluation.** If every round costs at most `R` of its input, and `R` is -bounded on the rounds of base problems and nodes as below, then from a call on `a` the loop -returns the solution of `a`, above an untouched stack, within rounds whose total cost is at most -`A * c` plus `B` times the size of the frame below, plus `B`. -/ -theorem eval_trace {cb : α → ℕ} {cn : α → β → β → ℕ} {R : Option (Frame α γ) × Val α β → ℕ} - {fsize : Option (Frame α γ) → ℕ} {B : ℕ} - (hbase : ∀ o a, D.isBase a = true → R (o, .inl a) ≤ B * (fsize o + 1) + B * cb a) - (hcall : ∀ o a b₁ b₂, D.isBase a = false → - R (o, .inl a) ≤ B * (fsize o + 1) + B * cn a b₁ b₂) - (hmid : ∀ a b₁ b₂, D.isBase a = false → R (some (.inl a), .inr (.inl b₁)) ≤ B * cn a b₁ b₂) - (hjoin : ∀ a b₁ b₂, D.isBase a = false → - R (some (.inr (D.mid (a, b₁)).2), .inr (.inl b₂)) ≤ B * cn a b₁ b₂) - (hframe : ∀ a b₁ b₂, D.isBase a = false → - fsize (some (.inl a)) + fsize (some (.inr (D.mid (a, b₁)).2)) + 2 ≤ cn a b₁ b₂) - {a : α} {b : β} {c : ℕ} (h : D.Eval cb cn a b c) (stk : List (Frame α γ)) : - ∃ m, (D.loop.step^[m] (.inl a, stk) = (.inr (.inl b), stk)) ∧ - (∀ i < m, D.loop.halt (D.loop.step^[i] (.inl a, stk)).1 = false) ∧ - ∑ i ∈ Finset.range m, R (StackLoop.roundInput (D.loop.step^[i] (.inl a, stk))) ≤ - 4 * B * c + B * (fsize stk.head? + 1) := by - induction h generalizing stk with - | @base a ha => - refine ⟨1, ?_, fun i hi => ?_, ?_⟩ - · simp [StackLoop.step, StackLoop.roundInput, loop, roundCall, ha, toList_head?_append_tail] - · obtain rfl : i = 0 := by omega - rfl - · simp only [Finset.range_one, Finset.sum_singleton, Function.iterate_zero, id_eq] - have := hbase stk.head? a ha - simp only [StackLoop.roundInput] - nlinarith - | @node a b₁ b₂ c₁ c₂ ha h₁ h₂ ih₁ ih₂ => - -- the call round, the first subproblem, the middle round, the second subproblem, the join - obtain ⟨m₁, hm₁, hh₁, hs₁⟩ := ih₁ (.inl a :: stk) - obtain ⟨m₂, hm₂, hh₂, hs₂⟩ := ih₂ (.inr (D.mid (a, b₁)).2 :: stk) - have hcallStep : D.loop.step (.inl a, stk) = (.inl (D.left a), .inl a :: stk) := by - simp [StackLoop.step, StackLoop.roundInput, loop, roundCall, ha, toList_head?_append_tail] - have hmidStep : D.loop.step (.inr (.inl b₁), .inl a :: stk) = - (.inl (D.mid (a, b₁)).1, .inr (D.mid (a, b₁)).2 :: stk) := by - simp [StackLoop.step, StackLoop.roundInput, loop, roundRet] - have hjoinStep : D.loop.step (.inr (.inl b₂), .inr (D.mid (a, b₁)).2 :: stk) = - (.inr (.inl (D.join ((D.mid (a, b₁)).2, b₂))), stk) := by - simp [StackLoop.step, StackLoop.roundInput, loop, roundRet] - -- the positions of the phases - have e₁ : D.loop.step^[m₁ + 1] (.inl a, stk) = (.inr (.inl b₁), .inl a :: stk) := by - rw [Function.iterate_add_apply, Function.iterate_one, hcallStep, hm₁] - have e₂ : D.loop.step^[m₂ + 1 + (m₁ + 1)] (.inl a, stk) = - (.inr (.inl b₂), .inr (D.mid (a, b₁)).2 :: stk) := by - rw [Function.iterate_add_apply, e₁, Function.iterate_add_apply, Function.iterate_one, - hmidStep, hm₂] - refine ⟨1 + (m₂ + 1 + (m₁ + 1)), ?_, fun i hi => ?_, ?_⟩ - · rw [Function.iterate_add_apply, e₂, Function.iterate_one, hjoinStep] - · -- every round before the end is on a call or a returned solution with a nonempty stack - rcases Nat.lt_or_ge i (m₁ + 1) with hi₁ | hi₁ - · rcases Nat.eq_zero_or_pos i with rfl | hi₀ - · rfl - · obtain ⟨j, rfl⟩ : ∃ j, i = j + 1 := ⟨i - 1, by omega⟩ - rw [Function.iterate_add_apply, Function.iterate_one, hcallStep] - exact hh₁ j (by omega) - · rcases Nat.lt_or_ge i (m₂ + 1 + (m₁ + 1)) with hi₂ | hi₂ - · obtain ⟨j, rfl⟩ : ∃ j, i = j + (m₁ + 1) := ⟨i - (m₁ + 1), by omega⟩ - rw [Function.iterate_add_apply, e₁] - rcases Nat.eq_zero_or_pos j with rfl | hj₀ - · rfl - · obtain ⟨l, rfl⟩ : ∃ l, j = l + 1 := ⟨j - 1, by omega⟩ - rw [Function.iterate_add_apply, Function.iterate_one, hmidStep] - exact hh₂ l (by omega) - · obtain rfl : i = m₂ + 1 + (m₁ + 1) := by omega - rw [e₂] - rfl - · -- the costs of the phases - have hsplit : ∑ i ∈ Finset.range (1 + (m₂ + 1 + (m₁ + 1))), - R (StackLoop.roundInput (D.loop.step^[i] (.inl a, stk))) = - R (stk.head?, .inl a) + - ∑ i ∈ Finset.range m₁, - R (StackLoop.roundInput (D.loop.step^[i] (.inl (D.left a), .inl a :: stk))) + - R (some (.inl a), .inr (.inl b₁)) + - ∑ i ∈ Finset.range m₂, - R (StackLoop.roundInput (D.loop.step^[i] (.inl (D.mid (a, b₁)).1, - .inr (D.mid (a, b₁)).2 :: stk))) + - R (some (.inr (D.mid (a, b₁)).2), .inr (.inl b₂)) := by - rw [show 1 + (m₂ + 1 + (m₁ + 1)) = 1 + m₁ + 1 + m₂ + 1 by omega, Finset.sum_range_succ, - Finset.sum_range_add, Finset.sum_range_succ, Finset.sum_range_add, Finset.sum_range_one] - simp only [Function.iterate_zero, id_eq, StackLoop.roundInput] - have hA : ∀ x, D.loop.step^[1 + x] (.inl a, stk) = - D.loop.step^[x] (.inl (D.left a), .inl a :: stk) := fun x => by - rw [add_comm, Function.iterate_add_apply, Function.iterate_one, hcallStep] - have hB : ∀ x, D.loop.step^[1 + m₁ + 1 + x] (.inl a, stk) = - D.loop.step^[x] (.inl (D.mid (a, b₁)).1, .inr (D.mid (a, b₁)).2 :: stk) := - fun x => by - rw [show 1 + m₁ + 1 + x = x + 1 + (m₁ + 1) by omega, Function.iterate_add_apply, e₁, - Function.iterate_add_apply, Function.iterate_one, hmidStep] - simp only [hA, hB, hm₁, hm₂, List.head?_cons] - rw [hsplit] - have h₀ := hcall stk.head? a b₁ b₂ ha - have h₃ := hmid a b₁ b₂ ha - have h₄ := hjoin a b₁ b₂ ha - have h₅ := hframe a b₁ b₂ ha - simp only [List.head?_cons] at hs₁ hs₂ - nlinarith - end DivConq -/-! ### Certificates for the rounds -/ - -namespace DivConq - -open ComputableTidilyInO - -variable {α β γ : Type} {encA : α ↪ List Bool} {encB : β ↪ List Bool} {encG : γ ↪ List Bool} - -/-- The encoding of the values of the loop. -/ -abbrev encVal (encA : α ↪ List Bool) (encB : β ↪ List Bool) : Val α β ↪ List Bool := - encSum encA (encSum encB encB) - -/-- The encoding of the frames of the loop. -/ -abbrev encFrame (encA : α ↪ List Bool) (encG : γ ↪ List Bool) : Frame α γ ↪ List Bool := - encSum encA encG - -/-- `Option.toList`, in linear time. -/ -lemma toList_inO {δ : Type} {enc : δ ↪ List Bool} : - ComputableTidilyInO (Option.toList (α := δ)) (encOption enc) (encList enc) - (fun o => (encOption enc o).length) (fun o => (encOption enc o).length) := by - have htail : ComputableTidilyInO List.tail encBits encBits (fun w => w.length) - (fun w => w.length) := - of_linear (.of_tail (f := List.tail) (encIn := encBits) (encOut := encBits) fun _ => rfl) - have hframe : ComputableTidilyInO frame encBits encBits (fun w => w.length) - (fun w => w.length) := - of_linear (.of_frame (f := frame) (encIn := encBits) (encOut := encBits) fun _ => rfl) - have hft : ComputableTidilyInO (fun w : List Bool => frame w.tail) encBits encBits - (fun w => w.length) (fun w => w.length) := - (hframe.comp htail).mono 2 (fun w => by simp [encBits]; omega) - (fun w => by simp [encBits]; omega) - have hw : ComputableTidilyInO (fun w : List Bool => if w.isEmpty then [] else frame w.tail) - encBits encBits (fun w => w.length) (fun w => w.length) := - ((of_linear (.of_isEmpty (f := List.isEmpty) (encIn := encBits) fun _ => rfl)).ite - (const (encMid := encBits) []) hft).mono 2 (fun w => by split_ifs <;> simp [encBits] <;> - omega) (fun w => by split_ifs <;> simp [encBits] <;> omega) - refine (hw.comp (of_linear (.of_eq (f := fun o : Option δ => encOption enc o) - (encIn := encOption enc) (encMid := encBits) fun _ => rfl))).of_enc_eq (fun o => ?_) |>.mono - 2 (fun o => ?_) (fun o => ?_) - · cases o <;> simp [encBits] - all_goals simp only [Function.comp_apply, encBits, Function.Embedding.refl_apply]; omega - -end DivConq - -end Turing.MultiTapeTM - -namespace Turing.MultiTapeTM - -namespace DivConq - /-- **Divide and conquer.** If the parts of a divide-and-conquer recursion are tidily computable and every input `x` is solved with `F x` at cost `C x`, then `F` is tidily computable within the cost of the evaluation plus the initialization. The cost of a base problem must cover its test, From f746087d0766d33cf1aa6a6f20f4d43b40bb3baa Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:24:49 +0000 Subject: [PATCH 06/40] wip(divconq): fix module structure --- .../Turing/MultiTape/Combinators/DivConq.lean | 32 +++++++++---------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 0142958ef8..4e1aa195c7 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -8,6 +8,7 @@ module -- upstream: candidate public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.StackLoop +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Cases /-! # Divide and conquer @@ -238,33 +239,30 @@ lemma toList_inO {δ : Type} {enc : δ ↪ List Bool} : of_linear (.of_frame (f := frame) (encIn := encBits) (encOut := encBits) fun _ => rfl) have hft : ComputableTidilyInO (fun w : List Bool => frame w.tail) encBits encBits (fun w => w.length) (fun w => w.length) := - (hframe.comp htail).mono 2 (fun w => by simp [encBits]; omega) - (fun w => by simp [encBits]; omega) + (hframe.comp htail).mono 2 (fun w => by simp; omega) (fun w => by simp; omega) have hw : ComputableTidilyInO (fun w : List Bool => if w.isEmpty then [] else frame w.tail) encBits encBits (fun w => w.length) (fun w => w.length) := ((of_linear (.of_isEmpty (f := List.isEmpty) (encIn := encBits) fun _ => rfl)).ite - (const (encMid := encBits) []) hft).mono 2 (fun w => by split_ifs <;> simp [encBits] <;> - omega) (fun w => by split_ifs <;> simp [encBits] <;> omega) + (const (encMid := encBits) []) hft).mono 2 (fun w => by split_ifs <;> simp <;> + omega) (fun w => by split_ifs <;> simp <;> omega) refine (hw.comp (of_linear (.of_eq (f := fun o : Option δ => encOption enc o) (encIn := encOption enc) (encMid := encBits) fun _ => rfl))).of_enc_eq (fun o => ?_) |>.mono 2 (fun o => ?_) (fun o => ?_) · cases o <;> simp [encBits] - all_goals simp only [Function.comp_apply, encBits, Function.Embedding.refl_apply]; omega + all_goals omega -end DivConq - -end Turing.MultiTapeTM +lemma length_encList_toList_le {δ : Type} (enc : δ ↪ List Bool) (o : Option δ) : + (encList enc o.toList).length ≤ 2 * (encOption enc o).length := by + cases o <;> simp [length_frame] -namespace Turing.MultiTapeTM - -namespace DivConq +end DivConq -/-- **Divide and conquer.** If the parts of a divide-and-conquer recursion are tidily computable -and every input `x` is solved with `F x` at cost `C x`, then `F` is tidily computable within the -cost of the evaluation plus the initialization. The cost of a base problem must cover its test, -its solution and the lengths of the problem and its solution; the cost of a node must cover its -test, the first subproblem, the middle and the combination, and the lengths of all the values they -read and write. -/ +/-- **Divide and conquer.** If the parts of a divide-and-conquer recursion are computable and every +input `x` is solved with `F x` at cost `C x`, then `F` is computable within the cost of the +evaluation plus the initialization. The cost of a base problem must cover its test, its solution +and the lengths of the problem and its solution; the cost of a node must cover its test, the first +subproblem, the middle and the combination, and the lengths of all the values they read and +write. -/ theorem ComputableInO.divConq {δ α β γ : Type} {encIn : δ ↪ List Bool} {encA : α ↪ List Bool} {encB : β ↪ List Bool} {encG : γ ↪ List Bool} (D : DivConq α β γ) {init : δ → α} {F : δ → β} {C : δ → ℕ} {cb : α → ℕ} {cn : α → β → β → ℕ} From e3d492c317bcbfbec23422425302e2ab8ffe89e3 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:26:27 +0000 Subject: [PATCH 07/40] wip(divconq): round certificates --- .../Turing/MultiTape/Combinators/DivConq.lean | 86 +++++++++++++++++++ 1 file changed, 86 insertions(+) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 4e1aa195c7..8f50de2ba4 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -255,6 +255,92 @@ lemma length_encList_toList_le {δ : Type} (enc : δ ↪ List Bool) (o : Option (encList enc o.toList).length ≤ 2 * (encOption enc o).length := by cases o <;> simp [length_frame] +variable (D : DivConq α β γ) {Tt St Tb Sb Tl Sl : α → ℕ} {Tm Sm : α × β → ℕ} + {Tj Sj : γ × β → ℕ} + +/-- The swap of the components of a pair, in linear time. -/ +lemma swap_inO {σ τ : Type} {encS : σ ↪ List Bool} {encT : τ ↪ List Bool} : + ComputableTidilyInO (fun p : σ × τ => (p.2, p.1)) (encPair encS encT) (encPair encT encS) + (fun p => (encPair encS encT p).length) (fun p => (encPair encS encT p).length) := + ((snd encS encT).prod (fst encS encT)).mono 2 (fun _ => by omega) (fun _ => by omega) + +/-- A call round, within the costs of its parts. -/ +lemma roundCall_inO (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) + (hbase : ComputableTidilyInO D.base encA encB Tb Sb) + (hleft : ComputableTidilyInO D.left encA encA Tl Sl) : + ComputableTidilyInO D.roundCall (encPair (encOption (encFrame encA encG)) encA) + (encPair (encList (encFrame encA encG)) (encVal encA encB)) + (fun p => (encPair (encOption (encFrame encA encG)) encA p).length + Tt p.2 + St p.2 + + if D.isBase p.2 then Tb p.2 + Sb p.2 + (encB (D.base p.2)).length + else Tl p.2 + Sl p.2 + (encA (D.left p.2)).length) + (fun p => (encPair (encOption (encFrame encA encG)) encA p).length + Tt p.2 + St p.2 + + if D.isBase p.2 then Tb p.2 + Sb p.2 + (encB (D.base p.2)).length + else Tl p.2 + Sl p.2 + (encA (D.left p.2)).length) := by + have hfst := fst (encOption (encFrame encA encG)) encA + have hsnd := snd (encOption (encFrame encA encG)) encA + have hc := hisBase.comp hsnd + have hl := (toList_inO (enc := encFrame encA encG)).comp hfst + have hb := (ComputableInO.inr encA (encSum encB encB)).tidy.comp + ((ComputableInO.inl encB encB).tidy.comp (hbase.comp hsnd)) + have hcons := (ComputableTidilyInDegree.cons (encFrame encA encG)).inO_one.comp + (((ComputableInO.inl encA encG).tidy.comp hsnd).prod hl) + have hlf := (ComputableInO.inl encA (encSum encB encB)).tidy.comp (hleft.comp hsnd) + refine (hc.ite (hl.prod hb) (hcons.prod hlf)).mono 8 (fun p => ?_) (fun p => ?_) + all_goals + obtain ⟨o, a⟩ := p + have h₁ := length_encList_toList_le (encFrame encA encG) o + simp only [Function.comp_apply, length_encPair, encSum_inl, List.length_cons] at * + split_ifs <;> nlinarith + +/-- `fun b => ([], inr (inr b))`, in linear time. -/ +private lemma final_inO : + ComputableTidilyInO (fun b : β => (([] : List (Frame α γ)), (.inr (.inr b) : Val α β))) encB + (encPair (encList (encFrame encA encG)) (encVal encA encB)) (fun b => (encB b).length) + (fun b => (encB b).length) := + ((const (encMid := encList (encFrame encA encG)) []).prod + ((ComputableInO.inr encA (encSum encB encB)).tidy.comp + (ComputableInO.inr encB encB).tidy)).mono 4 (fun b => by simp; omega) + (fun b => by simp; omega) + +/-- A round on a returned solution, with the components swapped, within the costs of its +parts. -/ +private lemma retSwap_inO + (hmid : ComputableTidilyInO D.mid (encPair encA encB) (encPair encA encG) Tm Sm) + (hjoin : ComputableTidilyInO D.join (encPair encG encB) encB Tj Sj) : + ComputableTidilyInO (fun q : β × Option (Frame α γ) => q.2.elim + (([] : List (Frame α γ)), (.inr (.inr q.1) : Val α β)) + (fun x => x.elim (fun a => ([.inr (D.mid (a, q.1)).2], .inl (D.mid (a, q.1)).1)) + (fun g => ([], .inr (.inl (D.join (g, q.1))))))) + (encPair encB (encOption (encFrame encA encG))) + (encPair (encList (encFrame encA encG)) (encVal encA encB)) + (fun q => (encPair encB (encOption (encFrame encA encG)) q).length + q.2.elim 0 + (fun x => x.elim (fun a => Tm (a, q.1) + Sm (a, q.1) + (encPair encA encG (D.mid (a, q.1))).length) + (fun g => Tj (g, q.1) + Sj (g, q.1) + (encB (D.join (g, q.1))).length))) + (fun q => (encPair encB (encOption (encFrame encA encG)) q).length + q.2.elim 0 + (fun x => x.elim (fun a => Tm (a, q.1) + Sm (a, q.1) + (encPair encA encG (D.mid (a, q.1))).length) + (fun g => Tj (g, q.1) + Sj (g, q.1) + (encB (D.join (g, q.1))).length))) := by + -- the middle: the second subproblem is called, the saved data pushed + have hm := hmid.comp (swap_inO (encS := encB) (encT := encA)) + have hpush := (ComputableTidilyInDegree.cons (encFrame encA encG)).inO_one.comp + (((ComputableInO.inr encA encG).tidy.comp ((snd encA encG).comp hm)).prod + ((const (encMid := encList (encFrame encA encG)) []).comp hm)) + have hcall := (ComputableInO.inl encA (encSum encB encB)).tidy.comp ((fst encA encG).comp hm) + have hM := hpush.prod hcall + -- the combination + have hj := hjoin.comp (swap_inO (encS := encB) (encT := encG)) + have hJ := (const (encMid := encList (encFrame encA encG)) []).prod + ((ComputableInO.inr encA (encSum encB encB)).tidy.comp + ((ComputableInO.inl encB encB).tidy.comp hj)) + have hx := ComputableInO.sumElimSnd hM.computableInO hJ.computableInO + have h := ComputableInO.optionElimSnd (final_inO (encA := encA) (encG := encG)).computableInO hx + refine h.tidy.mono 16 (fun q => ?_) (fun q => ?_) + all_goals + obtain ⟨b, _ | _ | _⟩ := q <;> + simp only [Function.comp_apply, length_encPair, encSum_inl, encSum_inr, List.length_cons, + Option.elim_none, Option.elim_some, Sum.elim_inl, Sum.elim_inr, encOption_some, + encList_nil, List.length_nil] at * <;> + nlinarith + end DivConq /-- **Divide and conquer.** If the parts of a divide-and-conquer recursion are computable and every From eba9a3ea3c1cd5c568f0ad23e4231400c1f6ee48 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:26:28 +0000 Subject: [PATCH 08/40] feat(universal): prove universal_eq_sim for the windowed simulation (#800) --- .../Turing/MultiTape/Universal/Windowed.lean | 633 +++++++++++++++++- 1 file changed, 631 insertions(+), 2 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean index 70f40e9947..7d0fe59861 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean @@ -105,12 +105,641 @@ symbol, after the left end, and blank work tapes. -/ @[expose] def initWin (d : Desc) (x : List ℕ) : Win := (some d.q₀, ⟨0, [some 0], x.map fun a => some (a + 1)⟩ :: List.replicate d.tapes ⟨0, [], []⟩) +/-! ### Cells of zippers -/ + +/-- The cell of `t` at offset `i` from its head; the cells beyond the lists are blank. -/ +private def cellAt (t : Tape) (i : ℤ) : Option ℕ := + if 0 ≤ i then t.right.getD i.toNat none else t.left.getD (-i - 1).toNat none + +private lemma getD_tail' (l : List (Option ℕ)) (m : ℕ) : + l.tail.getD m none = l.getD (m + 1) none := by + cases l <;> simp + +private lemma getD_drop' (l : List (Option ℕ)) (k m : ℕ) : + (l.drop k).getD m none = l.getD (k + m) none := by + simp only [List.getD_eq_getElem?_getD, List.getElem?_drop] + +private lemma getD_take' (l : List (Option ℕ)) (k m : ℕ) : + (l.take k).getD m none = if m < k then l.getD m none else none := by + simp only [List.getD_eq_getElem?_getD, List.getElem?_take] + split_ifs <;> rfl + +private lemma getD_append_left' {A B : List (Option ℕ)} {m : ℕ} (h : m < A.length) : + (A ++ B).getD m none = A.getD m none := by + simp only [List.getD_eq_getElem?_getD, List.getElem?_append_left h] + +private lemma getD_append_right' {A B : List (Option ℕ)} {m : ℕ} (h : A.length ≤ m) : + (A ++ B).getD m none = B.getD (m - A.length) none := by + simp only [List.getD_eq_getElem?_getD, List.getElem?_append_right h] + +private lemma getD_eq_none' {l : List (Option ℕ)} {m : ℕ} (h : l.length ≤ m) : + l.getD m none = none := by + simp [List.getD_eq_getElem?_getD, List.getElem?_eq_none h] + +private lemma cellAt_of_nonneg (t : Tape) {i : ℤ} (h : 0 ≤ i) : + cellAt t i = t.right.getD i.toNat none := by + simp only [cellAt, h, ↓reduceIte] + +private lemma cellAt_of_neg (t : Tape) {i : ℤ} (h : i < 0) : + cellAt t i = t.left.getD (-i - 1).toNat none := by + simp only [cellAt, show ¬0 ≤ i by omega, ↓reduceIte] + +private lemma cellAt_zero (t : Tape) : cellAt t 0 = t.read := by + obtain ⟨_, _, _ | _⟩ := t <;> rfl + +private lemma cellAt_write (t : Tape) (o : Option ℕ) (i : ℤ) : + cellAt (t.write o) i = if i = 0 then o else cellAt t i := by + rcases lt_trichotomy i 0 with hi | rfl | hi + · rw [cellAt_of_neg _ hi, cellAt_of_neg _ hi, ite_eq_right (by omega)] + rfl + · simp [cellAt, Tape.write] + · rw [cellAt_of_nonneg _ hi.le, cellAt_of_nonneg _ hi.le, ite_eq_right (by omega)] + simp only [Tape.write] + rw [show i.toNat = (i - 1).toNat + 1 by omega, List.getD_cons_succ, getD_tail'] + +private lemma cellAt_move (t : Tape) (m : SignType) (i : ℤ) : + cellAt (t.move m) i = cellAt t (i + m) := by + rcases m with _ | _ | _ + · simp [Tape.move, SignType.zero_eq_zero] + · rw [show ((SignType.neg : SignType) : ℤ) = -1 by simp [SignType.neg_eq_neg_one]] + rcases lt_trichotomy i 0 with hi | rfl | hi + · rw [cellAt_of_neg _ hi, cellAt_of_neg _ (by omega)] + simp only [Tape.move, getD_tail'] + congr 1 + omega + · simp only [cellAt, Tape.move] + cases t.left <;> rfl + · rw [cellAt_of_nonneg _ hi.le, cellAt_of_nonneg _ (by omega)] + simp only [Tape.move] + rw [show i.toNat = (i + -1).toNat + 1 by omega, List.getD_cons_succ] + · rw [show ((SignType.pos : SignType) : ℤ) = 1 by simp [SignType.pos_eq_one]] + rcases lt_trichotomy i (-1) with hi | rfl | hi + · rw [cellAt_of_neg _ (by omega), cellAt_of_neg _ (by omega)] + simp only [Tape.move] + rw [show (-i - 1).toNat = (-(i + 1) - 1).toNat + 1 by omega, List.getD_cons_succ] + · simp only [cellAt, Tape.move, Tape.read] + cases t.right <;> rfl + · rw [cellAt_of_nonneg _ (by omega), cellAt_of_nonneg _ (by omega)] + simp only [Tape.move, getD_tail'] + congr 1 + omega + +private lemma head_move (t : Tape) (m : SignType) : (t.move m).head = t.head + m := by + rcases m with _ | _ | _ <;> + simp [Tape.move, SignType.zero_eq_zero, SignType.neg_eq_neg_one, SignType.pos_eq_one, sub_eq_add_neg] + +private lemma head_apply (t : Tape) (a : Option (Option ℕ) × SignType) : + (t.apply a).head = t.head + a.2 := by + obtain ⟨_ | o, m⟩ := a <;> simp [Tape.apply, head_move, Tape.write] + +private lemma cellAt_apply (t : Tape) (a : Option (Option ℕ) × SignType) (h z : ℤ) : + cellAt (t.apply a) (z - (h + a.2)) = + if z = h then a.1.getD (cellAt t (z - h)) else cellAt t (z - h) := by + simp only [Tape.apply, cellAt_move] + rw [show z - (h + a.2) + a.2 = z - h by ring] + obtain ⟨_ | o, m⟩ := a + · simp + · simp [cellAt_write, sub_eq_zero] + +private lemma apply_none_zero (t : Tape) : t.apply (none, 0) = t := rfl + +private lemma length_left_apply (t : Tape) (a : Option (Option ℕ) × SignType) + (h : 1 ≤ t.left.length) : ((t.apply a).left.length : ℤ) = t.left.length + a.2 := by + obtain ⟨_ | o, _ | _ | _⟩ := a <;> + simp [Tape.apply, Tape.move, Tape.write, SignType.zero_eq_zero, SignType.neg_eq_neg_one, + SignType.pos_eq_one] <;> omega + +private lemma length_right_apply (t : Tape) (a : Option (Option ℕ) × SignType) + (h : 2 ≤ t.right.length) : ((t.apply a).right.length : ℤ) + a.2 = t.right.length := by + obtain ⟨_ | o, _ | _ | _⟩ := a <;> + simp [Tape.apply, Tape.move, Tape.write, Tape.read, SignType.zero_eq_zero, + SignType.neg_eq_neg_one, SignType.pos_eq_one] <;> omega + +private lemma cellAt_cut (r : ℕ) (t : Tape) (i : ℤ) : + cellAt (cut r t) i = if -(r : ℤ) ≤ i ∧ i ≤ r then cellAt t i else none := by + simp only [cellAt, cut, getD_take'] + split_ifs <;> first | rfl | omega + +/-- The cells of `A ++ B.drop k`, when `A` is either exactly the part of the list `B` before `k`, +shifted by `s`, or `B` has no cells at `k` and beyond and neither has `A`. -/ +private lemma getD_append_drop {A B : List (Option ℕ)} {k : ℕ} {s : ℤ} + (hk : k ≤ B.length → (A.length : ℤ) + s = k) + (hA : ∀ m : ℕ, (k : ℤ) ≤ m + s → A.getD m none = none) (m : ℕ) : + (A ++ B.drop k).getD m none = + if (m : ℤ) + s < k then A.getD m none else B.getD (m + s).toNat none := by + by_cases hm : m < A.length + · rw [getD_append_left' hm] + split_ifs with h + · rfl + · rw [hA m (by omega)] + by_cases hb : k ≤ B.length + · have := hk hb + omega + · rw [getD_eq_none' (by omega)] + · rw [getD_append_right' (by omega), getD_drop', getD_eq_none' (l := A) (by omega)] + by_cases hb : k ≤ B.length + · have := hk hb + rw [ite_eq_right (by omega)] + congr 1 + omega + · rw [getD_eq_none' (by omega)] + split_ifs + · rfl + · rw [getD_eq_none' (by omega)] + +private lemma cellAt_paste {r : ℕ} {O I : Tape} {h h' : ℤ} (h₁ : h - r ≤ h') (h₂ : h' ≤ h + r) + (hL : r ≤ O.left.length → (I.left.length : ℤ) + h = r + h') + (hR : r + 1 ≤ O.right.length → (I.right.length : ℤ) + h' = h + r + 1) + (hB : ∀ z, (z < h - r ∨ h + r < z) → cellAt I (z - h') = none) (z : ℤ) : + cellAt (paste r O I) (z - h') = + if h - r ≤ z ∧ z ≤ h + r then cellAt I (z - h') else cellAt O (z - h) := by + by_cases hz : 0 ≤ z - h' + · have e := getD_append_drop (A := I.right) (B := O.right) (k := r + 1) (s := h' - h) + (by intro hb; have := hR hb; push_cast; omega) + (fun m hm => by + have := hB (h' + m) (Or.inr (by push_cast at hm; omega)) + simpa [cellAt] using this) (z - h').toNat + simp only [cellAt, paste, ite_eq_left hz, e] + split_ifs <;> first | rfl | omega | (congr 1; omega) + · have e := getD_append_drop (A := I.left) (B := O.left) (k := r) (s := h - h') + (by intro hb; have := hL hb; omega) + (fun m hm => by + have := hB (h' - m - 1) (Or.inl (by omega)) + simp only [cellAt] at this + rw [ite_eq_right (by omega)] at this + rw [← this] + congr 1 + omega) (-(z - h') - 1).toNat + simp only [cellAt, paste, ite_eq_right hz, e] + split_ifs <;> first | rfl | omega | (congr 1; omega) + +/-! ### Steps on windows -/ + +/-- The action taken in the state `q`, with the input head reading `a` and the work-tape heads +reading `rs`. In a halting configuration, or without a matching transition, it changes nothing +but the state. -/ +private def act (d : Desc) : Option ℕ → Option ℕ → List (Option ℕ) → Act + | none, _, _ => ⟨.zero, [], none, none⟩ + | some q, a, rs => + match d.table.find? (·.1 = ⟨q, a, rs⟩) with + | none => ⟨.zero, [], none, none⟩ + | some e => e.2 + +private lemma applyTapes_nil' (ts : List Tape) : applyTapes ts [] = ts := by + cases ts <;> rfl + +private lemma length_applyTapes (ts : List Tape) (as : List (Option (Option ℕ) × SignType)) : + (applyTapes ts as).length = ts.length := by + induction ts generalizing as with + | nil => rfl + | cons t ts ih => cases as <;> simp [applyTapes, ih] + +private lemma getElem?_applyTapes (ts : List Tape) (as : List (Option (Option ℕ) × SignType)) + (k : ℕ) : (applyTapes ts as)[k]? = ts[k]?.map (·.apply (as.getD k (none, .zero))) := by + induction ts generalizing as k with + | nil => rfl + | cons t ts ih => + cases as with + | nil => simp [applyTapes, apply_none_zero] + | cons a as => cases k <;> simp [applyTapes, ih] + +private lemma stepWith_eq (d : Desc) (c : SCfg) (a : Option ℕ) : + stepWith d c a = (⟨(act d c.state a (c.workTapes.map Tape.read)).state, + moveInput c.inputPos a (act d c.state a (c.workTapes.map Tape.read)).inputTape, + applyTapes c.workTapes (act d c.state a (c.workTapes.map Tape.read)).workTapes⟩, + (act d c.state a (c.workTapes.map Tape.read)).output) := by + obtain ⟨_ | q, p, ts⟩ := c + · simp [stepWith, act, moveInput, applyTapes_nil'] + · simp only [stepWith, act] + split <;> (rename_i h; simp [h, moveInput, applyTapes_nil']) + +private lemma wstep_eq (d : Desc) (q : Option ℕ) (i : Tape) (ts : List Tape) : + wstep d (q, i :: ts) = + (((act d q (inSym i.read) (ts.map Tape.read)).state, + moveIn i (inPos i.read) (moveInput (inPos i.read) (inSym i.read) + (act d q (inSym i.read) (ts.map Tape.read)).inputTape) :: + applyTapes ts (act d q (inSym i.read) (ts.map Tape.read)).workTapes), + (act d q (inSym i.read) (ts.map Tape.read)).output) := by + simp only [wstep, stepWith_eq] + +/-- The coded input cell at position `z`: `some 0` at `0`, `some (a + 1)` for the input symbol `a` +and blank elsewhere. -/ +private def inCell (x : List ℕ) (z : ℤ) : Option ℕ := + if z = 0 then some 0 else if 0 < z then x[(z - 1).toNat]?.map (· + 1) else none + +private lemma inSym_inCell (x : List ℕ) (p : ℕ) : inSym (inCell x p) = inputSymbol x p := by + rcases p with _ | p + · simp [inSym, inCell, inputSymbol] + · have h1 : ((p + 1 : ℕ) : ℤ) ≠ 0 := by omega + have h2 : (0 : ℤ) < ((p + 1 : ℕ) : ℤ) := by omega + have h3 : (((p + 1 : ℕ) : ℤ) - 1).toNat = p := by omega + rw [inCell, ite_eq_right h1, ite_eq_left h2, h3] + cases h : x[p]? <;> simp [inputSymbol, inSym, h] + +private lemma inPos_inCell (x : List ℕ) (p : ℕ) : inPos (inCell x p) = 0 ↔ p = 0 := by + rcases p with _ | p + · simp [inPos, inCell] + · have h1 : ((p + 1 : ℕ) : ℤ) ≠ 0 := by omega + have h2 : (0 : ℤ) < ((p + 1 : ℕ) : ℤ) := by omega + rw [inCell, ite_eq_right h1, ite_eq_left h2] + cases x[(((p + 1 : ℕ) : ℤ) - 1).toNat]? <;> simp [inPos] + +private lemma moveIn_eq (i : Tape) {P p : ℕ} (hP : P = 0 ∨ P = 1) (hPp : P = 0 ↔ p = 0) + (a : Option ℕ) (mv : SignType) : + ∃ m : SignType, moveIn i P (moveInput P a mv) = i.move m ∧ + ((moveInput p a mv : ℕ) : ℤ) = p + m := by + rcases hP with rfl | rfl + · obtain rfl : p = 0 := hPp.1 rfl + rcases mv with _ | _ | _ + · exact ⟨.zero, by simp [moveIn, moveInput, Tape.move], by simp [moveInput, + SignType.zero_eq_zero]⟩ + · exact ⟨.zero, by simp [moveIn, moveInput, Tape.move], by simp [moveInput, + SignType.zero_eq_zero]⟩ + · exact ⟨.pos, by simp [moveIn, moveInput], by simp [moveInput, SignType.pos_eq_one]⟩ + · have hp : p ≠ 0 := fun h => absurd (hPp.2 h) (by omega) + rcases mv with _ | _ | _ + · exact ⟨.zero, by simp [moveIn, moveInput, Tape.move], by simp [moveInput, + SignType.zero_eq_zero]⟩ + · exact ⟨.neg, by simp [moveIn, moveInput], by simp [moveInput, SignType.neg_eq_neg_one]; omega⟩ + · by_cases ha : a.isSome + · exact ⟨.pos, by simp [moveIn, moveInput, ha], by simp [moveInput, SignType.pos_eq_one, ha, hp]⟩ + · exact ⟨.zero, by simp [moveIn, moveInput, ha, Tape.move], by + simp [moveInput, SignType.zero_eq_zero, ha, hp]⟩ + +/-! ### Windows agreeing with tapes -/ + +/-- An abstract tape: its cells by absolute position, and the position of its head. -/ +private abbrev ATape := (ℤ → Option ℕ) × ℤ + +/-- The window `W`, with its head at the head of `F`, agrees with `F` within distance `n` of the +head. -/ +private def Agr (n : ℕ) (W : Tape) (F : ATape) : Prop := + ∀ z, F.2 - n ≤ z → z ≤ F.2 + n → cellAt W (z - F.2) = F.1 z + +/-- A run of `n` steps took the window `W` agreeing with `F` to `W'`, and the tape `F` to `F'`: the +head moved by at most `n`, the cells of `F` within distance `n` of its head are mirrored in `W'`, +the other cells of `F` and `W` are unchanged, and lists of `W` long enough for the run keep their +place. -/ +private structure Tr (n : ℕ) (W : Tape) (F : ATape) (W' : Tape) (F' : ATape) : Prop where + le_head : F.2 - n ≤ F'.2 + head_le : F'.2 ≤ F.2 + n + real : ∀ z, z < F.2 - n ∨ F.2 + n < z → F'.1 z = F.1 z + agree : ∀ z, F.2 - n ≤ z → z ≤ F.2 + n → cellAt W' (z - F'.2) = F'.1 z + outside : ∀ z, z < F.2 - n ∨ F.2 + n < z → cellAt W' (z - F'.2) = cellAt W (z - F.2) + left : n ≤ W.left.length → (W'.left.length : ℤ) + F.2 = W.left.length + F'.2 + right : n + 1 ≤ W.right.length → (W'.right.length : ℤ) + F'.2 = W.right.length + F.2 + +/-- The effect of an action on an abstract tape. -/ +private def absApply (F : ATape) (a : Option (Option ℕ) × SignType) : ATape := + (fun z => if z = F.2 then a.1.getD (F.1 z) else F.1 z, F.2 + a.2) + +/-- A work tape as an abstract tape. -/ +private def realView (t : Tape) : ATape := (fun z => cellAt t (z - t.head), t.head) + +private lemma realView_apply (t : Tape) (a : Option (Option ℕ) × SignType) : + realView (t.apply a) = absApply (realView t) a := by + simp only [realView, absApply, head_apply] + congr 1 + funext z + exact cellAt_apply t a t.head z + +private lemma sign_bounds (m : SignType) : -1 ≤ (m : ℤ) ∧ (m : ℤ) ≤ 1 := by + rcases m with _ | _ | _ <;> + simp [SignType.zero_eq_zero, SignType.neg_eq_neg_one, SignType.pos_eq_one] + +private lemma tr_zero {W : Tape} {F : ATape} (h : Agr 0 W F) : Tr 0 W F W F := + ⟨by omega, by omega, fun _ _ => rfl, h, fun _ _ => rfl, fun _ => by omega, fun _ => by omega⟩ + +private lemma tr_apply {W : Tape} {F : ATape} (h : Agr 1 W F) + (a : Option (Option ℕ) × SignType) : Tr 1 W F (W.apply a) (absApply F a) := by + obtain ⟨f, p⟩ := F + have hm := sign_bounds a.2 + refine ⟨?_, ?_, fun z hz => ?_, fun z h1 h2 => ?_, fun z hz => ?_, fun hl => ?_, fun hr => ?_⟩ + · simp only [absApply] + omega + · simp only [absApply] + omega + · simp only [absApply] + rw [ite_eq_right (by omega)] + · simp only [absApply] at h1 h2 ⊢ + rw [cellAt_apply] + split_ifs with hz + · rw [h z h1 h2] + · exact h z h1 h2 + · simp only [absApply] at hz ⊢ + rw [cellAt_apply, ite_eq_right (by omega)] + · have := length_left_apply W a (by omega) + simp only [absApply] + omega + · have := length_right_apply W a (by omega) + simp only [absApply] + omega + +private lemma Agr.mono {n m : ℕ} {W : Tape} {F : ATape} (h : Agr n W F) (hmn : m ≤ n) : + Agr m W F := + fun z h1 h2 => h z (by omega) (by omega) + +private lemma Agr.cut {r : ℕ} {W : Tape} {F : ATape} (h : Agr r W F) : Agr r (cut r W) F := + fun z h1 h2 => by + rw [cellAt_cut, ite_eq_left (by omega)] + exact h z h1 h2 + +private lemma tr_paste {r : ℕ} {O I : Tape} {F F' : ATape} (hT : Tr r (cut r O) F I F') + {lo hi : ℤ} (hO : ∀ z, lo ≤ z → z ≤ hi → cellAt O (z - F.2) = F.1 z) : + (∀ z, lo ≤ z → z ≤ hi → cellAt (paste r O I) (z - F'.2) = F'.1 z) ∧ + (∀ z, z < F.2 - r ∨ F.2 + r < z → cellAt (paste r O I) (z - F'.2) = cellAt O (z - F.2)) ∧ + (r ≤ O.left.length → ((paste r O I).left.length : ℤ) + F.2 = O.left.length + F'.2) ∧ + (r + 1 ≤ O.right.length → + ((paste r O I).right.length : ℤ) + F'.2 = O.right.length + F.2) := by + have hl : r ≤ O.left.length → (I.left.length : ℤ) + F.2 = r + F'.2 := fun hl => by + have := hT.left (by simp only [cut, List.length_take]; omega) + simp only [cut, List.length_take] at this + omega + have hr : r + 1 ≤ O.right.length → (I.right.length : ℤ) + F'.2 = F.2 + r + 1 := fun hr => by + have := hT.right (by simp only [cut, List.length_take]; omega) + simp only [cut, List.length_take] at this + omega + have hP := cellAt_paste (O := O) hT.le_head hT.head_le hl hr + (fun z hz => by rw [hT.outside z hz, cellAt_cut, ite_eq_right (by omega)]) + refine ⟨fun z h1 h2 => ?_, fun z hz => ?_, fun h => ?_, fun h => ?_⟩ + · rw [hP] + split_ifs with hz + · exact hT.agree z hz.1 hz.2 + · rw [hO z h1 h2, hT.real z (by omega)] + · rw [hP, ite_eq_right (by omega)] + · have := hl h + simp only [paste, List.length_append, List.length_drop] + omega + · have := hr h + simp only [paste, List.length_append, List.length_drop] + omega + +private lemma agr_mid {n r s : ℕ} (hn : r + s = n) {W I : Tape} {F F₁ : ATape} (hW : Agr n W F) + (h₁ : Tr r (cut r W) F I F₁) : Agr s (cut s (paste r W I)) F₁ := by + obtain ⟨a, -, -, -⟩ := tr_paste h₁ (lo := F.2 - n) (hi := F.2 + n) hW + have := h₁.le_head + have := h₁.head_le + exact Agr.cut fun z h1 h2 => a z (by omega) (by omega) + +private lemma tr_comp {n r s : ℕ} (hn : r + s = n) {W I J : Tape} {F F₁ F₂ : ATape} + (hW : Agr n W F) (h₁ : Tr r (cut r W) F I F₁) (h₂ : Tr s (cut s (paste r W I)) F₁ J F₂) : + Tr n W F (paste s (paste r W I) J) F₂ := by + have b₁ := h₁.le_head + have b₂ := h₁.head_le + have b₃ := h₂.le_head + have b₄ := h₂.head_le + obtain ⟨a₁, o₁, l₁, r₁⟩ := tr_paste h₁ (lo := F.2 - n) (hi := F.2 + n) hW + obtain ⟨a₂, o₂, l₂, r₂⟩ := tr_paste h₂ (lo := F.2 - n) (hi := F.2 + n) a₁ + refine ⟨by omega, by omega, fun z hz => ?_, a₂, fun z hz => ?_, fun hl => ?_, fun hr => ?_⟩ + · rw [h₂.real z (by omega), h₁.real z (by omega)] + · rw [o₂ z (by omega), o₁ z (by omega)] + · have := l₁ (by omega) + have := l₂ (by omega) + omega + · have := r₁ (by omega) + have := r₂ (by omega) + omega + +/-! ### Correctness of the windowed simulation -/ + +private theorem sim_induction {motive : ℕ → Prop} (zero : motive 0) (one : motive 1) + (step : ∀ n, (∀ m < n + 2, motive m) → motive (n + 2)) (n : ℕ) : motive n := by + induction n using Nat.strong_induction_on with + | _ n ih => + match n, ih with + | 0, _ => exact zero + | 1, _ => exact one + | n + 2, ih => exact step n ih + +private lemma sim_zero (d : Desc) (w : Win) : sim d 0 w = (w, []) := by + rw [sim] + +private lemma sim_one (d : Desc) (w : Win) : sim d 1 w = ((wstep d w).1, (wstep d w).2.toList) := by + rw [sim] + +private lemma sim_add_two (d : Desc) (n : ℕ) (w : Win) : + sim d (n + 2) w = + (restore ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1) + (sim d ((n + 2) / 2) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))).1, + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).2 ++ + (sim d ((n + 2) / 2) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))).2) := by + rw [sim] + +private lemma exists_getElem?_of_length {α β : Type} {l : List α} {l' : List β} {k : ℕ} {a : α} + (h : l'.length = l.length) (hk : l[k]? = some a) : ∃ b, l'[k]? = some b := by + have : k < l.length := (List.getElem?_eq_some_iff.1 hk).1 + exact ⟨l'[k], List.getElem?_eq_getElem (by omega)⟩ + +private lemma length_restore (r : ℕ) (o i : Win) : + (restore r o i).2.length = min o.2.length i.2.length := + List.length_zipWith + +private lemma getElem?_extract {r k : ℕ} {w : Win} {W : Tape} (h : w.2[k]? = some W) : + (extract r w).2[k]? = some (cut r W) := by + simp [extract, h] + +private lemma getElem?_restore {r k : ℕ} {o i : Win} {W I : Tape} (hW : o.2[k]? = some W) + (hI : i.2[k]? = some I) : (restore r o i).2[k]? = some (paste r W I) := by + simp [restore, List.getElem?_zipWith, hW, hI] + +/-- `n` steps from `c`, collecting the emitted symbols. -/ +private def run (d : Desc) (x : List ℕ) (n : ℕ) (c : SCfg) : SCfg × List ℕ := + (stepOut d x)^[n] (c, []) + +private lemma iterate_stepOut (d : Desc) (x : List ℕ) (n : ℕ) (c : SCfg) (o : List ℕ) : + (stepOut d x)^[n] (c, o) = ((run d x n c).1, o ++ (run d x n c).2) := by + induction n generalizing c o with + | zero => simp [run] + | succ n ih => + have h : run d x (n + 1) c = (stepOut d x)^[n] (stepOut d x (c, [])) := + Function.iterate_succ_apply _ _ _ + rw [h, Function.iterate_succ_apply, stepOut, stepOut, ih, ih] + simp + +private lemma run_add (d : Desc) (x : List ℕ) (m n : ℕ) (c : SCfg) : + run d x (m + n) c = ((run d x n (run d x m c).1).1, + (run d x m c).2 ++ (run d x n (run d x m c).1).2) := by + change (stepOut d x)^[m + n] (c, []) = _ + rw [add_comm, Function.iterate_add_apply] + exact iterate_stepOut d x n _ _ + +private lemma length_workTapes_run (d : Desc) (x : List ℕ) (n : ℕ) (c : SCfg) : + (run d x n c).1.workTapes.length = c.workTapes.length := by + induction n with + | zero => rfl + | succ n ih => + rw [run_add] + change (step d x (run d x n c).1).1.workTapes.length = _ + rw [step_eq_stepWith, stepWith_eq, length_applyTapes, ih] + +/-- A configuration as abstract tapes: the coded input, then the work tapes. -/ +private def view (x : List ℕ) (c : SCfg) : List ATape := + (inCell x, (c.inputPos : ℤ)) :: c.workTapes.map realView + +private lemma length_view_run (d : Desc) (x : List ℕ) (n : ℕ) (c : SCfg) : + (view x (run d x n c).1).length = (view x c).length := by + simp [view, length_workTapes_run] + +/-- **Correctness of the windowed simulation.** If every window agrees with its tape within +distance `n` of the head, then `n` windowed steps emit the symbols and reach the state of `n` +steps, and the windows keep agreeing with the tapes. -/ +private theorem sim_spec (d : Desc) (x : List ℕ) (n : ℕ) : ∀ (c : SCfg) (w : Win), + w.1 = c.state → w.2.length = (view x c).length → + (∀ (k : ℕ) W F, w.2[k]? = some W → (view x c)[k]? = some F → Agr n W F) → + (sim d n w).2 = (run d x n c).2 ∧ (sim d n w).1.1 = (run d x n c).1.state ∧ + (sim d n w).1.2.length = w.2.length ∧ + ∀ (k : ℕ) W F W' F', w.2[k]? = some W → (view x c)[k]? = some F → + (sim d n w).1.2[k]? = some W' → + (view x (run d x n c).1)[k]? = some F' → Tr n W F W' F' := by + induction n using sim_induction with + | zero => + intro c w hq _ hagr + rw [sim_zero] + refine ⟨rfl, hq, rfl, fun k W F W' F' hW hF hW' hF' => ?_⟩ + change (view x c)[k]? = some F' at hF' + obtain rfl : W' = W := Option.some.inj (hW'.symm.trans hW) + obtain rfl : F' = F := Option.some.inj (hF'.symm.trans hF) + exact tr_zero (hagr k W' F' hW hF) + | one => + rintro ⟨q, p, ts⟩ ⟨st, _ | ⟨i, ws⟩⟩ hq hlen hagr + · simp [view] at hlen + simp only at hq + subst hq + have hlen' : ws.length = ts.length := by simpa [view] using hlen + have hi : Agr 1 i (inCell x, p) := hagr 0 i _ rfl rfl + have hws : ∀ k W t, ws[k]? = some W → ts[k]? = some t → Agr 1 W (realView t) := + fun k W t hW ht => hagr (k + 1) W (realView t) (by simpa using hW) (by simp [view, ht]) + have hread : i.read = inCell x p := by + have := hi p (by simp) (by simp) + rwa [sub_self, cellAt_zero] at this + have hreads : ws.map Tape.read = ts.map Tape.read := by + apply List.ext_getElem? + intro k + simp only [List.getElem?_map] + rcases hW : ws[k]? with _ | W + · have : ts[k]? = none := by + rw [List.getElem?_eq_none_iff] at hW ⊢ + omega + simp [this] + · obtain ⟨t, ht⟩ := exists_getElem?_of_length hlen'.symm hW + have := hws k W t hW ht t.head (by simp [realView]) (by simp [realView]) + simp only [realView, sub_self, cellAt_zero] at this + simp [ht, this] + have hstep : step d x ⟨st, p, ts⟩ = + (⟨(act d st (inputSymbol x p) (ts.map Tape.read)).state, + moveInput p (inputSymbol x p) (act d st (inputSymbol x p) (ts.map Tape.read)).inputTape, + applyTapes ts (act d st (inputSymbol x p) (ts.map Tape.read)).workTapes⟩, + (act d st (inputSymbol x p) (ts.map Tape.read)).output) := by + rw [step_eq_stepWith, stepWith_eq] + obtain ⟨m, hm₁, hm₂⟩ := moveIn_eq i (P := inPos i.read) (p := p) + (by unfold inPos; split_ifs <;> simp) (by rw [hread, inPos_inCell]) (inputSymbol x p) + (act d st (inputSymbol x p) (ts.map Tape.read)).inputTape + have hw : wstep d (st, i :: ws) = + (((act d st (inputSymbol x p) (ts.map Tape.read)).state, + i.move m :: applyTapes ws (act d st (inputSymbol x p) (ts.map Tape.read)).workTapes), + (act d st (inputSymbol x p) (ts.map Tape.read)).output) := by + rw [wstep_eq, hreads, hread, inSym_inCell, ← hm₁, hread] + have hrun : run d x 1 ⟨st, p, ts⟩ = + ((step d x ⟨st, p, ts⟩).1, (step d x ⟨st, p, ts⟩).2.toList) := by + simp [run, stepOut] + rw [sim_one, hw, hrun, hstep] + refine ⟨rfl, rfl, by simp [length_applyTapes], fun k W F W' F' hW hF hW' hF' => ?_⟩ + rcases k with _ | k + · simp only [List.getElem?_cons_zero, view, Option.some.injEq] at hW hF hW' hF' + subst hW hF hW' hF' + rw [hm₂, show ((inCell x, (p : ℤ) + m) : ATape) = absApply (inCell x, p) (none, m) by + simp [absApply]] + exact tr_apply hi (none, m) + · simp only [List.getElem?_cons_succ, view, List.getElem?_map, getElem?_applyTapes, + Option.map_eq_some_iff] at hW hF hW' hF' + obtain ⟨t, ht, rfl⟩ := hF + obtain ⟨W₀, hW₀, rfl⟩ := hW' + obtain ⟨_, ht', rfl⟩ := hF' + obtain ⟨_, ht'', rfl⟩ := ht' + rw [hW] at hW₀ + cases hW₀ + rw [ht] at ht'' + cases ht'' + rw [realView_apply] + exact tr_apply (hws k W t hW ht) _ + | step n ih => + intro c w hq hlen hagr + have hrs : firstHalf (n + 2) + (n + 2) / 2 = n + 2 := by simp only [firstHalf]; omega + have hr : firstHalf (n + 2) < n + 2 := by simp only [firstHalf]; omega + have hs : (n + 2) / 2 < n + 2 := by omega + rw [sim_add_two] + generalize firstHalf (n + 2) = r at hrs hr ⊢ + generalize (n + 2) / 2 = s at hrs hs ⊢ + obtain ⟨o₁, q₁, l₁, t₁⟩ := ih r hr c (extract r w) hq (by simpa [extract] using hlen) + (fun k W F hW hF => by + simp only [extract, List.getElem?_map, Option.map_eq_some_iff] at hW + obtain ⟨W₀, hW₀, rfl⟩ := hW + exact ((hagr k W₀ F hW₀ hF).mono (by omega)).cut) + have hle : ∀ r w, (extract r w).2.length = w.2.length := by simp [extract] + have hlen₁ : (extract s (restore r w (sim d r (extract r w)).1)).2.length = + (view x (run d x r c).1).length := by + rw [hle] + simp only [restore, List.length_zipWith, l₁, hle, length_view_run] + omega + obtain ⟨o₂, q₂, l₂, t₂⟩ := ih s hs (run d x r c).1 (extract s (restore r w (sim d r + (extract r w)).1)) q₁ hlen₁ (fun k W F₁ hW hF₁ => by + simp only [extract, restore, List.getElem?_map, Option.map_eq_some_iff, + List.getElem?_zipWith_eq_some] at hW + obtain ⟨_, ⟨W₀, I, hW₀, hI, rfl⟩, rfl⟩ := hW + obtain ⟨F, hF⟩ := exists_getElem?_of_length (length_view_run d x r c).symm hF₁ + exact agr_mid hrs (hagr k W₀ F hW₀ hF) + (t₁ k _ F I F₁ (getElem?_extract hW₀) hF hI hF₁)) + rw [← hrs, run_add] + refine ⟨by rw [o₁, o₂], q₂, ?_, fun k W F W' F' hW hF hW' hF' => ?_⟩ + · rw [length_restore, l₂, hle, length_restore, l₁, hle] + omega + · simp only [restore, List.getElem?_zipWith_eq_some] at hW' + obtain ⟨_, J, ⟨W₀, I, hW₀, hI, rfl⟩, hJ, rfl⟩ := hW' + rw [hW] at hW₀ + cases hW₀ + obtain ⟨F₁, hF₁⟩ := exists_getElem?_of_length (length_view_run d x r c) hF + exact tr_comp rfl (hrs ▸ hagr k W F hW hF) + (t₁ k _ F I F₁ (getElem?_extract hW) hF hI hF₁) + (t₂ k _ F₁ J F' (getElem?_extract (getElem?_restore hW hI)) hF₁ hJ hF') + +/-- The input window of `initWin` agrees with the coded input everywhere. -/ +private lemma cellAt_initWin_input (x : List ℕ) (z : ℤ) : + cellAt ⟨0, [some 0], x.map fun a => some (a + 1)⟩ (z - (1 : ℕ)) = inCell x z := by + rcases lt_trichotomy z 0 with hz | rfl | hz + · rw [cellAt_of_neg _ (by omega), getD_eq_none' (by simp; omega)] + simp [inCell, show z ≠ 0 by omega, show ¬0 < z by omega] + · simp [cellAt, inCell] + · rw [cellAt_of_nonneg _ (by omega)] + simp [inCell, show z ≠ 0 by omega, hz, List.getD_eq_getElem?_getD] + cases x[z.toNat - 1]? <;> simp + /-- **The windowed simulation computes the universal function**: started from the radius-`t` windows of the initial configuration, `t` windowed steps give the output and the halting status after `t` steps. -/ theorem universal_eq_sim (d : Desc) (x : List ℕ) (t : ℕ) : universal (d, x, t) = ((sim d t (extract t (initWin d x))).2, - (sim d t (extract t (initWin d x))).1.1.isNone) := - sorry + (sim d t (extract t (initWin d x))).1.1.isNone) := by + have hagr : ∀ (k : ℕ) W F, (extract t (initWin d x)).2[k]? = some W → + (view x (init d))[k]? = some F → Agr t W F := by + intro k W F hW hF + rcases k with _ | k + · simp only [extract, initWin, view, List.map_cons, List.getElem?_cons_zero, + Option.some.injEq] at hW hF + subst hW hF + exact Agr.cut fun z _ _ => cellAt_initWin_input x z + · simp only [extract, initWin, view, init, List.map_cons, List.getElem?_cons_succ, + List.getElem?_map, List.getElem?_replicate, Option.map_eq_some_iff] at hW hF + split_ifs at hW hF with hk + · obtain ⟨_, ⟨_, rfl⟩, rfl⟩ := hW + obtain ⟨_, ⟨_, rfl⟩, rfl⟩ := hF + exact Agr.cut fun z _ _ => rfl + · simp at hW + obtain ⟨o, q, -, -⟩ := sim_spec d x t (init d) (extract t (initWin d x)) rfl + (by simp [extract, initWin, view, init]) hagr + change ((run d x t (init d)).2, (run d x t (init d)).1.state.isNone) = _ + rw [o, q] end Turing.MultiTapeTM.Universal.Windowed From cc8c67aeb13ea1af6dc0bc1f997d3e88ea941b20 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:27:28 +0000 Subject: [PATCH 09/40] wip(divconq): round and halt certificates --- .../Turing/MultiTape/Combinators/DivConq.lean | 66 +++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 8f50de2ba4..0d0bee3fb7 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -341,6 +341,72 @@ private lemma retSwap_inO encList_nil, List.length_nil] at * <;> nlinarith +/-- A round, within the costs of the parts of the recursion it runs. -/ +lemma round_inO (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) + (hbase : ComputableTidilyInO D.base encA encB Tb Sb) + (hleft : ComputableTidilyInO D.left encA encA Tl Sl) + (hmid : ComputableTidilyInO D.mid (encPair encA encB) (encPair encA encG) Tm Sm) + (hjoin : ComputableTidilyInO D.join (encPair encG encB) encB Tj Sj) : + ComputableTidilyInO D.loop.round + (encPair (encOption (encFrame encA encG)) (encVal encA encB)) + (encPair (encList (encFrame encA encG)) (encVal encA encB)) + (fun p => (encPair (encOption (encFrame encA encG)) (encVal encA encB) p).length + p.2.elim + (fun a => Tt a + St a + if D.isBase a then Tb a + Sb a + (encB (D.base a)).length + else Tl a + Sl a + (encA (D.left a)).length) + (fun s => s.elim (fun b => p.1.elim 0 (fun x => x.elim + (fun a => Tm (a, b) + Sm (a, b) + (encPair encA encG (D.mid (a, b))).length) + (fun g => Tj (g, b) + Sj (g, b) + (encB (D.join (g, b))).length))) (fun _ => 0))) + (fun p => (encPair (encOption (encFrame encA encG)) (encVal encA encB) p).length + p.2.elim + (fun a => Tt a + St a + if D.isBase a then Tb a + Sb a + (encB (D.base a)).length + else Tl a + Sl a + (encA (D.left a)).length) + (fun s => s.elim (fun b => p.1.elim 0 (fun x => x.elim + (fun a => Tm (a, b) + Sm (a, b) + (encPair encA encG (D.mid (a, b))).length) + (fun g => Tj (g, b) + Sj (g, b) + (encB (D.join (g, b))).length))) (fun _ => 0))) := by + have hCall := D.roundCall_inO (encG := encG) hisBase hbase hleft + have hRet := (D.retSwap_inO hmid hjoin).comp + (swap_inO (encS := encOption (encFrame encA encG)) (encT := encB)) + have hFin := ((toList_inO (enc := encFrame encA encG)).comp + (fst (encOption (encFrame encA encG)) encB)).prod + ((ComputableInO.inr encA (encSum encB encB)).tidy.comp + ((ComputableInO.inr encB encB).tidy.comp (snd (encOption (encFrame encA encG)) encB))) + have hS := ComputableInO.sumElimSnd hRet.computableInO hFin.computableInO + have hR := ComputableInO.sumElimSnd hCall.computableInO hS + refine (hR.tidy.of_enc_eq fun p => ?_).mono 8 (fun p => ?_) (fun p => ?_) + · obtain ⟨o, a | b | b⟩ := p + · rfl + · rcases o with _ | a | g <;> rfl + · rfl + all_goals + obtain ⟨o, a | b | b⟩ := p + · simp only [Sum.elim_inl, length_encPair, encSum_inl, List.length_cons] + split_ifs <;> omega + · rcases o with _ | a | g <;> + simp only [Function.comp_apply, Sum.elim_inl, Sum.elim_inr, Option.elim_none, + Option.elim_some, length_encPair, encSum_inl, encSum_inr, List.length_cons, + encOption_some] <;> omega + · have := length_encList_toList_le (encFrame encA encG) o + simp only [Function.comp_apply, Sum.elim_inr, length_encPair, encSum_inr, + List.length_cons] at * + omega + +/-- The halting test of the loop, in linear time. -/ +lemma halt_inO : ComputableTidilyInO D.loop.halt (encVal encA encB) encBool + (fun v => (encVal encA encB v).length) (fun v => (encVal encA encB v).length) := by + have hw : ComputableTidilyInO (fun w : List Bool => (w.headD false, w.tail.headD false)) + encBits (encPair encBool encBool) (fun w => w.length) (fun w => w.length) := + ((ComputableTidilyInDegree.headD (enc₁ := encBool) (enc := encBits) false).inO_one.prod + ((ComputableTidilyInDegree.headD (enc₁ := encBool) (enc := encBits) false).inO_one.comp + (of_linear (.of_tail (f := List.tail) (encIn := encBits) (encOut := encBits) + fun _ => rfl)))).mono 3 (fun w => by simp [encBits]; omega) + (fun w => by simp [encBits]; omega) + refine (((ComputableTidilyInDegree.of_finite (encIn := encPair encBool encBool) + (encMid := encBool) (fun p : Bool × Bool => p.1 && p.2)).inO_one.comp hw).comp + (of_linear (.of_eq (f := fun v : Val α β => encVal encA encB v) (encIn := encVal encA encB) + (encMid := encBits) fun _ => rfl))).of_enc_eq (fun v => ?_) |>.mono 4 (fun v => ?_) + (fun v => ?_) + · rcases v with a | b | b <;> rfl + all_goals simp; omega + end DivConq /-- **Divide and conquer.** If the parts of a divide-and-conquer recursion are computable and every From 446f5ea27ea2db40cc02d84b5a546d5c73a1d037 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:27:29 +0000 Subject: [PATCH 10/40] feat(turing): linear-time unary take and drop on encoded lists (#800) A native one-work-tape machine (Internal/KernelTakeDropUnary.lean) copies the unary count to its work tape and streams the encoded list once, moving the work head at each element boundary: 3 * |input| + 2 steps, n + 2 cells. - ComputableInDegree.takeUnary / .dropUnary (plain, degree 1 1) in Combinators/TakeDropUnary.lean (no public tidy statements). - ComputableTidilyInDegree.dropUnary in Complexity/Lists.lean upgraded in place from degree 2 to degree 1 via the tidy normal form. AI-assisted (Jetski worker B). --- Complexity.lean | 1 + .../MultiTape/Combinators/TakeDropUnary.lean | 50 +- .../Turing/MultiTape/Complexity/Lists.lean | 43 +- .../Internal/KernelTakeDropUnary.lean | 600 ++++++++++++++++++ .../Turing/MultiTape/TakeDropUnary.lean | 42 ++ 5 files changed, 703 insertions(+), 33 deletions(-) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelTakeDropUnary.lean create mode 100644 ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean diff --git a/Complexity.lean b/Complexity.lean index ac64a214f5..596224ee4b 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1718,6 +1718,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Internal.Kernel public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelIterateWhile public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelNormalForm public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelOnWords +public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelTakeDropUnary public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelTransducer public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelZeroSpace public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelZipTransducer diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean index a4b0682210..83511e00bf 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean @@ -8,30 +8,56 @@ module -- upstream: candidate public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Lists +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Degree.Bounds +import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelTakeDropUnary /-! # Taking and dropping list elements in linear time -STUB: interface for the linear-time unary take/drop primitives. To be replaced by the native -machine and its proofs. --/ +Taking or dropping the first `n` elements of a list encoded by `Turing.MultiTapeTM.encList`, with +`n` in unary, has cost and output degree one. Both are computed by the one-tape machine +`Turing.MultiTapeTM.TakeDropUnary.toTM`, which copies the count to its work tape and then streams +the encoded list once, moving the work head at every element boundary. Folding over the count or +over the list would cost quadratic time. The tidy form of dropping is +`Turing.MultiTapeTM.ComputableTidilyInDegree.dropUnary`. + +## Main results -public section +* `Turing.MultiTapeTM.ComputableInDegree.takeUnary`: the first `n` elements. +* `Turing.MultiTapeTM.ComputableInDegree.dropUnary`: all but the first `n` elements. +-/ -namespace Turing.MultiTapeTM.ComputableTidilyInDegree +namespace Turing.MultiTapeTM.ComputableInDegree variable {α : Type} +/-- Taking (`keep = true`) or dropping (`keep = false`) a unary number of elements has cost and +output degree one. -/ +private theorem cut (keep : Bool) (enc : α ↪ List Bool) : + ComputableInDegree (fun p : List α × ℕ => if keep then p.1.take p.2 else p.1.drop p.2) + (encPair (encList enc) encUnary) (encList enc) 1 1 := + of_bounds ⟨5, fun p => by + dsimp only + rw [pow_one] + omega⟩ + ⟨2, fun p => by + have h := length_le_encPair_right (encList enc) encUnary p + rw [encUnary_apply, List.length_replicate] at h + dsimp only + rw [pow_one] + omega⟩ + (TakeDropUnary.computableInTimeAndSpace keep enc) + /-- Taking the first `n` elements, with `n` in unary, in linear time. -/ -theorem takeUnary (enc : α ↪ List Bool) : - ComputableTidilyInDegree (fun p : List α × ℕ => p.1.take p.2) +public theorem takeUnary (enc : α ↪ List Bool) : + ComputableInDegree (fun p : List α × ℕ => p.1.take p.2) (encPair (encList enc) encUnary) (encList enc) 1 1 := - sorry + cut true enc /-- Dropping the first `n` elements, with `n` in unary, in linear time. -/ -theorem dropUnaryLin (enc : α ↪ List Bool) : - ComputableTidilyInDegree (fun p : List α × ℕ => p.1.drop p.2) +public theorem dropUnary (enc : α ↪ List Bool) : + ComputableInDegree (fun p : List α × ℕ => p.1.drop p.2) (encPair (encList enc) encUnary) (encList enc) 1 1 := - sorry + cut false enc -end Turing.MultiTapeTM.ComputableTidilyInDegree +end Turing.MultiTapeTM.ComputableInDegree diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/Lists.lean b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/Lists.lean index dbdc651a34..17e0cf6e6b 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/Lists.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/Lists.lean @@ -9,6 +9,8 @@ module -- vendored: derive encoded prefix/filter bounds from Mathlib's `List.Sublist.flatMap`. public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Primitives +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TidyNormalForm +import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelTakeDropUnary import Mathlib.Tactic.Linarith /-! @@ -17,7 +19,7 @@ import Mathlib.Tactic.Linarith Operations on lists encoded by `Turing.MultiTapeTM.encList`, with explicit degrees (`Turing.MultiTapeTM.ComputableTidilyInDegree`): adding an element at either end and concatenation in linear time; finding the first element that passes a test and keeping the elements that pass a -test, one degree above the test; and dropping a number of elements in quadratic time. The tests may +test, one degree above the test; and dropping a number of elements in linear time. The tests may depend on a parameter. ## Main results @@ -182,28 +184,27 @@ public theorem filterWith {t : π × α → Bool} {par : γ → π} {list : γ funext x rw [foldl_filterStep, List.nil_append] -/-- Dropping the first `n` elements, with `n` in unary. -/ +-- vendored: linear time by the native machine `TakeDropUnary.toTM` (crei folds `List.tail` over +-- the count, which has degree 2). +/-- Dropping the first `n` elements, with `n` in unary, in linear time. -/ public theorem dropUnary (enc : α ↪ List Bool) : ComputableTidilyInDegree (fun p : List α × ℕ => p.1.drop p.2) - (encPair (encList enc) encUnary) (encList enc) 2 1 := by - have hrep (l : List α) (n : ℕ) : (List.replicate n true).foldl (fun acc _ => acc.tail) l = - l.drop n := by - simp [List.foldl_const, List.tail_iterate] - have hfold := foldl' (encA := encBool) (encL := encBits) (encB := encList enc) - (list := fun p : List α × ℕ => List.replicate p.2 true) (step := fun acc _ => acc.tail) - ((of_eq (f := fun n => List.replicate n true) (encIn := encUnary) (encMid := encBits) - fun _ => rfl).comp (snd (encList enc) encUnary)) - (fst (encList enc) encUnary) - ((tail (enc₁ := enc)).comp (fst (encList enc) encBool)) - (B := fun p => (encPair (encList enc) encUnary p).length) .self (fun p i hi => by - rw [List.take_replicate, hrep] - have := SizedListEncoding.length_drop_le (encA := enc) (encL := encList enc) p.1 - (min i p.2) - simp only [length_encPair] - omega) - convert hfold.mono (d' := 2) (e' := 1) using 1 - funext p - rw [hrep] + (encPair (encList enc) encUnary) (encList enc) 1 1 := by + obtain ⟨c, hc⟩ := + (TakeDropUnary.computableInTimeAndSpace false enc).exists_computableTidilyInTimeAndSpace + refine of_bounds ⟨10 + c, fun p => ?_⟩ ⟨3 * c, fun p => ?_⟩ hc <;> + have h := length_le_encPair_right (encList enc) encUnary p <;> + rw [encUnary_apply, List.length_replicate] at h <;> + dsimp only <;> + rw [pow_one] + · have hc' : c ≤ c * ((encPair (encList enc) encUnary p).length + 1) := + Nat.le_mul_of_pos_right c (Nat.succ_pos _) + rw [Nat.add_mul] + omega + · calc c * (p.2 + 2 + 1) ≤ c * (3 * ((encPair (encList enc) encUnary p).length + 1)) := + Nat.mul_le_mul_left c (by omega) + _ = 3 * c * ((encPair (encList enc) encUnary p).length + 1) := by + rw [Nat.mul_left_comm, Nat.mul_assoc] /-- One step of mapping with the parameter `p`. -/ @[expose] public def mapStep {β : Type} (f : π × α → β) (p : π) (acc : List β) (a : α) : diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelTakeDropUnary.lean b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelTakeDropUnary.lean new file mode 100644 index 0000000000..c8b55d7350 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelTakeDropUnary.lean @@ -0,0 +1,600 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Run +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Frame.Basic +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.List +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Pair +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Unary +import Mathlib.Basic.Finite.Sum + +/-! # A one-tape machine cutting a framed word at a unary count + +The machine `Turing.MultiTapeTM.TakeDropUnary.toTM keep` reads `frame u ++ List.replicate n true`. +It skips the frame, copies the count `n` to its work tape (leaving the head on the last `true`), +rewinds the input head and then streams the framed word `u`, reading `u` itself as a sequence of +frames: it remembers whether the next inner symbol is a marker or follows a marker `true`. At every +inner terminator `false` the work head moves one cell to the left while it is on a `true`, so the +head position counts the inner frames still to be taken or dropped. Inner symbols are emitted while +the count is positive (`keep = true`) or once it is zero (`keep = false`). + +On `u = encList enc l` this emits the encoded `l.take n` or `l.drop n`. The machine runs in time +linear in its input and uses `n + 2` work-tape cells. This is the realization behind the plain +`Turing.MultiTapeTM.ComputableInDegree.takeUnary` and `.dropUnary` and the tidy +`Turing.MultiTapeTM.ComputableTidilyInDegree.dropUnary`; folding over the count or over the list +would cost quadratic time. + +## Main definitions + +* `Turing.MultiTapeTM.TakeDropUnary.stream`: the word emitted while streaming an inner word. +* `Turing.MultiTapeTM.TakeDropUnary.toTM`: the machine with one work tape. + +## Main results + +* `Turing.MultiTapeTM.TakeDropUnary.computesInTimeAndSpace_toTM`: on + `frame u ++ List.replicate n true`, `toTM keep` emits `stream keep false n u` within + `3 * (frame u ++ List.replicate n true).length + 2` steps and `n + 2` cells. +* `Turing.MultiTapeTM.TakeDropUnary.stream_encList`: on an encoded list, the stream is the encoded + prefix or suffix. +* `Turing.MultiTapeTM.TakeDropUnary.computableInTimeAndSpace`: taking or dropping a unary number of + encoded list elements within `3 * (input length) + 2` steps and `n + 2` cells. +-/ + +namespace Turing.MultiTapeTM + +namespace TakeDropUnary + +/-! ### The streaming semantics -/ + +/-- Whether inner symbols are emitted when the remaining count is `c`: while `c` is positive when +taking (`keep = true`), once it is zero when dropping (`keep = false`). -/ +@[expose] public def emits (keep : Bool) (c : ℕ) : Bool := + decide (0 < c) == keep + +/-- `stream keep inBit c u`: the word emitted while streaming the inner word `u` with remaining +count `c`, where `inBit` says whether the next inner symbol follows a marker `true` (and so is a +symbol of the current inner frame). Each inner terminator `false` decrements the count. -/ +@[expose] public def stream (keep : Bool) : Bool → ℕ → List Bool → List Bool + | _, _, [] => [] + | false, c, b :: u => + (if emits keep c then [b] else []) ++ stream keep b (if b then c else c - 1) u + | true, c, b :: u => (if emits keep c then [b] else []) ++ stream keep false c u + +/-- The kind of the next inner symbol after reading `b` in kind `inBit`. -/ +@[expose] public def nextKind (inBit b : Bool) : Bool := + if inBit then false else b + +/-- The count after reading `b` in kind `inBit`. -/ +@[expose] public def nextCount (inBit b : Bool) (c : ℕ) : ℕ := + if inBit then c else if b then c else c - 1 + +public lemma stream_cons (keep inBit : Bool) (c : ℕ) (b : Bool) (u : List Bool) : + stream keep inBit c (b :: u) = + (if emits keep c then [b] else []) ++ + stream keep (nextKind inBit b) (nextCount inBit b c) u := by + cases inBit <;> cases b <;> rfl + +/-- **Streaming one inner frame** emits it when the count admits emission and then continues with +the count decremented. -/ +public theorem stream_frame_append (keep : Bool) (c : ℕ) (w rest : List Bool) : + stream keep false c (frame w ++ rest) = + (if emits keep c then frame w else []) ++ stream keep false (c - 1) rest := by + induction w with + | nil => cases h : emits keep c <;> simp [frame_nil, stream, h] + | cons b w ih => + simp only [frame_cons, List.cons_append, stream, ↓reduceIte, ih] + cases emits keep c <;> simp + +/-! ### The machine -/ + +/-- The control states of `TakeDropUnary.toTM`. -/ +public inductive State where + /-- Skipping the framed word: expecting a marker. -/ + | skip + /-- Skipping the framed word: expecting a symbol. -/ + | skipBit + /-- Copying the unary count to the work tape. -/ + | copy + /-- Moving the input head back to its start. -/ + | rewind + /-- Streaming: expecting a marker of the outer frame. -/ + | marker (inBit : Bool) + /-- Streaming: expecting an inner symbol of kind `inBit`. -/ + | symbol (inBit : Bool) + +/-- An encoding of the control states into a finite type. -/ +private def State.toSum : State → Fin 4 ⊕ Bool ⊕ Bool + | .skip => .inl 0 + | .skipBit => .inl 1 + | .copy => .inl 2 + | .rewind => .inl 3 + | .marker b => .inr (.inl b) + | .symbol b => .inr (.inr b) + +public instance State.instFinite : Finite State := + Finite.of_injective State.toSum fun a b h => by + cases a <;> cases b <;> simp_all [State.toSum] + +/-- The action that halts without moving or writing. -/ +private def haltAction : Action 1 Bool State := + { inputTape := 0, workTapes := fun _ => (none, 0), output := none, state := none } + +/-- The action moving the input head by `d` into state `q`. -/ +private def moveTo (d : SignType) (q : State) : Action 1 Bool State := + { inputTape := d, workTapes := fun _ => (none, 0), output := none, state := some q } + +/-- The transition function of `TakeDropUnary.toTM`. -/ +private def tr (keep : Bool) : State → Option Bool → Option Bool → Action 1 Bool State + | .skip, some true, _ => moveTo 1 .skipBit + | .skip, some false, _ => moveTo 1 .copy + | .skip, none, _ => haltAction + | .skipBit, some _, _ => moveTo 1 .skip + | .skipBit, none, _ => haltAction + | .copy, some true, _ => + { inputTape := 1, workTapes := fun _ => (some (some true), 1), output := none, + state := some .copy } + | .copy, some false, _ => haltAction + | .copy, none, _ => + { inputTape := -1, workTapes := fun _ => (none, -1), output := none, state := some .rewind } + | .rewind, some _, _ => moveTo (-1) .rewind + | .rewind, none, _ => moveTo 1 (.marker false) + | .marker b, some true, _ => moveTo 1 (.symbol b) + | .marker _, some false, _ => haltAction + | .marker _, none, _ => haltAction + | .symbol inBit, some b, y => + { inputTape := 1, + workTapes := fun _ => (none, if !inBit && !b && y.isSome then -1 else 0), + output := if y.isSome == keep then some b else none, + state := some (.marker (nextKind inBit b)) } + | .symbol _, none, _ => haltAction + +/-- The machine with one work tape cutting `frame u ++ List.replicate n true`: it emits the inner +frames of `u` while the count `n` lasts (`keep = true`) or after it is used up (`keep = false`). -/ +public def toTM (keep : Bool) : MultiTapeTM 1 Bool State := + ofTr .skip fun s x ys => tr keep s x (ys 0) + +/-! ### Configurations -/ + +variable {keep : Bool} {w : List Bool} + +/-- The configuration in state `st` with the input head at `p` (clamped to the input), the work +tape `tape` with its head at `h`, and the output `o`. -/ +private def cfgAt (w : List Bool) (st : Option State) (p : ℕ) (tape : ℤ → Option Bool) (h : ℤ) + (o : List Bool) : Cfg 1 Bool State w := + ⟨st, ⟨min p (w.length + 1), by omega⟩, fun _ => tape, fun _ => h, o⟩ + +private lemma moveInputPosNat_le (n j : ℕ) (d : SignType) (hj : j < n + 2) : + moveInputPosNat n j d ≤ n + 1 := by + have := (moveInputPos (⟨j, hj⟩ : Fin (n + 2)) d).isLt + rw [val_moveInputPos_eq_moveInputPosNat] at this + exact Nat.lt_succ_iff.mp this + +/-- One step of `toTM`, read off its transition function. -/ +private lemma step_cfgAt (s : State) (p : ℕ) (tape : ℤ → Option Bool) (h : ℤ) (o : List Bool) : + (toTM keep).step (cfgAt w (some s) p tape h o) = + cfgAt w (tr keep s (inputAt w (min p (w.length + 1))) (tape h)).state + (moveInputPosNat w.length (min p (w.length + 1)) + (tr keep s (inputAt w (min p (w.length + 1))) (tape h)).inputTape) + (match ((tr keep s (inputAt w (min p (w.length + 1))) (tape h)).workTapes 0).1 with + | none => tape + | some x => Function.update tape h x) + (h + (((tr keep s (inputAt w (min p (w.length + 1))) (tape h)).workTapes 0).2 : ℤ)) + (o ++ (tr keep s (inputAt w (min p (w.length + 1))) (tape h)).output.toList) := by + have hw : (cfgAt w (some s) p tape h o).workTapeSymbols = fun _ => tape h := rfl + have hp : ((cfgAt w (some s) p tape h o).inputPos : ℕ) = min p (w.length + 1) := rfl + rw [step_of_state rfl, Cfg.inputSymbol_eq_inputAt, hw, hp] + simp only [toTM, tr_ofTr] + refine Cfg.ext rfl (Fin.ext ?_) (funext fun i => ?_) (funext fun i => ?_) rfl + · rw [Action.apply_inputPos, val_moveInputPos_eq_moveInputPosNat, hp] + exact (min_eq_left (moveInputPosNat_le _ _ _ (by omega))).symm + · obtain rfl : i = 0 := Subsingleton.elim _ _ + simp only [cfgAt, Action.apply_workTapes] + rcases ((tr keep s (inputAt w (min p (w.length + 1))) (tape h)).workTapes 0).1 with _ | _ <;> + rfl + · obtain rfl : i = 0 := Subsingleton.elim _ _ + simp only [cfgAt, Action.apply_workTapePos] + +private lemma cfgAt_congr {st : Option State} {p p' : ℕ} {tape : ℤ → Option Bool} {h h' : ℤ} + {o : List Bool} (hp : min p (w.length + 1) = min p' (w.length + 1)) (hh : h = h') : + cfgAt w st p tape h o = cfgAt w st p' tape h' o := by + subst hh + simp only [cfgAt, hp] + +private lemma moveInputPosNat_one {n j : ℕ} (hj : j ≤ n) : moveInputPosNat n j 1 = j + 1 := by + simp only [moveInputPosNat, SignType.coe_one] + omega + +private lemma moveInputPosNat_zero {n j : ℕ} (hj : j ≤ n + 1) : moveInputPosNat n j 0 = j := by + simp only [moveInputPosNat, SignType.coe_zero] + omega + +private lemma moveInputPosNat_neg_one {n j : ℕ} (hj : j ≤ n + 1) : + moveInputPosNat n j (-1) = j - 1 := by + simp only [moveInputPosNat, SignType.coe_neg_one] + omega + +/-! ### Runs through a set of work-head positions -/ + +/-- From `c`, `toTM keep` reaches `c'` within `t` steps, its work head staying in `S`. -/ +private def Seg (keep : Bool) (S : Finset ℤ) (c c' : Cfg 1 Bool State w) (t : ℕ) : Prop := + ∃ n ≤ t, (toTM keep).runFrom c n = c' ∧ ∀ j ≤ n, ((toTM keep).runFrom c j).workTapePos 0 ∈ S + +variable {S : Finset ℤ} {c c' c'' : Cfg 1 Bool State w} {t t' : ℕ} + +private lemma Seg.refl (hc : c.workTapePos 0 ∈ S) : Seg keep S c c 0 := + ⟨0, le_rfl, rfl, fun j hj => by + obtain rfl : j = 0 := by omega + exact hc⟩ + +private lemma Seg.single (hc : c.workTapePos 0 ∈ S) (h : (toTM keep).step c = c') + (hc' : c'.workTapePos 0 ∈ S) : Seg keep S c c' 1 := + ⟨1, le_rfl, h, fun j hj => by + rcases Nat.le_one_iff_eq_zero_or_eq_one.mp hj with rfl | rfl + · exact hc + · rw [runFrom_one, h] + exact hc'⟩ + +private lemma Seg.trans (h₁ : Seg keep S c c' t) (h₂ : Seg keep S c' c'' t') : + Seg keep S c c'' (t + t') := by + obtain ⟨n₁, hn₁, hr₁, hs₁⟩ := h₁ + obtain ⟨n₂, hn₂, hr₂, hs₂⟩ := h₂ + refine ⟨n₁ + n₂, by omega, by rw [runFrom_add, hr₁, hr₂], fun j hj => ?_⟩ + rcases Nat.lt_or_ge n₁ j with h | h + · obtain ⟨d, rfl⟩ : ∃ d, j = n₁ + d := ⟨j - n₁, by omega⟩ + rw [runFrom_add, hr₁] + exact hs₂ d (by omega) + · exact hs₁ j h + +private lemma Seg.mono (h : Seg keep S c c' t) (ht : t ≤ t') : Seg keep S c c' t' := + let ⟨n, hn, hr, hs⟩ := h + ⟨n, hn.trans ht, hr, hs⟩ + +/-! ### The framed input -/ + +private lemma getElem?_frame_append (u v : List Bool) {i : ℕ} (hi : i < u.length) : + (frame u ++ v)[2 * i]? = some true ∧ (frame u ++ v)[2 * i + 1]? = some u[i] := by + induction u generalizing i with + | nil => simp at hi + | cons b u ih => + rcases i with _ | i + · simp [frame_cons] + · obtain ⟨h₁, h₂⟩ := ih (i := i) (by simpa using hi) + have e₁ : 2 * (i + 1) = 2 * i + 1 + 1 := by omega + simp only [frame_cons, List.cons_append, e₁, List.getElem?_cons_succ, + List.getElem_cons_succ] + exact ⟨h₁, h₂⟩ + +private lemma getElem?_frame_append_length (u v : List Bool) (j : ℕ) : + (frame u ++ v)[2 * u.length]? = some false ∧ + (frame u ++ v)[2 * u.length + 1 + j]? = v[j]? := by + have hfl : frame u ++ v = u.flatMap (fun b => [true, b]) ++ false :: v := by simp [frame] + have hlen : (u.flatMap (fun b => [true, b])).length = 2 * u.length := by + have := length_frame u + simp only [frame, List.length_append, List.length_singleton] at this + omega + rw [hfl, List.getElem?_append_right (by omega), List.getElem?_append_right (by omega), hlen, + Nat.sub_self, (by omega : 2 * u.length + 1 + j - 2 * u.length = j + 1)] + exact ⟨rfl, rfl⟩ + +private lemma length_frame_append (u v : List Bool) : + (frame u ++ v).length = 2 * u.length + 1 + v.length := by + rw [List.length_append, length_frame] + +/-- The inner symbols of `frame u ++ v`: the marker `true` and the symbol `u[i]`. -/ +private lemma inputAt_frame_append (u v : List Bool) {i : ℕ} (hi : i < u.length) : + inputAt (frame u ++ v) (2 * i + 1) = some true ∧ + inputAt (frame u ++ v) (2 * i + 2) = some u[i] := by + obtain ⟨h₁, h₂⟩ := getElem?_frame_append u v hi + exact ⟨by simpa [inputAt] using h₁, by simpa [inputAt] using h₂⟩ + +/-- The terminator of the frame. -/ +private lemma inputAt_frame_append_length (u v : List Bool) : + inputAt (frame u ++ v) (2 * u.length + 1) = some false := by + simpa [inputAt] using (getElem?_frame_append_length u v 0).1 + +/-! ### The phases of the machine -/ + +variable {u : List Bool} {n : ℕ} + +/-- The work head stays within the cells `-1, …, n`. -/ +private abbrev cells (n : ℕ) : Finset ℤ := Finset.Icc (-1) n + +@[simp] +private lemma cfgAt_workTapePos (st : Option State) (p : ℕ) (tape : ℤ → Option Bool) (h : ℤ) + (o : List Bool) : (cfgAt w st p tape h o).workTapePos 0 = h := + rfl + +private lemma cfgAt_mem_cells {st : Option State} {p : ℕ} {tape : ℤ → Option Bool} {h : ℤ} + {o : List Bool} (h₀ : -1 ≤ h) (h₁ : h ≤ n) : + (cfgAt w st p tape h o).workTapePos 0 ∈ cells n := + Finset.mem_Icc.mpr ⟨h₀, h₁⟩ + +/-- The input word. -/ +private abbrev word (u : List Bool) (n : ℕ) : List Bool := frame u ++ List.replicate n true + +private lemma length_word (u : List Bool) (n : ℕ) : (word u n).length = 2 * u.length + 1 + n := by + rw [length_frame_append, List.length_replicate] + +/-- Skipping the frame. -/ +private lemma seg_skip {i : ℕ} (hi : i ≤ u.length) : + Seg keep (cells n) (cfgAt (word u n) (some .skip) (2 * i + 1) (tapeOfList []) 0 []) + (cfgAt (word u n) (some .skip) (2 * u.length + 1) (tapeOfList []) 0 []) + (2 * (u.length - i)) := by + obtain ⟨d, hd⟩ : ∃ d, u.length - i = d := ⟨_, rfl⟩ + have hn := length_word u n + induction d generalizing i with + | zero => + obtain rfl : i = u.length := by omega + exact (Seg.refl (cfgAt_mem_cells (by omega) (by omega))).mono (Nat.zero_le _) + | succ d ih => + have hi' : i < u.length := by omega + obtain ⟨h₁, h₂⟩ := inputAt_frame_append u (List.replicate n true) hi' + have s₁ : (toTM keep).step + (cfgAt (word u n) (some .skip) (2 * i + 1) (tapeOfList []) 0 []) = + cfgAt (word u n) (some .skipBit) (2 * i + 2) (tapeOfList []) 0 [] := by + rw [step_cfgAt, min_eq_left (by omega), h₁] + simp only [tr, moveTo, moveInputPosNat_one (by omega : 2 * i + 1 ≤ (word u n).length), + SignType.coe_zero, add_zero, List.append_nil, Option.toList_none] + have s₂ : (toTM keep).step + (cfgAt (word u n) (some .skipBit) (2 * i + 2) (tapeOfList []) 0 []) = + cfgAt (word u n) (some .skip) (2 * (i + 1) + 1) (tapeOfList []) 0 [] := by + rw [step_cfgAt, min_eq_left (by omega), h₂] + simp only [tr, moveTo, moveInputPosNat_one (by omega : 2 * i + 2 ≤ (word u n).length), + SignType.coe_zero, add_zero, List.append_nil, Option.toList_none] + exact cfgAt_congr (by omega) rfl + refine ((Seg.single (cfgAt_mem_cells (by omega) (by omega)) s₁ + (cfgAt_mem_cells (by omega) (by omega))).trans + ((Seg.single (cfgAt_mem_cells (by omega) (by omega)) s₂ + (cfgAt_mem_cells (by omega) (by omega))).trans + (ih (i := i + 1) (by omega) (by omega)))).mono (by omega) + +/-- The end of the frame: the input head moves to the count. -/ +private lemma step_endFrame : + (toTM keep).step (cfgAt (word u n) (some .skip) (2 * u.length + 1) (tapeOfList []) 0 []) = + cfgAt (word u n) (some .copy) (2 * u.length + 2 + 0) (tapeOfList (List.replicate 0 true)) + ((0 : ℕ) : ℤ) [] := by + have hn := length_word u n + rw [step_cfgAt, min_eq_left (by omega), inputAt_frame_append_length] + simp only [tr, moveTo, moveInputPosNat_one (by omega : 2 * u.length + 1 ≤ (word u n).length), + SignType.coe_zero, add_zero, List.append_nil, Option.toList_none, List.replicate_zero] + exact cfgAt_congr (by omega) (by simp) + +/-- Copying the count to the work tape. -/ +private lemma seg_copy {i : ℕ} (hi : i ≤ n) : + Seg keep (cells n) + (cfgAt (word u n) (some .copy) (2 * u.length + 2 + i) (tapeOfList (List.replicate i true)) + i []) + (cfgAt (word u n) (some .copy) (2 * u.length + 2 + n) (tapeOfList (List.replicate n true)) + n []) + (n - i) := by + obtain ⟨d, hd⟩ : ∃ d, n - i = d := ⟨_, rfl⟩ + have hn := length_word u n + induction d generalizing i with + | zero => + obtain rfl : i = n := by omega + exact (Seg.refl (cfgAt_mem_cells (by omega) le_rfl)).mono (Nat.zero_le _) + | succ d ih => + have hi' : i < n := by omega + have hx : inputAt (word u n) (2 * u.length + 2 + i) = some true := by + have := (getElem?_frame_append_length u (List.replicate n true) i).2 + rw [List.getElem?_replicate_of_lt hi'] at this + simpa [inputAt, (by omega : 2 * u.length + 2 + i - 1 = 2 * u.length + 1 + i)] using this + have ht : Function.update (tapeOfList (List.replicate i true)) (i : ℤ) (some true) = + tapeOfList (List.replicate (i + 1) true) := by + rw [List.replicate_succ', tapeOfList_append_single, List.length_replicate] + have s : (toTM keep).step + (cfgAt (word u n) (some .copy) (2 * u.length + 2 + i) + (tapeOfList (List.replicate i true)) i []) = + cfgAt (word u n) (some .copy) (2 * u.length + 2 + (i + 1)) + (tapeOfList (List.replicate (i + 1) true)) ((i + 1 : ℕ) : ℤ) [] := by + rw [step_cfgAt, min_eq_left (by omega), hx] + simp only [tr, moveInputPosNat_one (by omega : 2 * u.length + 2 + i ≤ (word u n).length), + SignType.coe_one, List.append_nil, Option.toList_none, ht] + exact cfgAt_congr (by omega) (by push_cast; rfl) + exact ((Seg.single (cfgAt_mem_cells (by omega) (by omega)) s + (cfgAt_mem_cells (by omega) (by omega))).trans (ih (i := i + 1) (by omega) (by omega))).mono + (by omega) + +/-- The end of the count: the work head moves onto the last copied `true`. -/ +private lemma step_endCount : + (toTM keep).step (cfgAt (word u n) (some .copy) (2 * u.length + 2 + n) + (tapeOfList (List.replicate n true)) n []) = + cfgAt (word u n) (some .rewind) (word u n).length (tapeOfList (List.replicate n true)) + ((n : ℤ) - 1) [] := by + have hn := length_word u n + have hx : inputAt (word u n) (2 * u.length + 2 + n) = none := by + simp only [inputAt] + split_ifs + · rfl + · exact List.getElem?_eq_none (by omega) + rw [step_cfgAt, min_eq_left (by omega), hx] + simp only [tr, moveInputPosNat_neg_one (by omega : 2 * u.length + 2 + n ≤ (word u n).length + 1), + SignType.coe_neg_one, List.append_nil, Option.toList_none] + exact cfgAt_congr (by omega) (by omega) + +/-- Rewinding the input head. -/ +private lemma seg_rewind {j : ℕ} (hj : j ≤ (word u n).length) : + Seg keep (cells n) + (cfgAt (word u n) (some .rewind) j (tapeOfList (List.replicate n true)) ((n : ℤ) - 1) []) + (cfgAt (word u n) (some (.marker false)) (2 * 0 + 1) (tapeOfList (List.replicate n true)) + ((n : ℤ) - 1) []) + (j + 1) := by + induction j with + | zero => + refine Seg.single (cfgAt_mem_cells (by omega) (by omega)) ?_ + (cfgAt_mem_cells (by omega) (by omega)) + have h0 : inputAt (word u n) 0 = none := by simp [inputAt] + rw [step_cfgAt, min_eq_left (by omega), h0] + simp only [tr, moveTo, + moveInputPosNat_one (Nat.zero_le (word u n).length), SignType.coe_zero, add_zero, + List.append_nil, Option.toList_none] + | succ j ih => + have hx : inputAt (word u n) (j + 1) = some (word u n)[j] := by + simp only [inputAt, Nat.add_sub_cancel, List.getElem?_eq_getElem (by omega : j < + (word u n).length)] + rfl + have s : (toTM keep).step + (cfgAt (word u n) (some .rewind) (j + 1) (tapeOfList (List.replicate n true)) + ((n : ℤ) - 1) []) = + cfgAt (word u n) (some .rewind) j (tapeOfList (List.replicate n true)) + ((n : ℤ) - 1) [] := by + rw [step_cfgAt, min_eq_left (by omega), hx] + simp only [tr, moveTo, moveInputPosNat_neg_one (by omega : j + 1 ≤ (word u n).length + 1), + SignType.coe_zero, add_zero, List.append_nil, Option.toList_none, Nat.add_sub_cancel] + exact ((Seg.single (cfgAt_mem_cells (by omega) (by omega)) s + (cfgAt_mem_cells (by omega) (by omega))).trans (ih (by omega))).mono (by omega) + +/-- The work cell under the head holds `true` exactly while the count is positive. -/ +private lemma tapeOfList_replicate_count {c : ℕ} (hc : c ≤ n) : + tapeOfList (List.replicate n true) ((c : ℤ) - 1) = if 0 < c then some true else none := by + rcases c with _ | c + · exact rfl + · rw [(by push_cast; omega : ((c + 1 : ℕ) : ℤ) - 1 = ((c : ℕ) : ℤ)), tapeOfList_ofNat, + List.getElem?_replicate_of_lt (by omega)] + simp + +/-- Streaming the inner word `u`, from inner position `r` on, with remaining count `c`. -/ +private lemma seg_stream (v : List Bool) (inBit : Bool) {r : ℕ} (hr : r ≤ u.length) {c : ℕ} + (hc : c ≤ n) (o : List Bool) : + ∃ h' : ℤ, -1 ≤ h' ∧ h' ≤ n ∧ Seg keep (cells n) + (cfgAt (frame u ++ v) (some (.marker inBit)) (2 * r + 1) + (tapeOfList (List.replicate n true)) ((c : ℤ) - 1) o) + (cfgAt (frame u ++ v) none (2 * u.length + 1) (tapeOfList (List.replicate n true)) h' + (o ++ stream keep inBit c (u.drop r))) + (2 * (u.length - r) + 1) := by + obtain ⟨d, hd⟩ : ∃ d, u.length - r = d := ⟨_, rfl⟩ + have hn := length_frame_append u v + induction d generalizing r inBit c o with + | zero => + obtain rfl : r = u.length := by omega + refine ⟨(c : ℤ) - 1, by omega, by omega, ?_⟩ + rw [List.drop_length] + refine (Seg.single (cfgAt_mem_cells (by omega) (by omega)) ?_ + (cfgAt_mem_cells (by omega) (by omega))).mono (by omega) + rw [step_cfgAt, min_eq_left (by omega), inputAt_frame_append_length] + simp only [tr, haltAction, moveInputPosNat_zero (by omega : 2 * u.length + 1 ≤ + (frame u ++ v).length + 1), SignType.coe_zero, add_zero, Option.toList_none, stream] + | succ d ih => + have hr' : r < u.length := by omega + obtain ⟨h₁, h₂⟩ := inputAt_frame_append u v hr' + have s₁ : (toTM keep).step + (cfgAt (frame u ++ v) (some (.marker inBit)) (2 * r + 1) + (tapeOfList (List.replicate n true)) ((c : ℤ) - 1) o) = + cfgAt (frame u ++ v) (some (.symbol inBit)) (2 * r + 2) + (tapeOfList (List.replicate n true)) ((c : ℤ) - 1) o := by + rw [step_cfgAt, min_eq_left (by omega), h₁] + simp only [tr, moveTo, moveInputPosNat_one (by omega : 2 * r + 1 ≤ (frame u ++ v).length), + SignType.coe_zero, add_zero, List.append_nil, Option.toList_none] + have hcell := tapeOfList_replicate_count (n := n) hc + have hsome : (tapeOfList (List.replicate n true) ((c : ℤ) - 1)).isSome = decide (0 < c) := by + rw [hcell] + split_ifs with h <;> simp [h] + have hnext : nextCount inBit u[r] c ≤ n := by + simp only [nextCount] + split_ifs <;> omega + have hhead : (c : ℤ) - 1 + + ((if !inBit && !u[r] && (tapeOfList (List.replicate n true) ((c : ℤ) - 1)).isSome then -1 + else 0 : SignType) : ℤ) = ((nextCount inBit u[r] c : ℕ) : ℤ) - 1 := by + rw [hsome] + cases inBit <;> cases hb : u[r] <;> rcases Nat.eq_zero_or_pos c with h | h <;> + simp [nextCount, h] + omega + have s₂ : (toTM keep).step + (cfgAt (frame u ++ v) (some (.symbol inBit)) (2 * r + 2) + (tapeOfList (List.replicate n true)) ((c : ℤ) - 1) o) = + cfgAt (frame u ++ v) (some (.marker (nextKind inBit u[r]))) (2 * (r + 1) + 1) + (tapeOfList (List.replicate n true)) (((nextCount inBit u[r] c : ℕ) : ℤ) - 1) + (o ++ if emits keep c then [u[r]] else []) := by + rw [step_cfgAt, min_eq_left (by omega), h₂] + have ho : (if ((tapeOfList (List.replicate n true) ((c : ℤ) - 1)).isSome == keep) = true + then some u[r] else none).toList = if emits keep c then [u[r]] else [] := by + rw [hsome, emits] + split_ifs <;> rfl + simp only [tr, moveInputPosNat_one (by omega : 2 * r + 2 ≤ (frame u ++ v).length), hhead, ho] + exact cfgAt_congr (by omega) rfl + obtain ⟨h', hh₀, hh₁, hseg⟩ := ih (nextKind inBit u[r]) (r := r + 1) (by omega) hnext + (o ++ if emits keep c then [u[r]] else []) (by omega) + refine ⟨h', hh₀, hh₁, ?_⟩ + rw [List.drop_eq_getElem_cons hr', stream_cons, ← List.append_assoc] + refine ((Seg.single (cfgAt_mem_cells (by omega) (by omega)) s₁ + (cfgAt_mem_cells (by omega) (by omega))).trans + ((Seg.single (cfgAt_mem_cells (by omega) (by omega)) s₂ + (cfgAt_mem_cells (by omega) (by omega))).trans hseg)).mono (by omega) + +/-- The complete run on `frame u ++ List.replicate n true`. -/ +private lemma seg_run (u : List Bool) (n : ℕ) : + ∃ h' : ℤ, -1 ≤ h' ∧ h' ≤ n ∧ Seg keep (cells n) ((toTM keep).initCfg (word u n)) + (cfgAt (word u n) none (2 * u.length + 1) (tapeOfList (List.replicate n true)) h' + (stream keep false n u)) + (3 * (word u n).length + 2) := by + have hn := length_word u n + have hinit : (toTM keep).initCfg (word u n) = + cfgAt (word u n) (some .skip) (2 * 0 + 1) (tapeOfList []) 0 [] := by + refine Cfg.ext rfl (Fin.ext ?_) (funext fun _ => ?_) rfl rfl + · simp [MultiTapeNTM.initCfg, Cfg.init, cfgAt] + · simp [MultiTapeNTM.initCfg, Cfg.init, cfgAt, tapeOfList_nil] + obtain ⟨h', hh₀, hh₁, hstream⟩ := seg_stream (keep := keep) (u := u) (n := n) + (List.replicate n true) false (r := 0) (Nat.zero_le _) le_rfl [] + rw [List.drop_zero, List.nil_append] at hstream + refine ⟨h', hh₀, hh₁, ?_⟩ + rw [hinit] + refine ((seg_skip (Nat.zero_le _)).trans ((Seg.single (cfgAt_mem_cells (by omega) (by omega)) + step_endFrame (cfgAt_mem_cells (by omega) (by omega))).trans ((seg_copy (Nat.zero_le _)).trans + ((Seg.single (cfgAt_mem_cells (by omega) (by omega)) step_endCount + (cfgAt_mem_cells (by omega) (by omega))).trans + ((seg_rewind le_rfl).trans hstream))))).mono ?_ + omega + +/-- On `frame u ++ List.replicate n true`, `toTM keep` emits `stream keep false n u` within +`3 * (frame u ++ List.replicate n true).length + 2` steps, visiting the `n + 2` work-tape cells +`-1, …, n`. -/ +public theorem computesInTimeAndSpace_toTM (keep : Bool) (u : List Bool) (n : ℕ) : + (toTM keep).ComputesInTimeAndSpace (frame u ++ List.replicate n true) (stream keep false n u) + (3 * (frame u ++ List.replicate n true).length + 2) (n + 2) := by + obtain ⟨h', -, -, m, hm, hrun, hcells⟩ := seg_run (keep := keep) u n + have hhalt : ((toTM keep).runFrom ((toTM keep).initCfg (word u n)) m).Halted := by + rw [hrun] + rfl + refine ⟨⟨m, hhalt, by rw [hrun]; rfl⟩, runsInTime_of_halted ?_, runsInSpace_of_halted hhalt ?_⟩ + · rw [runFrom_eq_of_halt _ _ hm hhalt] + exact hhalt + · simp only [MultiTapeNTM.RunPath.space, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton] + refine (spaceUsedByTape_le_card _ hcells).trans_eq ?_ + simp only [cells, Int.card_Icc] + omega + +/-! ### Encoded lists -/ + +variable {α : Type} + +/-- **Streaming an encoded list** emits the encoded prefix (`keep = true`) or suffix +(`keep = false`) at the count. -/ +public theorem stream_encList (keep : Bool) (enc : α ↪ List Bool) (l : List α) (c : ℕ) : + stream keep false c (encList enc l) = encList enc (if keep then l.take c else l.drop c) := by + induction l generalizing c with + | nil => cases keep <;> simp [stream] + | cons a l ih => + rw [encList_cons, stream_frame_append, ih] + rcases c with _ | c <;> cases keep <;> simp [emits] + +/-- **Taking (`keep = true`) or dropping (`keep = false`) a unary number of elements** of an +encoded list, by `toTM keep`, within `3 * (encPair (encList enc) encUnary p).length + 2` steps and +`p.2 + 2` work-tape cells. -/ +public theorem computableInTimeAndSpace (keep : Bool) (enc : α ↪ List Bool) : + ComputableInTimeAndSpace (fun p : List α × ℕ => if keep then p.1.take p.2 else p.1.drop p.2) + (encPair (encList enc) encUnary) (encList enc) + (fun p => 3 * (encPair (encList enc) encUnary p).length + 2) (fun p => p.2 + 2) := + ⟨1, State, inferInstance, toTM keep, fun p => by + simpa only [encPair_apply, encUnary_apply, stream_encList] using + computesInTimeAndSpace_toTM keep (encList enc p.1) p.2⟩ + +end TakeDropUnary + +end Turing.MultiTapeTM diff --git a/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean b/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean new file mode 100644 index 0000000000..69d1ea69e1 --- /dev/null +++ b/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +module +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TakeDropUnary +import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelTakeDropUnary + +/-! Linear-time unary take and drop on encoded lists: instances and the streaming semantics. -/ + +open Turing.MultiTapeTM + +/-- The plain certificates instantiate on lists of unary numbers, at degree one. -/ +example : + ComputableInDegree (fun p : List ℕ × ℕ => p.1.take p.2) + (encPair (encList encUnary) encUnary) (encList encUnary) 1 1 ∧ + ComputableInDegree (fun p : List ℕ × ℕ => p.1.drop p.2) + (encPair (encList encUnary) encUnary) (encList encUnary) 1 1 := + ⟨ComputableInDegree.takeUnary encUnary, ComputableInDegree.dropUnary encUnary⟩ + +/-- The tidy `dropUnary` is linear, and still serves clients of the former quadratic degree. -/ +example (enc : Bool ↪ List Bool) : + ComputableTidilyInDegree (fun p : List Bool × ℕ => p.1.drop p.2) + (encPair (encList enc) encUnary) (encList enc) 1 1 ∧ + ComputableTidilyInDegree (fun p : List Bool × ℕ => p.1.drop p.2) + (encPair (encList enc) encUnary) (encList enc) 2 1 := + ⟨ComputableTidilyInDegree.dropUnary enc, (ComputableTidilyInDegree.dropUnary enc).mono⟩ + +/-! The machine's streaming semantics on a small encoded list, including an empty element. -/ + +example : TakeDropUnary.stream true false 2 (encList encUnary [2, 0, 1]) = + encList encUnary [2, 0] := by decide + +example : TakeDropUnary.stream false false 2 (encList encUnary [2, 0, 1]) = + encList encUnary [1] := by decide + +example : TakeDropUnary.stream true false 5 (encList encUnary [2, 0, 1]) = + encList encUnary [2, 0, 1] := by decide + +example : TakeDropUnary.stream false false 0 (encList encUnary [2, 0, 1]) = + encList encUnary [2, 0, 1] := by decide From b96a0dac4f8f860e73ea1aa391674def1c8e0898 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:27:41 +0000 Subject: [PATCH 11/40] feat(universal): prove the windowed size bounds (#800) Replace the sorries in Universal/WindowedBound.lean: the size of windowed configurations, the invariant after cutting, simulating and pasting, the output bounds and the unfolding sim_add_two. --- .../MultiTape/Universal/WindowedBound.lean | 465 ++++++++++++++++-- 1 file changed, 437 insertions(+), 28 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean index bbf6dc718c..1e999deb77 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean @@ -8,6 +8,7 @@ module -- upstream: candidate public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Windowed +import Mathlib.Tactic.Linarith /-! # The size of windowed configurations @@ -88,69 +89,477 @@ structure WInv (D B h L : ℕ) (w : Win) : Prop where /-- **The size of a windowed configuration.** -/ theorem length_eWin_le {D B h L : ℕ} {w : Win} (hw : WInv D B h L w) : - (eWin w).length ≤ winBound D B h L := - sorry + (eWin w).length ≤ winBound D B h L := by + obtain ⟨q, ts⟩ := w + have h₁ := length_eSym_le hw.state + have h₂ := length_encList_le eTape ts (b := 2 * h + 4 + 2 * L * (2 * B + 3)) fun t ht => by + have hi := length_encInt_le t.head + have hl := length_cells_le fun o ho => hw.val t ht o (List.mem_append_left t.right ho) + have hr := length_cells_le fun o ho => hw.val t ht o (List.mem_append_right t.left ho) + have hh := hw.head t ht + have hc := Nat.mul_le_mul_right (2 * B + 3) (hw.cells t ht) + simp only [cells] at hc + simp only [eTape_apply, length_encPair] + nlinarith + have h₃ := Nat.mul_le_mul_right (2 * (2 * h + 4 + 2 * L * (2 * B + 3)) + 1) hw.tapes + simp only [length_encPair, winBound] + nlinarith /-- Weakening the bounds. -/ theorem WInv.mono {D B h L h' L' : ℕ} {w : Win} (hw : WInv D B h L w) (hh : h ≤ h') (hL : L ≤ L') : WInv D B h' L' w := - sorry + ⟨hw.state, hw.tapes, fun t ht => (hw.head t ht).trans hh, fun t ht => (hw.cells t ht).trans hL, + hw.val⟩ /-- Cutting windows of radius `r`: the heads are at `0` and every window holds at most `2 * r + 1` cells, and at most as many as before. -/ theorem WInv.extract {D B h L : ℕ} {w : Win} (hw : WInv D B h L w) (r : ℕ) : - WInv D B 0 (min L (2 * r + 1)) (Windowed.extract r w) := - sorry + WInv D B 0 (min L (2 * r + 1)) (Windowed.extract r w) := by + refine ⟨hw.state, by simpa [Windowed.extract] using hw.tapes, ?_, ?_, ?_⟩ <;> + simp only [Windowed.extract, List.mem_map] <;> rintro _ ⟨t, ht, rfl⟩ + · simp [cut] + · have := hw.cells t ht + simp only [Windowed.cells, cut, List.length_take] at this ⊢ + omega + · intro o ho + simp only [cut, List.mem_append] at ho + exact hw.val t ht o (List.mem_append.mpr (ho.imp List.mem_of_mem_take List.mem_of_mem_take)) + +private lemma q₀_le' (d : Desc) : d.q₀ ≤ descLen d := by + simp only [descLen, eDesc_apply, length_encPair, encUnary_apply, List.length_replicate]; omega + +private lemma tapes_le' (d : Desc) : d.tapes ≤ descLen d := by + simp only [descLen, eDesc_apply, length_encPair, encUnary_apply, List.length_replicate]; omega /-- The windows of the initial configuration. -/ theorem winv_initWin (d : Desc) (x : List ℕ) : - WInv (descLen d) (descLen d + listMax id x + 1) 0 (x.length + 1) (initWin d x) := - sorry + WInv (descLen d) (descLen d + listMax id x + 1) 0 (x.length + 1) (initWin d x) := by + refine ⟨by simpa [initWin] using q₀_le' d, by simpa [initWin] using tapes_le' d, ?_, ?_, ?_⟩ <;> + simp only [initWin, List.mem_cons, List.mem_replicate] <;> rintro t (rfl | ⟨-, rfl⟩) + · simp + · simp + · simp [cells]; omega + · simp [cells] + · intro o ho + simp only [List.cons_append, List.nil_append, List.mem_cons, List.mem_map] at ho + rcases ho with rfl | ⟨a, ha, rfl⟩ + · simp + · have := le_listMax (f := id) ha + simp only [id] at this + simp only [Option.getD_some] + omega + · simp + +/-! ### One step -/ + +/-- The cells of a window are at most `B`. -/ +private abbrev ValLe (B : ℕ) (t : Tape) : Prop := ∀ o ∈ t.left ++ t.right, o.getD 0 ≤ B + +private lemma valLe_move {B : ℕ} {t : Tape} (h : ValLe B t) (m : SignType) : + ValLe B (t.move m) := by + have hl : ∀ o ∈ t.left, o.getD 0 ≤ B := fun o ho => h o (List.mem_append_left _ ho) + have hr : ∀ o ∈ t.right, o.getD 0 ≤ B := fun o ho => h o (List.mem_append_right _ ho) + have hd : ∀ {l : List (Option ℕ)}, (∀ o ∈ l, o.getD 0 ≤ B) → (l.headD none).getD 0 ≤ B := by + intro l hl + cases l with + | nil => simp + | cons o l => exact hl o (List.mem_cons_self ..) + intro o ho + rcases m with _ | _ | _ <;> + simp only [Tape.move, Tape.read, List.mem_append, List.mem_cons] at ho + · exact h o (List.mem_append.mpr ho) + · rcases ho with ho | rfl | ho + · exact hl o (List.mem_of_mem_tail ho) + · exact hd hl + · exact hr o ho + · rcases ho with (rfl | ho) | ho + · exact hd hr + · exact hl o ho + · exact hr o (List.mem_of_mem_tail ho) + +private lemma valLe_apply {B : ℕ} {t : Tape} (h : ValLe B t) {a : TapeAct} + (ha : (a.1.getD none).getD 0 ≤ B) : ValLe B (t.apply a) := by + obtain ⟨_ | o, m⟩ := a + · exact valLe_move h m + · refine valLe_move (fun o' ho' => ?_) m + simp only [Option.elim, Tape.write, List.mem_append, List.mem_cons] at ho' + rcases ho' with ho' | rfl | ho' + · exact h o' (List.mem_append_left _ ho') + · exact ha + · exact h o' (List.mem_append_right _ (List.mem_of_mem_tail ho')) + +private lemma head_move (t : Tape) (m : SignType) : (t.move m).head.natAbs ≤ t.head.natAbs + 1 := by + rcases m with _ | _ | _ <;> simp only [Tape.move] <;> omega + +private lemma cells_move (t : Tape) (m : SignType) : cells (t.move m) ≤ cells t + 1 := by + rcases m with _ | _ | _ <;> simp only [Tape.move, cells, List.length_cons, List.length_tail] <;> + omega + +private lemma head_apply (t : Tape) (a : TapeAct) : + (t.apply a).head.natAbs ≤ t.head.natAbs + 1 := by + obtain ⟨_ | o, m⟩ := a + · exact head_move t m + · exact head_move (t.write o) m + +private lemma cells_apply (t : Tape) (a : TapeAct) : cells (t.apply a) ≤ cells t + 2 := by + obtain ⟨_ | o, m⟩ := a + · have := cells_move t m + simp only [Tape.apply, Option.elim] + omega + · have := cells_move (t.write o) m + have : cells (t.write o) ≤ cells t + 1 := by + simp only [cells, Tape.write, List.length_cons, List.length_tail]; omega + simp only [Tape.apply, Option.elim] + omega + +/-- How a window may change in `n` steps: the head moves by at most one and at most `2 * n` cells +are added. -/ +private abbrev Grow (n : ℕ) (t t' : Tape) : Prop := + t'.head.natAbs ≤ t.head.natAbs + 1 ∧ cells t' ≤ cells t + 2 * n + +private lemma forall₂_grow_refl (n : ℕ) (ts : List Tape) : List.Forall₂ (Grow n) ts ts := + List.forall₂_same.mpr fun _ _ => ⟨by omega, by omega⟩ + +private lemma grow_moveIn (t : Tape) (p p' : ℕ) : Grow 1 t (moveIn t p p') := by + unfold moveIn + split_ifs + · exact ⟨head_move t _, by have := cells_move t .pos; omega⟩ + · exact ⟨head_move t _, by have := cells_move t .neg; omega⟩ + · exact ⟨by omega, by omega⟩ + +private lemma valLe_moveIn {B : ℕ} {t : Tape} (h : ValLe B t) (p p' : ℕ) : + ValLe B (moveIn t p p') := by + unfold moveIn + split_ifs + · exact valLe_move h _ + · exact valLe_move h _ + · exact h + +/-- Applying actions moves every head by at most one and adds at most two cells. -/ +private lemma forall₂_applyTapes (ts : List Tape) (as : List TapeAct) : + List.Forall₂ (Grow 1) ts (applyTapes ts as) := by + induction ts generalizing as with + | nil => cases as <;> exact .nil + | cons t ts ih => + cases as with + | nil => exact forall₂_grow_refl 1 _ + | cons a as => exact .cons ⟨head_apply t a, by have := cells_apply t a; omega⟩ (ih as) + +private lemma valLe_applyTapes {B : ℕ} {ts : List Tape} (hts : ∀ t ∈ ts, ValLe B t) + {as : List TapeAct} (has : ∀ a ∈ as, (a.1.getD none).getD 0 ≤ B) : + ∀ t ∈ applyTapes ts as, ValLe B t := by + induction ts generalizing as with + | nil => cases as <;> simp [applyTapes] + | cons t ts ih => + cases as with + | nil => exact hts + | cons a as => + simp only [applyTapes, List.mem_cons, forall_eq_or_imp] + exact ⟨valLe_apply (hts t (List.mem_cons_self ..)) (has a (List.mem_cons_self ..)), + ih (fun t ht => hts t (List.mem_cons_of_mem _ ht)) + (fun a ha => has a (List.mem_cons_of_mem _ ha))⟩ + +private lemma length_act_le {d : Desc} {e : Key × Act} (he : e ∈ d.table) : + (eAct e.2).length ≤ descLen d := by + have := length_le_encList_of_mem (encPair eKey eAct) he + simp only [descLen, eDesc_apply, length_encPair] at this ⊢ + omega + +private lemma getD_le_length (o : Option ℕ) : o.getD 0 ≤ (eSym o).length := by + cases o <;> simp + +private lemma state_le {d : Desc} {e : Key × Act} (he : e ∈ d.table) : + e.2.state.getD 0 ≤ descLen d := by + have := length_act_le he + have := getD_le_length e.2.state + simp only [eAct_apply, length_encPair] at * + omega + +private lemma output_le {d : Desc} {e : Key × Act} (he : e ∈ d.table) : + e.2.output.getD 0 ≤ descLen d := by + have := length_act_le he + have := getD_le_length e.2.output + simp only [eAct_apply, length_encPair] at * + omega + +private lemma write_le {d : Desc} {e : Key × Act} (he : e ∈ d.table) {ta : TapeAct} + (hta : ta ∈ e.2.workTapes) : (ta.1.getD none).getD 0 ≤ descLen d := by + have h₁ := length_act_le he + have h₂ := length_le_encList_of_mem eTA hta + have h₃ := getD_le_length (ta.1.getD none) + have h₄ : (eSym (ta.1.getD none)).length ≤ (encOption eSym ta.1).length := by + cases ta.1 <;> simp + simp only [eAct_apply, length_encPair] at * + omega + +/-- The three outcomes of a step: halted, no transition, or a transition from the table. -/ +private lemma stepWith_cases (d : Desc) (c : SCfg) (a : Option ℕ) : + stepWith d c a = (c, none) ∨ stepWith d c a = (⟨none, c.inputPos, c.workTapes⟩, none) ∨ + ∃ e ∈ d.table, stepWith d c a = (⟨e.2.state, moveInput c.inputPos a e.2.inputTape, + applyTapes c.workTapes e.2.workTapes⟩, e.2.output) := by + unfold stepWith + split + · exact Or.inl rfl + · split + · exact Or.inr (Or.inl rfl) + · next e he => exact Or.inr (Or.inr ⟨e, List.mem_of_find?_eq_some he, rfl⟩) + +/-- The outcomes of a windowed step. -/ +private lemma wstep_cases (d : Desc) (w : Win) : + wstep d w = (w, none) ∨ ∃ i ts p p', w.2 = i :: ts ∧ + (wstep d w = ((w.1, moveIn i p p' :: ts), none) ∨ + wstep d w = ((none, moveIn i p p' :: ts), none) ∨ + ∃ e ∈ d.table, + wstep d w = ((e.2.state, moveIn i p p' :: applyTapes ts e.2.workTapes), e.2.output)) := by + obtain ⟨q, _ | ⟨i, ts⟩⟩ := w + · exact Or.inl rfl + · refine Or.inr ⟨i, ts, inPos i.read, + (stepWith d ⟨q, inPos i.read, ts⟩ (inSym i.read)).1.inputPos, rfl, ?_⟩ + rcases stepWith_cases d ⟨q, inPos i.read, ts⟩ (inSym i.read) with h | h | ⟨e, he, h⟩ <;> + simp only [wstep, h] + · simp + · simp + · exact Or.inr (Or.inr ⟨e, he, rfl⟩) + +/-! ### Pasting -/ + +/-- Pasting replaces the cells of the cut window by those of the inner window. -/ +private lemma cells_paste (r : ℕ) (o i : Tape) : + cells (paste r o i) + cells (cut r o) = cells o + cells i := by + simp only [cells, paste, cut, List.length_append, List.length_drop, List.length_take] + omega + +private lemma forall₂_zipWith_paste {r k : ℕ} {ts ts' : List Tape} + (h : List.Forall₂ (fun t t' => cells t' ≤ cells (cut r t) + k) ts ts') : + List.Forall₂ (fun t t' => t'.head = 0 ∧ cells t' ≤ cells t + k) ts + (List.zipWith (paste r) ts ts') := by + induction h with + | nil => exact .nil + | @cons t t' _ _ h _ ih => + exact .cons ⟨rfl, by have := cells_paste r t t'; omega⟩ ih + +private lemma exists_of_forall₂ {α β : Type} {R : α → β → Prop} {l₁ : List α} {l₂ : List β} + (h : List.Forall₂ R l₁ l₂) {b : β} (hb : b ∈ l₂) : ∃ a ∈ l₁, R a b := by + induction h with + | nil => simp at hb + | cons hab _ ih => + rcases List.mem_cons.mp hb with rfl | hb + · exact ⟨_, List.mem_cons_self .., hab⟩ + · obtain ⟨a, ha, h⟩ := ih hb + exact ⟨a, List.mem_cons_of_mem _ ha, h⟩ + +private lemma forall₂_trans {α β γ : Type} {R : α → β → Prop} {S : β → γ → Prop} + {T : α → γ → Prop} (H : ∀ a b c, R a b → S b c → T a c) {l₁ : List α} {l₂ : List β} + {l₃ : List γ} (h₁ : List.Forall₂ R l₁ l₂) (h₂ : List.Forall₂ S l₂ l₃) : + List.Forall₂ T l₁ l₃ := by + induction h₁ generalizing l₃ with + | nil => cases h₂; exact .nil + | cons h _ ih => + cases h₂ with + | cons h' h₂ => exact .cons (H _ _ _ h h') (ih h₂) + +private lemma exists_of_mem_zipWith {α β γ : Type} {f : α → β → γ} {l₁ : List α} {l₂ : List β} + {c : γ} (h : c ∈ List.zipWith f l₁ l₂) : ∃ a ∈ l₁, ∃ b ∈ l₂, c = f a b := by + induction l₁ generalizing l₂ with + | nil => simp at h + | cons a l₁ ih => + cases l₂ with + | nil => simp at h + | cons b l₂ => + simp only [List.zipWith_cons_cons, List.mem_cons] at h + rcases h with rfl | h + · exact ⟨a, List.mem_cons_self .., b, List.mem_cons_self .., rfl⟩ + · obtain ⟨a', ha', b', hb', rfl⟩ := ih h + exact ⟨a', List.mem_cons_of_mem _ ha', b', List.mem_cons_of_mem _ hb', rfl⟩ + +private lemma valLe_restore {B r : ℕ} {outer inner : Win} (ho : ∀ t ∈ outer.2, ValLe B t) + (hi : ∀ t ∈ inner.2, ValLe B t) : ∀ t ∈ (restore r outer inner).2, ValLe B t := by + intro t ht + obtain ⟨o, hmo, i, hmi, rfl⟩ := exists_of_mem_zipWith ht + intro v hv + simp only [paste, List.mem_append] at hv + rcases hv with (hv | hv) | (hv | hv) + · exact hi i hmi v (List.mem_append_left _ hv) + · exact ho o hmo v (List.mem_append_left _ (List.mem_of_mem_drop hv)) + · exact hi i hmi v (List.mem_append_right _ hv) + · exact ho o hmo v (List.mem_append_right _ (List.mem_of_mem_drop hv)) + +private lemma valLe_extract {B r : ℕ} {w : Win} (h : ∀ t ∈ w.2, ValLe B t) : + ∀ t ∈ (extract r w).2, ValLe B t := by + simp only [extract, List.mem_map] + rintro _ ⟨t, ht, rfl⟩ o ho + simp only [cut, List.mem_append] at ho + exact h t ht o (List.mem_append.mpr (ho.imp List.mem_of_mem_take List.mem_of_mem_take)) + +/-! ### The windowed simulation -/ + +/-- The windowed simulation of `n + 2` steps: the first half on cut windows, pasted back, then the +second half. -/ +theorem sim_add_two (d : Desc) (n : ℕ) (w : Win) : + sim d (n + 2) w = + (restore ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1) + (sim d ((n + 2) / 2) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))).1, + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).2 ++ + (sim d ((n + 2) / 2) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))).2) := by + rw [sim] + +private lemma firstHalf_lt (n : ℕ) : firstHalf (n + 2) < n + 2 := by + simp only [firstHalf]; omega + +private lemma half_lt (n : ℕ) : (n + 2) / 2 < n + 2 := by omega + +private lemma firstHalf_add_half (n : ℕ) : firstHalf n + n / 2 = n := by + simp only [firstHalf]; omega + +/-- Paste the windows, simulated for `m` steps after cutting with radius `r`, back. -/ +private lemma forall₂_restore {r m : ℕ} {w inner : Win} + (h : List.Forall₂ (Grow m) (extract r w).2 inner.2) : + List.Forall₂ (fun t t' => t'.head = 0 ∧ cells t' ≤ cells t + 2 * m) w.2 + (restore r w inner).2 := + forall₂_zipWith_paste (List.forall₂_map_left_iff.mp h |>.imp fun _ _ h => h.2) + +/-- Window by window, the windowed simulation of `n` steps moves the heads by at most one and +adds at most `2 * n` cells. -/ +private lemma forall₂_sim (d : Desc) (n : ℕ) (w : Win) : + List.Forall₂ (Grow n) w.2 (sim d n w).1.2 := by + induction n using Nat.strong_induction_on generalizing w with + | _ n ih => + rcases n with _ | _ | n + · rw [sim]; exact forall₂_grow_refl 0 _ + · rw [sim] + rcases wstep_cases d w with h | ⟨i, ts, p, p', hw, h | h | ⟨e, -, h⟩⟩ <;> rw [h] <;> + try rw [hw] + · exact forall₂_grow_refl 1 _ + · exact .cons (grow_moveIn i p p') (forall₂_grow_refl 1 _) + · exact .cons (grow_moveIn i p p') (forall₂_grow_refl 1 _) + · exact .cons (grow_moveIn i p p') (forall₂_applyTapes ts _) + · rw [sim_add_two] + have h₁ := forall₂_restore (ih _ (firstHalf_lt n) (extract (firstHalf (n + 2)) w)) + have h₂ := forall₂_restore (ih _ (half_lt n) (extract ((n + 2) / 2) + (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))) + have hs := firstHalf_add_half (n + 2) + exact forall₂_trans (fun _ _ _ ha hb => ⟨by omega, by omega⟩) h₁ h₂ /-- The windowed simulation keeps the number of windows. -/ theorem length_sim (d : Desc) (n : ℕ) (w : Win) : (sim d n w).1.2.length = w.2.length := - sorry + (forall₂_sim d n w).length_eq.symm + +/-- The windowed simulation keeps a bound on the state above the length of the description. -/ +private lemma state_sim {d : Desc} {D : ℕ} (hD : descLen d ≤ D) (n : ℕ) {w : Win} + (hw : w.1.getD 0 ≤ D) : (sim d n w).1.1.getD 0 ≤ D := by + induction n using Nat.strong_induction_on generalizing w with + | _ n ih => + rcases n with _ | _ | n + · rw [sim]; exact hw + · rw [sim] + rcases wstep_cases d w with h | ⟨i, ts, p, p', -, h | h | ⟨e, he, h⟩⟩ <;> rw [h] + · exact hw + · exact hw + · simp + · exact (state_le he).trans hD + · rw [sim_add_two] + exact ih _ (half_lt n) (ih _ (firstHalf_lt n) hw) + +/-- The windowed simulation keeps a bound on the cells above the length of the description. -/ +private lemma valLe_sim {d : Desc} {B : ℕ} (hB : descLen d ≤ B) (n : ℕ) {w : Win} + (hw : ∀ t ∈ w.2, ValLe B t) : ∀ t ∈ (sim d n w).1.2, ValLe B t := by + induction n using Nat.strong_induction_on generalizing w with + | _ n ih => + rcases n with _ | _ | n + · rw [sim]; exact hw + · rw [sim] + rcases wstep_cases d w with h | ⟨i, ts, p, p', hw', h | h | ⟨e, he, h⟩⟩ <;> rw [h] + · exact hw + all_goals + rw [hw'] at hw + simp only [List.mem_cons, forall_eq_or_imp] at hw ⊢ + refine ⟨valLe_moveIn hw.1 p p', ?_⟩ + · exact hw.2 + · exact hw.2 + · exact valLe_applyTapes hw.2 fun ta hta => (write_le he hta).trans hB + · rw [sim_add_two] + exact valLe_restore (valLe_restore hw (ih _ (firstHalf_lt n) (valLe_extract hw))) + (ih _ (half_lt n) (valLe_extract + (valLe_restore hw (ih _ (firstHalf_lt n) (valLe_extract hw))))) /-- **The bounds after the windowed simulation** of `n` steps, for a description of length at most `B`: the heads move by at most one and every window gains at most `2 * n` cells. -/ theorem WInv.sim {d : Desc} {B h L : ℕ} (hDB : descLen d ≤ B) {w : Win} (hw : WInv (descLen d) B h L w) (n : ℕ) : - WInv (descLen d) B (h + 1) (L + 2 * n) (Windowed.sim d n w).1 := - sorry + WInv (descLen d) B (h + 1) (L + 2 * n) (Windowed.sim d n w).1 := by + have hf := forall₂_sim d n w + refine ⟨state_sim le_rfl n hw.state, by rw [length_sim]; exact hw.tapes, fun t' ht' => ?_, + fun t' ht' => ?_, valLe_sim hDB n hw.val⟩ <;> + obtain ⟨t, ht, hg⟩ := exists_of_forall₂ hf ht' + · have := hw.head t ht + have := hg.1 + omega + · have := hw.cells t ht + have := hg.2 + omega /-- **The bounds after simulating on cut windows and pasting them back**: simulating `m` steps on the windows of radius `r` and pasting the result back adds at most `2 * m` cells to every window, and puts the heads at `0`. -/ theorem WInv.restore_sim {d : Desc} {B h L : ℕ} (hDB : descLen d ≤ B) {w : Win} (hw : WInv (descLen d) B h L w) (r m : ℕ) : - WInv (descLen d) B 0 (L + 2 * m) (restore r w (Windowed.sim d m (Windowed.extract r w)).1) := - sorry + WInv (descLen d) B 0 (L + 2 * m) (restore r w (Windowed.sim d m (Windowed.extract r w)).1) := by + have hf := forall₂_restore (forall₂_sim d m (Windowed.extract r w)) + refine ⟨state_sim le_rfl m hw.state, ?_, fun t' ht' => ?_, fun t' ht' => ?_, + valLe_restore hw.val (valLe_sim hDB m (valLe_extract hw.val))⟩ + · rw [← hf.length_eq] + exact hw.tapes + · obtain ⟨t, -, hg⟩ := exists_of_forall₂ hf ht' + simp [hg.1] + · obtain ⟨t, ht, hg⟩ := exists_of_forall₂ hf ht' + have := hw.cells t ht + have := hg.2 + omega + +/-- The windowed simulation of `n` steps emits at most `n` symbols, each at most the length of the +description. -/ +private lemma sim_out (d : Desc) (n : ℕ) (w : Win) : + (sim d n w).2.length ≤ n ∧ ∀ o ∈ (sim d n w).2, o ≤ descLen d := by + induction n using Nat.strong_induction_on generalizing w with + | _ n ih => + rcases n with _ | _ | n + · rw [sim]; simp + · rw [sim] + rcases wstep_cases d w with h | ⟨i, ts, p, p', -, h | h | ⟨e, he, h⟩⟩ <;> rw [h] + · simp + · simp + · simp + · have := output_le he + revert this + cases e.2.output <;> simp + · rw [sim_add_two] + have h₁ := ih _ (firstHalf_lt n) (extract (firstHalf (n + 2)) w) + have h₂ := ih _ (half_lt n) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w + (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1)) + have hs := firstHalf_add_half (n + 2) + refine ⟨by rw [List.length_append]; omega, fun o ho => ?_⟩ + rcases List.mem_append.mp ho with ho | ho + · exact h₁.2 o ho + · exact h₂.2 o ho /-- The windowed simulation of `n` steps emits at most `n` symbols. -/ theorem length_sim_out (d : Desc) (n : ℕ) (w : Win) : (sim d n w).2.length ≤ n := - sorry + (sim_out d n w).1 /-- The symbols emitted by the windowed simulation are at most the length of the description. -/ theorem le_of_mem_sim_out {d : Desc} {n : ℕ} {w : Win} {o : ℕ} (ho : o ∈ (sim d n w).2) : o ≤ descLen d := - sorry + (sim_out d n w).2 o ho /-- The size of the emitted symbols. -/ theorem length_encList_sim_out_le (d : Desc) (n : ℕ) (w : Win) : (encList encUnary (sim d n w).2).length ≤ n * (2 * descLen d + 1) := - sorry - -/-- The windowed simulation of `n + 2` steps: the first half on cut windows, pasted back, then the -second half. -/ -theorem sim_add_two (d : Desc) (n : ℕ) (w : Win) : - sim d (n + 2) w = - (restore ((n + 2) / 2) (restore (firstHalf (n + 2)) w - (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1) - (sim d ((n + 2) / 2) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w - (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))).1, - (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).2 ++ - (sim d ((n + 2) / 2) (extract ((n + 2) / 2) (restore (firstHalf (n + 2)) w - (sim d (firstHalf (n + 2)) (extract (firstHalf (n + 2)) w)).1))).2) := - sorry + (length_encList_le encUnary _ (b := descLen d) fun o ho => by + simpa [encUnary_apply] using le_of_mem_sim_out ho).trans + (Nat.mul_le_mul_right _ (length_sim_out d n w)) end Turing.MultiTapeTM.Universal.Windowed From e31b683e98e09ebc93f1e71373a98f8332ab5f7a Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:28:02 +0000 Subject: [PATCH 12/40] wip(universal): cutting, pasting and halving certificates (#800) --- .../MultiTape/Universal/WindowedParts.lean | 283 +++++++++++++++++- 1 file changed, 271 insertions(+), 12 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean index 945e800780..c6e588428c 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean @@ -8,6 +8,13 @@ module -- upstream: candidate public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedBound +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Encoding +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TakeDropUnary +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Quantitative +import Complexity.Computability.Machines.Turing.MultiTape.Internal.BinaryPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.EqualityPrimitives +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring /-! # The cost of cutting, pasting and stepping windows @@ -30,38 +37,290 @@ public section namespace Turing.MultiTapeTM.Universal.Windowed +open ComputableTidilyInO + +/-! ### Linear-time list primitives -/ + +section Primitives + +variable {α : Type} + +/-- Taking the first `n` elements, with `n` in unary, in linear time. All uses of the primitive go +through this lemma. -/ +private lemma takeU (enc : α ↪ List Bool) : + ComputableTidilyInO (fun p : List α × ℕ => p.1.take p.2) (encPair (encList enc) encUnary) + (encList enc) (fun p => (encPair (encList enc) encUnary p).length) + fun p => (encPair (encList enc) encUnary p).length := + (ComputableInDegree.takeUnary enc).inO_one.tidy + +/-- Dropping the first `n` elements, with `n` in unary, in linear time. All uses of the primitive +go through this lemma. -/ +private lemma dropU (enc : α ↪ List Bool) : + ComputableTidilyInO (fun p : List α × ℕ => p.1.drop p.2) (encPair (encList enc) encUnary) + (encList enc) (fun p => (encPair (encList enc) encUnary p).length) + fun p => (encPair (encList enc) encUnary p).length := + (ComputableTidilyInDegree.dropUnaryLin enc).inO_one + +end Primitives + +/-! ### Sizes -/ + +private lemma one_le_length_encInt (z : ℤ) : 1 ≤ (encInt z).length := by + rw [length_encInt]; split_ifs <;> omega + +private lemma length_encList_drop_le {α : Type} (enc : α ↪ List Bool) (l : List α) (i : ℕ) : + (encList enc (l.drop i)).length ≤ (encList enc l).length := + ((List.drop_sublist i l).flatMap (frame ∘ enc)).length_le + +/-- Cutting does not lengthen a window. -/ +private lemma length_eTape_cut_le (r : ℕ) (t : Tape) : + (eTape (cut r t)).length ≤ (eTape t).length := by + have h₁ := one_le_length_encInt t.head + have h₂ := length_encList_take_le eSym t.left r + have h₃ := length_encList_take_le eSym t.right (r + 1) + simp only [cut, eTape_apply, length_encPair, encInt_zero, List.length_singleton] + omega + +/-- Pasting gives a window no longer than the two windows together. -/ +private lemma length_eTape_paste_le (r : ℕ) (o i : Tape) : + (eTape (paste r o i)).length ≤ (eTape o).length + (eTape i).length := by + have h₁ := one_le_length_encInt o.head + have h₂ := length_encList_drop_le eSym o.left r + have h₃ := length_encList_drop_le eSym o.right (r + 1) + simp only [paste, eTape_apply, length_encPair, encInt_zero, List.length_singleton, + encList_append, List.length_append] + omega + +/-- Mapping a function that does not lengthen elements does not lengthen the encoded list. -/ +private lemma length_encList_map_le {α β : Type} {encA : α ↪ List Bool} {encB : β ↪ List Bool} + {f : α → β} (hf : ∀ a, (encB (f a)).length ≤ (encA a).length) (l : List α) : + (encList encB (l.map f)).length ≤ (encList encA l).length := by + induction l with + | nil => simp + | cons a l ih => + have := hf a + simp only [List.map_cons, encList_cons, List.length_append, length_frame] + omega + +/-- Zipping with a function whose values are no longer than its two arguments together. -/ +private lemma length_encList_zipWith_le {α β γ : Type} {encA : α ↪ List Bool} + {encB : β ↪ List Bool} {encC : γ ↪ List Bool} {f : α → β → γ} + (hf : ∀ a b, (encC (f a b)).length ≤ (encA a).length + (encB b).length) (l₁ : List α) + (l₂ : List β) : + (encList encC (List.zipWith f l₁ l₂)).length ≤ + (encList encA l₁).length + (encList encB l₂).length := by + induction l₁ generalizing l₂ with + | nil => simp + | cons a l₁ ih => + cases l₂ with + | nil => simp + | cons b l₂ => + have := hf a b + have := ih l₂ + simp only [List.zipWith_cons_cons, encList_cons, List.length_append, length_frame] at * + omega + +/-! ### Cutting and pasting a window -/ + +private lemma tapeFields_inO : ComputableTidilyInO (fun t : Tape => (t.head, t.left, t.right)) + eTape eTapeFields (fun t => (eTape t).length) fun t => (eTape t).length := + of_linear (.of_eq fun _ => rfl) + +/-- Cutting a window, in linear time. -/ +private lemma cut_inO : ComputableTidilyInO (fun q : ℕ × Tape => cut q.1 q.2) + (encPair encUnary eTape) eTape (fun q => (encPair encUnary eTape q).length) + fun q => (encPair encUnary eTape q).length := by + have hr := fst encUnary eTape + have ht := tapeFields_inO.comp_linear (snd encUnary eTape) + have hl := (takeU eSym).comp_linear (ht.snd'.fst'.prod hr) + have hr' := (takeU eSym).comp_linear + (ht.snd'.snd'.prod (ComputableTidilyInDegree.unary_succ.inO_one.comp_linear hr)) + exact (((const (encMid := encInt) (0 : ℤ)).prod (hl.prod hr')).of_enc_eq (encOut := eTape) + (g := fun q : ℕ × Tape => cut q.1 q.2) fun _ => rfl).mono 8 (fun q => by omega) + fun q => by omega + +/-- Pasting a window back, in linear time. -/ +private lemma paste_inO : ComputableTidilyInO (fun q : ℕ × Tape × Tape => paste q.1 q.2.1 q.2.2) + (encPair encUnary (encPair eTape eTape)) eTape + (fun q => (encPair encUnary (encPair eTape eTape) q).length) + fun q => (encPair encUnary (encPair eTape eTape) q).length := by + have hr := fst encUnary (encPair eTape eTape) + have ho := tapeFields_inO.comp_linear (snd encUnary (encPair eTape eTape)).fst' + have hi := tapeFields_inO.comp_linear (snd encUnary (encPair eTape eTape)).snd' + have happ := (ComputableTidilyInDegree.listAppend eSym).inO_one + have hl := happ.comp_linear (hi.snd'.fst'.prod ((dropU eSym).comp_linear (ho.snd'.fst'.prod hr))) + have hr' := happ.comp_linear (hi.snd'.snd'.prod ((dropU eSym).comp_linear + (ho.snd'.snd'.prod (ComputableTidilyInDegree.unary_succ.inO_one.comp_linear hr)))) + exact (((const (encMid := encInt) (0 : ℤ)).prod (hl.prod hr')).of_enc_eq (encOut := eTape) + (g := fun q : ℕ × Tape × Tape => paste q.1 q.2.1 q.2.2) fun _ => rfl).mono 16 + (fun q => by omega) fun q => by omega + +/-! ### Cutting and pasting all windows -/ + /-- **Cutting windows** of radius `r`, in time linear in the encoded windows for each window. -/ theorem extract_inO : ComputableInO (fun p : ℕ × Win => extract p.1 p.2) (encPair encUnary eWin) eWin (fun p => (p.2.2.length + 1) * ((encPair encUnary eWin p).length + 1)) - (fun p => (p.2.2.length + 1) * ((encPair encUnary eWin p).length + 1)) := - sorry + (fun p => (p.2.2.length + 1) * ((encPair encUnary eWin p).length + 1)) := by + have hw := snd encUnary eWin + have hmap := mapWith (encP := encUnary) (enc := eTape) (encB := eTape) cut_inO + (fst encUnary eWin) hw.snd' + refine (((hw.fst'.prod hmap).of_enc_eq (encOut := eWin) + (g := fun p : ℕ × Win => extract p.1 p.2) fun _ => rfl).mono 8 (fun p => ?_) + fun p => ?_).computableInO + all_goals + obtain ⟨r, s, ts⟩ := p + have h₁ := length_encList_map_le (length_eTape_cut_le r) ts + have h₂ : listMax (fun a => (encPair encUnary eTape (r, a)).length) ts ≤ + 2 * (encUnary r).length + 1 + (encList eTape ts).length := + listMax_le fun a ha => by + have := length_le_encList_of_mem eTape ha + simp only [length_encPair] + omega + have hN : (encPair encUnary eWin (r, s, ts)).length = + 2 * (encUnary r).length + 1 + (2 * (eSym s).length + 1 + (encList eTape ts).length) := by + simp only [length_encPair] + simp only [hN] at * + generalize (encUnary r).length = R at * + generalize (encList eTape ts).length = L at * + generalize (eSym s).length = S at * + nlinarith + +/-- One round of pasting windows back: the remaining run windows, and the windows pasted so far. -/ +private def restoreStep (r : ℕ) (s : List Tape × List Tape) (t : Tape) : List Tape × List Tape := + (s.1.tail, if s.1.isEmpty then s.2 else s.2 ++ [paste r t (s.1.headD default)]) + +private lemma foldl_restoreStep (r : ℕ) (outer rest acc : List Tape) : + outer.foldl (restoreStep r) (rest, acc) = + (rest.drop outer.length, acc ++ List.zipWith (paste r) outer rest) := by + induction outer generalizing rest acc with + | nil => simp + | cons t outer ih => + rw [List.foldl_cons] + cases rest with + | nil => simp [restoreStep, ih] + | cons b rest => simp [restoreStep, ih] + +/-- A round of pasting windows back, in linear time. -/ +private lemma restoreStep_inO : ComputableTidilyInO + (fun q : (ℕ × List Tape × List Tape) × Tape => restoreStep q.1.1 q.1.2 q.2) + (encPair (encPair encUnary (encPair (encList eTape) (encList eTape))) eTape) + (encPair (encList eTape) (encList eTape)) + (fun q => (encPair (encPair encUnary (encPair (encList eTape) (encList eTape))) eTape q).length) + fun q => + (encPair (encPair encUnary (encPair (encList eTape) (encList eTape))) eTape q).length := by + have hq := fst (encPair encUnary (encPair (encList eTape) (encList eTape))) eTape + have ht := snd (encPair encUnary (encPair (encList eTape) (encList eTape))) eTape + have hrest := hq.snd'.fst' + have hacc := hq.snd'.snd' + have htail := (ComputableTidilyInDegree.listTail eTape).inO_one.comp_linear hrest + have hempty := (ComputableTidilyInDegree.listIsEmpty eTape).inO_one.comp_linear hrest + have hhead := (ComputableTidilyInDegree.listHeadD eTape default).inO_one.comp_linear hrest + have hpaste := paste_inO.comp_linear (hq.fst'.prod (ht.prod hhead)) + have hsnoc := (ComputableTidilyInDegree.snoc eTape).inO_one.comp_linear (hacc.prod hpaste) + refine ((htail.prod (hempty.ite hacc hsnoc)).of_enc_eq + (g := fun q : (ℕ × List Tape × List Tape) × Tape => restoreStep q.1.1 q.1.2 q.2) + fun _ => rfl).mono 16 (fun q => ?_) fun q => ?_ <;> + · simp only [Function.comp_apply] + split_ifs <;> omega /-- **Pasting windows back**, in time linear in the encoded windows for each window. -/ theorem restore_inO : ComputableInO (fun p : ℕ × Win × Win => restore p.1 p.2.1 p.2.2) (encPair encUnary (encPair eWin eWin)) eWin (fun p => (p.2.1.2.length + 1) * ((encPair encUnary (encPair eWin eWin) p).length + 1)) - (fun p => (p.2.1.2.length + 1) * ((encPair encUnary (encPair eWin eWin) p).length + 1)) := - sorry + (fun p => (p.2.1.2.length + 1) * ((encPair encUnary (encPair eWin eWin) p).length + 1)) := by + have hr := fst encUnary (encPair eWin eWin) + have ho := (snd encUnary (encPair eWin eWin)).fst' + have hi := (snd encUnary (encPair eWin eWin)).snd' + -- the states of the fold + have hst (p : ℕ × Win × Win) (i : ℕ) : + (encPair (encList eTape) (encList eTape) ((p.2.1.2.take i).foldl (restoreStep p.1) + (p.2.2.2, []))).length ≤ 3 * (encPair encUnary (encPair eWin eWin) p).length := by + obtain ⟨r, ⟨so, o⟩, ⟨si, w⟩⟩ := p + rw [foldl_restoreStep] + have h₁ := length_encList_drop_le eTape w (o.take i).length + have h₂ := length_encList_zipWith_le (length_eTape_paste_le r) (o.take i) w + have h₃ := length_encList_take_le eTape o i + simp only [length_encPair, List.nil_append] at * + omega + have hfold := foldlWith (encL := encList eTape) (encB := encPair (encList eTape) (encList eTape)) + (list := fun p : ℕ × Win × Win => p.2.1.2) hr ho.snd' (hi.snd'.prod (const [])) restoreStep_inO + (R := fun p => 16 * (encPair encUnary (encPair eWin eWin) p).length + 8) + (Q := fun p => 16 * (encPair encUnary (encPair eWin eWin) p).length + 8) + (B := fun p => 3 * (encPair encUnary (encPair eWin eWin) p).length) + (fun p i hi => by + have h₁ := hst p i + have h₂ := length_le_encList_of_mem eTape (List.getElem_mem hi) + obtain ⟨r, ⟨so, o⟩, ⟨si, w⟩⟩ := p + simp only [length_encPair] at * + omega) + (fun p i hi => by + have h₁ := hst p i + have h₂ := length_le_encList_of_mem eTape (List.getElem_mem hi) + obtain ⟨r, ⟨so, o⟩, ⟨si, w⟩⟩ := p + simp only [length_encPair] at * + omega) + (fun p i _ => hst p i) + refine (((hi.fst'.prod hfold.snd').of_enc_eq (encOut := eWin) + (g := fun p : ℕ × Win × Win => restore p.1 p.2.1 p.2.2) fun ⟨r, o, i⟩ => ?_).mono 64 + (fun p => ?_) fun p => ?_).computableInO + · simp only [restore, foldl_restoreStep, List.nil_append] + all_goals + obtain ⟨r, ⟨so, o⟩, ⟨si, w⟩⟩ := p + have hN : (encPair encUnary (encPair eWin eWin) (r, (so, o), (si, w))).length = + 2 * (encUnary r).length + 1 + (2 * (2 * (eSym so).length + 1 + + (encList eTape o).length) + 1 + (2 * (eSym si).length + 1 + + (encList eTape w).length)) := by + simp only [length_encPair] + simp only [hN, length_encPair] at * + generalize (encUnary r).length = R at * + generalize (encList eTape o).length = L at * + generalize (encList eTape w).length = M at * + generalize (eSym so).length = S at * + generalize (eSym si).length = S' at * + nlinarith + +/-! ### Halving in unary -/ + +/-- The transducer emitting a symbol on every other input symbol: from the first one on if +started in `false`, from the second one on if started in `true`. -/ +private def halfT (start : Bool) : Transducer Bool Bool where + q₀ := start + step q _ := (!q, if q then [] else [true]) + final _ := [] + length_step_le q _ := by cases q <;> simp + length_final_le _ := by simp -/-- **A windowed step**, in time cubic in the encoded description and windows. -/ -theorem wstep_inO : - ComputableInO (fun p : Desc × Win => wstep p.1 p.2) (encPair eDesc eWin) (encPair eWin eSym) - (fun p => ((encPair eDesc eWin p).length + 1) ^ 3) - (fun p => ((encPair eDesc eWin p).length + 1) ^ 3) := - sorry +private lemma run_halfT (start : Bool) (n : ℕ) : + (halfT start).run false (List.replicate n true) = List.replicate (n - n / 2) true ∧ + (halfT start).run true (List.replicate n true) = List.replicate (n / 2) true := by + induction n with + | zero => simp [halfT] + | succ n ih => + have h₁ : (halfT start).step false true = (true, [true]) := rfl + have h₂ : (halfT start).step true true = (false, []) := rfl + rw [List.replicate_succ, Transducer.run_cons, Transducer.run_cons, h₁, h₂, ih.1, ih.2] + refine ⟨?_, ?_⟩ + · rw [List.singleton_append, ← List.replicate_succ] + congr 1 + omega + · rw [List.nil_append] + congr 1 + omega /-- The first half of a number of steps, in unary, in linear time. -/ theorem firstHalf_inO : ComputableInO firstHalf encUnary encUnary (fun n => (encUnary n).length) (fun n => (encUnary n).length) := - sorry + (of_linear ((halfT false).computableTidilyInLinearTimeAndSpace fun n => + (run_halfT false n).1.symm)).computableInO /-- Half a number of steps, rounded down, in unary, in linear time. -/ theorem half_inO : ComputableInO (· / 2) encUnary encUnary (fun n => (encUnary n).length) (fun n => (encUnary n).length) := - sorry + (of_linear ((halfT true).computableTidilyInLinearTimeAndSpace fun n => + (run_halfT true n).2.symm)).computableInO end Turing.MultiTapeTM.Universal.Windowed From 906373c5793f0f5125eb9895d00e84330c99a041 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:31:00 +0000 Subject: [PATCH 13/40] wip(stack-loop): runs between shifted configurations and word-moving machines (#800) --- .../MultiTape/Plumbing/RunsBetween.lean | 450 +++++++++++++++++ .../Turing/MultiTape/Plumbing/WordMoves.lean | 457 ++++++++++++++++++ 2 files changed, 907 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean new file mode 100644 index 0000000000..76cc9da0fb --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean @@ -0,0 +1,450 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Cslib.Computability.Machines.Turing.MultiTape.Plumbing.RepeatUntilBlank +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.Sequential +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.ExtendTapesView +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.TransformsTapes +public import Complexity.Computability.Machines.Turing.MultiTape.Deterministic +import Mathlib.Tactic.Ring + +/-! +# Runs between configurations with shifted words + +`Turing.MultiTapeTM.TransformsTapes` describes machines that start and halt with every word at +the start of its tape and every head on the first cell of its word. Some machines keep a word at a +drifting position, for example a stack that grows to the left. This file describes runs between +arbitrary configurations and transports specifications to configurations whose words sit anywhere. + +`Turing.Cfg.shift δ` moves the contents and the head of every work tape `i` by `δ i` cells. Machines +are translation invariant (`Turing.MultiTapeTM.runFrom_shift`), so a run from a shifted +configuration is the shifted run. `Turing.tapesCfg input ws o h out` is the configuration whose tape +`i` holds the word `ws i` from cell `o i` on, with its head at cell `h i`; a `wordsCfg` +configuration shifted by `δ` is `tapesCfg input ws δ δ out`. + +`Turing.MultiTapeTM.RunsBetween tm c c' t s` says that `tm`, started in its initial state on the +tapes of `c`, has halted on the tapes of `c'` after `t` steps, using at most `s` cells. Such runs +compose sequentially, embed into machines with more tapes, follow from `TransformsTapes` +specifications at any shift, and accumulate along the loop `Turing.MultiTapeTM.loopWhile`. + +## Main definitions + +* `Turing.Cfg.shift`, `Turing.tapesCfg`: shifted configurations. +* `Turing.MultiTapeTM.RunsBetween`: a run between two configurations within bounds. +* `Turing.MultiTapeTM.loopWhile`: run a machine while a condition on the scanned work-tape symbols + holds. + +## Main results + +* `Turing.MultiTapeTM.runFrom_shift`, `Turing.MultiTapeTM.space_shift`: translation invariance. +* `Turing.MultiTapeTM.RunsBetween.seq`, `.extendTapes`, `.of_transformsTapes`: composition. +* `Turing.MultiTapeTM.runsBetween_loopWhile`: loops, with the costs of the rounds adding up. +-/ + +@[expose] public section + +namespace Turing + +variable {k k' : ℕ} {Symbol State : Type*} {input : List Symbol} + +/-- The configuration with the contents and the head of every work tape `i` moved by `δ i` cells to +the right. -/ +def Cfg.shift (δ : Fin k → ℤ) (c : Cfg k Symbol State input) : Cfg k Symbol State input := + ⟨c.state, c.inputPos, fun i z => c.workTapes i (z - δ i), fun i => c.workTapePos i + δ i, + c.output⟩ + +@[simp] +lemma Cfg.shift_withState (δ : Fin k → ℤ) (c : Cfg k Symbol State input) {State' : Type*} + (q : Option State') : (c.shift δ).withState q = (c.withState q).shift δ := rfl + +/-- The configuration whose work tape `i` holds the word `ws i` from cell `o i` on, with its head at +cell `h i`, the input head at the start of the input and the output `out`. Its state is irrelevant +for `Turing.MultiTapeTM.RunsBetween`. -/ +def tapesCfg (input : List Symbol) (ws : Fin k → List Symbol) (o h : Fin k → ℤ) + (out : List Symbol) : Cfg k Symbol Unit input := + ⟨none, 1, fun i z => tapeOfList (ws i) (z - o i), h, out⟩ + +@[simp] +lemma tapesCfg_workTapes (ws : Fin k → List Symbol) (o h : Fin k → ℤ) (out : List Symbol) + (i : Fin k) (z : ℤ) : + (tapesCfg input ws o h out).workTapes i z = tapeOfList (ws i) (z - o i) := rfl + +@[simp] +lemma tapesCfg_workTapePos (ws : Fin k → List Symbol) (o h : Fin k → ℤ) (out : List Symbol) : + (tapesCfg input ws o h out).workTapePos = h := rfl + +/-- The symbol under the head of a tape of a `tapesCfg` configuration. -/ +lemma tapesCfg_workTapeSymbols (ws : Fin k → List Symbol) (o h : Fin k → ℤ) (out : List Symbol) + (i : Fin k) : + (tapesCfg input ws o h out).workTapeSymbols i = tapeOfList (ws i) (h i - o i) := rfl + +/-- With every head on the first cell of its word, the scanned symbols are the first letters. -/ +lemma tapesCfg_workTapeSymbols_self (ws : Fin k → List Symbol) (o : Fin k → ℤ) + (out : List Symbol) (i : Fin k) : + (tapesCfg input ws o o out).workTapeSymbols i = (ws i).head? := by + rw [tapesCfg_workTapeSymbols, sub_self, tapeOfList_zero] + +lemma shift_tapesCfg (ws : Fin k → List Symbol) (o h δ : Fin k → ℤ) (out : List Symbol) : + (tapesCfg input ws o h out).shift δ = + tapesCfg input ws (fun i => o i + δ i) (fun i => h i + δ i) out := by + refine Cfg.ext rfl rfl ?_ rfl rfl + funext i z + simp only [Cfg.shift, tapesCfg] + congr 1 + ring + +lemma tapesCfg_zero_withState (ws : Fin k → List Symbol) (out : List Symbol) (q : Option State) : + (tapesCfg input ws 0 0 out).withState q = wordsCfg input q ws out := by + refine Cfg.ext rfl rfl ?_ rfl rfl + funext i z + simp [tapesCfg, wordsCfg] + +/-- A `wordsCfg` configuration, shifted. -/ +lemma wordsCfg_shift (ws : Fin k → List Symbol) (δ : Fin k → ℤ) (out : List Symbol) + (q : Option State) : + (wordsCfg input q ws out).shift δ = (tapesCfg input ws δ δ out).withState q := by + rw [← tapesCfg_zero_withState, ← Cfg.shift_withState, shift_tapesCfg] + simp + +namespace MultiTapeTM + +/-! ### Translation invariance -/ + +/-- One step of a machine commutes with shifting the work tapes. -/ +theorem step_shift (tm : MultiTapeTM k Symbol State) (δ : Fin k → ℤ) + (c : Cfg k Symbol State input) : tm.step (c.shift δ) = (tm.step c).shift δ := by + cases hq : c.state with + | none => + have hq' : (c.shift δ).state = none := hq + rw [step_of_halt hq', step_of_halt hq] + | some q => + have hq' : (c.shift δ).state = some q := hq + rw [step_of_state hq', step_of_state hq] + have hw : (c.shift δ).workTapeSymbols = c.workTapeSymbols := by + funext i + simp [Cfg.workTapeSymbols, Cfg.shift] + have hin : (c.shift δ).inputSymbol = c.inputSymbol := rfl + rw [hw, hin] + refine Cfg.ext rfl rfl ?_ ?_ rfl + · funext i z + simp only [Action.apply, Cfg.shift] + generalize ((tm.tr q c.inputSymbol c.workTapeSymbols).workTapes i).1 = w + cases w with + | none => rfl + | some s => simp only [Function.update_apply, sub_eq_iff_eq_add] + · funext i + simp only [Action.apply, Cfg.shift] + ring + +/-- **Translation invariance.** The run from a shifted configuration is the shifted run. -/ +theorem runFrom_shift (tm : MultiTapeTM k Symbol State) (δ : Fin k → ℤ) + (c : Cfg k Symbol State input) (t : ℕ) : tm.runFrom (c.shift δ) t = (tm.runFrom c t).shift δ := by + induction t with + | zero => rfl + | succ t ih => rw [runFrom_succ, runFrom_succ, ih, step_shift] + +/-- A shifted run visits as many cells as the run. -/ +theorem space_shift (tm : MultiTapeTM k Symbol State) (δ : Fin k → ℤ) + (c : Cfg k Symbol State input) (t : ℕ) : + (MultiTapeNTM.RunPath.ofDeterministic tm (c.shift δ) t).space = + (MultiTapeNTM.RunPath.ofDeterministic tm c t).space := by + have h (i : Fin k) : (MultiTapeNTM.RunPath.ofDeterministic tm (c.shift δ) t).visitedByTapeHead i = + ((MultiTapeNTM.RunPath.ofDeterministic tm c t).visitedByTapeHead i).image (· + δ i) := by + ext z + simp only [MultiTapeNTM.RunPath.mem_visitedByTapeHead_ofDeterministic, Finset.mem_image, + runFrom_shift] + constructor + · rintro ⟨m, hm, rfl⟩ + exact ⟨_, ⟨m, hm, rfl⟩, rfl⟩ + · rintro ⟨_, ⟨m, hm, rfl⟩, rfl⟩ + exact ⟨m, hm, rfl⟩ + simp only [MultiTapeNTM.RunPath.space, MultiTapeNTM.RunPath.spaceUsedByTape, h, + Finset.card_image_of_injective _ (add_left_injective _)] + +/-! ### Runs between configurations -/ + +/-- `RunsBetween tm c c' t s`: started in its initial state on the tapes, heads and output of `c`, +the machine has halted after `t` steps on those of `c'`, having visited at most `s` cells. The +states of `c` and `c'` are ignored. -/ +def RunsBetween (tm : MultiTapeTM k Symbol State) (c c' : Cfg k Symbol Unit input) (t s : ℕ) : + Prop := + tm.runFrom (c.withState (some tm.q₀)) t = c'.withState none ∧ + (MultiTapeNTM.RunPath.ofDeterministic tm (c.withState (some tm.q₀)) t).space ≤ s + +namespace RunsBetween + +variable {tm : MultiTapeTM k Symbol State} {c c' : Cfg k Symbol Unit input} {t s t' s' : ℕ} + +/-- Larger bounds: a halted machine stays where it is. -/ +theorem mono (h : RunsBetween tm c c' t s) (ht : t ≤ t') (hs : s ≤ s') : + RunsBetween tm c c' t' s' := by + have hhalt : (tm.runFrom (c.withState (some tm.q₀)) t).state = none := by rw [h.1]; rfl + exact ⟨by rw [runFrom_eq_of_halt _ _ ht hhalt, h.1], + by rw [space_eq_of_halt _ ht hhalt]; exact h.2.trans hs⟩ + +/-- A run to a halted configuration: its space is at most one cell per tape and configuration. -/ +theorem of_runFrom (h : tm.runFrom (c.withState (some tm.q₀)) t = c'.withState none) : + RunsBetween tm c c' t (k * (t + 1)) := + ⟨h, MultiTapeNTM.RunPath.space_le_mul_time_add_one _⟩ + +/-- A run between shifted configurations. -/ +theorem shift (h : RunsBetween tm c c' t s) (δ : Fin k → ℤ) : + RunsBetween tm (c.shift δ) (c'.shift δ) t s := by + refine ⟨?_, ?_⟩ + · rw [Cfg.shift_withState, runFrom_shift, h.1] + rfl + · rw [Cfg.shift_withState, space_shift] + exact h.2 + +open Sequential in +/-- **Sequential composition.** -/ +theorem seq {State₁ : Type*} {tm₁ : MultiTapeTM k Symbol State₁} {c'' : Cfg k Symbol Unit input} + {t₁ s₁ : ℕ} (h₀ : RunsBetween tm c c' t s) (h₁ : RunsBetween tm₁ c' c'' t₁ s₁) : + RunsBetween (tm.seq tm₁) c c'' (t + t₁) (s + s₁) := by + have hl : c.withState (some (tm.seq tm₁).q₀) = leftCfg tm₁ (c.withState (some tm.q₀)) := rfl + have hmid : (c'.withState (none : Option State)).Halted := rfl + refine ⟨?_, ?_⟩ + · rw [hl, runFrom_seq h₀.1 hmid h₁.1 rfl] + rfl + · rw [hl] + refine (space_seq_le h₀.1 hmid ?_).trans (Nat.add_le_add h₀.2 h₁.2) + rw [show (c'.withState (none : Option State)).withState (some tm₁.q₀) = + c'.withState (some tm₁.q₀) from rfl, h₁.1] + rfl + +/-- **A run on the tapes selected by an embedding.** The other tapes are left alone; each costs +one cell. -/ +theorem extendTapes (e : Fin k ↪ Fin k') {c : Cfg k' Symbol Unit input} + {d : Cfg k Symbol Unit input} (h : RunsBetween tm (viewCfg e c) d t s) : + RunsBetween (tm.extendTapes e) c (embed e d c.workTapes c.workTapePos) t (s + (k' - k)) := by + refine ⟨?_, ?_⟩ + · rw [runFrom_extendTapes] + exact congrArg (fun d => embed e d c.workTapes c.workTapePos) h.1 + · exact (space_extendTapes_le tm e _ t).trans (Nat.add_le_add_right h.2 _) + +/-- A `TransformsTapes` specification, read as runs between shifted word configurations. -/ +theorem of_transformsTapes + {P : (input : List Symbol) → (Fin k → List Symbol) → Prop} + {Q : (input : List Symbol) → (Fin k → List Symbol) → (Fin k → List Symbol) → + List Symbol → Prop} (h : TransformsTapes tm P Q t s) {ws : Fin k → List Symbol} + (hP : P input ws) (δ : Fin k → ℤ) (out : List Symbol) : + ∃ ws' e, Q input ws ws' e ∧ + RunsBetween tm (tapesCfg input ws δ δ out) (tapesCfg input ws' δ δ (out ++ e)) t s := by + obtain ⟨ws', e, hrun, hQ, hsp⟩ := transformsTapes_iff_runFrom.mp h input ws out hP + have h0 : RunsBetween tm (tapesCfg input ws 0 0 out) (tapesCfg input ws' 0 0 (out ++ e)) t s := + ⟨by rw [tapesCfg_zero_withState, tapesCfg_zero_withState, hrun], + by rw [tapesCfg_zero_withState]; exact hsp⟩ + refine ⟨ws', e, hQ, ?_⟩ + have := h0.shift δ + rw [shift_tapesCfg, shift_tapesCfg] at this + simpa only [Pi.zero_apply, zero_add] using this + +/-- A `TransformsTapes` specification whose postcondition determines the words and the emitted +word, read as a run between shifted word configurations. -/ +theorem of_transformsTapes_eq + {P : (input : List Symbol) → (Fin k → List Symbol) → Prop} {ws ws' : Fin k → List Symbol} + {e : List Symbol} + (h : TransformsTapes tm P (fun _ _ ws'' e' => ws'' = ws' ∧ e' = e) t s) + (hP : P input ws) (δ : Fin k → ℤ) (out : List Symbol) : + RunsBetween tm (tapesCfg input ws δ δ out) (tapesCfg input ws' δ δ (out ++ e)) t s := by + obtain ⟨_, _, ⟨rfl, rfl⟩, h'⟩ := of_transformsTapes h hP δ out + exact h' + +end RunsBetween + +/-- Viewing the tapes of a `tapesCfg` configuration through an embedding. -/ +@[simp] +lemma viewCfg_tapesCfg (e : Fin k ↪ Fin k') (ws : Fin k' → List Symbol) (o h : Fin k' → ℤ) + (out : List Symbol) : + viewCfg e (tapesCfg input ws o h out) = + tapesCfg input (fun j => ws (e j)) (fun j => o (e j)) (fun j => h (e j)) out := rfl + +/-- Placing a `tapesCfg` configuration on the tapes selected by an embedding, the other tapes of +another one. -/ +lemma embed_tapesCfg (e : Fin k ↪ Fin k') {v : Fin k → List Symbol} {ov hv : Fin k → ℤ} + {ws ws' : Fin k' → List Symbol} {o h o' h' : Fin k' → ℤ} {out : List Symbol} + (hsel : ∀ j, ws' (e j) = v j ∧ o' (e j) = ov j ∧ h' (e j) = hv j) + (hother : ∀ l ∉ Set.range e, ws' l = ws l ∧ o' l = o l ∧ h' l = h l) : + embed e (tapesCfg input v ov hv out) (tapesCfg input ws o h out).workTapes + (tapesCfg input ws o h out).workTapePos = tapesCfg input ws' o' h' out := by + refine Cfg.ext rfl rfl (funext fun l => ?_) (funext fun l => ?_) rfl + · rcases hl : partialInv e l with _ | j + · have hx := hother l fun ⟨j, hj⟩ => by simp [← hj] at hl + simp only [embed, hl, tapesCfg, hx.1, hx.2.1] + · have := partialInv_eq_some e hl + subst this + simp only [embed, hl, tapesCfg, (hsel j).1, (hsel j).2.1] + · rcases hl : partialInv e l with _ | j + · have hx := hother l fun ⟨j, hj⟩ => by simp [← hj] at hl + simp only [embed, hl, tapesCfg, hx.2.2] + · have := partialInv_eq_some e hl + subst this + simp only [embed, hl, tapesCfg, (hsel j).2.2] + +/-- **One step from a `tapesCfg` configuration**, for an action that keeps the input head and emits +nothing: each tape is written and moved as the action says. -/ +theorem step_tapesCfg {tm : MultiTapeTM k Symbol State} {q : State} + {ws ws' : Fin k → List Symbol} {o h o' h' : Fin k → ℤ} {out : List Symbol} + {a : Action k Symbol State} + (ha : tm.tr q (tapesCfg input ws o h out).inputSymbol + (fun i => tapeOfList (ws i) (h i - o i)) = a) + (hin : a.inputTape = 0) (hout : a.output = none) + (htape : ∀ i, (match (a.workTapes i).1 with + | none => fun z => tapeOfList (ws i) (z - o i) + | some s => Function.update (fun z => tapeOfList (ws i) (z - o i)) (h i) s) = + fun z => tapeOfList (ws' i) (z - o' i)) + (hhead : ∀ i, h i + ((a.workTapes i).2 : ℤ) = h' i) : + tm.step ((tapesCfg input ws o h out).withState (some q)) = + (tapesCfg input ws' o' h' out).withState a.state := by + rw [step_of_state rfl] + change (tm.tr q (tapesCfg input ws o h out).inputSymbol + (fun i => tapeOfList (ws i) (h i - o i))).apply _ = _ + rw [ha] + refine Cfg.ext rfl ?_ (funext htape) (funext hhead) ?_ + · simp [Action.apply, hin, tapesCfg, Cfg.withState] + · simp [Action.apply, hout, tapesCfg, Cfg.withState] + +/-! ### Loops -/ + +/-- `loopWhile c tm` reads the symbols under the work-tape heads and halts unless `c` holds of +them; otherwise it runs `tm` and repeats. Reading moves no head and writes nothing. -/ +noncomputable def loopWhile (c : (Fin k → Option Symbol) → Bool) + (tm : MultiTapeTM k Symbol State) : MultiTapeTM k Symbol (RepeatUntilBlankState State) := + ofTr .check fun q inp work => + match q with + | .run q => + let a := tm.tr q inp work + { a with state := some (a.state.elim .check .run) } + | .check => + { inputTape := 0, workTapes := fun _ => (none, 0), output := none, + state := if c work then some (.run tm.q₀) else none } + +namespace LoopWhile + +variable {c : (Fin k → Option Symbol) → Bool} {tm : MultiTapeTM k Symbol State} + +/-- A configuration of `tm` as one of `loopWhile c tm`. -/ +def runCfg (cfg : Cfg k Symbol State input) : Cfg k Symbol (RepeatUntilBlankState State) input := + cfg.mapState (fun st => some (st.elim .check .run)) + +lemma step_runCfg (cfg : Cfg k Symbol State input) (h : ¬ cfg.Halted) : + (loopWhile c tm).step (runCfg cfg) = runCfg (tm.step cfg) := by + obtain ⟨q, hq⟩ := Option.ne_none_iff_exists'.mp h + have hstate : (runCfg cfg).state = some (RepeatUntilBlankState.run q) := by + simp [runCfg, Cfg.mapState, hq] + rw [step_of_state hstate, step_of_state hq] + simp only [loopWhile, tr_ofTr] + rfl + +lemma runFrom_runCfg {cfg : Cfg k Symbol State input} {u n : ℕ} (hhalt : tm.HaltsAt cfg u) + (hn : n ≤ u) : + (loopWhile c tm).runFrom (runCfg cfg) n = runCfg (tm.runFrom cfg n) := by + induction n with + | zero => rfl + | succ n ih => + rw [runFrom_succ, runFrom_succ, ih (by lia), step_runCfg _ (hhalt.not_halted (by lia))] + +lemma step_check (d : Cfg k Symbol Unit input) : + (loopWhile c tm).step (d.withState (some .check)) = + d.withState (if c d.workTapeSymbols then some (.run tm.q₀) else none) := by + rw [step_of_state rfl] + have hw : (d.withState (some (RepeatUntilBlankState.check : RepeatUntilBlankState State)) + ).workTapeSymbols = d.workTapeSymbols := rfl + rw [hw] + refine Cfg.ext ?_ ?_ ?_ ?_ ?_ <;> + simp [loopWhile, Action.apply, Cfg.withState] + +/-- One round: from `check` with the condition holding, the loop runs `tm` and is back in +`check`. -/ +lemma exists_round {d d' : Cfg k Symbol Unit input} {t s : ℕ} (hc : c d.workTapeSymbols = true) + (h : RunsBetween tm d d' t s) : + ∃ u ≤ t, (loopWhile c tm).runFrom (d.withState (some .check)) (u + 1) = + d'.withState (some .check) ∧ + (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) (d.withState (some .check)) + (1 + u)).space ≤ s + k := by + obtain ⟨u, hu, hhalt⟩ := exists_haltsAt (tm := tm) + (show (tm.runFrom (d.withState (some tm.q₀)) t).Halted by rw [h.1]; rfl) + have hstart : (loopWhile c tm).step (d.withState (some .check)) = + runCfg (d.withState (some tm.q₀)) := by + rw [step_check, hc] + rfl + have hrun : (loopWhile c tm).runFrom (d.withState (some .check)) (1 + u) = + d'.withState (some .check) := by + rw [runFrom_add, runFrom_one, hstart, runFrom_runCfg hhalt le_rfl, ← hhalt.runFrom_eq hu, h.1] + rfl + refine ⟨u, hu, by rw [Nat.add_comm]; exact hrun, ?_⟩ + have h1 : (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) (d.withState (some .check)) + 1).space ≤ k := by + refine space_le_of_workTapePos_const _ 1 fun m hm => ?_ + rcases (by omega : m = 0 ∨ m = 1) with rfl | rfl + · rfl + · rw [runFrom_one, step_check] + rfl + have h2 : (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) + ((loopWhile c tm).runFrom (d.withState (some .check)) 1) u).space ≤ s := by + rw [runFrom_one, hstart, space_eq_of_workTapePos (tm' := tm) _ (d.withState (some tm.q₀)) u + fun m hm => by rw [runFrom_runCfg hhalt hm]; rfl] + exact (space_mono tm _ hu).trans h.2 + have := (space_add_le (tm := loopWhile c tm) (d.withState (some .check)) 1 u).trans + (Nat.add_le_add h1 h2) + omega + +end LoopWhile + +open LoopWhile in +/-- **Loops.** If `c` holds at the configurations `cfg i` for `i < n`, from each of which `tm` +runs to `cfg (i + 1)`, and fails at `cfg n`, then `loopWhile c tm` runs from `cfg 0` to `cfg n`. +The times of the rounds add up, with one step per round to read the condition. -/ +theorem runsBetween_loopWhile {c : (Fin k → Option Symbol) → Bool} + {tm : MultiTapeTM k Symbol State} (cfg : ℕ → Cfg k Symbol Unit input) (n : ℕ) (t s : ℕ → ℕ) + (hround : ∀ i < n, c (cfg i).workTapeSymbols = true ∧ + RunsBetween tm (cfg i) (cfg (i + 1)) (t i) (s i)) + (hstop : c (cfg n).workTapeSymbols = false) : + RunsBetween (loopWhile c tm) (cfg 0) (cfg n) (∑ i ∈ Finset.range n, (t i + 1) + 1) + (∑ i ∈ Finset.range n, (s i + k) + 2 * k) := by + set start := (cfg 0).withState (some (loopWhile c tm).q₀) with hstart + have hrec : ∀ m ≤ n, ∃ τ ≤ ∑ i ∈ Finset.range m, (t i + 1), + (loopWhile c tm).runFrom start τ = (cfg m).withState (some .check) ∧ + (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) start τ).space ≤ + ∑ i ∈ Finset.range m, (s i + k) + k := by + intro m hm + induction m with + | zero => exact ⟨0, le_rfl, rfl, by + simpa using space_le_of_workTapePos_const (tm := loopWhile c tm) start 0 + fun m hm => by rw [Nat.le_zero.mp hm]; rfl⟩ + | succ m ih => + obtain ⟨τ, hτ, hrun, hsp⟩ := ih (by lia) + obtain ⟨hc, hr⟩ := hround m (by lia) + obtain ⟨u, hu, hrun', hsp'⟩ := exists_round hc hr + refine ⟨τ + (1 + u), by rw [Finset.sum_range_succ]; lia, ?_, ?_⟩ + · rw [runFrom_add, hrun, Nat.add_comm 1 u, hrun'] + · refine (space_add_le _ τ (1 + u)).trans ?_ + rw [hrun, Finset.sum_range_succ] + have := Nat.add_le_add hsp hsp' + omega + obtain ⟨τ, hτ, hrun, hsp⟩ := hrec n le_rfl + have hfinal : (loopWhile c tm).runFrom start (τ + 1) = (cfg n).withState none := by + rw [runFrom_succ, hrun, step_check, hstop] + rfl + have hhalt : ((loopWhile c tm).runFrom start (τ + 1)).state = none := by rw [hfinal]; rfl + refine ⟨by rw [runFrom_eq_of_halt _ _ (by lia) hhalt, hfinal], ?_⟩ + rw [space_eq_of_halt _ (by lia) hhalt] + have h1 : (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) + ((loopWhile c tm).runFrom start τ) 1).space ≤ k := by + refine space_le_of_workTapePos_const _ 1 fun m hm => ?_ + rcases (by omega : m = 0 ∨ m = 1) with rfl | rfl + · rfl + · rw [hrun, runFrom_one, step_check] + rfl + have := (space_add_le (tm := loopWhile c tm) start τ 1).trans (Nat.add_le_add hsp h1) + omega + +end MultiTapeTM + +end Turing diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean new file mode 100644 index 0000000000..2e1463c7a8 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean @@ -0,0 +1,457 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.RunsBetween +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Frame.Basic +public import Mathlib.Data.Fin.VecNotation +import Mathlib.Tactic.FinCases + +/-! +# Moving words between the ends of tapes + +Small native machines that move a word along its tape or between two tapes, specified by runs +between `Turing.tapesCfg` configurations (`Turing.MultiTapeTM.RunsBetween`), so that the words may +sit anywhere on their tapes. They implement a stack kept on a tape that grows to the left. + +## Main definitions + +* `Turing.MultiTapeTM.seekEnd`: move the head from the first cell of a word to the cell after it. +* `Turing.MultiTapeTM.copyBack`: move a word, read from its end, to the front of the word on a + second tape. +* `Turing.MultiTapeTM.eraseFrame`: erase a framed word (`Cslib.frame`) at the front of a tape. +* `Turing.MultiTapeTM.popFrame`: move a framed word at the front of a tape to the end of a word on + a second tape, prefixed by `[true, true]`, or write `[false]` if the first tape is blank. + +## Main results + +* `Turing.MultiTapeTM.runsBetween_seekEnd`, `Turing.MultiTapeTM.runsBetween_copyBack`, + `Turing.MultiTapeTM.runsBetween_eraseFrame`, `Turing.MultiTapeTM.runsBetween_popFrame_nil`, + `Turing.MultiTapeTM.runsBetween_popFrame_frame`: their runs, in time linear in the words moved. +-/ + +@[expose] public section + +namespace Turing + +variable {Symbol : Type*} {input : List Symbol} + +/-! ### Shifted words -/ + +lemma tapeOfList_eq_ite (w : List Symbol) (z : ℤ) : + tapeOfList w z = if 0 ≤ z then w[z.toNat]? else none := by + cases z with + | ofNat n => simp + | negSucc n => simp + +lemma tapeOfList_natCast (w : List Symbol) (n : ℕ) : tapeOfList w (n : ℤ) = w[n]? := rfl + +lemma tapeOfList_cons_of_ne (x : Symbol) (l : List Symbol) {z : ℤ} (hz : z ≠ 0) : + tapeOfList (x :: l) z = tapeOfList l (z - 1) := by + rcases z with (_ | n) | n + · exact absurd rfl hz + · show tapeOfList (x :: l) ((n + 1 : ℕ) : ℤ) = tapeOfList l (((n + 1 : ℕ) : ℤ) - 1) + have h : ((n + 1 : ℕ) : ℤ) - 1 = (n : ℤ) := by omega + rw [h] + rfl + · rw [tapeOfList_negSucc, ((tapeOfList_eq_none_iff _ _).mpr (Or.inl (by omega)))] + +/-- Writing after the end of a shifted word appends to it. -/ +lemma update_shifted_append (w : List Symbol) (x : Symbol) (o : ℤ) : + Function.update (fun z => tapeOfList w (z - o)) (o + w.length) (some x) = + fun z => tapeOfList (w ++ [x]) (z - o) := by + funext z + rw [tapeOfList_append_single] + by_cases hz : z = o + w.length + · subst hz + simp + · rw [Function.update_of_ne hz, Function.update_of_ne (by omega)] + +/-- Erasing the first cell of a shifted word drops its first letter. -/ +lemma update_shifted_cons_none (x : Symbol) (l : List Symbol) (o : ℤ) : + Function.update (fun z => tapeOfList (x :: l) (z - o)) o none = + fun z => tapeOfList l (z - (o + 1)) := by + funext z + by_cases hz : z = o + · subst hz + rw [Function.update_self] + exact ((tapeOfList_eq_none_iff _ _).mpr (by omega)).symm + · rw [Function.update_of_ne hz, tapeOfList_cons_of_ne _ _ (by omega)] + congr 1 + omega + +/-- Erasing the last cell of a shifted word drops its last letter. -/ +lemma update_shifted_append_none (l : List Symbol) (x : Symbol) (o : ℤ) : + Function.update (fun z => tapeOfList (l ++ [x]) (z - o)) (o + l.length) none = + fun z => tapeOfList l (z - o) := by + funext z + by_cases hz : z = o + l.length + · subst hz + rw [Function.update_self] + exact ((tapeOfList_eq_none_iff _ _).mpr (by omega)).symm + · rw [Function.update_of_ne hz, tapeOfList_append_single, Function.update_of_ne (by omega)] + +/-- Writing before the first cell of a shifted word prepends to it. -/ +lemma update_shifted_pred (v : List Symbol) (x : Symbol) (o : ℤ) : + Function.update (fun z => tapeOfList v (z - o)) (o - 1) (some x) = + fun z => tapeOfList (x :: v) (z - (o - 1)) := by + funext z + by_cases hz : z = o - 1 + · subst hz + simp [tapeOfList_zero] + · rw [Function.update_of_ne hz, tapeOfList_cons_of_ne _ _ (by omega)] + congr 1 + omega + +/-- The first letter of a shifted word, read at its first cell. -/ +lemma tapeOfList_cons_sub_self (x : Symbol) (l : List Symbol) (o : ℤ) : + tapeOfList (x :: l) (o - o) = some x := by + rw [sub_self, tapeOfList_zero] + rfl + +/-- The cell after a shifted word is blank. -/ +lemma tapeOfList_add_length_sub (w : List Symbol) (o : ℤ) : + tapeOfList w (o + w.length - o) = none := by + rw [tapeOfList_eq_none_iff] + omega + +/-- The cell before a shifted word is blank. -/ +lemma tapeOfList_sub_one_sub (w : List Symbol) (o : ℤ) : tapeOfList w (o - 1 - o) = none := by + rw [tapeOfList_eq_none_iff] + omega + +namespace MultiTapeTM + +/-- A run of one more step, split after its first step. -/ +lemma runFrom_succ_eq_step {k : ℕ} {State : Type*} (tm : MultiTapeTM k Symbol State) + (c : Cfg k Symbol State input) (n : ℕ) : tm.runFrom c (n + 1) = tm.runFrom (tm.step c) n := by + rw [Nat.add_comm, runFrom_add, runFrom_one] + +/-! ### Moving the head to the end of a word -/ + +/-- Moves the head of its only tape right until it reads a blank. -/ +noncomputable def seekEnd (Symbol : Type*) : MultiTapeTM 1 Symbol Unit := + ofTr () fun _ _ work => + match work 0 with + | some _ => { inputTape := 0, workTapes := fun _ => (none, 1), output := none, state := some () } + | none => { inputTape := 0, workTapes := fun _ => (none, 0), output := none, state := none } + +theorem runFrom_seekEnd (w suf pre : List Symbol) (hw : w = pre ++ suf) (o : ℤ) + (out : List Symbol) : + (seekEnd Symbol).runFrom ((tapesCfg input (fun _ => w) (fun _ => o) + (fun _ => o + pre.length) out).withState (some ())) (suf.length + 1) = + (tapesCfg input (fun _ => w) (fun _ => o) (fun _ => o + w.length) out).withState none := by + induction suf generalizing pre with + | nil => + subst hw + simp only [List.append_nil, List.length_nil, Nat.zero_add] + rw [runFrom_one] + refine step_tapesCfg (a := ⟨0, fun _ => (none, 0), none, none⟩) ?_ rfl rfl + (fun _ => rfl) (fun _ => by simp) + simp only [seekEnd, tr_ofTr, tapeOfList_add_length_sub] + | cons x suf ih => + rw [show (x :: suf).length + 1 = 1 + (suf.length + 1) by simp; omega, runFrom_add, runFrom_one, + step_tapesCfg (a := ⟨0, fun _ => (none, 1), none, some ()⟩) + (h' := fun _ => o + (pre ++ [x]).length) ?_ rfl rfl (fun _ => rfl) (fun _ => by simp; omega)] + · exact ih (pre ++ [x]) (by simp [hw]) + · have : tapeOfList w (o + pre.length - o) = some x := by + rw [add_sub_cancel_left, tapeOfList_natCast, hw] + simp + simp only [seekEnd, tr_ofTr, this] + +theorem runsBetween_seekEnd (w : List Symbol) (o : ℤ) (out : List Symbol) : + RunsBetween (seekEnd Symbol) (tapesCfg input (fun _ => w) (fun _ => o) (fun _ => o) out) + (tapesCfg input (fun _ => w) (fun _ => o) (fun _ => o + w.length) out) + (w.length + 1) (1 * (w.length + 1 + 1)) := by + refine RunsBetween.of_runFrom ?_ + have := runFrom_seekEnd (input := input) w w [] (by simp) o out + simpa using this + +/-! ### Moving a word to the front of another -/ + +/-- The states of `Turing.MultiTapeTM.copyBack`. -/ +inductive CopyBackState + /-- Step both heads left. -/ + | first + /-- Move one letter. -/ + | loop + deriving DecidableEq + +instance : Fintype CopyBackState := ⟨{.first, .loop}, fun q => by cases q <;> simp⟩ + +/-- Started with the head of tape `0` on the cell after a word and the head of tape `1` on the +first cell of another, moves the first word letter by letter, from its end, to the front of the +second, erasing it, and halts with both heads on the first cells of their words. -/ +noncomputable def copyBack (Symbol : Type*) : MultiTapeTM 2 Symbol CopyBackState := + ofTr .first fun q _ work => + match q with + | .first => + { inputTape := 0, workTapes := fun _ => (none, -1), output := none, state := some .loop } + | .loop => + match work 0 with + | some x => + { inputTape := 0, workTapes := ![(some none, -1), (some (some x), -1)], output := none, + state := some .loop } + | none => { inputTape := 0, workTapes := fun _ => (none, 1), output := none, state := none } + +theorem runFrom_copyBack_loop (w v u : List Symbol) (oA oB oB' : ℤ) (hu : u = w ++ v) + (hB : oB' = oB - w.length) (out : List Symbol) : + (copyBack Symbol).runFrom ((tapesCfg input ![w, v] ![oA, oB] ![oA + w.length - 1, oB - 1] + out).withState (some .loop)) (w.length + 1) = + (tapesCfg input ![[], u] ![oA, oB'] ![oA, oB'] out).withState none := by + induction w using List.reverseRecOn generalizing v oB with + | nil => + subst hu hB + simp only [List.length_nil, Nat.zero_add, Nat.cast_zero, sub_zero, add_zero] + rw [runFrom_one] + refine step_tapesCfg (a := ⟨0, fun _ => (none, 1), none, none⟩) ?_ rfl rfl + (fun i => by fin_cases i <;> rfl) (fun i => by fin_cases i <;> simp) + simp only [copyBack, tr_ofTr, Matrix.cons_val_zero, tapeOfList_sub_one_sub] + | append_singleton l x ih => + rw [show (l ++ [x]).length + 1 = 1 + (l.length + 1) by simp; omega, runFrom_add, runFrom_one, + step_tapesCfg (a := ⟨0, ![(some none, -1), (some (some x), -1)], none, some .loop⟩) + (ws' := ![l, x :: v]) (o' := ![oA, oB - 1]) (h' := ![oA + l.length - 1, oB - 1 - 1]) + ?_ rfl rfl ?_ ?_] + · exact ih (x :: v) (oB - 1) (by simp [hu]) (by simp [hB]; omega) + · have hr : tapeOfList (l ++ [x]) (oA + ((l ++ [x]).length : ℤ) - 1 - oA) = some x := by + rw [show oA + ((l ++ [x]).length : ℤ) - 1 - oA = (l.length : ℕ) by simp; omega, + tapeOfList_natCast] + simp + simp only [copyBack, tr_ofTr, Matrix.cons_val_zero, hr] + · intro i + fin_cases i + · dsimp only [Fin.zero_eta, Matrix.cons_val_zero] + rw [show oA + ((l ++ [x]).length : ℤ) - 1 = oA + l.length by + simp only [List.length_append, List.length_singleton, Nat.cast_add, Nat.cast_one]; omega, + update_shifted_append_none] + · dsimp only [Fin.mk_one, Matrix.cons_val_one, Matrix.cons_val_zero] + exact update_shifted_pred v x oB + · intro i + fin_cases i + · simp; omega + · simp; omega + +theorem runsBetween_copyBack (w v : List Symbol) (oA oB : ℤ) (out : List Symbol) : + RunsBetween (copyBack Symbol) (tapesCfg input ![w, v] ![oA, oB] ![oA + w.length, oB] out) + (tapesCfg input ![[], w ++ v] ![oA, oB - w.length] ![oA, oB - w.length] out) + (w.length + 2) (2 * (w.length + 2 + 1)) := by + refine RunsBetween.of_runFrom ?_ + rw [show w.length + 2 = 1 + (w.length + 1) by omega, runFrom_add, runFrom_one, + step_tapesCfg (a := ⟨0, fun _ => (none, -1), none, some .loop⟩) + (ws' := ![w, v]) (o' := ![oA, oB]) (h' := ![oA + w.length - 1, oB - 1]) + (by simp only [copyBack, tr_ofTr, q₀_ofTr]) rfl rfl (fun i => by fin_cases i <;> rfl) + (fun i => by fin_cases i <;> simp <;> omega)] + exact runFrom_copyBack_loop w v _ oA oB _ rfl rfl out + +/-! ### Erasing a framed word -/ + +/-- The states of `Turing.MultiTapeTM.eraseFrame`. -/ +inductive EraseFrameState + /-- At the start of a pair, or at the final `false`. -/ + | loop + /-- At the second cell of a pair. -/ + | bit + deriving DecidableEq + +instance : Fintype EraseFrameState := ⟨{.loop, .bit}, fun q => by cases q <;> simp⟩ + +/-- Erases the framed word at the head of its only tape, moving right, and halts on the cell after +it. -/ +noncomputable def eraseFrame : MultiTapeTM 1 Bool EraseFrameState := + ofTr .loop fun q _ work => + match q, work 0 with + | .loop, some true => + { inputTape := 0, workTapes := fun _ => (some none, 1), output := none, state := some .bit } + | .loop, some false => + { inputTape := 0, workTapes := fun _ => (some none, 1), output := none, state := none } + | .bit, some _ => + { inputTape := 0, workTapes := fun _ => (some none, 1), output := none, state := some .loop } + | _, none => { inputTape := 0, workTapes := fun _ => (none, 0), output := none, state := none } + +theorem runFrom_eraseFrame (w rest u : List Bool) (o o' : ℤ) {input : List Bool} + (hu : u = frame w ++ rest) (ho : o' = o + (2 * w.length + 1 : ℕ)) (out : List Bool) : + eraseFrame.runFrom ((tapesCfg input (fun _ => u) (fun _ => o) (fun _ => o) out).withState + (some .loop)) (2 * w.length + 1) = + (tapesCfg input (fun _ => rest) (fun _ => o') (fun _ => o') out).withState none := by + induction w generalizing u o with + | nil => + subst hu ho + simp only [List.length_nil, Nat.mul_zero, Nat.zero_add, frame_nil, List.singleton_append] + rw [runFrom_one] + refine step_tapesCfg (a := ⟨0, fun _ => (some none, 1), none, none⟩) ?_ rfl rfl + (fun _ => update_shifted_cons_none _ _ _) (fun _ => by simp) + simp only [eraseFrame, tr_ofTr, tapeOfList_cons_sub_self] + | cons b w ih => + subst hu + rw [frame_cons, show 2 * (b :: w).length + 1 = 2 * w.length + 1 + 1 + 1 by simp; omega, + runFrom_succ_eq_step, runFrom_succ_eq_step, List.cons_append, List.cons_append, + step_tapesCfg (a := ⟨0, fun _ => (some none, 1), none, some .bit⟩) + (ws' := fun _ => b :: (frame w ++ rest)) (o' := fun _ => o + 1) (h' := fun _ => o + 1) + (by simp only [eraseFrame, tr_ofTr, tapeOfList_cons_sub_self]) rfl rfl + (fun _ => update_shifted_cons_none _ _ _) (fun _ => by simp), + step_tapesCfg (a := ⟨0, fun _ => (some none, 1), none, some .loop⟩) + (ws' := fun _ => frame w ++ rest) (o' := fun _ => o + 1 + 1) (h' := fun _ => o + 1 + 1) + (by simp only [eraseFrame, tr_ofTr, tapeOfList_cons_sub_self]) rfl rfl + (fun _ => update_shifted_cons_none _ _ _) (fun _ => by simp)] + exact ih _ (o + 1 + 1) rfl (by simp [ho]; omega) + +theorem runsBetween_eraseFrame (w rest : List Bool) (o : ℤ) {input : List Bool} + (out : List Bool) : + RunsBetween eraseFrame (tapesCfg input (fun _ => frame w ++ rest) (fun _ => o) (fun _ => o) out) + (tapesCfg input (fun _ => rest) (fun _ => o + (frame w).length) + (fun _ => o + (frame w).length) out) + (2 * w.length + 1) (1 * (2 * w.length + 1 + 1)) := + RunsBetween.of_runFrom (runFrom_eraseFrame w rest _ o _ rfl (by simp [length_frame]) out) + +/-! ### Popping a framed word -/ + +/-- The states of `Turing.MultiTapeTM.popFrame`. -/ +inductive PopFrameState + /-- Reading the first cell of tape `0`. -/ + | start + /-- Writing the second `true` of the prefix. -/ + | pre + /-- At the start of a pair, or at the final `false`. -/ + | loop + /-- At the second cell of a pair. -/ + | bit + deriving DecidableEq + +instance : Fintype PopFrameState := ⟨{.start, .pre, .loop, .bit}, fun q => by cases q <;> simp⟩ + +/-- If tape `0` is blank under its head, writes `false` at the head of tape `1`. Otherwise writes +`[true, true]` and then moves the framed word at the head of tape `0` there, erasing it. Both +heads move right as they go. -/ +noncomputable def popFrame : MultiTapeTM 2 Bool PopFrameState := + ofTr .start fun q _ work => + match q, work 0 with + | .start, none => + { inputTape := 0, workTapes := ![(none, 0), (some (some false), 1)], output := none, + state := none } + | .start, some _ => + { inputTape := 0, workTapes := ![(none, 0), (some (some true), 1)], output := none, + state := some .pre } + | .pre, _ => + { inputTape := 0, workTapes := ![(none, 0), (some (some true), 1)], output := none, + state := some .loop } + | .loop, some true => + { inputTape := 0, workTapes := ![(some none, 1), (some (some true), 1)], output := none, + state := some .bit } + | .loop, some false => + { inputTape := 0, workTapes := ![(some none, 1), (some (some false), 1)], output := none, + state := none } + | .bit, some b => + { inputTape := 0, workTapes := ![(some none, 1), (some (some b), 1)], output := none, + state := some .loop } + | _, none => { inputTape := 0, workTapes := fun _ => (none, 0), output := none, state := none } + +theorem runFrom_popFrame_loop (w rest u acc acc' : List Bool) (oS oS' oR hR' : ℤ) + {input : List Bool} (hu : u = frame w ++ rest) (hacc : acc' = acc ++ frame w) + (hS : oS' = oS + (2 * w.length + 1 : ℕ)) (hR : hR' = oR + acc'.length) (out : List Bool) : + popFrame.runFrom ((tapesCfg input ![u, acc] ![oS, oR] ![oS, oR + acc.length] out).withState + (some .loop)) (2 * w.length + 1) = + (tapesCfg input ![rest, acc'] ![oS', oR] ![oS', hR'] out).withState none := by + induction w generalizing u acc oS with + | nil => + subst hu hacc hS hR + simp only [List.length_nil, Nat.mul_zero, Nat.zero_add, frame_nil, List.singleton_append] + rw [runFrom_one] + refine step_tapesCfg (a := ⟨0, ![(some none, 1), (some (some false), 1)], none, none⟩) ?_ rfl + rfl ?_ ?_ + · simp only [popFrame, tr_ofTr, Matrix.cons_val_zero, tapeOfList_cons_sub_self] + · intro i + fin_cases i + · dsimp only [Fin.zero_eta, Matrix.cons_val_zero] + exact update_shifted_cons_none _ _ _ + · dsimp only [Fin.mk_one, Matrix.cons_val_one, Matrix.cons_val_zero] + exact update_shifted_append _ _ _ + · intro i + fin_cases i <;> simp; omega + | cons b w ih => + subst hu + rw [frame_cons, show 2 * (b :: w).length + 1 = 2 * w.length + 1 + 1 + 1 by simp; omega, + runFrom_succ_eq_step, runFrom_succ_eq_step, List.cons_append, List.cons_append, + step_tapesCfg (a := ⟨0, ![(some none, 1), (some (some true), 1)], none, some .bit⟩) + (ws' := ![b :: (frame w ++ rest), acc ++ [true]]) (o' := ![oS + 1, oR]) + (h' := ![oS + 1, oR + (acc ++ [true]).length]) + (by simp only [popFrame, tr_ofTr, Matrix.cons_val_zero, tapeOfList_cons_sub_self]) rfl rfl + (fun i => by + fin_cases i + · dsimp only [Fin.zero_eta, Matrix.cons_val_zero] + exact update_shifted_cons_none _ _ _ + · dsimp only [Fin.mk_one, Matrix.cons_val_one, Matrix.cons_val_zero] + exact update_shifted_append _ _ _) + (fun i => by fin_cases i <;> simp; omega), + step_tapesCfg (a := ⟨0, ![(some none, 1), (some (some b), 1)], none, some .loop⟩) + (ws' := ![frame w ++ rest, acc ++ [true] ++ [b]]) (o' := ![oS + 1 + 1, oR]) + (h' := ![oS + 1 + 1, oR + (acc ++ [true] ++ [b]).length]) + (by simp only [popFrame, tr_ofTr, Matrix.cons_val_zero, tapeOfList_cons_sub_self]) rfl rfl + (fun i => by + fin_cases i + · dsimp only [Fin.zero_eta, Matrix.cons_val_zero] + exact update_shifted_cons_none _ _ _ + · dsimp only [Fin.mk_one, Matrix.cons_val_one, Matrix.cons_val_zero] + exact update_shifted_append _ _ _) + (fun i => by fin_cases i <;> simp; omega)] + exact ih _ _ (oS + 1 + 1) rfl (by simp [hacc, frame_cons]) (by simp [hS]; omega) + +/-- On a blank tape `0`, `popFrame` writes `[false]`. -/ +theorem runsBetween_popFrame_nil (oS oR : ℤ) {input : List Bool} (out : List Bool) : + RunsBetween popFrame (tapesCfg input ![[], []] ![oS, oR] ![oS, oR] out) + (tapesCfg input ![[], [false]] ![oS, oR] ![oS, oR + 1] out) 1 (2 * (1 + 1)) := by + refine RunsBetween.of_runFrom ?_ + rw [runFrom_one] + refine step_tapesCfg (a := ⟨0, ![(none, 0), (some (some false), 1)], none, none⟩) ?_ rfl rfl ?_ + ?_ + · have : tapeOfList ([] : List Bool) (oS - oS) = none := by rw [tapeOfList_nil] + simp only [popFrame, tr_ofTr, q₀_ofTr, Matrix.cons_val_zero, this] + · intro i + fin_cases i + · rfl + · simpa using update_shifted_append ([] : List Bool) false oR + · intro i + fin_cases i <;> simp + +/-- On a framed word `frame w` at the head of tape `0`, `popFrame` moves it to tape `1` as +`frame (true :: w)`. -/ +theorem runsBetween_popFrame_frame (w rest : List Bool) (oS oR : ℤ) {input : List Bool} + (out : List Bool) : + RunsBetween popFrame (tapesCfg input ![frame w ++ rest, []] ![oS, oR] ![oS, oR] out) + (tapesCfg input ![rest, frame (true :: w)] ![oS + (frame w).length, oR] + ![oS + (frame w).length, oR + (frame (true :: w)).length] out) + (2 * w.length + 3) (2 * (2 * w.length + 3 + 1)) := by + refine RunsBetween.of_runFrom ?_ + obtain ⟨x, l, hxl⟩ : ∃ x l, frame w ++ rest = x :: l := by + cases w <;> exact ⟨_, _, rfl⟩ + rw [show 2 * w.length + 3 = 2 * w.length + 1 + 1 + 1 by omega, runFrom_succ_eq_step, + runFrom_succ_eq_step, + step_tapesCfg (a := ⟨0, ![(none, 0), (some (some true), 1)], none, some .pre⟩) + (ws' := ![frame w ++ rest, [true]]) (o' := ![oS, oR]) (h' := ![oS, oR + 1]) + (by simp only [popFrame, tr_ofTr, q₀_ofTr, Matrix.cons_val_zero, hxl, + tapeOfList_cons_sub_self]) + rfl rfl + (fun i => by + fin_cases i + · rfl + · simpa using update_shifted_append ([] : List Bool) true oR) + (fun i => by fin_cases i <;> simp), + step_tapesCfg (a := ⟨0, ![(none, 0), (some (some true), 1)], none, some .loop⟩) + (ws' := ![frame w ++ rest, [true, true]]) (o' := ![oS, oR]) + (h' := ![oS, oR + ([true, true] : List Bool).length]) + (by simp only [popFrame, tr_ofTr]) rfl rfl + (fun i => by + fin_cases i + · rfl + · simpa using update_shifted_append ([true] : List Bool) true oR) + (fun i => by fin_cases i <;> simp; omega)] + exact runFrom_popFrame_loop w rest _ [true, true] _ oS _ oR _ rfl (by simp [frame_cons]) + (by simp [length_frame]) (by simp [length_frame]) out + +end MultiTapeTM + +end Turing From cc1330dd4831d0f5679cbbca0c7d26d9b325b0ef Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:31:11 +0000 Subject: [PATCH 14/40] feat(universal): size facts for the windowed simulation and tests (#800) --- .../Turing/MultiTape/Universal/Windowed.lean | 246 +++++++++++++++++- ComplexityTests/UniversalWindowed.lean | 55 ++++ 2 files changed, 298 insertions(+), 3 deletions(-) create mode 100644 ComplexityTests/UniversalWindowed.lean diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean index 7d0fe59861..eed69e1290 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean @@ -28,6 +28,13 @@ Input cells are coded so that a step can be taken without the position of the in `some 0` is the left end at position `0`, `some (a + 1)` the input symbol `a`, and `none` a blank after the input. +The correctness proof follows each window against its tape cell by cell: if every window agrees +with its tape within distance `n` of the head, then `n` windowed steps take the same steps, the +windows keep agreeing with the tapes there, and the cells beyond are untouched. Pasting a window +back is exact because a list of a cut window either has exactly the cut length, in which case the +run keeps it aligned with the rest of the outer list, or ends early, in which case the outer list +has no cells beyond it either. + ## Main definitions * `Turing.MultiTapeTM.Universal.Windowed.extract`, `.restore`: cutting windows and pasting them @@ -40,6 +47,9 @@ after the input. * `Turing.MultiTapeTM.Universal.Windowed.universal_eq_sim`: the windowed simulation of `t` steps from the radius-`t` windows of the initial configuration computes the universal function. +* `Turing.MultiTapeTM.Universal.Windowed.length_sim`, `.length_sim_le`, `.sim_cells`, + `.sim_state`, `.sim_output`: the number and lengths of the windows, their cells, the state and + the emitted symbols, for the cost analysis. -/ public section @@ -65,7 +75,8 @@ beyond distance `r` of its head put back around it. -/ (inner.1, List.zipWith (paste r) outer.2 inner.2) /-- The input symbol of a coded input cell. -/ -@[expose] def inSym (c : Option ℕ) : Option ℕ := c.bind fun v => if v = 0 then none else some (v - 1) +@[expose] def inSym (c : Option ℕ) : Option ℕ := + c.bind fun v => if v = 0 then none else some (v - 1) /-- A stand-in for the position of the input head on a coded input cell: `0` at the left end and `1` elsewhere. `Turing.MultiTapeTM.Universal.moveInput` distinguishes only these cases. -/ @@ -186,7 +197,8 @@ private lemma cellAt_move (t : Tape) (m : SignType) (i : ℤ) : private lemma head_move (t : Tape) (m : SignType) : (t.move m).head = t.head + m := by rcases m with _ | _ | _ <;> - simp [Tape.move, SignType.zero_eq_zero, SignType.neg_eq_neg_one, SignType.pos_eq_one, sub_eq_add_neg] + simp [Tape.move, SignType.zero_eq_zero, SignType.neg_eq_neg_one, SignType.pos_eq_one, + sub_eq_add_neg] private lemma head_apply (t : Tape) (a : Option (Option ℕ) × SignType) : (t.apply a).head = t.head + a.2 := by @@ -362,7 +374,8 @@ private lemma moveIn_eq (i : Tape) {P p : ℕ} (hP : P = 0 ∨ P = 1) (hPp : P = SignType.zero_eq_zero]⟩ · exact ⟨.neg, by simp [moveIn, moveInput], by simp [moveInput, SignType.neg_eq_neg_one]; omega⟩ · by_cases ha : a.isSome - · exact ⟨.pos, by simp [moveIn, moveInput, ha], by simp [moveInput, SignType.pos_eq_one, ha, hp]⟩ + · exact ⟨.pos, by simp [moveIn, moveInput, ha], by + simp [moveInput, SignType.pos_eq_one, ha, hp]⟩ · exact ⟨.zero, by simp [moveIn, moveInput, ha, Tape.move], by simp [moveInput, SignType.zero_eq_zero, ha, hp]⟩ @@ -742,4 +755,231 @@ theorem universal_eq_sim (d : Desc) (x : List ℕ) (t : ℕ) : change ((run d x t (init d)).2, (run d x t (init d)).1.state.isNone) = _ rw [o, q] +/-! ### Sizes of the windows + +Facts about the shapes of the windows, the cells they hold, the state and the emitted symbols, for +the cost analysis of the windowed simulation. -/ + +private lemma getElem?_restore_eq_some {r k : ℕ} {o i : Win} {W' : Tape} : + (restore r o i).2[k]? = some W' ↔ + ∃ W I, o.2[k]? = some W ∧ i.2[k]? = some I ∧ paste r W I = W' := + List.getElem?_zipWith_eq_some + +private lemma act_cases (d : Desc) (q a : Option ℕ) (rs : List (Option ℕ)) : + act d q a rs = ⟨.zero, [], none, none⟩ ∨ ∃ e ∈ d.table, act d q a rs = e.2 := by + rcases q with _ | q + · exact Or.inl rfl + · simp only [act] + split + · exact Or.inl rfl + · rename_i h + exact Or.inr ⟨_, List.mem_of_find?_eq_some h, rfl⟩ + +/-- The windowed simulation keeps the number of windows. -/ +theorem length_sim (d : Desc) (n : ℕ) (w : Win) : (sim d n w).1.2.length = w.2.length := by + induction n using sim_induction generalizing w with + | zero => rw [sim_zero] + | one => + rw [sim_one] + obtain ⟨q, _ | ⟨i, ws⟩⟩ := w + · rfl + · simp [wstep_eq, length_applyTapes] + | step n ih => + have hle : ∀ r w, (extract r w).2.length = w.2.length := by simp [extract] + rw [sim_add_two, length_restore, ih _ (by omega), hle, length_restore, ih _ (by + simp only [firstHalf]; omega), hle] + omega + +private lemma length_apply_le (t : Tape) (a : Option (Option ℕ) × SignType) : + (t.apply a).left.length ≤ t.left.length + 1 ∧ + (t.apply a).right.length ≤ max t.right.length 1 + 1 := by + obtain ⟨_ | o, _ | _ | _⟩ := a <;> simp [Tape.apply, Tape.move, Tape.write] <;> omega + +/-- In `n` windowed steps, each window grows by at most `n` cells on each side, where the right +list, which holds the cell under the head, counts as at least one cell. -/ +theorem length_sim_le (d : Desc) (n : ℕ) (w : Win) {k : ℕ} {W W' : Tape} + (hW : w.2[k]? = some W) (hW' : (sim d n w).1.2[k]? = some W') : + W'.left.length ≤ W.left.length + n ∧ W'.right.length ≤ max W.right.length 1 + n := by + induction n using sim_induction generalizing w k W W' with + | zero => + rw [sim_zero, hW, Option.some.injEq] at hW' + subst hW' + omega + | one => + rw [sim_one] at hW' + obtain ⟨q, _ | ⟨i, ws⟩⟩ := w + · simp at hW + rw [wstep_eq] at hW' + rcases k with _ | k + · simp only [List.getElem?_cons_zero, Option.some.injEq] at hW hW' + subst hW hW' + unfold moveIn + split_ifs + · exact length_apply_le _ (none, .pos) + · exact length_apply_le _ (none, .neg) + · omega + · simp only [List.getElem?_cons_succ] at hW + simp only [List.getElem?_cons_succ, getElem?_applyTapes, hW, Option.map_some, + Option.some.injEq] at hW' + subst hW' + exact length_apply_le W _ + | step n ih => + rw [sim_add_two, getElem?_restore_eq_some] at hW' + obtain ⟨P, J, hP, hJ, rfl⟩ := hW' + rw [getElem?_restore_eq_some] at hP + obtain ⟨W₀, I, hW₀, hI, rfl⟩ := hP + rw [hW, Option.some.injEq] at hW₀ + subst hW₀ + have h₁ := ih _ (by simp only [firstHalf]; omega) _ (getElem?_extract hW) hI + have h₂ := ih _ (by omega) _ (getElem?_extract (getElem?_restore hW hI)) hJ + simp only [cut, paste, firstHalf, List.length_append, List.length_drop, + List.length_take] at h₁ h₂ ⊢ + omega + +/-- All cells of the window `t` satisfy `S`. -/ +private def Cells (S : Option ℕ → Prop) (t : Tape) : Prop := ∀ o ∈ t.left ++ t.right, S o + +private lemma cells_move {S : Option ℕ → Prop} (h0 : S none) {t : Tape} (h : Cells S t) + (m : SignType) : Cells S (t.move m) := by + have hl : ∀ o ∈ t.left, S o := fun o ho => h o (List.mem_append_left _ ho) + have hr : ∀ o ∈ t.right, S o := fun o ho => h o (List.mem_append_right _ ho) + have hd : ∀ l : List (Option ℕ), (∀ o ∈ l, S o) → S (l.headD none) := fun l hl' => by + cases l with + | nil => exact h0 + | cons a l => exact hl' a List.mem_cons_self + intro o ho + rcases m with _ | _ | _ + · exact h o ho + · simp only [Tape.move, List.mem_append, List.mem_cons] at ho + rcases ho with ho | rfl | ho + · exact hl o (List.mem_of_mem_tail ho) + · exact hd _ hl + · exact hr o ho + · simp only [Tape.move, List.mem_append, List.mem_cons] at ho + rcases ho with (rfl | ho) | ho + · exact hd _ hr + · exact hl o ho + · exact hr o (List.mem_of_mem_tail ho) + +private lemma cells_apply {S : Option ℕ → Prop} (h0 : S none) {t : Tape} (h : Cells S t) + {a : Option (Option ℕ) × SignType} (ha : ∀ o, a.1 = some o → S o) : Cells S (t.apply a) := by + obtain ⟨_ | o, m⟩ := a + · exact cells_move h0 h m + · change Cells S ((t.write o).move m) + refine cells_move h0 (fun o' ho' => ?_) m + simp only [Tape.write, List.mem_append, List.mem_cons] at ho' + rcases ho' with ho' | rfl | ho' + · exact h o' (List.mem_append_left _ ho') + · exact ha _ rfl + · exact h o' (List.mem_append_right _ (List.mem_of_mem_tail ho')) + +private lemma cells_applyTapes {S : Option ℕ → Prop} (h0 : S none) {ts : List Tape} + (h : ∀ t ∈ ts, Cells S t) {as : List (Option (Option ℕ) × SignType)} + (ha : ∀ a ∈ as, ∀ o, a.1 = some o → S o) : ∀ t ∈ applyTapes ts as, Cells S t := by + induction ts generalizing as with + | nil => simp [Universal.applyTapes] + | cons t ts ih => + cases as with + | nil => simpa [Universal.applyTapes] using h + | cons a as => + simp only [Universal.applyTapes, List.mem_cons, forall_eq_or_imp] at h ha ⊢ + exact ⟨cells_apply h0 h.1 ha.1, ih h.2 ha.2⟩ + +private lemma cells_cut {S : Option ℕ → Prop} {t : Tape} (h : Cells S t) (r : ℕ) : + Cells S (cut r t) := fun o ho => by + simp only [Windowed.cut, List.mem_append] at ho + rcases ho with ho | ho + · exact h o (List.mem_append_left _ (List.mem_of_mem_take ho)) + · exact h o (List.mem_append_right _ (List.mem_of_mem_take ho)) + +private lemma cells_paste {S : Option ℕ → Prop} {O I : Tape} (hO : Cells S O) (hI : Cells S I) + (r : ℕ) : Cells S (paste r O I) := fun o ho => by + simp only [Windowed.paste, List.mem_append] at ho + rcases ho with (ho | ho) | (ho | ho) + · exact hI o (List.mem_append_left _ ho) + · exact hO o (List.mem_append_left _ (List.mem_of_mem_drop ho)) + · exact hI o (List.mem_append_right _ ho) + · exact hO o (List.mem_append_right _ (List.mem_of_mem_drop ho)) + +/-- **The cells of the windows** after the windowed simulation come from the windows before it or +are written by a transition: a property of cells that holds for the blank, for every symbol +written by a transition and for all cells of the windows before, holds for all cells after. -/ +theorem sim_cells (d : Desc) (S : Option ℕ → Prop) (h0 : S none) + (htable : ∀ e ∈ d.table, ∀ a ∈ e.2.workTapes, ∀ o, a.1 = some o → S o) (n : ℕ) (w : Win) + (hw : ∀ W ∈ w.2, ∀ o ∈ W.left ++ W.right, S o) : + ∀ W ∈ (sim d n w).1.2, ∀ o ∈ W.left ++ W.right, S o := by + change ∀ W ∈ (sim d n w).1.2, Cells S W + change ∀ W ∈ w.2, Cells S W at hw + induction n using sim_induction generalizing w with + | zero => rwa [sim_zero] + | one => + rw [sim_one] + obtain ⟨q, _ | ⟨i, ws⟩⟩ := w + · exact hw + rw [wstep_eq] + simp only [List.mem_cons, forall_eq_or_imp] at hw ⊢ + refine ⟨?_, cells_applyTapes h0 hw.2 ?_⟩ + · unfold moveIn + split_ifs + · exact cells_move h0 hw.1 _ + · exact cells_move h0 hw.1 _ + · exact hw.1 + · rcases act_cases d q (inSym i.read) (ws.map Tape.read) with h | ⟨e, he, h⟩ <;> rw [h] + · simp + · exact htable e he + | step n ih => + have hr : ∀ r w, (∀ W ∈ w.2, Cells S W) → ∀ W ∈ (extract r w).2, Cells S W := + fun r w hw W hW => by + simp only [extract, List.mem_map] at hW + obtain ⟨W, hW, rfl⟩ := hW + exact cells_cut (hw W hW) r + have hp : ∀ r o i, (∀ W ∈ o.2, Cells S W) → (∀ W ∈ i.2, Cells S W) → + ∀ W ∈ (restore r o i).2, Cells S W := fun r o i ho hi W hW => by + obtain ⟨k, hk⟩ := List.mem_iff_getElem?.1 hW + obtain ⟨O, I, hO, hI, rfl⟩ := getElem?_restore_eq_some.1 hk + exact cells_paste (ho O (List.mem_of_getElem? hO)) (hi I (List.mem_of_getElem? hI)) r + rw [sim_add_two] + have h₁ := hp (firstHalf (n + 2)) w _ hw (ih (firstHalf (n + 2)) + (by simp only [firstHalf]; omega) _ (hr (firstHalf (n + 2)) w hw)) + exact hp _ _ _ h₁ (ih ((n + 2) / 2) (by omega) _ (hr _ _ h₁)) + +/-- The state after the windowed simulation is the state before it, the halting state, or the next +state of a transition. -/ +theorem sim_state (d : Desc) (T : Option ℕ → Prop) (h0 : T none) + (htable : ∀ e ∈ d.table, T e.2.state) (n : ℕ) (w : Win) (hw : T w.1) : T (sim d n w).1.1 := by + induction n using sim_induction generalizing w with + | zero => rwa [sim_zero] + | one => + rw [sim_one] + obtain ⟨q, _ | ⟨i, ws⟩⟩ := w + · exact hw + rw [wstep_eq] + rcases act_cases d q (inSym i.read) (ws.map Tape.read) with h | ⟨e, he, h⟩ <;> rw [h] + · exact h0 + · exact htable e he + | step n ih => + rw [sim_add_two] + exact ih _ (by omega) _ (ih _ (by simp only [firstHalf]; omega) _ hw) + +/-- Every symbol emitted by the windowed simulation is the output of a transition. -/ +theorem sim_output (d : Desc) (n : ℕ) (w : Win) : + ∀ o ∈ (sim d n w).2, ∃ e ∈ d.table, e.2.output = some o := by + induction n using sim_induction generalizing w with + | zero => simp [sim_zero] + | one => + rw [sim_one] + obtain ⟨q, _ | ⟨i, ws⟩⟩ := w + · simp [wstep] + rw [wstep_eq] + rcases act_cases d q (inSym i.read) (ws.map Tape.read) with h | ⟨e, he, h⟩ <;> rw [h] + · simp + · intro o ho + exact ⟨e, he, by simpa using ho⟩ + | step n ih => + rw [sim_add_two] + intro o ho + rcases List.mem_append.1 ho with ho | ho + · exact ih _ (by simp only [firstHalf]; omega) _ o ho + · exact ih _ (by omega) _ o ho + end Turing.MultiTapeTM.Universal.Windowed diff --git a/ComplexityTests/UniversalWindowed.lean b/ComplexityTests/UniversalWindowed.lean new file mode 100644 index 0000000000..1bc37c77c1 --- /dev/null +++ b/ComplexityTests/UniversalWindowed.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (tests of the windowed universal simulation) + +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Windowed + +/-! +# The windowed universal simulation + +A concrete machine checks one windowed step against the transition table, and the output of the +windowed simulation through `universal_eq_sim`. The size facts are instantiated on the initial +windows. +-/ + +@[expose] public section + +namespace ComplexityTests.UniversalWindowed + +open Turing.MultiTapeTM.Universal Turing.MultiTapeTM.Universal.Windowed + +/-- On the input `[0, 1]`, read the symbol zero, emit seven, move right and write three on the +work tape, then halt on the missing transition. -/ +def readZero : Desc where + tapes := 1 + q₀ := 0 + table := [(⟨0, some 0, [none]⟩, ⟨.pos, [(some (some 3), .pos)], some 7, some 1⟩)] + +-- One windowed step reads the coded input cell `some 1` as the input symbol zero. +example : + (wstep readZero (initWin readZero [0, 1])).1.1 = some 1 ∧ + (wstep readZero (initWin readZero [0, 1])).2 = some 7 ∧ + ((wstep readZero (initWin readZero [0, 1])).1.2.map Tape.read) = [some 2, none] ∧ + ((wstep readZero (initWin readZero [0, 1])).1.2.map Tape.left) = + [[some 1, some 0], [some 3]] := by + decide + +-- The windowed simulation of three steps emits the output of the machine. +example : (sim readZero 3 (extract 3 (initWin readZero [0, 1]))).2 = [7] ∧ + (sim readZero 3 (extract 3 (initWin readZero [0, 1]))).1.1 = none := by + have h := universal_eq_sim readZero [0, 1] 3 + have h₁ := congrArg Prod.fst h + have h₂ := congrArg Prod.snd h + simp only at h₁ h₂ + refine ⟨h₁ ▸ by decide, Option.isNone_iff_eq_none.1 (h₂ ▸ by decide)⟩ + +example (n : ℕ) : + (sim readZero n (extract n (initWin readZero [0, 1]))).1.2.length = 2 := + (length_sim _ _ _).trans rfl + +end ComplexityTests.UniversalWindowed From 9bb8edb2008ef911e3a2fc2fcf8796415c9f3c98 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:33:28 +0000 Subject: [PATCH 15/40] feat(divconq): divide and conquer from the stack loop --- .../Turing/MultiTape/Combinators/DivConq.lean | 147 +++++++++++++++++- 1 file changed, 145 insertions(+), 2 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 0d0bee3fb7..5769c04d72 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -70,6 +70,30 @@ inductive Eval (D : DivConq α β γ) (cb : α → ℕ) (cn : α → β → β Eval D cb cn (D.left a) b₁ c₁ → Eval D cb cn (D.mid (a, b₁)).1 b₂ c₂ → Eval D cb cn a (D.join ((D.mid (a, b₁)).2, b₂)) (c₁ + c₂ + cn a b₁ b₂) +namespace Eval + +variable {D : DivConq α β γ} {cb : α → ℕ} {cn : α → β → β → ℕ} + +/-- Scaling the costs of base problems and nodes scales the cost of an evaluation. -/ +lemma scale (k : ℕ) {a : α} {b : β} {c : ℕ} (h : D.Eval cb cn a b c) : + D.Eval (fun a => k * cb a) (fun a b₁ b₂ => k * cn a b₁ b₂) a b (k * c) := by + induction h with + | base ha => exact .base ha + | node ha _ _ ih₁ ih₂ => rw [Nat.mul_add, Nat.mul_add]; exact .node ha ih₁ ih₂ + +/-- The problem and its solution are within the cost of an evaluation, when the cost of every base +problem and node covers them. -/ +lemma length_le {encA : α ↪ List Bool} {encB : β ↪ List Bool} + (hb : ∀ a, D.isBase a = true → (encA a).length + (encB (D.base a)).length ≤ cb a) + (hn : ∀ a b₁ b₂, D.isBase a = false → + (encA a).length + (encB (D.join ((D.mid (a, b₁)).2, b₂))).length ≤ cn a b₁ b₂) + {a : α} {b : β} {c : ℕ} (h : D.Eval cb cn a b c) : (encA a).length + (encB b).length ≤ c := by + induction h with + | base ha => exact hb _ ha + | @node a b₁ b₂ c₁ c₂ ha _ _ _ _ => have := hn a b₁ b₂ ha; omega + +end Eval + /-! ### The recursion as a stack loop -/ /-- The values of the stack loop: a call on a problem, a returned solution, and the final @@ -251,6 +275,16 @@ lemma toList_inO {δ : Type} {enc : δ ↪ List Bool} : · cases o <;> simp [encBits] all_goals omega +/-- The sums of the costs of a run of `m + 1` rounds followed by a halting test, against a bound +on the first `m` rounds. -/ +lemma sums_le {A B R : ℕ → ℕ} {m X : ℕ} (h : ∀ i < m, A i + B i ≤ R i) : + X + ∑ i ∈ Finset.range (m + 1 + 1), A i + ∑ i ∈ Finset.range (m + 1), B i ≤ + X + (∑ i ∈ Finset.range m, R i + A m + A (m + 1) + B m) := by + rw [Finset.sum_range_succ, Finset.sum_range_succ, Finset.sum_range_succ] + have := Finset.sum_le_sum (s := Finset.range m) fun i hi => h i (Finset.mem_range.mp hi) + rw [Finset.sum_add_distrib] at this + omega + lemma length_encList_toList_le {δ : Type} (enc : δ ↪ List Bool) (o : Option δ) : (encList enc o.toList).length ≤ 2 * (encOption enc o).length := by cases o <;> simp [length_frame] @@ -435,7 +469,116 @@ theorem ComputableInO.divConq {δ α β γ : Type} {encIn : δ ↪ List Bool} (encB (D.join ((D.mid (a, b₁)).2, b₂))).length + 1 ≤ cn a b₁ b₂) (heval : ∀ x, D.Eval cb cn (init x) (F x) (C x)) : ComputableInO F encIn encB (fun x => (encIn x).length + Ti x + Si x + C x) - (fun x => (encIn x).length + Ti x + Si x + C x) := - sorry + (fun x => (encIn x).length + Ti x + Si x + C x) := by + classical + -- the certificates of the loop + have hR := D.round_inO (encG := encG) hisBase.tidy hbase.tidy hleft.tidy hmid.tidy hjoin.tidy + have hH := D.halt_inO (encA := encA) (encB := encB) + have hI := (ComputableInO.inl encA (encSum encB encB)).tidy.comp hinit.tidy + set encF := DivConq.encFrame encA encG with hencF + set encV := DivConq.encVal encA encB with hencV + -- the cost of a round + let RB : Option (DivConq.Frame α γ) × DivConq.Val α β → ℕ := fun p => + (encPair (encOption encF) encV p).length + p.2.elim + (fun a => Tt a + St a + if D.isBase a then Tb a + Sb a + (encB (D.base a)).length + else Tl a + Sl a + (encA (D.left a)).length) + (fun s => s.elim (fun b => p.1.elim 0 (fun x => x.elim + (fun a => Tm (a, b) + Sm (a, b) + (encPair encA encG (D.mid (a, b))).length) + (fun g => Tj (g, b) + Sj (g, b) + (encB (D.join (g, b))).length))) (fun _ => 0)) + let R : Option (DivConq.Frame α γ) × DivConq.Val α β → ℕ := fun p => + (encV p.2).length + (encV p.2).length + (encV p.2).length + (RB p + RB p + + (encPair (encOption encF) encV p).length + + (encPair (encList encF) encV (D.loop.round p)).length) + let fsize : Option (DivConq.Frame α γ) → ℕ := fun o => (encOption encF o).length + -- the bounds of the rounds of base problems and nodes + have hb' : ∀ o a, D.isBase a = true → + R (o, .inl a) ≤ 64 * (fsize o + 1) + 64 * (6 * cb a) := by + intro o a ha + have h₁ := hcb a ha + have h₂ := DivConq.length_encList_toList_le encF o + simp only [R, RB, fsize, DivConq.loop, DivConq.roundCall, ha, Sum.elim_inl, ite_true, + length_encPair, hencV, hencF, encSum_inl, encSum_inr, List.length_cons] at h₂ ⊢ + omega + have hc' : ∀ o a b₁ b₂, D.isBase a = false → + R (o, .inl a) ≤ 64 * (fsize o + 1) + 64 * (6 * cn a b₁ b₂) := by + intro o a b₁ b₂ ha + have h₁ := hcn a b₁ b₂ ha + have h₂ := DivConq.length_encList_toList_le encF o + simp only [R, RB, fsize, DivConq.loop, DivConq.roundCall, ha, Sum.elim_inl, + Bool.false_eq_true, ite_false, length_encPair, hencV, hencF, encSum_inl, + List.length_cons, encList_cons, List.length_append, length_frame] at h₂ ⊢ + omega + have hm' : ∀ a b₁ b₂, D.isBase a = false → + R (some (.inl a), .inr (.inl b₁)) ≤ 64 * (6 * cn a b₁ b₂) := by + intro a b₁ b₂ ha + have h₁ := hcn a b₁ b₂ ha + simp only [R, RB, DivConq.loop, DivConq.roundRet, Sum.elim_inl, Sum.elim_inr, + Option.elim_some, length_encPair, hencV, hencF, encSum_inl, encSum_inr, List.length_cons, + encOption_some, encList_cons, encList_nil, List.append_nil, length_frame] + omega + have hj' : ∀ a b₁ b₂, D.isBase a = false → + R (some (.inr (D.mid (a, b₁)).2), .inr (.inl b₂)) ≤ 64 * (6 * cn a b₁ b₂) := by + intro a b₁ b₂ ha + have h₁ := hcn a b₁ b₂ ha + simp only [R, RB, DivConq.loop, DivConq.roundRet, Sum.elim_inl, Sum.elim_inr, + Option.elim_some, length_encPair, hencV, hencF, encSum_inl, encSum_inr, List.length_cons, + encOption_some, encList_nil, List.length_nil] + omega + have hf' : ∀ a b₁ b₂, D.isBase a = false → + fsize (some (.inl a)) + fsize (some (.inr (D.mid (a, b₁)).2)) + 2 ≤ 6 * cn a b₁ b₂ := by + intro a b₁ b₂ ha + have h₁ := hcn a b₁ b₂ ha + simp only [fsize, hencF, encOption_some, encSum_inl, encSum_inr, List.length_cons] + omega + -- the trace of every input + have htrace := fun x => D.eval_trace hb' hc' hm' hj' hf' ((heval x).scale 6) [] + choose m hm hh hs using htrace + have hfinal : ∀ x, D.loop.step^[m x + 1] (.inl (init x), []) = (.inr (.inr (F x)), []) := + fun x => by rw [Function.iterate_succ_apply', hm x]; rfl + have hlen := fun x => DivConq.Eval.length_le (encA := encA) (encB := encB) + (fun a ha => by have := hcb a ha; omega) + (fun a b₁ b₂ ha => by have := hcn a b₁ b₂ ha; omega) (heval x) + have hSL := ComputableInO.stackLoop D.loop (fun x => m x + 1) hI.computableInO + hH.computableInO hR.computableInO + (fun x i hi => by + rcases Nat.lt_or_ge i (m x) with hi' | hi' + · exact hh x i hi' + · obtain rfl : i = m x := by omega + simp only [Function.comp_apply, hm x]; rfl) + (fun x => by simp only [Function.comp_apply, hfinal x]; rfl) + (fun x => by simp only [Function.comp_apply, hfinal x]) + -- the solution is the final value without its two tags + have hdrop : ComputableTidilyInO (fun v : DivConq.Val α β => (encV v).drop 2) encV encBits + (fun v => (encV v).length) (fun v => (encV v).length) := by + have htail : ComputableTidilyInO List.tail encBits encBits (fun w => w.length) + (fun w => w.length) := + ComputableTidilyInO.of_linear (ComputableTidilyInLinearTimeAndSpace.of_tail + (f := List.tail) (encIn := encBits) (encOut := encBits) fun _ => rfl) + refine ((htail.comp htail).comp (ComputableTidilyInO.of_linear + (ComputableTidilyInLinearTimeAndSpace.of_eq (f := fun v => encV v) (encIn := encV) + (encMid := encBits) fun _ => rfl))).of_enc_eq (fun v => ?_) |>.mono 3 (fun v => ?_) + (fun v => ?_) + · simp only [Function.comp_apply, encBits, Function.Embedding.refl_apply] + generalize encV v = w + rcases w with _ | ⟨_, _ | ⟨_, _⟩⟩ <;> rfl + all_goals simp; omega + refine ((hdrop.comp hSL.tidy).of_enc_eq (g := F) fun x => ?_).computableInO.mono 4000 + (fun x => ?_) (fun x => ?_) + · simp only [Function.comp_apply, hfinal, hencV, encSum_inr, encBits, + Function.Embedding.refl_apply, List.drop_succ_cons, List.drop_zero] + all_goals + have hsx := hs x + have hlx := hlen x + simp only [Function.comp_apply] + refine le_trans (Nat.add_le_add_right (DivConq.sums_le (R := fun i => R + (StackLoop.roundInput (D.loop.step^[i] (.inl (init x), [])))) ?_) _) ?_ + · intro i _ + exact le_of_eq rfl + have hround : D.loop.round (none, .inr (.inl (F x))) = ([], .inr (.inr (F x))) := rfl + simp only [hm x, hfinal x, StackLoop.roundInput, List.head?_nil, hround] at hsx ⊢ + simp only [hencV, hencF, Option.elim_none, Sum.elim_inr, Sum.elim_inl, length_encPair, + encSum_inr, encSum_inl, List.length_cons, encOption_none, encList_nil, List.length_nil, + fsize] at hsx ⊢ + omega end Turing.MultiTapeTM From 61844d4d38a6ad19fc27ffde8e6f9d7403e49bb8 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:33:45 +0000 Subject: [PATCH 16/40] chore: regenerate Complexity.lean --- Complexity.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Complexity.lean b/Complexity.lean index 596224ee4b..5d90e81de3 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1512,6 +1512,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Zip public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Arith public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Bounds +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Cases public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Constructible public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Lists public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.NatPolynomial From 4730706cc858c55a2a1605271cde37b99c896365 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:34:02 +0000 Subject: [PATCH 17/40] feat(universal): prove initProb_inO, the cost of the initial windows (#800) Binary-to-unary conversion by a doubling left fold over the reversed binary digits (time O((t + 1) * (L + 1))), the input recoded by four passes of the finite-state rewrite true -> true, false -> true false, the input window cut with the linear-time unary take (through a single private wrapper), and the blank work windows built by replicate. --- .../MultiTape/Universal/WindowedInit.lean | 281 +++++++++++++++++- 1 file changed, 279 insertions(+), 2 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean index b225e71a77..8b60a1bdf3 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean @@ -8,6 +8,12 @@ module -- upstream: candidate public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedBound +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Encoding +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Reverse +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TakeDropUnary +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.LinearSpaceArith +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring /-! # The cost of the initial windows @@ -20,6 +26,17 @@ description and the length `L` of `t` in binary: `t` is converted to unary by do symbols are recoded by a finite-state rewrite in linear time, and the input window is cut with a linear-time take. +The computation goes through the intermediate value `(d, t, x')` with `t` in unary and the coded +input cells `x' = x.map fun a => some (a + 1)`: + +* `t` is converted by a left fold of `u ↦ 2 * u + b` over the binary digits of `t`, most + significant first; each round is linear in the unary state, which is at most `t`. +* In `encList encUnary x`, the element `a` is `(true true)^a false`; in the encoding of `x'` it is + `(true true)^(a + 2) false`. The rewrite `true ↦ true`, `false ↦ true false`, applied four times, + maps the one to the other, and every application is a finite-state transducer. +* The input window keeps the first `t + 1` coded cells; the blank work windows are built by + `ComputableTidilyInDegree.replicate`, within time cubic in the number of work tapes. + ## Main results * `Turing.MultiTapeTM.Universal.Windowed.initProb_inO`: the first problem. @@ -29,6 +46,256 @@ public section namespace Turing.MultiTapeTM.Universal.Windowed +open ComputableTidilyInO + +/-! ### The initial windows -/ + +/-- The windows of radius `t` of the initial configuration. -/ +private lemma extract_initWin (d : Desc) (x : List ℕ) (t : ℕ) : + extract t (initWin d x) = (some d.q₀, + ⟨0, [some 0].take t, (x.map fun a => some (a + 1)).take (t + 1)⟩ :: + List.replicate d.tapes ⟨0, [], []⟩) := by + simp [extract, initWin, cut, List.map_replicate] + +/-- Taking the first `n` elements of a list, with `n` in unary, in linear time. All uses go through +this wrapper, so that only it depends on the form of the take primitive. -/ +private lemma takeU {α : Type} (enc : α ↪ List Bool) : + ComputableTidilyInO (fun p : List α × ℕ => p.1.take p.2) (encPair (encList enc) encUnary) + (encList enc) (fun p => (encPair (encList enc) encUnary p).length) + fun p => (encPair (encList enc) encUnary p).length := + (ComputableInDegree.takeUnary enc).inO_one.tidy + +/-! ### From binary to unary by doubling -/ + +/-- A doubling round of the conversion from binary to unary: `u ↦ 2 * u + b`. -/ +private def dbl (u : ℕ) (b : Bool) : ℕ := u + u + cond b 1 0 + +private lemma foldr_dbl_bits (n : ℕ) : n.bits.foldr (fun b u => dbl u b) 0 = n := by + induction n using Nat.binaryRec' with + | zero => rfl + | bit b n hn ih => + rw [Nat.bits_append_bit _ _ hn, List.foldr_cons, ih, Nat.bit_val] + cases b <;> + simp only [dbl, Bool.cond_true, Bool.cond_false, Bool.toNat_true, Bool.toNat_false] <;> omega + +/-- Doubling over the binary digits, most significant first, gives the number. -/ +private lemma foldl_dbl_bits (n : ℕ) : (encNat n).reverse.foldl dbl 0 = n := by + rw [List.foldl_reverse, encNat_apply, foldr_dbl_bits] + +private lemma le_foldl_dbl (l : List Bool) (a : ℕ) : a ≤ l.foldl dbl a := by + induction l generalizing a with + | nil => exact le_rfl + | cons b l ih => exact (show a ≤ dbl a b by simp only [dbl]; omega).trans (ih _) + +/-- The states of the doubling fold are at most the number. -/ +private lemma foldl_dbl_take_le (n i : ℕ) : ((encNat n).reverse.take i).foldl dbl 0 ≤ n := + calc _ ≤ ((encNat n).reverse.drop i).foldl dbl (((encNat n).reverse.take i).foldl dbl 0) := + le_foldl_dbl _ _ + _ = n := by rw [← List.foldl_append, List.take_append_drop, foldl_dbl_bits] + +/-- A doubling round, in linear time. -/ +private lemma dbl_deg : ComputableTidilyInDegree (fun p : ℕ × Bool => dbl p.1 p.2) + (encPair encUnary encBool) encUnary 1 1 := by + have h₁ := ComputableTidilyInDegree.fst encUnary encBool + have h₂ := (ComputableTidilyInDegree.of_finite (encIn := encBool) (encMid := encUnary) + fun b : Bool => cond b 1 0).comp (ComputableTidilyInDegree.snd encUnary encBool) + have hdouble := h₁.append h₁ (encOut := encUnary) (g := fun p : ℕ × Bool => p.1 + p.1) + fun p => by simp only [encUnary_apply, List.replicate_add] + exact (hdouble.append h₂ fun p => by + simp only [dbl, encUnary_apply, List.replicate_add, Function.comp_apply]).mono + +/-- **From binary to unary**, in time `O((t + 1) * (L + 1))` for `t` with `L` binary digits. -/ +private lemma toUnary_inO : ComputableTidilyInO (fun t : ℕ => t) encNat encUnary + (fun t => (t + 1) * ((encNat t).length + 1)) fun t => (t + 1) * ((encNat t).length + 1) := by + have hrev : ComputableTidilyInO (fun t : ℕ => (encNat t).reverse) encNat encBits + (fun t => (encNat t).length) fun t => (encNat t).length := + of_linear ⟨4, (computableTidilyInTimeAndSpace_reverse fun _ => rfl).mono + (fun _ => by omega) fun _ => Nat.zero_le _⟩ + refine ((foldl (encA := encBool) (encL := encBits) (list := fun t : ℕ => (encNat t).reverse) + (init := fun _ => 0) (step := dbl) hrev (const 0) dbl_deg.inO_one + (R := fun t => 2 * t + 2) (Q := fun t => 2 * t + 2) (B := fun t => t) + (fun t i _ => ?_) (fun t i _ => ?_) (fun t i _ => ?_)).mono 8 (fun t => ?_) + fun t => ?_).of_enc_eq fun t => ?_ + · have := foldl_dbl_take_le t i + simp only [length_encPair, encUnary_apply, encBool_apply, List.length_replicate, + List.length_singleton] + omega + · have := foldl_dbl_take_le t i + simp only [length_encPair, encUnary_apply, encBool_apply, List.length_replicate, + List.length_singleton] + omega + · have := foldl_dbl_take_le t i + simp only [encUnary_apply, List.length_replicate] + omega + · have := length_encNat_le_self t + simp only [encBits_apply, List.length_reverse] + nlinarith + · have := length_encNat_le_self t + simp only [encBits_apply, List.length_reverse] + nlinarith + · rw [foldl_dbl_bits] + +/-! ### Recoding the input symbols -/ + +/-- The rewrite `true ↦ true`, `false ↦ true false`. -/ +private def ins (w : List Bool) : List Bool := + w.flatMap fun b => if b then [true] else [true, false] + +/-- The rewrite `ins` as a finite-state transducer. -/ +private def insT : Transducer Bool Unit where + q₀ := () + step _ b := ((), if b then [true] else [true, false]) + final _ := [] + length_step_le _ b := by cases b <;> simp + length_final_le _ := by simp + +private lemma insT_run (w : List Bool) : insT.run () w = ins w := by + induction w with + | nil => rfl + | cons b w ih => + change (if b then [true] else [true, false]) ++ insT.run () w = _ + rw [ih] + rfl + +private lemma ins_append (u v : List Bool) : ins (u ++ v) = ins u ++ ins v := + List.flatMap_append + +private lemma ins_replicate (n : ℕ) : + ins (List.replicate n true ++ [false]) = List.replicate (n + 1) true ++ [false] := by + induction n with + | zero => rfl + | succ n ih => + rw [List.replicate_succ, List.cons_append] + change [true] ++ ins _ = _ + rw [ih] + rfl + +private lemma frame_replicate_true (n : ℕ) : + frame (List.replicate n true) = List.replicate (2 * n) true ++ [false] := by + induction n with + | zero => rfl + | succ n ih => + rw [List.replicate_succ, frame_cons, ih, show 2 * (n + 1) = 2 * n + 1 + 1 by omega] + rfl + +/-- Four rewrites turn the encoded input into the encoded coded input cells. -/ +private lemma ins_four (x : List ℕ) : ins (ins (ins (ins (encList encUnary x)))) = + encList eSym (x.map fun a => some (a + 1)) := by + induction x with + | nil => rfl + | cons a x ih => + have hsym : eSym (some (a + 1)) = List.replicate (a + 1 + 1) true := rfl + rw [encList_cons, List.map_cons, encList_cons, ins_append, ins_append, ins_append, ins_append, + ih, hsym, encUnary_apply, frame_replicate_true, frame_replicate_true, ins_replicate, + ins_replicate, ins_replicate, ins_replicate, show 2 * (a + 1 + 1) = 2 * a + 1 + 1 + 1 + 1 by + omega] + +private lemma length_encList_recode (x : List ℕ) : + (encList eSym (x.map fun a => some (a + 1))).length = + (encList encUnary x).length + 4 * x.length := by + rw [← ins_four] + induction x with + | nil => rfl + | cons a x ih => + rw [encList_cons, ins_append, ins_append, ins_append, ins_append, List.length_append, + List.length_append, ih, encUnary_apply, frame_replicate_true, ins_replicate, ins_replicate, + ins_replicate, ins_replicate] + simp only [List.length_append, List.length_replicate, List.length_cons] + omega + +/-- **Recoding the input symbols**, in linear time. -/ +private lemma recode_inO : ComputableTidilyInO (fun x : List ℕ => x.map fun a => some (a + 1)) + (encList encUnary) (encList eSym) (fun x => (encList encUnary x).length) + fun x => (encList encUnary x).length := by + have hins : ComputableTidilyInDegree ins encBits encBits 1 1 := + .of_linear (insT.computableTidilyInLinearTimeAndSpace fun w => (insT_run w).symm) + have h₁ : ComputableTidilyInDegree (fun x : List ℕ => ins (encList encUnary x)) + (encList encUnary) encBits 1 1 := + .of_linear (insT.computableTidilyInLinearTimeAndSpace fun x => (insT_run _).symm) + exact ((hins.comp (hins.comp (hins.comp h₁))).mono (d' := 1) (e' := 1)).inO_one.of_enc_eq + fun x => (ins_four x).symm + +/-! ### The intermediate value -/ + +/-- The intermediate value: the description, `t` in unary and the coded input cells. -/ +private abbrev eMid : Desc × ℕ × List (Option ℕ) ↪ List Bool := + encPair eDesc (encPair encUnary (encList eSym)) + +/-- The intermediate value, in time linear in the encoded input plus `O((t + 1) * (L + 1))`. -/ +private lemma mid_inO : ComputableTidilyInO + (fun i : Desc × List ℕ × ℕ => (i.1, i.2.2, i.2.1.map fun a => some (a + 1))) eIn eMid + (fun i => (eIn i).length + (i.2.2 + 1) * ((encNat i.2.2).length + 1)) + fun i => (eIn i).length + (i.2.2 + 1) * ((encNat i.2.2).length + 1) := by + have hd := fst eDesc (encPair (encList encUnary) encNat) + have hx := (snd eDesc (encPair (encList encUnary) encNat)).fst' + have ht := (snd eDesc (encPair (encList encUnary) encNat)).snd' + refine (hd.prod ((toUnary_inO.comp ht).prod (recode_inO.comp_linear hx))).mono 4 + (fun i => ?_) fun i => ?_ + all_goals + have h := length_le_encPair_left (encList encUnary) encNat i.2 + simp only [length_encPair] at * + omega + +/-- The first problem from the intermediate value, in time linear in its encoding plus cubic in the +length of the description. -/ +private lemma fin_inO : ComputableTidilyInO (fun m : Desc × ℕ × List (Option ℕ) => + ((m.1, m.2.1, (some m.1.q₀, ⟨0, [some 0].take m.2.1, m.2.2.take (m.2.1 + 1)⟩ :: + List.replicate m.1.tapes ⟨0, [], []⟩)) : Prob)) + eMid eProb (fun m => (eMid m).length + (descLen m.1 + 1) ^ 3) + fun m => (eMid m).length + (descLen m.1 + 1) ^ 3 := by + have pd := fst eDesc (encPair encUnary (encList eSym)) + have pt := (snd eDesc (encPair encUnary (encList eSym))).fst' + have pxs := (snd eDesc (encPair encUnary (encList eSym))).snd' + have hf : ComputableTidilyInO (fun d : Desc => (d.tapes, d.q₀, d.table)) eDesc + (encPair encUnary (encPair encUnary (encList (encPair eKey eAct)))) + (fun d => (eDesc d).length) fun d => (eDesc d).length := + of_linear (.of_eq fun _ => rfl) + have hq := ((ComputableTidilyInDegree.optionSome (enc₁ := encUnary) (enc := eSym)).inO_one + |>.comp_linear hf.snd'.fst').comp_linear pd + have hz : ComputableTidilyInO (fun n : ℕ => decide (n = 0)) encUnary encBool + (fun n => (encUnary n).length) fun n => (encUnary n).length := + of_linear (.of_isEmpty fun n => by cases n <;> rfl) + have hl := ite (hz.comp_linear pt) (const (encIn := eMid) (encMid := encList eSym) []) + (const [some 0]) + have hs : ComputableTidilyInO (fun n : ℕ => n + 1) encUnary encUnary + (fun n => (encUnary n).length) fun n => (encUnary n).length := + of_linear (.of_cons_true fun n => by simp only [encUnary_apply, List.replicate_succ]) + have hr := (takeU eSym).comp_linear (pxs.prod (hs.comp_linear pt)) + have htape := ((const (encIn := eMid) (encMid := encInt) (0 : ℤ)).prod (hl.prod hr)).of_enc_eq + (encOut := eTape) (g := fun m : Desc × ℕ × List (Option ℕ) => + (⟨0, if decide (m.2.1 = 0) then [] else [some 0], m.2.2.take (m.2.1 + 1)⟩ : Tape)) + fun m => rfl + have hb := (ComputableTidilyInDegree.replicate eTape).inO.comp + ((hf.fst'.comp_linear pd).prod (const (encMid := eTape) (⟨0, [], []⟩ : Tape))) + have hw := (htape.prod hb).of_enc_eq (encOut := encList eTape) + (g := fun m : Desc × ℕ × List (Option ℕ) => + (⟨0, if decide (m.2.1 = 0) then [] else [some 0], m.2.2.take (m.2.1 + 1)⟩ : Tape) :: + List.replicate m.1.tapes ⟨0, [], []⟩) + fun m => rfl + refine (((pd.prod (pt.prod (hq.prod hw))).mono 512 (fun m => ?_) fun m => ?_).of_enc_eq + fun m => ?_) + rotate_left 2 + · obtain ⟨d, t, xs⟩ := m + have h : [some 0].take t = if decide (t = 0) = true then [] else [some 0] := by + cases t <;> simp + dsimp only + rw [h] + rfl + all_goals + have htapes : m.1.tapes ≤ descLen m.1 := by + simp only [descLen, eDesc_apply, length_encPair, encUnary_apply, List.length_replicate] + omega + have hcube : ((encPair encUnary eTape (m.1.tapes, (⟨0, [], []⟩ : Tape))).length + 1) ^ 3 ≤ + 216 * (descLen m.1 + 1) ^ 3 := by + have hk : (eTape (⟨0, [], []⟩ : Tape)).length = 4 := rfl + rw [length_encPair, hk, encUnary_apply, List.length_replicate] + calc _ ≤ (6 * (descLen m.1 + 1)) ^ 3 := Nat.pow_le_pow_left (by omega) 3 + _ = _ := by ring + clear pd pt pxs hf hq hz hl hs hr htape hb hw + have he : (eMid m).length = (encPair eDesc (encPair encUnary (encList eSym)) m).length := rfl + simp only [Function.comp_apply] + split_ifs <;> omega + /-- **The first problem of the windowed simulation**, in time linear in the encoded input, cubic in the length of the description and `O((t + 1) * (L + 1))` for `t` steps written with `L` binary digits. -/ @@ -37,7 +304,17 @@ theorem initProb_inO : Prob)) eIn eProb (fun i => (eIn i).length + (descLen i.1 + 1) ^ 3 + (i.2.2 + 1) * ((encNat i.2.2).length + 1)) (fun i => (eIn i).length + (descLen i.1 + 1) ^ 3 + - (i.2.2 + 1) * ((encNat i.2.2).length + 1)) := - sorry + (i.2.2 + 1) * ((encNat i.2.2).length + 1)) := by + refine (((fin_inO.comp mid_inO).mono 8 (fun i => ?_) fun i => ?_).of_enc_eq + fun i => ?_).computableInO + rotate_left 2 + · rw [extract_initWin] + rfl + all_goals + have h₁ := length_encList_recode i.2.1 + have h₂ := length_le_length_encList encUnary i.2.1 + have h₃ : i.2.2 ≤ (i.2.2 + 1) * ((encNat i.2.2).length + 1) := by nlinarith + simp only [length_encPair, encUnary_apply, List.length_replicate] at * + omega end Turing.MultiTapeTM.Universal.Windowed From 4702b7431f86ea154514b757c0cee12ceea4a2a4 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:34:40 +0000 Subject: [PATCH 18/40] style: line lengths --- .../Turing/MultiTape/Combinators/DivConq.lean | 6 ++++-- .../Turing/MultiTape/Combinators/StackLoop.lean | 3 ++- .../Turing/MultiTape/Complexity/BigO/Cases.lean | 16 ++++++++++------ 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 5769c04d72..05e6d00cb3 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -348,10 +348,12 @@ private lemma retSwap_inO (encPair encB (encOption (encFrame encA encG))) (encPair (encList (encFrame encA encG)) (encVal encA encB)) (fun q => (encPair encB (encOption (encFrame encA encG)) q).length + q.2.elim 0 - (fun x => x.elim (fun a => Tm (a, q.1) + Sm (a, q.1) + (encPair encA encG (D.mid (a, q.1))).length) + (fun x => x.elim + (fun a => Tm (a, q.1) + Sm (a, q.1) + (encPair encA encG (D.mid (a, q.1))).length) (fun g => Tj (g, q.1) + Sj (g, q.1) + (encB (D.join (g, q.1))).length))) (fun q => (encPair encB (encOption (encFrame encA encG)) q).length + q.2.elim 0 - (fun x => x.elim (fun a => Tm (a, q.1) + Sm (a, q.1) + (encPair encA encG (D.mid (a, q.1))).length) + (fun x => x.elim + (fun a => Tm (a, q.1) + Sm (a, q.1) + (encPair encA encG (D.mid (a, q.1))).length) (fun g => Tj (g, q.1) + Sj (g, q.1) + (encB (D.join (g, q.1))).length))) := by -- the middle: the second subproblem is called, the saved data pushed have hm := hmid.comp (swap_inO (encS := encB) (encT := encA)) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean index 1772b1d143..fe7d202988 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean @@ -100,7 +100,8 @@ theorem ComputableInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} ∑ i ∈ Finset.range (n x), (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + - (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length)) := + (encPair (encList encG) encA + (L.round (roundInput (L.step^[i] (init x, []))))).length)) := sorry end Turing.MultiTapeTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean index 5a2e707b8f..c4266ff554 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean @@ -15,9 +15,10 @@ import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Ite # Case analysis on a component, within given bounds Case analysis on the second component of a pair, when that component is a tagged sum -(`Turing.MultiTapeTM.encSum`) or an option (`Turing.MultiTapeTM.encOption`). Each branch need only be computable on its own case, and only the -branch taken is charged, plus the length of the encoded input. No default values of the component -types are needed: the branches run on the inputs of their case only. +(`Turing.MultiTapeTM.encSum`) or an option (`Turing.MultiTapeTM.encOption`). Each branch need +only be computable on its own case, and only the branch taken is charged, plus the length of the +encoded input. No default values of the component types are needed: the branches run on the +inputs of their case only. ## Main results @@ -83,7 +84,8 @@ private lemma keepFrame_drop {σ : Type} {encS : σ ↪ List Bool} {h : σ → /-- **Case analysis on a sum component.** If `f` is computable on the left case and `g` on the right case, so is the case analysis, within the bounds of the branch taken plus the length of the encoded input. -/ -private theorem sumElimSnd_tidy {f : π × α → ε} {g : π × β → ε} {Tf Sf : π × α → ℕ} {Tg Sg : π × β → ℕ} +private theorem sumElimSnd_tidy {f : π × α → ε} {g : π × β → ε} {Tf Sf : π × α → ℕ} + {Tg Sg : π × β → ℕ} (hf : ComputableTidilyInO f (encPair encP encA) encE Tf Sf) (hg : ComputableTidilyInO g (encPair encP encB) encE Tg Sg) : ComputableTidilyInO @@ -107,12 +109,14 @@ private theorem sumElimSnd_tidy {f : π × α → ε} {g : π × β → ε} {Tf fun p => (p.1.1, p.1.2.getLeft (by simpa using p.2)) let R : {p : π × (α ⊕ β) // p.2.isLeft = false} → π × β := fun p => (p.1.1, p.1.2.getRight (by simpa using p.2)) - have hL := keepFrame_drop (encP := encP) (encA := encA) (encS := (Function.Embedding.subtype _).trans enc) (h := L) 1 + have hL := keepFrame_drop (encP := encP) (encA := encA) + (encS := (Function.Embedding.subtype _).trans enc) (h := L) 1 fun ⟨⟨x, s⟩, hs⟩ => by cases s with | inl a => exact ⟨false :: encA a, by simp [enc, L], rfl⟩ | inr b => simp at hs - have hR := keepFrame_drop (encP := encP) (encA := encB) (encS := (Function.Embedding.subtype _).trans enc) (h := R) 1 + have hR := keepFrame_drop (encP := encP) (encA := encB) + (encS := (Function.Embedding.subtype _).trans enc) (h := R) 1 fun ⟨⟨x, s⟩, hs⟩ => by cases s with | inl a => simp at hs From 10053b2a0018322c0f405df70bfdeefa088224ce Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:35:25 +0000 Subject: [PATCH 19/40] feat(universal): certificates for windowed cutting, pasting, stepping and halving (#800) --- .../MultiTape/Universal/WindowedParts.lean | 279 ++++++++++++++++++ 1 file changed, 279 insertions(+) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean index c6e588428c..9e325270ac 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean @@ -12,6 +12,7 @@ import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Encoding import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TakeDropUnary import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Quantitative import Complexity.Computability.Machines.Turing.MultiTape.Internal.BinaryPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.BinarySizeFacts import Complexity.Computability.Machines.Turing.MultiTape.Internal.EqualityPrimitives import Mathlib.Tactic.Linarith import Mathlib.Tactic.Ring @@ -323,4 +324,282 @@ theorem half_inO : (of_linear ((halfT true).computableTidilyInLinearTimeAndSpace fun n => (run_halfT true n).2.symm)).computableInO +/-! ### A windowed step -/ + +section TapeDegree + +private lemma tapeFields_deg : ComputableTidilyInDegree (fun t : Tape => (t.head, t.left, t.right)) + eTape eTapeFields 1 1 := + ComputableTidilyInDegree.of_eq fun _ => rfl + +@[local fun_prop] +private lemma tapeMk_deg : ComputableTidilyInDegree + (fun p : ℤ × List (Option ℕ) × List (Option ℕ) => Tape.mk p.1 p.2.1 p.2.2) eTapeFields eTape + 1 1 := + ComputableTidilyInDegree.of_eq fun _ => rfl + +@[local fun_prop] +private lemma tapeHead_deg : ComputableTidilyInDegree Tape.head eTape encInt 1 1 := + tapeFields_deg.fst' + +@[local fun_prop] +private lemma tapeLeft_deg : ComputableTidilyInDegree Tape.left eTape (encList eSym) 1 1 := + tapeFields_deg.snd'.fst' + +@[local fun_prop] +private lemma tapeRight_deg : ComputableTidilyInDegree Tape.right eTape (encList eSym) 1 1 := + tapeFields_deg.snd'.snd' + +/-- The symbol under the head. -/ +@[local fun_prop] +private lemma read_deg : ComputableTidilyInDegree Tape.read eTape eSym 1 1 := by + unfold Tape.read + fun_prop (disch := lia) + +/-- A right move. -/ +private lemma movePos_deg : + ComputableTidilyInDegree (fun t : Tape => t.move .pos) eTape eTape 1 1 := by + simp only [Tape.move] + fun_prop (disch := lia) + +/-- A left move. -/ +private lemma moveNeg_deg : + ComputableTidilyInDegree (fun t : Tape => t.move .neg) eTape eTape 1 1 := by + simp only [Tape.move] + fun_prop (disch := lia) + +end TapeDegree + +/-! #### Coded input cells -/ + +private lemma inPos_eq (c : Option ℕ) : inPos c = if decide (c = some 0) then 0 else 1 := by + simp only [inPos, decide_eq_true_eq] + +private lemma inSym_eq (c : Option ℕ) : inSym c = + if decide (c = some 0) then none else if c.isSome then some (c.getD 0 - 1) else none := by + rcases c with _ | _ | v <;> simp [inSym] + +private lemma inPos_le (c : Option ℕ) : inPos c ≤ 1 := by + unfold inPos; split_ifs <;> omega + +private lemma length_inSym_le (c : Option ℕ) : (eSym (inSym c)).length ≤ (eSym c).length := by + rcases c with _ | _ | v <;> simp [inSym] + +/-- Whether a coded input cell is the left end, in quadratic time. -/ +private lemma isEnd_inO : ComputableTidilyInO (fun c : Option ℕ => decide (c = some 0)) eSym + encBool (fun c => ((eSym c).length + 1) ^ 2) fun c => (eSym c).length := by + refine ((ComputableInO.eq eSym).tidy.comp ((of_linear (.of_eq fun _ => rfl) : + ComputableTidilyInO (fun c : Option ℕ => c) eSym eSym _ _).prod + (const (some 0)))).mono 8 (fun c => ?_) fun c => ?_ <;> + · simp only [length_encPair, encOption_some, encUnary_apply, List.length_cons, + List.length_replicate] + nlinarith + +/-- `Turing.MultiTapeTM.Universal.Windowed.inPos`, in quadratic time. -/ +private lemma inPos_inO : ComputableTidilyInO inPos eSym encNat + (fun c => ((eSym c).length + 1) ^ 2) fun c => (eSym c).length := by + refine ((isEnd_inO.ite (const 0) (const 1)).of_enc_eq (g := inPos) + fun c => by rw [inPos_eq]).mono 4 (fun c => ?_) fun c => ?_ <;> + · have : (eSym c).length ≤ ((eSym c).length + 1) ^ 2 := by nlinarith + split_ifs <;> omega + +/-- `Turing.MultiTapeTM.Universal.Windowed.inSym`, in quadratic time. -/ +private lemma inSym_inO : ComputableTidilyInO inSym eSym eSym + (fun c => ((eSym c).length + 1) ^ 2) fun c => (eSym c).length := by + have hsome := (ComputableTidilyInDegree.optionSome (enc₁ := encUnary) (enc := eSym)).inO_one + |>.comp_linear (ComputableTidilyInDegree.unary_pred.inO_one.comp_linear + (ComputableTidilyInDegree.getD (enc₁ := encUnary) (enc := eSym) 0).inO_one) + refine ((isEnd_inO.ite (const none) ((ComputableTidilyInDegree.isSome encUnary).inO_one.ite + hsome (const none))).of_enc_eq (g := inSym) fun c => by rw [inSym_eq]; rfl).mono 4 + (fun c => ?_) fun c => ?_ <;> + · have : (eSym c).length ≤ ((eSym c).length + 1) ^ 2 := by nlinarith + have : (encOption encUnary c).length = (eSym c).length := rfl + split_ifs <;> omega + +/-! #### The step -/ + +/-- The input window, or a blank window if there is none. -/ +private def wHead (x : Desc × Win) : Tape := x.2.2.headD default + +/-- The context of the step on a windowed configuration with at least one window. -/ +private def wCtx (x : Desc × Win) : WCtx := + ((x.1, ⟨x.2.1, inPos (wHead x).read, x.2.2.tail⟩), inSym (wHead x).read) + +/-- The windowed configuration after a step, from the input window, its coded position and the +result of the step. -/ +private def wFin (y : (Tape × ℕ) × SCfg × Option ℕ) : Win × Option ℕ := + ((y.2.1.state, moveIn y.1.1 y.1.2 y.2.1.inputPos :: y.2.1.workTapes), y.2.2) + +private lemma wstep_eq (x : Desc × Win) : wstep x.1 x.2 = if x.2.2.isEmpty then (x.2, none) else + wFin ((wHead x, inPos (wHead x).read), stepWith (wCtx x).1.1 (wCtx x).1.2 (wCtx x).2) := by + obtain ⟨d, s, _ | ⟨i, ts⟩⟩ := x <;> rfl + +private lemma moveIn_eq (t : Tape) (p p' : ℕ) : moveIn t p p' = + if decide (p' = p + 1) then t.move .pos + else if decide (p' + 1 = p) then t.move .neg else t := by + simp only [moveIn, decide_eq_true_eq] + +/-- Reassembling the windowed configuration after a step, in quadratic time. -/ +private lemma wFin_inO : ComputableTidilyInO wFin + (encPair (encPair eTape encNat) (encPair eCfg eSym)) (encPair eWin eSym) + (fun y => ((encPair (encPair eTape encNat) (encPair eCfg eSym) y).length + 1) ^ 2) + fun y => (encPair (encPair eTape encNat) (encPair eCfg eSym) y).length := by + have hy₁ := fst (encPair eTape encNat) (encPair eCfg eSym) + have hy₂ := snd (encPair eTape encNat) (encPair eCfg eSym) + have ht := hy₁.fst' + have hp := hy₁.snd' + have hf := hy₂.fst'.of_enc_eq (encOut := eCfgFields) + (g := fun y : (Tape × ℕ) × SCfg × Option ℕ => (y.2.1.state, y.2.1.inputPos, y.2.1.workTapes)) + fun _ => rfl + have hp' := hf.snd'.fst' + have hsucc := ComputableInO.natSucc.tidy + have hc₁ := (ComputableInO.eq encNat).tidy.comp (hp'.prod (hsucc.comp hp)) + have hc₂ := (ComputableInO.eq encNat).tidy.comp ((hsucc.comp hp').prod hp) + have hmv := hc₁.ite (movePos_deg.inO_one.comp_linear ht) + (hc₂.ite (moveNeg_deg.inO_one.comp_linear ht) ht) + have hlist := (ComputableTidilyInDegree.cons eTape).inO_one.comp_linear + (hmv.prod hf.snd'.snd') + refine (((hf.fst'.prod hlist).prod hy₂.snd').of_enc_eq (g := wFin) fun y => ?_).mono 64 + (fun y => ?_) fun y => ?_ + · simp only [wFin, moveIn_eq] + rfl + all_goals + obtain ⟨⟨t, p⟩, ⟨s, p', ws⟩, o⟩ := y + have h₁ := length_encNat_add_le p 1 + have h₂ := length_encNat_add_le p' 1 + simp only [Function.comp_apply, length_encPair, eCfg_apply] at * + generalize (encNat (p + 1)).length = A at * + generalize (encNat (p' + 1)).length = A' at * + generalize (encNat p).length = P at * + generalize (encNat p').length = P' at * + generalize (eTape t).length = X at * + generalize (eSym s).length = S at * + generalize (encList eTape ws).length = L at * + generalize (eSym o).length = O at * + split_ifs <;> nlinarith + +/-! #### Sizes -/ + +private lemma length_read_le (t : Tape) : (eSym t.read).length ≤ (eTape t).length := by + have : (eSym (t.right.headD none)).length ≤ (encList eSym t.right).length := by + cases t.right <;> simp; omega + simp only [Tape.read, eTape_apply, length_encPair] at * + omega + +private lemma length_encList_tail_le {α : Type} (enc : α ↪ List Bool) (l : List α) : + (encList enc l.tail).length ≤ (encList enc l).length := + ((List.tail_sublist l).flatMap (frame ∘ enc)).length_le + +private lemma length_read_headD_le (l : List Tape) : + (eSym (l.headD default).read).length ≤ (encList eTape l).length := by + cases l with + | nil => exact le_of_eq rfl + | cons t l => + have := length_read_le t + simp only [List.headD_cons, encList_cons, List.length_append, length_frame] + omega + +private lemma length_eWCtx_wCtx_le (x : Desc × Win) : + (eWCtx (wCtx x)).length ≤ 4 * (encPair eDesc eWin x).length + 8 := by + have h₁ := length_inSym_le (wHead x).read + have h₂ := length_read_headD_le x.2.2 + have h₃ := length_encList_tail_le eTape x.2.2 + have h₄ : (encNat (inPos (wHead x).read)).length ≤ 1 := + (length_encNat_le _).trans (inPos_le _) + simp only [wCtx, wHead, eCfg_apply, length_encPair] at * + omega + +private lemma wTime_wCtx_le (x : Desc × Win) : + wTime (wCtx x) ≤ 32 * ((encPair eDesc eWin x).length + 1) ^ 3 := by + have hW := length_eWCtx_wCtx_le x + have h₁ : (wCtx x).1.2.workTapes.length ≤ (encList eTape x.2.2).length := by + have := length_le_length_encList eTape x.2.2 + simp only [wCtx, List.length_tail] + omega + have h₂ : (wCtx x).1.1.table.length ≤ (eDesc x.1).length := by + have := length_le_length_encList (encPair eKey eAct) x.1.table + simp only [wCtx, eDesc_apply, length_encPair] + omega + have h₃ : (encNat (wCtx x).1.2.inputPos).length ≤ 1 := + (length_encNat_le _).trans (inPos_le _) + have hN : (encList eTape x.2.2).length + (eDesc x.1).length ≤ (encPair eDesc eWin x).length := by + simp only [length_encPair] + omega + have hD : (eDesc (wCtx x).1.1).length ≤ (encPair eDesc eWin x).length := by + simp only [wCtx, length_encPair] + omega + unfold wTime + generalize (encPair eDesc eWin x).length = N at * + generalize (eWCtx (wCtx x)).length = W at * + generalize (eDesc (wCtx x).1.1).length = D at * + generalize (encNat (wCtx x).1.2.inputPos).length = P at * + have hA : (wCtx x).1.2.workTapes.length + (wCtx x).1.1.table.length + 1 ≤ 2 * (N + 1) := by + omega + have hP : (P + 1) ^ 2 ≤ 4 := by nlinarith + have h := Nat.mul_le_mul (Nat.mul_le_mul hA (show D + 1 ≤ N + 1 by omega)) + (show W + 1 ≤ 9 * (N + 1) by omega) + have : 1 ≤ (N + 1) ^ 3 := Nat.one_le_pow _ _ (Nat.succ_pos _) + nlinarith + +/-- The arguments of the reassembly: the input window, its coded position and the result of the +step, in cubic time and linear space. -/ +private lemma wArgs_inO : ComputableTidilyInO + (fun x : Desc × Win => ((wHead x, inPos (wHead x).read), + stepWith (wCtx x).1.1 (wCtx x).1.2 (wCtx x).2)) + (encPair eDesc eWin) (encPair (encPair eTape encNat) (encPair eCfg eSym)) + (fun x => ((encPair eDesc eWin x).length + 1) ^ 3) fun x => (encPair eDesc eWin x).length := by + have hd := fst eDesc eWin + have hw := snd eDesc eWin + have hhead := (ComputableTidilyInDegree.listHeadD eTape default).inO_one.comp_linear hw.snd' + have hread := read_deg.inO_one.comp_linear hhead + have hpos := inPos_inO.comp hread + have hsym := inSym_inO.comp hread + have htail := (ComputableTidilyInDegree.listTail eTape).inO_one.comp_linear hw.snd' + have hcfg := (hw.fst'.prod (hpos.prod htail)).of_enc_eq (encOut := eCfg) + (g := fun x : Desc × Win => (⟨x.2.1, inPos (wHead x).read, x.2.2.tail⟩ : SCfg)) fun _ => rfl + have hctx := ((hd.prod hcfg).prod hsym).of_enc_eq (encOut := eWCtx) (g := wCtx) fun _ => rfl + have hstep := stepWith_inO.comp hctx + refine (((hhead.prod hpos).prod hstep).of_enc_eq (g := fun x : Desc × Win => + ((wHead x, inPos (wHead x).read), stepWith (wCtx x).1.1 (wCtx x).1.2 (wCtx x).2)) + fun _ => rfl).mono 128 (fun x => ?_) fun x => ?_ + all_goals + have h₁ := length_read_headD_le x.2.2 + have h₂ := wTime_wCtx_le x + have h₃ := length_eWCtx_wCtx_le x + have hL : (encList eTape x.2.2).length ≤ (encPair eDesc eWin x).length := by + simp only [length_encPair]; omega + simp only [Function.comp_apply] at * + generalize (encPair eDesc eWin x).length = N at * + generalize (eSym (x.2.2.headD default).read).length = C at * + generalize wTime (wCtx x) = Wt at * + generalize (eWCtx (wCtx x)).length = W at * + have : 1 ≤ (N + 1) ^ 3 := Nat.one_le_pow _ _ (Nat.succ_pos _) + have : (C + 1) ^ 2 ≤ (N + 1) ^ 3 := by + calc (C + 1) ^ 2 ≤ (N + 1) ^ 2 := Nat.pow_le_pow_left (by omega) 2 + _ ≤ (N + 1) ^ 3 := Nat.pow_le_pow_right (Nat.succ_pos _) (by omega) + have : N + 1 ≤ (N + 1) ^ 3 := Nat.le_self_pow (by norm_num) _ + omega + +/-- **A windowed step**, in time cubic in the encoded description and windows. -/ +theorem wstep_inO : + ComputableInO (fun p : Desc × Win => wstep p.1 p.2) (encPair eDesc eWin) (encPair eWin eSym) + (fun p => ((encPair eDesc eWin p).length + 1) ^ 3) + (fun p => ((encPair eDesc eWin p).length + 1) ^ 3) := by + obtain ⟨c, hc⟩ := wArgs_inO.length_le + have hw := snd eDesc eWin + have hempty := (ComputableTidilyInDegree.listIsEmpty eTape).inO_one.comp_linear hw.snd' + refine (((hempty.ite (hw.prod (const none)) (wFin_inO.comp wArgs_inO)).of_enc_eq + (g := fun x : Desc × Win => wstep x.1 x.2) fun x => by rw [wstep_eq]; rfl).mono + (4 * (c + 2) ^ 2) (fun x => ?_) fun x => ?_).computableInO + all_goals + have h := hc x + simp only [Function.comp_apply] at * + generalize (encPair eDesc eWin x).length = N at * + generalize (encPair (encPair eTape encNat) (encPair eCfg eSym) _).length = G at * + have hG : G + 1 ≤ (c + 1) * (N + 1) := by nlinarith + have hG2 := Nat.mul_le_mul hG hG + have h₁ : (N + 1) ^ 2 ≤ (N + 1) ^ 3 := Nat.pow_le_pow_right (Nat.succ_pos _) (by omega) + have h₂ : N + 1 ≤ (N + 1) ^ 3 := by nlinarith + split_ifs <;> nlinarith + end Turing.MultiTapeTM.Universal.Windowed From c58607bd5f48761c63a6b27480caa7223439fccb Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:37:10 +0000 Subject: [PATCH 20/40] wip(universal): D&C parts and node/base cost bounds for the windowed simulation (#800) --- .../Universal/WindowedComplexity.lean | 356 ++++++++++++++++++ 1 file changed, 356 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean new file mode 100644 index 0000000000..83e59353a2 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean @@ -0,0 +1,356 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedParts +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedInit +public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.DivConq +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring + +/-! +# The universal function in time `O(t log t)` + +TODO docstring +-/ + +namespace Turing.MultiTapeTM.Universal.Windowed + +open ComputableTidilyInO + +/-! ### The divide-and-conquer form of the windowed simulation -/ + +/-- The solution of a base problem: no step or one step. -/ +def baseSol (a : Prob) : Sol := + if a.2.1 = 0 then (a.2.2, []) else ((wstep a.1 a.2.2).1, (wstep a.1 a.2.2).2.toList) + +/-- The windowed simulation as a divide-and-conquer recursion. -/ +def simDC : DivConq Prob Sol Saved where + isBase a := decide (a.2.1 ≤ 1) + base := baseSol + left a := (a.1, firstHalf a.2.1, extract (firstHalf a.2.1) a.2.2) + mid p := ((p.1.1, p.1.2.1 / 2, extract (p.1.2.1 / 2) (restore (firstHalf p.1.2.1) p.1.2.2 p.2.1)), + (p.1.2.1 / 2, restore (firstHalf p.1.2.1) p.1.2.2 p.2.1, p.2.2)) + join q := (restore q.1.1 q.1.2.1 q.2.1, q.1.2.2 ++ q.2.2) + +/-! ### The parts -/ + +section Parts + +lemma prob_d : ComputableTidilyInO (fun a : Prob => a.1) eProb eDesc (fun a => (eProb a).length) + (fun a => (eProb a).length) := + fst _ _ + +lemma prob_n : ComputableTidilyInO (fun a : Prob => a.2.1) eProb encUnary + (fun a => (eProb a).length) (fun a => (eProb a).length) := + (snd eDesc (encPair encUnary eWin)).fst' + +lemma prob_w : ComputableTidilyInO (fun a : Prob => a.2.2) eProb eWin + (fun a => (eProb a).length) (fun a => (eProb a).length) := + (snd eDesc (encPair encUnary eWin)).snd' + +lemma length_eProb (a : Prob) : (eProb a).length = + 2 * descLen a.1 + 1 + (2 * a.2.1 + 1 + (eWin a.2.2).length) := by + show _ = 2 * (eDesc a.1).length + 1 + _ + simp only [length_encPair, encUnary_apply, List.length_replicate] + +lemma isBase_inO : ComputableTidilyInO simDC.isBase eProb encBool (fun a => (eProb a).length) + (fun a => (eProb a).length) := + (((ComputableTidilyInDegree.unary_isZero.comp ComputableTidilyInDegree.unary_pred).mono + (d' := 1) (e' := 1)).inO_one.comp_linear prob_n).of_enc_eq fun a => + congrArg encBool (decide_eq_decide.mpr (by dsimp only; omega)) + +lemma toList_inO : ComputableTidilyInO Option.toList eSym (encList encUnary) + (fun o => (eSym o).length) (fun o => (eSym o).length) := + ((((ComputableTidilyInDegree.isSome encUnary).inO_one).ite + ((ComputableTidilyInDegree.snoc encUnary).inO_one.comp_linear + ((const []).prod (ComputableTidilyInDegree.getD (enc₁ := encUnary) 0).inO_one)) + (const [])).mono 4 (fun o => by dsimp only [eSym]; split_ifs <;> omega) + (fun o => by dsimp only [eSym]; split_ifs <;> omega)).of_enc_eq + fun o => by cases o <;> rfl + +lemma length_dw_le (a : Prob) : (encPair eDesc eWin (a.1, a.2.2)).length ≤ (eProb a).length := by + simp only [length_encPair]; omega + +/-- The time and space of a base problem. -/ +def Tb (a : Prob) : ℕ := ((eProb a).length + 1) ^ 3 + +lemma base_inO : ComputableTidilyInO simDC.base eProb eSol Tb Tb := by + have hstep := wstep_inO.tidy.comp (prob_d.prod prob_w) + have hlive := hstep.fst'.prod (toList_inO.comp_linear hstep.snd') + have hidle := prob_w.prod (const (encMid := encList encUnary) []) + refine ((((ComputableTidilyInDegree.unary_isZero.inO_one.comp_linear prob_n).ite hidle + hlive).mono 8 (fun a => ?_) (fun a => ?_)).of_enc_eq fun a => ?_) + all_goals + have h₁ := length_dw_le a + have h₂ : (eProb a).length + 1 ≤ ((eProb a).length + 1) ^ 3 := Nat.le_self_pow (by omega) _ + have h₃ : ((encPair eDesc eWin (a.1, a.2.2)).length + 1) ^ 3 ≤ ((eProb a).length + 1) ^ 3 := + Nat.pow_le_pow_left (by omega) 3 + simp only [Function.comp_apply, Tb] + · split_ifs <;> omega + · split_ifs <;> omega + · simp only [simDC, baseSol] + split_ifs <;> simp_all + +/-- The time and space of the first subproblem. -/ +def Tl (a : Prob) : ℕ := (a.2.2.2.length + 1) * ((eProb a).length + 1) + +lemma left_inO : ComputableTidilyInO simDC.left eProb eProb Tl Tl := by + have hfh := firstHalf_inO.tidy.comp_linear prob_n + have hex := extract_inO.tidy.comp (hfh.prod prob_w) + refine ((prob_d.prod (hfh.prod hex)).mono 8 (fun a => ?_) (fun a => ?_)).of_enc_eq + fun a => rfl + all_goals + have h₁ : (encPair encUnary eWin (firstHalf a.2.1, a.2.2)).length ≤ (eProb a).length := by + rw [length_eProb]; simp only [length_encPair, encUnary_apply, List.length_replicate, + firstHalf]; omega + have h₂ := Nat.mul_le_mul_left (a.2.2.2.length + 1) (Nat.add_le_add_right h₁ 1) + have h₃ : (eProb a).length + 1 ≤ (a.2.2.2.length + 1) * ((eProb a).length + 1) := + Nat.le_mul_of_pos_left _ (by omega) + simp only [Function.comp_apply, Tl] at * + omega + +lemma length_restore_tapes_le (r : ℕ) (o i : Win) : (restore r o i).2.length ≤ o.2.length := by + simp only [restore, List.length_zipWith]; omega + +/-- The time and space of the middle part: the windows after the first half are pasted back. -/ +def Tm (p : Prob × Sol) : ℕ := + (p.1.2.2.2.length + 1) * + ((encPair eProb eSol p).length + (eWin (restore (firstHalf p.1.2.1) p.1.2.2 p.2.1)).length + 1) + +lemma mid_inO : ComputableTidilyInO simDC.mid (encPair eProb eSol) (encPair eProb eSaved) Tm Tm := by + have hd := prob_d.comp_linear (fst eProb eSol) + have hn := prob_n.comp_linear (fst eProb eSol) + have hw := prob_w.comp_linear (fst eProb eSol) + have hw1 := (fst eWin (encList encUnary)).comp_linear (snd eProb eSol) + have ho1 := (snd eWin (encList encUnary)).comp_linear (snd eProb eSol) + have hfh := firstHalf_inO.tidy.comp_linear hn + have hres := restore_inO.tidy.comp (hfh.prod (hw.prod hw1)) + have hh := half_inO.tidy.comp_linear hn + have hex := extract_inO.tidy.comp (hh.prod hres) + refine (((hd.prod (hh.prod hex)).prod (hh.prod (hres.prod ho1))).mono 16 (fun p => ?_) + (fun p => ?_)).of_enc_eq fun p => rfl + all_goals + obtain ⟨⟨d, n, w⟩, w₁', o₁⟩ := p + have h₁ : (encPair encUnary (encPair eWin eWin) (firstHalf n, w, w₁')).length ≤ + (encPair eProb eSol ((d, n, w), w₁', o₁)).length := by + simp only [length_encPair, encUnary_apply, List.length_replicate, firstHalf]; omega + have h₂ : (encPair encUnary eWin (n / 2, restore (firstHalf n) w w₁')).length ≤ + (encPair eProb eSol ((d, n, w), w₁', o₁)).length + + (eWin (restore (firstHalf n) w w₁')).length := by + simp only [length_encPair, encUnary_apply, List.length_replicate]; omega + have h₃ := length_restore_tapes_le (firstHalf n) w w₁' + have h₄ := Nat.mul_le_mul (Nat.add_le_add_right h₃ 1) (Nat.add_le_add_right h₂ 1) + have h₅ := Nat.mul_le_mul_left (w.2.length + 1) (Nat.add_le_add_right h₁ 1) + have h₆ : (encPair eProb eSol ((d, n, w), w₁', o₁)).length + + (eWin (restore (firstHalf n) w w₁')).length + 1 ≤ Tm ((d, n, w), w₁', o₁) := + Nat.le_mul_of_pos_left _ (by omega) + have h₇ : (w.2.length + 1) * ((encPair eProb eSol ((d, n, w), w₁', o₁)).length + 1) ≤ + Tm ((d, n, w), w₁', o₁) := Nat.mul_le_mul_left _ (by omega) + have h₈ : ((restore (firstHalf n) w w₁').2.length + 1) * + ((encPair encUnary eWin (n / 2, restore (firstHalf n) w w₁')).length + 1) ≤ + Tm ((d, n, w), w₁', o₁) := by + unfold Tm; exact h₄ + simp only [Function.comp_apply] at * + omega + +/-- The time and space of the combination. -/ +def Tj (q : Saved × Sol) : ℕ := (q.1.2.1.2.length + 1) * ((encPair eSaved eSol q).length + 1) + +lemma join_inO : ComputableTidilyInO simDC.join (encPair eSaved eSol) eSol Tj Tj := by + have hr := (fst encUnary (encPair eWin (encList encUnary))).comp_linear (fst eSaved eSol) + have hs := (snd encUnary (encPair eWin (encList encUnary))).comp_linear (fst eSaved eSol) + have hw2 := (fst eWin (encList encUnary)).comp_linear (snd eSaved eSol) + have ho2 := (snd eWin (encList encUnary)).comp_linear (snd eSaved eSol) + have hres := restore_inO.tidy.comp (hr.prod (hs.fst'.prod hw2)) + have happ := (ComputableTidilyInDegree.listAppend encUnary).inO_one.comp_linear + (hs.snd'.prod ho2) + refine ((hres.prod happ).mono 8 (fun q => ?_) (fun q => ?_)).of_enc_eq fun q => rfl + all_goals + obtain ⟨⟨r, w₁, o₁⟩, w₂', o₂⟩ := q + have h₁ : (encPair encUnary (encPair eWin eWin) (r, w₁, w₂')).length ≤ + (encPair eSaved eSol ((r, w₁, o₁), w₂', o₂)).length := by + simp only [length_encPair, encUnary_apply, List.length_replicate]; omega + have h₂ := Nat.mul_le_mul_left (w₁.2.length + 1) (Nat.add_le_add_right h₁ 1) + have h₃ : (encPair eSaved eSol ((r, w₁, o₁), w₂', o₂)).length + 1 ≤ + Tj ((r, w₁, o₁), w₂', o₂) := Nat.le_mul_of_pos_left _ (by omega) + simp only [Function.comp_apply, Tj] at * + omega + +end Parts + +/-! ### The cost recurrence -/ + +section Cost + +/-- The cost of a base problem charged by `Turing.MultiTapeTM.ComputableInO.divConq`. -/ +def baseCost (a : Prob) : ℕ := + (eProb a).length + (eProb a).length + Tb a + Tb a + (eProb a).length + + (eSol (simDC.base a)).length + 1 + +/-- The cost of a node charged by `Turing.MultiTapeTM.ComputableInO.divConq`. -/ +def nodeCost (a : Prob) (b₁ b₂ : Sol) : ℕ := + (eProb a).length + (eProb a).length + Tl a + Tl a + Tm (a, b₁) + Tm (a, b₁) + + Tj ((simDC.mid (a, b₁)).2, b₂) + Tj ((simDC.mid (a, b₁)).2, b₂) + + (eProb a).length + (eProb (simDC.left a)).length + (eSol b₁).length + + (eProb (simDC.mid (a, b₁)).1).length + (eSaved (simDC.mid (a, b₁)).2).length + + (eSol b₂).length + (eSol (simDC.join ((simDC.mid (a, b₁)).2, b₂))).length + 1 + +/-- The factor of the cost of the simulation, for a description of length `D` and cells at most +`B`. -/ +def costA (D B : ℕ) : ℕ := 10000000 * (D + B + 2) ^ 6 + +lemma winBound_node (D B n : ℕ) : + winBound D B 1 (4 * n + 1) + 1 ≤ 65 * ((D + 1) * (B + 1) * (n + 1)) ∧ + D + n + n * (2 * D + 1) ≤ winBound D B 1 (4 * n + 1) := by + unfold winBound + constructor + · nlinarith [Nat.zero_le (D * B * n), Nat.zero_le (D * B), Nat.zero_le (D * n), + Nat.zero_le (B * n)] + · nlinarith [Nat.zero_le (D * B * n), Nat.zero_le (D * B), Nat.zero_le (D * n), + Nat.zero_le (B * n)] + +lemma winBound_base (D B : ℕ) : winBound D B 1 5 ≤ 76 * ((D + 1) * (B + 1)) := by + unfold winBound + nlinarith [Nat.zero_le (D * B)] + +lemma le_sq_X (D B : ℕ) : (D + 1) * (B + 1) ≤ (D + B + 2) ^ 2 := by + nlinarith + +lemma simDC_base_eq {d : Desc} {n : ℕ} (hn : n ≤ 1) (w : Win) : + simDC.base (d, n, w) = sim d n w := by + rcases Nat.le_one_iff_eq_zero_or_eq_one.mp hn with rfl | rfl + · simp [simDC, baseSol, sim] + · simp [simDC, baseSol, sim] + +lemma baseCost_le {d : Desc} {B n : ℕ} {w : Win} (hDB : descLen d ≤ B) (hn : n ≤ 1) + (hw : WInv (descLen d) B 0 (2 * n + 1) w) : baseCost (d, n, w) ≤ costA (descLen d) B := by + have hZ := winBound_base (descLen d) B + have hX := le_sq_X (descLen d) B + have hw' := length_eWin_le (hw.mono (h' := 1) (L' := 5) (by omega) (by omega)) + have hs := length_eWin_le ((hw.sim hDB n).mono (h' := 1) (L' := 5) (by omega) (by omega)) + have ho := length_encList_sim_out_le d n w + have hn' : n * (2 * descLen d + 1) ≤ 2 * descLen d + 1 := + (Nat.mul_le_mul_right _ hn).trans (by rw [Nat.one_mul]) + have hX2 : (descLen d + B + 2) ^ 2 ≤ (descLen d + B + 2) ^ 6 := + Nat.pow_le_pow_right (by omega) (by omega) + have hE := length_eProb (d, n, w) + have hS : (eSol (sim d n w)).length = + 2 * (eWin (sim d n w).1).length + 1 + (encList encUnary (sim d n w).2).length := + length_encPair .. + unfold baseCost costA Tb + rw [simDC_base_eq hn] + have h83 : (83 * (descLen d + B + 2) ^ 2) ^ 3 = 571787 * (descLen d + B + 2) ^ 6 := by ring + simp only [descLen] at * + generalize (eProb (d, n, w)).length = E at * + have hY : E + 1 ≤ 83 * ((eDesc d).length + B + 2) ^ 2 := by + nlinarith + have hY3 := Nat.pow_le_pow_left hY 3 + have hY1 : E + 1 ≤ (E + 1) ^ 3 := Nat.le_self_pow (by omega) _ + omega + +lemma nodeCost_le {d : Desc} {B n : ℕ} {w : Win} (hDB : descLen d ≤ B) + (hw : WInv (descLen d) B 0 (2 * n + 1) w) : + nodeCost (d, n, w) (sim d (firstHalf n) (extract (firstHalf n) w)) + (sim d (n / 2) (extract (n / 2) + (restore (firstHalf n) w (sim d (firstHalf n) (extract (firstHalf n) w)).1))) ≤ + costA (descLen d) B * (n + 1) := by + have hfh : firstHalf n + n / 2 = n := by unfold firstHalf; omega + set b₁ := sim d (firstHalf n) (extract (firstHalf n) w) with hb₁ + set w₁ := restore (firstHalf n) w b₁.1 with hw₁ + set b₂ := sim d (n / 2) (extract (n / 2) w₁) with hb₂ + -- the bounds on the windows + have iL := (hw.extract (firstHalf n)).mono (h' := 0) (L' := 2 * firstHalf n + 1) le_rfl + (min_le_right _ _) + have ib₁ : WInv (descLen d) B 1 (2 * firstHalf n + 1 + 2 * firstHalf n) b₁.1 := + iL.sim hDB (firstHalf n) + have iw₁ : WInv (descLen d) B 0 (2 * n + 1 + 2 * firstHalf n) w₁ := + hw.restore_sim hDB (firstHalf n) (firstHalf n) + have iM := (iw₁.extract (n / 2)).mono (h' := 0) (L' := 2 * (n / 2) + 1) le_rfl + (min_le_right _ _) + have ib₂ : WInv (descLen d) B 1 (2 * (n / 2) + 1 + 2 * (n / 2)) b₂.1 := iM.sim hDB (n / 2) + have iJ : WInv (descLen d) B 0 (2 * n + 1 + 2 * firstHalf n + 2 * (n / 2)) + (restore (n / 2) w₁ b₂.1) := iw₁.restore_sim hDB (n / 2) (n / 2) + -- their sizes + obtain ⟨hZ, hZ'⟩ := winBound_node (descLen d) B n + have sw := length_eWin_le (hw.mono (h' := 1) (L' := 4 * n + 1) (by omega) (by omega)) + have sL := length_eWin_le (iL.mono (h' := 1) (L' := 4 * n + 1) (by omega) (by omega)) + have sb₁ := length_eWin_le (ib₁.mono (h' := 1) (L' := 4 * n + 1) (by omega) (by omega)) + have sw₁ := length_eWin_le (iw₁.mono (h' := 1) (L' := 4 * n + 1) (by omega) (by omega)) + have sM := length_eWin_le (iM.mono (h' := 1) (L' := 4 * n + 1) (by omega) (by omega)) + have sb₂ := length_eWin_le (ib₂.mono (h' := 1) (L' := 4 * n + 1) (by omega) (by omega)) + have sJ := length_eWin_le (iJ.mono (h' := 1) (L' := 4 * n + 1) (by omega) (by omega)) + have o₁ : (encList encUnary b₁.2).length ≤ firstHalf n * (2 * descLen d + 1) := + length_encList_sim_out_le d (firstHalf n) (extract (firstHalf n) w) + have o₂ : (encList encUnary b₂.2).length ≤ n / 2 * (2 * descLen d + 1) := + length_encList_sim_out_le d (n / 2) (extract (n / 2) w₁) + have o₁' := Nat.mul_le_mul_right (2 * descLen d + 1) (show firstHalf n ≤ n by omega) + have o₂' := Nat.mul_le_mul_right (2 * descLen d + 1) (show n / 2 ≤ n by omega) + have o₁₂ : firstHalf n * (2 * descLen d + 1) + n / 2 * (2 * descLen d + 1) = + n * (2 * descLen d + 1) := by rw [← Nat.add_mul, hfh] + generalize winBound (descLen d) B 1 (4 * n + 1) = Z at * + -- the sizes of the values + have hA : (eProb (d, n, w)).length ≤ 5 * Z + 2 := by rw [length_eProb]; dsimp only; omega + have hLp : (eProb (simDC.left (d, n, w))).length ≤ 5 * Z + 2 := by + show (eProb (d, firstHalf n, extract (firstHalf n) w)).length ≤ _ + rw [length_eProb]; dsimp only; unfold firstHalf at sL ⊢; omega + have hB₁ : (eSol b₁).length ≤ 3 * Z + 1 := by + rw [length_encPair (enc₁ := eWin) (enc₂ := encList encUnary)]; omega + have hMp : (eProb (simDC.mid ((d, n, w), b₁)).1).length ≤ 5 * Z + 2 := by + show (eProb (d, n / 2, extract (n / 2) w₁)).length ≤ _ + rw [length_eProb]; dsimp only; omega + have hS : (eSaved (simDC.mid ((d, n, w), b₁)).2).length ≤ 4 * Z + 2 := by + show (eSaved (n / 2, w₁, b₁.2)).length ≤ _ + rw [length_encPair (enc₁ := encUnary) (enc₂ := encPair eWin (encList encUnary)), + length_encPair (enc₁ := eWin) (enc₂ := encList encUnary)] + simp only [encUnary_apply, List.length_replicate] + omega + have hB₂ : (eSol b₂).length ≤ 3 * Z + 1 := by + rw [length_encPair (enc₁ := eWin) (enc₂ := encList encUnary)]; omega + have hJs : (eSol (simDC.join ((simDC.mid ((d, n, w), b₁)).2, b₂))).length ≤ 3 * Z + 1 := by + show (eSol (restore (n / 2) w₁ b₂.1, b₁.2 ++ b₂.2)).length ≤ _ + rw [length_encPair (enc₁ := eWin) (enc₂ := encList encUnary)] + simp only [encList_append, List.length_append] + omega + -- the products + have hk := hw.tapes + have hk₁ := iw₁.tapes + have hP : ∀ {k m c : ℕ}, k ≤ descLen d + 1 → m ≤ c * (Z + 1) → + (k + 1) * m ≤ c * ((descLen d + 2) * (Z + 1)) := fun hk hm => + (Nat.mul_le_mul (Nat.add_le_add_right hk 1) hm).trans (le_of_eq (by ring)) + have hTl : Tl (d, n, w) ≤ 5 * ((descLen d + 2) * (Z + 1)) := hP hk (by omega) + have hTm : Tm ((d, n, w), b₁) ≤ 14 * ((descLen d + 2) * (Z + 1)) := by + refine hP (m := (encPair eProb eSol ((d, n, w), b₁)).length + (eWin w₁).length + 1) hk ?_ + rw [length_encPair (enc₁ := eProb) (enc₂ := eSol)]; dsimp only; omega + have hTj : Tj ((simDC.mid ((d, n, w), b₁)).2, b₂) ≤ 11 * ((descLen d + 2) * (Z + 1)) := by + refine hP (k := w₁.2.length) + (m := (encPair eSaved eSol ((simDC.mid ((d, n, w), b₁)).2, b₂)).length + 1) hk₁ ?_ + rw [length_encPair (enc₁ := eSaved) (enc₂ := eSol)]; dsimp only; omega + have hZP : Z + 1 ≤ (descLen d + 2) * (Z + 1) := Nat.le_mul_of_pos_left _ (by omega) + have hX3 : (descLen d + 2) * ((descLen d + 1) * (B + 1)) ≤ (descLen d + B + 2) ^ 6 := + calc _ ≤ (descLen d + B + 2) * ((descLen d + B + 2) * (descLen d + B + 2)) := + Nat.mul_le_mul (by omega) (Nat.mul_le_mul (by omega) (by omega)) + _ = (descLen d + B + 2) ^ 3 := by ring + _ ≤ _ := Nat.pow_le_pow_right (by omega) (by omega) + have hfin : 100 * ((descLen d + 2) * (Z + 1)) ≤ costA (descLen d) B * (n + 1) := + calc 100 * ((descLen d + 2) * (Z + 1)) + ≤ 100 * ((descLen d + 2) * (65 * ((descLen d + 1) * (B + 1) * (n + 1)))) := + Nat.mul_le_mul_left _ (Nat.mul_le_mul_left _ hZ) + _ = 6500 * ((descLen d + 2) * ((descLen d + 1) * (B + 1)) * (n + 1)) := by ring + _ ≤ 6500 * ((descLen d + B + 2) ^ 6 * (n + 1)) := + Nat.mul_le_mul_left _ (Nat.mul_le_mul_right _ hX3) + _ ≤ costA (descLen d) B * (n + 1) := by + unfold costA + rw [Nat.mul_assoc] + exact Nat.mul_le_mul_right _ (by norm_num) + unfold nodeCost + omega + +end Cost + +end Turing.MultiTapeTM.Universal.Windowed From 74341cb2e60a85a7b4fb1fe79aa41d464658cfec Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:39:17 +0000 Subject: [PATCH 21/40] feat(universal): the universal function in time O(t log t) (#800) --- .../Universal/WindowedComplexity.lean | 146 ++++++++++++++++++ 1 file changed, 146 insertions(+) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean index 83e59353a2..e31a44a956 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean @@ -10,6 +10,7 @@ module public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedParts public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedInit public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.DivConq +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Constructible import Mathlib.Tactic.Linarith import Mathlib.Tactic.Ring @@ -351,6 +352,151 @@ lemma nodeCost_le {d : Desc} {B n : ℕ} {w : Win} (hDB : descLen d ≤ B) unfold nodeCost omega +lemma eval_base {d : Desc} {B n : ℕ} {w : Win} (hDB : descLen d ≤ B) (hn : n ≤ 1) + (hw : WInv (descLen d) B 0 (2 * n + 1) w) : + ∃ c, simDC.Eval baseCost nodeCost (d, n, w) (sim d n w) c ∧ c ≤ costA (descLen d) B := by + refine ⟨baseCost (d, n, w), ?_, baseCost_le hDB hn hw⟩ + rw [← simDC_base_eq hn] + exact .base (by simp only [simDC, decide_eq_true_eq]; exact hn) + +/-- **The cost recurrence**: on `n ≤ 2 ^ k` steps, the windowed simulation costs at most +`2 ^ (k + 1) * (k + 1) * costA D B`. -/ +lemma eval_le (d : Desc) {B : ℕ} (hDB : descLen d ≤ B) (k : ℕ) : + ∀ n w, n ≤ 2 ^ k → WInv (descLen d) B 0 (2 * n + 1) w → + ∃ c, simDC.Eval baseCost nodeCost (d, n, w) (sim d n w) c ∧ + c ≤ 2 ^ (k + 1) * (k + 1) * costA (descLen d) B := by + induction k with + | zero => + intro n w hn hw + obtain ⟨c, hc, hle⟩ := eval_base hDB (by simpa using hn) hw + exact ⟨c, hc, by simp only [zero_add, pow_one, Nat.mul_one]; omega⟩ + | succ k ih => + intro n w hn hw + have hA : costA (descLen d) B ≤ 2 ^ (k + 1 + 1) * (k + 1 + 1) * costA (descLen d) B := + Nat.le_mul_of_pos_left _ (Nat.mul_pos (Nat.pow_pos (by omega)) (by omega)) + by_cases hn1 : n ≤ 1 + · obtain ⟨c, hc, hle⟩ := eval_base hDB hn1 hw + exact ⟨c, hc, hle.trans hA⟩ + have hpow : 2 ^ (k + 1) = 2 * 2 ^ k := by ring + have iL := (hw.extract (firstHalf n)).mono (h' := 0) (L' := 2 * firstHalf n + 1) le_rfl + (min_le_right _ _) + obtain ⟨c₁, h₁, hc₁⟩ := ih (firstHalf n) _ (by unfold firstHalf; omega) iL + have iw₁ := hw.restore_sim hDB (firstHalf n) (firstHalf n) + have iM := (iw₁.extract (n / 2)).mono (h' := 0) (L' := 2 * (n / 2) + 1) le_rfl + (min_le_right _ _) + obtain ⟨c₂, h₂, hc₂⟩ := ih (n / 2) _ (by omega) iM + have hnode := DivConq.Eval.node (D := simDC) (a := (d, n, w)) + (by simp only [simDC, decide_eq_false_iff_not]; omega) h₁ h₂ + have hcost := nodeCost_le hDB hw + obtain ⟨m, rfl⟩ : ∃ m, n = m + 2 := ⟨n - 2, by omega⟩ + rw [show simDC.join ((simDC.mid ((d, m + 2, w), sim d (firstHalf (m + 2)) + (extract (firstHalf (m + 2)) w))).2, sim d ((m + 2) / 2) (extract ((m + 2) / 2) + (restore (firstHalf (m + 2)) w (sim d (firstHalf (m + 2)) + (extract (firstHalf (m + 2)) w)).1))) = sim d (m + 2) w by + rw [sim_add_two]; rfl] at hnode + refine ⟨_, hnode, ?_⟩ + · have h2 : m + 2 + 1 ≤ 2 * 2 ^ (k + 1) := by omega + calc c₁ + c₂ + nodeCost (d, m + 2, w) _ _ + ≤ 2 ^ (k + 1) * (k + 1) * costA (descLen d) B + + 2 ^ (k + 1) * (k + 1) * costA (descLen d) B + + costA (descLen d) B * (m + 2 + 1) := by omega + _ ≤ 2 ^ (k + 1) * (k + 1) * costA (descLen d) B + + 2 ^ (k + 1) * (k + 1) * costA (descLen d) B + + costA (descLen d) B * (2 * 2 ^ (k + 1)) := by gcongr + _ = 2 ^ (k + 1 + 1) * (k + 1 + 1) * costA (descLen d) B := by ring + end Cost end Turing.MultiTapeTM.Universal.Windowed + +namespace Turing.MultiTapeTM.Universal + +open Windowed ComputableTidilyInO + +/-- The output of the universal function from the result of the windowed simulation. -/ +lemma post_inO : ComputableTidilyInO (fun s : Sol => (s.2, s.1.1.isNone)) eSol eOut + (fun s => (eSol s).length) (fun s => (eSol s).length) := by + have hst := (fst eSym (encList eTape)).comp_linear (fst eWin (encList encUnary)) + have hnone := (ComputableTidilyInDegree.of_finite (encIn := encBool) (encMid := encBool) + (fun b : Bool => !b)).inO_one.comp_linear + ((ComputableTidilyInDegree.isSome encUnary).inO_one.comp_linear hst) + exact (((snd eWin (encList encUnary)).prod hnone).mono 2 (fun s => by dsimp only [eSol]; omega) + (fun s => by dsimp only [eSol]; omega)).of_enc_eq fun ⟨⟨st, ts⟩, o⟩ => by cases st <;> rfl + +lemma length_encNat_le_log (t : ℕ) : (encNat t).length ≤ Nat.log 2 (t + 1) + 1 := by + have h := Nat.le_log_of_pow_le (b := 2) (by norm_num) + (show 2 ^ (encNat t).length ≤ (t + 1) * 2 by + have := two_pow_length_encNat_le t; omega) + rwa [Nat.log_mul_base (by norm_num) (by omega)] at h + +lemma two_pow_log_le (t : ℕ) : 2 ^ Nat.log 2 t ≤ t + 1 := by + rcases Nat.eq_zero_or_pos t with rfl | ht + · simp + · exact (Nat.pow_log_le_self 2 (by omega)).trans (by omega) + +/-- **The universal function in time `O(t log t)`.** For a description `d` of encoded length `D`, +an input `x` with largest symbol `M` and `t` steps given in binary, the universal function is +computable in time and space `O(N + (D + M + 2) ^ 6 * (t + 1) * (log₂ (t + 1) + 1))`, where `N` is +the length of the encoded input `(d, x, t)`. -/ +public theorem computableInO_universal_nlogn : + ComputableInO universal eIn eOut + (fun i => (eIn i).length + + (descLen i.1 + listMax id i.2.1 + 2) ^ 6 * ((i.2.2 + 1) * (Nat.log 2 (i.2.2 + 1) + 1))) + (fun i => (eIn i).length + + (descLen i.1 + listMax id i.2.1 + 2) ^ 6 * ((i.2.2 + 1) * (Nat.log 2 (i.2.2 + 1) + 1))) := by + have hev : ∀ i : Desc × List ℕ × ℕ, ∃ c, simDC.Eval baseCost nodeCost + (i.1, i.2.2, extract i.2.2 (initWin i.1 i.2.1)) + (sim i.1 i.2.2 (extract i.2.2 (initWin i.1 i.2.1))) c ∧ + c ≤ 2 ^ (Nat.log 2 i.2.2 + 1 + 1) * (Nat.log 2 i.2.2 + 1 + 1) * + costA (descLen i.1) (descLen i.1 + listMax id i.2.1 + 1) := fun i => + eval_le i.1 (by omega) (Nat.log 2 i.2.2 + 1) i.2.2 _ + (Nat.lt_pow_succ_log_self (by norm_num) _).le + (((winv_initWin i.1 i.2.1).extract i.2.2).mono le_rfl (min_le_right _ _)) + choose C hC using hev + have hdc := ComputableInO.divConq simDC initProb_inO isBase_inO.computableInO + base_inO.computableInO left_inO.computableInO mid_inO.computableInO join_inO.computableInO + (cb := baseCost) (cn := nodeCost) (fun _ _ => le_rfl) (fun _ _ _ _ => le_rfl) + (fun i => (hC i).1) + refine (((post_inO.comp_linear hdc.tidy).of_enc_eq (g := universal) fun ⟨d, x, t⟩ => by + rw [universal_eq_sim]; rfl).computableInO.mono 6000000000 (fun i => ?_) (fun i => ?_)) + all_goals + obtain ⟨d, x, t⟩ := i + have hY : descLen d + 1 ≤ descLen d + listMax id x + 2 := by omega + have hY6 : 1 ≤ (descLen d + listMax id x + 2) ^ 6 := Nat.one_le_pow _ _ (by omega) + have hD3 : (descLen d + 1) ^ 3 ≤ (descLen d + listMax id x + 2) ^ 6 := + (Nat.pow_le_pow_left hY 3).trans (Nat.pow_le_pow_right (by omega) (by omega)) + have hQ1 : 1 ≤ (t + 1) * (Nat.log 2 (t + 1) + 1) := Nat.one_le_iff_ne_zero.mpr (by positivity) + have hQ : (t + 1) * ((encNat t).length + 1) ≤ 2 * ((t + 1) * (Nat.log 2 (t + 1) + 1)) := by + have := length_encNat_le_log t + calc (t + 1) * ((encNat t).length + 1) ≤ (t + 1) * (2 * (Nat.log 2 (t + 1) + 1)) := + Nat.mul_le_mul_left _ (by omega) + _ = _ := by ring + have hlog : Nat.log 2 t ≤ Nat.log 2 (t + 1) := Nat.log_mono_right (by omega) + have hC1 : 2 ^ (Nat.log 2 t + 1 + 1) * (Nat.log 2 t + 1 + 1) ≤ + 8 * ((t + 1) * (Nat.log 2 (t + 1) + 1)) := + calc 2 ^ (Nat.log 2 t + 1 + 1) * (Nat.log 2 t + 1 + 1) + ≤ (4 * (t + 1)) * (2 * (Nat.log 2 (t + 1) + 1)) := by + refine Nat.mul_le_mul ?_ (by omega) + have := two_pow_log_le t + rw [pow_succ, pow_succ]; omega + _ = _ := by ring + have hC2 : costA (descLen d) (descLen d + listMax id x + 1) ≤ + 640000000 * (descLen d + listMax id x + 2) ^ 6 := by + unfold costA + calc 10000000 * (descLen d + (descLen d + listMax id x + 1) + 2) ^ 6 + ≤ 10000000 * (2 * (descLen d + listMax id x + 2)) ^ 6 := + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left (by omega) 6) + _ = _ := by ring + have hC3 := (hC (d, x, t)).2 + have hC4 : C (d, x, t) ≤ 5120000000 * ((descLen d + listMax id x + 2) ^ 6 * + ((t + 1) * (Nat.log 2 (t + 1) + 1))) := + calc C (d, x, t) ≤ 8 * ((t + 1) * (Nat.log 2 (t + 1) + 1)) * + (640000000 * (descLen d + listMax id x + 2) ^ 6) := + hC3.trans (Nat.mul_le_mul hC1 hC2) + _ = _ := by ring + have hP1 := Nat.le_mul_of_pos_right ((descLen d + listMax id x + 2) ^ 6) hQ1 + have hP2 := Nat.le_mul_of_pos_left ((t + 1) * (Nat.log 2 (t + 1) + 1)) hY6 + dsimp only at * + omega + +end Turing.MultiTapeTM.Universal From a7e042d85e0de6b294ec0d62fe8705b0fdace635 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:39:45 +0000 Subject: [PATCH 22/40] wip(stack-loop): tape layout and phases of the stack-loop machine (#800) --- .../MultiTape/Combinators/StackLoop.lean | 18 +- .../MultiTape/Internal/KernelStackLoop.lean | 515 ++++++++++++++++++ 2 files changed, 524 insertions(+), 9 deletions(-) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean index 42ac39eeb6..1772b1d143 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean @@ -30,8 +30,8 @@ of their calls, rather than paying for the whole recursion state on every round. ## Main results -* `Turing.MultiTapeTM.ComputableTidilyInO.stackLoop`: if the initial value, the halting test and - the round are tidily computable, so is the value at which the loop halts with an empty stack, +* `Turing.MultiTapeTM.ComputableInO.stackLoop`: if the initial value, the halting test and + the round are computable, so is the value at which the loop halts with an empty stack, within the sum over the rounds of their costs and the lengths of the words they touch. -/ @@ -67,24 +67,24 @@ end StackLoop open StackLoop /-- **Stack loops.** If the initial value, the halting test and the round of a stack loop are -tidily computable, and from the initial value with an empty stack the loop halts after `n x` -rounds with an empty stack, then the halting value is tidily computable. The time and space are +computable, and from the initial value with an empty stack the loop halts after `n x` +rounds with an empty stack, then the halting value is computable. The time and space are the costs of the initialization, plus, for every round and the final halting test, the costs of the halting test and of the round together with the lengths of the words they read and write. The frames are kept on a separate work tape: a round pays for the popped and pushed frames only, not for the rest of the stack. -/ -theorem ComputableTidilyInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} +theorem ComputableInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} {encA : α ↪ List Bool} {encG : γ ↪ List Bool} (L : StackLoop α γ) {init : δ → α} {Ti Si : δ → ℕ} {Th Sh : α → ℕ} {Tr Sr : Option γ × α → ℕ} (n : δ → ℕ) - (hinit : ComputableTidilyInO init encIn encA Ti Si) - (hhalt : ComputableTidilyInO L.halt encA encBool Th Sh) - (hround : ComputableTidilyInO L.round (encPair (encOption encG) encA) + (hinit : ComputableInO init encIn encA Ti Si) + (hhalt : ComputableInO L.halt encA encBool Th Sh) + (hround : ComputableInO L.round (encPair (encOption encG) encA) (encPair (encList encG) encA) Tr Sr) (hrun : ∀ x, ∀ i < n x, L.halt (L.step^[i] (init x, [])).1 = false) (hstop : ∀ x, L.halt (L.step^[n x] (init x, [])).1 = true) (hempty : ∀ x, (L.step^[n x] (init x, [])).2 = []) : - ComputableTidilyInO (fun x => (L.step^[n x] (init x, [])).1) encIn encA + ComputableInO (fun x => (L.step^[n x] (init x, [])).1) encIn encA (fun x => (encIn x).length + Ti x + Si x + ∑ i ∈ Finset.range (n x + 1), (Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean new file mode 100644 index 0000000000..deec228e3e --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean @@ -0,0 +1,515 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WordMoves +public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelOnWords +public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.CopyWord +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.OutputToTape +public import Cslib.Computability.Machines.Turing.MultiTape.Plumbing.ClearWork +import Mathlib.Tactic.FinCases + +/-! +# The stack-loop machine: tape layout and phases + +The machine of `Turing.MultiTapeTM.ComputableInO.stackLoop` has the `kk` work tapes shared by the +machines it runs, followed by six named tapes: a flag tape for `Turing.MultiTapeTM.onWords`, the +current value `C`, the halting flag `F`, the round input or output `R`, the pushed frames `P` and +the stack `S`. The stack is kept as the framed words of its frames, top first, ending just before +cell `0` of `S`, so that pushing writes to the left and popping erases from the left. + +This file describes the configurations of the machine (`StackLoopKernel.cfgS`) and the runs of its +phases between them. +-/ + +@[expose] public section + +namespace Turing.MultiTapeTM.StackLoopKernel + +variable {kk : ℕ} {input : List Bool} + +/-! ### Tape layout -/ + +/-- The named tape `j`: `0` flag, `1` current value, `2` halting flag, `3` round word, `4` pushed +frames, `5` stack. -/ +abbrev nm (j : Fin 6) : Fin (kk + 6) := Fin.natAdd kk j + +/-- The words on the tapes: the shared work tapes and the flag tape are blank. -/ +def tapeWords (c f r p s : List Bool) : Fin (kk + 6) → List Bool := + Fin.append (fun _ => []) ![[], c, f, r, p, s] + +/-- The offsets of the words: only the current value and the stack may be shifted. -/ +def tapeOffs (oc os : ℤ) : Fin (kk + 6) → ℤ := Fin.append (fun _ => 0) ![0, oc, 0, 0, 0, os] + +/-- The heads: on the first cells of the words, except possibly on the round word and the pushed +frames. -/ +def tapeHeads (oc os hr hp : ℤ) : Fin (kk + 6) → ℤ := + Fin.append (fun _ => 0) ![0, oc, 0, hr, hp, os] + +/-- A configuration of the stack-loop machine. -/ +def cfgS (input : List Bool) (c f r p s : List Bool) (oc os hr hp : ℤ) (out : List Bool) : + Cfg (kk + 6) Bool Unit input := + tapesCfg input (tapeWords c f r p s) (tapeOffs oc os) (tapeHeads oc os hr hp) out + +lemma tapeHeads_zero (oc os : ℤ) : tapeHeads (kk := kk) oc os 0 0 = tapeOffs oc os := rfl + +@[simp] lemma tapeWords_castAdd (c f r p s : List Bool) (i : Fin kk) : + tapeWords c f r p s (Fin.castAdd 6 i) = [] := Fin.append_left _ _ _ +@[simp] lemma tapeWords_nm (c f r p s : List Bool) (j : Fin 6) : + tapeWords (kk := kk) c f r p s (nm j) = ![[], c, f, r, p, s] j := Fin.append_right _ _ _ +@[simp] lemma tapeOffs_castAdd (oc os : ℤ) (i : Fin kk) : + tapeOffs oc os (Fin.castAdd 6 i) = 0 := Fin.append_left _ _ _ +@[simp] lemma tapeOffs_nm (oc os : ℤ) (j : Fin 6) : + tapeOffs (kk := kk) oc os (nm j) = ![0, oc, 0, 0, 0, os] j := Fin.append_right _ _ _ +@[simp] lemma tapeHeads_castAdd (oc os hr hp : ℤ) (i : Fin kk) : + tapeHeads oc os hr hp (Fin.castAdd 6 i) = 0 := Fin.append_left _ _ _ +@[simp] lemma tapeHeads_nm (oc os hr hp : ℤ) (j : Fin 6) : + tapeHeads (kk := kk) oc os hr hp (nm j) = ![0, oc, 0, hr, hp, os] j := Fin.append_right _ _ _ + +/-- Two families on the tapes agree if they agree on the shared and the named tapes. -/ +lemma fun_ext_tapes {α : Type*} {f g : Fin (kk + 6) → α} (h₁ : ∀ i, f (Fin.castAdd 6 i) = + g (Fin.castAdd 6 i)) (h₂ : ∀ j, f (nm j) = g (nm j)) : f = g := by + funext l + induction l using Fin.addCases with + | left i => exact h₁ i + | right j => exact h₂ j + +/-! ### Embeddings of the phases -/ + +/-- The tapes of `Turing.MultiTapeTM.onWords` with `kk` work tapes: the shared tapes, the output +tape `nm o`, the input tape `nm v` and the flag tape `nm 0`. -/ +def owEmb (v o : Fin 6) (hv : v.val ≠ 0) (ho : o.val ≠ 0) (hvo : v.val ≠ o.val) : + Fin (kk + 1 + 2) ↪ Fin (kk + 6) := + ⟨fun j => if h : j.val < kk then Fin.castAdd 6 ⟨j.val, h⟩ + else if j.val = kk then nm o else if j.val = kk + 1 then nm v else nm 0, by + intro a b hab + have ha := a.isLt + have hb := b.isLt + apply Fin.ext + simp only at hab + split_ifs at hab <;> simp only [Fin.ext_iff, Fin.val_castAdd, Fin.val_natAdd] at hab <;> + omega⟩ + +section OwEmb + +variable {v o : Fin 6} {hv : v.val ≠ 0} {ho : o.val ≠ 0} {hvo : v.val ≠ o.val} + +@[simp] lemma owEmb_work (i : Fin kk) : + owEmb v o hv ho hvo ((Fin.castSucc i).castAdd 2) = Fin.castAdd 6 i := by + unfold owEmb + simp only [Function.Embedding.coeFn_mk] + rw [dite_eq_left (by simp)] + rfl + +@[simp] lemma owEmb_out : owEmb v o hv ho hvo ((Fin.last kk).castAdd 2) = nm o := by + simp [owEmb] + +@[simp] lemma owEmb_in : owEmb v o hv ho hvo (Fin.natAdd (kk + 1) 0) = nm v := by + simp [owEmb] + +@[simp] lemma owEmb_flag : owEmb v o hv ho hvo (Fin.natAdd (kk + 1) 1) = nm 0 := by + unfold owEmb + simp only [Function.Embedding.coeFn_mk, Fin.val_natAdd, Fin.val_one] + rw [dite_eq_right (by omega), ite_eq_right (by omega), ite_eq_right (by omega)] + +end OwEmb + +/-- The tapes of `Turing.MultiTapeTM.outputToWord` with `kk` work tapes: the shared tapes and the +current value. -/ +def initEmb : Fin (kk + 1) ↪ Fin (kk + 6) := + ⟨fun j => if h : j.val < kk then Fin.castAdd 6 ⟨j.val, h⟩ else nm 1, by + intro a b hab + have ha := a.isLt + have hb := b.isLt + apply Fin.ext + simp only at hab + split_ifs at hab <;> simp only [Fin.ext_iff, Fin.val_castAdd, Fin.val_natAdd] at hab <;> + omega⟩ + +@[simp] lemma initEmb_work (i : Fin kk) : initEmb (Fin.castSucc i) = Fin.castAdd 6 i := by + unfold initEmb + simp only [Function.Embedding.coeFn_mk] + rw [dite_eq_left (by simp)] + rfl + +@[simp] lemma initEmb_last : initEmb (Fin.last kk) = nm 1 := by + simp [initEmb] + +/-- Two named tapes, for a two-tape machine. -/ +def pairEmb (a b : Fin 6) (h : a ≠ b) : Fin 2 ↪ Fin (kk + 6) := + ⟨![nm a, nm b], by + intro x y hxy + fin_cases x <;> fin_cases y <;> simp_all [Fin.natAdd_inj]⟩ + +/-- The tapes of `Turing.MultiTapeTM.copyWord`: from the round word to the current value. -/ +def copyEmb : Fin (0 + 1 + 2) ↪ Fin (kk + 6) := + ⟨![nm 1, nm 3, nm 0], by + intro x y hxy + fin_cases x <;> fin_cases y <;> simp_all [Fin.natAdd_inj]⟩ + +/-- The tapes of `Turing.MultiTapeTM.emitWord`: the current value. -/ +def emitEmb : Fin (0 + 2) ↪ Fin (kk + 6) := + ⟨![nm 1, nm 0], by + intro x y hxy + fin_cases x <;> fin_cases y <;> simp_all [Fin.natAdd_inj]⟩ + +/-! ### Specifications on embedded tapes -/ + +/-- **`onWords` on embedded tapes**, with every other tape arbitrary: the input on the tape +selected for the input of `onWords`, its other tapes blank. -/ +theorem transformsTapes_onWords_embed {k K : ℕ} {Symbol S : Type*} {tm : MultiTapeTM k Symbol S} + {x y : List Symbol} {t s : ℕ} (h : tm.ComputesTidilyInTimeAndSpace x y t s) (mark : Symbol) + (e : Fin (k + 1 + 2) ↪ Fin K) : + TransformsTapes ((tm.onWords mark).extendTapes e) + (fun _ ws => ws (e (Fin.natAdd (k + 1) 0)) = x ∧ + ∀ j ≠ Fin.natAdd (k + 1) 0, ws (e j) = []) + (fun _ ws ws' em => ws' = Function.update ws (e ((Fin.last k).castAdd 2)) y ∧ em = []) + (t + y.length + 6) (s + 2 * x.length + 2 * y.length + 3 * k + 18 + (K - (k + 1 + 2))) := by + refine ((h.onWords mark).extendTapes e).imp (fun _ ws ⟨hx, hb⟩ => ?_) + (fun _ ws ws' _ _ ⟨⟨hv, hy⟩, hx⟩ => ⟨?_, hy⟩) le_rfl le_rfl + · funext j + by_cases hj : j = Fin.natAdd (k + 1) 0 + · subst hj + simp [hx] + · rw [Function.update_of_ne hj] + exact hb j hj + · funext l + by_cases hl : l ∈ Set.range e + · obtain ⟨j, rfl⟩ := hl + have : ws' (e j) = Function.update (fun j => ws (e j)) ((Fin.last k).castAdd 2) y j := + congrFun hv j + rw [this] + by_cases hj : j = (Fin.last k).castAdd 2 + · subst hj + simp + · rw [Function.update_of_ne hj, Function.update_of_ne (e.injective.ne hj)] + · rw [hx l hl, Function.update_of_ne fun h => hl ⟨_, h.symm⟩] + +/-! ### Runs of the phases -/ + +/-- A specification on the words, read on configurations of the stack-loop machine with every head +on the first cell of its word. -/ +lemma runs_of_spec {S : Type*} {M : MultiTapeTM (kk + 6) Bool S} + {P : (input : List Bool) → (Fin (kk + 6) → List Bool) → Prop} + {Q : (input : List Bool) → (Fin (kk + 6) → List Bool) → (Fin (kk + 6) → List Bool) → + List Bool → Prop} {t s : ℕ} (h : TransformsTapes M P Q t s) + {c f r p st c' f' r' p' st' : List Bool} {oc os : ℤ} {e out out' : List Bool} + (hP : P input (tapeWords c f r p st)) + (hQ : ∀ ws e', Q input (tapeWords c f r p st) ws e' → + ws = tapeWords c' f' r' p' st' ∧ e' = e) (hout : out' = out ++ e) : + RunsBetween M (cfgS input c f r p st oc os 0 0 out) + (cfgS input c' f' r' p' st' oc os 0 0 out') t s := by + obtain ⟨ws, e', hQ', hrun⟩ := RunsBetween.of_transformsTapes h hP (tapeOffs oc os) out + obtain ⟨rfl, rfl⟩ := hQ ws e' hQ' + subst hout + exact hrun + +/-- A run of a machine on embedded tapes. -/ +lemma runs_lift {m : ℕ} {S : Type*} {tm : MultiTapeTM m Bool S} (e : Fin m ↪ Fin (kk + 6)) + {c c' : Cfg (kk + 6) Bool Unit input} {d₀ d : Cfg m Bool Unit input} {t s : ℕ} + (hd₀ : viewCfg e c = d₀) (h : RunsBetween tm d₀ d t s) + (hc : embed e d c.workTapes c.workTapePos = c') : + RunsBetween (tm.extendTapes e) c c' t (s + (kk + 6 - m)) := by + subst hd₀ hc + exact h.extendTapes e + +lemma update_tapeWords (c f r p st : List Bool) (j : Fin 6) (x : List Bool) : + Function.update (tapeWords (kk := kk) c f r p st) (nm j) x = + Fin.append (fun _ => []) (Function.update ![[], c, f, r, p, st] j x) := + (Fin.append_update_right _ _ _ _).symm + +/-- The machine clearing the named tape `j`. -/ +noncomputable def clearM (j : Fin 6) := + (clearWork Bool).extendTapes (tapeEmb (nm (kk := kk) j)) + +lemma runs_clearC (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (clearM (kk := kk) 1) (cfgS input c f r p st oc os 0 0 out) + (cfgS input [] f r p st oc os 0 0 out) (3 * (c.length + 1)) (c.length + 1 + (kk + 6)) := by + refine runs_of_spec (e := []) (transformsTapes_clearWork_tapeEmb (Symbol := Bool) (nm 1) c) + (by simp) (by + rintro _ _ ⟨rfl, rfl⟩ + refine ⟨?_, rfl⟩ + rw [update_tapeWords] + unfold tapeWords + congr 1 + funext i + fin_cases i <;> rfl) (List.append_nil out).symm + +lemma runs_clearF (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (clearM (kk := kk) 2) (cfgS input c f r p st oc os 0 0 out) + (cfgS input c [] r p st oc os 0 0 out) (3 * (f.length + 1)) (f.length + 1 + (kk + 6)) := by + refine runs_of_spec (e := []) (transformsTapes_clearWork_tapeEmb (Symbol := Bool) (nm 2) f) + (by simp) (by + rintro _ _ ⟨rfl, rfl⟩ + refine ⟨?_, rfl⟩ + rw [update_tapeWords] + unfold tapeWords + congr 1 + funext i + fin_cases i <;> rfl) (List.append_nil out).symm + +lemma runs_clearR (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (clearM (kk := kk) 3) (cfgS input c f r p st oc os 0 0 out) + (cfgS input c f [] p st oc os 0 0 out) (3 * (r.length + 1)) (r.length + 1 + (kk + 6)) := by + refine runs_of_spec (e := []) (transformsTapes_clearWork_tapeEmb (Symbol := Bool) (nm 3) r) + (by simp) (by + rintro _ _ ⟨rfl, rfl⟩ + refine ⟨?_, rfl⟩ + rw [update_tapeWords] + unfold tapeWords + congr 1 + funext i + fin_cases i <;> rfl) (List.append_nil out).symm + +/-- Copying the round word to the blank current-value tape. -/ +noncomputable def copyM := copyWord (copyEmb (kk := kk)) true + +lemma runs_copy (f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (copyM (kk := kk)) (cfgS input [] f r p st oc os 0 0 out) + (cfgS input r f r p st oc os 0 0 out) (3 * r.length + 10) + (4 * r.length + (kk + 6) + 15) := by + refine runs_of_spec (e := []) (transformsTapes_copyWord (copyEmb (kk := kk)) true r) + (by simp [copyEmb]) (by + rintro _ _ ⟨rfl, rfl⟩ + refine ⟨?_, rfl⟩ + rw [show copyEmb (kk := kk) 0 = nm 1 from rfl, update_tapeWords] + unfold tapeWords + congr 1 + funext i + fin_cases i <;> rfl) (List.append_nil out).symm + +/-- Emitting the current value. -/ +noncomputable def emitM := emitWord (emitEmb (kk := kk)) true + +lemma runs_emit (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (emitM (kk := kk)) (cfgS input c f r p st oc os 0 0 out) + (cfgS input c f r p st oc os 0 0 (out ++ c)) (2 * c.length + 8) + (2 * c.length + (kk + 6) + 10) := + runs_of_spec (transformsTapes_emitWord (emitEmb (kk := kk)) true c) (by simp [emitEmb]) + (by rintro _ _ ⟨rfl, rfl⟩; exact ⟨rfl, rfl⟩) rfl + +/-- Running a machine with `kk` work tapes on words, from the named tape `v` to the named tape +`o`. -/ +noncomputable def wordsM {S : Type*} (tm : MultiTapeTM kk Bool S) (v o : Fin 6) (hv : v.val ≠ 0) + (ho : o.val ≠ 0) (hvo : v.val ≠ o.val) := + (tm.onWords true).extendTapes (owEmb v o hv ho hvo) + +lemma tapeWords_owEmb_eq_nil {v o : Fin 6} {hv : v.val ≠ 0} {ho : o.val ≠ 0} + {hvo : v.val ≠ o.val} {c f r p st : List Bool} (hnil : ![[], c, f, r, p, st] o = []) + (j : Fin (kk + 1 + 2)) (hj : j ≠ Fin.natAdd (kk + 1) 0) : + tapeWords c f r p st (owEmb v o hv ho hvo j) = [] := by + induction j using Fin.addCases with + | left j => + induction j using Fin.lastCases with + | last => simpa using hnil + | cast i => simp + | right j => + fin_cases j + · exact absurd rfl hj + · simp + +/-- The halting test: from the current value to the halting flag. -/ +lemma runs_halt {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} + (h : tm.ComputesTidilyInTimeAndSpace c y t s') (r p st : List Bool) (oc os : ℤ) + (out : List Bool) : + RunsBetween (wordsM tm 1 2 (by decide) (by decide) (by decide)) + (cfgS input c [] r p st oc os 0 0 out) (cfgS input c y r p st oc os 0 0 out) + (t + y.length + 6) (s' + 2 * c.length + 2 * y.length + 3 * kk + 18 + 3) := by + have := runs_of_spec (input := input) (e := []) (oc := oc) (os := os) (out := out) (out' := out) + (transformsTapes_onWords_embed h true (owEmb (kk := kk) 1 2 (by decide) (by decide) + (by decide))) (c := c) (f := []) (r := r) (p := p) (st := st) (c' := c) (f' := y) + (r' := r) (p' := p) (st' := st) + ⟨by simp, tapeWords_owEmb_eq_nil (by rfl)⟩ (by + rintro _ _ ⟨rfl, rfl⟩ + refine ⟨?_, rfl⟩ + rw [owEmb_out, update_tapeWords] + unfold tapeWords + congr 1 + funext i + fin_cases i <;> rfl) (List.append_nil out).symm + simpa [wordsM, show kk + 6 - (kk + 1 + 2) = 3 by omega] using this + +/-- A round machine, from the current value to the pushed frames. -/ +lemma runs_push {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} + (h : tm.ComputesTidilyInTimeAndSpace c y t s') (f r st : List Bool) (oc os : ℤ) + (out : List Bool) : + RunsBetween (wordsM tm 1 4 (by decide) (by decide) (by decide)) + (cfgS input c f r [] st oc os 0 0 out) (cfgS input c f r y st oc os 0 0 out) + (t + y.length + 6) (s' + 2 * c.length + 2 * y.length + 3 * kk + 18 + 3) := by + have := runs_of_spec (input := input) (e := []) (oc := oc) (os := os) (out := out) (out' := out) + (transformsTapes_onWords_embed h true (owEmb (kk := kk) 1 4 (by decide) (by decide) + (by decide))) (c := c) (f := f) (r := r) (p := []) (st := st) (c' := c) (f' := f) + (r' := r) (p' := y) (st' := st) + ⟨by simp, tapeWords_owEmb_eq_nil (by rfl)⟩ (by + rintro _ _ ⟨rfl, rfl⟩ + refine ⟨?_, rfl⟩ + rw [owEmb_out, update_tapeWords] + unfold tapeWords + congr 1 + funext i + fin_cases i <;> rfl) (List.append_nil out).symm + simpa [wordsM, show kk + 6 - (kk + 1 + 2) = 3 by omega] using this + +/-- A round machine, from the current value to the round word. -/ +lemma runs_next {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} + (h : tm.ComputesTidilyInTimeAndSpace c y t s') (f p st : List Bool) (oc os : ℤ) + (out : List Bool) : + RunsBetween (wordsM tm 1 3 (by decide) (by decide) (by decide)) + (cfgS input c f [] p st oc os 0 0 out) (cfgS input c f y p st oc os 0 0 out) + (t + y.length + 6) (s' + 2 * c.length + 2 * y.length + 3 * kk + 18 + 3) := by + have := runs_of_spec (input := input) (e := []) (oc := oc) (os := os) (out := out) (out' := out) + (transformsTapes_onWords_embed h true (owEmb (kk := kk) 1 3 (by decide) (by decide) + (by decide))) (c := c) (f := f) (r := []) (p := p) (st := st) (c' := c) (f' := f) + (r' := y) (p' := p) (st' := st) + ⟨by simp, tapeWords_owEmb_eq_nil (by rfl)⟩ (by + rintro _ _ ⟨rfl, rfl⟩ + refine ⟨?_, rfl⟩ + rw [owEmb_out, update_tapeWords] + unfold tapeWords + congr 1 + funext i + fin_cases i <;> rfl) (List.append_nil out).symm + simpa [wordsM, show kk + 6 - (kk + 1 + 2) = 3 by omega] using this + +/-- The initialization: the machine reads the input and writes its output to the current-value +tape. -/ +noncomputable def initM {S : Type*} (tm : MultiTapeTM kk Bool S) := + tm.outputToWord.extendTapes (initEmb (kk := kk)) + +lemma runs_init {S : Type*} {tm : MultiTapeTM kk Bool S} {y : List Bool} {t s' : ℕ} + (h : tm.ComputesTidilyInTimeAndSpace input y t s') (out : List Bool) : + RunsBetween (initM tm) (cfgS input [] [] [] [] [] 0 0 0 0 out) + (cfgS input y [] [] [] [] 0 0 0 0 out) + (t + y.length + 2) (s' + 2 * y.length + kk + 4 + 5) := by + have := runs_of_spec (input := input) (e := []) (oc := 0) (os := 0) (out := out) (out' := out) + (h.outputToWord_extendTapes (initEmb (kk := kk))) (c := []) (f := []) (r := []) (p := []) + (st := []) (c' := y) (f' := []) (r' := []) (p' := []) (st' := []) + ⟨rfl, fun j => by + induction j using Fin.lastCases with + | last => simp + | cast i => simp⟩ (by + rintro _ _ ⟨rfl, rfl⟩ + refine ⟨?_, rfl⟩ + rw [initEmb_last, update_tapeWords] + unfold tapeWords + congr 1 + funext i + fin_cases i <;> rfl) (List.append_nil out).symm + simpa [initM, show kk + 6 - (kk + 1) = 5 by omega] using this + +/-! ### Native phases -/ + +lemma append_apply_eq {α : Type*} {z : α} {u v : Fin 6 → α} {l : Fin (kk + 6)} + (h : ∀ j, l = nm j → u j = v j) : + Fin.append (fun _ : Fin kk => z) u l = Fin.append (fun _ : Fin kk => z) v l := by + induction l using Fin.addCases with + | left i => simp only [Fin.append_left] + | right j => simp only [Fin.append_right]; exact h j rfl + +/-- A two-tape machine on the named tapes `a` and `b`. -/ +lemma runs_pair {S : Type*} {tm : MultiTapeTM 2 Bool S} (a b : Fin 6) (hab : a ≠ b) + {w w' : Fin 6 → List Bool} {o o' h h' : Fin 6 → ℤ} {t s : ℕ} {out : List Bool} + (hrun : RunsBetween tm (tapesCfg input ![w a, w b] ![o a, o b] ![h a, h b] out) + (tapesCfg input ![w' a, w' b] ![o' a, o' b] ![h' a, h' b] out) t s) + (hw : ∀ j, j ≠ a → j ≠ b → w' j = w j ∧ o' j = o j ∧ h' j = h j) : + RunsBetween (tm.extendTapes (pairEmb (kk := kk) a b hab)) + (tapesCfg input (Fin.append (fun _ => []) w) (Fin.append (fun _ => 0) o) + (Fin.append (fun _ => 0) h) out) + (tapesCfg input (Fin.append (fun _ => []) w') (Fin.append (fun _ => 0) o') + (Fin.append (fun _ => 0) h') out) t (s + (kk + 6 - 2)) := by + refine runs_lift _ ?_ hrun (embed_tapesCfg _ (fun j => ?_) fun l hl => ?_) + · rw [viewCfg_tapesCfg] + congr 1 <;> funext j <;> fin_cases j <;> simp [pairEmb] + · fin_cases j <;> simp [pairEmb] + · have hne : ∀ j, l = nm j → j ≠ a ∧ j ≠ b := by + rintro j rfl + exact ⟨fun h => hl ⟨0, by subst h; rfl⟩, fun h => hl ⟨1, by subst h; rfl⟩⟩ + exact ⟨append_apply_eq fun j hj => (hw j (hne j hj).1 (hne j hj).2).1, + append_apply_eq fun j hj => (hw j (hne j hj).1 (hne j hj).2).2.1, + append_apply_eq fun j hj => (hw j (hne j hj).1 (hne j hj).2).2.2⟩ + +/-- A one-tape machine on the named tape `a`. -/ +lemma runs_one {S : Type*} {tm : MultiTapeTM 1 Bool S} (a : Fin 6) + {w w' : Fin 6 → List Bool} {o o' h h' : Fin 6 → ℤ} {t s : ℕ} {out : List Bool} + (hrun : RunsBetween tm (tapesCfg input (fun _ => w a) (fun _ => o a) (fun _ => h a) out) + (tapesCfg input (fun _ => w' a) (fun _ => o' a) (fun _ => h' a) out) t s) + (hw : ∀ j, j ≠ a → w' j = w j ∧ o' j = o j ∧ h' j = h j) : + RunsBetween (tm.extendTapes (tapeEmb (nm (kk := kk) a))) + (tapesCfg input (Fin.append (fun _ => []) w) (Fin.append (fun _ => 0) o) + (Fin.append (fun _ => 0) h) out) + (tapesCfg input (Fin.append (fun _ => []) w') (Fin.append (fun _ => 0) o') + (Fin.append (fun _ => 0) h') out) t (s + (kk + 6 - 1)) := by + refine runs_lift _ ?_ hrun (embed_tapesCfg _ (fun j => ?_) fun l hl => ?_) + · rw [viewCfg_tapesCfg] + simp only [tapeEmb_apply, nm, Fin.append_right] + · simp only [tapeEmb_apply, nm, Fin.append_right, and_self] + · have hne : ∀ j, l = nm j → j ≠ a := by + rintro j rfl h + exact hl ⟨0, by subst h; rfl⟩ + exact ⟨append_apply_eq fun j hj => (hw j (hne j hj)).1, + append_apply_eq fun j hj => (hw j (hne j hj)).2.1, + append_apply_eq fun j hj => (hw j (hne j hj)).2.2⟩ + +/-- Popping the stack to the round word. -/ +noncomputable def popM := popFrame.extendTapes (pairEmb (kk := kk) 5 3 (by decide)) + +lemma runs_pop_nil (c f p : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (popM (kk := kk)) (cfgS input c f [] p [] oc os 0 0 out) + (cfgS input c f [false] p [] oc os 1 0 out) 1 (2 * (1 + 1) + (kk + 6 - 2)) := + runs_pair 5 3 _ (by simpa using runsBetween_popFrame_nil (input := input) os 0 out) + (fun j h5 h3 => by fin_cases j <;> simp_all) + +lemma runs_pop_frame (c f p u rest : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (popM (kk := kk)) (cfgS input c f [] p (frame u ++ rest) oc os 0 0 out) + (cfgS input c f (frame (true :: u)) p rest oc (os + (frame u).length) + (frame (true :: u)).length 0 out) (2 * u.length + 3) + (2 * (2 * u.length + 3 + 1) + (kk + 6 - 2)) := + runs_pair 5 3 _ (by simpa using runsBetween_popFrame_frame (input := input) u rest os 0 out) + (fun j h5 h3 => by fin_cases j <;> simp_all) + +/-- Moving the round word to the front of the current value. -/ +noncomputable def backRC := (copyBack Bool).extendTapes (pairEmb (kk := kk) 3 1 (by decide)) + +lemma runs_backRC (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (backRC (kk := kk)) (cfgS input c f r p st oc os r.length 0 out) + (cfgS input (r ++ c) f [] p st (oc - r.length) os 0 0 out) (r.length + 2) + (2 * (r.length + 2 + 1) + (kk + 6 - 2)) := + runs_pair 3 1 _ (by simpa using runsBetween_copyBack (input := input) r c 0 oc out) + (fun j h3 h1 => by fin_cases j <;> simp_all) + +/-- Moving the pushed frames to the front of the stack. -/ +noncomputable def backPS := (copyBack Bool).extendTapes (pairEmb (kk := kk) 4 5 (by decide)) + +lemma runs_backPS (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (backPS (kk := kk)) (cfgS input c f r p st oc os 0 p.length out) + (cfgS input c f r [] (p ++ st) oc (os - p.length) 0 0 out) (p.length + 2) + (2 * (p.length + 2 + 1) + (kk + 6 - 2)) := + runs_pair 4 5 _ (by simpa using runsBetween_copyBack (input := input) p st 0 os out) + (fun j h4 h5 => by fin_cases j <;> simp_all) + +/-- Erasing the popped frame at the front of the current value. -/ +noncomputable def eraseM := eraseFrame.extendTapes (tapeEmb (nm (kk := kk) 1)) + +lemma runs_erase (u rest f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (eraseM (kk := kk)) (cfgS input (frame u ++ rest) f r p st oc os 0 0 out) + (cfgS input rest f r p st (oc + (frame u).length) os 0 0 out) (2 * u.length + 1) + (1 * (2 * u.length + 1 + 1) + (kk + 6 - 1)) := + runs_one 1 (by simpa using runsBetween_eraseFrame (input := input) u rest oc out) + (fun j h1 => by fin_cases j <;> simp_all) + +/-- Moving the head of the pushed frames to their end. -/ +noncomputable def seekM := (seekEnd Bool).extendTapes (tapeEmb (nm (kk := kk) 4)) + +lemma runs_seek (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : + RunsBetween (seekM (kk := kk)) (cfgS input c f r p st oc os 0 0 out) + (cfgS input c f r p st oc os 0 p.length out) (p.length + 1) + (1 * (p.length + 1 + 1) + (kk + 6 - 1)) := + runs_one 4 (by simpa using runsBetween_seekEnd (input := input) p 0 out) + (fun j h4 => by fin_cases j <;> simp_all) + +end Turing.MultiTapeTM.StackLoopKernel From a303b892b044f19298aa133649d27a5657218b2f Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:42:49 +0000 Subject: [PATCH 23/40] docs(universal): document the windowed cost certificates (#800) --- .../Turing/MultiTape/Universal/WindowedComplexity.lean | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean index c7bb1a9d43..faebd0b811 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean @@ -88,12 +88,14 @@ lemma length_eProb (a : Prob) : (eProb a).length = change _ = 2 * (eDesc a.1).length + 1 + _ simp only [length_encPair, encUnary_apply, List.length_replicate] +/-- The test for base problems, in linear time. -/ lemma isBase_inO : ComputableTidilyInO simDC.isBase eProb encBool (fun a => (eProb a).length) (fun a => (eProb a).length) := (((ComputableTidilyInDegree.unary_isZero.comp ComputableTidilyInDegree.unary_pred).mono (d' := 1) (e' := 1)).inO_one.comp_linear prob_n).of_enc_eq fun a => congrArg encBool (decide_eq_decide.mpr (by dsimp only; omega)) +/-- `Option.toList` on symbols, in linear time. -/ lemma toList_inO : ComputableTidilyInO Option.toList eSym (encList encUnary) (fun o => (eSym o).length) (fun o => (eSym o).length) := ((((ComputableTidilyInDegree.isSome encUnary).inO_one).ite @@ -109,6 +111,7 @@ lemma length_dw_le (a : Prob) : (encPair eDesc eWin (a.1, a.2.2)).length ≤ (eP /-- The time and space of a base problem. -/ def Tb (a : Prob) : ℕ := ((eProb a).length + 1) ^ 3 +/-- Base problems: no step, or one windowed step. -/ lemma base_inO : ComputableTidilyInO simDC.base eProb eSol Tb Tb := by have hstep := wstep_inO.tidy.comp (prob_d.prod prob_w) have hlive := hstep.fst'.prod (toList_inO.comp_linear hstep.snd') @@ -129,6 +132,7 @@ lemma base_inO : ComputableTidilyInO simDC.base eProb eSol Tb Tb := by /-- The time and space of the first subproblem. -/ def Tl (a : Prob) : ℕ := (a.2.2.2.length + 1) * ((eProb a).length + 1) +/-- The first subproblem: the first half of the steps on the cut windows. -/ lemma left_inO : ComputableTidilyInO simDC.left eProb eProb Tl Tl := by have hfh := firstHalf_inO.tidy.comp_linear prob_n have hex := extract_inO.tidy.comp (hfh.prod prob_w) @@ -152,6 +156,8 @@ def Tm (p : Prob × Sol) : ℕ := (p.1.2.2.2.length + 1) * ((encPair eProb eSol p).length + (eWin (restore (firstHalf p.1.2.1) p.1.2.2 p.2.1)).length + 1) +/-- The second subproblem and the saved data: the windows after the first half are pasted +back and cut again for the second half. -/ lemma mid_inO : ComputableTidilyInO simDC.mid (encPair eProb eSol) (encPair eProb eSaved) Tm Tm := by have hd := prob_d.comp_linear (fst eProb eSol) @@ -192,6 +198,8 @@ lemma mid_inO : /-- The time and space of the combination. -/ def Tj (q : Saved × Sol) : ℕ := (q.1.2.1.2.length + 1) * ((encPair eSaved eSol q).length + 1) +/-- The combination: the windows after the second half are pasted back and the emitted symbols +concatenated. -/ lemma join_inO : ComputableTidilyInO simDC.join (encPair eSaved eSol) eSol Tj Tj := by have hr := (fst encUnary (encPair eWin (encList encUnary))).comp_linear (fst eSaved eSol) have hs := (snd encUnary (encPair eWin (encList encUnary))).comp_linear (fst eSaved eSol) @@ -258,6 +266,7 @@ lemma simDC_base_eq {d : Desc} {n : ℕ} (hn : n ≤ 1) (w : Win) : · simp [simDC, baseSol, sim] · simp [simDC, baseSol, sim] +/-- The cost of a base problem, within `costA`. -/ lemma baseCost_le {d : Desc} {B n : ℕ} {w : Win} (hDB : descLen d ≤ B) (hn : n ≤ 1) (hw : WInv (descLen d) B 0 (2 * n + 1) w) : baseCost (d, n, w) ≤ costA (descLen d) B := by have hZ := winBound_base (descLen d) B @@ -284,6 +293,7 @@ lemma baseCost_le {d : Desc} {B n : ℕ} {w : Win} (hDB : descLen d ≤ B) (hn : have hY1 : E + 1 ≤ (E + 1) ^ 3 := Nat.le_self_pow (by omega) _ omega +/-- The cost of a node of `n` steps, within `costA * (n + 1)`. -/ lemma nodeCost_le {d : Desc} {B n : ℕ} {w : Win} (hDB : descLen d ≤ B) (hw : WInv (descLen d) B 0 (2 * n + 1) w) : nodeCost (d, n, w) (sim d (firstHalf n) (extract (firstHalf n) w)) From 88f6b96236b96efb6fb27f2b6d30519880e0a02f Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:43:21 +0000 Subject: [PATCH 24/40] fix(divconq): keep tidy helpers private; review doc fixes --- .../Turing/MultiTape/Combinators/DivConq.lean | 39 +++++++++---------- .../Turing/MultiTape/Universal/Windowed.lean | 7 ++-- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 05e6d00cb3..12bdb342fe 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -19,9 +19,8 @@ problem and the first solution, solves the second subproblem, and combines the s second solution. Its evaluation with a cost is the inductive relation `Turing.MultiTapeTM.DivConq.Eval`: a node costs its two subproblems plus a cost of its own. -If the parts are tidily computable, the solution is tidily computable within the cost of the -evaluation, when the cost of every node covers the costs of its parts and the lengths of the words -it touches (`Turing.MultiTapeTM.ComputableInO.divConq`). The machine runs the recursion as a +If the parts are computable, the solution is computable within the cost of the evaluation, when +the cost of every node covers the costs of its parts and the lengths of the words it touches (`Turing.MultiTapeTM.ComputableInO.divConq`). The machine runs the recursion as a `Turing.MultiTapeTM.StackLoop`, keeping the pending problems and saved data on a stack, so a node does not pay for the frames of its ancestors. @@ -98,30 +97,30 @@ end Eval /-- The values of the stack loop: a call on a problem, a returned solution, and the final solution. -/ -abbrev Val (α β : Type) := α ⊕ (β ⊕ β) +private abbrev Val (α β : Type) := α ⊕ (β ⊕ β) /-- The frames of the stack loop: a problem whose first subproblem is being solved, or the data saved while its second subproblem is solved. -/ -abbrev Frame (α γ : Type) := α ⊕ γ +private abbrev Frame (α γ : Type) := α ⊕ γ variable (D : DivConq α β γ) /-- A round on a call: a base problem returns its solution; otherwise the problem is saved and its first subproblem called. The popped frame is pushed back. -/ -@[expose] def roundCall (p : Option (Frame α γ) × α) : List (Frame α γ) × Val α β := +private def roundCall (p : Option (Frame α γ) × α) : List (Frame α γ) × Val α β := if D.isBase p.2 then (p.1.toList, .inr (.inl (D.base p.2))) else (.inl p.2 :: p.1.toList, .inl (D.left p.2)) /-- A round on a returned solution: with an empty stack it is final; after a first subproblem the second is called, saving the data; after a second subproblem the solution is combined. -/ -@[expose] def roundRet (p : Option (Frame α γ) × β) : List (Frame α γ) × Val α β := +private def roundRet (p : Option (Frame α γ) × β) : List (Frame α γ) × Val α β := match p.1 with | none => ([], .inr (.inr p.2)) | some (.inl a) => ([.inr (D.mid (a, p.2)).2], .inl (D.mid (a, p.2)).1) | some (.inr g) => ([], .inr (.inl (D.join (g, p.2)))) /-- The recursion as a stack loop, halting at a final solution. -/ -@[expose] def loop : StackLoop (Val α β) (Frame α γ) where +private def loop : StackLoop (Val α β) (Frame α γ) where halt v := match v with | .inr (.inr _) => true | _ => false @@ -131,14 +130,14 @@ second is called, saving the data; after a second subproblem the solution is com | .inr (.inr b) => (p.1.toList, .inr (.inr b)) omit D in -lemma toList_head?_append_tail (stk : List (Frame α γ)) : stk.head?.toList ++ stk.tail = stk := by +private lemma toList_head?_append_tail (stk : List (Frame α γ)) : stk.head?.toList ++ stk.tail = stk := by cases stk <;> rfl /-- **The trace of an evaluation.** If every round costs at most `R` of its input, and `R` is bounded on the rounds of base problems and nodes as below, then from a call on `a` the loop returns the solution of `a`, above an untouched stack, within rounds whose total cost is at most -`A * c` plus `B` times the size of the frame below, plus `B`. -/ -theorem eval_trace {cb : α → ℕ} {cn : α → β → β → ℕ} {R : Option (Frame α γ) × Val α β → ℕ} +`4 * B * c` plus `B` times one more than the size of the top frame below. -/ +private theorem eval_trace {cb : α → ℕ} {cn : α → β → β → ℕ} {R : Option (Frame α γ) × Val α β → ℕ} {fsize : Option (Frame α γ) → ℕ} {B : ℕ} (hbase : ∀ o a, D.isBase a = true → R (o, .inl a) ≤ B * (fsize o + 1) + B * cb a) (hcall : ∀ o a b₁ b₂, D.isBase a = false → @@ -244,15 +243,15 @@ open ComputableTidilyInO variable {α β γ : Type} {encA : α ↪ List Bool} {encB : β ↪ List Bool} {encG : γ ↪ List Bool} /-- The encoding of the values of the loop. -/ -abbrev encVal (encA : α ↪ List Bool) (encB : β ↪ List Bool) : Val α β ↪ List Bool := +private abbrev encVal (encA : α ↪ List Bool) (encB : β ↪ List Bool) : Val α β ↪ List Bool := encSum encA (encSum encB encB) /-- The encoding of the frames of the loop. -/ -abbrev encFrame (encA : α ↪ List Bool) (encG : γ ↪ List Bool) : Frame α γ ↪ List Bool := +private abbrev encFrame (encA : α ↪ List Bool) (encG : γ ↪ List Bool) : Frame α γ ↪ List Bool := encSum encA encG /-- `Option.toList`, in linear time. -/ -lemma toList_inO {δ : Type} {enc : δ ↪ List Bool} : +private lemma toList_inO {δ : Type} {enc : δ ↪ List Bool} : ComputableTidilyInO (Option.toList (α := δ)) (encOption enc) (encList enc) (fun o => (encOption enc o).length) (fun o => (encOption enc o).length) := by have htail : ComputableTidilyInO List.tail encBits encBits (fun w => w.length) @@ -277,7 +276,7 @@ lemma toList_inO {δ : Type} {enc : δ ↪ List Bool} : /-- The sums of the costs of a run of `m + 1` rounds followed by a halting test, against a bound on the first `m` rounds. -/ -lemma sums_le {A B R : ℕ → ℕ} {m X : ℕ} (h : ∀ i < m, A i + B i ≤ R i) : +private lemma sums_le {A B R : ℕ → ℕ} {m X : ℕ} (h : ∀ i < m, A i + B i ≤ R i) : X + ∑ i ∈ Finset.range (m + 1 + 1), A i + ∑ i ∈ Finset.range (m + 1), B i ≤ X + (∑ i ∈ Finset.range m, R i + A m + A (m + 1) + B m) := by rw [Finset.sum_range_succ, Finset.sum_range_succ, Finset.sum_range_succ] @@ -285,7 +284,7 @@ lemma sums_le {A B R : ℕ → ℕ} {m X : ℕ} (h : ∀ i < m, A i + B i ≤ R rw [Finset.sum_add_distrib] at this omega -lemma length_encList_toList_le {δ : Type} (enc : δ ↪ List Bool) (o : Option δ) : +private lemma length_encList_toList_le {δ : Type} (enc : δ ↪ List Bool) (o : Option δ) : (encList enc o.toList).length ≤ 2 * (encOption enc o).length := by cases o <;> simp [length_frame] @@ -293,13 +292,13 @@ variable (D : DivConq α β γ) {Tt St Tb Sb Tl Sl : α → ℕ} {Tm Sm : α × {Tj Sj : γ × β → ℕ} /-- The swap of the components of a pair, in linear time. -/ -lemma swap_inO {σ τ : Type} {encS : σ ↪ List Bool} {encT : τ ↪ List Bool} : +private lemma swap_inO {σ τ : Type} {encS : σ ↪ List Bool} {encT : τ ↪ List Bool} : ComputableTidilyInO (fun p : σ × τ => (p.2, p.1)) (encPair encS encT) (encPair encT encS) (fun p => (encPair encS encT p).length) (fun p => (encPair encS encT p).length) := ((snd encS encT).prod (fst encS encT)).mono 2 (fun _ => by omega) (fun _ => by omega) /-- A call round, within the costs of its parts. -/ -lemma roundCall_inO (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) +private lemma roundCall_inO (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) (hbase : ComputableTidilyInO D.base encA encB Tb Sb) (hleft : ComputableTidilyInO D.left encA encA Tl Sl) : ComputableTidilyInO D.roundCall (encPair (encOption (encFrame encA encG)) encA) @@ -378,7 +377,7 @@ private lemma retSwap_inO nlinarith /-- A round, within the costs of the parts of the recursion it runs. -/ -lemma round_inO (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) +private lemma round_inO (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) (hbase : ComputableTidilyInO D.base encA encB Tb Sb) (hleft : ComputableTidilyInO D.left encA encA Tl Sl) (hmid : ComputableTidilyInO D.mid (encPair encA encB) (encPair encA encG) Tm Sm) @@ -426,7 +425,7 @@ lemma round_inO (hisBase : ComputableTidilyInO D.isBase encA encBool Tt St) omega /-- The halting test of the loop, in linear time. -/ -lemma halt_inO : ComputableTidilyInO D.loop.halt (encVal encA encB) encBool +private lemma halt_inO : ComputableTidilyInO D.loop.halt (encVal encA encB) encBool (fun v => (encVal encA encB v).length) (fun v => (encVal encA encB v).length) := by have hw : ComputableTidilyInO (fun w : List Bool => (w.headD false, w.tail.headD false)) encBits (encPair encBool encBool) (fun w => w.length) (fun w => w.length) := diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean index eed69e1290..9b0c1a4978 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean @@ -18,9 +18,10 @@ cells within distance `n` of its head. It cuts the windows of radius `⌈n / 2 simulates the first `⌈n / 2⌉` steps on them recursively, pastes the result back, and does the same for the remaining `⌊n / 2⌋` steps. A single step is `Turing.MultiTapeTM.Universal.stepWith`. -Cutting and pasting take time linear in the window, so `n` steps take time `O(n log n)` for a -fixed machine; that cost analysis is in a separate module. This module defines the simulation and -proves that it computes the universal function. +Cutting and pasting take time linear in the enclosing window, so `n` steps take time +`O(n log n)` for a fixed machine; that cost analysis is +`Turing.MultiTapeTM.Universal.computableInO_universal_nlogn`, in a separate module. This module +defines the simulation and proves that it computes the universal function. A windowed configuration (`Turing.MultiTapeTM.Universal.Windowed.Win`) holds the state, then the input window followed by the work windows. The `head` fields of the window zippers are not used. From 3b2dc80ecbccb0a9ae8a844db084e65f0393454d Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:43:48 +0000 Subject: [PATCH 25/40] fix(turing): keep vendored Lists.lean faithful; doc and test nits (#800) Review S1: revert the Complexity/Lists.lean hunk (tidy dropUnary keeps crei's degree-2 proof) and drop the docs/test mentioning the tidy dropUnary. Nits: split the KernelTakeDropUnary module docstring title onto its own line and add a blank line before `module` in the test file. --- .../MultiTape/Combinators/TakeDropUnary.lean | 3 +- .../Turing/MultiTape/Complexity/Lists.lean | 43 +++++++++---------- .../Internal/KernelTakeDropUnary.lean | 10 ++--- .../Turing/MultiTape/TakeDropUnary.lean | 9 +--- 4 files changed, 28 insertions(+), 37 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean index 83511e00bf..d20cd047b8 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean @@ -18,8 +18,7 @@ Taking or dropping the first `n` elements of a list encoded by `Turing.MultiTape `n` in unary, has cost and output degree one. Both are computed by the one-tape machine `Turing.MultiTapeTM.TakeDropUnary.toTM`, which copies the count to its work tape and then streams the encoded list once, moving the work head at every element boundary. Folding over the count or -over the list would cost quadratic time. The tidy form of dropping is -`Turing.MultiTapeTM.ComputableTidilyInDegree.dropUnary`. +over the list would cost quadratic time. ## Main results diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/Lists.lean b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/Lists.lean index 17e0cf6e6b..dbdc651a34 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Complexity/Lists.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/Lists.lean @@ -9,8 +9,6 @@ module -- vendored: derive encoded prefix/filter bounds from Mathlib's `List.Sublist.flatMap`. public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Primitives -import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TidyNormalForm -import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelTakeDropUnary import Mathlib.Tactic.Linarith /-! @@ -19,7 +17,7 @@ import Mathlib.Tactic.Linarith Operations on lists encoded by `Turing.MultiTapeTM.encList`, with explicit degrees (`Turing.MultiTapeTM.ComputableTidilyInDegree`): adding an element at either end and concatenation in linear time; finding the first element that passes a test and keeping the elements that pass a -test, one degree above the test; and dropping a number of elements in linear time. The tests may +test, one degree above the test; and dropping a number of elements in quadratic time. The tests may depend on a parameter. ## Main results @@ -184,27 +182,28 @@ public theorem filterWith {t : π × α → Bool} {par : γ → π} {list : γ funext x rw [foldl_filterStep, List.nil_append] --- vendored: linear time by the native machine `TakeDropUnary.toTM` (crei folds `List.tail` over --- the count, which has degree 2). -/-- Dropping the first `n` elements, with `n` in unary, in linear time. -/ +/-- Dropping the first `n` elements, with `n` in unary. -/ public theorem dropUnary (enc : α ↪ List Bool) : ComputableTidilyInDegree (fun p : List α × ℕ => p.1.drop p.2) - (encPair (encList enc) encUnary) (encList enc) 1 1 := by - obtain ⟨c, hc⟩ := - (TakeDropUnary.computableInTimeAndSpace false enc).exists_computableTidilyInTimeAndSpace - refine of_bounds ⟨10 + c, fun p => ?_⟩ ⟨3 * c, fun p => ?_⟩ hc <;> - have h := length_le_encPair_right (encList enc) encUnary p <;> - rw [encUnary_apply, List.length_replicate] at h <;> - dsimp only <;> - rw [pow_one] - · have hc' : c ≤ c * ((encPair (encList enc) encUnary p).length + 1) := - Nat.le_mul_of_pos_right c (Nat.succ_pos _) - rw [Nat.add_mul] - omega - · calc c * (p.2 + 2 + 1) ≤ c * (3 * ((encPair (encList enc) encUnary p).length + 1)) := - Nat.mul_le_mul_left c (by omega) - _ = 3 * c * ((encPair (encList enc) encUnary p).length + 1) := by - rw [Nat.mul_left_comm, Nat.mul_assoc] + (encPair (encList enc) encUnary) (encList enc) 2 1 := by + have hrep (l : List α) (n : ℕ) : (List.replicate n true).foldl (fun acc _ => acc.tail) l = + l.drop n := by + simp [List.foldl_const, List.tail_iterate] + have hfold := foldl' (encA := encBool) (encL := encBits) (encB := encList enc) + (list := fun p : List α × ℕ => List.replicate p.2 true) (step := fun acc _ => acc.tail) + ((of_eq (f := fun n => List.replicate n true) (encIn := encUnary) (encMid := encBits) + fun _ => rfl).comp (snd (encList enc) encUnary)) + (fst (encList enc) encUnary) + ((tail (enc₁ := enc)).comp (fst (encList enc) encBool)) + (B := fun p => (encPair (encList enc) encUnary p).length) .self (fun p i hi => by + rw [List.take_replicate, hrep] + have := SizedListEncoding.length_drop_le (encA := enc) (encL := encList enc) p.1 + (min i p.2) + simp only [length_encPair] + omega) + convert hfold.mono (d' := 2) (e' := 1) using 1 + funext p + rw [hrep] /-- One step of mapping with the parameter `p`. -/ @[expose] public def mapStep {β : Type} (f : π × α → β) (p : π) (acc : List β) (a : α) : diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelTakeDropUnary.lean b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelTakeDropUnary.lean index c8b55d7350..39f7e4ef55 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelTakeDropUnary.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelTakeDropUnary.lean @@ -14,7 +14,8 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Pair public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Unary import Mathlib.Basic.Finite.Sum -/-! # A one-tape machine cutting a framed word at a unary count +/-! +# A one-tape machine cutting a framed word at a unary count The machine `Turing.MultiTapeTM.TakeDropUnary.toTM keep` reads `frame u ++ List.replicate n true`. It skips the frame, copies the count `n` to its work tape (leaving the head on the last `true`), @@ -25,10 +26,9 @@ head position counts the inner frames still to be taken or dropped. Inner symbol the count is positive (`keep = true`) or once it is zero (`keep = false`). On `u = encList enc l` this emits the encoded `l.take n` or `l.drop n`. The machine runs in time -linear in its input and uses `n + 2` work-tape cells. This is the realization behind the plain -`Turing.MultiTapeTM.ComputableInDegree.takeUnary` and `.dropUnary` and the tidy -`Turing.MultiTapeTM.ComputableTidilyInDegree.dropUnary`; folding over the count or over the list -would cost quadratic time. +linear in its input and uses `n + 2` work-tape cells. This is the realization behind +`Turing.MultiTapeTM.ComputableInDegree.takeUnary` and `.dropUnary`; folding over the count or over +the list would cost quadratic time. ## Main definitions diff --git a/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean b/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean index 69d1ea69e1..dfcb16c4ea 100644 --- a/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean +++ b/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean @@ -3,6 +3,7 @@ Copyright (c) 2026 Samuel Schlesinger. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Samuel Schlesinger -/ + module import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TakeDropUnary import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelTakeDropUnary @@ -19,14 +20,6 @@ example : (encPair (encList encUnary) encUnary) (encList encUnary) 1 1 := ⟨ComputableInDegree.takeUnary encUnary, ComputableInDegree.dropUnary encUnary⟩ -/-- The tidy `dropUnary` is linear, and still serves clients of the former quadratic degree. -/ -example (enc : Bool ↪ List Bool) : - ComputableTidilyInDegree (fun p : List Bool × ℕ => p.1.drop p.2) - (encPair (encList enc) encUnary) (encList enc) 1 1 ∧ - ComputableTidilyInDegree (fun p : List Bool × ℕ => p.1.drop p.2) - (encPair (encList enc) encUnary) (encList enc) 2 1 := - ⟨ComputableTidilyInDegree.dropUnary enc, (ComputableTidilyInDegree.dropUnary enc).mono⟩ - /-! The machine's streaming semantics on a small encoded list, including an empty element. -/ example : TakeDropUnary.stream true false 2 (encList encUnary [2, 0, 1]) = From f3a85e0b3ac7fb727afb9a7039539892bf3c4676 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:44:02 +0000 Subject: [PATCH 26/40] wip(stack-loop): the run of the stack-loop machine (#800) --- .../MultiTape/Internal/KernelStackLoop.lean | 255 +++++++++++++++++- 1 file changed, 248 insertions(+), 7 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean index deec228e3e..6184013b71 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean @@ -12,6 +12,9 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Internal.Kernel public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.CopyWord public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.OutputToTape public import Cslib.Computability.Machines.Turing.MultiTape.Plumbing.ClearWork +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.List +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Option +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic import Mathlib.Tactic.FinCases /-! @@ -71,6 +74,14 @@ lemma tapeHeads_zero (oc os : ℤ) : tapeHeads (kk := kk) oc os 0 0 = tapeOffs o @[simp] lemma tapeHeads_nm (oc os hr hp : ℤ) (j : Fin 6) : tapeHeads (kk := kk) oc os hr hp (nm j) = ![0, oc, 0, hr, hp, os] j := Fin.append_right _ _ _ +/-- With every tape blank and every word at its start, a configuration of the stack-loop machine +is a word configuration. -/ +lemma cfgS_blank (out : List Bool) : + cfgS (kk := kk) input [] [] [] [] [] 0 0 0 0 out = tapesCfg input (fun _ => []) 0 0 out := by + unfold cfgS + congr 1 <;> funext l <;> induction l using Fin.addCases <;> simp [tapeWords, tapeOffs, + tapeHeads] <;> rename_i j <;> fin_cases j <;> rfl + /-- Two families on the tapes agree if they agree on the shared and the named tapes. -/ lemma fun_ext_tapes {α : Type*} {f g : Fin (kk + 6) → α} (h₁ : ∀ i, f (Fin.castAdd 6 i) = g (Fin.castAdd 6 i)) (h₂ : ∀ j, f (nm j) = g (nm j)) : f = g := by @@ -163,14 +174,17 @@ def emitEmb : Fin (0 + 2) ↪ Fin (kk + 6) := /-- **`onWords` on embedded tapes**, with every other tape arbitrary: the input on the tape selected for the input of `onWords`, its other tapes blank. -/ theorem transformsTapes_onWords_embed {k K : ℕ} {Symbol S : Type*} {tm : MultiTapeTM k Symbol S} - {x y : List Symbol} {t s : ℕ} (h : tm.ComputesTidilyInTimeAndSpace x y t s) (mark : Symbol) + {x y : List Symbol} {t s : ℕ} + (h : TransformsTapes tm (fun inp ws => inp = x ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s) (mark : Symbol) (e : Fin (k + 1 + 2) ↪ Fin K) : TransformsTapes ((tm.onWords mark).extendTapes e) (fun _ ws => ws (e (Fin.natAdd (k + 1) 0)) = x ∧ ∀ j ≠ Fin.natAdd (k + 1) 0, ws (e j) = []) (fun _ ws ws' em => ws' = Function.update ws (e ((Fin.last k).castAdd 2)) y ∧ em = []) (t + y.length + 6) (s + 2 * x.length + 2 * y.length + 3 * k + 18 + (K - (k + 1 + 2))) := by - refine ((h.onWords mark).extendTapes e).imp (fun _ ws ⟨hx, hb⟩ => ?_) + refine ((ComputesTidilyInTimeAndSpace.onWords mark h).extendTapes e).imp + (fun _ ws ⟨hx, hb⟩ => ?_) (fun _ ws ws' _ _ ⟨⟨hv, hy⟩, hx⟩ => ⟨?_, hy⟩) le_rfl le_rfl · funext j by_cases hj : j = Fin.natAdd (k + 1) 0 @@ -315,7 +329,8 @@ lemma tapeWords_owEmb_eq_nil {v o : Fin 6} {hv : v.val ≠ 0} {ho : o.val ≠ 0} /-- The halting test: from the current value to the halting flag. -/ lemma runs_halt {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} - (h : tm.ComputesTidilyInTimeAndSpace c y t s') (r p st : List Bool) (oc os : ℤ) + (h : TransformsTapes tm (fun inp ws => inp = c ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s') (r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (wordsM tm 1 2 (by decide) (by decide) (by decide)) (cfgS input c [] r p st oc os 0 0 out) (cfgS input c y r p st oc os 0 0 out) @@ -336,7 +351,8 @@ lemma runs_halt {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' /-- A round machine, from the current value to the pushed frames. -/ lemma runs_push {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} - (h : tm.ComputesTidilyInTimeAndSpace c y t s') (f r st : List Bool) (oc os : ℤ) + (h : TransformsTapes tm (fun inp ws => inp = c ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s') (f r st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (wordsM tm 1 4 (by decide) (by decide) (by decide)) (cfgS input c f r [] st oc os 0 0 out) (cfgS input c f r y st oc os 0 0 out) @@ -357,7 +373,8 @@ lemma runs_push {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' /-- A round machine, from the current value to the round word. -/ lemma runs_next {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} - (h : tm.ComputesTidilyInTimeAndSpace c y t s') (f p st : List Bool) (oc os : ℤ) + (h : TransformsTapes tm (fun inp ws => inp = c ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s') (f p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (wordsM tm 1 3 (by decide) (by decide) (by decide)) (cfgS input c f [] p st oc os 0 0 out) (cfgS input c f y p st oc os 0 0 out) @@ -382,12 +399,14 @@ noncomputable def initM {S : Type*} (tm : MultiTapeTM kk Bool S) := tm.outputToWord.extendTapes (initEmb (kk := kk)) lemma runs_init {S : Type*} {tm : MultiTapeTM kk Bool S} {y : List Bool} {t s' : ℕ} - (h : tm.ComputesTidilyInTimeAndSpace input y t s') (out : List Bool) : + (h : TransformsTapes tm (fun inp ws => inp = input ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s') (out : List Bool) : RunsBetween (initM tm) (cfgS input [] [] [] [] [] 0 0 0 0 out) (cfgS input y [] [] [] [] 0 0 0 0 out) (t + y.length + 2) (s' + 2 * y.length + kk + 4 + 5) := by have := runs_of_spec (input := input) (e := []) (oc := 0) (os := 0) (out := out) (out' := out) - (h.outputToWord_extendTapes (initEmb (kk := kk))) (c := []) (f := []) (r := []) (p := []) + (ComputesTidilyInTimeAndSpace.outputToWord_extendTapes h (initEmb (kk := kk))) (c := []) + (f := []) (r := []) (p := []) (st := []) (c' := y) (f' := []) (r' := []) (p' := []) (st' := []) ⟨rfl, fun j => by induction j using Fin.lastCases with @@ -512,4 +531,226 @@ lemma runs_seek (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : runs_one 4 (by simpa using runsBetween_seekEnd (input := input) p 0 out) (fun j h4 => by fin_cases j <;> simp_all) +/-! ### One round -/ + +/-- The halting test, from the current value to the halting flag. -/ +noncomputable def haltM {SH : Type*} (tH : MultiTapeTM kk Bool SH) := + wordsM tH 1 2 (by decide) (by decide) (by decide) + +/-- The pushed frames of a round, from the current value. -/ +noncomputable def pushM {SP : Type*} (tP : MultiTapeTM kk Bool SP) := + wordsM tP 1 4 (by decide) (by decide) (by decide) + +/-- The next value of a round, from the current value to the round word. -/ +noncomputable def nextM {SN : Type*} (tN : MultiTapeTM kk Bool SN) := + wordsM tN 1 3 (by decide) (by decide) (by decide) + +/-- One round: clear the halting flag, pop the stack to the front of the current value, compute +the pushed frames and the next value, drop the popped frame, make the next value current, push the +frames and test the next value. -/ +noncomputable def body {SH SP SN : Type*} (tH : MultiTapeTM kk Bool SH) + (tP : MultiTapeTM kk Bool SP) (tN : MultiTapeTM kk Bool SN) := + (clearM (kk := kk) 2).seq (popM.seq (backRC.seq ((pushM tP).seq ((nextM tN).seq (eraseM.seq + ((clearM 1).seq (copyM.seq ((clearM 3).seq (seekM.seq (backPS.seq (haltM tH))))))))))) + +/-- **One round**, from the current value `ea` and a stack whose top frame `frame u` pops to the +round word, to the next value `ea'` and the stack with the frames `X` pushed. -/ +theorem runs_round {SH SP SN : Type*} {tH : MultiTapeTM kk Bool SH} + {tP : MultiTapeTM kk Bool SP} {tN : MultiTapeTM kk Bool SN} + {ea f st0 u rest X ea' f' : List Bool} {os os' : ℤ} {tpop spop tp sp tn sn th sh : ℕ} + (hpop : RunsBetween (popM (kk := kk)) (cfgS input ea [] [] [] st0 0 os 0 0 []) + (cfgS input ea [] (frame u) [] rest 0 os' (frame u).length 0 []) tpop spop) + (hP : TransformsTapes tP (fun inp ws => inp = frame u ++ ea ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = X) tp sp) + (hN : TransformsTapes tN (fun inp ws => inp = frame u ++ ea ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = ea') tn sn) + (hH : TransformsTapes tH (fun inp ws => inp = ea' ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = f') th sh) : + RunsBetween (body tH tP tN) (cfgS input ea f [] [] st0 0 os 0 0 []) + (cfgS input ea' f' [] [] (X ++ rest) 0 (os' - X.length) 0 0 []) + (tpop + tp + tn + th + + 8 * ((frame u).length + ea.length + ea'.length + X.length + f.length + f'.length) + 42) + (spop + sp + sn + sh + + 10 * ((frame u).length + ea.length + ea'.length + X.length + f.length + f'.length) + + 20 * kk + 200) := by + have r1 := runs_clearF (input := input) (kk := kk) ea f [] [] st0 0 os [] + have r3 := runs_backRC (input := input) (kk := kk) ea [] (frame u) [] rest 0 os' [] + have r4 := runs_push (input := input) (kk := kk) hP [] [] rest (0 - (frame u).length) os' [] + have r5 := runs_next (input := input) (kk := kk) hN [] X rest (0 - (frame u).length) os' [] + have r6 := runs_erase (input := input) (kk := kk) u ea [] ea' X rest + (0 - (frame u).length) os' [] + rw [sub_add_cancel] at r6 + have r7 := runs_clearC (input := input) (kk := kk) ea [] ea' X rest 0 os' [] + have r8 := runs_copy (input := input) (kk := kk) [] ea' X rest 0 os' [] + have r9 := runs_clearR (input := input) (kk := kk) ea' [] ea' X rest 0 os' [] + have r10 := runs_seek (input := input) (kk := kk) ea' [] [] X rest 0 os' [] + have r11 := runs_backPS (input := input) (kk := kk) ea' [] [] X rest 0 os' [] + have r12 := runs_halt (input := input) (kk := kk) hH [] [] (X ++ rest) 0 (os' - X.length) [] + have hu := length_frame u + refine (r1.seq (hpop.seq (r3.seq (r4.seq (r5.seq (r6.seq (r7.seq (r8.seq (r9.seq (r10.seq + (r11.seq r12))))))))))).mono ?_ ?_ + · omega + · have e1 : kk + 6 - 1 = kk + 5 := by omega + have e2 : kk + 6 - 2 = kk + 4 := by omega + simp only [List.length_append, e1, e2] + omega + +/-! ### The loop over a stack -/ + +section Stack + +variable {γ : Type*} {encG : γ ↪ List Bool} + +lemma encList_append' (l₁ l₂ : List γ) : + encList encG (l₁ ++ l₂) = encList encG l₁ ++ encList encG l₂ := + List.flatMap_append .. + +/-- Popping a stack kept as its framed frames, ending just before cell `0`. -/ +lemma runs_pop_stack (ea : List Bool) (stk : List γ) : + RunsBetween (popM (kk := kk)) + (cfgS input ea [] [] [] (encList encG stk) 0 (-((encList encG stk).length : ℤ)) 0 0 []) + (cfgS input ea [] (frame (encOption encG stk.head?)) [] (encList encG stk.tail) 0 + (-((encList encG stk.tail).length : ℤ)) (frame (encOption encG stk.head?)).length 0 []) + (frame (encOption encG stk.head?)).length + (2 * ((frame (encOption encG stk.head?)).length + 1) + (kk + 6 - 2)) := by + cases stk with + | nil => + have := runs_pop_nil (input := input) (kk := kk) ea [] [] 0 0 [] + simpa [encOption_none, frame_nil] using this + | cons g t => + have := runs_pop_frame (input := input) (kk := kk) ea [] [] (encG g) (encList encG t) 0 + (-((encList encG (g :: t)).length : ℤ)) [] + have ho : -((encList encG (g :: t)).length : ℤ) + (frame (encG g)).length = + -((encList encG t).length : ℤ) := by + simp only [encList_cons, List.length_append, Nat.cast_add] + ring + rw [ho] at this + refine (by simpa [encOption_some] using this : RunsBetween _ _ _ _ _).mono ?_ ?_ + · simp [length_frame] + · simp [length_frame] + +end Stack + +/-- The loop condition: the halting flag is `false`. -/ +def haltCond : (Fin (kk + 6) → Option Bool) → Bool := fun work => decide (work (nm 2) = some false) + +/-- The stack-loop machine: initialize the current value, test it, repeat rounds while the test +fails, then emit the current value and clear the tapes. -/ +noncomputable def stackLoopTM {SI SH SP SN : Type*} (tI : MultiTapeTM kk Bool SI) + (tH : MultiTapeTM kk Bool SH) (tP : MultiTapeTM kk Bool SP) (tN : MultiTapeTM kk Bool SN) := + (initM tI).seq ((haltM tH).seq ((loopWhile haltCond (body tH tP tN)).seq + ((clearM 2).seq (emitM.seq (clearM 1))))) + +section Main + +variable {α γ : Type*} {encA : α ↪ List Bool} {encG : γ ↪ List Bool} {halt : α → Bool} + {round : Option γ × α → List γ × α} {SI SH SP SN : Type*} {tI : MultiTapeTM kk Bool SI} + {tH : MultiTapeTM kk Bool SH} {tP : MultiTapeTM kk Bool SP} {tN : MultiTapeTM kk Bool SN} + {TH SH' : α → ℕ} {TP SP' TN SN' : Option γ × α → ℕ} + +/-- The input of round `i`. -/ +abbrev zIn (s : ℕ → α × List γ) (i : ℕ) : Option γ × α := ((s i).2.head?, (s i).1) + +/-- The configuration at the start of round `i`. -/ +def cfgL (encA : α ↪ List Bool) (encG : γ ↪ List Bool) (halt : α → Bool) (input : List Bool) + (s : ℕ → α × List γ) (i : ℕ) : Cfg (kk + 6) Bool Unit input := + cfgS input (encA (s i).1) [halt (s i).1] [] [] (encList encG (s i).2) 0 + (-((encList encG (s i).2).length : ℤ)) 0 0 [] + +/-- A bound on the time of round `i`. -/ +def roundTime (encA : α ↪ List Bool) (encG : γ ↪ List Bool) (round : Option γ × α → List γ × α) + (TH : α → ℕ) (TP TN : Option γ × α → ℕ) (s : ℕ → α × List γ) (i : ℕ) : ℕ := + TP (zIn s i) + TN (zIn s i) + TH (round (zIn s i)).2 + + 9 * ((frame (encOption encG (s i).2.head?)).length + (encA (s i).1).length + + (encA (round (zIn s i)).2).length + (encList encG (round (zIn s i)).1).length + 2) + 42 + +/-- A bound on the space of round `i`. -/ +def roundSpace (encA : α ↪ List Bool) (encG : γ ↪ List Bool) (round : Option γ × α → List γ × α) + (SH' : α → ℕ) (SP' SN' : Option γ × α → ℕ) (kk : ℕ) (s : ℕ → α × List γ) (i : ℕ) : ℕ := + SP' (zIn s i) + SN' (zIn s i) + SH' (round (zIn s i)).2 + + 12 * ((frame (encOption encG (s i).2.head?)).length + (encA (s i).1).length + + (encA (round (zIn s i)).2).length + (encList encG (round (zIn s i)).1).length + 2) + + 21 * kk + 220 + +/-- **The run of the stack-loop machine.** If `s` is the run of a stack loop from an initial +value computed from the input with an empty stack, which halts after `n` rounds with an empty +stack, then the machine computes the halting value, within the costs of the initialization, of +the halting tests and of the rounds. -/ +theorem runs_stackLoop + (hH : ∀ a, TransformsTapes tH (fun inp ws => inp = encA a ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = [halt a]) (TH a) (SH' a)) + (hP : ∀ z, TransformsTapes tP + (fun inp ws => inp = frame (encOption encG z.1) ++ encA z.2 ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = encList encG (round z).1) (TP z) (SP' z)) + (hN : ∀ z, TransformsTapes tN + (fun inp ws => inp = frame (encOption encG z.1) ++ encA z.2 ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = encA (round z).2) (TN z) (SN' z)) + {tinit sinit : ℕ} (s : ℕ → α × List γ) (n : ℕ) + (hI : TransformsTapes tI (fun inp ws => inp = input ∧ ws = fun _ => []) + (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = encA (s 0).1) tinit sinit) + (h0 : (s 0).2 = []) + (hs : ∀ i, s (i + 1) = ((round (zIn s i)).2, (round (zIn s i)).1 ++ (s i).2.tail)) + (hrun : ∀ i < n, halt (s i).1 = false) (hstop : halt (s n).1 = true) + (hempty : (s n).2 = []) : + RunsBetween (stackLoopTM tI tH tP tN) (cfgS input [] [] [] [] [] 0 0 0 0 []) + (cfgS input [] [] [] [] [] 0 0 0 0 (encA (s n).1)) + (tinit + TH (s 0).1 + ∑ i ∈ Finset.range n, (roundTime encA encG round TH TP TN s i + 1) + + (encA (s 0).1).length + 5 * (encA (s n).1).length + 40) + (sinit + SH' (s 0).1 + + ∑ i ∈ Finset.range n, (roundSpace encA encG round SH' SP' SN' kk s i + (kk + 6)) + + 4 * (encA (s 0).1).length + 3 * (encA (s n).1).length + 10 * kk + 100) := by + -- the rounds + have hround : ∀ i < n, + haltCond (kk := kk) (cfgL (kk := kk) encA encG halt input s i).workTapeSymbols = true ∧ + RunsBetween (body tH tP tN) (cfgL encA encG halt input s i) + (cfgL encA encG halt input s (i + 1)) (roundTime encA encG round TH TP TN s i) + (roundSpace encA encG round SH' SP' SN' kk s i) := by + intro i hi + refine ⟨?_, ?_⟩ + · simp [haltCond, cfgL, cfgS, tapesCfg_workTapeSymbols, hrun i hi, tapeOfList_zero] + · have hr := runs_round (input := input) (kk := kk) (f := [halt (s i).1]) + (runs_pop_stack (input := input) (kk := kk) (encG := encG) (encA (s i).1) (s i).2) + (hP (zIn s i)) (hN (zIn s i)) (hH (round (zIn s i)).2) + have hcfg : cfgL (kk := kk) encA encG halt input s (i + 1) = + cfgS input (encA (round (zIn s i)).2) [halt (round (zIn s i)).2] [] [] + (encList encG (round (zIn s i)).1 ++ encList encG (s i).2.tail) 0 + (-((encList encG (s i).2.tail).length : ℤ) - + (encList encG (round (zIn s i)).1).length) 0 0 [] := by + rw [cfgL, hs i, encList_append'] + congr 1 + simp only [List.length_append, Nat.cast_add] + ring + rw [hcfg] + refine hr.mono ?_ ?_ + · simp only [roundTime, List.length_singleton] + omega + · simp only [roundSpace, List.length_singleton] + omega + have hloop := runsBetween_loopWhile (c := haltCond) (tm := body tH tP tN) + (cfgL encA encG halt input s) n _ _ hround + (by simp [haltCond, cfgL, cfgS, tapesCfg_workTapeSymbols, hstop, tapeOfList_zero]) + -- before and after the loop + have hinit := runs_init (input := input) (kk := kk) hI [] + have hhalt0 := runs_halt (input := input) (kk := kk) (hH (s 0).1) [] [] [] 0 0 [] + have hc0 : cfgL (kk := kk) encA encG halt input s 0 = + cfgS input (encA (s 0).1) [halt (s 0).1] [] [] [] 0 0 0 0 [] := by + simp [cfgL, h0] + have hcn : cfgL (kk := kk) encA encG halt input s n = + cfgS input (encA (s n).1) [true] [] [] [] 0 0 0 0 [] := by + simp [cfgL, hempty, hstop] + rw [hc0, hcn] at hloop + have hclearF := runs_clearF (input := input) (kk := kk) (encA (s n).1) [true] [] [] [] 0 0 [] + have hemit := runs_emit (input := input) (kk := kk) (encA (s n).1) [] [] [] [] 0 0 [] + have hclearC := runs_clearC (input := input) (kk := kk) (encA (s n).1) [] [] [] [] 0 0 + ([] ++ encA (s n).1) + rw [List.nil_append] at hclearC + refine (hinit.seq (hhalt0.seq (hloop.seq (hclearF.seq (hemit.seq hclearC))))).mono ?_ ?_ + · simp only [List.length_singleton] + omega + · have e1 : kk + 6 - (kk + 1 + 2) = 3 := by omega + simp only [List.length_singleton] + omega + +end Main + end Turing.MultiTapeTM.StackLoopKernel From e55fe68a1831b09bac70dcd5f9945434f2e02ba2 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:44:09 +0000 Subject: [PATCH 27/40] style: line lengths --- .../Machines/Turing/MultiTape/Combinators/DivConq.lean | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 12bdb342fe..5d265ca914 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -20,7 +20,8 @@ second solution. Its evaluation with a cost is the inductive relation `Turing.MultiTapeTM.DivConq.Eval`: a node costs its two subproblems plus a cost of its own. If the parts are computable, the solution is computable within the cost of the evaluation, when -the cost of every node covers the costs of its parts and the lengths of the words it touches (`Turing.MultiTapeTM.ComputableInO.divConq`). The machine runs the recursion as a +the cost of every node covers the costs of its parts and the lengths of the words it touches +(`Turing.MultiTapeTM.ComputableInO.divConq`). The machine runs the recursion as a `Turing.MultiTapeTM.StackLoop`, keeping the pending problems and saved data on a stack, so a node does not pay for the frames of its ancestors. @@ -130,7 +131,8 @@ private def loop : StackLoop (Val α β) (Frame α γ) where | .inr (.inr b) => (p.1.toList, .inr (.inr b)) omit D in -private lemma toList_head?_append_tail (stk : List (Frame α γ)) : stk.head?.toList ++ stk.tail = stk := by +private lemma toList_head?_append_tail (stk : List (Frame α γ)) : + stk.head?.toList ++ stk.tail = stk := by cases stk <;> rfl /-- **The trace of an evaluation.** If every round costs at most `R` of its input, and `R` is From 4a4939423418aaf85708033249ee3b698bf59481 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:44:18 +0000 Subject: [PATCH 28/40] test(divconq): smoke test instantiating ComputableInO.divConq (#800) --- ComplexityTests/DivConq.lean | 53 ++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 ComplexityTests/DivConq.lean diff --git a/ComplexityTests/DivConq.lean b/ComplexityTests/DivConq.lean new file mode 100644 index 0000000000..5a9f5a9b1a --- /dev/null +++ b/ComplexityTests/DivConq.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (tests of the divide-and-conquer combinator) + +public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.DivConq + +/-! +# Divide and conquer + +A smoke test of `Turing.MultiTapeTM.ComputableInO.divConq`: a recursion in which every problem is a +base problem, solved by the identity on unary numbers, so that all hypotheses are discharged and the +conclusion is reached. The windowed simulation +(`Turing.MultiTapeTM.Universal.computableInO_universal_nlogn`) is a nontrivial instance. +-/ + +@[expose] public section + +namespace ComplexityTests.DivConq + +open Turing.MultiTapeTM + +/-- A recursion in which every problem is a base problem, solved by the identity. -/ +def trivialDC : DivConq ℕ ℕ ℕ where + isBase _ := true + base := id + left := id + mid p := p + join q := q.2 + +/-- Every problem of `trivialDC` is solved by itself. -/ +example : ComputableInO (fun n : ℕ => n) encUnary encUnary + (fun n => (encUnary n).length + (encUnary n).length + (encUnary n).length + + ((encUnary n).length + (encUnary n).length + (encUnary n).length + (encUnary n).length + + (encUnary n).length + (encUnary n).length + 1)) + (fun n => (encUnary n).length + (encUnary n).length + (encUnary n).length + + ((encUnary n).length + (encUnary n).length + (encUnary n).length + (encUnary n).length + + (encUnary n).length + (encUnary n).length + 1)) := + ComputableInO.divConq trivialDC (init := id) (F := fun n => n) (cn := fun _ _ _ => 0) + (ComputableTidilyInO.of_linear (.of_eq fun _ => rfl)).computableInO + (ComputableTidilyInO.const (encMid := encBool) true).computableInO + (ComputableTidilyInO.of_linear (.of_eq fun _ => rfl)).computableInO + (ComputableTidilyInO.of_linear (.of_eq fun _ => rfl)).computableInO + (ComputableTidilyInO.of_linear (.of_eq fun _ => rfl)).computableInO + (ComputableTidilyInO.snd encUnary encUnary).computableInO + (fun _ _ => le_rfl) (fun _ _ _ h => absurd h (by simp [trivialDC])) + (fun _ => .base rfl) + +end ComplexityTests.DivConq From 20e1ff32a2339c6ff1e99bbb869d26d64c2a8287 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:50:05 +0000 Subject: [PATCH 29/40] feat(stack-loop): prove ComputableInO.stackLoop natively (#800) --- .../MultiTape/Combinators/StackLoop.lean | 243 +++++++++++++++++- 1 file changed, 242 insertions(+), 1 deletion(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean index 1772b1d143..415eb639e9 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean @@ -9,6 +9,9 @@ module public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO public import Mathlib.Algebra.BigOperators.Group.Finset.Basic +import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelStackLoop +import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelFacts +import Mathlib.Tactic.Ring /-! # Loops with a stack of frames @@ -23,6 +26,12 @@ popped frame and the pushed frames: its cost does not depend on the frames deepe This makes recursive algorithms such as divide and conquer computable within the sum of the costs of their calls, rather than paying for the whole recursion state on every round. +The machine is `Turing.MultiTapeTM.StackLoopKernel.stackLoopTM`; its run is +`Turing.MultiTapeTM.StackLoopKernel.runs_stackLoop`. The frames sit on the stack tape as their +framed encodings, top first, ending just before cell `0`: a push writes the new frames to the left +of the stack, and a pop moves the top frame to the front of the current value, which then is the +encoding of the round input. + ## Main definitions * `Turing.MultiTapeTM.StackLoop`: the round and the halting test of a stack loop. @@ -66,6 +75,238 @@ end StackLoop open StackLoop +open StackLoopKernel in +/-- A run of a machine from and to blank stack-loop configurations is a tidy computation. -/ +private theorem computesTidily_of_runsBetween {kk : ℕ} {S : Type*} + {tm : MultiTapeTM (kk + 6) Bool S} {input y : List Bool} {t s : ℕ} + (h : RunsBetween tm (cfgS input [] [] [] [] [] 0 0 0 0 []) + (cfgS input [] [] [] [] [] 0 0 0 0 y) t s) : + tm.ComputesTidilyInTimeAndSpace input y t s := by + rw [cfgS_blank, cfgS_blank] at h + obtain ⟨hrun, hsp⟩ := h + rw [tapesCfg_zero_withState, tapesCfg_zero_withState] at hrun + rw [tapesCfg_zero_withState] at hsp + exact computesTidily_iff.mpr ⟨.ofDeterministic tm _ t, rfl, hrun, le_rfl, hsp⟩ + +/-- Summing bounds on the rounds, each charged to its own costs and to the next halting test. -/ +private theorem sum_le_of_round {n c : ℕ} {u v w : ℕ → ℕ} + (h : ∀ i < n, u i ≤ c * (4 * v i + w (i + 1))) : + ∑ i ∈ Finset.range n, u i ≤ + c * (4 * ∑ i ∈ Finset.range n, v i + ∑ i ∈ Finset.range (n + 1), w i) := by + calc ∑ i ∈ Finset.range n, u i ≤ ∑ i ∈ Finset.range n, c * (4 * v i + w (i + 1)) := + Finset.sum_le_sum fun i hi => h i (Finset.mem_range.mp hi) + _ = c * (4 * ∑ i ∈ Finset.range n, v i + ∑ i ∈ Finset.range n, w (i + 1)) := by + rw [← Finset.mul_sum, Finset.sum_add_distrib, ← Finset.mul_sum] + _ ≤ c * (4 * ∑ i ∈ Finset.range n, v i + ∑ i ∈ Finset.range (n + 1), w i) := by + refine Nat.mul_le_mul_left _ (Nat.add_le_add_left ?_ _) + rw [Finset.sum_range_succ' w] + exact Nat.le_add_right _ _ + +/-- The arithmetic of the time of one round. -/ +private theorem round_time_arith {c0 cP cN cH T S Th Sh e F A A' X ri ro : ℕ} + (hc : cP + cN + cH + 100 ≤ c0) (hri : ri = F + A) (hro : ro = 2 * X + 1 + A') (hF : 1 ≤ F) : + cP * (T + 1) + cN * (T + 1) + cH * (Th + 1) + 9 * (F + A + A' + X + 2) + 42 + 1 ≤ + c0 * (4 * (T + S + ri + ro) + (Th + Sh + e)) := by + have h1 : cP * (T + 1) ≤ c0 * (T + 1) := Nat.mul_le_mul_right _ (by omega) + have h2 : cN * (T + 1) ≤ c0 * (T + 1) := Nat.mul_le_mul_right _ (by omega) + have h3 : cH * (Th + 1) ≤ c0 * (Th + 1) := Nat.mul_le_mul_right _ (by omega) + have h4 : 100 * (ri + ro + 1) ≤ c0 * (ri + ro + 1) := Nat.mul_le_mul_right _ (by omega) + have h5 : c0 * (T + 1) + c0 * (T + 1) + c0 * (Th + 1) + c0 * (ri + ro + 1) ≤ + c0 * (4 * (T + S + ri + ro) + (Th + Sh + e)) := by + rw [← Nat.mul_add, ← Nat.mul_add, ← Nat.mul_add] + exact Nat.mul_le_mul_left _ (by omega) + omega + +/-- The arithmetic of the space of one round. -/ +private theorem round_space_arith {d0 cP cN cH kk kP kN kH T S Th Sh e F A A' X ri ro : ℕ} + (hd : cP + cN + cH + 25 * kk + 300 ≤ d0) (hri : ri = F + A) (hro : ro = 2 * X + 1 + A') + (hF : 1 ≤ F) : + cP * (S + 1) + (kk - kP) + (cN * (S + 1) + (kk - kN)) + (cH * (Sh + 1) + (kk - kH)) + + 12 * (F + A + A' + X + 2) + 21 * kk + 220 + (kk + 6) ≤ + d0 * (4 * (T + S + ri + ro) + (Th + Sh + e)) := by + have h1 : cP * (S + 1) ≤ d0 * (S + 1) := Nat.mul_le_mul_right _ (by omega) + have h2 : cN * (S + 1) ≤ d0 * (S + 1) := Nat.mul_le_mul_right _ (by omega) + have h3 : cH * (Sh + 1) ≤ d0 * (Sh + 1) := Nat.mul_le_mul_right _ (by omega) + have h4 : (25 * kk + 300) * (ri + ro + 1) ≤ d0 * (ri + ro + 1) := + Nat.mul_le_mul_right _ (by omega) + have h6 : kk ≤ kk * (ri + ro + 1) := Nat.le_mul_of_pos_right _ (by omega) + have h7 : (25 * kk + 300) * (ri + ro + 1) = 25 * (kk * (ri + ro + 1)) + 300 * (ri + ro + 1) := by + ring + have h5 : d0 * (S + 1) + d0 * (S + 1) + d0 * (Sh + 1) + d0 * (ri + ro + 1) ≤ + d0 * (4 * (T + S + ri + ro) + (Th + Sh + e)) := by + rw [← Nat.mul_add, ← Nat.mul_add, ← Nat.mul_add] + exact Nat.mul_le_mul_left _ (by omega) + omega + +/-- The arithmetic of the total time. -/ +private theorem total_time_arith {K cI cH c0 Ti Si H R E A0 An T0 S0 : ℕ} + (hK : 4 * (cI + cH + c0 + 50) ≤ K) (hS : S0 ≤ c0 * (4 * R + H)) (ha0 : A0 ≤ cI * (Si + 1)) + (hTh : T0 ≤ H) (han : An ≤ H) : + cI * (Ti + 1) + cH * (T0 + 1) + S0 + A0 + 5 * An + 40 ≤ K * (E + Ti + Si + H + R + 1) := by + have h1 : cI * (Ti + 1) ≤ (cI + cH + c0 + 50) * (Ti + 1) := Nat.mul_le_mul_right _ (by omega) + have h2 : cH * (T0 + 1) ≤ (cI + cH + c0 + 50) * (H + 1) := Nat.mul_le_mul (by omega) (by omega) + have h3 : c0 * (4 * R + H) ≤ (cI + cH + c0 + 50) * (4 * R + H) := + Nat.mul_le_mul_right _ (by omega) + have h4 : cI * (Si + 1) ≤ (cI + cH + c0 + 50) * (Si + 1) := Nat.mul_le_mul_right _ (by omega) + have h5 : 50 * (H + 1) ≤ (cI + cH + c0 + 50) * (H + 1) := Nat.mul_le_mul_right _ (by omega) + have h6 : (cI + cH + c0 + 50) * (Ti + 1) + (cI + cH + c0 + 50) * (H + 1) + + (cI + cH + c0 + 50) * (4 * R + H) + (cI + cH + c0 + 50) * (Si + 1) + + (cI + cH + c0 + 50) * (H + 1) ≤ K * (E + Ti + Si + H + R + 1) := by + rw [← Nat.mul_add, ← Nat.mul_add, ← Nat.mul_add, ← Nat.mul_add] + calc (cI + cH + c0 + 50) * (Ti + 1 + (H + 1) + (4 * R + H) + (Si + 1) + (H + 1)) + ≤ (cI + cH + c0 + 50) * (4 * (E + Ti + Si + H + R + 1)) := + Nat.mul_le_mul_left _ (by omega) + _ = 4 * (cI + cH + c0 + 50) * (E + Ti + Si + H + R + 1) := by ring + _ ≤ K * (E + Ti + Si + H + R + 1) := Nat.mul_le_mul_right _ hK + omega + +/-- The arithmetic of the total space. -/ +private theorem total_space_arith {K cI cH d0 kk kI kH Ti Si H R E A0 An Sh0 S0 : ℕ} + (hK : 8 * (cI + cH + d0 + 20 * kk + 200) ≤ K) (hS : S0 ≤ d0 * (4 * R + H)) + (ha0 : A0 ≤ cI * (Si + 1)) (hSh : Sh0 ≤ H) (han : An ≤ H) : + cI * (Si + 1) + (kk - kI) + (cH * (Sh0 + 1) + (kk - kH)) + S0 + 4 * A0 + 3 * An + + 10 * kk + 100 ≤ K * (E + Ti + Si + H + R + 1) := by + set C := cI + cH + d0 + 20 * kk + 200 with hC + have h1 : cI * (Si + 1) ≤ C * (Si + 1) := Nat.mul_le_mul_right _ (by omega) + have h2 : cH * (Sh0 + 1) ≤ C * (H + 1) := Nat.mul_le_mul (by omega) (by omega) + have h3 : d0 * (4 * R + H) ≤ C * (4 * R + H) := Nat.mul_le_mul_right _ (by omega) + have h5 : (20 * kk + 200) * (H + 1) ≤ C * (H + 1) := Nat.mul_le_mul_right _ (by omega) + have h8 : (20 * kk + 200) * (H + 1) = 20 * (kk * (H + 1)) + 200 * (H + 1) := by ring + have h9 : kk ≤ kk * (H + 1) := Nat.le_mul_of_pos_right _ (by omega) + have h6 : C * (Si + 1) + C * (H + 1) + C * (4 * R + H) + 4 * (C * (Si + 1)) + C * (H + 1) ≤ + K * (E + Ti + Si + H + R + 1) := by + rw [show 4 * (C * (Si + 1)) = C * (4 * (Si + 1)) by ring, ← Nat.mul_add, ← Nat.mul_add, + ← Nat.mul_add, ← Nat.mul_add] + calc C * (Si + 1 + (H + 1) + (4 * R + H) + 4 * (Si + 1) + (H + 1)) + ≤ C * (8 * (E + Ti + Si + H + R + 1)) := Nat.mul_le_mul_left _ (by omega) + _ = 8 * C * (E + Ti + Si + H + R + 1) := by ring + _ ≤ K * (E + Ti + Si + H + R + 1) := Nat.mul_le_mul_right _ hK + omega + +/-- The tidy version of `Turing.MultiTapeTM.ComputableInO.stackLoop`. -/ +private theorem ComputableTidilyInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} + {encA : α ↪ List Bool} {encG : γ ↪ List Bool} (L : StackLoop α γ) + {init : δ → α} {Ti Si : δ → ℕ} {Th Sh : α → ℕ} {Tr Sr : Option γ × α → ℕ} (n : δ → ℕ) + (hinit : ComputableTidilyInO init encIn encA Ti Si) + (hhalt : ComputableTidilyInO L.halt encA encBool Th Sh) + (hround : ComputableTidilyInO L.round (encPair (encOption encG) encA) + (encPair (encList encG) encA) Tr Sr) + (hrun : ∀ x, ∀ i < n x, L.halt (L.step^[i] (init x, [])).1 = false) + (hstop : ∀ x, L.halt (L.step^[n x] (init x, [])).1 = true) + (hempty : ∀ x, (L.step^[n x] (init x, [])).2 = []) : + ComputableTidilyInO (fun x => (L.step^[n x] (init x, [])).1) encIn encA + (fun x => (encIn x).length + Ti x + Si x + + ∑ i ∈ Finset.range (n x + 1), + (Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + + (encA (L.step^[i] (init x, [])).1).length) + + ∑ i ∈ Finset.range (n x), + (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + + (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length)) + (fun x => (encIn x).length + Ti x + Si x + + ∑ i ∈ Finset.range (n x + 1), + (Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + + (encA (L.step^[i] (init x, [])).1).length) + + ∑ i ∈ Finset.range (n x), + (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + + (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length)) := by + obtain ⟨cI, ⟨kI, SI, _, tI, hI⟩, lI⟩ := hinit + obtain ⟨cH, ⟨kH, SH, _, tH, hH⟩, -⟩ := hhalt + obtain ⟨cP, ⟨kP, SP, _, tP, hP⟩, -⟩ := hround.fst' + obtain ⟨cN, ⟨kN, SN, _, tN, hN⟩, -⟩ := hround.snd' + -- the four machines, padded to a common number of work tapes + set kk := max (max kI kH) (max kP kN) with hkk + have hkI : kI ≤ kk := (le_max_left _ _).trans (le_max_left _ _) + have hkH : kH ≤ kk := (le_max_right _ _).trans (le_max_left _ _) + have hkP : kP ≤ kk := (le_max_left _ _).trans (le_max_right _ _) + have hkN : kN ≤ kk := (le_max_right _ _).trans (le_max_right _ _) + have key := fun x => StackLoopKernel.runs_stackLoop (kk := kk) (input := encIn x) + (encA := encA) (encG := encG) (halt := L.halt) (round := L.round) + (tI := tI.extendTapes (Fin.castLEEmb hkI)) (tH := tH.extendTapes (Fin.castLEEmb hkH)) + (tP := tP.extendTapes (Fin.castLEEmb hkP)) (tN := tN.extendTapes (Fin.castLEEmb hkN)) + (TH := fun a => cH * (Th a + 1)) (SH' := fun a => cH * (Sh a + 1) + (kk - kH)) + (TP := fun z => cP * (Tr z + 1)) (SP' := fun z => cP * (Sr z + 1) + (kk - kP)) + (TN := fun z => cN * (Tr z + 1)) (SN' := fun z => cN * (Sr z + 1) + (kk - kN)) + (fun a => (hH a).extendTapes (Fin.castLEEmb hkH)) + (fun z => (hP z).extendTapes (Fin.castLEEmb hkP)) + (fun z => (hN z).extendTapes (Fin.castLEEmb hkN)) + (fun i => L.step^[i] (init x, [])) (n x) ((hI x).extendTapes (Fin.castLEEmb hkI)) rfl + (fun i => Function.iterate_succ_apply' _ _ _) (hrun x) (hstop x) (hempty x) + set c0 := cP + cN + cH + 100 with hc0 + set d0 := cP + cN + cH + 25 * kk + 300 with hd0 + -- the costs of the halting tests and of the rounds + have hH0 (x : δ) : Th (L.step^[0] (init x, [])).1 + Sh (L.step^[0] (init x, [])).1 + + (encA (L.step^[0] (init x, [])).1).length ≤ + ∑ i ∈ Finset.range (n x + 1), (Th (L.step^[i] (init x, [])).1 + + Sh (L.step^[i] (init x, [])).1 + (encA (L.step^[i] (init x, [])).1).length) := + Finset.single_le_sum (f := fun i => Th (L.step^[i] (init x, [])).1 + + Sh (L.step^[i] (init x, [])).1 + (encA (L.step^[i] (init x, [])).1).length) + (fun _ _ => Nat.zero_le _) (Finset.mem_range.mpr (Nat.succ_pos _)) + have hHn (x : δ) : Th (L.step^[n x] (init x, [])).1 + Sh (L.step^[n x] (init x, [])).1 + + (encA (L.step^[n x] (init x, [])).1).length ≤ + ∑ i ∈ Finset.range (n x + 1), (Th (L.step^[i] (init x, [])).1 + + Sh (L.step^[i] (init x, [])).1 + (encA (L.step^[i] (init x, [])).1).length) := + Finset.single_le_sum (f := fun i => Th (L.step^[i] (init x, [])).1 + + Sh (L.step^[i] (init x, [])).1 + (encA (L.step^[i] (init x, [])).1).length) + (fun _ _ => Nat.zero_le _) (Finset.mem_range.mpr (Nat.lt_succ_self _)) + refine ComputableTidilyInO.of_bounds ⟨kk + 6, _, by infer_instance, _, + fun x => computesTidily_of_runsBetween (key x)⟩ + (4 * (cI + cH + c0 + 50) + 8 * (cI + cH + d0 + 20 * kk + 200) + 1) ?_ ?_ ?_ + · intro x + have hsum := sum_le_of_round (n := n x) (c := c0) + (u := fun i => StackLoopKernel.roundTime encA encG L.round (fun a => cH * (Th a + 1)) + (fun z => cP * (Tr z + 1)) (fun z => cN * (Tr z + 1)) (fun i => L.step^[i] (init x, [])) + i + 1) + (v := fun i => Tr (roundInput (L.step^[i] (init x, []))) + + Sr (roundInput (L.step^[i] (init x, []))) + + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + + (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length) + (w := fun i => Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + + (encA (L.step^[i] (init x, [])).1).length) + (fun i _ => by + simp only [StackLoopKernel.roundTime, StackLoopKernel.zIn, roundInput, + Function.iterate_succ_apply', StackLoop.step] + generalize L.step^[i] (init x, []) = st + generalize L.round (st.2.head?, st.1) = rr + exact round_time_arith (by omega) (by simp) (length_encPair _) (by simp [length_frame])) + have h0 := hH0 x + have hn := hHn x + exact total_time_arith (by omega) hsum (lI x) (by omega) (by omega) + · intro x + have hsum := sum_le_of_round (n := n x) (c := d0) + (u := fun i => StackLoopKernel.roundSpace encA encG L.round + (fun a => cH * (Sh a + 1) + (kk - kH)) (fun z => cP * (Sr z + 1) + (kk - kP)) + (fun z => cN * (Sr z + 1) + (kk - kN)) kk (fun i => L.step^[i] (init x, [])) i + (kk + 6)) + (v := fun i => Tr (roundInput (L.step^[i] (init x, []))) + + Sr (roundInput (L.step^[i] (init x, []))) + + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + + (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length) + (w := fun i => Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + + (encA (L.step^[i] (init x, [])).1).length) + (fun i _ => by + simp only [StackLoopKernel.roundSpace, StackLoopKernel.zIn, roundInput, + Function.iterate_succ_apply', StackLoop.step] + generalize L.step^[i] (init x, []) = st + generalize L.round (st.2.head?, st.1) = rr + exact round_space_arith (by omega) (by simp) (length_encPair _) (by simp [length_frame])) + have h0 := hH0 x + have hn := hHn x + exact total_space_arith (by omega) hsum (lI x) (by omega) (by omega) + · intro x + have hn := hHn x + have hK := Nat.le_mul_of_pos_left ((encIn x).length + Ti x + Si x + + ∑ i ∈ Finset.range (n x + 1), + (Th (L.step^[i] (init x, [])).1 + Sh (L.step^[i] (init x, [])).1 + + (encA (L.step^[i] (init x, [])).1).length) + + ∑ i ∈ Finset.range (n x), + (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + + (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length) + + 1) + (show 0 < 4 * (cI + cH + c0 + 50) + 8 * (cI + cH + d0 + 20 * kk + 200) + 1 by omega) + omega + /-- **Stack loops.** If the initial value, the halting test and the round of a stack loop are computable, and from the initial value with an empty stack the loop halts after `n x` rounds with an empty stack, then the halting value is computable. The time and space are @@ -101,6 +342,6 @@ theorem ComputableInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length)) := - sorry + (ComputableTidilyInO.stackLoop L n hinit.tidy hhalt.tidy hround.tidy hrun hstop hempty).computableInO end Turing.MultiTapeTM From 1ea4d93a78a84f2ecab4bd07b2725008665ef510 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:52:35 +0000 Subject: [PATCH 30/40] chore(stack-loop): register modules, fix lints (#800) --- Complexity.lean | 3 +++ .../MultiTape/Combinators/StackLoop.lean | 9 ++++--- .../MultiTape/Internal/KernelStackLoop.lean | 26 +++++++++++++------ .../MultiTape/Plumbing/RunsBetween.lean | 3 ++- .../Turing/MultiTape/Plumbing/WordMoves.lean | 11 +++++--- 5 files changed, 36 insertions(+), 16 deletions(-) diff --git a/Complexity.lean b/Complexity.lean index ac64a214f5..bf4d2449cf 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1718,6 +1718,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Internal.Kernel public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelIterateWhile public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelNormalForm public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelOnWords +public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelStackLoop public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelTransducer public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelZeroSpace public import Complexity.Computability.Machines.Turing.MultiTape.Internal.KernelZipTransducer @@ -1784,6 +1785,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.Prepar public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.ReadInput public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.RepeatUntilBlank public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.RewindWork +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.RunsBetween public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.Sequential public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.Shadow public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.Tidy.Basic @@ -1793,6 +1795,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.Transf public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.TransformsWords public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileCond public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileInput +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WordMoves public import Complexity.Computability.Machines.Turing.MultiTape.PolyTime public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Clock diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean index 415eb639e9..8cc7ef5625 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean @@ -210,7 +210,8 @@ private theorem ComputableTidilyInO.stackLoop {δ α γ : Type} {encIn : δ ↪ ∑ i ∈ Finset.range (n x), (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + - (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length)) := by + (encPair (encList encG) encA + (L.round (roundInput (L.step^[i] (init x, []))))).length)) := by obtain ⟨cI, ⟨kI, SI, _, tI, hI⟩, lI⟩ := hinit obtain ⟨cH, ⟨kH, SH, _, tH, hH⟩, -⟩ := hhalt obtain ⟨cP, ⟨kP, SP, _, tP, hP⟩, -⟩ := hround.fst' @@ -341,7 +342,9 @@ theorem ComputableInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} ∑ i ∈ Finset.range (n x), (Tr (roundInput (L.step^[i] (init x, []))) + Sr (roundInput (L.step^[i] (init x, []))) + (encPair (encOption encG) encA (roundInput (L.step^[i] (init x, [])))).length + - (encPair (encList encG) encA (L.round (roundInput (L.step^[i] (init x, []))))).length)) := - (ComputableTidilyInO.stackLoop L n hinit.tidy hhalt.tidy hround.tidy hrun hstop hempty).computableInO + (encPair (encList encG) encA + (L.round (roundInput (L.step^[i] (init x, []))))).length)) := + (ComputableTidilyInO.stackLoop L n hinit.tidy hhalt.tidy hround.tidy hrun hstop + hempty).computableInO end Turing.MultiTapeTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean index 6184013b71..daff6a7dac 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean @@ -74,14 +74,6 @@ lemma tapeHeads_zero (oc os : ℤ) : tapeHeads (kk := kk) oc os 0 0 = tapeOffs o @[simp] lemma tapeHeads_nm (oc os hr hp : ℤ) (j : Fin 6) : tapeHeads (kk := kk) oc os hr hp (nm j) = ![0, oc, 0, hr, hp, os] j := Fin.append_right _ _ _ -/-- With every tape blank and every word at its start, a configuration of the stack-loop machine -is a word configuration. -/ -lemma cfgS_blank (out : List Bool) : - cfgS (kk := kk) input [] [] [] [] [] 0 0 0 0 out = tapesCfg input (fun _ => []) 0 0 out := by - unfold cfgS - congr 1 <;> funext l <;> induction l using Fin.addCases <;> simp [tapeWords, tapeOffs, - tapeHeads] <;> rename_i j <;> fin_cases j <;> rfl - /-- Two families on the tapes agree if they agree on the shared and the named tapes. -/ lemma fun_ext_tapes {α : Type*} {f g : Fin (kk + 6) → α} (h₁ : ∀ i, f (Fin.castAdd 6 i) = g (Fin.castAdd 6 i)) (h₂ : ∀ j, f (nm j) = g (nm j)) : f = g := by @@ -90,6 +82,24 @@ lemma fun_ext_tapes {α : Type*} {f g : Fin (kk + 6) → α} (h₁ : ∀ i, f (F | left i => exact h₁ i | right j => exact h₂ j +/-- With every tape blank and every word at its start, a configuration of the stack-loop machine +is a word configuration. -/ +lemma cfgS_blank (out : List Bool) : + cfgS (kk := kk) input [] [] [] [] [] 0 0 0 0 out = tapesCfg input (fun _ => []) 0 0 out := by + have hw : tapeWords (kk := kk) [] [] [] [] [] = fun _ => [] := + fun_ext_tapes (fun i => tapeWords_castAdd ..) fun j => by + rw [tapeWords_nm] + fin_cases j <;> rfl + have ho : tapeOffs (kk := kk) 0 0 = 0 := + fun_ext_tapes (fun i => tapeOffs_castAdd ..) fun j => by + rw [tapeOffs_nm] + fin_cases j <;> rfl + have hh : tapeHeads (kk := kk) 0 0 0 0 = 0 := + fun_ext_tapes (fun i => tapeHeads_castAdd ..) fun j => by + rw [tapeHeads_nm] + fin_cases j <;> rfl + rw [cfgS, hw, ho, hh] + /-! ### Embeddings of the phases -/ /-- The tapes of `Turing.MultiTapeTM.onWords` with `kk` work tapes: the shared tapes, the output diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean index 76cc9da0fb..bae5fd3ea0 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean @@ -144,7 +144,8 @@ theorem step_shift (tm : MultiTapeTM k Symbol State) (δ : Fin k → ℤ) /-- **Translation invariance.** The run from a shifted configuration is the shifted run. -/ theorem runFrom_shift (tm : MultiTapeTM k Symbol State) (δ : Fin k → ℤ) - (c : Cfg k Symbol State input) (t : ℕ) : tm.runFrom (c.shift δ) t = (tm.runFrom c t).shift δ := by + (c : Cfg k Symbol State input) (t : ℕ) : + tm.runFrom (c.shift δ) t = (tm.runFrom c t).shift δ := by induction t with | zero => rfl | succ t ih => rw [runFrom_succ, runFrom_succ, ih, step_shift] diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean index 2e1463c7a8..4b071e90d2 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean @@ -24,7 +24,8 @@ sit anywhere on their tapes. They implement a stack kept on a tape that grows to * `Turing.MultiTapeTM.seekEnd`: move the head from the first cell of a word to the cell after it. * `Turing.MultiTapeTM.copyBack`: move a word, read from its end, to the front of the word on a second tape. -* `Turing.MultiTapeTM.eraseFrame`: erase a framed word (`Cslib.frame`) at the front of a tape. +* `Turing.MultiTapeTM.eraseFrame`: erase a framed word (`Turing.MultiTapeTM.frame`) at the front + of a tape. * `Turing.MultiTapeTM.popFrame`: move a framed word at the front of a tape to the end of a word on a second tape, prefixed by `[true, true]`, or write `[false]` if the first tape is blank. @@ -55,7 +56,7 @@ lemma tapeOfList_cons_of_ne (x : Symbol) (l : List Symbol) {z : ℤ} (hz : z ≠ tapeOfList (x :: l) z = tapeOfList l (z - 1) := by rcases z with (_ | n) | n · exact absurd rfl hz - · show tapeOfList (x :: l) ((n + 1 : ℕ) : ℤ) = tapeOfList l (((n + 1 : ℕ) : ℤ) - 1) + · change tapeOfList (x :: l) ((n + 1 : ℕ) : ℤ) = tapeOfList l (((n + 1 : ℕ) : ℤ) - 1) have h : ((n + 1 : ℕ) : ℤ) - 1 = (n : ℤ) := by omega rw [h] rfl @@ -138,7 +139,8 @@ lemma runFrom_succ_eq_step {k : ℕ} {State : Type*} (tm : MultiTapeTM k Symbol noncomputable def seekEnd (Symbol : Type*) : MultiTapeTM 1 Symbol Unit := ofTr () fun _ _ work => match work 0 with - | some _ => { inputTape := 0, workTapes := fun _ => (none, 1), output := none, state := some () } + | some _ => + { inputTape := 0, workTapes := fun _ => (none, 1), output := none, state := some () } | none => { inputTape := 0, workTapes := fun _ => (none, 0), output := none, state := none } theorem runFrom_seekEnd (w suf pre : List Symbol) (hw : w = pre ++ suf) (o : ℤ) @@ -157,7 +159,8 @@ theorem runFrom_seekEnd (w suf pre : List Symbol) (hw : w = pre ++ suf) (o : ℤ | cons x suf ih => rw [show (x :: suf).length + 1 = 1 + (suf.length + 1) by simp; omega, runFrom_add, runFrom_one, step_tapesCfg (a := ⟨0, fun _ => (none, 1), none, some ()⟩) - (h' := fun _ => o + (pre ++ [x]).length) ?_ rfl rfl (fun _ => rfl) (fun _ => by simp; omega)] + (h' := fun _ => o + (pre ++ [x]).length) ?_ rfl rfl (fun _ => rfl) + (fun _ => by simp; omega)] · exact ih (pre ++ [x]) (by simp [hw]) · have : tapeOfList w (o + pre.length - o) = some x := by rw [add_sub_cancel_left, tapeOfList_natCast, hw] From 08c04b4b049935bd2c4b5abe3d735bcbe26ef76d Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:53:32 +0000 Subject: [PATCH 31/40] feat(Hierarchy/ShortDesc): decide shortness in linear time Halve the unary length of the word once per bit of the framed description with a finite-state transducer inside the cumulative-cost unary stream; the costs n + n/2 + ... sum to O(n). Replaces the quadratic certificate; Time and Space build unchanged. --- .../Classes/Hierarchy/ShortDesc.lean | 157 +++++++++++++++--- 1 file changed, 132 insertions(+), 25 deletions(-) diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/ShortDesc.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/ShortDesc.lean index bc9796820f..cacb602d2d 100644 --- a/Complexity/Computability/Complexity/Classes/Hierarchy/ShortDesc.lean +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/ShortDesc.lean @@ -8,8 +8,9 @@ module -- upstream: candidate public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO -import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Constructible +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Transducer import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Quantitative +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Streaming import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Frame import Complexity.Computability.Machines.Turing.MultiTape.Universal.Bound import Mathlib.Data.Nat.Size @@ -31,8 +32,8 @@ which is `O(|x|)`. Padded descriptions are short. * `Cslib.Complexity.Diagonal.shortDesc_eq_decide`: shortness compares the length of the description with the number of binary digits of the length of the word. -* `Cslib.Complexity.Diagonal.computableInO_shortDesc`: shortness is decided within quadratic - time and linear space. +* `Cslib.Complexity.Diagonal.computableInO_shortDesc`: shortness is decided within linear time + and space, by halving the length of the word once per bit of the description. ## References @@ -56,29 +57,135 @@ theorem shortDesc_eq_decide (x : List Bool) : rw [shortDesc, encNat_apply, Nat.size_eq_bits_len] exact decide_eq_decide.mpr (Nat.lt_size.symm.trans Nat.lt_iff_add_one_le) -/-- Shortness is decided within quadratic time and linear space. -/ -theorem computableInO_shortDesc : - ComputableInO shortDesc encBits encBool (fun x => (x.length + 1) ^ 2) - fun x => x.length + 1 := by - have hu : ComputableInO unframe encBits encBits (fun x => x.length) fun x => x.length := - ComputableInO.of_linear (.of_unframe fun _ => rfl) - have ha := ComputableInDegree.unary_succ.inO_one.comp - (ComputableInO.lengthUnary.comp hu) - have hb := ComputableInO.lengthUnary.comp - (ComputableInO.lengthNat.of_enc_eq (encC := encBits) - (g := fun x : List Bool => encNat x.length) fun _ => rfl) - have h := ComputableInO.unaryLe.comp (ha.prod hb) - refine (h.mono 64 (fun x => ?_) fun x => ?_).of_enc_eq fun x => ?_ - · have h₁ := length_unframe_le x - have h₂ := Universal.length_encNat_le x.length - simp only [Function.comp_apply, length_encPair, encUnary_apply, - List.length_replicate] at h₁ h₂ ⊢ +/-! ### Shortness in linear time -/ + +/-- The transducer halving a unary number: it keeps every second bit. -/ +private def halveT : Transducer Bool Bool where + q₀ := false + step q _ := (!q, if q then [true] else []) + final _ := [] + length_step_le q _ := by cases q <;> simp + length_final_le _ := by simp + +private lemma run_halveT (q : Bool) (k : ℕ) : + halveT.run q (List.replicate k true) = List.replicate ((k + q.toNat) / 2) true := by + induction k generalizing q with + | zero => cases q <;> rfl + | succ k ih => + rw [List.replicate_succ, Transducer.run_cons, ih] + cases q + · simp only [halveT, Bool.not_false, Bool.false_eq_true, ↓reduceIte, List.nil_append, + Bool.toNat_true, Bool.toNat_false] + · have e : (k + 1 + Bool.toNat true) / 2 = (k + Bool.toNat false) / 2 + 1 := by + simp only [Bool.toNat_true, Bool.toNat_false] + omega + rw [e, List.replicate_succ] + rfl + +/-- The transducer emitting nothing. -/ +private def silentT : Transducer Bool Unit where + q₀ := () + step _ _ := ((), []) + final _ := [] + length_step_le _ _ := by simp + length_final_le _ := by simp + +private lemma run_silentT (w : List Bool) : silentT.run () w = [] := by + induction w with + | nil => rfl + | cons b w ih => exact ih + +/-- The transducer reporting whether a unary number is positive. -/ +private def posT : Transducer Bool Bool where + q₀ := false + step _ _ := (true, []) + final q := [q] + length_step_le _ _ := by simp + length_final_le _ := by simp + +private lemma run_posT (q : Bool) (k : ℕ) : + posT.run q (List.replicate k true) = [q || decide (0 < k)] := by + induction k generalizing q with + | zero => simp [posT] + | succ k ih => + rw [List.replicate_succ, Transducer.run_cons, ih] + simp [posT] + +private lemma iterate_div_two (n i : ℕ) : (· / 2)^[i] n = n / 2 ^ i := by + induction i with + | zero => simp + | succ i ih => + rw [Function.iterate_succ_apply', ih, pow_succ, Nat.div_div_eq_div_mul] + +private lemma sum_div_two_pow_le (n L : ℕ) : ∑ i ∈ Finset.range L, n / 2 ^ i ≤ 2 * n := by + induction L generalizing n with + | zero => simp + | succ L ih => + rw [Finset.sum_range_succ'] + have h (i : ℕ) : n / 2 ^ (i + 1) = n / 2 / 2 ^ i := by + rw [pow_succ', Nat.div_div_eq_div_mul] + simp only [h, pow_zero, Nat.div_one] + have := ih (n / 2) + omega + +/-- Comparing `2 ^ L` with `n`, both in unary, in linear time: `n` is halved `L` times, which costs +`n + n / 2 + ⋯`, and the result is tested for positivity. -/ +private theorem computableTidilyInO_two_pow_le : + ComputableTidilyInO (fun p : ℕ × ℕ => decide (2 ^ p.2 ≤ p.1)) (encPair encUnary encUnary) + encBool (fun p => (encPair encUnary encUnary p).length) + fun p => (encPair encUnary encUnary p).length := by + have hN : ComputableTidilyInTimeAndSpace (· / 2) encUnary encUnary + (fun k => 4 * (encUnary k).length + 8) fun _ => 0 := + halveT.computableTidilyInTimeAndSpace fun k => by + rw [encUnary_apply, encUnary_apply, run_halveT] + rfl + have hE : ComputableTidilyInTimeAndSpace (fun _ : ℕ => ([] : List Bool)) encUnary encBits + (fun k => 4 * (encUnary k).length + 8) fun _ => 0 := + silentT.computableTidilyInTimeAndSpace fun k => (run_silentT _).symm + have hF : ComputableTidilyInTimeAndSpace (fun k : ℕ => [decide (0 < k)]) encUnary encBits + (fun k => 4 * (encUnary k).length + 8) fun _ => 0 := + posT.computableTidilyInTimeAndSpace fun k => by + rw [encUnary_apply, run_posT] + rfl + obtain ⟨c, h⟩ := ComputableTidilyInTimeAndSpace.iterate_unary_stream_sum hN hE hF + (R := fun x i => 17 * (x.1 / 2 ^ i) + 17) (Q := fun _ => 0) (B := fun x => x.1) + (fun x i _ => by + simp only [encUnary_apply, List.length_replicate, iterate_div_two] + have : x.1 / 2 ^ (i + 1) ≤ x.1 / 2 ^ i := + Nat.div_le_div_left (Nat.pow_le_pow_right (by norm_num) (Nat.le_succ i)) (by positivity) + omega) + (fun _ _ _ => le_rfl) + (fun x i _ => by + simp only [encUnary_apply, List.length_replicate, iterate_div_two] + exact Nat.div_le_self _ _) + refine ComputableTidilyInO.of_bounds (h.of_enc_eq fun p => ?_) (100 * c + 100) + (fun p => ?_) (fun p => ?_) fun p => ?_ + · simp only [encBool_apply, encBits_apply, iterate_div_two, List.map_const', + List.flatten_replicate_nil, List.nil_append, List.cons.injEq, and_true] + exact decide_eq_decide.mpr (Nat.div_pos_iff.trans (and_iff_right (by positivity))).symm + · have hs := sum_div_two_pow_le p.1 p.2 + have hq : p.1 / 2 ^ p.2 ≤ p.1 := Nat.div_le_self _ _ + simp only [encUnary_apply, List.length_replicate, iterate_div_two, length_encPair, + Finset.sum_add_distrib, ← Finset.mul_sum, Finset.sum_const, Finset.card_range, + smul_eq_mul] + nlinarith + · simp only [length_encPair, encUnary_apply, List.length_replicate] nlinarith - · have h₁ := length_unframe_le x - have h₂ := Universal.length_encNat_le x.length - simp only [Function.comp_apply, length_encPair, encUnary_apply, - List.length_replicate] at h₁ h₂ ⊢ + · simp only [encBool_apply, List.length_singleton] + nlinarith + +/-- **Shortness is decided within linear time and space.** The length of the word and of the +framed description are written in unary, and the first is halved once per bit of the second. -/ +theorem computableInO_shortDesc : + ComputableInO shortDesc encBits encBool (fun x => x.length) fun x => x.length := by + have hu : ComputableTidilyInO unframe encBits encBits (fun x => x.length) fun x => x.length := + ComputableTidilyInO.of_linear (.of_unframe fun _ => rfl) + have hl := ComputableInO.lengthUnary.tidy + have h := computableTidilyInO_two_pow_le.comp (hl.prod (hl.comp hu)) + refine (h.mono 8 (fun x => ?_) fun x => ?_).computableInO + all_goals + have h₁ := length_unframe_le x + simp only [Function.comp_apply, length_encPair, encUnary_apply, List.length_replicate] at h₁ ⊢ omega - · simp only [Function.comp_apply, shortDesc_eq_decide] end Cslib.Complexity.Diagonal From c65182568ec6c0e8f1f910ff5176362ab5123912 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:53:33 +0000 Subject: [PATCH 32/40] feat(Hierarchy/TimePolylog): time hierarchy with a polylogarithmic gap (#800) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit With the O(t log t) universal simulation, the clocked diagonal on short descriptions runs in time O(n + polylog(n) * J log J); derive DTIME f ⊂ DTIME g for a clock J beating c * f + c (eventually or frequently) and for time-constructible f >= n with (f + 1) * (log (f + 1) + 1) ^ k <= g, for an absolute exponent k. Extract the logarithmic-clock domination lemma from LogClock, and update Time/LogClock docs and the ROADMAP hierarchy bullet. --- Complexity.lean | 1 + .../Classes/Hierarchy/LogClock.lean | 24 +- .../Complexity/Classes/Hierarchy/Time.lean | 18 +- .../Classes/Hierarchy/TimePolylog.lean | 317 ++++++++++++++++++ ComplexityTests/HierarchyPolylog.lean | 39 +++ ROADMAP.md | 9 +- 6 files changed, 389 insertions(+), 19 deletions(-) create mode 100644 Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean create mode 100644 ComplexityTests/HierarchyPolylog.lean diff --git a/Complexity.lean b/Complexity.lean index b6cd910a9d..94b1cc7a94 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1036,6 +1036,7 @@ public import Complexity.Computability.Complexity.Classes.Hierarchy.Polynomial public import Complexity.Computability.Complexity.Classes.Hierarchy.ShortDesc public import Complexity.Computability.Complexity.Classes.Hierarchy.Space public import Complexity.Computability.Complexity.Classes.Hierarchy.Time +public import Complexity.Computability.Complexity.Classes.Hierarchy.TimePolylog public import Complexity.Computability.Complexity.Classes.IP public import Complexity.Computability.Complexity.Classes.IP.CoinFixing public import Complexity.Computability.Complexity.Classes.IP.GameTree diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/LogClock.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/LogClock.lean index 4afbea16ab..d3a328978e 100644 --- a/Complexity/Computability/Complexity/Classes/Hierarchy/LogClock.lean +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/LogClock.lean @@ -20,11 +20,13 @@ which is smaller when `f` is polynomially bounded. The resulting hierarchy still pays for the native universal interpreter: the upper bound is `(n + 1) ^ 5 * (f n * (Nat.size (f n) + 1) + 1) ^ 3`. This is a quantitative improvement in the -clock for polynomially bounded `f`; it does not prove the textbook logarithmic-overhead -universal simulation. +clock for polynomially bounded `f`. `Hierarchy.TimePolylog` combines this clock with the +`O(t log t)` universal simulation, narrowing the gap to a polylogarithmic factor. ## Main results +* `Cslib.Complexity.eventually_mul_add_le_mul_size_succ`: the clock eventually exceeds every + `c * f n + c`. * `Cslib.Complexity.DTIME_ssubset_DTIME_of_log_clock`: the native hierarchy with a logarithmically inflated clock. -/ @@ -35,13 +37,9 @@ namespace Cslib.Complexity open Turing.MultiTapeTM Filter -/-- The native deterministic hierarchy using a logarithmically inflated clock. The upper bound -charges the existing universal interpreter explicitly. -/ -theorem DTIME_ssubset_DTIME_of_log_clock {f g : ℕ → ℕ} - (hf : TimeConstructible f) (hn : ∀ n, n ≤ f n) - (hg : ∀ᶠ n in atTop, (n + 1) ^ 5 * (f n * (Nat.size (f n) + 1) + 1) ^ 3 ≤ g n) : - DTIME encBits f ⊂ DTIME encBits g := by - refine DTIME_ssubset_DTIME_of_clock hf.mul_size_succ (fun c => ?_) hg +/-- The logarithmic clock of an at-least-linear `f` eventually exceeds every `c * f n + c`. -/ +theorem eventually_mul_add_le_mul_size_succ {f : ℕ → ℕ} (hn : ∀ n, n ≤ f n) (c : ℕ) : + ∀ᶠ n in atTop, c * f n + c ≤ f n * (Nat.size (f n) + 1) := by filter_upwards [eventually_ge_atTop (max c (2 ^ c))] with n hnc have hcf : c ≤ f n := (le_max_left _ _).trans (hnc.trans (hn n)) have hsize : c < Nat.size (f n) := @@ -49,4 +47,12 @@ theorem DTIME_ssubset_DTIME_of_log_clock {f g : ℕ → ℕ} have := Nat.mul_le_mul_left (f n) hsize.le nlinarith +/-- The native deterministic hierarchy using a logarithmically inflated clock. The upper bound +charges the existing universal interpreter explicitly. -/ +theorem DTIME_ssubset_DTIME_of_log_clock {f g : ℕ → ℕ} + (hf : TimeConstructible f) (hn : ∀ n, n ≤ f n) + (hg : ∀ᶠ n in atTop, (n + 1) ^ 5 * (f n * (Nat.size (f n) + 1) + 1) ^ 3 ≤ g n) : + DTIME encBits f ⊂ DTIME encBits g := + DTIME_ssubset_DTIME_of_clock hf.mul_size_succ (eventually_mul_add_le_mul_size_succ hn) hg + end Cslib.Complexity diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/Time.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/Time.lean index f23f9d159c..c736d6a26b 100644 --- a/Complexity/Computability/Complexity/Classes/Hierarchy/Time.lean +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/Time.lean @@ -60,12 +60,15 @@ Hence `DTIME f ⊂ DTIME g` with the clock `(n + 1) * f n` (`Cslib.Complexity.DTIME_ssubset_DTIME`). As `n ≤ f n`, the gap `(f n + 1) ^ 11 ≤ g n` suffices. -The polynomial gap is the overhead of the native universal machine, which is polynomial in the -description and in the clock. The textbook gap `f n * log (f n) = o(g n)` needs a simulation with -logarithmic overhead and is not claimed here. `Hierarchy.LogClock` reduces the clock inflation -to `f n * (Nat.size (f n) + 1)`. `Hierarchy.Polynomial` uses native padding to prove strictness -between every pair of distinct positive integer polynomial degrees, despite this -interpreter overhead. +The polynomial gap is the overhead of the polynomial-certificate universal interpreter, which is +polynomial in the description and in the clock. `Hierarchy.TimePolylog` uses the `O(t log t)` +universal simulation instead and narrows the gap to a polylogarithmic factor: `g` need only +eventually exceed `n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1)` for an absolute +constant `k`, or `(f n + 1) * (log (f n + 1) + 1) ^ k` for a time-constructible `f`. The textbook +gap `f n * log (f n) = o(g n)` needs the diagonal to clock the universal machine's own steps and is +not claimed. `Hierarchy.LogClock` reduces the clock inflation to `f n * (Nat.size (f n) + 1)`. +`Hierarchy.Polynomial` uses native padding to prove strictness between every pair of distinct +positive integer polynomial degrees, despite this interpreter overhead. ## Main definitions @@ -396,7 +399,8 @@ theorem DTIME_ssubset_DTIME_of_clock {f g J : ℕ → ℕ} (hJ : TimeConstructib /-- **The time hierarchy theorem.** If `f` is time-constructible and `n ≤ f n`, then `DTIME f` is strictly contained in every `DTIME g` with `(n + 1) ^ 8 * (f n + 1) ^ 3 ≤ g n` eventually [Arora and Barak, Theorem 3.1][AroraBarak09], [Sipser, Theorem 9.10][Sipser2013]. The gap is the -polynomial overhead of the native universal machine, not the textbook `f n * log (f n)`. -/ +polynomial overhead of the polynomial-certificate universal interpreter; +`Cslib.Complexity.exists_DTIME_ssubset_DTIME_polylog` narrows it to a polylogarithmic factor. -/ theorem DTIME_ssubset_DTIME {f g : ℕ → ℕ} (hf : TimeConstructible f) (hn : ∀ n, n ≤ f n) (hg : ∀ᶠ n in atTop, (n + 1) ^ 8 * (f n + 1) ^ 3 ≤ g n) : DTIME encBits f ⊂ DTIME encBits g := by diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean new file mode 100644 index 0000000000..03594d2c36 --- /dev/null +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean @@ -0,0 +1,317 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Complexity.Classes.Hierarchy.LogClock +import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedComplexity +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Plain +import Complexity.Computability.Machines.Turing.MultiTape.Internal.EqualityPrimitives +import Complexity.Foundations.Data.Nat.PolynomialBound.Exponential + +/-! +# The time hierarchy with a polylogarithmic gap + +With the universal machine running a fixed machine for `t` steps within time `O(t log t)` +(`Turing.MultiTapeTM.Universal.computableInO_universal_nlogn`), the clocked diagonal on short +descriptions `Cslib.Complexity.timeDiagonal J` of +`Complexity.Computability.Complexity.Classes.Hierarchy.Time` is computable within time and space +`O(n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1))` on inputs of length `n`, for a +time-constructible clock `J` and an absolute constant `k` +(`Cslib.Complexity.exists_computableInO_timeDiagonal_polylog`). On a short description, of +`L ≤ log n` bits, the decoded description has encoded length polynomial in `L`, so the overhead of +the universal machine, polynomial in that length, is polylogarithmic in `n`; the symbols are bits. +Shortness and the final test are decided in linear time. + +The diagonal argument of `Hierarchy.Time` then gives `DTIME f ⊂ DTIME g` +[Arora and Barak, Theorem 3.1][AroraBarak09], [Sipser, Theorem 9.10][Sipser2013]: + +* when a time-constructible clock `J` eventually exceeds every `c * f n + c` and + `n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1) ≤ g n` eventually + (`Cslib.Complexity.exists_DTIME_ssubset_DTIME_of_clock_polylog`), or when the clock beats each + `c * f n + c` only at arbitrarily large lengths and `f ≤ g` eventually + (`Cslib.Complexity.exists_DTIME_ssubset_DTIME_of_frequently_clock_polylog`); +* when `f` is time-constructible, `n ≤ f n` and `(f n + 1) * (log (f n + 1) + 1) ^ k ≤ g n` + eventually (`Cslib.Complexity.exists_DTIME_ssubset_DTIME_polylog`), with the clock + `f n * (Nat.size (f n) + 1)` of `Hierarchy.LogClock`. + +Each statement asserts an absolute exponent `k`, chosen before the bounds. The bounds are monotone +in `k`, so one exponent serves any finitely many of them. The gap is a polylogarithmic factor, +weaker than the textbook `f n * log (f n) = o(g n)`, which needs the diagonal to count the steps of +the universal machine itself rather than those of the simulated machine. Here the exponent `k` +comes from the polynomial overhead of the universal machine in the description and from the +degree of the description decoder. + +## Main results + +* `Cslib.Complexity.exists_computableInO_timeDiagonal_polylog`: the clocked diagonal within time + `O(n + polylog(n) * J log J)`. +* `Cslib.Complexity.exists_setOf_timeDiagonal_mem_DTIME_polylog`: its problem is in the + corresponding class. +* `Cslib.Complexity.exists_DTIME_not_subset_DTIME_of_clock_polylog`, + `Cslib.Complexity.exists_DTIME_ssubset_DTIME_of_frequently_clock_polylog`, + `Cslib.Complexity.exists_DTIME_ssubset_DTIME_of_clock_polylog`: the time hierarchy for a clock. +* `Cslib.Complexity.exists_DTIME_ssubset_DTIME_polylog`: the time hierarchy for a + time-constructible bound, with gap `f * polylog f`. + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraBarak09] +* [M. Sipser, *Introduction to the Theory of Computation*][Sipser2013] +-/ + +public section + +namespace Cslib.Complexity + +open Turing Turing.MultiTapeTM Turing.MultiTapeTM.Universal Filter + +namespace Diagonal + +/-- The test of the diagonal is within linear time and space. The comparison costs the length of +its first argument times the total length, so the constant `[eBit true]` is put first. (The +quadratic `Cslib.Complexity.Diagonal.computableInO_verdict` puts the result first.) -/ +private theorem computableInO_verdict_linear : + ComputableInO verdict eOut encBool (fun r => (eOut r).length) fun r => (eOut r).length := by + have heq := (ComputableInO.eq (encList encUnary)).tidy.comp + ((ComputableTidilyInO.const (encMid := encList encUnary) [eBit true]).prod + (ComputableTidilyInO.fst (encList encUnary) encBool)) + have hfin := (ComputableTidilyInDegree.of_finite (encIn := encPair encBool encBool) + (encMid := encBool) fun q : Bool × Bool => !(q.1 && q.2)).inO_one + refine (((hfin.comp ((ComputableTidilyInO.snd (encList encUnary) encBool).prod heq)).mono 64 + (fun r => ?_) fun r => ?_).of_enc_eq fun r => ?_).computableInO + rotate_left 2 + · simp only [verdict, Function.comp_apply, encBool_apply, List.cons.injEq, and_true] + rw [decide_eq_decide.mpr eq_comm] + all_goals + have h₁ := length_le_encPair_left (encList encUnary) encBool r + have h₂ : (encList encUnary [eBit true]).length = 3 := rfl + simp only [Function.comp_apply, length_encPair, encBool_apply, List.length_singleton, + h₂] at h₁ ⊢ + omega + +/-- The numeric core of the resources of the clocked diagonal with the `O(t log t)` universal +machine, for the exponent `E` of its overhead: for an input of length `n` with a short framed +description of `L` bits, a decoding time `A` linear in `n`, a decoded description of encoded length +`D` polynomial in `L`, symbols of size `M ≤ 1` and an encoded universal input of length `I`, +everything is within `K * (n + (log (n + 1) + 1) ^ (e * E) * Y + 1)` for the clock term +`Y = (J + 1) * (log (J + 1) + 1)`. -/ +private theorem polylogBounds_aux (E e ce cA : ℕ) (hE : 1 ≤ E) : ∃ K, ∀ {n L A D M J I : ℕ}, + 2 ^ L ≤ n → A ≤ cA * (n + 1) → D ≤ ce * (L + 1) ^ e → M ≤ 1 → + I ≤ 2 * D + 1 + (2 * (3 * n) + 1 + J) → + n + A + (n + J) + (I + (D + M + 2) ^ E * ((J + 1) * (Nat.log 2 (J + 1) + 1))) ≤ + K * (n + (Nat.log 2 (n + 1) + 1) ^ (e * E) * ((J + 1) * (Nat.log 2 (J + 1) + 1)) + 1) := by + refine ⟨cA + 2 * ce + (ce + 3) ^ E + 12, fun {n L A D M J I} hL hA hD hM hI => ?_⟩ + set ℓ := Nat.log 2 (n + 1) + 1 with hℓ + set Y := (J + 1) * (Nat.log 2 (J + 1) + 1) with hY + set V := ℓ ^ (e * E) * Y with hV + have hℓ1 : 1 ≤ ℓ := Nat.le_add_left _ _ + have hLℓ : L + 1 ≤ ℓ := Nat.succ_le_succ (Nat.le_log_of_pow_le (by norm_num) + (hL.trans (Nat.le_succ n))) + have hJY : J + 1 ≤ Y := Nat.le_mul_of_pos_right _ (Nat.succ_pos _) + have hYV : Y ≤ V := Nat.le_mul_of_pos_left _ (Nat.pow_pos hℓ1) + have hpow : (L + 1) ^ e ≤ ℓ ^ e := Nat.pow_le_pow_left hLℓ e + have hΛ : ℓ ^ e ≤ ℓ ^ (e * E) := Nat.pow_le_pow_right hℓ1 (Nat.le_mul_of_pos_right _ hE) + have hΛV : ℓ ^ (e * E) ≤ V := Nat.le_mul_of_pos_right _ (by omega) + have hDV : D ≤ ce * V := hD.trans (Nat.mul_le_mul_left _ ((hpow.trans hΛ).trans hΛV)) + have hB : (D + M + 2) ^ E * Y ≤ (ce + 3) ^ E * V := by + have h₁ : D + M + 2 ≤ (ce + 3) * ℓ ^ e := by + have := Nat.mul_le_mul_left ce hpow + have : 1 ≤ ℓ ^ e := Nat.one_le_pow _ _ hℓ1 + have e₁ : (ce + 3) * ℓ ^ e = ce * ℓ ^ e + 3 * ℓ ^ e := by ring + omega + calc (D + M + 2) ^ E * Y ≤ ((ce + 3) * ℓ ^ e) ^ E * Y := + Nat.mul_le_mul_right _ (Nat.pow_le_pow_left h₁ E) + _ = (ce + 3) ^ E * V := by rw [hV, mul_pow, ← pow_mul]; ring + have hcA : cA * (n + 1) ≤ cA * (n + V + 1) := Nat.mul_le_mul_left _ (by omega) + have hce : ce * V ≤ ce * (n + V + 1) := Nat.mul_le_mul_left _ (by omega) + have hC : (ce + 3) ^ E * V ≤ (ce + 3) ^ E * (n + V + 1) := Nat.mul_le_mul_left _ (by omega) + have e₁ : (cA + 2 * ce + (ce + 3) ^ E + 12) * (n + V + 1) = cA * (n + V + 1) + + 2 * (ce * (n + V + 1)) + (ce + 3) ^ E * (n + V + 1) + 12 * (n + V + 1) := by ring + rw [e₁] + omega + +end Diagonal + +open Diagonal in +/-- **The clocked diagonal in time `O(n + polylog(n) · J log J)`.** There is an absolute constant +`k` such that, for every time-constructible clock `J`, the clocked diagonal on short descriptions +is computable within time and space `O(n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1))` +on inputs of length `n`. It charges the shortness test, decoding, the symbols, the clock, the +`O(t log t)` universal run and the test. -/ +theorem exists_computableInO_timeDiagonal_polylog : ∃ k, ∀ {J : ℕ → ℕ}, TimeConstructible J → + ComputableInO (timeDiagonal J) encBits encBool + (fun x => x.length + (Nat.log 2 (x.length + 1) + 1) ^ k * + ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1))) + fun x => x.length + (Nat.log 2 (x.length + 1) + 1) ^ k * + ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1)) := by + obtain ⟨dd, ed, hdec⟩ := exists_computableTidilyInDegree_decodeDesc + obtain ⟨ce, hce⟩ := hdec.2 + obtain ⟨cA, hcA⟩ := PolynomiallyBounded.exists_le_mul_two_pow (p := fun u => (u + 1) ^ dd) + (by fun_prop) + obtain ⟨K, hK⟩ := polylogBounds_aux 6 ed ce cA (by norm_num) + refine ⟨ed * 6, fun {J} hJ => ?_⟩ + have hu : ComputableTidilyInO unframe encBits encBits (fun x => x.length) fun x => x.length := + ComputableTidilyInO.of_linear (.of_unframe fun _ => rfl) + have hdesc := hdec.inO.comp hu + have hsym := Universal.computableTidilyInDegree_map_eBit.inO_one + have hclock := hJ.computableInO.tidy + have hU := computableInO_universal_nlogn.tidy.comp (hdesc.prod (hsym.prod hclock)) + have h := computableInO_shortDesc.tidy.ite (computableInO_verdict_linear.tidy.comp hU) + (ComputableTidilyInO.const (encMid := encBool) false) + obtain ⟨cO, hcO⟩ := hU.length_le + have hbound (x : List Bool) (hs : shortDesc x = true) : + x.length + ((unframe x).length + 1) ^ dd + (x.length + J x.length) + + ((eIn (decodeDesc (unframe x), x.map eBit, J x.length)).length + + (descLen (decodeDesc (unframe x)) + listMax id (x.map eBit) + 2) ^ 6 * + ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1))) ≤ + K * (x.length + (Nat.log 2 (x.length + 1) + 1) ^ (ed * 6) * + ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1)) + 1) := by + have hL : 2 ^ (unframe x).length ≤ x.length := of_decide_eq_true hs + have hN : (encList encUnary (x.map eBit)).length ≤ 3 * x.length := + (length_encList_le encUnary _ (b := 1) fun s hs => by + obtain ⟨b, -, rfl⟩ := List.mem_map.mp hs + cases b + · exact Nat.zero_le _ + · exact le_rfl).trans (by rw [List.length_map]; omega) + have hJ := Universal.length_encNat_le (J x.length) + refine hK hL ((hcA _).trans (Nat.mul_le_mul_left _ (hL.trans (Nat.le_succ _)))) (hce _) + (listMax_le fun a ha => ?_) ?_ + · obtain ⟨b, -, rfl⟩ := List.mem_map.mp ha + cases b <;> decide + · simp only [length_encPair, descLen] + omega + refine (h.mono ((K + 1) * (cO + 1) + 2) (fun x => ?_) fun x => ?_).computableInO + all_goals + have hO := hcO x + dsimp only [Function.comp_apply, encBits_apply] at hO ⊢ + have hW : x.length ≤ x.length + (Nat.log 2 (x.length + 1) + 1) ^ (ed * 6) * + ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1)) := Nat.le_add_right _ _ + split_ifs with hs + · have hT := hbound x hs + set W := x.length + (Nat.log 2 (x.length + 1) + 1) ^ (ed * 6) * + ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1)) + have h₁ := Nat.mul_le_mul_left cO (Nat.add_le_add_right hT 1) + have h₂ : cO ≤ cO * (W + 1) := Nat.le_mul_of_pos_right _ (Nat.succ_pos _) + have e₁ : ((K + 1) * (cO + 1) + 2) * (W + 1) = + cO * (K * (W + 1)) + K * (W + 1) + cO * (W + 1) + 3 * (W + 1) := by ring + have e₂ : cO * (K * (W + 1) + 1) = cO * (K * (W + 1)) + cO := by ring + omega + · set W := x.length + (Nat.log 2 (x.length + 1) + 1) ^ (ed * 6) * + ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1)) + have e₁ : ((K + 1) * (cO + 1) + 2) * (W + 1) = + (K + 1) * (cO + 1) * (W + 1) + 2 * (W + 1) := by ring + omega + +/-- The problem of the clocked diagonal is decidable within time +`O(n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1))`, for an absolute constant `k`. -/ +theorem exists_setOf_timeDiagonal_mem_DTIME_polylog : ∃ k, ∀ {J : ℕ → ℕ}, TimeConstructible J → + {x | timeDiagonal J x = true} ∈ DTIME encBits fun n => + n + (Nat.log 2 (n + 1) + 1) ^ k * ((J n + 1) * (Nat.log 2 (J n + 1) + 1)) := by + obtain ⟨k, hk⟩ := exists_computableInO_timeDiagonal_polylog + exact ⟨k, fun hJ => setOf_mem_DTIME_of_computableInO (hk hJ) fun _ => le_rfl⟩ + +/-! ### The time hierarchy theorem -/ + +/-- **Time-class noninclusion from a clock, with a polylogarithmic gap.** Infinitely many favorable +lengths for each constant suffice to separate the upper class from `DTIME f`. -/ +theorem exists_DTIME_not_subset_DTIME_of_clock_polylog : ∃ k, ∀ {f g J : ℕ → ℕ}, + TimeConstructible J → (∀ c, ∃ᶠ n in atTop, c * f n + c ≤ J n) → + (∀ᶠ n in atTop, + n + (Nat.log 2 (n + 1) + 1) ^ k * ((J n + 1) * (Nat.log 2 (J n + 1) + 1)) ≤ g n) → + ¬DTIME encBits g ⊆ DTIME encBits f := by + obtain ⟨k, hk⟩ := exists_setOf_timeDiagonal_mem_DTIME_polylog + exact ⟨k, fun hJ hfJ hg h => setOf_timeDiagonal_notMem_DTIME_of_frequently_le hfJ + (h (DTIME_mono_of_eventually_le hg (hk hJ)))⟩ + +/-- **A hierarchy for irregular bounds, with a polylogarithmic gap.** The clock must dominate the +lower bound only infinitely often for each constant; eventual `f ≤ g` supplies the inclusion. -/ +theorem exists_DTIME_ssubset_DTIME_of_frequently_clock_polylog : ∃ k, ∀ {f g J : ℕ → ℕ}, + TimeConstructible J → (∀ c, ∃ᶠ n in atTop, c * f n + c ≤ J n) → + (∀ᶠ n in atTop, f n ≤ g n) → + (∀ᶠ n in atTop, + n + (Nat.log 2 (n + 1) + 1) ^ k * ((J n + 1) * (Nat.log 2 (J n + 1) + 1)) ≤ g n) → + DTIME encBits f ⊂ DTIME encBits g := by + obtain ⟨k, hk⟩ := exists_DTIME_not_subset_DTIME_of_clock_polylog + exact ⟨k, fun hJ hfJ hfg hg => ⟨DTIME_mono_of_eventually_le hfg, hk hJ hfJ hg⟩⟩ + +/-- **The time hierarchy theorem for a clock, with a polylogarithmic gap.** There is an absolute +constant `k` such that, if a time-constructible clock `J` eventually exceeds every `c * f n + c`, +then `DTIME f` is strictly contained in every `DTIME g` with +`n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1) ≤ g n` eventually +[Arora and Barak, Theorem 3.1][AroraBarak09]. -/ +theorem exists_DTIME_ssubset_DTIME_of_clock_polylog : ∃ k, ∀ {f g J : ℕ → ℕ}, + TimeConstructible J → (∀ c, ∀ᶠ n in atTop, c * f n + c ≤ J n) → + (∀ᶠ n in atTop, + n + (Nat.log 2 (n + 1) + 1) ^ k * ((J n + 1) * (Nat.log 2 (J n + 1) + 1)) ≤ g n) → + DTIME encBits f ⊂ DTIME encBits g := by + obtain ⟨k, hk⟩ := exists_DTIME_ssubset_DTIME_of_frequently_clock_polylog + refine ⟨k, fun {f g J} hJ hfJ hg => hk hJ (fun c => (hfJ c).frequently) ?_ hg⟩ + filter_upwards [hfJ 1, hg] with n h₁ h₂ + have : J n + 1 ≤ (Nat.log 2 (n + 1) + 1) ^ k * ((J n + 1) * (Nat.log 2 (J n + 1) + 1)) := + (Nat.le_mul_of_pos_right _ (Nat.succ_pos _)).trans + (Nat.le_mul_of_pos_left _ (Nat.pow_pos (Nat.succ_pos _))) + omega + +/-- The bound of the clocked diagonal for the logarithmic clock `m * (Nat.size m + 1)` of an +at-least-linear `m = f n` is within `(m + 1) * (log (m + 1) + 1) ^ (k + 5)`. -/ +private theorem logClockBound_le (k : ℕ) {n m : ℕ} (hnm : n ≤ m) (hm : 1 ≤ m) : + n + (Nat.log 2 (n + 1) + 1) ^ k * ((m * (Nat.size m + 1) + 1) * + (Nat.log 2 (m * (Nat.size m + 1) + 1) + 1)) ≤ + (m + 1) * (Nat.log 2 (m + 1) + 1) ^ (k + 5) := by + set ℓ := Nat.log 2 (m + 1) + 1 with hℓ + have hℓ2 : 2 ≤ ℓ := Nat.succ_le_succ (Nat.log_pos (by norm_num) (by omega)) + have hm2 : m + 1 < 2 ^ ℓ := Nat.lt_pow_succ_log_self (by norm_num) _ + have hsize : Nat.size m ≤ ℓ := Nat.size_le.mpr (by omega) + have hsm : Nat.size m ≤ m := Nat.size_le.mpr Nat.lt_two_pow_self + have hJ₁ : m * (Nat.size m + 1) + 1 ≤ (m + 1) * (2 * ℓ) := by + have := Nat.mul_le_mul_left m (Nat.add_le_add_right hsize 1) + have e : (m + 1) * (2 * ℓ) = m * (ℓ + 1) + (m * (ℓ - 1) + 2 * ℓ) := by + have : 2 * ℓ = (ℓ + 1) + (ℓ - 1) := by omega + rw [this] + ring + omega + have hJ₂ : m * (Nat.size m + 1) + 1 < 2 ^ (2 * ℓ) := by + have h₁ : m * (Nat.size m + 1) + 1 ≤ (m + 1) * (m + 1) := by + have := Nat.mul_le_mul_left m (Nat.add_le_add_right hsm 1) + nlinarith + have h₂ : (m + 1) * (m + 1) < 2 ^ ℓ * 2 ^ ℓ := Nat.mul_lt_mul'' hm2 hm2 + rw [two_mul, pow_add] + omega + have hlogJ : Nat.log 2 (m * (Nat.size m + 1) + 1) + 1 ≤ 2 * ℓ := + Nat.log_lt_of_lt_pow (by omega) hJ₂ + have hlogn : (Nat.log 2 (n + 1) + 1) ^ k ≤ ℓ ^ k := + Nat.pow_le_pow_left (Nat.succ_le_succ (Nat.log_mono_right (by omega))) k + have hP : m + 1 ≤ (m + 1) * ℓ ^ (k + 2) := + Nat.le_mul_of_pos_right _ (Nat.pow_pos (by omega)) + have h8 : 8 * ((m + 1) * ℓ ^ (k + 2)) ≤ (m + 1) * ℓ ^ (k + 5) := by + have : 2 ^ 3 ≤ ℓ ^ 3 := Nat.pow_le_pow_left hℓ2 3 + calc 8 * ((m + 1) * ℓ ^ (k + 2)) ≤ ℓ ^ 3 * ((m + 1) * ℓ ^ (k + 2)) := + Nat.mul_le_mul_right _ this + _ = (m + 1) * ℓ ^ (k + 5) := by ring + calc n + (Nat.log 2 (n + 1) + 1) ^ k * ((m * (Nat.size m + 1) + 1) * + (Nat.log 2 (m * (Nat.size m + 1) + 1) + 1)) + ≤ m + ℓ ^ k * (((m + 1) * (2 * ℓ)) * (2 * ℓ)) := + Nat.add_le_add hnm (Nat.mul_le_mul hlogn (Nat.mul_le_mul hJ₁ hlogJ)) + _ = m + 4 * ((m + 1) * ℓ ^ (k + 2)) := by ring + _ ≤ (m + 1) * ℓ ^ (k + 5) := by omega + +/-- **The time hierarchy theorem, with a polylogarithmic gap.** There is an absolute constant `k` +such that, if `f` is time-constructible and `n ≤ f n`, then `DTIME f` is strictly contained in +every `DTIME g` with `(f n + 1) * (log (f n + 1) + 1) ^ k ≤ g n` eventually +[Arora and Barak, Theorem 3.1][AroraBarak09], [Sipser, Theorem 9.10][Sipser2013]. The gap is a +polylogarithmic factor, not the textbook `f n * log (f n) = o(g n)`. -/ +theorem exists_DTIME_ssubset_DTIME_polylog : ∃ k, ∀ {f g : ℕ → ℕ}, TimeConstructible f → + (∀ n, n ≤ f n) → (∀ᶠ n in atTop, (f n + 1) * (Nat.log 2 (f n + 1) + 1) ^ k ≤ g n) → + DTIME encBits f ⊂ DTIME encBits g := by + obtain ⟨k, hk⟩ := exists_DTIME_ssubset_DTIME_of_clock_polylog + refine ⟨k + 5, fun {f g} hf hn hg => + hk hf.mul_size_succ (eventually_mul_add_le_mul_size_succ hn) ?_⟩ + filter_upwards [hg, eventually_ge_atTop 1] with n h h₁ + exact (logClockBound_le k (hn n) (h₁.trans (hn n))).trans h + +end Cslib.Complexity diff --git a/ComplexityTests/HierarchyPolylog.lean b/ComplexityTests/HierarchyPolylog.lean new file mode 100644 index 0000000000..4ee7cd9d6f --- /dev/null +++ b/ComplexityTests/HierarchyPolylog.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Complexity.Classes.Hierarchy.TimePolylog +import Complexity.Foundations.Data.Nat.PolynomialBound.Exponential + +/-! Linear-time shortness of descriptions, and the time hierarchy with a polylogarithmic gap on +concrete bounds. -/ + +namespace ComplexityTests.HierarchyPolylog + +open Cslib Cslib.Complexity Turing Turing.MultiTapeTM Filter + +/-- Shortness of the framed description is decided within linear time. -/ +example : ComputableInO Diagonal.shortDesc encBits encBool (fun x => x.length) fun x => x.length := + Diagonal.computableInO_shortDesc + +/-- The clock version with the exponential clock: linear time is strictly contained in the class +of the clocked diagonal for `2 ^ n`, which beats every linear function. -/ +example : ∃ k, DTIME encBits (fun n => n) ⊂ DTIME encBits fun n => + n + (Nat.log 2 (n + 1) + 1) ^ k * ((2 ^ n + 1) * (Nat.log 2 (2 ^ n + 1) + 1)) := by + obtain ⟨k, hk⟩ := exists_DTIME_ssubset_DTIME_of_clock_polylog + exact ⟨k, hk timeConstructible_two_pow (fun c => + (PolynomiallyBounded.eventually_lt_two_pow (f := fun n => c * n + c) (by fun_prop)).mono + fun _ h => h.le) (Eventually.of_forall fun _ => le_rfl)⟩ + +/-- **Quadratic time is strictly contained in quadratic time with a polylogarithmic factor**, for +an absolute exponent: far below the gap `(n + 1) ^ 8 * ((n + 1) ^ 2 + 1) ^ 3` of +`Cslib.Complexity.DTIME_ssubset_DTIME`. -/ +example : ∃ k, DTIME encBits (fun n => (n + 1) ^ 2) ⊂ + DTIME encBits fun n => ((n + 1) ^ 2 + 1) * (Nat.log 2 ((n + 1) ^ 2 + 1) + 1) ^ k := by + obtain ⟨k, hk⟩ := exists_DTIME_ssubset_DTIME_polylog + exact ⟨k, hk timeConstructible_succ_sq (fun n => by nlinarith) + (Eventually.of_forall fun _ => le_rfl)⟩ + +end ComplexityTests.HierarchyPolylog diff --git a/ROADMAP.md b/ROADMAP.md index 90254e6377..c20f9cfc32 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -182,9 +182,12 @@ index links to canonical definitions rather than keeping a second set. completeness, padding, self-reducibility, relativization and oracle separations, preserving each reduction's resource bound. - **Time hierarchies** ([#1572]): native polynomial padding separates every pair of integer - degrees `1 ≤ a < b`. Remaining targets include the general deterministic `f log f` hierarchy - with its simulation bound ([#800]), noninteger polynomial degrees and finer logarithmic - gaps, and sharp nondeterministic and alternating time hierarchies with certified simulators. + degrees `1 ≤ a < b`, and the `O(t log t)` universal simulation ([#800]) gives + `DTIME f ⊂ DTIME g` for time-constructible `f ≥ n` once `(f + 1) * polylog f ≤ g`, with an + absolute exponent (`Hierarchy/TimePolylog`). Remaining targets include the textbook + `f log f = o(g)` hierarchy, which needs the diagonal to clock the universal machine's own + steps, noninteger polynomial degrees, and sharp nondeterministic and alternating time + hierarchies with certified simulators. - The space hierarchy for `log n ≤ g n`, which needs a universal simulation that does not hold its input. - **Space:** Savitch bounds for general space-constructible functions. From 0eaaf4eaf0127dfa5a27bfde7f90a6b440141be0 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 21:55:03 +0000 Subject: [PATCH 33/40] doc(upstream): record the windowed universal simulation --- UPSTREAM.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/UPSTREAM.md b/UPSTREAM.md index d2c6548072..014dc03d21 100644 --- a/UPSTREAM.md +++ b/UPSTREAM.md @@ -47,6 +47,11 @@ Do not add a ledger row for an ordinary candidate or repeat its source marker he without repeatedly copying list tails. Retain these local improvements when synchronizing `Universal/Complexity`, `Bound` and their resource consumers with `crei/tidy-universal`. This is an extension of the existing interpreter, not a buffered Hennie–Stearns backend. + `Universal/Windowed*` adds a divide-and-conquer windowed simulation on top of the vendored + description format and `stepWith`; with the native `Combinators/StackLoop` and + `Combinators/DivConq` combinators it proves the `O(t log t)` bound + `computableInO_universal_nlogn`. It is a new local construction layered beside the vendored + files, not a revision of them; keep it out of the copied modules when synchronizing. * **Polynomial bounds.** The tidy calculus's size-parameterized `PolyBounded` adapts CSLib's `PolynomiallyBounded` and shares its closure API. Coordinate this adaptation with the tidy branch; preserve it when resynchronizing the vendored files. From 9234d42f133cb2f0da2f89bc1828fbc2803c14ac Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 22:04:11 +0000 Subject: [PATCH 34/40] doc: literature mapping, ROADMAP milestone, narrower public imports (review) --- .../Classes/Hierarchy/TimePolylog.lean | 9 +++++---- .../Turing/MultiTape/Combinators/DivConq.lean | 5 +++-- .../Universal/WindowedComplexity.lean | 20 ++++++++++++++++--- ROADMAP.md | 9 +++++---- 4 files changed, 30 insertions(+), 13 deletions(-) diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean index 03594d2c36..5e3e1ca52d 100644 --- a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean @@ -7,7 +7,8 @@ Authors: Samuel Schlesinger module -- upstream: candidate -public import Complexity.Computability.Complexity.Classes.Hierarchy.LogClock +public import Complexity.Computability.Complexity.Classes.Hierarchy.Time +import Complexity.Computability.Complexity.Classes.Hierarchy.LogClock import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedComplexity import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Plain import Complexity.Computability.Machines.Turing.MultiTape.Internal.EqualityPrimitives @@ -18,8 +19,7 @@ import Complexity.Foundations.Data.Nat.PolynomialBound.Exponential With the universal machine running a fixed machine for `t` steps within time `O(t log t)` (`Turing.MultiTapeTM.Universal.computableInO_universal_nlogn`), the clocked diagonal on short -descriptions `Cslib.Complexity.timeDiagonal J` of -`Complexity.Computability.Complexity.Classes.Hierarchy.Time` is computable within time and space +descriptions `Cslib.Complexity.timeDiagonal J` of `Hierarchy.Time` is computable within time and space `O(n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1))` on inputs of length `n`, for a time-constructible clock `J` and an absolute constant `k` (`Cslib.Complexity.exists_computableInO_timeDiagonal_polylog`). On a short description, of @@ -44,7 +44,8 @@ in `k`, so one exponent serves any finitely many of them. The gap is a polylogar weaker than the textbook `f n * log (f n) = o(g n)`, which needs the diagonal to count the steps of the universal machine itself rather than those of the simulated machine. Here the exponent `k` comes from the polynomial overhead of the universal machine in the description and from the -degree of the description decoder. +degree of the description decoder; for time-constructible `f` it also absorbs the logarithmic +inflation of the clock `f n * (Nat.size (f n) + 1)` and the `J log J` term. ## Main results diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean index 5d265ca914..314086cf95 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -7,8 +7,9 @@ Authors: Samuel Schlesinger module -- upstream: candidate -public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.StackLoop -public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Cases +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.StackLoop +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Cases /-! # Divide and conquer diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean index faebd0b811..1877be31f3 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean @@ -7,9 +7,13 @@ Authors: Samuel Schlesinger module -- upstream: candidate -public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedParts -public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedInit -public import Complexity.Computability.Machines.Turing.MultiTape.Combinators.DivConq +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Machine +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Bound +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.Windowed +public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO +import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedParts +import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedInit +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.DivConq import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Constructible import Mathlib.Tactic.Linarith import Mathlib.Tactic.Ring @@ -37,6 +41,16 @@ the encoded input plus `O((D + 1) ^ 3 + (t + 1) * (log₂ (t + 1) + 1))`. The bound covers time and space alike; the space is not bounded separately here. It depends on the largest input symbol `M` because the input cells hold the symbols in unary. +For a fixed machine on inputs over a fixed alphabet this is the `O(t log t)` simulation overhead of +[Arora and Barak, Theorem 1.9][AroraBarak09], attributed there to Hennie and Stearns, with an +additive term for reading the encoded input. It differs from that statement in several ways: the +number of steps is an input (a clocked simulation, not a run until the simulated machine halts); +the factor is an explicit polynomial in `D` and `M` rather than a constant depending on the +machine's alphabet, tapes and states; the space is not bounded by the simulated machine's space; +and the simulated model is the description format of `Turing.MultiTapeTM.Universal.Desc`, with a +read-only input and an emitted output. The construction is an original divide-and-conquer windowed +simulation, not the buffered tapes of Hennie and Stearns. + ## Main results * `Turing.MultiTapeTM.Universal.computableInO_universal_nlogn`: the universal function in time and diff --git a/ROADMAP.md b/ROADMAP.md index c20f9cfc32..caac3349c3 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -562,10 +562,11 @@ reusing graph and matroid foundations and the shared data-structure interfaces. compact root descriptors, with derived logarithmic width and uniform `Oκ((n+1) log²(n+2))` charged cost. This frontend is composed into the complete native preprocessing and the conditional ordinary host described below. -- **Efficient universal simulation** ([#800]): realize the buffered Hennie–Stearns backend - with time `O_M(t log(t + 2))`, together with a source-space-sensitive storage bound. - The current interpreter has a stronger polynomial certificate and a streaming input lookup; - the buffered representation, its native cleanup routines and their amortized bounds remain. +- **Efficient universal simulation** ([#800]): the clocked universal function runs in time + `O(N + poly(D, M) · (t + 1) log(t + 2))` by a divide-and-conquer windowed simulation + (`computableInO_universal_nlogn`). Remaining: a source-space-sensitive storage bound (the + space is currently bounded only by the time), and an unclocked form that runs until the + simulated machine halts. - **Plain computability** ([#862]): complete the plain calculus ([#608]), delete the tidy calculus, keeping only a machine-level kernel inside the Machines layer, and switch the abstract bridges to the shared predicate. From 7d39fa69f853f3955564af65a0e13f4f055566db Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 22:04:24 +0000 Subject: [PATCH 35/40] style: line length --- .../Complexity/Classes/Hierarchy/TimePolylog.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean index 5e3e1ca52d..2f4ba3e3ae 100644 --- a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean @@ -19,8 +19,8 @@ import Complexity.Foundations.Data.Nat.PolynomialBound.Exponential With the universal machine running a fixed machine for `t` steps within time `O(t log t)` (`Turing.MultiTapeTM.Universal.computableInO_universal_nlogn`), the clocked diagonal on short -descriptions `Cslib.Complexity.timeDiagonal J` of `Hierarchy.Time` is computable within time and space -`O(n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1))` on inputs of length `n`, for a +descriptions `Cslib.Complexity.timeDiagonal J` of `Hierarchy.Time` is computable within time and +space `O(n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1))` on inputs of length `n`, for a time-constructible clock `J` and an absolute constant `k` (`Cslib.Complexity.exists_computableInO_timeDiagonal_polylog`). On a short description, of `L ≤ log n` bits, the decoded description has encoded length polynomial in `L`, so the overhead of From 9f7970233a0dd5b801d4ddada5c295b0a87d38b8 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 22:04:36 +0000 Subject: [PATCH 36/40] style: line length --- .../Complexity/Classes/Hierarchy/TimePolylog.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean index 2f4ba3e3ae..311cd9e51c 100644 --- a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean @@ -20,8 +20,8 @@ import Complexity.Foundations.Data.Nat.PolynomialBound.Exponential With the universal machine running a fixed machine for `t` steps within time `O(t log t)` (`Turing.MultiTapeTM.Universal.computableInO_universal_nlogn`), the clocked diagonal on short descriptions `Cslib.Complexity.timeDiagonal J` of `Hierarchy.Time` is computable within time and -space `O(n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1))` on inputs of length `n`, for a -time-constructible clock `J` and an absolute constant `k` +space `O(n + (log (n + 1) + 1) ^ k * (J n + 1) * (log (J n + 1) + 1))` on inputs of length `n`, +for a time-constructible clock `J` and an absolute constant `k` (`Cslib.Complexity.exists_computableInO_timeDiagonal_polylog`). On a short description, of `L ≤ log n` bits, the decoded description has encoded length polynomial in `L`, so the overhead of the universal machine, polynomial in that length, is polylogarithmic in `n`; the symbols are bits. From f0ffb0534e017904aef034f8791350b25d6d9b1e Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 22:06:09 +0000 Subject: [PATCH 37/40] =?UTF-8?q?refactor(stack-loop):=20address=20review?= =?UTF-8?q?=20=E2=80=94=20reuse=20whileCond,=20targeted=20expose,=20privat?= =?UTF-8?q?e=20helpers=20(#800)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../MultiTape/Internal/KernelStackLoop.lean | 114 ++++++++++------- .../MultiTape/Plumbing/RunsBetween.lean | 116 ++++++++---------- .../Turing/MultiTape/Plumbing/WhileCond.lean | 4 +- .../Turing/MultiTape/Plumbing/WordMoves.lean | 27 ++-- 4 files changed, 136 insertions(+), 125 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean index daff6a7dac..a0c8351507 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean @@ -26,11 +26,26 @@ current value `C`, the halting flag `F`, the round input or output `R`, the push the stack `S`. The stack is kept as the framed words of its frames, top first, ending just before cell `0` of `S`, so that pushing writes to the left and popping erases from the left. -This file describes the configurations of the machine (`StackLoopKernel.cfgS`) and the runs of its -phases between them. +This file describes the configurations of the machine (`StackLoopKernel.cfgS`), the runs of its +phases between them, one round, and the whole run. + +## Main definitions + +* `Turing.MultiTapeTM.StackLoopKernel.cfgS`: the configurations of the machine. +* `Turing.MultiTapeTM.StackLoopKernel.body`: one round. +* `Turing.MultiTapeTM.StackLoopKernel.stackLoopTM`: the machine. +* `Turing.MultiTapeTM.StackLoopKernel.roundTime`, `Turing.MultiTapeTM.StackLoopKernel.roundSpace`: + bounds on one round. + +## Main results + +* `Turing.MultiTapeTM.StackLoopKernel.transformsTapes_onWords_embed`: `onWords` on embedded tapes, + with every other tape arbitrary. +* `Turing.MultiTapeTM.StackLoopKernel.runs_stackLoop`: the run of the machine on a stack loop that + halts with an empty stack. -/ -@[expose] public section +public section namespace Turing.MultiTapeTM.StackLoopKernel @@ -43,19 +58,20 @@ frames, `5` stack. -/ abbrev nm (j : Fin 6) : Fin (kk + 6) := Fin.natAdd kk j /-- The words on the tapes: the shared work tapes and the flag tape are blank. -/ -def tapeWords (c f r p s : List Bool) : Fin (kk + 6) → List Bool := +@[expose] def tapeWords (c f r p s : List Bool) : Fin (kk + 6) → List Bool := Fin.append (fun _ => []) ![[], c, f, r, p, s] /-- The offsets of the words: only the current value and the stack may be shifted. -/ -def tapeOffs (oc os : ℤ) : Fin (kk + 6) → ℤ := Fin.append (fun _ => 0) ![0, oc, 0, 0, 0, os] +@[expose] def tapeOffs (oc os : ℤ) : Fin (kk + 6) → ℤ := + Fin.append (fun _ => 0) ![0, oc, 0, 0, 0, os] /-- The heads: on the first cells of the words, except possibly on the round word and the pushed frames. -/ -def tapeHeads (oc os hr hp : ℤ) : Fin (kk + 6) → ℤ := +@[expose] def tapeHeads (oc os hr hp : ℤ) : Fin (kk + 6) → ℤ := Fin.append (fun _ => 0) ![0, oc, 0, hr, hp, os] /-- A configuration of the stack-loop machine. -/ -def cfgS (input : List Bool) (c f r p s : List Bool) (oc os hr hp : ℤ) (out : List Bool) : +@[expose] def cfgS (input : List Bool) (c f r p s : List Bool) (oc os hr hp : ℤ) (out : List Bool) : Cfg (kk + 6) Bool Unit input := tapesCfg input (tapeWords c f r p s) (tapeOffs oc os) (tapeHeads oc os hr hp) out @@ -75,7 +91,7 @@ lemma tapeHeads_zero (oc os : ℤ) : tapeHeads (kk := kk) oc os 0 0 = tapeOffs o tapeHeads (kk := kk) oc os hr hp (nm j) = ![0, oc, 0, hr, hp, os] j := Fin.append_right _ _ _ /-- Two families on the tapes agree if they agree on the shared and the named tapes. -/ -lemma fun_ext_tapes {α : Type*} {f g : Fin (kk + 6) → α} (h₁ : ∀ i, f (Fin.castAdd 6 i) = +private lemma fun_ext_tapes {α : Type*} {f g : Fin (kk + 6) → α} (h₁ : ∀ i, f (Fin.castAdd 6 i) = g (Fin.castAdd 6 i)) (h₂ : ∀ j, f (nm j) = g (nm j)) : f = g := by funext l induction l using Fin.addCases with @@ -104,7 +120,7 @@ lemma cfgS_blank (out : List Bool) : /-- The tapes of `Turing.MultiTapeTM.onWords` with `kk` work tapes: the shared tapes, the output tape `nm o`, the input tape `nm v` and the flag tape `nm 0`. -/ -def owEmb (v o : Fin 6) (hv : v.val ≠ 0) (ho : o.val ≠ 0) (hvo : v.val ≠ o.val) : +@[expose] def owEmb (v o : Fin 6) (hv : v.val ≠ 0) (ho : o.val ≠ 0) (hvo : v.val ≠ o.val) : Fin (kk + 1 + 2) ↪ Fin (kk + 6) := ⟨fun j => if h : j.val < kk then Fin.castAdd 6 ⟨j.val, h⟩ else if j.val = kk then nm o else if j.val = kk + 1 then nm v else nm 0, by @@ -142,7 +158,7 @@ end OwEmb /-- The tapes of `Turing.MultiTapeTM.outputToWord` with `kk` work tapes: the shared tapes and the current value. -/ -def initEmb : Fin (kk + 1) ↪ Fin (kk + 6) := +@[expose] def initEmb : Fin (kk + 1) ↪ Fin (kk + 6) := ⟨fun j => if h : j.val < kk then Fin.castAdd 6 ⟨j.val, h⟩ else nm 1, by intro a b hab have ha := a.isLt @@ -162,19 +178,19 @@ def initEmb : Fin (kk + 1) ↪ Fin (kk + 6) := simp [initEmb] /-- Two named tapes, for a two-tape machine. -/ -def pairEmb (a b : Fin 6) (h : a ≠ b) : Fin 2 ↪ Fin (kk + 6) := +@[expose] def pairEmb (a b : Fin 6) (h : a ≠ b) : Fin 2 ↪ Fin (kk + 6) := ⟨![nm a, nm b], by intro x y hxy fin_cases x <;> fin_cases y <;> simp_all [Fin.natAdd_inj]⟩ /-- The tapes of `Turing.MultiTapeTM.copyWord`: from the round word to the current value. -/ -def copyEmb : Fin (0 + 1 + 2) ↪ Fin (kk + 6) := +@[expose] def copyEmb : Fin (0 + 1 + 2) ↪ Fin (kk + 6) := ⟨![nm 1, nm 3, nm 0], by intro x y hxy fin_cases x <;> fin_cases y <;> simp_all [Fin.natAdd_inj]⟩ /-- The tapes of `Turing.MultiTapeTM.emitWord`: the current value. -/ -def emitEmb : Fin (0 + 2) ↪ Fin (kk + 6) := +@[expose] def emitEmb : Fin (0 + 2) ↪ Fin (kk + 6) := ⟨![nm 1, nm 0], by intro x y hxy fin_cases x <;> fin_cases y <;> simp_all [Fin.natAdd_inj]⟩ @@ -218,7 +234,7 @@ theorem transformsTapes_onWords_embed {k K : ℕ} {Symbol S : Type*} {tm : Multi /-- A specification on the words, read on configurations of the stack-loop machine with every head on the first cell of its word. -/ -lemma runs_of_spec {S : Type*} {M : MultiTapeTM (kk + 6) Bool S} +private lemma runs_of_spec {S : Type*} {M : MultiTapeTM (kk + 6) Bool S} {P : (input : List Bool) → (Fin (kk + 6) → List Bool) → Prop} {Q : (input : List Bool) → (Fin (kk + 6) → List Bool) → (Fin (kk + 6) → List Bool) → List Bool → Prop} {t s : ℕ} (h : TransformsTapes M P Q t s) @@ -234,7 +250,7 @@ lemma runs_of_spec {S : Type*} {M : MultiTapeTM (kk + 6) Bool S} exact hrun /-- A run of a machine on embedded tapes. -/ -lemma runs_lift {m : ℕ} {S : Type*} {tm : MultiTapeTM m Bool S} (e : Fin m ↪ Fin (kk + 6)) +private lemma runs_lift {m : ℕ} {S : Type*} {tm : MultiTapeTM m Bool S} (e : Fin m ↪ Fin (kk + 6)) {c c' : Cfg (kk + 6) Bool Unit input} {d₀ d : Cfg m Bool Unit input} {t s : ℕ} (hd₀ : viewCfg e c = d₀) (h : RunsBetween tm d₀ d t s) (hc : embed e d c.workTapes c.workTapePos = c') : @@ -242,7 +258,7 @@ lemma runs_lift {m : ℕ} {S : Type*} {tm : MultiTapeTM m Bool S} (e : Fin m ↪ subst hd₀ hc exact h.extendTapes e -lemma update_tapeWords (c f r p st : List Bool) (j : Fin 6) (x : List Bool) : +private lemma update_tapeWords (c f r p st : List Bool) (j : Fin 6) (x : List Bool) : Function.update (tapeWords (kk := kk) c f r p st) (nm j) x = Fin.append (fun _ => []) (Function.update ![[], c, f, r, p, st] j x) := (Fin.append_update_right _ _ _ _).symm @@ -251,7 +267,7 @@ lemma update_tapeWords (c f r p st : List Bool) (j : Fin 6) (x : List Bool) : noncomputable def clearM (j : Fin 6) := (clearWork Bool).extendTapes (tapeEmb (nm (kk := kk) j)) -lemma runs_clearC (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_clearC (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (clearM (kk := kk) 1) (cfgS input c f r p st oc os 0 0 out) (cfgS input [] f r p st oc os 0 0 out) (3 * (c.length + 1)) (c.length + 1 + (kk + 6)) := by refine runs_of_spec (e := []) (transformsTapes_clearWork_tapeEmb (Symbol := Bool) (nm 1) c) @@ -264,7 +280,7 @@ lemma runs_clearC (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : funext i fin_cases i <;> rfl) (List.append_nil out).symm -lemma runs_clearF (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_clearF (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (clearM (kk := kk) 2) (cfgS input c f r p st oc os 0 0 out) (cfgS input c [] r p st oc os 0 0 out) (3 * (f.length + 1)) (f.length + 1 + (kk + 6)) := by refine runs_of_spec (e := []) (transformsTapes_clearWork_tapeEmb (Symbol := Bool) (nm 2) f) @@ -277,7 +293,7 @@ lemma runs_clearF (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : funext i fin_cases i <;> rfl) (List.append_nil out).symm -lemma runs_clearR (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_clearR (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (clearM (kk := kk) 3) (cfgS input c f r p st oc os 0 0 out) (cfgS input c f [] p st oc os 0 0 out) (3 * (r.length + 1)) (r.length + 1 + (kk + 6)) := by refine runs_of_spec (e := []) (transformsTapes_clearWork_tapeEmb (Symbol := Bool) (nm 3) r) @@ -293,7 +309,7 @@ lemma runs_clearR (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : /-- Copying the round word to the blank current-value tape. -/ noncomputable def copyM := copyWord (copyEmb (kk := kk)) true -lemma runs_copy (f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_copy (f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (copyM (kk := kk)) (cfgS input [] f r p st oc os 0 0 out) (cfgS input r f r p st oc os 0 0 out) (3 * r.length + 10) (4 * r.length + (kk + 6) + 15) := by @@ -310,7 +326,7 @@ lemma runs_copy (f r p st : List Bool) (oc os : ℤ) (out : List Bool) : /-- Emitting the current value. -/ noncomputable def emitM := emitWord (emitEmb (kk := kk)) true -lemma runs_emit (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_emit (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (emitM (kk := kk)) (cfgS input c f r p st oc os 0 0 out) (cfgS input c f r p st oc os 0 0 (out ++ c)) (2 * c.length + 8) (2 * c.length + (kk + 6) + 10) := @@ -323,7 +339,7 @@ noncomputable def wordsM {S : Type*} (tm : MultiTapeTM kk Bool S) (v o : Fin 6) (ho : o.val ≠ 0) (hvo : v.val ≠ o.val) := (tm.onWords true).extendTapes (owEmb v o hv ho hvo) -lemma tapeWords_owEmb_eq_nil {v o : Fin 6} {hv : v.val ≠ 0} {ho : o.val ≠ 0} +private lemma tapeWords_owEmb_eq_nil {v o : Fin 6} {hv : v.val ≠ 0} {ho : o.val ≠ 0} {hvo : v.val ≠ o.val} {c f r p st : List Bool} (hnil : ![[], c, f, r, p, st] o = []) (j : Fin (kk + 1 + 2)) (hj : j ≠ Fin.natAdd (kk + 1) 0) : tapeWords c f r p st (owEmb v o hv ho hvo j) = [] := by @@ -338,7 +354,7 @@ lemma tapeWords_owEmb_eq_nil {v o : Fin 6} {hv : v.val ≠ 0} {ho : o.val ≠ 0} · simp /-- The halting test: from the current value to the halting flag. -/ -lemma runs_halt {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} +private lemma runs_halt {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} (h : TransformsTapes tm (fun inp ws => inp = c ∧ ws = fun _ => []) (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s') (r p st : List Bool) (oc os : ℤ) (out : List Bool) : @@ -360,7 +376,7 @@ lemma runs_halt {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' simpa [wordsM, show kk + 6 - (kk + 1 + 2) = 3 by omega] using this /-- A round machine, from the current value to the pushed frames. -/ -lemma runs_push {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} +private lemma runs_push {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} (h : TransformsTapes tm (fun inp ws => inp = c ∧ ws = fun _ => []) (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s') (f r st : List Bool) (oc os : ℤ) (out : List Bool) : @@ -382,7 +398,7 @@ lemma runs_push {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' simpa [wordsM, show kk + 6 - (kk + 1 + 2) = 3 by omega] using this /-- A round machine, from the current value to the round word. -/ -lemma runs_next {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} +private lemma runs_next {S : Type*} {tm : MultiTapeTM kk Bool S} {c y : List Bool} {t s' : ℕ} (h : TransformsTapes tm (fun inp ws => inp = c ∧ ws = fun _ => []) (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s') (f p st : List Bool) (oc os : ℤ) (out : List Bool) : @@ -408,7 +424,7 @@ tape. -/ noncomputable def initM {S : Type*} (tm : MultiTapeTM kk Bool S) := tm.outputToWord.extendTapes (initEmb (kk := kk)) -lemma runs_init {S : Type*} {tm : MultiTapeTM kk Bool S} {y : List Bool} {t s' : ℕ} +private lemma runs_init {S : Type*} {tm : MultiTapeTM kk Bool S} {y : List Bool} {t s' : ℕ} (h : TransformsTapes tm (fun inp ws => inp = input ∧ ws = fun _ => []) (fun _ _ ws' e => ws' = (fun _ => []) ∧ e = y) t s') (out : List Bool) : RunsBetween (initM tm) (cfgS input [] [] [] [] [] 0 0 0 0 out) @@ -433,7 +449,7 @@ lemma runs_init {S : Type*} {tm : MultiTapeTM kk Bool S} {y : List Bool} {t s' : /-! ### Native phases -/ -lemma append_apply_eq {α : Type*} {z : α} {u v : Fin 6 → α} {l : Fin (kk + 6)} +private lemma append_apply_eq {α : Type*} {z : α} {u v : Fin 6 → α} {l : Fin (kk + 6)} (h : ∀ j, l = nm j → u j = v j) : Fin.append (fun _ : Fin kk => z) u l = Fin.append (fun _ : Fin kk => z) v l := by induction l using Fin.addCases with @@ -441,7 +457,7 @@ lemma append_apply_eq {α : Type*} {z : α} {u v : Fin 6 → α} {l : Fin (kk + | right j => simp only [Fin.append_right]; exact h j rfl /-- A two-tape machine on the named tapes `a` and `b`. -/ -lemma runs_pair {S : Type*} {tm : MultiTapeTM 2 Bool S} (a b : Fin 6) (hab : a ≠ b) +private lemma runs_pair {S : Type*} {tm : MultiTapeTM 2 Bool S} (a b : Fin 6) (hab : a ≠ b) {w w' : Fin 6 → List Bool} {o o' h h' : Fin 6 → ℤ} {t s : ℕ} {out : List Bool} (hrun : RunsBetween tm (tapesCfg input ![w a, w b] ![o a, o b] ![h a, h b] out) (tapesCfg input ![w' a, w' b] ![o' a, o' b] ![h' a, h' b] out) t s) @@ -463,7 +479,7 @@ lemma runs_pair {S : Type*} {tm : MultiTapeTM 2 Bool S} (a b : Fin 6) (hab : a append_apply_eq fun j hj => (hw j (hne j hj).1 (hne j hj).2).2.2⟩ /-- A one-tape machine on the named tape `a`. -/ -lemma runs_one {S : Type*} {tm : MultiTapeTM 1 Bool S} (a : Fin 6) +private lemma runs_one {S : Type*} {tm : MultiTapeTM 1 Bool S} (a : Fin 6) {w w' : Fin 6 → List Bool} {o o' h h' : Fin 6 → ℤ} {t s : ℕ} {out : List Bool} (hrun : RunsBetween tm (tapesCfg input (fun _ => w a) (fun _ => o a) (fun _ => h a) out) (tapesCfg input (fun _ => w' a) (fun _ => o' a) (fun _ => h' a) out) t s) @@ -487,13 +503,13 @@ lemma runs_one {S : Type*} {tm : MultiTapeTM 1 Bool S} (a : Fin 6) /-- Popping the stack to the round word. -/ noncomputable def popM := popFrame.extendTapes (pairEmb (kk := kk) 5 3 (by decide)) -lemma runs_pop_nil (c f p : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_pop_nil (c f p : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (popM (kk := kk)) (cfgS input c f [] p [] oc os 0 0 out) (cfgS input c f [false] p [] oc os 1 0 out) 1 (2 * (1 + 1) + (kk + 6 - 2)) := runs_pair 5 3 _ (by simpa using runsBetween_popFrame_nil (input := input) os 0 out) (fun j h5 h3 => by fin_cases j <;> simp_all) -lemma runs_pop_frame (c f p u rest : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_pop_frame (c f p u rest : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (popM (kk := kk)) (cfgS input c f [] p (frame u ++ rest) oc os 0 0 out) (cfgS input c f (frame (true :: u)) p rest oc (os + (frame u).length) (frame (true :: u)).length 0 out) (2 * u.length + 3) @@ -504,7 +520,7 @@ lemma runs_pop_frame (c f p u rest : List Bool) (oc os : ℤ) (out : List Bool) /-- Moving the round word to the front of the current value. -/ noncomputable def backRC := (copyBack Bool).extendTapes (pairEmb (kk := kk) 3 1 (by decide)) -lemma runs_backRC (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_backRC (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (backRC (kk := kk)) (cfgS input c f r p st oc os r.length 0 out) (cfgS input (r ++ c) f [] p st (oc - r.length) os 0 0 out) (r.length + 2) (2 * (r.length + 2 + 1) + (kk + 6 - 2)) := @@ -514,7 +530,7 @@ lemma runs_backRC (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : /-- Moving the pushed frames to the front of the stack. -/ noncomputable def backPS := (copyBack Bool).extendTapes (pairEmb (kk := kk) 4 5 (by decide)) -lemma runs_backPS (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_backPS (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (backPS (kk := kk)) (cfgS input c f r p st oc os 0 p.length out) (cfgS input c f r [] (p ++ st) oc (os - p.length) 0 0 out) (p.length + 2) (2 * (p.length + 2 + 1) + (kk + 6 - 2)) := @@ -524,20 +540,20 @@ lemma runs_backPS (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : /-- Erasing the popped frame at the front of the current value. -/ noncomputable def eraseM := eraseFrame.extendTapes (tapeEmb (nm (kk := kk) 1)) -lemma runs_erase (u rest f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_erase (u rest f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (eraseM (kk := kk)) (cfgS input (frame u ++ rest) f r p st oc os 0 0 out) (cfgS input rest f r p st (oc + (frame u).length) os 0 0 out) (2 * u.length + 1) - (1 * (2 * u.length + 1 + 1) + (kk + 6 - 1)) := + (2 * u.length + 1 + 1 + (kk + 6 - 1)) := runs_one 1 (by simpa using runsBetween_eraseFrame (input := input) u rest oc out) (fun j h1 => by fin_cases j <;> simp_all) /-- Moving the head of the pushed frames to their end. -/ noncomputable def seekM := (seekEnd Bool).extendTapes (tapeEmb (nm (kk := kk) 4)) -lemma runs_seek (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : +private lemma runs_seek (c f r p st : List Bool) (oc os : ℤ) (out : List Bool) : RunsBetween (seekM (kk := kk)) (cfgS input c f r p st oc os 0 0 out) (cfgS input c f r p st oc os 0 p.length out) (p.length + 1) - (1 * (p.length + 1 + 1) + (kk + 6 - 1)) := + (p.length + 1 + 1 + (kk + 6 - 1)) := runs_one 4 (by simpa using runsBetween_seekEnd (input := input) p 0 out) (fun j h4 => by fin_cases j <;> simp_all) @@ -565,7 +581,7 @@ noncomputable def body {SH SP SN : Type*} (tH : MultiTapeTM kk Bool SH) /-- **One round**, from the current value `ea` and a stack whose top frame `frame u` pops to the round word, to the next value `ea'` and the stack with the frames `X` pushed. -/ -theorem runs_round {SH SP SN : Type*} {tH : MultiTapeTM kk Bool SH} +private theorem runs_round {SH SP SN : Type*} {tH : MultiTapeTM kk Bool SH} {tP : MultiTapeTM kk Bool SP} {tN : MultiTapeTM kk Bool SN} {ea f st0 u rest X ea' f' : List Bool} {os os' : ℤ} {tpop spop tp sp tn sn th sh : ℕ} (hpop : RunsBetween (popM (kk := kk)) (cfgS input ea [] [] [] st0 0 os 0 0 []) @@ -611,12 +627,12 @@ section Stack variable {γ : Type*} {encG : γ ↪ List Bool} -lemma encList_append' (l₁ l₂ : List γ) : +private lemma encList_append' (l₁ l₂ : List γ) : encList encG (l₁ ++ l₂) = encList encG l₁ ++ encList encG l₂ := List.flatMap_append .. /-- Popping a stack kept as its framed frames, ending just before cell `0`. -/ -lemma runs_pop_stack (ea : List Bool) (stk : List γ) : +private lemma runs_pop_stack (ea : List Bool) (stk : List γ) : RunsBetween (popM (kk := kk)) (cfgS input ea [] [] [] (encList encG stk) 0 (-((encList encG stk).length : ℤ)) 0 0 []) (cfgS input ea [] (frame (encOption encG stk.head?)) [] (encList encG stk.tail) 0 @@ -642,13 +658,14 @@ lemma runs_pop_stack (ea : List Bool) (stk : List γ) : end Stack /-- The loop condition: the halting flag is `false`. -/ -def haltCond : (Fin (kk + 6) → Option Bool) → Bool := fun work => decide (work (nm 2) = some false) +@[expose] def haltCond : (Fin (kk + 6) → Option Bool) → Bool := + fun work => decide (work (nm 2) = some false) /-- The stack-loop machine: initialize the current value, test it, repeat rounds while the test fails, then emit the current value and clear the tapes. -/ noncomputable def stackLoopTM {SI SH SP SN : Type*} (tI : MultiTapeTM kk Bool SI) (tH : MultiTapeTM kk Bool SH) (tP : MultiTapeTM kk Bool SP) (tN : MultiTapeTM kk Bool SN) := - (initM tI).seq ((haltM tH).seq ((loopWhile haltCond (body tH tP tN)).seq + (initM tI).seq ((haltM tH).seq ((whileCond (fun _ => haltCond) (body tH tP tN)).seq ((clearM 2).seq (emitM.seq (clearM 1))))) section Main @@ -662,20 +679,22 @@ variable {α γ : Type*} {encA : α ↪ List Bool} {encG : γ ↪ List Bool} {ha abbrev zIn (s : ℕ → α × List γ) (i : ℕ) : Option γ × α := ((s i).2.head?, (s i).1) /-- The configuration at the start of round `i`. -/ -def cfgL (encA : α ↪ List Bool) (encG : γ ↪ List Bool) (halt : α → Bool) (input : List Bool) +private def cfgL (encA : α ↪ List Bool) (encG : γ ↪ List Bool) (halt : α → Bool) (input : List Bool) (s : ℕ → α × List γ) (i : ℕ) : Cfg (kk + 6) Bool Unit input := cfgS input (encA (s i).1) [halt (s i).1] [] [] (encList encG (s i).2) 0 (-((encList encG (s i).2).length : ℤ)) 0 0 [] /-- A bound on the time of round `i`. -/ -def roundTime (encA : α ↪ List Bool) (encG : γ ↪ List Bool) (round : Option γ × α → List γ × α) +@[expose] def roundTime (encA : α ↪ List Bool) (encG : γ ↪ List Bool) + (round : Option γ × α → List γ × α) (TH : α → ℕ) (TP TN : Option γ × α → ℕ) (s : ℕ → α × List γ) (i : ℕ) : ℕ := TP (zIn s i) + TN (zIn s i) + TH (round (zIn s i)).2 + 9 * ((frame (encOption encG (s i).2.head?)).length + (encA (s i).1).length + (encA (round (zIn s i)).2).length + (encList encG (round (zIn s i)).1).length + 2) + 42 /-- A bound on the space of round `i`. -/ -def roundSpace (encA : α ↪ List Bool) (encG : γ ↪ List Bool) (round : Option γ × α → List γ × α) +@[expose] def roundSpace (encA : α ↪ List Bool) (encG : γ ↪ List Bool) + (round : Option γ × α → List γ × α) (SH' : α → ℕ) (SP' SN' : Option γ × α → ℕ) (kk : ℕ) (s : ℕ → α × List γ) (i : ℕ) : ℕ := SP' (zIn s i) + SN' (zIn s i) + SH' (round (zIn s i)).2 + 12 * ((frame (encOption encG (s i).2.head?)).length + (encA (s i).1).length + @@ -711,7 +730,8 @@ theorem runs_stackLoop 4 * (encA (s 0).1).length + 3 * (encA (s n).1).length + 10 * kk + 100) := by -- the rounds have hround : ∀ i < n, - haltCond (kk := kk) (cfgL (kk := kk) encA encG halt input s i).workTapeSymbols = true ∧ + (fun _ => haltCond (kk := kk)) (cfgL (kk := kk) encA encG halt input s i).inputSymbol + (cfgL (kk := kk) encA encG halt input s i).workTapeSymbols = true ∧ RunsBetween (body tH tP tN) (cfgL encA encG halt input s i) (cfgL encA encG halt input s (i + 1)) (roundTime encA encG round TH TP TN s i) (roundSpace encA encG round SH' SP' SN' kk s i) := by @@ -736,7 +756,7 @@ theorem runs_stackLoop omega · simp only [roundSpace, List.length_singleton] omega - have hloop := runsBetween_loopWhile (c := haltCond) (tm := body tH tP tN) + have hloop := runsBetween_whileCond (c := fun _ => haltCond) (tm := body tH tP tN) (cfgL encA encG halt input s) n _ _ hround (by simp [haltCond, cfgL, cfgS, tapesCfg_workTapeSymbols, hstop, tapeOfList_zero]) -- before and after the loop diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean index bae5fd3ea0..b1ebfe844d 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean @@ -7,7 +7,7 @@ Authors: Samuel Schlesinger module -- upstream: candidate -public import Cslib.Computability.Machines.Turing.MultiTape.Plumbing.RepeatUntilBlank +public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileCond public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.Sequential public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.ExtendTapesView public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.TransformsTapes @@ -31,23 +31,21 @@ configuration shifted by `δ` is `tapesCfg input ws δ δ out`. `Turing.MultiTapeTM.RunsBetween tm c c' t s` says that `tm`, started in its initial state on the tapes of `c`, has halted on the tapes of `c'` after `t` steps, using at most `s` cells. Such runs compose sequentially, embed into machines with more tapes, follow from `TransformsTapes` -specifications at any shift, and accumulate along the loop `Turing.MultiTapeTM.loopWhile`. +specifications at any shift, and accumulate along the loop `Turing.MultiTapeTM.whileCond`. ## Main definitions * `Turing.Cfg.shift`, `Turing.tapesCfg`: shifted configurations. * `Turing.MultiTapeTM.RunsBetween`: a run between two configurations within bounds. -* `Turing.MultiTapeTM.loopWhile`: run a machine while a condition on the scanned work-tape symbols - holds. ## Main results * `Turing.MultiTapeTM.runFrom_shift`, `Turing.MultiTapeTM.space_shift`: translation invariance. * `Turing.MultiTapeTM.RunsBetween.seq`, `.extendTapes`, `.of_transformsTapes`: composition. -* `Turing.MultiTapeTM.runsBetween_loopWhile`: loops, with the costs of the rounds adding up. +* `Turing.MultiTapeTM.runsBetween_whileCond`: loops, with the costs of the rounds adding up. -/ -@[expose] public section +public section namespace Turing @@ -55,7 +53,7 @@ variable {k k' : ℕ} {Symbol State : Type*} {input : List Symbol} /-- The configuration with the contents and the head of every work tape `i` moved by `δ i` cells to the right. -/ -def Cfg.shift (δ : Fin k → ℤ) (c : Cfg k Symbol State input) : Cfg k Symbol State input := +@[expose] def Cfg.shift (δ : Fin k → ℤ) (c : Cfg k Symbol State input) : Cfg k Symbol State input := ⟨c.state, c.inputPos, fun i z => c.workTapes i (z - δ i), fun i => c.workTapePos i + δ i, c.output⟩ @@ -66,7 +64,7 @@ lemma Cfg.shift_withState (δ : Fin k → ℤ) (c : Cfg k Symbol State input) {S /-- The configuration whose work tape `i` holds the word `ws i` from cell `o i` on, with its head at cell `h i`, the input head at the start of the input and the output `out`. Its state is irrelevant for `Turing.MultiTapeTM.RunsBetween`. -/ -def tapesCfg (input : List Symbol) (ws : Fin k → List Symbol) (o h : Fin k → ℤ) +@[expose] def tapesCfg (input : List Symbol) (ws : Fin k → List Symbol) (o h : Fin k → ℤ) (out : List Symbol) : Cfg k Symbol Unit input := ⟨none, 1, fun i z => tapeOfList (ws i) (z - o i), h, out⟩ @@ -173,7 +171,8 @@ theorem space_shift (tm : MultiTapeTM k Symbol State) (δ : Fin k → ℤ) /-- `RunsBetween tm c c' t s`: started in its initial state on the tapes, heads and output of `c`, the machine has halted after `t` steps on those of `c'`, having visited at most `s` cells. The states of `c` and `c'` are ignored. -/ -def RunsBetween (tm : MultiTapeTM k Symbol State) (c c' : Cfg k Symbol Unit input) (t s : ℕ) : +@[expose] def RunsBetween (tm : MultiTapeTM k Symbol State) (c c' : Cfg k Symbol Unit input) + (t s : ℕ) : Prop := tm.runFrom (c.withState (some tm.q₀)) t = c'.withState none ∧ (MultiTapeNTM.RunPath.ofDeterministic tm (c.withState (some tm.q₀)) t).space ≤ s @@ -313,111 +312,102 @@ theorem step_tapesCfg {tm : MultiTapeTM k Symbol State} {q : State} /-! ### Loops -/ -/-- `loopWhile c tm` reads the symbols under the work-tape heads and halts unless `c` holds of -them; otherwise it runs `tm` and repeats. Reading moves no head and writes nothing. -/ -noncomputable def loopWhile (c : (Fin k → Option Symbol) → Bool) - (tm : MultiTapeTM k Symbol State) : MultiTapeTM k Symbol (RepeatUntilBlankState State) := - ofTr .check fun q inp work => - match q with - | .run q => - let a := tm.tr q inp work - { a with state := some (a.state.elim .check .run) } - | .check => - { inputTape := 0, workTapes := fun _ => (none, 0), output := none, - state := if c work then some (.run tm.q₀) else none } - -namespace LoopWhile - -variable {c : (Fin k → Option Symbol) → Bool} {tm : MultiTapeTM k Symbol State} - -/-- A configuration of `tm` as one of `loopWhile c tm`. -/ -def runCfg (cfg : Cfg k Symbol State input) : Cfg k Symbol (RepeatUntilBlankState State) input := +namespace RunsBetweenWhileCond + +variable {c : Option Symbol → (Fin k → Option Symbol) → Bool} {tm : MultiTapeTM k Symbol State} + +/-- A configuration of `tm` as one of `whileCond c tm`. -/ +private def runCfg (cfg : Cfg k Symbol State input) : + Cfg k Symbol (RepeatUntilBlankState State) input := cfg.mapState (fun st => some (st.elim .check .run)) -lemma step_runCfg (cfg : Cfg k Symbol State input) (h : ¬ cfg.Halted) : - (loopWhile c tm).step (runCfg cfg) = runCfg (tm.step cfg) := by +private lemma step_runCfg (cfg : Cfg k Symbol State input) (h : ¬ cfg.Halted) : + (whileCond c tm).step (runCfg cfg) = runCfg (tm.step cfg) := by obtain ⟨q, hq⟩ := Option.ne_none_iff_exists'.mp h have hstate : (runCfg cfg).state = some (RepeatUntilBlankState.run q) := by simp [runCfg, Cfg.mapState, hq] rw [step_of_state hstate, step_of_state hq] - simp only [loopWhile, tr_ofTr] + simp only [whileCond, tr_ofTr] rfl -lemma runFrom_runCfg {cfg : Cfg k Symbol State input} {u n : ℕ} (hhalt : tm.HaltsAt cfg u) +private lemma runFrom_runCfg {cfg : Cfg k Symbol State input} {u n : ℕ} (hhalt : tm.HaltsAt cfg u) (hn : n ≤ u) : - (loopWhile c tm).runFrom (runCfg cfg) n = runCfg (tm.runFrom cfg n) := by + (whileCond c tm).runFrom (runCfg cfg) n = runCfg (tm.runFrom cfg n) := by induction n with | zero => rfl | succ n ih => rw [runFrom_succ, runFrom_succ, ih (by lia), step_runCfg _ (hhalt.not_halted (by lia))] -lemma step_check (d : Cfg k Symbol Unit input) : - (loopWhile c tm).step (d.withState (some .check)) = - d.withState (if c d.workTapeSymbols then some (.run tm.q₀) else none) := by +private lemma step_check (d : Cfg k Symbol Unit input) : + (whileCond c tm).step (d.withState (some .check)) = + d.withState (if c d.inputSymbol d.workTapeSymbols then some (.run tm.q₀) else none) := by rw [step_of_state rfl] have hw : (d.withState (some (RepeatUntilBlankState.check : RepeatUntilBlankState State)) ).workTapeSymbols = d.workTapeSymbols := rfl - rw [hw] + have hi : (d.withState (some (RepeatUntilBlankState.check : RepeatUntilBlankState State)) + ).inputSymbol = d.inputSymbol := rfl + rw [hw, hi] refine Cfg.ext ?_ ?_ ?_ ?_ ?_ <;> - simp [loopWhile, Action.apply, Cfg.withState] + simp [whileCond, Action.apply, Cfg.withState] /-- One round: from `check` with the condition holding, the loop runs `tm` and is back in `check`. -/ -lemma exists_round {d d' : Cfg k Symbol Unit input} {t s : ℕ} (hc : c d.workTapeSymbols = true) +private lemma exists_round {d d' : Cfg k Symbol Unit input} {t s : ℕ} + (hc : c d.inputSymbol d.workTapeSymbols = true) (h : RunsBetween tm d d' t s) : - ∃ u ≤ t, (loopWhile c tm).runFrom (d.withState (some .check)) (u + 1) = + ∃ u ≤ t, (whileCond c tm).runFrom (d.withState (some .check)) (u + 1) = d'.withState (some .check) ∧ - (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) (d.withState (some .check)) + (MultiTapeNTM.RunPath.ofDeterministic (whileCond c tm) (d.withState (some .check)) (1 + u)).space ≤ s + k := by obtain ⟨u, hu, hhalt⟩ := exists_haltsAt (tm := tm) (show (tm.runFrom (d.withState (some tm.q₀)) t).Halted by rw [h.1]; rfl) - have hstart : (loopWhile c tm).step (d.withState (some .check)) = + have hstart : (whileCond c tm).step (d.withState (some .check)) = runCfg (d.withState (some tm.q₀)) := by rw [step_check, hc] rfl - have hrun : (loopWhile c tm).runFrom (d.withState (some .check)) (1 + u) = + have hrun : (whileCond c tm).runFrom (d.withState (some .check)) (1 + u) = d'.withState (some .check) := by rw [runFrom_add, runFrom_one, hstart, runFrom_runCfg hhalt le_rfl, ← hhalt.runFrom_eq hu, h.1] rfl refine ⟨u, hu, by rw [Nat.add_comm]; exact hrun, ?_⟩ - have h1 : (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) (d.withState (some .check)) + have h1 : (MultiTapeNTM.RunPath.ofDeterministic (whileCond c tm) (d.withState (some .check)) 1).space ≤ k := by refine space_le_of_workTapePos_const _ 1 fun m hm => ?_ rcases (by omega : m = 0 ∨ m = 1) with rfl | rfl · rfl · rw [runFrom_one, step_check] rfl - have h2 : (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) - ((loopWhile c tm).runFrom (d.withState (some .check)) 1) u).space ≤ s := by + have h2 : (MultiTapeNTM.RunPath.ofDeterministic (whileCond c tm) + ((whileCond c tm).runFrom (d.withState (some .check)) 1) u).space ≤ s := by rw [runFrom_one, hstart, space_eq_of_workTapePos (tm' := tm) _ (d.withState (some tm.q₀)) u fun m hm => by rw [runFrom_runCfg hhalt hm]; rfl] exact (space_mono tm _ hu).trans h.2 - have := (space_add_le (tm := loopWhile c tm) (d.withState (some .check)) 1 u).trans + have := (space_add_le (tm := whileCond c tm) (d.withState (some .check)) 1 u).trans (Nat.add_le_add h1 h2) omega -end LoopWhile +end RunsBetweenWhileCond -open LoopWhile in +open RunsBetweenWhileCond in /-- **Loops.** If `c` holds at the configurations `cfg i` for `i < n`, from each of which `tm` -runs to `cfg (i + 1)`, and fails at `cfg n`, then `loopWhile c tm` runs from `cfg 0` to `cfg n`. +runs to `cfg (i + 1)`, and fails at `cfg n`, then `whileCond c tm` runs from `cfg 0` to `cfg n`. The times of the rounds add up, with one step per round to read the condition. -/ -theorem runsBetween_loopWhile {c : (Fin k → Option Symbol) → Bool} +theorem runsBetween_whileCond {c : Option Symbol → (Fin k → Option Symbol) → Bool} {tm : MultiTapeTM k Symbol State} (cfg : ℕ → Cfg k Symbol Unit input) (n : ℕ) (t s : ℕ → ℕ) - (hround : ∀ i < n, c (cfg i).workTapeSymbols = true ∧ + (hround : ∀ i < n, c (cfg i).inputSymbol (cfg i).workTapeSymbols = true ∧ RunsBetween tm (cfg i) (cfg (i + 1)) (t i) (s i)) - (hstop : c (cfg n).workTapeSymbols = false) : - RunsBetween (loopWhile c tm) (cfg 0) (cfg n) (∑ i ∈ Finset.range n, (t i + 1) + 1) + (hstop : c (cfg n).inputSymbol (cfg n).workTapeSymbols = false) : + RunsBetween (whileCond c tm) (cfg 0) (cfg n) (∑ i ∈ Finset.range n, (t i + 1) + 1) (∑ i ∈ Finset.range n, (s i + k) + 2 * k) := by - set start := (cfg 0).withState (some (loopWhile c tm).q₀) with hstart + set start := (cfg 0).withState (some (whileCond c tm).q₀) with hstart have hrec : ∀ m ≤ n, ∃ τ ≤ ∑ i ∈ Finset.range m, (t i + 1), - (loopWhile c tm).runFrom start τ = (cfg m).withState (some .check) ∧ - (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) start τ).space ≤ + (whileCond c tm).runFrom start τ = (cfg m).withState (some .check) ∧ + (MultiTapeNTM.RunPath.ofDeterministic (whileCond c tm) start τ).space ≤ ∑ i ∈ Finset.range m, (s i + k) + k := by intro m hm induction m with | zero => exact ⟨0, le_rfl, rfl, by - simpa using space_le_of_workTapePos_const (tm := loopWhile c tm) start 0 + simpa using space_le_of_workTapePos_const (tm := whileCond c tm) start 0 fun m hm => by rw [Nat.le_zero.mp hm]; rfl⟩ | succ m ih => obtain ⟨τ, hτ, hrun, hsp⟩ := ih (by lia) @@ -430,20 +420,20 @@ theorem runsBetween_loopWhile {c : (Fin k → Option Symbol) → Bool} have := Nat.add_le_add hsp hsp' omega obtain ⟨τ, hτ, hrun, hsp⟩ := hrec n le_rfl - have hfinal : (loopWhile c tm).runFrom start (τ + 1) = (cfg n).withState none := by + have hfinal : (whileCond c tm).runFrom start (τ + 1) = (cfg n).withState none := by rw [runFrom_succ, hrun, step_check, hstop] rfl - have hhalt : ((loopWhile c tm).runFrom start (τ + 1)).state = none := by rw [hfinal]; rfl + have hhalt : ((whileCond c tm).runFrom start (τ + 1)).state = none := by rw [hfinal]; rfl refine ⟨by rw [runFrom_eq_of_halt _ _ (by lia) hhalt, hfinal], ?_⟩ rw [space_eq_of_halt _ (by lia) hhalt] - have h1 : (MultiTapeNTM.RunPath.ofDeterministic (loopWhile c tm) - ((loopWhile c tm).runFrom start τ) 1).space ≤ k := by + have h1 : (MultiTapeNTM.RunPath.ofDeterministic (whileCond c tm) + ((whileCond c tm).runFrom start τ) 1).space ≤ k := by refine space_le_of_workTapePos_const _ 1 fun m hm => ?_ rcases (by omega : m = 0 ∨ m = 1) with rfl | rfl · rfl · rw [hrun, runFrom_one, step_check] rfl - have := (space_add_le (tm := loopWhile c tm) start τ 1).trans (Nat.add_le_add hsp h1) + have := (space_add_le (tm := whileCond c tm) start τ 1).trans (Nat.add_le_add hsp h1) omega end MultiTapeTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WhileCond.lean b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WhileCond.lean index 8831bca26f..7a9f3c68f8 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WhileCond.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WhileCond.lean @@ -7,6 +7,8 @@ Authors: Christian Reitwiessner module -- upstream: vendored crei:crei/tidy-universal @9cce4cc7 (unsubmitted) -- vendored: `spaceUsed` is the space of a run path since cslib #1133 and #1122 +-- vendored: the body of `whileCond` is exposed for the run law on arbitrary configurations in +-- `Plumbing/RunsBetween` public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileInput @@ -35,7 +37,7 @@ variable {k : ℕ} {Symbol State : Type*} {input : List Symbol} /-- From `check`, the machine halts unless `c` holds of the symbols under the input head and the work-tape heads, and otherwise starts `tm`, moving no head. Each round of `tm` returns to `check`. -/ -public noncomputable def whileCond (c : Option Symbol → (Fin k → Option Symbol) → Bool) +@[expose] public noncomputable def whileCond (c : Option Symbol → (Fin k → Option Symbol) → Bool) (tm : MultiTapeTM k Symbol State) : MultiTapeTM k Symbol (RepeatUntilBlankState State) := ofTr .check fun q inp work => match q with diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean index 4b071e90d2..16fd9e2d3f 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean @@ -26,8 +26,8 @@ sit anywhere on their tapes. They implement a stack kept on a tape that grows to second tape. * `Turing.MultiTapeTM.eraseFrame`: erase a framed word (`Turing.MultiTapeTM.frame`) at the front of a tape. -* `Turing.MultiTapeTM.popFrame`: move a framed word at the front of a tape to the end of a word on - a second tape, prefixed by `[true, true]`, or write `[false]` if the first tape is blank. +* `Turing.MultiTapeTM.popFrame`: move a framed word at the front of a tape to a blank second tape, + prefixed by `[true, true]`, or write `[false]` there if the first tape is blank. ## Main results @@ -36,7 +36,7 @@ sit anywhere on their tapes. They implement a stack kept on a tape that grows to `Turing.MultiTapeTM.runsBetween_popFrame_frame`: their runs, in time linear in the words moved. -/ -@[expose] public section +public section namespace Turing @@ -50,8 +50,6 @@ lemma tapeOfList_eq_ite (w : List Symbol) (z : ℤ) : | ofNat n => simp | negSucc n => simp -lemma tapeOfList_natCast (w : List Symbol) (n : ℕ) : tapeOfList w (n : ℤ) = w[n]? := rfl - lemma tapeOfList_cons_of_ne (x : Symbol) (l : List Symbol) {z : ℤ} (hz : z ≠ 0) : tapeOfList (x :: l) z = tapeOfList l (z - 1) := by rcases z with (_ | n) | n @@ -129,7 +127,7 @@ lemma tapeOfList_sub_one_sub (w : List Symbol) (o : ℤ) : tapeOfList w (o - 1 - namespace MultiTapeTM /-- A run of one more step, split after its first step. -/ -lemma runFrom_succ_eq_step {k : ℕ} {State : Type*} (tm : MultiTapeTM k Symbol State) +private lemma runFrom_succ_eq_step {k : ℕ} {State : Type*} (tm : MultiTapeTM k Symbol State) (c : Cfg k Symbol State input) (n : ℕ) : tm.runFrom c (n + 1) = tm.runFrom (tm.step c) n := by rw [Nat.add_comm, runFrom_add, runFrom_one] @@ -163,17 +161,16 @@ theorem runFrom_seekEnd (w suf pre : List Symbol) (hw : w = pre ++ suf) (o : ℤ (fun _ => by simp; omega)] · exact ih (pre ++ [x]) (by simp [hw]) · have : tapeOfList w (o + pre.length - o) = some x := by - rw [add_sub_cancel_left, tapeOfList_natCast, hw] + rw [add_sub_cancel_left, tapeOfList_ofNat, hw] simp simp only [seekEnd, tr_ofTr, this] theorem runsBetween_seekEnd (w : List Symbol) (o : ℤ) (out : List Symbol) : RunsBetween (seekEnd Symbol) (tapesCfg input (fun _ => w) (fun _ => o) (fun _ => o) out) (tapesCfg input (fun _ => w) (fun _ => o) (fun _ => o + w.length) out) - (w.length + 1) (1 * (w.length + 1 + 1)) := by - refine RunsBetween.of_runFrom ?_ + (w.length + 1) (w.length + 1 + 1) := by have := runFrom_seekEnd (input := input) w w [] (by simp) o out - simpa using this + exact (RunsBetween.of_runFrom (by simpa using this)).mono le_rfl (by omega) /-! ### Moving a word to the front of another -/ @@ -223,7 +220,7 @@ theorem runFrom_copyBack_loop (w v u : List Symbol) (oA oB oB' : ℤ) (hu : u = · exact ih (x :: v) (oB - 1) (by simp [hu]) (by simp [hB]; omega) · have hr : tapeOfList (l ++ [x]) (oA + ((l ++ [x]).length : ℤ) - 1 - oA) = some x := by rw [show oA + ((l ++ [x]).length : ℤ) - 1 - oA = (l.length : ℕ) by simp; omega, - tapeOfList_natCast] + tapeOfList_ofNat] simp simp only [copyBack, tr_ofTr, Matrix.cons_val_zero, hr] · intro i @@ -308,8 +305,9 @@ theorem runsBetween_eraseFrame (w rest : List Bool) (o : ℤ) {input : List Bool RunsBetween eraseFrame (tapesCfg input (fun _ => frame w ++ rest) (fun _ => o) (fun _ => o) out) (tapesCfg input (fun _ => rest) (fun _ => o + (frame w).length) (fun _ => o + (frame w).length) out) - (2 * w.length + 1) (1 * (2 * w.length + 1 + 1)) := - RunsBetween.of_runFrom (runFrom_eraseFrame w rest _ o _ rfl (by simp [length_frame]) out) + (2 * w.length + 1) (2 * w.length + 1 + 1) := + (RunsBetween.of_runFrom (runFrom_eraseFrame (input := input) w rest _ o _ rfl + (by simp [length_frame]) out)).mono le_rfl (by omega) /-! ### Popping a framed word -/ @@ -329,7 +327,8 @@ instance : Fintype PopFrameState := ⟨{.start, .pre, .loop, .bit}, fun q => by /-- If tape `0` is blank under its head, writes `false` at the head of tape `1`. Otherwise writes `[true, true]` and then moves the framed word at the head of tape `0` there, erasing it. Both -heads move right as they go. -/ +heads move right as they go. The specifications below start with a blank tape `1`; the loop +`Turing.MultiTapeTM.runFrom_popFrame_loop` appends to any word ending before the head. -/ noncomputable def popFrame : MultiTapeTM 2 Bool PopFrameState := ofTr .start fun q _ work => match q, work 0 with From ba6a94aa178c59eab2a9c41fcae6720c589c7bb2 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Fri, 30 Oct 2026 22:10:15 +0000 Subject: [PATCH 38/40] doc(roadmap): define N, D, M in the #800 entry --- ROADMAP.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ROADMAP.md b/ROADMAP.md index caac3349c3..4e58b5028d 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -563,7 +563,8 @@ reusing graph and matroid foundations and the shared data-structure interfaces. `Oκ((n+1) log²(n+2))` charged cost. This frontend is composed into the complete native preprocessing and the conditional ordinary host described below. - **Efficient universal simulation** ([#800]): the clocked universal function runs in time - `O(N + poly(D, M) · (t + 1) log(t + 2))` by a divide-and-conquer windowed simulation + `O(N + poly(D, M) · (t + 1) log(t + 2))`, for encoded input length `N`, description length `D` + and largest input symbol `M`, by a divide-and-conquer windowed simulation (`computableInO_universal_nlogn`). Remaining: a source-space-sensitive storage bound (the space is currently bounded only by the time), and an unclocked form that runs until the simulated machine halts. From 8009449142caa9b34fad2f23bd8225c91d7133b0 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sat, 31 Oct 2026 10:06:11 -0400 Subject: [PATCH 39/40] style(universal): replace non-terminal simp with simp only in Windowed (#800) Addresses the source-hygiene finding on Windowed.lean:730 from reviewer-codex-edemaine's review of ba6a94aa1. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Machines/Turing/MultiTape/Universal/Windowed.lean | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean index 9b0c1a4978..be750796b3 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean @@ -727,7 +727,8 @@ private lemma cellAt_initWin_input (x : List ℕ) (z : ℤ) : simp [inCell, show z ≠ 0 by omega, show ¬0 < z by omega] · simp [cellAt, inCell] · rw [cellAt_of_nonneg _ (by omega)] - simp [inCell, show z ≠ 0 by omega, hz, List.getD_eq_getElem?_getD] + simp only [Nat.cast_one, Int.pred_toNat, List.getD_eq_getElem?_getD, List.getElem?_map, + inCell, show z ≠ 0 by omega, ↓reduceIte, hz] cases x[z.toNat - 1]? <;> simp /-- **The windowed simulation computes the universal function**: started from the radius-`t` From a8177992448614e2d8788e0f9865caea6d2e9b8e Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sat, 31 Oct 2026 10:15:28 -0400 Subject: [PATCH 40/40] fix(universal): adapt WindowedParts and TimePolylog to main (#800) Main retired the tidy list combinators (#2008), stated stepWith_inO in the plain calculus (#1777) and replaced the tidy decoder certificate with exists_computableInDegree_decodeDesc (#1863). Use the plain mapWith, stepWith_inO.tidy and the plain decoder with .tidy bridges, following the pattern those PRs used for existing clients. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Complexity/Classes/Hierarchy/TimePolylog.lean | 4 ++-- .../Turing/MultiTape/Universal/WindowedParts.lean | 9 ++++++--- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean index 311cd9e51c..1d66eb7406 100644 --- a/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean @@ -150,7 +150,7 @@ theorem exists_computableInO_timeDiagonal_polylog : ∃ k, ∀ {J : ℕ → ℕ} ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1))) fun x => x.length + (Nat.log 2 (x.length + 1) + 1) ^ k * ((J x.length + 1) * (Nat.log 2 (J x.length + 1) + 1)) := by - obtain ⟨dd, ed, hdec⟩ := exists_computableTidilyInDegree_decodeDesc + obtain ⟨dd, ed, hdec⟩ := exists_computableInDegree_decodeDesc obtain ⟨ce, hce⟩ := hdec.2 obtain ⟨cA, hcA⟩ := PolynomiallyBounded.exists_le_mul_two_pow (p := fun u => (u + 1) ^ dd) (by fun_prop) @@ -158,7 +158,7 @@ theorem exists_computableInO_timeDiagonal_polylog : ∃ k, ∀ {J : ℕ → ℕ} refine ⟨ed * 6, fun {J} hJ => ?_⟩ have hu : ComputableTidilyInO unframe encBits encBits (fun x => x.length) fun x => x.length := ComputableTidilyInO.of_linear (.of_unframe fun _ => rfl) - have hdesc := hdec.inO.comp hu + have hdesc := hdec.inO.tidy.comp hu have hsym := Universal.computableTidilyInDegree_map_eBit.inO_one have hclock := hJ.computableInO.tidy have hU := computableInO_universal_nlogn.tidy.comp (hdesc.prod (hsym.prod hclock)) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean index 4fc5b3fd9e..ee62dea962 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean @@ -10,6 +10,7 @@ module public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedBound import Complexity.Computability.Machines.Turing.MultiTape.Combinators.Encoding import Complexity.Computability.Machines.Turing.MultiTape.Combinators.TakeDropUnary +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Lists import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Quantitative import Complexity.Computability.Machines.Turing.MultiTape.Internal.BinaryPrimitives import Complexity.Computability.Machines.Turing.MultiTape.Internal.BinarySizeFacts @@ -164,8 +165,9 @@ theorem extract_inO : (fun p => (p.2.2.length + 1) * ((encPair encUnary eWin p).length + 1)) (fun p => (p.2.2.length + 1) * ((encPair encUnary eWin p).length + 1)) := by have hw := snd encUnary eWin - have hmap := mapWith (encP := encUnary) (enc := eTape) (encB := eTape) cut_inO - (fst encUnary eWin) hw.snd' + -- bridge for #862: tidy client of the plain `ComputableInO.mapWith` + have hmap := (ComputableInO.mapWith (encP := encUnary) (enc := eTape) (encB := eTape) + cut_inO.computableInO (fst encUnary eWin).computableInO hw.snd'.computableInO).tidy refine (((hw.fst'.prod hmap).of_enc_eq (encOut := eWin) (g := fun p : ℕ × Win => extract p.1 p.2) fun _ => rfl).mono 8 (fun p => ?_) fun p => ?_).computableInO @@ -558,7 +560,8 @@ private lemma wArgs_inO : ComputableTidilyInO have hcfg := (hw.fst'.prod (hpos.prod htail)).of_enc_eq (encOut := eCfg) (g := fun x : Desc × Win => (⟨x.2.1, inPos (wHead x).read, x.2.2.tail⟩ : SCfg)) fun _ => rfl have hctx := ((hd.prod hcfg).prod hsym).of_enc_eq (encOut := eWCtx) (g := wCtx) fun _ => rfl - have hstep := stepWith_inO.comp hctx + -- bridge for #862: tidy client of the plain `stepWith_inO` + have hstep := stepWith_inO.tidy.comp hctx refine (((hhead.prod hpos).prod hstep).of_enc_eq (g := fun x : Desc × Win => ((wHead x, inPos (wHead x).read), stepWith (wCtx x).1.1 (wCtx x).1.2 (wCtx x).2)) fun _ => rfl).mono 128 (fun x => ?_) fun x => ?_