diff --git a/Complexity.lean b/Complexity.lean index 551ac4124c..1048ca6fdd 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1178,6 +1178,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 @@ -1664,6 +1665,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 @@ -1671,8 +1673,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 @@ -1680,6 +1684,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.FunProp public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Lists @@ -1898,6 +1903,8 @@ 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.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 @@ -1965,6 +1972,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 @@ -1974,6 +1982,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.AcceptCount @@ -2037,6 +2046,11 @@ 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.MultiTape.Universal.WindowedBound +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedComplexity +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedInit +public import Complexity.Computability.Machines.Turing.MultiTape.Universal.WindowedParts 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/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/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 diff --git a/Complexity/Computability/Complexity/Classes/Hierarchy/Time.lean b/Complexity/Computability/Complexity/Classes/Hierarchy/Time.lean index 48b8e810dc..7b319e5896 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..1d66eb7406 --- /dev/null +++ b/Complexity/Computability/Complexity/Classes/Hierarchy/TimePolylog.lean @@ -0,0 +1,318 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +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 +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 `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; 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 + +* `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_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) + 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.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)) + 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/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean new file mode 100644 index 0000000000..314086cf95 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/DivConq.lean @@ -0,0 +1,588 @@ +/- +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 +import Complexity.Computability.Machines.Turing.MultiTape.Combinators.StackLoop +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.BigO.Cases + +/-! +# 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 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. + +## 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.ComputableInO.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₂) + +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 +solution. -/ +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. -/ +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. -/ +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. -/ +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. -/ +private 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 +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 +`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 → + 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. -/ +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. -/ +private abbrev encFrame (encA : α ↪ List Bool) (encG : γ ↪ List Bool) : Frame α γ ↪ List Bool := + encSum encA encG + +/-- `Option.toList`, in linear time. -/ +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) + (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; 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 <;> + 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 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. -/ +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] + 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 + +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] + +variable (D : DivConq α β γ) {Tt St Tb Sb Tl Sl : α → ℕ} {Tm Sm : α × β → ℕ} + {Tj Sj : γ × β → ℕ} + +/-- The swap of the components of a pair, in linear time. -/ +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. -/ +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) + (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 + +/-- A round, within the costs of the parts of the recursion it runs. -/ +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) + (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. -/ +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) := + ((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 +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 : α → β → β → ℕ} + {Ti Si : δ → ℕ} {Tt St Tb Sb Tl Sl : α → ℕ} {Tm Sm : α × β → ℕ} {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 → + 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)) : + 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) := 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 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..8cc7ef5625 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/StackLoop.lean @@ -0,0 +1,350 @@ +/- +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 +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 + +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. + +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. +* `Turing.MultiTapeTM.StackLoop.step`: one round on a value and a stack. + +## Main results + +* `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. +-/ + +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 + +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 +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 ComputableInO.stackLoop {δ α γ : Type} {encIn : δ ↪ List Bool} + {encA : α ↪ List Bool} {encG : γ ↪ List Bool} (L : StackLoop α γ) + {init : δ → α} {Ti Si : δ → ℕ} {Th Sh : α → ℕ} {Tr Sr : Option γ × α → ℕ} (n : δ → ℕ) + (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 = []) : + 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 + + (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)) := + (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/Combinators/TakeDropUnary.lean b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean new file mode 100644 index 0000000000..d20cd047b8 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Combinators/TakeDropUnary.lean @@ -0,0 +1,62 @@ +/- +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 +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 + +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. + +## Main results + +* `Turing.MultiTapeTM.ComputableInDegree.takeUnary`: the first `n` elements. +* `Turing.MultiTapeTM.ComputableInDegree.dropUnary`: all but the first `n` elements. +-/ + +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. -/ +public theorem takeUnary (enc : α ↪ List Bool) : + ComputableInDegree (fun p : List α × ℕ => p.1.take p.2) + (encPair (encList enc) encUnary) (encList enc) 1 1 := + cut true enc + +/-- Dropping the first `n` elements, with `n` in unary, in linear time. -/ +public theorem dropUnary (enc : α ↪ List Bool) : + ComputableInDegree (fun p : List α × ℕ => p.1.drop p.2) + (encPair (encList enc) encUnary) (encList enc) 1 1 := + cut false enc + +end Turing.MultiTapeTM.ComputableInDegree 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..c4266ff554 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Complexity/BigO/Cases.lean @@ -0,0 +1,342 @@ +/- +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.ComputableInO.sumElimSnd`: case analysis on a sum component. +* `Turing.MultiTapeTM.ComputableInO.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. -/ +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 + (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. -/ +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))) + (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 + +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 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..a0c8351507 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Internal/KernelStackLoop.lean @@ -0,0 +1,786 @@ +/- +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 +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 + +/-! +# 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`), 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. +-/ + +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. -/ +@[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. -/ +@[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. -/ +@[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. -/ +@[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 + +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. -/ +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 + | 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 +tape `nm o`, the input tape `nm v` and the flag tape `nm 0`. -/ +@[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 + 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. -/ +@[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 + 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. -/ +@[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. -/ +@[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. -/ +@[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]⟩ + +/-! ### 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 : 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 ((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 + · 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. -/ +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) + {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. -/ +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') : + RunsBetween (tm.extendTapes e) c c' t (s + (kk + 6 - m)) := by + subst hd₀ hc + exact h.extendTapes e + +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 + +/-- The machine clearing the named tape `j`. -/ +noncomputable def clearM (j : Fin 6) := + (clearWork Bool).extendTapes (tapeEmb (nm (kk := kk) j)) + +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) + (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 + +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) + (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 + +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) + (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 + +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 + 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 + +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) := + 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) + +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 + 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. -/ +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) : + 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. -/ +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) : + 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. -/ +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) : + 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)) + +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) + (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) + (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 + | 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 -/ + +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 + | 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`. -/ +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) + (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`. -/ +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) + (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)) + +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) + +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) + (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)) + +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)) := + 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)) + +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)) := + 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)) + +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) + (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)) + +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) + (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) + +/-! ### 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. -/ +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 []) + (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} + +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`. -/ +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 + (-((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`. -/ +@[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 ((whileCond (fun _ => 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`. -/ +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`. -/ +@[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`. -/ +@[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 + + (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, + (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 + 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_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 + 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 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..39f7e4ef55 --- /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 +`Turing.MultiTapeTM.ComputableInDegree.takeUnary` and `.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/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean new file mode 100644 index 0000000000..b1ebfe844d --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/RunsBetween.lean @@ -0,0 +1,441 @@ +/- +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.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 +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.whileCond`. + +## Main definitions + +* `Turing.Cfg.shift`, `Turing.tapesCfg`: shifted configurations. +* `Turing.MultiTapeTM.RunsBetween`: a run between two configurations within bounds. + +## Main results + +* `Turing.MultiTapeTM.runFrom_shift`, `Turing.MultiTapeTM.space_shift`: translation invariance. +* `Turing.MultiTapeTM.RunsBetween.seq`, `.extendTapes`, `.of_transformsTapes`: composition. +* `Turing.MultiTapeTM.runsBetween_whileCond`: loops, with the costs of the rounds adding up. +-/ + +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. -/ +@[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⟩ + +@[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`. -/ +@[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⟩ + +@[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. -/ +@[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 + +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 -/ + +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)) + +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 [whileCond, tr_ofTr] + rfl + +private lemma runFrom_runCfg {cfg : Cfg k Symbol State input} {u n : ℕ} (hhalt : tm.HaltsAt cfg u) + (hn : n ≤ u) : + (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))] + +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 + have hi : (d.withState (some (RepeatUntilBlankState.check : RepeatUntilBlankState State)) + ).inputSymbol = d.inputSymbol := rfl + rw [hw, hi] + refine Cfg.ext ?_ ?_ ?_ ?_ ?_ <;> + simp [whileCond, Action.apply, Cfg.withState] + +/-- One round: from `check` with the condition holding, the loop runs `tm` and is back in +`check`. -/ +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, (whileCond c tm).runFrom (d.withState (some .check)) (u + 1) = + 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 : (whileCond c tm).step (d.withState (some .check)) = + runCfg (d.withState (some tm.q₀)) := by + rw [step_check, hc] + rfl + 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 (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 (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 := whileCond c tm) (d.withState (some .check)) 1 u).trans + (Nat.add_le_add h1 h2) + omega + +end RunsBetweenWhileCond + +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 `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_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).inputSymbol (cfg i).workTapeSymbols = true ∧ + RunsBetween tm (cfg i) (cfg (i + 1)) (t i) (s i)) + (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 (whileCond c tm).q₀) with hstart + have hrec : ∀ m ≤ n, ∃ τ ≤ ∑ i ∈ Finset.range m, (t i + 1), + (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 := 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) + 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 : (whileCond c tm).runFrom start (τ + 1) = (cfg n).withState none := by + rw [runFrom_succ, hrun, step_check, hstop] + 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 (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 := whileCond 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/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 new file mode 100644 index 0000000000..16fd9e2d3f --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Plumbing/WordMoves.lean @@ -0,0 +1,459 @@ +/- +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 (`Turing.MultiTapeTM.frame`) at the front + of a tape. +* `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 + +* `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. +-/ + +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_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 + · change 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. -/ +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] + +/-! ### 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_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) (w.length + 1 + 1) := by + have := runFrom_seekEnd (input := input) w w [] (by simp) o out + exact (RunsBetween.of_runFrom (by simpa using this)).mono le_rfl (by omega) + +/-! ### 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_ofNat] + 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) (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 -/ + +/-- 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. 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 + | .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 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..be750796b3 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/Windowed.lean @@ -0,0 +1,987 @@ +/- +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 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. +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. + +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 + 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. +* `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 + +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, [], []⟩) + +/-! ### 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 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` +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) := 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] + +/-! ### 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/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean new file mode 100644 index 0000000000..2d64cd2cb2 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedBound.lean @@ -0,0 +1,561 @@ +/- +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 +import Mathlib.Tactic.Linarith + +/-! +# 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 := 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 := + ⟨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) := 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) := 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 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 := 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) := 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 := + (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 := + (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) := + (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 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..1877be31f3 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedComplexity.lean @@ -0,0 +1,556 @@ +/- +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 +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 + +/-! +# The universal function in time `O(t log t)` + +The universal function (`Turing.MultiTapeTM.Universal.universal`), on a description `d`, an input +`x` and a number `t` of steps in binary, is computed by the windowed simulation +(`Turing.MultiTapeTM.Universal.Windowed.sim`, see +`Turing.MultiTapeTM.Universal.Windowed.universal_eq_sim`) run as a divide-and-conquer recursion +(`Turing.MultiTapeTM.ComputableInO.divConq`). A problem is the description, a number of steps in +unary and the windows. A problem of at most one step is solved by a windowed step; a larger one by +its first half on the cut windows, pasted back, and then its second half likewise. + +Let `D` be the length of the encoded description and `M` the largest input symbol. The windows of a +problem of `n` steps, and those it computes, hold `O(n)` cells, each at most `D + M + 1`, and there +are at most `D + 1` of them (`Turing.MultiTapeTM.Universal.Windowed.WInv`). Cutting and pasting are +linear in the encoded windows for each window, so a problem of `n ≥ 2` steps costs +`O((D + M + 2) ^ 3 * (n + 1))` besides its halves, and a problem of at most one step +`O((D + M + 2) ^ 6)`. The recursion on `t` steps then costs +`O((D + M + 2) ^ 6 * (t + 1) * (log₂ (t + 1) + 1))`. The first problem is computed in time linear in +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 + space `O(N + (D + M + 2) ^ 6 * (t + 1) * (log₂ (t + 1) + 1))`, for the length `N` of the encoded + input. + +## References + +* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraBarak09] +-/ + +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 + 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 + ((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 + +/-- 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') + 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) + +/-- 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) + 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) + +/-- 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) + 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) + +/-- 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) + 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] + +/-- 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 + 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 + +/-- 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)) + (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 + change (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 + change (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 + change (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 + change (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 + +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 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..8b60a1bdf3 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedInit.lean @@ -0,0 +1,320 @@ +/- +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 +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 + +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. + +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. +-/ + +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. -/ +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)) := 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 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..ee62dea962 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Universal/WindowedParts.lean @@ -0,0 +1,608 @@ +/- +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 +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 +import Complexity.Computability.Machines.Turing.MultiTape.Internal.EqualityPrimitives +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring + +/-! +# 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 + +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 := + (ComputableInDegree.dropUnary enc).inO_one.tidy + +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)) := by + have hw := snd encUnary eWin + -- 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 + 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)) := 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 + +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) := + (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) := + (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 + -- 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 => ?_ + 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 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 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/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean b/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean new file mode 100644 index 0000000000..dfcb16c4ea --- /dev/null +++ b/ComplexityTests/Machines/Turing/MultiTape/TakeDropUnary.lean @@ -0,0 +1,35 @@ +/- +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 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 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 diff --git a/ROADMAP.md b/ROADMAP.md index 32f0f759ba..5147b14bab 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -180,9 +180,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. @@ -564,10 +567,12 @@ 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))`, 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. - **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. diff --git a/UPSTREAM.md b/UPSTREAM.md index 75d6bd509f..fd02fa45ee 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.