diff --git a/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean index 3cc0737f..53f66b37 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean @@ -48,7 +48,7 @@ theorem add₀_eval_list {tapes : Fin 6 → List (List OneTwo)} : dya_inv ((tapes 1).headD [])) :: (tapes 2)))) := by simp [add₀] by_cases h : dya_inv ((tapes 0).head?.getD []) = 0 - · simp [h]; grind + · simp [h] · grind /-- diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean index 67c89864..5d1f0464 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -238,6 +238,10 @@ def TransformsTapes (tapes tapes' : Fin k → BiTape α) : Prop := ∃ t, tm.TransformsTapesInTime tapes tapes' t +/-- The Turing machine `tm` eventually halts starting from any initial tape configuration. -/ +def haltsOn (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : Prop := + ∃ tapes', tm.TransformsTapes tapes tapes' + @[scoped grind =] lemma relatesInSteps_iff_step_iter_eq_some (tm : MultiTapeTM k α) @@ -294,6 +298,13 @@ public noncomputable def eval (tm : MultiTapeTM k α) (tapes : Fin k → BiTape Part (Fin k → BiTape α) := ⟨∃ tapes', tm.TransformsTapes tapes tapes', fun h => h.choose⟩ +/-- +Execute the Turing machine `tm` on initial tapes `tapes` given a proof that it always halts +and thus this yields a total function. -/ +public noncomputable def eval_tot (tm : MultiTapeTM k α) {h : ∀ tapes, tm.haltsOn tapes} + (tapes : Fin k → BiTape α) : Fin k → BiTape α := + (tm.eval tapes).get (h tapes) + -- TODO use MultiTapeTM.configurations? -- TODO this is a simple consequence of relatesInSteps_iff_configurations_eq_some, maybe not needed. lemma configurations_of_transformsTapesInTime diff --git a/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean index 96a71504..aca3d10d 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean @@ -31,22 +31,21 @@ lemma copy₁_eval_list {tapes : Fin 2 → List (List α)} : A Turing machine that copies the first word on tape `i` to tape `j`. If Tape `i` is empty, pushes the empty word to tape `j`. -/ -public def copy {k : ℕ} (i j : ℕ) - (h_neq : i ≠ j := by decide) - (h_i_lt : i < k := by decide) - (h_j_lt : j < k := by decide) : - MultiTapeTM k (WithSep α) := - copy₁.with_tapes [⟨i, h_i_lt⟩, ⟨j, h_j_lt⟩].get (by intro x y; grind) +public def copy {k : ℕ} + (i j : Fin (k + 2)) + (h_inj : [i, j].get.Injective := by intro x y; grind) : + MultiTapeTM (k + 2) (WithSep α) := + copy₁.with_tapes [i, j].get (by intro x y; grind) @[simp, grind =] public lemma copy_eval_list - {k : ℕ} {i j : ℕ} {h_neq : i ≠ j} {h_i_lt : i < k} {h_j_lt : j < k} - {tapes : Fin k → List (List α)} : - (copy i j (h_neq := h_neq) (h_i_lt) (h_j_lt)).eval_list tapes = Part.some - (Function.update tapes ⟨j, h_j_lt⟩ - (((tapes ⟨i, h_i_lt⟩).headD []) :: (tapes ⟨j, h_j_lt⟩))) := by - have h_inj : [(⟨i, h_i_lt⟩ : Fin k), ⟨j, h_j_lt⟩].get.Injective := by intro x y; grind - simp_all [copy] + {k : ℕ} + (i j : Fin (k + 2)) + (h_inj : [i, j].get.Injective := by intro x y; grind) + {tapes : Fin (k + 2) → List (List α)} : + (copy i j h_inj).eval_list tapes = Part.some + (Function.update tapes j (((tapes i).headD []) :: (tapes j))) := by + simpa [copy] using apply_updates_function_update h_inj end Routines diff --git a/Cslib/Computability/Machines/MultiTapeTuring/DecRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/DecRoutine.lean new file mode 100644 index 00000000..9d8cae75 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/DecRoutine.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christian Reitwiessner +-/ + +module + +public import Cslib.Computability.Machines.MultiTapeTuring.Basic +public import Cslib.Computability.Machines.MultiTapeTuring.ListEncoding +public import Cslib.Computability.Machines.MultiTapeTuring.WithTapes +public import Cslib.Computability.Machines.MultiTapeTuring.CopyRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.SuccRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PushRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PopRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.SequentialCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.LoopCombinator + +namespace Turing + +namespace Routines + +def dec₀ : MultiTapeTM 6 (WithSep OneTwo) := + push 1 [] <;> push 2 [] <;> + loop 0 (h_i := by decide) (pop 2 <;> copy 1 2 <;> succ 1) <;> + pop 0 <;> + copy 2 0 <;> + pop 2 <;> + pop 1 + +@[simp] +lemma inner_eval_iter {r : ℕ} {tapes : Fin 3 → List (List OneTwo)} : + (Part.bind · (pop 2 <;> copy 1 2 <;> succ 1).eval_list)^[r] (.some tapes) = Part.some ( + if r = 0 then + tapes + else + Function.update (Function.update tapes + 2 ((dya ((dya_inv ((tapes 1).headD [])) + (r - 1))) :: (tapes 2).tail)) + 1 ((dya ((dya_inv ((tapes 1).headD [])) + r)) :: (tapes 1).tail)) := by + induction r with + | zero => simp + | succ r ih => + rw [Function.iterate_succ_apply'] + simp [ih] + grind + +@[simp] +lemma loop_eval_iter {tapes : Fin 6 → List (List OneTwo)} : + (loop 0 (h_i := by decide) (pop 2 <;> copy 1 2 <;> succ 1)).eval_list tapes = .some ( + if dya_inv ((tapes 0).head?.getD []) = 0 then + tapes + else + Function.update (Function.update tapes + 2 (dya (dya_inv ((tapes 1).head?.getD []) + + (dya_inv ((tapes 0).head?.getD []) - 1)) :: (tapes 2).tail)) + 1 (dya (dya_inv ((tapes 1).head?.getD []) + + dya_inv ((tapes 0).head?.getD [])) :: (tapes 1).tail)) := by + by_cases h : dya_inv ((tapes 0).head?.getD []) = 0 + · simp [h] + · simp [h]; grind + +@[simp, grind =] +lemma dec₀_eval_list {tapes : Fin 6 → List (List OneTwo)} : + dec₀.eval_list tapes = .some (Function.update tapes 0 + ((dya ((dya_inv ((tapes 0).headD [])) - 1)) :: (tapes 0).tail)) := by + by_cases h : dya_inv ((tapes 0).head?.getD []) = 0 + · simp [dec₀, h]; grind + · simp [dec₀, h]; grind + +/-- +A Turing machine that decrements the dyadic value at the head of tape `i`. +If the value is zero already, keeps it at zero. If the tape is empty, pushes zero. +-/ +public def dec {k : ℕ} (i : Fin (k + 6)) + (aux : Fin (k + 6) := ⟨k + 1, by omega⟩) + (h_inj : [i, aux, aux + 1, aux + 2, aux + 3, aux + 4].get.Injective := + by intro x y; grind) : + MultiTapeTM (k + 6) (WithSep OneTwo) := + dec₀.with_tapes [i, aux, aux + 1, aux + 2, aux + 3, aux + 4].get h_inj + +@[simp, grind =] +public theorem dec_eval_list {k : ℕ} (i aux : Fin (k + 6)) + (h_inj : [i, aux, aux + 1, aux + 2, aux + 3, aux + 4].get.Injective) + (tapes : Fin (k + 6) → List (List OneTwo)) : + (dec i aux h_inj).eval_list tapes = .some (Function.update tapes i + ((dya ((dya_inv ((tapes i).headD [])) - 1)) :: (tapes i).tail)) := by + simpa [dec] using apply_updates_function_update h_inj + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/DuplicateRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/DuplicateRoutine.lean new file mode 100644 index 00000000..c4ef352b --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/DuplicateRoutine.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christian Reitwiessner +-/ + +module + +public import Cslib.Computability.Machines.MultiTapeTuring.Basic +public import Cslib.Computability.Machines.MultiTapeTuring.ListEncoding +public import Cslib.Computability.Machines.MultiTapeTuring.WithTapes +public import Cslib.Computability.Machines.MultiTapeTuring.CopyRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PopRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.SequentialCombinator + +namespace Turing + +namespace Routines + +variable [Inhabited α] [Fintype α] + +def duplicate₀ : MultiTapeTM 2 (WithSep α) := copy 0 1 <;> copy 1 0 <;> pop 1 + +@[simp] +lemma duplicate₀_eval_list {tapes : Fin 2 → List (List α)} : + duplicate₀.eval_list tapes = .some (Function.update tapes 0 + (((tapes 0).headD []) :: (tapes 0))) := by + simp [duplicate₀] + grind + +/-- +A Turing machine that duplicates the head of tape `i` (or pushes the empty word +if the tape is empty. +-/ +public def duplicate {k : ℕ} (i : Fin k.succ) + (aux : Fin k.succ := ⟨k, by omega⟩) + (h_inj : [i, aux].get.Injective := by intro x y; grind) : + MultiTapeTM k.succ (WithSep α) := + duplicate₀.with_tapes [i, aux].get h_inj + +@[simp, grind =] +public theorem duplicate_eval_list {k : ℕ} {i : Fin k.succ} + (aux : Fin k.succ := ⟨k, by omega⟩) + (h_inj : [i, aux].get.Injective) + {tapes : Fin k.succ → List (List OneTwo)} : + (duplicate i aux h_inj).eval_list tapes = Part.some (Function.update tapes i + (((tapes i).headD []) :: (tapes i))) := by + simp [duplicate] + grind + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean index 7ad2b42c..271c06ed 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean @@ -47,10 +47,11 @@ public def eq {k : ℕ} (q s t : Fin k) MultiTapeTM k (WithSep OneTwo) := eq₀.with_tapes [q, s, t].get h_inj +-- TODO why does the linter complain about simp here? @[grind =] -public theorem eq_eval_list {k : ℕ} {q s t : Fin k} +public theorem eq_eval_list {k : ℕ} {q s t : Fin k.succ} (h_inj : [q, s, t].get.Injective) - {tapes : Fin k → List (List OneTwo)} : + {tapes : Fin k.succ → List (List OneTwo)} : (eq q s t).eval_list tapes = Part.some (Function.update tapes t ((if (tapes q).headD [] = (tapes s).headD [] then [.one] diff --git a/Cslib/Computability/Machines/MultiTapeTuring/GraphReachability.lean b/Cslib/Computability/Machines/MultiTapeTuring/GraphReachability.lean index 508491ca..1df55f2b 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/GraphReachability.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/GraphReachability.lean @@ -6,18 +6,20 @@ Authors: Christian Reitwiessner module -import Cslib.Foundations.Data.BiTape -import Cslib.Foundations.Data.RelatesInSteps - public import Cslib.Computability.Machines.MultiTapeTuring.Basic public import Cslib.Computability.Machines.MultiTapeTuring.ListEncoding -public import Cslib.Computability.Machines.MultiTapeTuring.HeadStats - --- TODO create a "common file" -import Cslib.Computability.Machines.SingleTapeTuring.Basic +public import Cslib.Computability.Machines.MultiTapeTuring.IteCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.SequentialCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.EqualRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PushRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PopRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.DuplicateRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.DecRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.WhileCombinator namespace Turing +namespace Routines -- This is an attempt at proving Savitch's theorem. We start by stating a generic -- space-efficient graph reachability algorithm. @@ -30,45 +32,480 @@ def reachable(a, b, t, r): if t = 0: return r(a, b) else: + result = False for c in vertices: - if reachable(a, c, t - 1, r) and reachable(c, b, t - 1, r): - return True - return False + result |= reachable(a, c, t - 1, r) and reachable(c, b, t - 1, r) + return result Until we have a generic mechanism for recursion, let's translate this into a program that uses "goto", and every variable is a stack: -def reachable(a, b, t, r): - terminate = 0 - result = 0 - section = [0] - while !terminate: - match section.pop() - | 0 => +def reachable(a, b, t, edge): + pc = [:fun_start] + while !pc.is_empty(): + match pc.pop() + | :fun_start => if t = 0: - result = r(a, b) - terminate = 1 - section.push(7) + result.push(edge(a, b)) else: - section.push(1) - | 1 => - c.push(0) - section.push(2) - | 2 => + c.push(0) + result.push(0) + pc.push(:loop_start) + | :loop_start => if c.top() = num_vertices: - section.push(6) + c.pop() else: a.push(a.top()) b.push(c.top()) - section.push(0) - t.push(t.top() - 1) - section.push(3) - | 3 => - section.push(4) + t = t - 1 + pc.push(:after_first_rec) + pc.push(:fun_start) + | :after_first_rec => + a.pop() + b.pop() + -- we keep the result of the first recursive call. + a.push(c.top()) + b.push(b.top()) + pc.push(:after_second_rec) + pc.push(:fun_start) + | :after_second_rec => + a.pop() + b.pop() + t = t + 1 + result.push(result.pop() ∨ result.pop() ∨ result.pop()) + c.top() += 1 + pc.push(:loop_start) + -- cleanup + t.pop() + a.pop() + b.pop() +-/ +abbrev tapeCount := 20 +@[simp, grind =] +lemma tape_count_eq : tapeCount = 20 := rfl --/ +abbrev a : Fin tapeCount := ⟨0, sorry⟩ +abbrev b : Fin tapeCount := ⟨1, sorry⟩ +abbrev t : Fin tapeCount := ⟨3, sorry⟩ +abbrev result : Fin tapeCount := ⟨2, sorry⟩ +abbrev initialT : Fin tapeCount := ⟨7, sorry⟩ +abbrev pc : Fin tapeCount := ⟨8, sorry⟩ +abbrev c : Fin tapeCount := ⟨9, sorry⟩ +abbrev mainAux : Fin tapeCount := ⟨10, sorry⟩ + +abbrev l_funStart := [OneTwo.one] +abbrev l_loopStart := [OneTwo.two] +abbrev l_afterFirstRec := [OneTwo.one, OneTwo.one] +abbrev l_afterSecondRec := [OneTwo.one, OneTwo.two] +abbrev l_loopContinue := [OneTwo.two, OneTwo.one] + +public def eqLit {k : ℕ} + (q : Fin (k + 3)) + (w : List OneTwo) + (s : Fin (k + 3)) + (aux : Fin (k + 3) := ⟨k + 2, by omega⟩) + (h_inj : [q, aux, s].get.Injective := by intro x y; grind) : + MultiTapeTM (k + 3) (WithSep OneTwo) := + push aux w <;> eq q aux s h_inj <;> pop aux + +@[simp] +public theorem eqLit_eval_list {k : ℕ} {q s aux : Fin (k + 3)} {w : List OneTwo} + {h_inj : [q, aux, s].get.Injective} + {tapes : Fin (k + 3) → List (List OneTwo)} : + (eqLit q w s aux h_inj).eval_list tapes = + .some (Function.update tapes s ( + (if (tapes q).headD [] = w then + [.one] + else + []) :: (tapes s))) := by + simp [eqLit, eq_eval_list h_inj] + have h_neq : aux ≠ s := Function.Injective.ne h_inj (a₁ := 1) (a₂ := 2) (by grind) + have h_neq : q ≠ aux := Function.Injective.ne h_inj (a₁ := 0) (a₂ := 1) (by grind) + grind + +@[simp] +public def iteLit {k : ℕ} + (i : Fin (k + 3)) + (w : List OneTwo) + (aux : Fin (k + 3) := ⟨k + 1, by omega⟩) + (tm₁ tm₂ : MultiTapeTM (k + 3) (WithSep OneTwo)) + (h_inj : [i, aux, aux + 1].get.Injective := by decide) : + MultiTapeTM (k + 3) (WithSep OneTwo) := + eqLit i w (aux + 1) aux (h_inj := by intro x y; grind) <;> + ite (aux + 1) (pop (aux + 1) <;> tm₁) (pop (aux + 1) <;> tm₂) + +@[simp] +public def combineAnd {k : ℕ} (i : Fin k) : + MultiTapeTM k (WithSep OneTwo) := + ite i + (pop i <;> + ite i + (pop i <;> push i [OneTwo.one]) + (pop i <;> push i [])) + (pop i <;> pop i <;> push i []) + +@[simp] +public def combineOr {k : ℕ} (i : Fin k) : + MultiTapeTM k (WithSep OneTwo) := + ite i + (pop i <;> pop i <;> push i [OneTwo.one]) + (pop i <;> + ite i + (pop i <;> push i [OneTwo.one]) + (pop i <;> push i [])) + + +-- | :fun_start => +-- if t = 0: +-- result.push(edge(a, b)) +-- else: +-- c.push(0) +-- result.push(0) +-- pc.push(:loop_start) + +@[simp] +def funStart (edge : MultiTapeTM tapeCount (WithSep OneTwo)) := + ite t (push c [] <;> push result [] <;> push pc l_loopStart) edge + +-- | :loop_start => +-- if c.top() = num_vertices: +-- c.pop() +-- else: +-- a.push(a.top()) +-- b.push(c.top()) +-- t = t - 1 +-- pc.push(:after_first_rec) +-- pc.push(:fun_start) + +@[simp] +def loopStart (maxConfig : List OneTwo) := + iteLit c maxConfig mainAux + (pop c) + (duplicate a <;> copy c b <;> + dec t mainAux (by decide) <;> push pc l_afterFirstRec <;> push pc l_funStart) + +-- | :after_first_rec => +-- a.pop() +-- b.pop() +-- -- we keep the result of the first recursive call. +-- a.push(c.top()) +-- b.push(b.top()) +-- pc.push(:after_second_rec) +-- pc.push(:fun_start) + +@[simp] +def afterFirstRec := + pop a <;> pop b <;> copy c a <;> duplicate b <;> + push pc l_afterSecondRec <;> push pc l_funStart + +-- | :after_second_rec => +-- a.pop() +-- b.pop() +-- t = t + 1 +-- result.push(result.pop() ∨ result.pop() ∨ result.pop()) +-- c.top() += 1 +-- pc.push(:loop_start) + +@[simp] +def afterSecondRec := + pop a <;> pop b <;> succ t <;> + combineAnd result <;> combineOr result <;> succ c <;> push pc l_loopStart + +def innerLoop (edge : MultiTapeTM tapeCount (WithSep OneTwo)) (maxConfig : List OneTwo) : + MultiTapeTM tapeCount (WithSep OneTwo) := + iteLit pc l_funStart mainAux (pop pc <;> funStart edge) + (iteLit pc l_loopStart mainAux (pop pc <;> loopStart maxConfig) + (iteLit pc l_afterFirstRec mainAux (pop pc <;> afterFirstRec) + (pop pc <;> afterSecondRec))) + +lemma relatesInStepsExp {α : Type} + (r : α → α → Prop) + (a b : α) + (t : ℕ) : + (Relation.RelatesInSteps r a b (Nat.pow 2 t.succ)) ↔ + ∃ c, Relation.RelatesInSteps r a c (Nat.pow 2 t) ∧ + Relation.RelatesInSteps r c b (Nat.pow 2 t) := by + sorry + +def finiteRel (r : (List OneTwo) → (List OneTwo) → Prop) (max : ℕ) : Prop := + ∀ a b, r a b → (dya_inv a < max ∧ dya_inv b < max) + +lemma finiteRel_apply₁ {r : (List OneTwo) → (List OneTwo) → Prop} {max : ℕ} + (h_finite : finiteRel r max) {a b : List OneTwo} (h_r : r a b) : + dya_inv a < max := (h_finite a b h_r).1 + +lemma finiteRel_apply₂ {r : (List OneTwo) → (List OneTwo) → Prop} {max : ℕ} + (h_finite : finiteRel r max) {a b : List OneTwo} (h_r : r a b) : + dya_inv b < max := (h_finite a b h_r).2 + +def edge_semantics + (r : (List OneTwo) → (List OneTwo) → Prop) + (h_r_dec : ∀ x y, Decidable (r x y)) + (edge : MultiTapeTM tapeCount (WithSep OneTwo)) : Prop := + ∀ tapes, + edge.eval_list tapes = .some (if r ((tapes a).headD []) ((tapes b).headD []) then + Function.update tapes result ([.one] :: (tapes result)) + else + Function.update tapes result ([] :: (tapes result))) + +lemma inner_loop_halts_on_lists + {r : (List OneTwo) → (List OneTwo) → Prop} + {h_r_dec : ∀ x y, Decidable (r x y)} + {edge : MultiTapeTM tapeCount (WithSep OneTwo)} + (h_edge_semantics : edge_semantics r h_r_dec edge) + {maxConfig : List OneTwo} : + ∀ tapes, (innerLoop edge maxConfig).HaltsOnLists tapes := by + intro tapes + apply MultiTapeTM.HaltsOnLists_of_eval_list + unfold edge_semantics at h_edge_semantics + simp [h_edge_semantics, innerLoop] + split_ifs + · simp + · simp + · simp + · simp + · simp + · simp + · simp + split_ifs + · simp + · simp + · simp + split_ifs + · simp + · simp + · simp + +def reachability + (edge : MultiTapeTM tapeCount (WithSep OneTwo)) + (maxConfig : List OneTwo) + (x y : List OneTwo) + (t_val : ℕ) := + push a x <;> push b y <;> push t (dya t_val) <;> push pc [] <;> push pc l_funStart <;> + doWhile pc (innerLoop edge maxConfig) <;> + pop t <;> pop a <;> pop b + +@[simp] +def iter_count_bound (max : ℕ) (t : ℕ) : ℕ := match t with + | .zero => 1 + | .succ t' => 2 + max * (3 + 2 * iter_count_bound max t') + +noncomputable def innerLoopFun + {r : (List OneTwo) → (List OneTwo) → Prop} + {h_r_dec : ∀ x y, Decidable (r x y)} + (max : ℕ) + {edge : MultiTapeTM tapeCount (WithSep OneTwo)} + (h_edge_semantics : edge_semantics r h_r_dec edge) := + (innerLoop edge (dya max)).eval_list_tot (inner_loop_halts_on_lists h_edge_semantics) + +lemma inner_loop_start + {max : ℕ} + {edge : MultiTapeTM tapeCount (WithSep OneTwo)} + {tapes : Fin tapeCount → List (List OneTwo)} + (h_pc_loopStart : (tapes pc).head?.getD [] = l_loopStart) : + (innerLoop edge (dya max)).eval_list tapes = Part.some (if (tapes c).head?.getD [] = dya max then + Function.update (Function.update tapes pc (tapes pc).tail) c (tapes c).tail + else + Function.update (Function.update (Function.update (Function.update tapes + a ((tapes a).head?.getD [] :: tapes a)) + b ((tapes c).head?.getD [] :: tapes b)) + t (dya (dya_inv ((tapes t).head?.getD []) - 1) :: (tapes t).tail)) + pc (l_funStart :: l_afterFirstRec :: (tapes pc).tail)) := by + simp [innerLoop, h_pc_loopStart] + split_ifs + · simp + · simp; grind + +-- TODO the result of eval_list makes heavy use of +-- Function.update tapes x (f(tapes) :: (tapes x).tail) +-- create an abstraction for that? Sometimes we need .tail.tail + +lemma inner_loop_after_first_rec + {max : ℕ} + {edge : MultiTapeTM tapeCount (WithSep OneTwo)} + {tapes : Fin tapeCount → List (List OneTwo)} + (h_pc_afterFirstRec : (tapes pc).head?.getD [] = l_afterFirstRec) : + (innerLoop edge (dya max)).eval_list tapes = Part.some ( + Function.update (Function.update (Function.update tapes + a ((tapes c).head?.getD [] :: (tapes a).tail)) + b ((tapes b)[1]?.getD [] :: (tapes b).tail)) + pc (l_funStart :: l_afterSecondRec :: (tapes pc).tail)) := by + simp [innerLoop, h_pc_afterFirstRec] + grind + +lemma function_update_sort + {α : Type} {k : ℕ} {x y : Fin k} {h_lt : x.val < y.val} + {a b : α} {f : Fin k → α} : + Function.update (Function.update f y b) x a = + Function.update (Function.update f x a) y b := by grind + +lemma inner_loop_after_second_rec + {max : ℕ} + {edge : MultiTapeTM tapeCount (WithSep OneTwo)} + {tapes : Fin tapeCount → List (List OneTwo)} + (h_pc_afterSecondRec : (tapes pc).head?.getD [] = l_afterSecondRec) : + (innerLoop edge (dya max)).eval_list tapes = Part.some ( + Function.update (Function.update (Function.update (Function.update + (Function.update (Function.update tapes + a (tapes a).tail) + b (tapes b).tail) + t (dya (dya_inv ((tapes t).head?.getD []) + 1) :: (tapes t).tail)) + result ( + (if (((tapes result).head?.getD [] != []) ∧ + (tapes result)[1]?.getD [] != []) ∨ + (tapes result)[2]?.getD [] != [] then + [.one] + else + []) :: (tapes result).tail.tail.tail)) + c (dya (dya_inv ((tapes c).head?.getD []) + 1) :: (tapes c).tail)) + pc (l_loopStart :: (tapes pc).tail)) := by + simp [innerLoop, h_pc_afterSecondRec] + split_ifs + · simp + split_ifs + · simp + grind + · simp + grind + · simp + split_ifs + · simp + grind + · simp + grind + · simp + split_ifs + · simp + grind + · simp + grind + · simp + split_ifs + · simp + grind + · simp + grind + · simp + grind + · simp + grind + +-- TODO continue here: prove this theorem by induction. +lemma loop_semantics + {r : (List OneTwo) → (List OneTwo) → Prop} + {h_r_dec : ∀ x y, Decidable (r x y)} + (h_rs_dec : ∀ x y t, Decidable (Relation.RelatesInSteps r x y t)) + {max : ℕ} + (h_finite : finiteRel r max) + {edge : MultiTapeTM tapeCount (WithSep OneTwo)} + (h_edge_semantics : edge_semantics r h_r_dec edge) + (tapes : Fin tapeCount → List (List OneTwo)) + (h_pc_funStart : (tapes pc).head?.getD [] = l_funStart) : + (innerLoopFun max h_edge_semantics)^[iter_count_bound max (dya_inv ((tapes t).headD []))] + tapes = Function.update (Function.update tapes + pc (tapes pc).tail) + result ( + if Relation.RelatesInSteps r ((tapes a).headD []) ((tapes b).headD []) + (Nat.pow 2 (dya_inv ((tapes t).headD []))) then + [.one] :: (tapes result) + else + [] :: (tapes result)) ∧ + ∀ n' < iter_count_bound max (dya_inv ((tapes t).headD [])), + (((innerLoopFun max h_edge_semantics)^[n'] tapes) pc).length ≥ (tapes pc).length := by + induction h_t : (dya_inv ((tapes t).head?.getD [])) generalizing tapes with + | zero => + have h_t_dya : (tapes t).head?.getD [] = dya 0 := by rw [← h_t]; simp + unfold edge_semantics at h_edge_semantics + simp [h_edge_semantics, h_pc_funStart, h_t_dya, Relation.RelatesInSteps.single_iff, + innerLoop, innerLoopFun] + split + · simp + · simp + | succ t_val ih => + have h_inner (tapes : Fin tapeCount → List (List OneTwo)) + (h_pc : (tapes pc).head?.getD [] = l_loopStart) + (h_c : (tapes c).head?.getD [] ≠ dya max) + (h_t : dya_inv ((tapes t).head?.getD []) = t_val.succ) : + (innerLoopFun max h_edge_semantics)^[3 + 2 * (iter_count_bound max t_val)] tapes = + Function.update (Function.update (Function.update (Function.update tapes + c ((dya_succ ((tapes c).headD [])) :: (tapes c).tail)) + t (dya (t_val.succ) :: (tapes t).tail)) -- TODO But we already have that + pc (l_loopStart :: (tapes pc).tail)) + result (if + ((tapes result).headD [] != []) ∨ + (Relation.RelatesInSteps r ((tapes a).headD []) ((tapes c).headD []) (2 ^ t_val) ∧ + Relation.RelatesInSteps r ((tapes c).headD []) ((tapes b).headD []) (2 ^ t_val)) + then + [.one] :: (tapes result).tail + else + [] :: (tapes result).tail) := by + have {α : Type} {x : α} {n : ℕ} (f : α → α): f^[3 + 2 * n] x = + f (f^[n] (f (f^[n] (f x)))) := by + rw [← Function.iterate_succ_apply, ← Function.iterate_succ_apply] + rw [← Function.iterate_add_apply, ← Function.iterate_succ_apply' (f := f)] + grind + rw [this] + simp [innerLoopFun] + rw [inner_loop_start h_pc] + simp [h_c] + simp [innerLoopFun] at ih + simp [h_t] + let ih' := ih (Function.update (Function.update (Function.update (Function.update tapes + a ((tapes a).head?.getD [] :: tapes a)) + b ((tapes c).head?.getD [] :: tapes b)) + t ((dya t_val) :: (tapes t).tail)) + pc (l_funStart :: l_afterFirstRec :: (tapes pc).tail)) + simp at ih' + let ih' := ih'.1 + simp [ih'] + simp [inner_loop_after_first_rec] + let ih' := ih (Function.update + (Function.update + (Function.update + (Function.update + (Function.update + (Function.update + (Function.update (Function.update tapes 0 ((tapes 0).head?.getD [] :: tapes 0)) 1 + ((tapes c).head?.getD [] :: tapes 1)) + t (dya t_val :: (tapes t).tail)) + pc (l_afterFirstRec :: (tapes pc).tail)) + result + (if Relation.RelatesInSteps r ((tapes 0).head?.getD []) ((tapes c).head?.getD []) (2 ^ t_val) then + [OneTwo.one] :: tapes result + else [] :: tapes result)) + 0 ((tapes c).head?.getD [] :: tapes 0)) + 1 ((tapes 1)[0]?.getD [] :: tapes 1)) + pc (l_funStart :: l_afterSecondRec :: (tapes pc).tail)) + simp at ih' + let ih' := ih'.1 + simp [ih'] + simp [inner_loop_after_second_rec] + sorry + sorry + + +theorem reachability_eval_list + {r : (List OneTwo) → (List OneTwo) → Prop} + {h_r_dec : ∀ x y, Decidable (r x y)} + (h_rs_dec : ∀ x y t, Decidable (Relation.RelatesInSteps r x y t)) + {max : ℕ} + (h_finite : finiteRel r max) + {edge : MultiTapeTM tapeCount (WithSep OneTwo)} + (h_edge_semantics : edge_semantics r h_r_dec edge) + {t_val : ℕ} + {a_val b_val : List OneTwo} + {tapes : Fin tapeCount → List (List OneTwo)} : + (reachability edge (dya max) a_val b_val t_val).eval_list tapes = .some (Function.update tapes + result ( + if Relation.RelatesInSteps r a_val b_val t_val then + [.one] :: (tapes result) + else + [] :: (tapes result))) := by + simp [reachability] + sorry +end Routines end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean index 25588371..33ca731a 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean @@ -53,12 +53,42 @@ public def MultiTapeTM.TransformsLists (tapes tapes' : Fin k → List (List α)) : Prop := tm.TransformsTapes (listToTape ∘ tapes) (listToTape ∘ tapes') +/-- The Turing machine `tm` halts starting with list-encoded tapes `tapes`. -/ +public def MultiTapeTM.HaltsOnLists + (tm : MultiTapeTM k (WithSep α)) + (tapes : Fin k → List (List α)) : Prop := + ∃ tapes', tm.TransformsLists tapes tapes' + /-- Execute the Turing machine `tm` on the list-encoded tapes `tapes`. -/ public noncomputable def MultiTapeTM.eval_list (tm : MultiTapeTM k (WithSep α)) (tapes : Fin k → List (List α)) : Part (Fin k → List (List α)) := - ⟨∃ tapes', tm.TransformsLists tapes tapes', fun h => h.choose⟩ + ⟨tm.HaltsOnLists tapes, fun h => h.choose⟩ + +public theorem MultiTapeTM.HaltsOnLists_of_eval_list + {tm : MultiTapeTM k (WithSep α)} + {tapes : Fin k → List (List α)} + (h_dom : (tm.eval_list tapes).Dom) : + tm.HaltsOnLists tapes := by + simpa using h_dom + +/-- Execute the Turing machine `tm` knowing that it always halts, thus yielding a total function +on the tapes. -/ +public noncomputable def MultiTapeTM.eval_list_tot + (tm : MultiTapeTM k (WithSep α)) + (h_alwaysHalts : ∀ tapes, tm.HaltsOnLists tapes) + (tapes : Fin k → List (List α)) : + Fin k → List (List α) := + (tm.eval_list tapes).get (h_alwaysHalts tapes) + +@[simp] +public theorem MultiTapeTM.eval_list_tot_eq_eval_list_get + (tm : MultiTapeTM k (WithSep α)) + (h_alwaysHalts : ∀ tapes, tm.HaltsOnLists tapes) + (tapes : Fin k → List (List α)) : + tm.eval_list_tot h_alwaysHalts tapes = + (tm.eval_list tapes).get (sorry /- this should be h_alwaysHalts tapes --/) := by rfl @[simp, grind =] public theorem MultiTapeTM.extend_eval_list @@ -144,6 +174,9 @@ public def dya (n : ℕ) : List OneTwo := /-- Dyadic decoding of natural numbers. -/ public def dya_inv : List OneTwo → ℕ := sorry +@[simp, grind =] +public lemma dya_zero : dya 0 = [] := by simp [dya] + @[simp, grind =] public lemma dya_inv_zero : dya_inv [] = 0 := by sorry diff --git a/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean index 8c4f6bb9..30274df7 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean @@ -42,6 +42,9 @@ public theorem succ_eval_list {k : ℕ} {i : Fin k} {tapes : Fin k → List (Lis ((dya (dya_inv ((tapes i).headD [])).succ) :: (tapes i).tail)) := by simpa [succ] using apply_updates_function_update (by intro x y; grind) +@[simp] +public abbrev dya_succ (w : List OneTwo) := dya ((dya_inv w).succ) + lemma succ₀_evalWithStats_list {n : ℕ} {ls : List (List OneTwo)} : succ₀.evalWithStats_list [(dya n) :: ls].get = .some ( diff --git a/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean b/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean index 43c6e9ca..260d5d8c 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean @@ -63,6 +63,16 @@ public abbrev tapes_extend_by (i : Fin k₂) : γ := if h : i < k₁ then tapes ⟨i, h⟩ else extend_by i +@[simp] +public lemma tapes_extend_by_tapes_take + {γ : Type} + {k₁ k₂ : ℕ} + {h_le : k₁ ≤ k₂} + (tapes : Fin k₂ → γ) : + tapes_extend_by (tapes_take tapes k₁ h_le) tapes = tapes := by + unfold tapes_extend_by tapes_take + simp + @[simp, grind =] public lemma MultiTapeTM.extend_eval {k₁ k₂ : ℕ} (h_le : k₁ ≤ k₂) (tm : MultiTapeTM k₁ α) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean index 2538c73f..dbc78721 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean @@ -50,14 +50,14 @@ public def doWhile (i : Fin k) (tm : MultiTapeTM k (WithSep α)) : M _ syms := sorry @[simp] -public theorem doWhile_eval - (i : Fin k) - (tm : MultiTapeTM k (WithSep α)) - (tapes_seq : ℕ → Fin k → List (List α)) - (h_transform : ∀ j, tm.eval_list (tapes_seq j) = .some (tapes_seq j.succ)) - (h_nonempty : ∀ j, tapes_seq j i ≠ []) - (h_stops : ∃ m, (tapes_seq m i).head (h_nonempty m) = []) : - (doWhile i tm).eval_list (tapes_seq 0) = .some (tapes_seq (Nat.find h_stops)) := by +public theorem doWhile_eval_list + {i : Fin k} + {tm : MultiTapeTM k (WithSep α)} + {tapes : Fin k → List (List α)} + (h_halts : ∀ tapes', tm.HaltsOnLists tapes') : + (doWhile i tm).eval_list tapes = + ⟨∃ n, ((tm.eval_list_tot h_halts)^[n] tapes i).head?.getD [] = [], + fun h_loopEnds => (tm.eval_list_tot h_halts)^[Nat.find h_loopEnds] tapes⟩ := by sorry end Routines diff --git a/Cslib/Foundations/Data/RelatesInSteps.lean b/Cslib/Foundations/Data/RelatesInSteps.lean index 04106f01..a5fa9da7 100644 --- a/Cslib/Foundations/Data/RelatesInSteps.lean +++ b/Cslib/Foundations/Data/RelatesInSteps.lean @@ -47,6 +47,9 @@ theorem ReflTransGen.relatesInSteps (h : ReflTransGen r a b) : ∃ n, RelatesInS lemma RelatesInSteps.single {a b : α} (h : r a b) : RelatesInSteps r a b 1 := tail a a b 0 (refl a) h +lemma RelatesInSteps.single_iff {a b : α} : RelatesInSteps r a b 1 ↔ r a b := by + sorry + theorem RelatesInSteps.head (t t' t'' : α) (n : ℕ) (h₁ : r t t') (h₂ : RelatesInSteps r t' t'' n) : RelatesInSteps r t t'' (n+1) := by induction h₂ with