From e8c772bb87cdd415b4981c748a2c42faee2b1b2b Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Tue, 13 Jan 2026 19:39:39 -0800 Subject: [PATCH 01/95] add files --- .../Machines/SingleTapeTuring/Basic.lean | 998 ++++++++++++++++++ .../Semantics/ReductionSystem/Basic.lean | 12 + 2 files changed, 1010 insertions(+) create mode 100644 Cslib/Computability/Machines/SingleTapeTuring/Basic.lean diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean new file mode 100644 index 000000000..fb9e7ab21 --- /dev/null +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -0,0 +1,998 @@ +/- +Copyright (c) 2025 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module + +public import Cslib.Computability.Automata.Acceptors.Acceptor +public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor +public import Cslib.Foundations.Data.OmegaSequence.InfOcc +public import Cslib.Foundations.Semantics.ReductionSystem.Basic +public import Mathlib.Algebra.Polynomial.Eval.Defs +public import Mathlib.Computability.PostTuringMachine +public import Mathlib.Computability.TuringMachine + + +namespace Turing + +/-- +List of option values that don't end with none +-/ +structure OList (α : Type) where + (asList : List (Option α)) + -- The list can be empty (i.e. none), but if it is not empty, the last element is not (some) none + (h : asList.getLast? ≠ some none) + +def OList.empty {α} : OList α := { asList := [], h := by simp } + +def OList.map_some {α} (l : List α) : OList α := { asList := l.map some, h := by simp } + +instance {α : Type} : Inhabited (OList α) where + default := OList.empty + + +def OList.length {α} (l : OList α) : ℕ := l.asList.length + +def OList.cons {α} : Option α -> OList α -> OList α +| none, l => { asList := [], h := by simp } +| some a, l => { + asList := some a :: l.asList, + h := by + cases hl : l.asList with + | nil => simp + | cons hd tl => + simp only [List.getLast?_cons_cons] + rw [← hl] + exact l.h + } + +def OList.tail {α} (l : OList α) : OList α := + match hl : l.asList with + | [] => OList.empty + | hd :: t => { asList := t, h := by + match t with + | [] => simp + | hd' :: t' => + have lh := l.h + rw [hl] at lh + simp only [List.getLast?_cons_cons] at lh + have := l.h + rw [hl, List.getLast?_cons_cons] at this + exact this + } + +def OList.head {α} (l : OList α) : Option α := + match l.asList with + | [] => none + | h :: _ => h + +lemma OList.length_tail_le {α} (l : OList α) : l.tail.length ≤ l.length := by + unfold tail length + split + · simp [empty] + · next heq => simp [heq] + +lemma OList.length_cons_none {α} (l : OList α) : (OList.cons none l).length = 0 := by + simp [cons, length, empty] + +lemma OList.length_cons_some {α} (a : α) (l : OList α) : + (OList.cons (some a) l).length = l.length + 1 := by + simp [cons, length] + +lemma OList.length_cons_le {α} (o : Option α) (l : OList α) : + (OList.cons o l).length ≤ l.length + 1 := by + cases o with + | none => simp [length_cons_none] + | some a => simp [length_cons_some] + +lemma OList.length_map_some {α} (l : List α) : (OList.map_some l).length = l.length := by + simp [map_some, length] + +lemma OList.length_empty {α} : (OList.empty : OList α).length = 0 := by + simp [empty, length] + +/-- +I find this more convenient than mathlib's Tape type, +because that requires the type tobe inhabited, +and it is easy to confuse a list representing one thing with a list representing another, +if the representations are the same except for a sequence of default values at the end. + +The head of the machine is the current symbol under the tape head. +We do not assume here, but could add, that the ends of the tape are never none. +The move function should guarantee this, so that two tapes are equal +even if one has written none to the side +-/ +structure OTape (α : Type) where + (head : Option α) + (left : OList α) + (right : OList α) +deriving Inhabited + +def OTape.mk₁ (l : List Bool) : OTape Bool := + match l with + | [] => { head := none, left := OList.empty, right := OList.empty } + | h :: t => { head := some h, left := OList.empty, right := OList.map_some t } + +-- TODO incorrect, we must delete blanks from the ends, refactor out OList +def OTape.move {α} : Turing.OTape α → Dir → Turing.OTape α + | t, .left => + match t.left, t.head, t.right with + | l, h, r => { head := l.head, left := l.tail, right := OList.cons h r } + | t, .right => + match t.left, t.head, t.right with + | l, h, r => { head := r.head, left := OList.cons h l, right := r.tail } + + +def OTape.move? {α} : Turing.OTape α → Option Dir → Turing.OTape α + | t, none => t + | t, some d => t.move d + +def OTape.write {α} : Turing.OTape α → Option α → Turing.OTape α + | t, a => { t with head := a } + +open Classical in +noncomputable def ListBlank.space_used {α} [Inhabited α] (l : ListBlank α) : ℕ := + Nat.find (p := fun n => ∀ i > n, l.nth i = default) + (l.inductionOn (fun xs => ⟨xs.length, fun i hi => by + change (ListBlank.mk xs).nth i = default + rw [ListBlank.nth_mk] + exact List.getI_eq_default xs (Nat.le_of_lt hi)⟩)) + +/-- +The space used by a OTape is the number of symbols +between and including the head, and leftmost and rightmost non-blank symbols on the OTape +-/ +noncomputable def OTape.space_used {α} [Inhabited α] (t : Turing.OTape α) : ℕ := + 1 + t.left.length + t.right.length + +lemma OTape.space_used_write {α} [Inhabited α] (t : Turing.OTape α) (a : Option α) : + (t.write a).space_used = t.space_used := by + rfl + +lemma OTape.space_used_mk₁ (l : List Bool) : + (OTape.mk₁ l).space_used = max 1 l.length := by + cases l with + | nil => + simp [mk₁, space_used, OList.length_empty] + | cons h t => + simp [mk₁, space_used, OList.length_empty, OList.length_map_some] + omega + +open Classical in +lemma ListBlank.nth_ge_space_used {α} [Inhabited α] (l : ListBlank α) (i : ℕ) + (hi : i > l.space_used) : l.nth i = default := by + unfold space_used at hi + have H : ∃ n, ∀ i > n, l.nth i = default := l.inductionOn (fun xs => ⟨xs.length, fun i hi => + (ListBlank.nth_mk xs i).symm ▸ List.getI_eq_default xs (Nat.le_of_lt hi)⟩) + have h := Nat.find_spec H + exact h i hi + +open Classical in +lemma ListBlank.space_used_cons_le {α} [Inhabited α] (a : α) (l : ListBlank α) : + (l.cons a).space_used ≤ l.space_used + 1 := by + unfold space_used + apply Nat.find_le + intro i hi + cases i with + | zero => omega + | succ i => + rw [ListBlank.nth_succ, ListBlank.tail_cons] + exact ListBlank.nth_ge_space_used l i (by unfold space_used; omega) + +open Classical in +lemma ListBlank.space_used_tail_le {α} [Inhabited α] (l : ListBlank α) : + l.tail.space_used ≤ l.space_used := by + unfold space_used + apply Nat.find_le + intro i hi + rw [← ListBlank.nth_succ] + exact ListBlank.nth_ge_space_used l (i + 1) (by unfold space_used; omega) + +lemma OTape.space_used_move {α} [Inhabited α] (t : Turing.OTape α) (d : Dir) : + (t.move d).space_used ≤ t.space_used + 1 := by + cases d with + | left => + simp only [move, space_used] + have h1 := OList.length_tail_le t.left + have h2 := OList.length_cons_le t.head t.right + omega + | right => + simp only [move, space_used] + have h1 := OList.length_cons_le t.head t.left + have h2 := OList.length_tail_le t.right + omega + +namespace BinTM0 + +/-- A Turing machine "statement" is just a command to move + left or right, and write a symbol on the OTape. -/ +def Stmt := (Option Bool) × Option (Dir) +deriving Inhabited + +end BinTM0 + +/-- A TM0 over the alphabet of Option Bool (none is blank OTape symbol). -/ +structure BinTM0 where + /-- type of state labels -/ + (Λ : Type) + /-- finiteness of the state type -/ + [FintypeΛ : Fintype Λ] + /-- Initial state -/ + (q₀ : Λ) + /-- Transition function, mapping a state and a head symbol + to a Stmt to invoke, and optionally a new state (none for halt) -/ + (M : Λ → (Option Bool) → (Turing.BinTM0.Stmt × Option Λ)) + + +namespace BinTM0 + +section + +variable (tm : BinTM0) + +instance : Inhabited tm.Λ := + ⟨tm.q₀⟩ + +instance : Fintype tm.Λ := + tm.FintypeΛ + +instance inhabitedStmt : Inhabited (Stmt) := inferInstance + +/-- The type of configurations (functions) corresponding to this TM. -/ +structure Cfg : Type where + /-- the state of the TM (or none for the halting state) -/ + state : Option tm.Λ + /-- the OTape contents, which -/ + OTape : OTape (Bool) +deriving Inhabited + +/-- The step function corresponding to this TM. -/ +@[simp] +def step : tm.Cfg → Option tm.Cfg := + fun ⟨q, t⟩ => + match q with + -- If in the halting state, there is no next configuration + | none => none + -- If in state q' + | some q' => + -- Look up the transition function + match tm.M q' t.head with + | ⟨(wr, dir), q''⟩ => + -- enter a new configuration + some ⟨ + -- With state q'' (or none for halting) + q'', + -- And OTape updated according to the Stmt + (t.write wr).move? dir⟩ +end + +/-- The initial configuration corresponding to a list in the input alphabet. -/ +def initCfg (tm : BinTM0) (s : List Bool) : tm.Cfg := ⟨some tm.q₀, OTape.mk₁ s⟩ + +/-- The final configuration corresponding to a list in the output alphabet. +(We demand that the head halts at the leftmost position of the output.) +-/ +def haltCfg (tm : BinTM0) (s : List (Bool)) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ + +/-- +The `ReductionSystem` corresponding to a `BinTM0` is defined by the `step` function, +which maps a configuration to its next configuration if it exists. +-/ +def ReductionSystem (tm : BinTM0) : Cslib.ReductionSystem (tm.Cfg) := + { Red := fun cfg cfg' => tm.step cfg = some cfg' } +-- TODO use this, rather than the current setup + + +noncomputable def Cfg.space_used (tm : BinTM0) (cfg : tm.Cfg) : ℕ := + cfg.OTape.space_used + +open Classical in +lemma ListBlank.space_used_mk_nil {α} [Inhabited α] : + (ListBlank.mk ([] : List α)).space_used = 0 := by + unfold ListBlank.space_used + rw [Nat.find_eq_zero] + intro i hi + rw [ListBlank.nth_mk] + exact List.getI_nil i + +-- Helper lemma for space_used of a ListBlank created from a list +open Classical in +lemma ListBlank.space_used_mk {α} [Inhabited α] (l : List α) : + (ListBlank.mk l).space_used ≤ l.length := by + unfold ListBlank.space_used + apply Nat.find_le + intro i hi + rw [ListBlank.nth_mk] + exact List.getI_eq_default l (Nat.le_of_lt hi) + +-- /-- The space_used of a OTape created from a list +-- equals the maximum of 1 and the list length -/ +-- lemma OTape.space_used_mk₁ {α} [Inhabited α] (l : List α) : +-- (OTape.mk₁ l).space_used = max 1 l.length := by +-- unfold OTape.mk₁ OTape.mk₂ OTape.mk' OTape.space_used +-- simp only [ListBlank.space_used_mk_nil, add_zero, ListBlank.tail_mk] +-- cases l with +-- | nil => +-- simp [ListBlank.space_used_mk_nil] +-- | cons h t => +-- simp only [List.tail_cons, List.length_cons, le_add_iff_nonneg_left, zero_le, sup_of_le_right] +-- rw [add_comm] +-- simp only [Nat.add_right_cancel_iff] +-- sorry + +lemma Cfg.space_used_initCfg (tm : BinTM0) (s : List Bool) : + (tm.initCfg s).space_used = max 1 s.length := by + simp [initCfg, Cfg.space_used, OTape.space_used_mk₁] + +lemma Cfg.space_used_haltCfg (tm : BinTM0) (s : List Bool) : + (tm.haltCfg s).space_used = max 1 s.length := by + simp [haltCfg, Cfg.space_used, OTape.space_used_mk₁] + +lemma Cfg.space_used_step {tm : BinTM0} (cfg cfg' : tm.Cfg) + (hstep : tm.step cfg = some cfg') : + cfg'.space_used ≤ cfg.space_used + 1 := by + unfold Cfg.space_used + cases cfg with | mk state tape => + cases state with + | none => simp [step] at hstep + | some q => + simp only [step] at hstep + generalize hM : tm.M q tape.head = result at hstep + obtain ⟨⟨wr, dir⟩, q''⟩ := result + simp only at hstep + cases hstep + cases dir with + | none => + simp only [OTape.move?] + rw [OTape.space_used_write] + omega + | some d => + simp only [OTape.move?] + have h1 := OTape.space_used_move (tape.write wr) d + rw [OTape.space_used_write] at h1 + exact h1 + +/-- `f` eventually reaches `b` when repeatedly evaluated on `a`, in exactly `steps` steps. -/ +def EvalsToInTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (steps : ℕ) : Prop := + (· >>= f)^[steps] a = b + +/-- Reflexivity of `EvalsTo` in 0 steps. -/ +lemma EvalsToInTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : EvalsToInTime f a (some a) 0 := + rfl + +/-- Transitivity of `EvalsTo` in the sum of the numbers of steps. -/ +@[trans] +lemma EvalsToInTime.trans {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (c : Option σ) + (steps₁ steps₂ : ℕ) + (h₁ : EvalsToInTime f a b steps₁) + (h₂ : EvalsToInTime f b c steps₂) : + EvalsToInTime f a c (steps₂ + steps₁) := by + simp_all only [EvalsToInTime, Option.bind_eq_bind] + rw [Function.iterate_add_apply, h₁, h₂] + +/-- If we evaluate to some state in n+1 steps, there is an intermediate state + that we reach in n steps, and then one more step reaches the final state. -/ +lemma EvalsToInTime.succ_decompose {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) + (n : ℕ) (h : EvalsToInTime f a (some b) (n + 1)) : + ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := by + set c' := (· >>= f)^[n] (some a) with hc' + simp only [EvalsToInTime, Option.bind_eq_bind] at h hc' ⊢ + rw [Function.iterate_succ_apply'] at h + -- h : (· >>= f) ((· >>= f)^[n] (some a)) = some b + -- This means (· >>= f)^[n] (some a) >>= f = some b + -- So (· >>= f)^[n] (some a) = some c for some c with f c = some b + rw [<-hc'] at h + revert h hc' + cases c' with + | none => + grind + | some c => + intros h hc' + use c + grind + +lemma EvalsToInTime.succ_iff {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) + (n : ℕ) : + EvalsToInTime f a (some b) (n + 1) ↔ + ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := by + constructor + · exact EvalsToInTime.succ_decompose f a b n + · intro ⟨c, hc_eval, hc_step⟩ + simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_succ_apply'] at hc_eval ⊢ + simp only [hc_eval, Option.bind_some, hc_step] + +theorem Turing.BinTM0.EvalsToInTime.congr.extracted_1_2.{u_2, u_1} + {σ : Type u_1} {σ' : Type u_2} (f : σ → Option σ) + (f' : σ' → Option σ') (g : σ → σ') + (hg : ∀ (x : σ), Option.map g (f x) = f' (g x)) (n : ℕ) (a : σ) : + (Option.map g ((flip Option.bind f)^[n] (some a))).bind f' = + ((flip Option.bind f)^[n] (some a)).bind fun a ↦ f' (g a) := by + induction n with + | zero => simp + | succ n ih => + simp only [Function.iterate_succ_apply, flip, Option.bind_some, <- hg] at ih ⊢ + grind + + + + + +/-- +If `f` is homomorphic to `f'` via `g`, then if `f` evals to `b` from `a` in `steps` steps, +then `f'` evals to `g b` from `g a` in `steps` steps. +-/ +lemma EvalsToInTime.map {σ σ' : Type*} (f : σ → Option σ) (f' : σ' → Option σ') + (g : σ → σ') (hg : ∀ x, Option.map g (f x) = f' (g x)) + (a : σ) (b : Option σ) + (steps : ℕ) + (h : EvalsToInTime f a b steps) : EvalsToInTime f' (g a) (Option.map g b) steps := by + induction steps generalizing a b with + | zero => + simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_zero, id_eq] at h ⊢ + subst h + rfl + | succ n ih => + simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_succ_apply', + forall_eq'] at h ih ⊢ + subst h + rw [ih] + clear ih + simp only [Option.map_bind, Function.comp_apply, hg] + exact Turing.BinTM0.EvalsToInTime.congr.extracted_1_2 f f' g hg n a + +/-- +If `h : σ → ℕ` increases by at most 1 on each step of `f`, +then the value of `h` at the output after `steps` steps is at most `h` at the input plus `steps`. +-/ +lemma EvalsToInTime.small_change {σ : Type*} (f : σ → Option σ) (h : σ → ℕ) + (h_step : ∀ a b, f a = some b → h b ≤ h a + 1) + (a : σ) (b : σ) + (steps : ℕ) + (hevals : EvalsToInTime f a b steps) : + h b ≤ h a + steps := by + induction steps generalizing a b with + | zero => + simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_zero, id_eq, Option.some.injEq, + add_zero] at hevals ⊢ + subst hevals + exact Nat.le_refl (h a) + | succ n ih => + rw [EvalsToInTime.succ_iff] at hevals + obtain ⟨c, hevals_n, h_step_eq⟩ := hevals + specialize ih a c hevals_n + specialize h_step c b h_step_eq + omega + + +-- m -> step_bound +/-- `f` eventually reaches `b` in at most `m` steps when repeatedly +evaluated on `a`. -/ +def EvalsToWithinTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (m : ℕ) : Prop := + ∃ steps ≤ m, EvalsToInTime f a b steps + +/-- Reflexivity of `EvalsToWithinTime` in 0 steps. -/ +def EvalsToWithinTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : + EvalsToWithinTime f a (some a) 0 := by + use 0 + exact if_false_right.mp rfl + +/-- Transitivity of `EvalsToWithinTime` in the sum of the numbers of steps. -/ +@[trans] +def EvalsToWithinTime.trans {σ : Type*} (f : σ → Option σ) (m₁ : ℕ) (m₂ : ℕ) (a : σ) (b : σ) + (c : Option σ) (h₁ : EvalsToWithinTime f a b m₁) (h₂ : EvalsToWithinTime f b c m₂) : + EvalsToWithinTime f a c (m₂ + m₁) := by + obtain ⟨steps₁, hsteps₁, hevals₁⟩ := h₁ + obtain ⟨steps₂, hsteps₂, hevals₂⟩ := h₂ + use steps₂ + steps₁ + constructor + · omega + · exact EvalsToInTime.trans f a b c steps₁ steps₂ hevals₁ hevals₂ + +def EvalsToWithinTime.map {σ σ' : Type*} (f : σ → Option σ) (f' : σ' → Option σ') + (g : σ → σ') (hg : ∀ x, Option.map g (f x) = f' (g x)) + (a : σ) (b : Option σ) + (m : ℕ) + (h : EvalsToWithinTime f a b m) : EvalsToWithinTime f' (g a) (Option.map g b) m := by + obtain ⟨steps, hsteps, hevals⟩ := h + use steps + constructor + · exact hsteps + · exact EvalsToInTime.map f f' g hg a b steps hevals + +/-- +Monotonicity of `EvalsToWithinTime` in the time bound. +-/ +def EvalsToWithinTime.mono_time {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) + {m₁ m₂ : ℕ} (h : EvalsToWithinTime f a b m₁) (hm : m₁ ≤ m₂) : EvalsToWithinTime f a b m₂ := by + obtain ⟨steps, hsteps, hevals⟩ := h + use steps + simp_all only + simp + omega + +lemma EvalsToWithinTime.small_change {σ : Type*} (f : σ → Option σ) (h : σ → ℕ) + (h_step : ∀ a b, f a = some b → h b ≤ h a + 1) + (a : σ) (b : σ) + (m : ℕ) + (hevals : EvalsToWithinTime f a (some b) m) : + h b ≤ h a + m := by + obtain ⟨steps, hsteps, hevals_steps⟩ := hevals + have := EvalsToInTime.small_change f h h_step a b steps hevals_steps + omega + +/-- A proof of tm outputting l' when given l. -/ +def OutputsInTime (tm : BinTM0) (l : List (Bool)) (l' : Option (List (Bool))) := + EvalsToInTime tm.step (initCfg tm l) ((Option.map (haltCfg tm)) l') + +/-- A proof of tm outputting l' when given l in at most m steps. -/ +def OutputsWithinTime (tm : BinTM0) (l : List (Bool)) (l' : Option (List (Bool))) + (m : ℕ) := + EvalsToWithinTime tm.step (initCfg tm l) ((Option.map (haltCfg tm)) l') m + +-- /-- A (bundled TM0) Turing machine +-- with input alphabet equivalent to `Γ₀` and output alphabet equivalent to `Γ₁`. +-- TODO this is something of a holdover, might get rid +-- -/ +-- structure ComputableAux (Γ₀ Γ₁ : Type) where +-- /-- the underlying bundled TM0 -/ +-- tm : BinTM0 +-- /-- the input alphabet is equivalent to `Γ₀` -/ +-- inputAlphabet : Bool ≃ Γ₀ +-- /-- the output alphabet is equivalent to `Γ₁` -/ +-- outputAlphabet : Bool ≃ Γ₁ + +/-- A Turing machine + a proof it outputsInTime `f`. -/ +structure Computable (f : List Bool → List Bool) where + /-- the underlying bundled TM0 -/ + tm : BinTM0 + steps : ℕ + /-- a proof this machine outputsInTime `f` -/ + outputsFun : + ∀ a, + OutputsInTime tm ((a)) + (Option.some (((f a)))) + steps + +/-- A Turing machine + a time function + +a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ +structure ComputableInTime (f : List Bool → List Bool) where + /-- the underlying bundled TM0 -/ + tm : BinTM0 + /-- a time function -/ + time : ℕ → ℕ + /-- proof this machine outputsInTime `f` in at most `time(input.length)` steps -/ + outputsFun : + ∀ a, + tm.OutputsWithinTime + ((a)) + (Option.some (((f a)))) + (time ( a).length) + +/-- A Turing machine + a polynomial time function + +a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ +structure ComputableInPolyTime (f : List Bool → List Bool) where + /-- the underlying bundled TM0 -/ + tm : BinTM0 + /-- a polynomial time function -/ + time : Polynomial ℕ + /-- proof that this machine outputsInTime `f` in at most `time(input.length)` steps -/ + outputsFun : + ∀ a, + OutputsWithinTime tm (( a)) + (Option.some (((f a)))) + (time.eval ( a).length) + +-- /-- A forgetful map, forgetting the time bound on the number of steps. -/ +-- def ComputableInTime.toComputable {α β : Type} {ea : BinEncoding α} {eb : BinEncoding β} +-- {f : α → β} (h : ComputableInTime ea eb f) : Computable ea eb f := +-- ⟨h.tm, fun a => OutputsWithinTime.toOutputsInTime (h.outputsFun a)⟩ + +/-- A forgetful map, forgetting that the time function is polynomial. -/ +def ComputableInPolyTime.toComputableInTime {f : List Bool → List Bool} (h : ComputableInPolyTime f) : + ComputableInTime f := + ⟨h.tm, fun n => h.time.eval n, h.outputsFun⟩ + +open Turing.TM0.Stmt + +/-- A Turing machine computing the identity. -/ +def idComputer : BinTM0 where + Λ := PUnit + q₀ := PUnit.unit + M := fun _ b => ⟨(b, none), none⟩ + +noncomputable section + +/-- A proof that the identity map on α is computable in polytime. -/ +def ComputableInPolyTime.id : + @ComputableInPolyTime id where + tm := idComputer + time := 1 + outputsFun x := by + use 1 + simp only [Polynomial.eval_one, le_refl, id_eq, Option.map_some, true_and] + simp only [EvalsToInTime, initCfg, haltCfg, idComputer, + Function.iterate_succ, Function.iterate_zero, Function.comp_apply, id_eq] + congr 1 + + + -- { steps := 1 + -- evals_in_steps := rfl + -- steps_le_m := by simp only [Polynomial.eval_one, le_refl] } + +-- instance inhabitedComputableInPolyTime : +-- Inhabited (ComputableInPolyTime (default : BinEncoding Bool) default id) := +-- ⟨idComputableInPolyTime Computability.inhabitedBinEncoding.default⟩ + +-- instance inhabitedOutputsWithinTime : +-- Inhabited +-- (OutputsWithinTime (idComputer finEncodingBoolBool) +-- (List.map (Equiv.cast rfl).invFun [false]) +-- (some (List.map (Equiv.cast rfl).invFun [false])) (Polynomial.eval 1 1)) := +-- ⟨(idComputableInPolyTime finEncodingBoolBool).outputsFun false⟩ + +-- instance inhabitedOutputsInTime : +-- Inhabited +-- (OutputsInTime (idComputer finEncodingBoolBool) (List.map (Equiv.cast rfl).invFun [false]) +-- (some (List.map (Equiv.cast rfl).invFun [false]))) := +-- ⟨OutputsWithinTime.toOutputsInTime Turing.inhabitedOutputsWithinTime.default⟩ + +-- instance inhabitedEvalsToWithinTime : +-- Inhabited (EvalsToWithinTime (fun _ : Unit => some ⟨⟩) ⟨⟩ (some ⟨⟩) 0) := +-- ⟨EvalsToWithinTime.refl _ _⟩ + +-- instance inhabitedTM0EvalsToInTime : +-- Inhabited (EvalsToInTime (fun _ : Unit => some ⟨⟩) ⟨⟩ (some ⟨⟩)) := +-- ⟨EvalsTo.refl _ _⟩ + +/-- A proof that the identity map on α is computable in time. -/ +def ComputableInTime.id : + @ComputableInTime id := + ComputableInPolyTime.toComputableInTime <| ComputableInPolyTime.id + +-- instance inhabitedComputableInTime : +-- Inhabited (ComputableInTime finEncodingBoolBool finEncodingBoolBool id) := +-- ⟨idComputableInTime Computability.inhabitedBinEncoding.default⟩ + +-- /-- A proof that the identity map on α is computable. -/ +-- def idComputable {α : Type} (ea : BinEncoding α) : @Computable α α ea ea id := +-- ComputableInTime.toComputable <| ComputableInTime.id ea + +-- instance inhabitedComputable : +-- Inhabited (Computable finEncodingBoolBool finEncodingBoolBool id) := +-- ⟨idComputable Computability.inhabitedBinEncoding.default⟩ + +-- instance inhabitedComputableAux : Inhabited (ComputableAux Bool Bool) := +-- ⟨(default : Computable finEncodingBoolBool finEncodingBoolBool id).toComputableAux⟩ + +def compComputer {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) + (hg : ComputableInTime g) : + BinTM0 := + { + Λ := hf.tm.Λ ⊕ hg.tm.Λ + q₀ := Sum.inl hf.tm.q₀ + M := fun q h => + match q with + -- If we are in the first machine's states, run that machine + | Sum.inl ql => match hf.tm.M ql (h) with + -- The action should be the same, and the state should either be the corresponding state + -- in the first machine, or transition to the start state of the second machine if halting + | (ql', stmt) => (ql', + match stmt with + -- If it halts, transition to the start state of the second machine + | none => some (Sum.inr hg.tm.q₀) + -- Otherwise continue as normal + | _ => Option.map Sum.inl stmt) + -- If we are in the second machine's states, run that machine + | Sum.inr qr => + match hg.tm.M qr (h) with + -- The action should be the same, and the state should be the corresponding state + -- in the second machine, or halting if the second machine halts + | (qr', stmt) => (qr', + match stmt with + -- If it halts, transition to the halting state + | none => none + -- Otherwise continue as normal + | _ => Option.map Sum.inr stmt) + } + +lemma compComputer_q₀_eq (f : List Bool → List Bool) (g : List Bool → List Bool) + (hf : ComputableInTime f) + (hg : ComputableInTime g) : + (compComputer hf hg).q₀ = Sum.inl hf.tm.q₀ := + rfl + +/-- Lift a config over a tm to a config over the comp -/ +def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) + (hg : ComputableInTime g) + (cfg : hf.tm.Cfg) : + (compComputer hf hg).Cfg := + { + state := Option.map Sum.inl cfg.state + OTape := cfg.OTape + } + +def liftCompCfg_right{f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) + (hg : ComputableInTime g) + (cfg : hg.tm.Cfg) : + (compComputer hf hg).Cfg := + { + state := Option.map Sum.inr cfg.state + OTape := cfg.OTape + } + +theorem map_liftCompCfg_left_step + {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) (hg : ComputableInTime g) + (x : hf.tm.Cfg) + (hx : ∀ cfg, hf.tm.step x = some cfg → cfg.state.isSome) : + Option.map (liftCompCfg_left hf hg) (hf.tm.step x) = + (compComputer hf hg).step (liftCompCfg_left hf hg x) := by + cases x with + | mk state OTape => + cases state with + | none => + -- x is already in halting state, step returns none on both sides + simp only [step, liftCompCfg_left, Option.map_none, compComputer] + | some q => + simp only [step, liftCompCfg_left, compComputer, Option.map_some] + -- Get the transition result + generalize hM : hf.tm.M q OTape.head = result + obtain ⟨⟨wr, dir⟩, nextState⟩ := result + simp only + -- Case on whether the next state is none (halting) or some + cases nextState with + | none => + -- The first machine halts, but hx says the result has state.isSome + simp only [step, hM] at hx + have := hx ⟨none, (OTape.write wr).move? dir⟩ rfl + simp at this + | some q' => + -- Normal step case - both sides produce the lifted config + simp only [hM, Option.map_some, liftCompCfg_left] + +/-- Helper lemma: liftCompCfg_right commutes with step for the second machine -/ +theorem map_liftCompCfg_right_step + {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) (hg : ComputableInTime g) + (x : hg.tm.Cfg) : + Option.map (liftCompCfg_right hf hg) (hg.tm.step x) = + (compComputer hf hg).step (liftCompCfg_right hf hg x) := by + cases x with + | mk state OTape => + cases state with + | none => + simp only [step, liftCompCfg_right, Option.map_none, compComputer] + | some q => + simp only [step, liftCompCfg_right, compComputer, Option.map_some] + generalize hM : hg.tm.M q OTape.head = result + obtain ⟨⟨wr, dir⟩, nextState⟩ := result + cases nextState with + | none => simp only [hM, Option.map_some, liftCompCfg_right, Option.map_none] + | some q' => simp only [hM, Option.map_some, liftCompCfg_right] + +/-- When the first machine would halt, the composed machine transitions to the second machine -/ +theorem comp_transition_to_right {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) (hg : ComputableInTime g) + (tp : OTape (Bool)) + (q : hf.tm.Λ) + (hM : (hf.tm.M q tp.head).2 = none) : + (compComputer hf hg).step { state := some (Sum.inl q), OTape := tp } = + some { state := some (Sum.inr hg.tm.q₀), + OTape := (tp.write (hf.tm.M q tp.head).1.1).move? (hf.tm.M q tp.head).1.2 } := by + simp only [step, compComputer, hM] + generalize hfM_eq : hf.tm.M q tp.head = result + obtain ⟨⟨wr, dir⟩, nextState⟩ := result + simp only [hfM_eq] + +/-- Helper: lifting to Sum.inl and transitioning to Sum.inr on halt -/ +def liftCompCfg_left_or_right {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) + (hg : ComputableInTime g) + (cfg : hf.tm.Cfg) : + (compComputer hf hg).Cfg := + match cfg.state with + | some q => { state := some (Sum.inl q), OTape := cfg.OTape } + | none => { state := some (Sum.inr hg.tm.q₀), OTape := cfg.OTape } + +/-- The lifting function commutes with step, converting halt to transition -/ +theorem map_liftCompCfg_left_or_right_step + {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) (hg : ComputableInTime g) + (x : hf.tm.Cfg) + (hx : x.state.isSome) : + Option.map (liftCompCfg_left_or_right hf hg) (hf.tm.step x) = + (compComputer hf hg).step (liftCompCfg_left_or_right hf hg x) := by + cases x with + | mk state OTape => + cases state with + | none => simp at hx + | some q => + simp only [step, liftCompCfg_left_or_right, compComputer] + generalize hM : hf.tm.M q OTape.head = result + obtain ⟨⟨wr, dir⟩, nextState⟩ := result + cases nextState with + | none => simp only [hM, Option.map_some, liftCompCfg_left_or_right] + | some q' => simp only [hM, Option.map_some, liftCompCfg_left_or_right] + +/-- General simulation: if the first machine goes from cfg to halt, the composed machine + goes from lifted cfg to Sum.inr hg.tm.q₀ -/ +theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) (hg : ComputableInTime g) + (cfg : hf.tm.Cfg) + (hcfg : cfg.state.isSome) + (haltCfg : hf.tm.Cfg) + -- (haltCfg_state : haltCfg.state = none) + (steps : ℕ) + (h : EvalsToInTime hf.tm.step cfg (some haltCfg) steps) : + EvalsToInTime (compComputer hf hg).step + (liftCompCfg_left_or_right hf hg cfg) + (some (liftCompCfg_left_or_right hf hg haltCfg)) + steps := by + -- Proof by induction on steps. + -- Key insight: liftCompCfg_left_or_right maps: + -- { state := some q, OTape } -> { state := some (Sum.inl q), OTape } + -- { state := none, OTape } -> { state := some (Sum.inr hg.tm.q₀), OTape } + -- For non-halting configs, the composed machine simulates exactly. + -- When the first machine halts, the composed machine transitions to Sum.inr hg.tm.q₀. + induction steps generalizing cfg haltCfg with + | zero => + simp only [EvalsToInTime, Option.bind_eq_bind, step, Function.iterate_zero, id_eq, + Option.some.injEq] at h ⊢ + rw [h] + | succ n ih => + -- Use the decomposition lemma: cfg evals to some intermediate c in n steps, + -- and then c steps to haltCfg + -- obtain ⟨c, hc_n, hc_step⟩ := EvalsToInTime.succ_decompose hf.tm.step cfg haltCfg n h + rw [EvalsToInTime.succ_iff] at h ⊢ + obtain ⟨c, hc_n, hc_step⟩ := h + use liftCompCfg_left_or_right hf hg c + constructor + · apply ih + · exact hcfg + · exact hc_n + · cases c with + | mk state OTape => + cases state with + | none => + simp_all + | some q => + rw [← map_liftCompCfg_left_or_right_step hf hg ⟨some q, OTape⟩ (by simp)] + simp only [hc_step, Option.map_some] + + +/-- +Simulation for the first phase of the composed computer. +When the first machine runs from start to halt, the composed machine +runs from start (with Sum.inl state) to Sum.inr hg.tm.q₀ (the start of the second phase). +This takes the same number of steps because the halt transition becomes a transition to the +second machine. +-/ +theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) (hg : ComputableInTime g) + (a : List Bool) + (hf_outputsFun : + EvalsToWithinTime hf.tm.step + { state := some hf.tm.q₀, OTape := OTape.mk₁ ( a) } + (some { state := none, OTape := OTape.mk₁ ( (f a)) }) + (hf.time ( a).length)) : + EvalsToWithinTime (compComputer hf hg).step + { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ ( a) } + (some { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ ( (f a)) }) + (hf.time ( a).length) := by + obtain ⟨steps, hsteps_le, hsteps_eval⟩ := hf_outputsFun + use steps + constructor + · exact hsteps_le + · have := comp_left_simulation_general hf hg + { state := some hf.tm.q₀, OTape := OTape.mk₁ ( a) } + (by simp) + { state := none, OTape := OTape.mk₁ ( (f a)) } + steps + hsteps_eval + simp only [liftCompCfg_left_or_right] at this + exact this + +/-- Simulation lemma for the second machine in the composed computer -/ +theorem comp_right_simulation + {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) (hg : ComputableInTime g) + (x : hg.tm.Cfg) (y : Option hg.tm.Cfg) (m : ℕ) + (h : EvalsToWithinTime hg.tm.step x y m) : + EvalsToWithinTime (compComputer hf hg).step + (liftCompCfg_right hf hg x) + (Option.map (liftCompCfg_right hf hg) y) + m := by + exact EvalsToWithinTime.map hg.tm.step (compComputer hf hg).step + (liftCompCfg_right hf hg) (map_liftCompCfg_right_step hf hg) x y m h + + + + +lemma output_length_le_input_length_add_time (tm : BinTM0) (l l' : List Bool) (t : ℕ) + (h : tm.OutputsWithinTime l (some l') t) : + l'.length ≤ max 1 l.length + t := by + unfold OutputsWithinTime at h + obtain ⟨steps, hsteps_le, hevals⟩ := h + replace hevals := hevals.small_change + specialize hevals (Cfg.space_used tm) + simp only [Cfg.space_used_initCfg, Cfg.space_used_haltCfg] at hevals + suffices l'.length ≤ max 1 l.length + steps + by omega + specialize hevals fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep) + omega + +/-- +A composition for ComputableInTime. + +If f and g are computed by turing machines M₁ and M₂ +then we can construct a turing machine M which computes g ∘ f by first running M₁ +and then, when M₁ halts, transitioning to the start state of M₂ and running M₂. + +This results in time bounded by the amount of time taken by M₁ plus the maximum time taken by M₂ on +inputs of length of the maximum output length of M₁ for that input size (which is itself bounded by +the time taken by M₁). + +Note that we require the time function of the second machine to be monotone; +this is to ensure that if the first machine returns an output +which is shorter than the maximum possible length of output for that input size, +then the time bound for the second machine still holds for that shorter input to the second machine. + +TODO refactor out the definition of the composed TM. +Prove separately that it +evals to the intermediate state from the start state and +then from the intermediate state to the final state. +-/ +def ComputableInTime.comp + {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) + (hg : ComputableInTime g) + (h_mono : Monotone hg.time) : + (ComputableInTime (g ∘ f)) where + tm := compComputer hf hg + time l := (hf.time l) + hg.time (max 1 l + hf.time l) + outputsFun a := by + have hf_outputsFun := hf.outputsFun a + have hg_outputsFun := hg.outputsFun (f a) + simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, + Option.map_some, haltCfg] at hg_outputsFun hf_outputsFun ⊢ + -- The computer evals a to f a in time hf.time ( a) + have h_a_evalsTo_f_a : + EvalsToWithinTime (compComputer hf hg).step + { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ ( a) } + (some { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ ( ((f a))) }) + (hf.time ( a).length) := + comp_left_simulation hf hg a hf_outputsFun + have h_f_a_evalsTo_g_f_a : + EvalsToWithinTime (compComputer hf hg).step + { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ ( ((f a))) } + (some { state := none, OTape := OTape.mk₁ ( ((g (f a)))) }) + (hg.time ( ((f a))).length) := by + -- Use the simulation lemma for the second machine + have := comp_right_simulation hf hg + { state := some hg.tm.q₀, OTape := OTape.mk₁ ( (f a)) } + (some { state := none, OTape := OTape.mk₁ ( (g (f a))) }) + (hg.time ( (f a)).length) + hg_outputsFun + simp only [liftCompCfg_right, Option.map_some] at this + exact this + have h_a_evalsTo_g_f_a := + EvalsToWithinTime.trans + (compComputer hf hg).step _ _ _ _ _ h_a_evalsTo_f_a h_f_a_evalsTo_g_f_a + apply EvalsToWithinTime.mono_time _ _ _ h_a_evalsTo_g_f_a + nth_rw 1 [← add_comm] + apply add_le_add + · omega + · apply h_mono + -- Use the lemma about output length being bounded by input length + time + exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFun a) + +end + +end BinTM0 + +end Turing diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index 5aad8a38b..1c85c16d6 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -50,6 +50,18 @@ theorem ReductionSystem.MRed.single (rs : ReductionSystem Term) (h : rs.Red a b) end MultiStep +section Timed + +/-! ## Timed reductions -/ + +/-- Given a reduction system `rs` on `Term`, returns a reduction system on `Term × ℕ` +where the second component of the pair represents the number of steps taken. -/ +def Timed (rs : ReductionSystem Term) : ReductionSystem (Term × ℕ) := + { Red := fun ⟨t, n⟩ ⟨t', n'⟩ => rs.Red t t' ∧ n' = n + 1 } + +end Timed + + open Lean Elab Meta Command Term -- thank you to Kyle Miller for this: From efa68803a0e1f56c7d868daba74b2d8fdb3f1678 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Tue, 13 Jan 2026 21:34:08 -0800 Subject: [PATCH 02/95] refactor --- .../Machines/SingleTapeTuring/Basic.lean | 269 +++--------------- Cslib/Foundations/Data/OList.lean | 98 +++++++ Cslib/Foundations/Data/OTape.lean | 120 ++++++++ 3 files changed, 262 insertions(+), 225 deletions(-) create mode 100644 Cslib/Foundations/Data/OList.lean create mode 100644 Cslib/Foundations/Data/OTape.lean diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index fb9e7ab21..cf195ff18 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -6,203 +6,20 @@ Authors: Bolton Bailey module +-- TODO golf imports public import Cslib.Computability.Automata.Acceptors.Acceptor public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor public import Cslib.Foundations.Data.OmegaSequence.InfOcc +public import Cslib.Foundations.Data.OTape public import Cslib.Foundations.Semantics.ReductionSystem.Basic public import Mathlib.Algebra.Polynomial.Eval.Defs public import Mathlib.Computability.PostTuringMachine public import Mathlib.Computability.TuringMachine +@[expose] public section -namespace Turing - -/-- -List of option values that don't end with none --/ -structure OList (α : Type) where - (asList : List (Option α)) - -- The list can be empty (i.e. none), but if it is not empty, the last element is not (some) none - (h : asList.getLast? ≠ some none) - -def OList.empty {α} : OList α := { asList := [], h := by simp } - -def OList.map_some {α} (l : List α) : OList α := { asList := l.map some, h := by simp } - -instance {α : Type} : Inhabited (OList α) where - default := OList.empty - - -def OList.length {α} (l : OList α) : ℕ := l.asList.length - -def OList.cons {α} : Option α -> OList α -> OList α -| none, l => { asList := [], h := by simp } -| some a, l => { - asList := some a :: l.asList, - h := by - cases hl : l.asList with - | nil => simp - | cons hd tl => - simp only [List.getLast?_cons_cons] - rw [← hl] - exact l.h - } - -def OList.tail {α} (l : OList α) : OList α := - match hl : l.asList with - | [] => OList.empty - | hd :: t => { asList := t, h := by - match t with - | [] => simp - | hd' :: t' => - have lh := l.h - rw [hl] at lh - simp only [List.getLast?_cons_cons] at lh - have := l.h - rw [hl, List.getLast?_cons_cons] at this - exact this - } - -def OList.head {α} (l : OList α) : Option α := - match l.asList with - | [] => none - | h :: _ => h - -lemma OList.length_tail_le {α} (l : OList α) : l.tail.length ≤ l.length := by - unfold tail length - split - · simp [empty] - · next heq => simp [heq] - -lemma OList.length_cons_none {α} (l : OList α) : (OList.cons none l).length = 0 := by - simp [cons, length, empty] - -lemma OList.length_cons_some {α} (a : α) (l : OList α) : - (OList.cons (some a) l).length = l.length + 1 := by - simp [cons, length] - -lemma OList.length_cons_le {α} (o : Option α) (l : OList α) : - (OList.cons o l).length ≤ l.length + 1 := by - cases o with - | none => simp [length_cons_none] - | some a => simp [length_cons_some] - -lemma OList.length_map_some {α} (l : List α) : (OList.map_some l).length = l.length := by - simp [map_some, length] - -lemma OList.length_empty {α} : (OList.empty : OList α).length = 0 := by - simp [empty, length] - -/-- -I find this more convenient than mathlib's Tape type, -because that requires the type tobe inhabited, -and it is easy to confuse a list representing one thing with a list representing another, -if the representations are the same except for a sequence of default values at the end. - -The head of the machine is the current symbol under the tape head. -We do not assume here, but could add, that the ends of the tape are never none. -The move function should guarantee this, so that two tapes are equal -even if one has written none to the side --/ -structure OTape (α : Type) where - (head : Option α) - (left : OList α) - (right : OList α) -deriving Inhabited - -def OTape.mk₁ (l : List Bool) : OTape Bool := - match l with - | [] => { head := none, left := OList.empty, right := OList.empty } - | h :: t => { head := some h, left := OList.empty, right := OList.map_some t } - --- TODO incorrect, we must delete blanks from the ends, refactor out OList -def OTape.move {α} : Turing.OTape α → Dir → Turing.OTape α - | t, .left => - match t.left, t.head, t.right with - | l, h, r => { head := l.head, left := l.tail, right := OList.cons h r } - | t, .right => - match t.left, t.head, t.right with - | l, h, r => { head := r.head, left := OList.cons h l, right := r.tail } - - -def OTape.move? {α} : Turing.OTape α → Option Dir → Turing.OTape α - | t, none => t - | t, some d => t.move d - -def OTape.write {α} : Turing.OTape α → Option α → Turing.OTape α - | t, a => { t with head := a } - -open Classical in -noncomputable def ListBlank.space_used {α} [Inhabited α] (l : ListBlank α) : ℕ := - Nat.find (p := fun n => ∀ i > n, l.nth i = default) - (l.inductionOn (fun xs => ⟨xs.length, fun i hi => by - change (ListBlank.mk xs).nth i = default - rw [ListBlank.nth_mk] - exact List.getI_eq_default xs (Nat.le_of_lt hi)⟩)) - -/-- -The space used by a OTape is the number of symbols -between and including the head, and leftmost and rightmost non-blank symbols on the OTape --/ -noncomputable def OTape.space_used {α} [Inhabited α] (t : Turing.OTape α) : ℕ := - 1 + t.left.length + t.right.length - -lemma OTape.space_used_write {α} [Inhabited α] (t : Turing.OTape α) (a : Option α) : - (t.write a).space_used = t.space_used := by - rfl - -lemma OTape.space_used_mk₁ (l : List Bool) : - (OTape.mk₁ l).space_used = max 1 l.length := by - cases l with - | nil => - simp [mk₁, space_used, OList.length_empty] - | cons h t => - simp [mk₁, space_used, OList.length_empty, OList.length_map_some] - omega - -open Classical in -lemma ListBlank.nth_ge_space_used {α} [Inhabited α] (l : ListBlank α) (i : ℕ) - (hi : i > l.space_used) : l.nth i = default := by - unfold space_used at hi - have H : ∃ n, ∀ i > n, l.nth i = default := l.inductionOn (fun xs => ⟨xs.length, fun i hi => - (ListBlank.nth_mk xs i).symm ▸ List.getI_eq_default xs (Nat.le_of_lt hi)⟩) - have h := Nat.find_spec H - exact h i hi -open Classical in -lemma ListBlank.space_used_cons_le {α} [Inhabited α] (a : α) (l : ListBlank α) : - (l.cons a).space_used ≤ l.space_used + 1 := by - unfold space_used - apply Nat.find_le - intro i hi - cases i with - | zero => omega - | succ i => - rw [ListBlank.nth_succ, ListBlank.tail_cons] - exact ListBlank.nth_ge_space_used l i (by unfold space_used; omega) - -open Classical in -lemma ListBlank.space_used_tail_le {α} [Inhabited α] (l : ListBlank α) : - l.tail.space_used ≤ l.space_used := by - unfold space_used - apply Nat.find_le - intro i hi - rw [← ListBlank.nth_succ] - exact ListBlank.nth_ge_space_used l (i + 1) (by unfold space_used; omega) - -lemma OTape.space_used_move {α} [Inhabited α] (t : Turing.OTape α) (d : Dir) : - (t.move d).space_used ≤ t.space_used + 1 := by - cases d with - | left => - simp only [move, space_used] - have h1 := OList.length_tail_le t.left - have h2 := OList.length_cons_le t.head t.right - omega - | right => - simp only [move, space_used] - have h1 := OList.length_cons_le t.head t.left - have h2 := OList.length_tail_le t.right - omega +namespace Turing namespace BinTM0 @@ -317,7 +134,8 @@ lemma ListBlank.space_used_mk {α} [Inhabited α] (l : List α) : -- | nil => -- simp [ListBlank.space_used_mk_nil] -- | cons h t => --- simp only [List.tail_cons, List.length_cons, le_add_iff_nonneg_left, zero_le, sup_of_le_right] +-- simp only [List.tail_cons, List.length_cons, le_add_iff_nonneg_left, zero_le, +-- sup_of_le_right] -- rw [add_comm] -- simp only [Nat.add_right_cancel_iff] -- sorry @@ -551,8 +369,8 @@ structure Computable (f : List Bool → List Bool) where /-- a proof this machine outputsInTime `f` -/ outputsFun : ∀ a, - OutputsInTime tm ((a)) - (Option.some (((f a)))) + OutputsInTime tm a + (Option.some (f a)) steps /-- A Turing machine + a time function + @@ -566,9 +384,9 @@ structure ComputableInTime (f : List Bool → List Bool) where outputsFun : ∀ a, tm.OutputsWithinTime - ((a)) - (Option.some (((f a)))) - (time ( a).length) + a + (Option.some (f a)) + (time a.length) /-- A Turing machine + a polynomial time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ @@ -580,9 +398,9 @@ structure ComputableInPolyTime (f : List Bool → List Bool) where /-- proof that this machine outputsInTime `f` in at most `time(input.length)` steps -/ outputsFun : ∀ a, - OutputsWithinTime tm (( a)) - (Option.some (((f a)))) - (time.eval ( a).length) + OutputsWithinTime tm a + (Option.some (f a)) + (time.eval a.length) -- /-- A forgetful map, forgetting the time bound on the number of steps. -/ -- def ComputableInTime.toComputable {α β : Type} {ea : BinEncoding α} {eb : BinEncoding β} @@ -590,7 +408,8 @@ structure ComputableInPolyTime (f : List Bool → List Bool) where -- ⟨h.tm, fun a => OutputsWithinTime.toOutputsInTime (h.outputsFun a)⟩ /-- A forgetful map, forgetting that the time function is polynomial. -/ -def ComputableInPolyTime.toComputableInTime {f : List Bool → List Bool} (h : ComputableInPolyTime f) : +def ComputableInPolyTime.toComputableInTime {f : List Bool → List Bool} + (h : ComputableInPolyTime f) : ComputableInTime f := ⟨h.tm, fun n => h.time.eval n, h.outputsFun⟩ @@ -647,7 +466,7 @@ def ComputableInPolyTime.id : -- ⟨EvalsTo.refl _ _⟩ /-- A proof that the identity map on α is computable in time. -/ -def ComputableInTime.id : +def ComputableInTime.id : @ComputableInTime id := ComputableInPolyTime.toComputableInTime <| ComputableInPolyTime.id @@ -706,7 +525,7 @@ lemma compComputer_q₀_eq (f : List Bool → List Bool) (g : List Bool → List /-- Lift a config over a tm to a config over the comp -/ def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) + (hf : ComputableInTime f) (hg : ComputableInTime g) (cfg : hf.tm.Cfg) : (compComputer hf hg).Cfg := @@ -715,9 +534,9 @@ def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} OTape := cfg.OTape } -def liftCompCfg_right{f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) - (hg : ComputableInTime g) +def liftCompCfg_right {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : ComputableInTime f) + (hg : ComputableInTime g) (cfg : hg.tm.Cfg) : (compComputer hf hg).Cfg := { @@ -802,7 +621,7 @@ def liftCompCfg_left_or_right {f : List Bool → List Bool} {g : List Bool → L /-- The lifting function commutes with step, converting halt to transition -/ theorem map_liftCompCfg_left_or_right_step {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : ComputableInTime f) (hg : ComputableInTime g) (x : hf.tm.Cfg) (hx : x.state.isSome) : Option.map (liftCompCfg_left_or_right hf hg) (hf.tm.step x) = @@ -822,7 +641,7 @@ theorem map_liftCompCfg_left_or_right_step /-- General simulation: if the first machine goes from cfg to halt, the composed machine goes from lifted cfg to Sum.inr hg.tm.q₀ -/ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : ComputableInTime f) (hg : ComputableInTime g) (cfg : hf.tm.Cfg) (hcfg : cfg.state.isSome) (haltCfg : hf.tm.Cfg) @@ -873,25 +692,25 @@ This takes the same number of steps because the halt transition becomes a transi second machine. -/ theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : ComputableInTime f) (hg : ComputableInTime g) (a : List Bool) (hf_outputsFun : EvalsToWithinTime hf.tm.step - { state := some hf.tm.q₀, OTape := OTape.mk₁ ( a) } - (some { state := none, OTape := OTape.mk₁ ( (f a)) }) - (hf.time ( a).length)) : + { state := some hf.tm.q₀, OTape := OTape.mk₁ a } + (some { state := none, OTape := OTape.mk₁ (f a) }) + (hf.time a.length)) : EvalsToWithinTime (compComputer hf hg).step - { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ ( a) } - (some { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ ( (f a)) }) - (hf.time ( a).length) := by + { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ a } + (some { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) }) + (hf.time a.length) := by obtain ⟨steps, hsteps_le, hsteps_eval⟩ := hf_outputsFun use steps constructor · exact hsteps_le · have := comp_left_simulation_general hf hg - { state := some hf.tm.q₀, OTape := OTape.mk₁ ( a) } + { state := some hf.tm.q₀, OTape := OTape.mk₁ a } (by simp) - { state := none, OTape := OTape.mk₁ ( (f a)) } + { state := none, OTape := OTape.mk₁ (f a) } steps hsteps_eval simp only [liftCompCfg_left_or_right] at this @@ -900,7 +719,7 @@ theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → Li /-- Simulation lemma for the second machine in the composed computer -/ theorem comp_right_simulation {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : ComputableInTime f) (hg : ComputableInTime g) (x : hg.tm.Cfg) (y : Option hg.tm.Cfg) (m : ℕ) (h : EvalsToWithinTime hg.tm.step x y m) : EvalsToWithinTime (compComputer hf hg).step @@ -949,7 +768,7 @@ then from the intermediate state to the final state. -/ def ComputableInTime.comp {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) + (hf : ComputableInTime f) (hg : ComputableInTime g) (h_mono : Monotone hg.time) : (ComputableInTime (g ∘ f)) where @@ -960,23 +779,23 @@ def ComputableInTime.comp have hg_outputsFun := hg.outputsFun (f a) simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, Option.map_some, haltCfg] at hg_outputsFun hf_outputsFun ⊢ - -- The computer evals a to f a in time hf.time ( a) + -- The computer evals a to f a in time hf.time a have h_a_evalsTo_f_a : EvalsToWithinTime (compComputer hf hg).step - { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ ( a) } - (some { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ ( ((f a))) }) - (hf.time ( a).length) := + { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ a } + (some { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) }) + (hf.time a.length) := comp_left_simulation hf hg a hf_outputsFun have h_f_a_evalsTo_g_f_a : EvalsToWithinTime (compComputer hf hg).step - { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ ( ((f a))) } - (some { state := none, OTape := OTape.mk₁ ( ((g (f a)))) }) - (hg.time ( ((f a))).length) := by + { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) } + (some { state := none, OTape := OTape.mk₁ (g (f a)) }) + (hg.time (f a).length) := by -- Use the simulation lemma for the second machine have := comp_right_simulation hf hg - { state := some hg.tm.q₀, OTape := OTape.mk₁ ( (f a)) } - (some { state := none, OTape := OTape.mk₁ ( (g (f a))) }) - (hg.time ( (f a)).length) + { state := some hg.tm.q₀, OTape := OTape.mk₁ (f a) } + (some { state := none, OTape := OTape.mk₁ (g (f a)) }) + (hg.time (f a).length) hg_outputsFun simp only [liftCompCfg_right, Option.map_some] at this exact this diff --git a/Cslib/Foundations/Data/OList.lean b/Cslib/Foundations/Data/OList.lean new file mode 100644 index 000000000..c3c724ca5 --- /dev/null +++ b/Cslib/Foundations/Data/OList.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2025 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module + +public import Mathlib.Data.List.Basic + +@[expose] public section + +/-! +# OList: Lists of Options that don't end with none + +This file defines `OList`, a list of option values where the list cannot end with `none`. +This is useful for representing tape contents where trailing blanks are not stored. +-/ + +namespace Turing + +/-- +List of option values that don't end with none +-/ +structure OList (α : Type) where + (asList : List (Option α)) + -- The list can be empty (i.e. none), but if it is not empty, the last element is not (some) none + (h : asList.getLast? ≠ some none) + +def OList.empty {α} : OList α := { asList := [], h := by simp } + +def OList.map_some {α} (l : List α) : OList α := { asList := l.map some, h := by simp } + +instance {α : Type} : Inhabited (OList α) where + default := OList.empty + + +def OList.length {α} (l : OList α) : ℕ := l.asList.length + +def OList.cons {α} : Option α -> OList α -> OList α +| none, l => { asList := [], h := by simp } +| some a, l => { + asList := some a :: l.asList, + h := by + cases hl : l.asList with + | nil => simp + | cons hd tl => + simp only [List.getLast?_cons_cons] + rw [← hl] + exact l.h + } + +def OList.tail {α} (l : OList α) : OList α := + match hl : l.asList with + | [] => OList.empty + | hd :: t => { asList := t, h := by + match t with + | [] => simp + | hd' :: t' => + have lh := l.h + rw [hl] at lh + simp only [List.getLast?_cons_cons] at lh + have := l.h + rw [hl, List.getLast?_cons_cons] at this + exact this + } + +def OList.head {α} (l : OList α) : Option α := + match l.asList with + | [] => none + | h :: _ => h + +lemma OList.length_tail_le {α} (l : OList α) : l.tail.length ≤ l.length := by + unfold tail length + split + · simp [empty] + · next heq => simp [heq] + +lemma OList.length_cons_none {α} (l : OList α) : (OList.cons none l).length = 0 := by + simp [cons, length] + +lemma OList.length_cons_some {α} (a : α) (l : OList α) : + (OList.cons (some a) l).length = l.length + 1 := by + simp [cons, length] + +lemma OList.length_cons_le {α} (o : Option α) (l : OList α) : + (OList.cons o l).length ≤ l.length + 1 := by + cases o with + | none => simp [length_cons_none] + | some a => simp [length_cons_some] + +lemma OList.length_map_some {α} (l : List α) : (OList.map_some l).length = l.length := by + simp [map_some, length] + +lemma OList.length_empty {α} : (OList.empty : OList α).length = 0 := by + simp [empty, length] + +end Turing diff --git a/Cslib/Foundations/Data/OTape.lean b/Cslib/Foundations/Data/OTape.lean new file mode 100644 index 000000000..765c875d1 --- /dev/null +++ b/Cslib/Foundations/Data/OTape.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2025 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module + +public import Cslib.Foundations.Data.OList +public import Mathlib.Computability.TuringMachine + +@[expose] public section + +/-! +# OTape: Tape representation using OList + +This file defines `OTape`, a tape representation for Turing machines +in the form of an `List` of `Option` values, +with the additional property that the list cannot end with `none`. + +## Design + +Note that Mathlib has a `Tape` type, but it requires the alphabet type to be inhabited, +and considers the ends of the tape to be filled with default values. + +The design that requires the tape elements to be `Option` values ensures that +Lists of the base alphabet, rendered directly onto the tape by mapping over `some`, +will not collide. + +## Main definitions + +* `OTape`: A tape with a head symbol and left/right contents stored as `OList` +* `OTape.move`: Move the tape head left or right +* `OTape.write`: Write a symbol at the current head position +* `OTape.space_used`: The space used by the tape +-/ + +namespace Turing + +/-- +I find this more convenient than mathlib's Tape type, +because that requires the type tobe inhabited, +and it is easy to confuse a list representing one thing with a list representing another, +if the representations are the same except for a sequence of default values at the end. + +The head of the machine is the current symbol under the tape head. +We do not assume here, but could add, that the ends of the tape are never none. +The move function should guarantee this, so that two tapes are equal +even if one has written none to the side +-/ +structure OTape (α : Type) where + (head : Option α) + (left : OList α) + (right : OList α) +deriving Inhabited + +def OTape.mk₁ (l : List Bool) : OTape Bool := + match l with + | [] => { head := none, left := OList.empty, right := OList.empty } + | h :: t => { head := some h, left := OList.empty, right := OList.map_some t } + +def OTape.move {α} : Turing.OTape α → Dir → Turing.OTape α + | t, .left => + match t.left, t.head, t.right with + | l, h, r => { head := l.head, left := l.tail, right := OList.cons h r } + | t, .right => + match t.left, t.head, t.right with + | l, h, r => { head := r.head, left := OList.cons h l, right := r.tail } + + +def OTape.move? {α} : Turing.OTape α → Option Dir → Turing.OTape α + | t, none => t + | t, some d => t.move d + +def OTape.write {α} : Turing.OTape α → Option α → Turing.OTape α + | t, a => { t with head := a } + +open Classical in +noncomputable def ListBlank.space_used {α} [Inhabited α] (l : ListBlank α) : ℕ := + Nat.find (p := fun n => ∀ i > n, l.nth i = default) + (l.inductionOn (fun xs => ⟨xs.length, fun i hi => by + change (ListBlank.mk xs).nth i = default + rw [ListBlank.nth_mk] + exact List.getI_eq_default xs (Nat.le_of_lt hi)⟩)) + +/-- +The space used by a OTape is the number of symbols +between and including the head, and leftmost and rightmost non-blank symbols on the OTape +-/ +noncomputable def OTape.space_used {α} [Inhabited α] (t : Turing.OTape α) : ℕ := + 1 + t.left.length + t.right.length + +lemma OTape.space_used_write {α} [Inhabited α] (t : Turing.OTape α) (a : Option α) : + (t.write a).space_used = t.space_used := by + rfl + +lemma OTape.space_used_mk₁ (l : List Bool) : + (OTape.mk₁ l).space_used = max 1 l.length := by + cases l with + | nil => + simp [mk₁, space_used, OList.length_empty] + | cons h t => + simp [mk₁, space_used, OList.length_empty, OList.length_map_some] + omega + +lemma OTape.space_used_move {α} [Inhabited α] (t : Turing.OTape α) (d : Dir) : + (t.move d).space_used ≤ t.space_used + 1 := by + cases d with + | left => + simp only [move, space_used] + have h1 := OList.length_tail_le t.left + have h2 := OList.length_cons_le t.head t.right + omega + | right => + simp only [move, space_used] + have h1 := OList.length_cons_le t.head t.left + have h2 := OList.length_tail_le t.right + omega + +end Turing From 946f4a385edd04bcf812bf23d0841d2e083b9e52 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Tue, 13 Jan 2026 21:38:36 -0800 Subject: [PATCH 03/95] remove listblank content --- .../Machines/SingleTapeTuring/Basic.lean | 104 ++++-------------- Cslib/Foundations/Data/OTape.lean | 8 -- 2 files changed, 20 insertions(+), 92 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index cf195ff18..ab463813f 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -105,41 +105,6 @@ def ReductionSystem (tm : BinTM0) : Cslib.ReductionSystem (tm.Cfg) := noncomputable def Cfg.space_used (tm : BinTM0) (cfg : tm.Cfg) : ℕ := cfg.OTape.space_used -open Classical in -lemma ListBlank.space_used_mk_nil {α} [Inhabited α] : - (ListBlank.mk ([] : List α)).space_used = 0 := by - unfold ListBlank.space_used - rw [Nat.find_eq_zero] - intro i hi - rw [ListBlank.nth_mk] - exact List.getI_nil i - --- Helper lemma for space_used of a ListBlank created from a list -open Classical in -lemma ListBlank.space_used_mk {α} [Inhabited α] (l : List α) : - (ListBlank.mk l).space_used ≤ l.length := by - unfold ListBlank.space_used - apply Nat.find_le - intro i hi - rw [ListBlank.nth_mk] - exact List.getI_eq_default l (Nat.le_of_lt hi) - --- /-- The space_used of a OTape created from a list --- equals the maximum of 1 and the list length -/ --- lemma OTape.space_used_mk₁ {α} [Inhabited α] (l : List α) : --- (OTape.mk₁ l).space_used = max 1 l.length := by --- unfold OTape.mk₁ OTape.mk₂ OTape.mk' OTape.space_used --- simp only [ListBlank.space_used_mk_nil, add_zero, ListBlank.tail_mk] --- cases l with --- | nil => --- simp [ListBlank.space_used_mk_nil] --- | cons h t => --- simp only [List.tail_cons, List.length_cons, le_add_iff_nonneg_left, zero_le, --- sup_of_le_right] --- rw [add_comm] --- simp only [Nat.add_right_cancel_iff] --- sorry - lemma Cfg.space_used_initCfg (tm : BinTM0) (s : List Bool) : (tm.initCfg s).space_used = max 1 s.length := by simp [initCfg, Cfg.space_used, OTape.space_used_mk₁] @@ -149,28 +114,17 @@ lemma Cfg.space_used_haltCfg (tm : BinTM0) (s : List Bool) : simp [haltCfg, Cfg.space_used, OTape.space_used_mk₁] lemma Cfg.space_used_step {tm : BinTM0} (cfg cfg' : tm.Cfg) - (hstep : tm.step cfg = some cfg') : - cfg'.space_used ≤ cfg.space_used + 1 := by - unfold Cfg.space_used - cases cfg with | mk state tape => - cases state with - | none => simp [step] at hstep - | some q => - simp only [step] at hstep + (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + 1 := by + obtain ⟨_ | q, tape⟩ := cfg + · simp [step] at hstep + · simp only [step] at hstep generalize hM : tm.M q tape.head = result at hstep obtain ⟨⟨wr, dir⟩, q''⟩ := result - simp only at hstep - cases hstep - cases dir with - | none => - simp only [OTape.move?] - rw [OTape.space_used_write] - omega + cases hstep; cases dir with + | none => simp [Cfg.space_used, OTape.move?, OTape.space_used_write] | some d => - simp only [OTape.move?] - have h1 := OTape.space_used_move (tape.write wr) d - rw [OTape.space_used_write] at h1 - exact h1 + have := OTape.space_used_move (tape.write wr) d + simp only [Cfg.space_used, OTape.move?, OTape.space_used_write] at this ⊢; exact this /-- `f` eventually reaches `b` when repeatedly evaluated on `a`, in exactly `steps` steps. -/ def EvalsToInTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (steps : ℕ) : Prop := @@ -183,43 +137,25 @@ lemma EvalsToInTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : EvalsToI /-- Transitivity of `EvalsTo` in the sum of the numbers of steps. -/ @[trans] lemma EvalsToInTime.trans {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (c : Option σ) - (steps₁ steps₂ : ℕ) - (h₁ : EvalsToInTime f a b steps₁) - (h₂ : EvalsToInTime f b c steps₂) : + (steps₁ steps₂ : ℕ) (h₁ : EvalsToInTime f a b steps₁) (h₂ : EvalsToInTime f b c steps₂) : EvalsToInTime f a c (steps₂ + steps₁) := by - simp_all only [EvalsToInTime, Option.bind_eq_bind] - rw [Function.iterate_add_apply, h₁, h₂] + simp only [EvalsToInTime] at *; rw [Function.iterate_add_apply, h₁, h₂] /-- If we evaluate to some state in n+1 steps, there is an intermediate state that we reach in n steps, and then one more step reaches the final state. -/ lemma EvalsToInTime.succ_decompose {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (n : ℕ) (h : EvalsToInTime f a (some b) (n + 1)) : ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := by - set c' := (· >>= f)^[n] (some a) with hc' - simp only [EvalsToInTime, Option.bind_eq_bind] at h hc' ⊢ - rw [Function.iterate_succ_apply'] at h - -- h : (· >>= f) ((· >>= f)^[n] (some a)) = some b - -- This means (· >>= f)^[n] (some a) >>= f = some b - -- So (· >>= f)^[n] (some a) = some c for some c with f c = some b - rw [<-hc'] at h - revert h hc' - cases c' with - | none => - grind - | some c => - intros h hc' - use c - grind - -lemma EvalsToInTime.succ_iff {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) - (n : ℕ) : - EvalsToInTime f a (some b) (n + 1) ↔ - ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := by - constructor - · exact EvalsToInTime.succ_decompose f a b n - · intro ⟨c, hc_eval, hc_step⟩ - simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_succ_apply'] at hc_eval ⊢ - simp only [hc_eval, Option.bind_some, hc_step] + simp only [EvalsToInTime, Function.iterate_succ_apply'] at h + match hc' : (· >>= f)^[n] (some a) with + | none => simp_all + | some c => exact ⟨c, hc', by simp_all⟩ + +lemma EvalsToInTime.succ_iff {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (n : ℕ) : + EvalsToInTime f a (some b) (n + 1) ↔ ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := + ⟨succ_decompose f a b n, fun ⟨_, hc_eval, hc_step⟩ => by + simp only [EvalsToInTime, Function.iterate_succ_apply'] at hc_eval ⊢; + rw [hc_eval]; exact hc_step⟩ theorem Turing.BinTM0.EvalsToInTime.congr.extracted_1_2.{u_2, u_1} {σ : Type u_1} {σ' : Type u_2} (f : σ → Option σ) diff --git a/Cslib/Foundations/Data/OTape.lean b/Cslib/Foundations/Data/OTape.lean index 765c875d1..f2c092136 100644 --- a/Cslib/Foundations/Data/OTape.lean +++ b/Cslib/Foundations/Data/OTape.lean @@ -75,14 +75,6 @@ def OTape.move? {α} : Turing.OTape α → Option Dir → Turing.OTape α def OTape.write {α} : Turing.OTape α → Option α → Turing.OTape α | t, a => { t with head := a } -open Classical in -noncomputable def ListBlank.space_used {α} [Inhabited α] (l : ListBlank α) : ℕ := - Nat.find (p := fun n => ∀ i > n, l.nth i = default) - (l.inductionOn (fun xs => ⟨xs.length, fun i hi => by - change (ListBlank.mk xs).nth i = default - rw [ListBlank.nth_mk] - exact List.getI_eq_default xs (Nat.le_of_lt hi)⟩)) - /-- The space used by a OTape is the number of symbols between and including the head, and leftmost and rightmost non-blank symbols on the OTape From 0c3b4325cc4ba14cad82b4f126b59c589b458f2d Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 10:16:08 -0800 Subject: [PATCH 04/95] clean up --- .gitignore | 1 + .../Machines/SingleTapeTuring/Basic.lean | 374 +++++------------- .../Semantics/ReductionSystem/Basic.lean | 211 +++++++++- 3 files changed, 302 insertions(+), 284 deletions(-) diff --git a/.gitignore b/.gitignore index 94f4582bb..85b216ae8 100644 --- a/.gitignore +++ b/.gitignore @@ -14,3 +14,4 @@ /docs/Std-manifest.json.hash /docs/Std-manifest.json.trace .DS_Store +.claude diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index ab463813f..b95473a18 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -1,23 +1,33 @@ /- Copyright (c) 2025 Bolton Bailey. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bolton Bailey +Authors: Bolton Bailey TODO add the authors of the mathlib file this is based on -/ module --- TODO golf imports -public import Cslib.Computability.Automata.Acceptors.Acceptor -public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor -public import Cslib.Foundations.Data.OmegaSequence.InfOcc public import Cslib.Foundations.Data.OTape public import Cslib.Foundations.Semantics.ReductionSystem.Basic public import Mathlib.Algebra.Polynomial.Eval.Defs -public import Mathlib.Computability.PostTuringMachine -public import Mathlib.Computability.TuringMachine @[expose] public section +/-! +# Single-Tape Turing Machine + +Defines a single-tape Turing machine over the alphabet of `Option Bool`, +where `none` represents a blank OTape symbol. + +## TODOs + +- Generalize Bool to an arbitrary (finite?) alphabet +- switch transition system to use the `ReductionSystem` framework +- refactor polynomial time to another file +- remove unfold + +-/ + +open Cslib namespace Turing @@ -99,7 +109,7 @@ which maps a configuration to its next configuration if it exists. -/ def ReductionSystem (tm : BinTM0) : Cslib.ReductionSystem (tm.Cfg) := { Red := fun cfg cfg' => tm.step cfg = some cfg' } --- TODO use this, rather than the current setup +-- TODO use this, rather than the current setup, or better yet an LTS? noncomputable def Cfg.space_used (tm : BinTM0) (cfg : tm.Cfg) : ℕ := @@ -126,155 +136,6 @@ lemma Cfg.space_used_step {tm : BinTM0} (cfg cfg' : tm.Cfg) have := OTape.space_used_move (tape.write wr) d simp only [Cfg.space_used, OTape.move?, OTape.space_used_write] at this ⊢; exact this -/-- `f` eventually reaches `b` when repeatedly evaluated on `a`, in exactly `steps` steps. -/ -def EvalsToInTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (steps : ℕ) : Prop := - (· >>= f)^[steps] a = b - -/-- Reflexivity of `EvalsTo` in 0 steps. -/ -lemma EvalsToInTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : EvalsToInTime f a (some a) 0 := - rfl - -/-- Transitivity of `EvalsTo` in the sum of the numbers of steps. -/ -@[trans] -lemma EvalsToInTime.trans {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (c : Option σ) - (steps₁ steps₂ : ℕ) (h₁ : EvalsToInTime f a b steps₁) (h₂ : EvalsToInTime f b c steps₂) : - EvalsToInTime f a c (steps₂ + steps₁) := by - simp only [EvalsToInTime] at *; rw [Function.iterate_add_apply, h₁, h₂] - -/-- If we evaluate to some state in n+1 steps, there is an intermediate state - that we reach in n steps, and then one more step reaches the final state. -/ -lemma EvalsToInTime.succ_decompose {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) - (n : ℕ) (h : EvalsToInTime f a (some b) (n + 1)) : - ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := by - simp only [EvalsToInTime, Function.iterate_succ_apply'] at h - match hc' : (· >>= f)^[n] (some a) with - | none => simp_all - | some c => exact ⟨c, hc', by simp_all⟩ - -lemma EvalsToInTime.succ_iff {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (n : ℕ) : - EvalsToInTime f a (some b) (n + 1) ↔ ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := - ⟨succ_decompose f a b n, fun ⟨_, hc_eval, hc_step⟩ => by - simp only [EvalsToInTime, Function.iterate_succ_apply'] at hc_eval ⊢; - rw [hc_eval]; exact hc_step⟩ - -theorem Turing.BinTM0.EvalsToInTime.congr.extracted_1_2.{u_2, u_1} - {σ : Type u_1} {σ' : Type u_2} (f : σ → Option σ) - (f' : σ' → Option σ') (g : σ → σ') - (hg : ∀ (x : σ), Option.map g (f x) = f' (g x)) (n : ℕ) (a : σ) : - (Option.map g ((flip Option.bind f)^[n] (some a))).bind f' = - ((flip Option.bind f)^[n] (some a)).bind fun a ↦ f' (g a) := by - induction n with - | zero => simp - | succ n ih => - simp only [Function.iterate_succ_apply, flip, Option.bind_some, <- hg] at ih ⊢ - grind - - - - - -/-- -If `f` is homomorphic to `f'` via `g`, then if `f` evals to `b` from `a` in `steps` steps, -then `f'` evals to `g b` from `g a` in `steps` steps. --/ -lemma EvalsToInTime.map {σ σ' : Type*} (f : σ → Option σ) (f' : σ' → Option σ') - (g : σ → σ') (hg : ∀ x, Option.map g (f x) = f' (g x)) - (a : σ) (b : Option σ) - (steps : ℕ) - (h : EvalsToInTime f a b steps) : EvalsToInTime f' (g a) (Option.map g b) steps := by - induction steps generalizing a b with - | zero => - simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_zero, id_eq] at h ⊢ - subst h - rfl - | succ n ih => - simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_succ_apply', - forall_eq'] at h ih ⊢ - subst h - rw [ih] - clear ih - simp only [Option.map_bind, Function.comp_apply, hg] - exact Turing.BinTM0.EvalsToInTime.congr.extracted_1_2 f f' g hg n a - -/-- -If `h : σ → ℕ` increases by at most 1 on each step of `f`, -then the value of `h` at the output after `steps` steps is at most `h` at the input plus `steps`. --/ -lemma EvalsToInTime.small_change {σ : Type*} (f : σ → Option σ) (h : σ → ℕ) - (h_step : ∀ a b, f a = some b → h b ≤ h a + 1) - (a : σ) (b : σ) - (steps : ℕ) - (hevals : EvalsToInTime f a b steps) : - h b ≤ h a + steps := by - induction steps generalizing a b with - | zero => - simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_zero, id_eq, Option.some.injEq, - add_zero] at hevals ⊢ - subst hevals - exact Nat.le_refl (h a) - | succ n ih => - rw [EvalsToInTime.succ_iff] at hevals - obtain ⟨c, hevals_n, h_step_eq⟩ := hevals - specialize ih a c hevals_n - specialize h_step c b h_step_eq - omega - - --- m -> step_bound -/-- `f` eventually reaches `b` in at most `m` steps when repeatedly -evaluated on `a`. -/ -def EvalsToWithinTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (m : ℕ) : Prop := - ∃ steps ≤ m, EvalsToInTime f a b steps - -/-- Reflexivity of `EvalsToWithinTime` in 0 steps. -/ -def EvalsToWithinTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : - EvalsToWithinTime f a (some a) 0 := by - use 0 - exact if_false_right.mp rfl - -/-- Transitivity of `EvalsToWithinTime` in the sum of the numbers of steps. -/ -@[trans] -def EvalsToWithinTime.trans {σ : Type*} (f : σ → Option σ) (m₁ : ℕ) (m₂ : ℕ) (a : σ) (b : σ) - (c : Option σ) (h₁ : EvalsToWithinTime f a b m₁) (h₂ : EvalsToWithinTime f b c m₂) : - EvalsToWithinTime f a c (m₂ + m₁) := by - obtain ⟨steps₁, hsteps₁, hevals₁⟩ := h₁ - obtain ⟨steps₂, hsteps₂, hevals₂⟩ := h₂ - use steps₂ + steps₁ - constructor - · omega - · exact EvalsToInTime.trans f a b c steps₁ steps₂ hevals₁ hevals₂ - -def EvalsToWithinTime.map {σ σ' : Type*} (f : σ → Option σ) (f' : σ' → Option σ') - (g : σ → σ') (hg : ∀ x, Option.map g (f x) = f' (g x)) - (a : σ) (b : Option σ) - (m : ℕ) - (h : EvalsToWithinTime f a b m) : EvalsToWithinTime f' (g a) (Option.map g b) m := by - obtain ⟨steps, hsteps, hevals⟩ := h - use steps - constructor - · exact hsteps - · exact EvalsToInTime.map f f' g hg a b steps hevals - -/-- -Monotonicity of `EvalsToWithinTime` in the time bound. --/ -def EvalsToWithinTime.mono_time {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) - {m₁ m₂ : ℕ} (h : EvalsToWithinTime f a b m₁) (hm : m₁ ≤ m₂) : EvalsToWithinTime f a b m₂ := by - obtain ⟨steps, hsteps, hevals⟩ := h - use steps - simp_all only - simp - omega - -lemma EvalsToWithinTime.small_change {σ : Type*} (f : σ → Option σ) (h : σ → ℕ) - (h_step : ∀ a b, f a = some b → h b ≤ h a + 1) - (a : σ) (b : σ) - (m : ℕ) - (hevals : EvalsToWithinTime f a (some b) m) : - h b ≤ h a + m := by - obtain ⟨steps, hsteps, hevals_steps⟩ := hevals - have := EvalsToInTime.small_change f h h_step a b steps hevals_steps - omega /-- A proof of tm outputting l' when given l. -/ def OutputsInTime (tm : BinTM0) (l : List (Bool)) (l' : Option (List (Bool))) := @@ -285,18 +146,6 @@ def OutputsWithinTime (tm : BinTM0) (l : List (Bool)) (l' : Option (List (Bool)) (m : ℕ) := EvalsToWithinTime tm.step (initCfg tm l) ((Option.map (haltCfg tm)) l') m --- /-- A (bundled TM0) Turing machine --- with input alphabet equivalent to `Γ₀` and output alphabet equivalent to `Γ₁`. --- TODO this is something of a holdover, might get rid --- -/ --- structure ComputableAux (Γ₀ Γ₁ : Type) where --- /-- the underlying bundled TM0 -/ --- tm : BinTM0 --- /-- the input alphabet is equivalent to `Γ₀` -/ --- inputAlphabet : Bool ≃ Γ₀ --- /-- the output alphabet is equivalent to `Γ₁` -/ --- outputAlphabet : Bool ≃ Γ₁ - /-- A Turing machine + a proof it outputsInTime `f`. -/ structure Computable (f : List Bool → List Bool) where /-- the underlying bundled TM0 -/ @@ -311,7 +160,7 @@ structure Computable (f : List Bool → List Bool) where /-- A Turing machine + a time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ -structure ComputableInTime (f : List Bool → List Bool) where +structure TimeComputable (f : List Bool → List Bool) where /-- the underlying bundled TM0 -/ tm : BinTM0 /-- a time function -/ @@ -324,33 +173,6 @@ structure ComputableInTime (f : List Bool → List Bool) where (Option.some (f a)) (time a.length) -/-- A Turing machine + a polynomial time function + -a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ -structure ComputableInPolyTime (f : List Bool → List Bool) where - /-- the underlying bundled TM0 -/ - tm : BinTM0 - /-- a polynomial time function -/ - time : Polynomial ℕ - /-- proof that this machine outputsInTime `f` in at most `time(input.length)` steps -/ - outputsFun : - ∀ a, - OutputsWithinTime tm a - (Option.some (f a)) - (time.eval a.length) - --- /-- A forgetful map, forgetting the time bound on the number of steps. -/ --- def ComputableInTime.toComputable {α β : Type} {ea : BinEncoding α} {eb : BinEncoding β} --- {f : α → β} (h : ComputableInTime ea eb f) : Computable ea eb f := --- ⟨h.tm, fun a => OutputsWithinTime.toOutputsInTime (h.outputsFun a)⟩ - -/-- A forgetful map, forgetting that the time function is polynomial. -/ -def ComputableInPolyTime.toComputableInTime {f : List Bool → List Bool} - (h : ComputableInPolyTime f) : - ComputableInTime f := - ⟨h.tm, fun n => h.time.eval n, h.outputsFun⟩ - -open Turing.TM0.Stmt - /-- A Turing machine computing the identity. -/ def idComputer : BinTM0 where Λ := PUnit @@ -359,71 +181,19 @@ def idComputer : BinTM0 where noncomputable section -/-- A proof that the identity map on α is computable in polytime. -/ -def ComputableInPolyTime.id : - @ComputableInPolyTime id where - tm := idComputer - time := 1 - outputsFun x := by +/-- A proof that the identity map on α is computable in time. -/ +def TimeComputable.id : + @TimeComputable id := + ⟨idComputer, fun _ => 1, fun x => by use 1 - simp only [Polynomial.eval_one, le_refl, id_eq, Option.map_some, true_and] + simp only [le_refl, id_eq, Option.map_some, true_and] simp only [EvalsToInTime, initCfg, haltCfg, idComputer, Function.iterate_succ, Function.iterate_zero, Function.comp_apply, id_eq] - congr 1 - - - -- { steps := 1 - -- evals_in_steps := rfl - -- steps_le_m := by simp only [Polynomial.eval_one, le_refl] } - --- instance inhabitedComputableInPolyTime : --- Inhabited (ComputableInPolyTime (default : BinEncoding Bool) default id) := --- ⟨idComputableInPolyTime Computability.inhabitedBinEncoding.default⟩ - --- instance inhabitedOutputsWithinTime : --- Inhabited --- (OutputsWithinTime (idComputer finEncodingBoolBool) --- (List.map (Equiv.cast rfl).invFun [false]) --- (some (List.map (Equiv.cast rfl).invFun [false])) (Polynomial.eval 1 1)) := --- ⟨(idComputableInPolyTime finEncodingBoolBool).outputsFun false⟩ - --- instance inhabitedOutputsInTime : --- Inhabited --- (OutputsInTime (idComputer finEncodingBoolBool) (List.map (Equiv.cast rfl).invFun [false]) --- (some (List.map (Equiv.cast rfl).invFun [false]))) := --- ⟨OutputsWithinTime.toOutputsInTime Turing.inhabitedOutputsWithinTime.default⟩ - --- instance inhabitedEvalsToWithinTime : --- Inhabited (EvalsToWithinTime (fun _ : Unit => some ⟨⟩) ⟨⟩ (some ⟨⟩) 0) := --- ⟨EvalsToWithinTime.refl _ _⟩ - --- instance inhabitedTM0EvalsToInTime : --- Inhabited (EvalsToInTime (fun _ : Unit => some ⟨⟩) ⟨⟩ (some ⟨⟩)) := --- ⟨EvalsTo.refl _ _⟩ - -/-- A proof that the identity map on α is computable in time. -/ -def ComputableInTime.id : - @ComputableInTime id := - ComputableInPolyTime.toComputableInTime <| ComputableInPolyTime.id - --- instance inhabitedComputableInTime : --- Inhabited (ComputableInTime finEncodingBoolBool finEncodingBoolBool id) := --- ⟨idComputableInTime Computability.inhabitedBinEncoding.default⟩ - --- /-- A proof that the identity map on α is computable. -/ --- def idComputable {α : Type} (ea : BinEncoding α) : @Computable α α ea ea id := --- ComputableInTime.toComputable <| ComputableInTime.id ea - --- instance inhabitedComputable : --- Inhabited (Computable finEncodingBoolBool finEncodingBoolBool id) := --- ⟨idComputable Computability.inhabitedBinEncoding.default⟩ - --- instance inhabitedComputableAux : Inhabited (ComputableAux Bool Bool) := --- ⟨(default : Computable finEncodingBoolBool finEncodingBoolBool id).toComputableAux⟩ + congr 1⟩ def compComputer {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) - (hg : ComputableInTime g) : + (hf : TimeComputable f) + (hg : TimeComputable g) : BinTM0 := { Λ := hf.tm.Λ ⊕ hg.tm.Λ @@ -454,15 +224,15 @@ def compComputer {f : List Bool → List Bool} {g : List Bool → List Bool} } lemma compComputer_q₀_eq (f : List Bool → List Bool) (g : List Bool → List Bool) - (hf : ComputableInTime f) - (hg : ComputableInTime g) : + (hf : TimeComputable f) + (hg : TimeComputable g) : (compComputer hf hg).q₀ = Sum.inl hf.tm.q₀ := rfl /-- Lift a config over a tm to a config over the comp -/ def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) - (hg : ComputableInTime g) + (hf : TimeComputable f) + (hg : TimeComputable g) (cfg : hf.tm.Cfg) : (compComputer hf hg).Cfg := { @@ -471,8 +241,8 @@ def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} } def liftCompCfg_right {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) - (hg : ComputableInTime g) + (hf : TimeComputable f) + (hg : TimeComputable g) (cfg : hg.tm.Cfg) : (compComputer hf hg).Cfg := { @@ -482,7 +252,7 @@ def liftCompCfg_right {f : List Bool → List Bool} {g : List Bool → List Bool theorem map_liftCompCfg_left_step {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : TimeComputable f) (hg : TimeComputable g) (x : hf.tm.Cfg) (hx : ∀ cfg, hf.tm.step x = some cfg → cfg.state.isSome) : Option.map (liftCompCfg_left hf hg) (hf.tm.step x) = @@ -513,7 +283,7 @@ theorem map_liftCompCfg_left_step /-- Helper lemma: liftCompCfg_right commutes with step for the second machine -/ theorem map_liftCompCfg_right_step {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : TimeComputable f) (hg : TimeComputable g) (x : hg.tm.Cfg) : Option.map (liftCompCfg_right hf hg) (hg.tm.step x) = (compComputer hf hg).step (liftCompCfg_right hf hg x) := by @@ -532,7 +302,7 @@ theorem map_liftCompCfg_right_step /-- When the first machine would halt, the composed machine transitions to the second machine -/ theorem comp_transition_to_right {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : TimeComputable f) (hg : TimeComputable g) (tp : OTape (Bool)) (q : hf.tm.Λ) (hM : (hf.tm.M q tp.head).2 = none) : @@ -546,8 +316,8 @@ theorem comp_transition_to_right {f : List Bool → List Bool} {g : List Bool /-- Helper: lifting to Sum.inl and transitioning to Sum.inr on halt -/ def liftCompCfg_left_or_right {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) - (hg : ComputableInTime g) + (hf : TimeComputable f) + (hg : TimeComputable g) (cfg : hf.tm.Cfg) : (compComputer hf hg).Cfg := match cfg.state with @@ -557,7 +327,7 @@ def liftCompCfg_left_or_right {f : List Bool → List Bool} {g : List Bool → L /-- The lifting function commutes with step, converting halt to transition -/ theorem map_liftCompCfg_left_or_right_step {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : TimeComputable f) (hg : TimeComputable g) (x : hf.tm.Cfg) (hx : x.state.isSome) : Option.map (liftCompCfg_left_or_right hf hg) (hf.tm.step x) = @@ -577,7 +347,7 @@ theorem map_liftCompCfg_left_or_right_step /-- General simulation: if the first machine goes from cfg to halt, the composed machine goes from lifted cfg to Sum.inr hg.tm.q₀ -/ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) (hcfg : cfg.state.isSome) (haltCfg : hf.tm.Cfg) @@ -628,7 +398,7 @@ This takes the same number of steps because the halt transition becomes a transi second machine. -/ theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : TimeComputable f) (hg : TimeComputable g) (a : List Bool) (hf_outputsFun : EvalsToWithinTime hf.tm.step @@ -655,7 +425,7 @@ theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → Li /-- Simulation lemma for the second machine in the composed computer -/ theorem comp_right_simulation {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) (hg : ComputableInTime g) + (hf : TimeComputable f) (hg : TimeComputable g) (x : hg.tm.Cfg) (y : Option hg.tm.Cfg) (m : ℕ) (h : EvalsToWithinTime hg.tm.step x y m) : EvalsToWithinTime (compComputer hf hg).step @@ -682,7 +452,7 @@ lemma output_length_le_input_length_add_time (tm : BinTM0) (l l' : List Bool) (t omega /-- -A composition for ComputableInTime. +A composition for TimeComputable. If f and g are computed by turing machines M₁ and M₂ then we can construct a turing machine M which computes g ∘ f by first running M₁ @@ -702,12 +472,12 @@ Prove separately that it evals to the intermediate state from the start state and then from the intermediate state to the final state. -/ -def ComputableInTime.comp +def TimeComputable.comp {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : ComputableInTime f) - (hg : ComputableInTime g) + (hf : TimeComputable f) + (hg : TimeComputable g) (h_mono : Monotone hg.time) : - (ComputableInTime (g ∘ f)) where + (TimeComputable (g ∘ f)) where tm := compComputer hf hg time l := (hf.time l) + hg.time (max 1 l + hf.time l) outputsFun a := by @@ -748,6 +518,56 @@ def ComputableInTime.comp end +/-! +## Polynomial Time Computability + +This section defines polynomial time computable functions on Turing machines. +-/ + +section PolyTime + +/-- A Turing machine + a polynomial time function + +a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ +structure PolyTimeComputable (f : List Bool → List Bool) extends TimeComputable f where + /-- a polynomial time bound -/ + poly : Polynomial ℕ + /-- proof that this machine outputsInTime `f` in at most `time(input.length)` steps -/ + bounds : ∀ n, time n ≤ poly.eval n + +/-- A proof that the identity map on α is computable in polytime. -/ +noncomputable def PolyTimeComputable.id : @PolyTimeComputable id where + toTimeComputable := TimeComputable.id + poly := 1 + bounds n := by simp only [TimeComputable.id, Polynomial.eval_one, le_refl] + +/-- +A proof that the composition of two polytime computable functions is polytime computable. +-/ +noncomputable def PolyTimeComputable.comp + {f : List Bool → List Bool} {g : List Bool → List Bool} + (hf : PolyTimeComputable f) + (hg : PolyTimeComputable g) + -- all Nat polynomials are monotone, but the tighter internal bound maybe is not + (h_mono : Monotone hg.time) : + PolyTimeComputable (g ∘ f) where + toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono + + poly := hf.poly + hg.poly.comp (1 + Polynomial.X + hf.poly) + bounds n := by + simp only [TimeComputable.comp, Polynomial.eval_add, Polynomial.eval_comp, Polynomial.eval_X, + Polynomial.eval_one] + apply add_le_add + · exact hf.bounds n + · have : hg.time (max 1 n + hf.time n) ≤ hg.time (1 + n + hf.poly.eval n) := by + apply h_mono + apply add_le_add + · omega + · exact hf.bounds n + apply le_trans this _ + exact hg.bounds (1 + n + hf.poly.eval n) + +end PolyTime + end BinTM0 end Turing diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index 1c85c16d6..02d65ef22 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -10,6 +10,9 @@ public import Cslib.Init public import Mathlib.Logic.Relation public import Mathlib.Util.Notation3 +-- TODO remove this import +public import Mathlib.Algebra.Polynomial.Eval.Defs + @[expose] public section /-! @@ -29,6 +32,11 @@ structure ReductionSystem (Term : Type u) where /-- The reduction relation. -/ Red : Term → Term → Prop +structure TerminalReductionSystem (Term : Type u) extends ReductionSystem Term where + /-- The terminal terms. -/ + Terminal : Term → Prop + /-- A terminal term cannot be further reduced. -/ + terminal_not_reducible : ∀ t t', Terminal t → ¬ Red t t' section MultiStep @@ -50,17 +58,206 @@ theorem ReductionSystem.MRed.single (rs : ReductionSystem Term) (h : rs.Red a b) end MultiStep -section Timed +section Steps + +inductive ReductionSystem.reducesToInSteps + (rs : ReductionSystem Term) : Term → Term → ℕ → Prop + | refl (t : Term) : reducesToInSteps rs t t 0 + | cons (t t' t'' : Term) (n : ℕ) (h₁ : rs.Red t t') (h₂ : reducesToInSteps rs t' t'' n) : + reducesToInSteps rs t t'' (n + 1) + +lemma ReductionSystem.reducesToInSteps.trans {rs : ReductionSystem Term} {a b c : Term} {n m : ℕ} + (h₁ : reducesToInSteps rs a b n) (h₂ : reducesToInSteps rs b c m) : + reducesToInSteps rs a c (n + m) := by + sorry + +lemma ReductionSystem.reducesToInSteps.succ {rs : ReductionSystem Term} {a b : Term} {n : ℕ} + (h : reducesToInSteps rs a b (n + 1)) : + ∃ t', rs.Red a t' ∧ reducesToInSteps rs t' b n := by + sorry + +-- TODO iff + +lemma ReductionSystem.reducesToInSteps.succ' {rs : ReductionSystem Term} {a b : Term} {n : ℕ} + (h : reducesToInSteps rs a b (n + 1)) : + ∃ t', reducesToInSteps rs a t' n ∧ rs.Red t' b := by + sorry + +-- TODO iff + +end Steps + +/-- +Given a map σ → Option σ, we can construct a terminal reduction system on `σ` +where a term is terminal if it maps to `none` under the given function. +and otherwise is reducible to its `some` value under the given function. +-/ +def TerminalReductionSystem.Option {σ : Type*} (f : σ → Option σ) : TerminalReductionSystem σ where + Red := fun a b => f a = some b + Terminal := fun a => f a = none + terminal_not_reducible := by + intros t t' h_terminal h_red + simp [h_terminal] at h_red + + +-- TODO refactor the contents of this section into ReductionSystem +-- then delete them +section EvalsToJunk + + + +/-- `f` eventually reaches `b` when repeatedly evaluated on `a`, in exactly `steps` steps. -/ +def EvalsToInTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (steps : ℕ) : Prop := + (· >>= f)^[steps] a = b + +/-- Reflexivity of `EvalsTo` in 0 steps. -/ +lemma EvalsToInTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : EvalsToInTime f a (some a) 0 := + rfl + +/-- Transitivity of `EvalsTo` in the sum of the numbers of steps. -/ +@[trans] +lemma EvalsToInTime.trans {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (c : Option σ) + (steps₁ steps₂ : ℕ) (h₁ : EvalsToInTime f a b steps₁) (h₂ : EvalsToInTime f b c steps₂) : + EvalsToInTime f a c (steps₂ + steps₁) := by + simp only [EvalsToInTime] at *; rw [Function.iterate_add_apply, h₁, h₂] + +/-- If we evaluate to some state in n+1 steps, there is an intermediate state + that we reach in n steps, and then one more step reaches the final state. -/ +lemma EvalsToInTime.succ_decompose {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) + (n : ℕ) (h : EvalsToInTime f a (some b) (n + 1)) : + ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := by + simp only [EvalsToInTime, Function.iterate_succ_apply'] at h + match hc' : (· >>= f)^[n] (some a) with + | none => simp_all + | some c => exact ⟨c, hc', by simp_all⟩ -/-! ## Timed reductions -/ +lemma EvalsToInTime.succ_iff {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (n : ℕ) : + EvalsToInTime f a (some b) (n + 1) ↔ ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := + ⟨succ_decompose f a b n, fun ⟨_, hc_eval, hc_step⟩ => by + simp only [EvalsToInTime, Function.iterate_succ_apply'] at hc_eval ⊢; + rw [hc_eval]; exact hc_step⟩ + +theorem Turing.BinTM0.EvalsToInTime.congr.extracted_1_2.{u_2, u_1} + {σ : Type u_1} {σ' : Type u_2} (f : σ → Option σ) + (f' : σ' → Option σ') (g : σ → σ') + (hg : ∀ (x : σ), Option.map g (f x) = f' (g x)) (n : ℕ) (a : σ) : + (Option.map g ((flip Option.bind f)^[n] (some a))).bind f' = + ((flip Option.bind f)^[n] (some a)).bind fun a ↦ f' (g a) := by + induction n with + | zero => simp + | succ n ih => + simp only [Function.iterate_succ_apply, flip, Option.bind_some, <- hg] at ih ⊢ + grind + + + + + +/-- +If `f` is homomorphic to `f'` via `g`, then if `f` evals to `b` from `a` in `steps` steps, +then `f'` evals to `g b` from `g a` in `steps` steps. +-/ +lemma EvalsToInTime.map {σ σ' : Type*} (f : σ → Option σ) (f' : σ' → Option σ') + (g : σ → σ') (hg : ∀ x, Option.map g (f x) = f' (g x)) + (a : σ) (b : Option σ) + (steps : ℕ) + (h : EvalsToInTime f a b steps) : EvalsToInTime f' (g a) (Option.map g b) steps := by + induction steps generalizing a b with + | zero => + simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_zero, id_eq] at h ⊢ + subst h + rfl + | succ n ih => + simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_succ_apply', + forall_eq'] at h ih ⊢ + subst h + rw [ih] + clear ih + simp only [Option.map_bind, Function.comp_apply, hg] + exact Turing.BinTM0.EvalsToInTime.congr.extracted_1_2 f f' g hg n a + +/-- +If `h : σ → ℕ` increases by at most 1 on each step of `f`, +then the value of `h` at the output after `steps` steps is at most `h` at the input plus `steps`. +-/ +lemma EvalsToInTime.small_change {σ : Type*} (f : σ → Option σ) (h : σ → ℕ) + (h_step : ∀ a b, f a = some b → h b ≤ h a + 1) + (a : σ) (b : σ) + (steps : ℕ) + (hevals : EvalsToInTime f a b steps) : + h b ≤ h a + steps := by + induction steps generalizing a b with + | zero => + simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_zero, id_eq, Option.some.injEq, + add_zero] at hevals ⊢ + subst hevals + exact Nat.le_refl (h a) + | succ n ih => + rw [EvalsToInTime.succ_iff] at hevals + obtain ⟨c, hevals_n, h_step_eq⟩ := hevals + specialize ih a c hevals_n + specialize h_step c b h_step_eq + omega + + +-- m -> step_bound +/-- `f` eventually reaches `b` in at most `m` steps when repeatedly +evaluated on `a`. -/ +def EvalsToWithinTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (m : ℕ) : Prop := + ∃ steps ≤ m, EvalsToInTime f a b steps + +/-- Reflexivity of `EvalsToWithinTime` in 0 steps. -/ +def EvalsToWithinTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : + EvalsToWithinTime f a (some a) 0 := by + use 0 + exact if_false_right.mp rfl + +/-- Transitivity of `EvalsToWithinTime` in the sum of the numbers of steps. -/ +@[trans] +def EvalsToWithinTime.trans {σ : Type*} (f : σ → Option σ) (m₁ : ℕ) (m₂ : ℕ) (a : σ) (b : σ) + (c : Option σ) (h₁ : EvalsToWithinTime f a b m₁) (h₂ : EvalsToWithinTime f b c m₂) : + EvalsToWithinTime f a c (m₂ + m₁) := by + obtain ⟨steps₁, hsteps₁, hevals₁⟩ := h₁ + obtain ⟨steps₂, hsteps₂, hevals₂⟩ := h₂ + use steps₂ + steps₁ + constructor + · omega + · exact EvalsToInTime.trans f a b c steps₁ steps₂ hevals₁ hevals₂ + +def EvalsToWithinTime.map {σ σ' : Type*} (f : σ → Option σ) (f' : σ' → Option σ') + (g : σ → σ') (hg : ∀ x, Option.map g (f x) = f' (g x)) + (a : σ) (b : Option σ) + (m : ℕ) + (h : EvalsToWithinTime f a b m) : EvalsToWithinTime f' (g a) (Option.map g b) m := by + obtain ⟨steps, hsteps, hevals⟩ := h + use steps + constructor + · exact hsteps + · exact EvalsToInTime.map f f' g hg a b steps hevals + +/-- +Monotonicity of `EvalsToWithinTime` in the time bound. +-/ +def EvalsToWithinTime.mono_time {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) + {m₁ m₂ : ℕ} (h : EvalsToWithinTime f a b m₁) (hm : m₁ ≤ m₂) : EvalsToWithinTime f a b m₂ := by + obtain ⟨steps, hsteps, hevals⟩ := h + use steps + simp_all only + simp + omega -/-- Given a reduction system `rs` on `Term`, returns a reduction system on `Term × ℕ` -where the second component of the pair represents the number of steps taken. -/ -def Timed (rs : ReductionSystem Term) : ReductionSystem (Term × ℕ) := - { Red := fun ⟨t, n⟩ ⟨t', n'⟩ => rs.Red t t' ∧ n' = n + 1 } +lemma EvalsToWithinTime.small_change {σ : Type*} (f : σ → Option σ) (h : σ → ℕ) + (h_step : ∀ a b, f a = some b → h b ≤ h a + 1) + (a : σ) (b : σ) + (m : ℕ) + (hevals : EvalsToWithinTime f a (some b) m) : + h b ≤ h a + m := by + obtain ⟨steps, hsteps, hevals_steps⟩ := hevals + have := EvalsToInTime.small_change f h h_step a b steps hevals_steps + omega -end Timed +end EvalsToJunk open Lean Elab Meta Command Term From 630ce615d86cdb87d4f5591a6bfadccbe8f99a89 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 11:10:28 -0800 Subject: [PATCH 05/95] claude build/switch to reduces API --- .../Machines/SingleTapeTuring/Basic.lean | 112 ++++++------ .../Semantics/ReductionSystem/Basic.lean | 171 +++++++++++++++++- 2 files changed, 224 insertions(+), 59 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index b95473a18..57a654797 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -104,13 +104,11 @@ def initCfg (tm : BinTM0) (s : List Bool) : tm.Cfg := ⟨some tm.q₀, OTape.mk def haltCfg (tm : BinTM0) (s : List (Bool)) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ /-- -The `ReductionSystem` corresponding to a `BinTM0` is defined by the `step` function, +The `TerminalReductionSystem` corresponding to a `BinTM0` is defined by the `step` function, which maps a configuration to its next configuration if it exists. -/ -def ReductionSystem (tm : BinTM0) : Cslib.ReductionSystem (tm.Cfg) := - { Red := fun cfg cfg' => tm.step cfg = some cfg' } --- TODO use this, rather than the current setup, or better yet an LTS? - +def TerminalReductionSystem (tm : BinTM0) : Cslib.TerminalReductionSystem (tm.Cfg) := + TerminalReductionSystem.Option tm.step noncomputable def Cfg.space_used (tm : BinTM0) (cfg : tm.Cfg) : ℕ := cfg.OTape.space_used @@ -138,25 +136,21 @@ lemma Cfg.space_used_step {tm : BinTM0} (cfg cfg' : tm.Cfg) /-- A proof of tm outputting l' when given l. -/ -def OutputsInTime (tm : BinTM0) (l : List (Bool)) (l' : Option (List (Bool))) := - EvalsToInTime tm.step (initCfg tm l) ((Option.map (haltCfg tm)) l') +def Outputs (tm : BinTM0) (l : List (Bool)) (l' : List (Bool)) : Prop := + tm.TerminalReductionSystem.MRed (initCfg tm l) (haltCfg tm l') /-- A proof of tm outputting l' when given l in at most m steps. -/ -def OutputsWithinTime (tm : BinTM0) (l : List (Bool)) (l' : Option (List (Bool))) +def OutputsWithinTime (tm : BinTM0) (l : List (Bool)) (l' : (List (Bool))) (m : ℕ) := - EvalsToWithinTime tm.step (initCfg tm l) ((Option.map (haltCfg tm)) l') m + tm.TerminalReductionSystem.reducesToWithinSteps (initCfg tm l) (haltCfg tm l') m /-- A Turing machine + a proof it outputsInTime `f`. -/ structure Computable (f : List Bool → List Bool) where /-- the underlying bundled TM0 -/ tm : BinTM0 - steps : ℕ /-- a proof this machine outputsInTime `f` -/ outputsFun : - ∀ a, - OutputsInTime tm a - (Option.some (f a)) - steps + ∀ a, tm.Outputs a (f a) /-- A Turing machine + a time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ @@ -170,7 +164,7 @@ structure TimeComputable (f : List Bool → List Bool) where ∀ a, tm.OutputsWithinTime a - (Option.some (f a)) + ((f a)) (time a.length) /-- A Turing machine computing the identity. -/ @@ -181,14 +175,16 @@ def idComputer : BinTM0 where noncomputable section +-- TODO switch to where syntax /-- A proof that the identity map on α is computable in time. -/ -def TimeComputable.id : - @TimeComputable id := +def TimeComputable.id : TimeComputable id := ⟨idComputer, fun _ => 1, fun x => by - use 1 - simp only [le_refl, id_eq, Option.map_some, true_and] - simp only [EvalsToInTime, initCfg, haltCfg, idComputer, - Function.iterate_succ, Function.iterate_zero, Function.comp_apply, id_eq] + refine ⟨1, le_refl 1, ?_⟩ + -- Need to show reducesToInSteps for 1 step + refine Cslib.ReductionSystem.reducesToInSteps.cons _ _ _ 0 ?_ (Cslib.ReductionSystem.reducesToInSteps.refl _) + -- Show the single step reduction: step (init x) = some (halt x) + simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option, initCfg, haltCfg, + idComputer, step, OTape.move?] congr 1⟩ def compComputer {f : List Bool → List Bool} {g : List Bool → List Bool} @@ -353,10 +349,10 @@ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Boo (haltCfg : hf.tm.Cfg) -- (haltCfg_state : haltCfg.state = none) (steps : ℕ) - (h : EvalsToInTime hf.tm.step cfg (some haltCfg) steps) : - EvalsToInTime (compComputer hf hg).step + (h : hf.tm.TerminalReductionSystem.reducesToInSteps cfg ( haltCfg) steps) : + (compComputer hf hg).TerminalReductionSystem.reducesToInSteps (liftCompCfg_left_or_right hf hg cfg) - (some (liftCompCfg_left_or_right hf hg haltCfg)) + ( (liftCompCfg_left_or_right hf hg haltCfg)) steps := by -- Proof by induction on steps. -- Key insight: liftCompCfg_left_or_right maps: @@ -366,14 +362,17 @@ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Boo -- When the first machine halts, the composed machine transitions to Sum.inr hg.tm.q₀. induction steps generalizing cfg haltCfg with | zero => - simp only [EvalsToInTime, Option.bind_eq_bind, step, Function.iterate_zero, id_eq, + -- rw [ReductionSystem.reducesToInSteps.zero_iff] at h + -- rw [ReductionSystem.reducesToInSteps.zero_iff] + -- rw [h] + simp [Option.bind_eq_bind, step, Function.iterate_zero, id_eq, Option.some.injEq] at h ⊢ rw [h] | succ n ih => -- Use the decomposition lemma: cfg evals to some intermediate c in n steps, -- and then c steps to haltCfg -- obtain ⟨c, hc_n, hc_step⟩ := EvalsToInTime.succ_decompose hf.tm.step cfg haltCfg n h - rw [EvalsToInTime.succ_iff] at h ⊢ + rw [ReductionSystem.reducesToInSteps.succ'_iff] at h ⊢ obtain ⟨c, hc_n, hc_step⟩ := h use liftCompCfg_left_or_right hf hg c constructor @@ -384,10 +383,11 @@ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Boo | mk state OTape => cases state with | none => - simp_all + sorry | some q => - rw [← map_liftCompCfg_left_or_right_step hf hg ⟨some q, OTape⟩ (by simp)] - simp only [hc_step, Option.map_some] + sorry + -- rw [← map_liftCompCfg_left_or_right_step hf hg ⟨some q, OTape⟩ (by simp)] + -- simp only [hc_step, Option.map_some] /-- @@ -401,13 +401,13 @@ theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → Li (hf : TimeComputable f) (hg : TimeComputable g) (a : List Bool) (hf_outputsFun : - EvalsToWithinTime hf.tm.step + hf.tm.TerminalReductionSystem.reducesToWithinSteps { state := some hf.tm.q₀, OTape := OTape.mk₁ a } - (some { state := none, OTape := OTape.mk₁ (f a) }) + ({ state := none, OTape := OTape.mk₁ (f a) }) (hf.time a.length)) : - EvalsToWithinTime (compComputer hf hg).step + (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ a } - (some { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) }) + ({ state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) }) (hf.time a.length) := by obtain ⟨steps, hsteps_le, hsteps_eval⟩ := hf_outputsFun use steps @@ -426,20 +426,25 @@ theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → Li theorem comp_right_simulation {f : List Bool → List Bool} {g : List Bool → List Bool} (hf : TimeComputable f) (hg : TimeComputable g) - (x : hg.tm.Cfg) (y : Option hg.tm.Cfg) (m : ℕ) - (h : EvalsToWithinTime hg.tm.step x y m) : - EvalsToWithinTime (compComputer hf hg).step + (x : hg.tm.Cfg) (y : hg.tm.Cfg) (m : ℕ) + (h : hg.tm.TerminalReductionSystem.reducesToWithinSteps x y m) : + (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps (liftCompCfg_right hf hg x) - (Option.map (liftCompCfg_right hf hg) y) + ((liftCompCfg_right hf hg) y) m := by - exact EvalsToWithinTime.map hg.tm.step (compComputer hf hg).step - (liftCompCfg_right hf hg) (map_liftCompCfg_right_step hf hg) x y m h + refine Cslib.ReductionSystem.reducesToWithinSteps.map (liftCompCfg_right hf hg) ?_ h + intro a b hab + -- hab : hg.tm.step a = some b (this is Red for TerminalReductionSystem.Option) + -- Need: (compComputer hf hg).step (liftCompCfg_right hf hg a) = some (liftCompCfg_right hf hg b) + have h1 := map_liftCompCfg_right_step hf hg a + rw [hab, Option.map_some] at h1 + exact h1.symm lemma output_length_le_input_length_add_time (tm : BinTM0) (l l' : List Bool) (t : ℕ) - (h : tm.OutputsWithinTime l (some l') t) : + (h : tm.OutputsWithinTime l l' t) : l'.length ≤ max 1 l.length + t := by unfold OutputsWithinTime at h obtain ⟨steps, hsteps_le, hevals⟩ := h @@ -485,31 +490,30 @@ def TimeComputable.comp have hg_outputsFun := hg.outputsFun (f a) simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, Option.map_some, haltCfg] at hg_outputsFun hf_outputsFun ⊢ - -- The computer evals a to f a in time hf.time a - have h_a_evalsTo_f_a : - EvalsToWithinTime (compComputer hf hg).step + -- The computer reduces a to f a in time hf.time a + have h_a_reducesTo_f_a : + (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ a } - (some { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) }) + { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) } (hf.time a.length) := comp_left_simulation hf hg a hf_outputsFun - have h_f_a_evalsTo_g_f_a : - EvalsToWithinTime (compComputer hf hg).step + have h_f_a_reducesTo_g_f_a : + (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) } - (some { state := none, OTape := OTape.mk₁ (g (f a)) }) + { state := none, OTape := OTape.mk₁ (g (f a)) } (hg.time (f a).length) := by -- Use the simulation lemma for the second machine have := comp_right_simulation hf hg { state := some hg.tm.q₀, OTape := OTape.mk₁ (f a) } - (some { state := none, OTape := OTape.mk₁ (g (f a)) }) + { state := none, OTape := OTape.mk₁ (g (f a)) } (hg.time (f a).length) hg_outputsFun - simp only [liftCompCfg_right, Option.map_some] at this + simp only [liftCompCfg_right] at this exact this - have h_a_evalsTo_g_f_a := - EvalsToWithinTime.trans - (compComputer hf hg).step _ _ _ _ _ h_a_evalsTo_f_a h_f_a_evalsTo_g_f_a - apply EvalsToWithinTime.mono_time _ _ _ h_a_evalsTo_g_f_a - nth_rw 1 [← add_comm] + have h_a_reducesTo_g_f_a := + Cslib.ReductionSystem.reducesToWithinSteps.trans + h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a + apply Cslib.ReductionSystem.reducesToWithinSteps.mono_steps h_a_reducesTo_g_f_a apply add_le_add · omega · apply h_mono diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index 02d65ef22..0e4bb3001 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -69,21 +69,182 @@ inductive ReductionSystem.reducesToInSteps lemma ReductionSystem.reducesToInSteps.trans {rs : ReductionSystem Term} {a b c : Term} {n m : ℕ} (h₁ : reducesToInSteps rs a b n) (h₂ : reducesToInSteps rs b c m) : reducesToInSteps rs a c (n + m) := by - sorry + induction h₁ with + | refl _ => simp only [Nat.zero_add]; exact h₂ + | cons t t' t'' k h_red _ ih => + simp only [Nat.add_right_comm] + exact reducesToInSteps.cons t t' c (k + m) h_red (ih h₂) + +lemma ReductionSystem.reducesToInSteps.zero {rs : ReductionSystem Term} {a b : Term} + (h : reducesToInSteps rs a b 0) : + a = b := by + cases h + rfl + +@[simp] +lemma ReductionSystem.reducesToInSteps.zero_iff {rs : ReductionSystem Term} {a b : Term} : + reducesToInSteps rs a b 0 ↔ a = b := by + constructor + · exact reducesToInSteps.zero + · intro h; subst h; exact reducesToInSteps.refl a + lemma ReductionSystem.reducesToInSteps.succ {rs : ReductionSystem Term} {a b : Term} {n : ℕ} (h : reducesToInSteps rs a b (n + 1)) : ∃ t', rs.Red a t' ∧ reducesToInSteps rs t' b n := by - sorry + cases h with + | cons _ t' _ _ h_red h_steps => exact ⟨t', h_red, h_steps⟩ --- TODO iff +lemma ReductionSystem.reducesToInSteps.succ_iff {rs : ReductionSystem Term} {a b : Term} {n : ℕ} : + reducesToInSteps rs a b (n + 1) ↔ ∃ t', rs.Red a t' ∧ reducesToInSteps rs t' b n := by + constructor + · exact ReductionSystem.reducesToInSteps.succ + · rintro ⟨t', h_red, h_steps⟩ + exact ReductionSystem.reducesToInSteps.cons a t' b n h_red h_steps lemma ReductionSystem.reducesToInSteps.succ' {rs : ReductionSystem Term} {a b : Term} {n : ℕ} (h : reducesToInSteps rs a b (n + 1)) : ∃ t', reducesToInSteps rs a t' n ∧ rs.Red t' b := by - sorry + induction n generalizing a b with + | zero => + obtain ⟨t', h_red, h_steps⟩ := succ h + rw [zero_iff] at h_steps + subst h_steps + exact ⟨a, reducesToInSteps.refl a, h_red⟩ + | succ k ih => + obtain ⟨t', h_red, h_steps⟩ := succ h + obtain ⟨t'', h_steps', h_red'⟩ := ih h_steps + exact ⟨t'', reducesToInSteps.cons a t' t'' k h_red h_steps', h_red'⟩ + +lemma ReductionSystem.reducesToInSteps.succ'_iff + {rs : ReductionSystem Term} {a b : Term} {n : ℕ} : + reducesToInSteps rs a b (n + 1) ↔ ∃ t', reducesToInSteps rs a t' n ∧ rs.Red t' b := by + constructor + · exact succ' + · rintro ⟨t', h_steps, h_red⟩ + have h_one : reducesToInSteps rs t' b 1 := cons t' b b 0 h_red (refl b) + have := trans h_steps h_one + simp only [Nat.add_one] at this + exact this + +lemma ReductionSystem.reducesToInSteps.small_change + {rs : ReductionSystem Term} {a b : Term} (h : Term → ℕ) + (h_step : ∀ a b, rs.Red a b → h b ≤ h a + 1) + (m : ℕ) + (hevals : rs.reducesToInSteps a b m) : + h b ≤ h a + m := by + induction hevals with + | refl _ => simp + | cons t t' t'' k h_red _ ih => + have h_step' := h_step t t' h_red + omega + +/-- +If `g` is a homomorphism from `rs` to `rs'` (i.e., it preserves the reduction relation), +then `reducesToInSteps` is preserved under `g`. +-/ +lemma ReductionSystem.reducesToInSteps.map {Term Term' : Type*} + {rs : ReductionSystem Term} {rs' : ReductionSystem Term'} + (g : Term → Term') (hg : ∀ a b, rs.Red a b → rs'.Red (g a) (g b)) + {a b : Term} {n : ℕ} + (h : reducesToInSteps rs a b n) : + reducesToInSteps rs' (g a) (g b) n := by + induction h with + | refl t => exact reducesToInSteps.refl (g t) + | cons t t' t'' m h_red h_steps ih => + exact reducesToInSteps.cons (g t) (g t') (g t'') m (hg t t' h_red) ih + +def ReductionSystem.reducesToWithinSteps (rs : ReductionSystem Term) (a b : Term) (n : ℕ) : Prop := + ∃ m ≤ n, reducesToInSteps rs a b m + +/-- Reflexivity of `reducesToWithinSteps` in 0 steps. -/ +lemma ReductionSystem.reducesToWithinSteps.refl {rs : ReductionSystem Term} (a : Term) : + reducesToWithinSteps rs a a 0 := by + use 0 + exact ⟨Nat.le_refl 0, reducesToInSteps.refl a⟩ --- TODO iff +/-- Transitivity of `reducesToWithinSteps` in the sum of the step bounds. -/ +@[trans] +lemma ReductionSystem.reducesToWithinSteps.trans {rs : ReductionSystem Term} + {a b c : Term} {n₁ n₂ : ℕ} + (h₁ : reducesToWithinSteps rs a b n₁) (h₂ : reducesToWithinSteps rs b c n₂) : + reducesToWithinSteps rs a c (n₁ + n₂) := by + obtain ⟨m₁, hm₁, hevals₁⟩ := h₁ + obtain ⟨m₂, hm₂, hevals₂⟩ := h₂ + use m₁ + m₂ + constructor + · omega + · exact reducesToInSteps.trans hevals₁ hevals₂ + +/-- Monotonicity of `reducesToWithinSteps` in the step bound. -/ +lemma ReductionSystem.reducesToWithinSteps.mono_steps {rs : ReductionSystem Term} + {a b : Term} {n₁ n₂ : ℕ} + (h : reducesToWithinSteps rs a b n₁) (hn : n₁ ≤ n₂) : + reducesToWithinSteps rs a b n₂ := by + obtain ⟨m, hm, hevals⟩ := h + use m + constructor + · omega + · exact hevals + +/-- If `h : Term → ℕ` increases by at most 1 on each step of `rs`, +then the value of `h` at the output is at most `h` at the input plus the step bound. -/ +lemma ReductionSystem.reducesToWithinSteps.small_change {rs : ReductionSystem Term} + {a b : Term} (h : Term → ℕ) + (h_step : ∀ a b, rs.Red a b → h b ≤ h a + 1) + (n : ℕ) + (hevals : reducesToWithinSteps rs a b n) : + h b ≤ h a + n := by + obtain ⟨m, hm, hevals_m⟩ := hevals + have := reducesToInSteps.small_change h h_step m hevals_m + omega + +/-- +If `g` is a homomorphism from `rs` to `rs'` (i.e., it preserves the reduction relation), +then `reducesToWithinSteps` is preserved under `g`. +-/ +lemma ReductionSystem.reducesToWithinSteps.map {Term Term' : Type*} + {rs : ReductionSystem Term} {rs' : ReductionSystem Term'} + (g : Term → Term') (hg : ∀ a b, rs.Red a b → rs'.Red (g a) (g b)) + {a b : Term} {n : ℕ} + (h : reducesToWithinSteps rs a b n) : + reducesToWithinSteps rs' (g a) (g b) n := by + obtain ⟨m, hm, hevals⟩ := h + exact ⟨m, hm, reducesToInSteps.map g hg hevals⟩ + +/-- A single reduction step gives `reducesToWithinSteps` with bound 1. -/ +lemma ReductionSystem.reducesToWithinSteps.single {rs : ReductionSystem Term} + {a b : Term} (h : rs.Red a b) : + reducesToWithinSteps rs a b 1 := by + use 1 + constructor + · exact Nat.le_refl 1 + · exact reducesToInSteps.cons a b b 0 h (reducesToInSteps.refl b) + +/-- `reducesToInSteps` implies `reducesToWithinSteps` with the same bound. -/ +lemma ReductionSystem.reducesToWithinSteps.of_reducesToInSteps {rs : ReductionSystem Term} + {a b : Term} {n : ℕ} + (h : reducesToInSteps rs a b n) : + reducesToWithinSteps rs a b n := + ⟨n, Nat.le_refl n, h⟩ + +/-- Zero steps means the terms are equal. -/ +lemma ReductionSystem.reducesToWithinSteps.zero {rs : ReductionSystem Term} {a b : Term} + (h : reducesToWithinSteps rs a b 0) : + a = b := by + obtain ⟨m, hm, hevals⟩ := h + have : m = 0 := Nat.le_zero.mp hm + subst this + exact reducesToInSteps.zero hevals + +@[simp] +lemma ReductionSystem.reducesToWithinSteps.zero_iff {rs : ReductionSystem Term} {a b : Term} : + reducesToWithinSteps rs a b 0 ↔ a = b := by + constructor + · exact reducesToWithinSteps.zero + · intro h + subst h + exact reducesToWithinSteps.refl a end Steps From 4587a743f50ce622c9c4ed450e933a9444d272e3 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 11:12:15 -0800 Subject: [PATCH 06/95] claude: remove sorries --- .../Machines/SingleTapeTuring/Basic.lean | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 57a654797..d646cbf20 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -383,11 +383,15 @@ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Boo | mk state OTape => cases state with | none => - sorry + -- c is in halting state, but step of halting state is none, contradiction + simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option, step] at hc_step + cases hc_step | some q => - sorry - -- rw [← map_liftCompCfg_left_or_right_step hf hg ⟨some q, OTape⟩ (by simp)] - -- simp only [hc_step, Option.map_some] + -- Use the lifting lemma + have h1 := map_liftCompCfg_left_or_right_step hf hg ⟨some q, OTape⟩ (by simp) + simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option] at hc_step ⊢ + rw [hc_step, Option.map_some] at h1 + exact h1.symm /-- From 35558b849668ae41e477da427e8e53f3f94ea363 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 11:15:05 -0800 Subject: [PATCH 07/95] delete evals junk --- .../Semantics/ReductionSystem/Basic.lean | 160 ------------------ 1 file changed, 160 deletions(-) diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index 0e4bb3001..fc01c18d9 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -260,166 +260,6 @@ def TerminalReductionSystem.Option {σ : Type*} (f : σ → Option σ) : Termina intros t t' h_terminal h_red simp [h_terminal] at h_red - --- TODO refactor the contents of this section into ReductionSystem --- then delete them -section EvalsToJunk - - - -/-- `f` eventually reaches `b` when repeatedly evaluated on `a`, in exactly `steps` steps. -/ -def EvalsToInTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (steps : ℕ) : Prop := - (· >>= f)^[steps] a = b - -/-- Reflexivity of `EvalsTo` in 0 steps. -/ -lemma EvalsToInTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : EvalsToInTime f a (some a) 0 := - rfl - -/-- Transitivity of `EvalsTo` in the sum of the numbers of steps. -/ -@[trans] -lemma EvalsToInTime.trans {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (c : Option σ) - (steps₁ steps₂ : ℕ) (h₁ : EvalsToInTime f a b steps₁) (h₂ : EvalsToInTime f b c steps₂) : - EvalsToInTime f a c (steps₂ + steps₁) := by - simp only [EvalsToInTime] at *; rw [Function.iterate_add_apply, h₁, h₂] - -/-- If we evaluate to some state in n+1 steps, there is an intermediate state - that we reach in n steps, and then one more step reaches the final state. -/ -lemma EvalsToInTime.succ_decompose {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) - (n : ℕ) (h : EvalsToInTime f a (some b) (n + 1)) : - ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := by - simp only [EvalsToInTime, Function.iterate_succ_apply'] at h - match hc' : (· >>= f)^[n] (some a) with - | none => simp_all - | some c => exact ⟨c, hc', by simp_all⟩ - -lemma EvalsToInTime.succ_iff {σ : Type*} (f : σ → Option σ) (a : σ) (b : σ) (n : ℕ) : - EvalsToInTime f a (some b) (n + 1) ↔ ∃ c : σ, EvalsToInTime f a (some c) n ∧ f c = some b := - ⟨succ_decompose f a b n, fun ⟨_, hc_eval, hc_step⟩ => by - simp only [EvalsToInTime, Function.iterate_succ_apply'] at hc_eval ⊢; - rw [hc_eval]; exact hc_step⟩ - -theorem Turing.BinTM0.EvalsToInTime.congr.extracted_1_2.{u_2, u_1} - {σ : Type u_1} {σ' : Type u_2} (f : σ → Option σ) - (f' : σ' → Option σ') (g : σ → σ') - (hg : ∀ (x : σ), Option.map g (f x) = f' (g x)) (n : ℕ) (a : σ) : - (Option.map g ((flip Option.bind f)^[n] (some a))).bind f' = - ((flip Option.bind f)^[n] (some a)).bind fun a ↦ f' (g a) := by - induction n with - | zero => simp - | succ n ih => - simp only [Function.iterate_succ_apply, flip, Option.bind_some, <- hg] at ih ⊢ - grind - - - - - -/-- -If `f` is homomorphic to `f'` via `g`, then if `f` evals to `b` from `a` in `steps` steps, -then `f'` evals to `g b` from `g a` in `steps` steps. --/ -lemma EvalsToInTime.map {σ σ' : Type*} (f : σ → Option σ) (f' : σ' → Option σ') - (g : σ → σ') (hg : ∀ x, Option.map g (f x) = f' (g x)) - (a : σ) (b : Option σ) - (steps : ℕ) - (h : EvalsToInTime f a b steps) : EvalsToInTime f' (g a) (Option.map g b) steps := by - induction steps generalizing a b with - | zero => - simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_zero, id_eq] at h ⊢ - subst h - rfl - | succ n ih => - simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_succ_apply', - forall_eq'] at h ih ⊢ - subst h - rw [ih] - clear ih - simp only [Option.map_bind, Function.comp_apply, hg] - exact Turing.BinTM0.EvalsToInTime.congr.extracted_1_2 f f' g hg n a - -/-- -If `h : σ → ℕ` increases by at most 1 on each step of `f`, -then the value of `h` at the output after `steps` steps is at most `h` at the input plus `steps`. --/ -lemma EvalsToInTime.small_change {σ : Type*} (f : σ → Option σ) (h : σ → ℕ) - (h_step : ∀ a b, f a = some b → h b ≤ h a + 1) - (a : σ) (b : σ) - (steps : ℕ) - (hevals : EvalsToInTime f a b steps) : - h b ≤ h a + steps := by - induction steps generalizing a b with - | zero => - simp only [EvalsToInTime, Option.bind_eq_bind, Function.iterate_zero, id_eq, Option.some.injEq, - add_zero] at hevals ⊢ - subst hevals - exact Nat.le_refl (h a) - | succ n ih => - rw [EvalsToInTime.succ_iff] at hevals - obtain ⟨c, hevals_n, h_step_eq⟩ := hevals - specialize ih a c hevals_n - specialize h_step c b h_step_eq - omega - - --- m -> step_bound -/-- `f` eventually reaches `b` in at most `m` steps when repeatedly -evaluated on `a`. -/ -def EvalsToWithinTime {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) (m : ℕ) : Prop := - ∃ steps ≤ m, EvalsToInTime f a b steps - -/-- Reflexivity of `EvalsToWithinTime` in 0 steps. -/ -def EvalsToWithinTime.refl {σ : Type*} (f : σ → Option σ) (a : σ) : - EvalsToWithinTime f a (some a) 0 := by - use 0 - exact if_false_right.mp rfl - -/-- Transitivity of `EvalsToWithinTime` in the sum of the numbers of steps. -/ -@[trans] -def EvalsToWithinTime.trans {σ : Type*} (f : σ → Option σ) (m₁ : ℕ) (m₂ : ℕ) (a : σ) (b : σ) - (c : Option σ) (h₁ : EvalsToWithinTime f a b m₁) (h₂ : EvalsToWithinTime f b c m₂) : - EvalsToWithinTime f a c (m₂ + m₁) := by - obtain ⟨steps₁, hsteps₁, hevals₁⟩ := h₁ - obtain ⟨steps₂, hsteps₂, hevals₂⟩ := h₂ - use steps₂ + steps₁ - constructor - · omega - · exact EvalsToInTime.trans f a b c steps₁ steps₂ hevals₁ hevals₂ - -def EvalsToWithinTime.map {σ σ' : Type*} (f : σ → Option σ) (f' : σ' → Option σ') - (g : σ → σ') (hg : ∀ x, Option.map g (f x) = f' (g x)) - (a : σ) (b : Option σ) - (m : ℕ) - (h : EvalsToWithinTime f a b m) : EvalsToWithinTime f' (g a) (Option.map g b) m := by - obtain ⟨steps, hsteps, hevals⟩ := h - use steps - constructor - · exact hsteps - · exact EvalsToInTime.map f f' g hg a b steps hevals - -/-- -Monotonicity of `EvalsToWithinTime` in the time bound. --/ -def EvalsToWithinTime.mono_time {σ : Type*} (f : σ → Option σ) (a : σ) (b : Option σ) - {m₁ m₂ : ℕ} (h : EvalsToWithinTime f a b m₁) (hm : m₁ ≤ m₂) : EvalsToWithinTime f a b m₂ := by - obtain ⟨steps, hsteps, hevals⟩ := h - use steps - simp_all only - simp - omega - -lemma EvalsToWithinTime.small_change {σ : Type*} (f : σ → Option σ) (h : σ → ℕ) - (h_step : ∀ a b, f a = some b → h b ≤ h a + 1) - (a : σ) (b : σ) - (m : ℕ) - (hevals : EvalsToWithinTime f a (some b) m) : - h b ≤ h a + m := by - obtain ⟨steps, hsteps, hevals_steps⟩ := hevals - have := EvalsToInTime.small_change f h h_step a b steps hevals_steps - omega - - -end EvalsToJunk - open Lean Elab Meta Command Term -- thank you to Kyle Miller for this: From 1ef61821f4b24f81e8bc0bd7e76e7f79de35c26d Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 13:17:52 -0800 Subject: [PATCH 08/95] clean whitespace --- .../Machines/SingleTapeTuring/Basic.lean | 57 ++++++++----------- Cslib/Foundations/Data/OTape.lean | 2 +- 2 files changed, 26 insertions(+), 33 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index d646cbf20..9286d79e0 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -52,7 +52,6 @@ structure BinTM0 where to a Stmt to invoke, and optionally a new state (none for halt) -/ (M : Λ → (Option Bool) → (Turing.BinTM0.Stmt × Option Λ)) - namespace BinTM0 section @@ -110,7 +109,7 @@ which maps a configuration to its next configuration if it exists. def TerminalReductionSystem (tm : BinTM0) : Cslib.TerminalReductionSystem (tm.Cfg) := TerminalReductionSystem.Option tm.step -noncomputable def Cfg.space_used (tm : BinTM0) (cfg : tm.Cfg) : ℕ := +def Cfg.space_used (tm : BinTM0) (cfg : tm.Cfg) : ℕ := cfg.OTape.space_used lemma Cfg.space_used_initCfg (tm : BinTM0) (s : List Bool) : @@ -149,8 +148,7 @@ structure Computable (f : List Bool → List Bool) where /-- the underlying bundled TM0 -/ tm : BinTM0 /-- a proof this machine outputsInTime `f` -/ - outputsFun : - ∀ a, tm.Outputs a (f a) + outputsFun : ∀ a, tm.Outputs a (f a) /-- A Turing machine + a time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ @@ -160,12 +158,7 @@ structure TimeComputable (f : List Bool → List Bool) where /-- a time function -/ time : ℕ → ℕ /-- proof this machine outputsInTime `f` in at most `time(input.length)` steps -/ - outputsFun : - ∀ a, - tm.OutputsWithinTime - a - ((f a)) - (time a.length) + outputsFun : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) /-- A Turing machine computing the identity. -/ def idComputer : BinTM0 where @@ -173,7 +166,7 @@ def idComputer : BinTM0 where q₀ := PUnit.unit M := fun _ b => ⟨(b, none), none⟩ -noncomputable section +section -- TODO switch to where syntax /-- A proof that the identity map on α is computable in time. -/ @@ -181,7 +174,8 @@ def TimeComputable.id : TimeComputable id := ⟨idComputer, fun _ => 1, fun x => by refine ⟨1, le_refl 1, ?_⟩ -- Need to show reducesToInSteps for 1 step - refine Cslib.ReductionSystem.reducesToInSteps.cons _ _ _ 0 ?_ (Cslib.ReductionSystem.reducesToInSteps.refl _) + refine Cslib.ReductionSystem.reducesToInSteps.cons _ _ _ 0 ?_ + (Cslib.ReductionSystem.reducesToInSteps.refl _) -- Show the single step reduction: step (init x) = some (halt x) simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option, initCfg, haltCfg, idComputer, step, OTape.move?] @@ -220,15 +214,13 @@ def compComputer {f : List Bool → List Bool} {g : List Bool → List Bool} } lemma compComputer_q₀_eq (f : List Bool → List Bool) (g : List Bool → List Bool) - (hf : TimeComputable f) - (hg : TimeComputable g) : + (hf : TimeComputable f) (hg : TimeComputable g) : (compComputer hf hg).q₀ = Sum.inl hf.tm.q₀ := rfl /-- Lift a config over a tm to a config over the comp -/ def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : TimeComputable f) - (hg : TimeComputable g) + (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) : (compComputer hf hg).Cfg := { @@ -237,8 +229,7 @@ def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} } def liftCompCfg_right {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : TimeComputable f) - (hg : TimeComputable g) + (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hg.tm.Cfg) : (compComputer hf hg).Cfg := { @@ -249,8 +240,7 @@ def liftCompCfg_right {f : List Bool → List Bool} {g : List Bool → List Bool theorem map_liftCompCfg_left_step {f : List Bool → List Bool} {g : List Bool → List Bool} (hf : TimeComputable f) (hg : TimeComputable g) - (x : hf.tm.Cfg) - (hx : ∀ cfg, hf.tm.step x = some cfg → cfg.state.isSome) : + (x : hf.tm.Cfg) (hx : ∀ cfg, hf.tm.step x = some cfg → cfg.state.isSome) : Option.map (liftCompCfg_left hf hg) (hf.tm.step x) = (compComputer hf hg).step (liftCompCfg_left hf hg x) := by cases x with @@ -312,8 +302,7 @@ theorem comp_transition_to_right {f : List Bool → List Bool} {g : List Bool /-- Helper: lifting to Sum.inl and transitioning to Sum.inr on halt -/ def liftCompCfg_left_or_right {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : TimeComputable f) - (hg : TimeComputable g) + (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) : (compComputer hf hg).Cfg := match cfg.state with @@ -347,12 +336,11 @@ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Boo (cfg : hf.tm.Cfg) (hcfg : cfg.state.isSome) (haltCfg : hf.tm.Cfg) - -- (haltCfg_state : haltCfg.state = none) (steps : ℕ) - (h : hf.tm.TerminalReductionSystem.reducesToInSteps cfg ( haltCfg) steps) : + (h : hf.tm.TerminalReductionSystem.reducesToInSteps cfg haltCfg steps) : (compComputer hf hg).TerminalReductionSystem.reducesToInSteps (liftCompCfg_left_or_right hf hg cfg) - ( (liftCompCfg_left_or_right hf hg haltCfg)) + (liftCompCfg_left_or_right hf hg haltCfg) steps := by -- Proof by induction on steps. -- Key insight: liftCompCfg_left_or_right maps: @@ -365,8 +353,7 @@ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Boo -- rw [ReductionSystem.reducesToInSteps.zero_iff] at h -- rw [ReductionSystem.reducesToInSteps.zero_iff] -- rw [h] - simp [Option.bind_eq_bind, step, Function.iterate_zero, id_eq, - Option.some.injEq] at h ⊢ + simp only [ReductionSystem.reducesToInSteps.zero_iff] at h ⊢ rw [h] | succ n ih => -- Use the decomposition lemma: cfg evals to some intermediate c in n steps, @@ -483,8 +470,7 @@ then from the intermediate state to the final state. -/ def TimeComputable.comp {f : List Bool → List Bool} {g : List Bool → List Bool} - (hf : TimeComputable f) - (hg : TimeComputable g) + (hf : TimeComputable f) (hg : TimeComputable g) (h_mono : Monotone hg.time) : (TimeComputable (g ∘ f)) where tm := compComputer hf hg @@ -493,7 +479,7 @@ def TimeComputable.comp have hf_outputsFun := hf.outputsFun a have hg_outputsFun := hg.outputsFun (f a) simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, - Option.map_some, haltCfg] at hg_outputsFun hf_outputsFun ⊢ + haltCfg] at hg_outputsFun hf_outputsFun ⊢ -- The computer reduces a to f a in time hf.time a have h_a_reducesTo_f_a : (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps @@ -529,11 +515,18 @@ end /-! ## Polynomial Time Computability -This section defines polynomial time computable functions on Turing machines. +This section defines polynomial time computable functions on Turing machines, +and proves that +* The identity function is polynomial time computable +* The composition of two polynomial time computable functions is polynomial time computable + + -/ section PolyTime +-- TODO noncomputable due to use of Polynomial +-- perhaps could we switch to one of those computable polynomial representations? /-- A Turing machine + a polynomial time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ structure PolyTimeComputable (f : List Bool → List Bool) extends TimeComputable f where @@ -555,7 +548,7 @@ noncomputable def PolyTimeComputable.comp {f : List Bool → List Bool} {g : List Bool → List Bool} (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) - -- all Nat polynomials are monotone, but the tighter internal bound maybe is not + -- all Nat polynomials are monotone, but the tighter internal bound maybe is not, awkwardly (h_mono : Monotone hg.time) : PolyTimeComputable (g ∘ f) where toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono diff --git a/Cslib/Foundations/Data/OTape.lean b/Cslib/Foundations/Data/OTape.lean index f2c092136..b2de4065c 100644 --- a/Cslib/Foundations/Data/OTape.lean +++ b/Cslib/Foundations/Data/OTape.lean @@ -79,7 +79,7 @@ def OTape.write {α} : Turing.OTape α → Option α → Turing.OTape α The space used by a OTape is the number of symbols between and including the head, and leftmost and rightmost non-blank symbols on the OTape -/ -noncomputable def OTape.space_used {α} [Inhabited α] (t : Turing.OTape α) : ℕ := +def OTape.space_used {α} [Inhabited α] (t : Turing.OTape α) : ℕ := 1 + t.left.length + t.right.length lemma OTape.space_used_write {α} [Inhabited α] (t : Turing.OTape α) (a : Option α) : From 6a2d234743a6027f615f9108d7164649edc89a6f Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 13:18:39 -0800 Subject: [PATCH 09/95] TM0 -> SingleTapeTM --- .../Machines/SingleTapeTuring/Basic.lean | 51 ++++++++++--------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 9286d79e0..730755c42 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -31,17 +31,17 @@ open Cslib namespace Turing -namespace BinTM0 +namespace BinSingleTapeTM /-- A Turing machine "statement" is just a command to move left or right, and write a symbol on the OTape. -/ def Stmt := (Option Bool) × Option (Dir) deriving Inhabited -end BinTM0 +end BinSingleTapeTM -/-- A TM0 over the alphabet of Option Bool (none is blank OTape symbol). -/ -structure BinTM0 where +/-- A SingleTapeTM over the alphabet of Option Bool (none is blank OTape symbol). -/ +structure BinSingleTapeTM where /-- type of state labels -/ (Λ : Type) /-- finiteness of the state type -/ @@ -50,13 +50,13 @@ structure BinTM0 where (q₀ : Λ) /-- Transition function, mapping a state and a head symbol to a Stmt to invoke, and optionally a new state (none for halt) -/ - (M : Λ → (Option Bool) → (Turing.BinTM0.Stmt × Option Λ)) + (M : Λ → (Option Bool) → (Turing.BinSingleTapeTM.Stmt × Option Λ)) -namespace BinTM0 +namespace BinSingleTapeTM section -variable (tm : BinTM0) +variable (tm : BinSingleTapeTM) instance : Inhabited tm.Λ := ⟨tm.q₀⟩ @@ -95,32 +95,33 @@ def step : tm.Cfg → Option tm.Cfg := end /-- The initial configuration corresponding to a list in the input alphabet. -/ -def initCfg (tm : BinTM0) (s : List Bool) : tm.Cfg := ⟨some tm.q₀, OTape.mk₁ s⟩ +def initCfg (tm : BinSingleTapeTM) (s : List Bool) : tm.Cfg := ⟨some tm.q₀, OTape.mk₁ s⟩ /-- The final configuration corresponding to a list in the output alphabet. (We demand that the head halts at the leftmost position of the output.) -/ -def haltCfg (tm : BinTM0) (s : List (Bool)) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ +def haltCfg (tm : BinSingleTapeTM) (s : List (Bool)) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ /-- -The `TerminalReductionSystem` corresponding to a `BinTM0` is defined by the `step` function, +The `TerminalReductionSystem` corresponding to a `BinSingleTapeTM` +is defined by the `step` function, which maps a configuration to its next configuration if it exists. -/ -def TerminalReductionSystem (tm : BinTM0) : Cslib.TerminalReductionSystem (tm.Cfg) := +def TerminalReductionSystem (tm : BinSingleTapeTM) : Cslib.TerminalReductionSystem (tm.Cfg) := TerminalReductionSystem.Option tm.step -def Cfg.space_used (tm : BinTM0) (cfg : tm.Cfg) : ℕ := +def Cfg.space_used (tm : BinSingleTapeTM) (cfg : tm.Cfg) : ℕ := cfg.OTape.space_used -lemma Cfg.space_used_initCfg (tm : BinTM0) (s : List Bool) : +lemma Cfg.space_used_initCfg (tm : BinSingleTapeTM) (s : List Bool) : (tm.initCfg s).space_used = max 1 s.length := by simp [initCfg, Cfg.space_used, OTape.space_used_mk₁] -lemma Cfg.space_used_haltCfg (tm : BinTM0) (s : List Bool) : +lemma Cfg.space_used_haltCfg (tm : BinSingleTapeTM) (s : List Bool) : (tm.haltCfg s).space_used = max 1 s.length := by simp [haltCfg, Cfg.space_used, OTape.space_used_mk₁] -lemma Cfg.space_used_step {tm : BinTM0} (cfg cfg' : tm.Cfg) +lemma Cfg.space_used_step {tm : BinSingleTapeTM} (cfg cfg' : tm.Cfg) (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + 1 := by obtain ⟨_ | q, tape⟩ := cfg · simp [step] at hstep @@ -135,33 +136,33 @@ lemma Cfg.space_used_step {tm : BinTM0} (cfg cfg' : tm.Cfg) /-- A proof of tm outputting l' when given l. -/ -def Outputs (tm : BinTM0) (l : List (Bool)) (l' : List (Bool)) : Prop := +def Outputs (tm : BinSingleTapeTM) (l : List (Bool)) (l' : List (Bool)) : Prop := tm.TerminalReductionSystem.MRed (initCfg tm l) (haltCfg tm l') /-- A proof of tm outputting l' when given l in at most m steps. -/ -def OutputsWithinTime (tm : BinTM0) (l : List (Bool)) (l' : (List (Bool))) +def OutputsWithinTime (tm : BinSingleTapeTM) (l : List (Bool)) (l' : (List (Bool))) (m : ℕ) := tm.TerminalReductionSystem.reducesToWithinSteps (initCfg tm l) (haltCfg tm l') m /-- A Turing machine + a proof it outputsInTime `f`. -/ structure Computable (f : List Bool → List Bool) where - /-- the underlying bundled TM0 -/ - tm : BinTM0 + /-- the underlying bundled SingleTapeTM -/ + tm : BinSingleTapeTM /-- a proof this machine outputsInTime `f` -/ outputsFun : ∀ a, tm.Outputs a (f a) /-- A Turing machine + a time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ structure TimeComputable (f : List Bool → List Bool) where - /-- the underlying bundled TM0 -/ - tm : BinTM0 + /-- the underlying bundled SingleTapeTM -/ + tm : BinSingleTapeTM /-- a time function -/ time : ℕ → ℕ /-- proof this machine outputsInTime `f` in at most `time(input.length)` steps -/ outputsFun : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) /-- A Turing machine computing the identity. -/ -def idComputer : BinTM0 where +def idComputer : BinSingleTapeTM where Λ := PUnit q₀ := PUnit.unit M := fun _ b => ⟨(b, none), none⟩ @@ -184,7 +185,7 @@ def TimeComputable.id : TimeComputable id := def compComputer {f : List Bool → List Bool} {g : List Bool → List Bool} (hf : TimeComputable f) (hg : TimeComputable g) : - BinTM0 := + BinSingleTapeTM := { Λ := hf.tm.Λ ⊕ hg.tm.Λ q₀ := Sum.inl hf.tm.q₀ @@ -434,7 +435,7 @@ theorem comp_right_simulation -lemma output_length_le_input_length_add_time (tm : BinTM0) (l l' : List Bool) (t : ℕ) +lemma output_length_le_input_length_add_time (tm : BinSingleTapeTM) (l l' : List Bool) (t : ℕ) (h : tm.OutputsWithinTime l l' t) : l'.length ≤ max 1 l.length + t := by unfold OutputsWithinTime at h @@ -569,6 +570,6 @@ noncomputable def PolyTimeComputable.comp end PolyTime -end BinTM0 +end BinSingleTapeTM end Turing From 68c6ae4112861f84386e09b5fb291808ac719d3c Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 13:51:41 -0800 Subject: [PATCH 10/95] generalize alphabet --- .../Machines/SingleTapeTuring/Basic.lean | 175 ++++++++++-------- Cslib/Foundations/Data/OTape.lean | 10 +- 2 files changed, 103 insertions(+), 82 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 730755c42..1c958ff32 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -15,15 +15,12 @@ public import Mathlib.Algebra.Polynomial.Eval.Defs /-! # Single-Tape Turing Machine -Defines a single-tape Turing machine over the alphabet of `Option Bool`, +Defines a single-tape Turing machine over the alphabet of `Option α`, where `none` represents a blank OTape symbol. ## TODOs -- Generalize Bool to an arbitrary (finite?) alphabet -- switch transition system to use the `ReductionSystem` framework -- refactor polynomial time to another file -- remove unfold +- refactor polynomial time to another file? -/ @@ -31,17 +28,23 @@ open Cslib namespace Turing -namespace BinSingleTapeTM +variable {α : Type} + +namespace SingleTapeTM /-- A Turing machine "statement" is just a command to move left or right, and write a symbol on the OTape. -/ -def Stmt := (Option Bool) × Option (Dir) +def Stmt (α : Type) := (Option α) × Option Dir deriving Inhabited -end BinSingleTapeTM +end SingleTapeTM -/-- A SingleTapeTM over the alphabet of Option Bool (none is blank OTape symbol). -/ -structure BinSingleTapeTM where +/-- A SingleTapeTM over the alphabet of Option α (none is blank OTape symbol). -/ +structure SingleTapeTM (α) where + /-- Inhabited instance for the alphabet -/ + [Inhabitedα : Inhabited α] + /-- Finiteness of the alphabet -/ + [Fintypeα : Fintype α] /-- type of state labels -/ (Λ : Type) /-- finiteness of the state type -/ @@ -50,13 +53,21 @@ structure BinSingleTapeTM where (q₀ : Λ) /-- Transition function, mapping a state and a head symbol to a Stmt to invoke, and optionally a new state (none for halt) -/ - (M : Λ → (Option Bool) → (Turing.BinSingleTapeTM.Stmt × Option Λ)) + (M : Λ → (Option α) → (Turing.SingleTapeTM.Stmt α × Option Λ)) -namespace BinSingleTapeTM +namespace SingleTapeTM -section +section Cfg -variable (tm : BinSingleTapeTM) +/-! +## Configurations of a Turing Machine + +This section defines the configurations of a Turing machine, +the step function that lets the machine transition from one configuration to the next, +and the intended initial and final configurations. +-/ + +variable (tm : SingleTapeTM α) instance : Inhabited tm.Λ := ⟨tm.q₀⟩ @@ -64,14 +75,18 @@ instance : Inhabited tm.Λ := instance : Fintype tm.Λ := tm.FintypeΛ -instance inhabitedStmt : Inhabited (Stmt) := inferInstance +instance inhabitedStmt : Inhabited (Stmt α) := inferInstance -/-- The type of configurations (functions) corresponding to this TM. -/ +/-- +The configurations of a Turing machine consist of an `Option`al state +(or none for the halting state) +and an OTape representing the tape contents. +-/ structure Cfg : Type where /-- the state of the TM (or none for the halting state) -/ state : Option tm.Λ - /-- the OTape contents, which -/ - OTape : OTape (Bool) + /-- the OTape contents -/ + OTape : OTape (α) deriving Inhabited /-- The step function corresponding to this TM. -/ @@ -92,36 +107,27 @@ def step : tm.Cfg → Option tm.Cfg := q'', -- And OTape updated according to the Stmt (t.write wr).move? dir⟩ -end /-- The initial configuration corresponding to a list in the input alphabet. -/ -def initCfg (tm : BinSingleTapeTM) (s : List Bool) : tm.Cfg := ⟨some tm.q₀, OTape.mk₁ s⟩ +def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, OTape.mk₁ s⟩ /-- The final configuration corresponding to a list in the output alphabet. (We demand that the head halts at the leftmost position of the output.) -/ -def haltCfg (tm : BinSingleTapeTM) (s : List (Bool)) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ +def haltCfg (tm : SingleTapeTM α) (s : List (α)) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ -/-- -The `TerminalReductionSystem` corresponding to a `BinSingleTapeTM` -is defined by the `step` function, -which maps a configuration to its next configuration if it exists. --/ -def TerminalReductionSystem (tm : BinSingleTapeTM) : Cslib.TerminalReductionSystem (tm.Cfg) := - TerminalReductionSystem.Option tm.step - -def Cfg.space_used (tm : BinSingleTapeTM) (cfg : tm.Cfg) : ℕ := +def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := cfg.OTape.space_used -lemma Cfg.space_used_initCfg (tm : BinSingleTapeTM) (s : List Bool) : +lemma Cfg.space_used_initCfg (tm : SingleTapeTM α) (s : List α) : (tm.initCfg s).space_used = max 1 s.length := by - simp [initCfg, Cfg.space_used, OTape.space_used_mk₁] + simp only [space_used, initCfg, OTape.space_used_mk₁] -lemma Cfg.space_used_haltCfg (tm : BinSingleTapeTM) (s : List Bool) : +lemma Cfg.space_used_haltCfg (tm : SingleTapeTM α) (s : List α) : (tm.haltCfg s).space_used = max 1 s.length := by simp [haltCfg, Cfg.space_used, OTape.space_used_mk₁] -lemma Cfg.space_used_step {tm : BinSingleTapeTM} (cfg cfg' : tm.Cfg) +lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + 1 := by obtain ⟨_ | q, tape⟩ := cfg · simp [step] at hstep @@ -134,44 +140,55 @@ lemma Cfg.space_used_step {tm : BinSingleTapeTM} (cfg cfg' : tm.Cfg) have := OTape.space_used_move (tape.write wr) d simp only [Cfg.space_used, OTape.move?, OTape.space_used_write] at this ⊢; exact this +end Cfg + +/-- +The `TerminalReductionSystem` corresponding to a `SingleTapeTM α` +is defined by the `step` function, +which maps a configuration to its next configuration if it exists. +-/ +def TerminalReductionSystem (tm : SingleTapeTM α) : Cslib.TerminalReductionSystem (tm.Cfg) := + TerminalReductionSystem.Option tm.step /-- A proof of tm outputting l' when given l. -/ -def Outputs (tm : BinSingleTapeTM) (l : List (Bool)) (l' : List (Bool)) : Prop := +def Outputs (tm : SingleTapeTM α) (l : List (α)) (l' : List (α)) : Prop := tm.TerminalReductionSystem.MRed (initCfg tm l) (haltCfg tm l') /-- A proof of tm outputting l' when given l in at most m steps. -/ -def OutputsWithinTime (tm : BinSingleTapeTM) (l : List (Bool)) (l' : (List (Bool))) +def OutputsWithinTime (tm : SingleTapeTM α) (l : List (α)) (l' : (List (α))) (m : ℕ) := tm.TerminalReductionSystem.reducesToWithinSteps (initCfg tm l) (haltCfg tm l') m /-- A Turing machine + a proof it outputsInTime `f`. -/ -structure Computable (f : List Bool → List Bool) where +structure Computable (f : List α → List α) where /-- the underlying bundled SingleTapeTM -/ - tm : BinSingleTapeTM + tm : SingleTapeTM α /-- a proof this machine outputsInTime `f` -/ outputsFun : ∀ a, tm.Outputs a (f a) /-- A Turing machine + a time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ -structure TimeComputable (f : List Bool → List Bool) where +structure TimeComputable (f : List α → List α) where /-- the underlying bundled SingleTapeTM -/ - tm : BinSingleTapeTM + tm : SingleTapeTM α /-- a time function -/ time : ℕ → ℕ /-- proof this machine outputsInTime `f` in at most `time(input.length)` steps -/ outputsFun : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) +section + +variable [Inhabited α] [Fintype α] + /-- A Turing machine computing the identity. -/ -def idComputer : BinSingleTapeTM where +def idComputer : SingleTapeTM α where Λ := PUnit q₀ := PUnit.unit M := fun _ b => ⟨(b, none), none⟩ -section - -- TODO switch to where syntax /-- A proof that the identity map on α is computable in time. -/ -def TimeComputable.id : TimeComputable id := +def TimeComputable.id : TimeComputable (α := α) id := ⟨idComputer, fun _ => 1, fun x => by refine ⟨1, le_refl 1, ?_⟩ -- Need to show reducesToInSteps for 1 step @@ -182,10 +199,10 @@ def TimeComputable.id : TimeComputable id := idComputer, step, OTape.move?] congr 1⟩ -def compComputer {f : List Bool → List Bool} {g : List Bool → List Bool} +def compComputer {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) : - BinSingleTapeTM := + SingleTapeTM α := { Λ := hf.tm.Λ ⊕ hg.tm.Λ q₀ := Sum.inl hf.tm.q₀ @@ -214,13 +231,13 @@ def compComputer {f : List Bool → List Bool} {g : List Bool → List Bool} | _ => Option.map Sum.inr stmt) } -lemma compComputer_q₀_eq (f : List Bool → List Bool) (g : List Bool → List Bool) +lemma compComputer_q₀_eq (f : List α → List α) (g : List α → List α) (hf : TimeComputable f) (hg : TimeComputable g) : (compComputer hf hg).q₀ = Sum.inl hf.tm.q₀ := rfl /-- Lift a config over a tm to a config over the comp -/ -def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} +def liftCompCfg_left {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) : (compComputer hf hg).Cfg := @@ -229,7 +246,7 @@ def liftCompCfg_left {f : List Bool → List Bool} {g : List Bool → List Bool} OTape := cfg.OTape } -def liftCompCfg_right {f : List Bool → List Bool} {g : List Bool → List Bool} +def liftCompCfg_right {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hg.tm.Cfg) : (compComputer hf hg).Cfg := @@ -239,7 +256,7 @@ def liftCompCfg_right {f : List Bool → List Bool} {g : List Bool → List Bool } theorem map_liftCompCfg_left_step - {f : List Bool → List Bool} {g : List Bool → List Bool} + {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hf.tm.Cfg) (hx : ∀ cfg, hf.tm.step x = some cfg → cfg.state.isSome) : Option.map (liftCompCfg_left hf hg) (hf.tm.step x) = @@ -269,7 +286,7 @@ theorem map_liftCompCfg_left_step /-- Helper lemma: liftCompCfg_right commutes with step for the second machine -/ theorem map_liftCompCfg_right_step - {f : List Bool → List Bool} {g : List Bool → List Bool} + {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hg.tm.Cfg) : Option.map (liftCompCfg_right hf hg) (hg.tm.step x) = @@ -287,10 +304,9 @@ theorem map_liftCompCfg_right_step | none => simp only [hM, Option.map_some, liftCompCfg_right, Option.map_none] | some q' => simp only [hM, Option.map_some, liftCompCfg_right] -/-- When the first machine would halt, the composed machine transitions to the second machine -/ -theorem comp_transition_to_right {f : List Bool → List Bool} {g : List Bool → List Bool} +theorem comp_transition_to_right {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) - (tp : OTape (Bool)) + (tp : OTape (α)) (q : hf.tm.Λ) (hM : (hf.tm.M q tp.head).2 = none) : (compComputer hf hg).step { state := some (Sum.inl q), OTape := tp } = @@ -302,7 +318,7 @@ theorem comp_transition_to_right {f : List Bool → List Bool} {g : List Bool simp only [hfM_eq] /-- Helper: lifting to Sum.inl and transitioning to Sum.inr on halt -/ -def liftCompCfg_left_or_right {f : List Bool → List Bool} {g : List Bool → List Bool} +def liftCompCfg_left_or_right {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) : (compComputer hf hg).Cfg := @@ -312,7 +328,7 @@ def liftCompCfg_left_or_right {f : List Bool → List Bool} {g : List Bool → L /-- The lifting function commutes with step, converting halt to transition -/ theorem map_liftCompCfg_left_or_right_step - {f : List Bool → List Bool} {g : List Bool → List Bool} + {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hf.tm.Cfg) (hx : x.state.isSome) : @@ -332,7 +348,7 @@ theorem map_liftCompCfg_left_or_right_step /-- General simulation: if the first machine goes from cfg to halt, the composed machine goes from lifted cfg to Sum.inr hg.tm.q₀ -/ -theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Bool → List Bool} +theorem comp_left_simulation_general {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) (hcfg : cfg.state.isSome) @@ -351,9 +367,6 @@ theorem comp_left_simulation_general {f : List Bool → List Bool} {g : List Boo -- When the first machine halts, the composed machine transitions to Sum.inr hg.tm.q₀. induction steps generalizing cfg haltCfg with | zero => - -- rw [ReductionSystem.reducesToInSteps.zero_iff] at h - -- rw [ReductionSystem.reducesToInSteps.zero_iff] - -- rw [h] simp only [ReductionSystem.reducesToInSteps.zero_iff] at h ⊢ rw [h] | succ n ih => @@ -389,9 +402,9 @@ runs from start (with Sum.inl state) to Sum.inr hg.tm.q₀ (the start of the sec This takes the same number of steps because the halt transition becomes a transition to the second machine. -/ -theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → List Bool} +theorem comp_left_simulation {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) - (a : List Bool) + (a : List α) (hf_outputsFun : hf.tm.TerminalReductionSystem.reducesToWithinSteps { state := some hf.tm.q₀, OTape := OTape.mk₁ a } @@ -416,7 +429,7 @@ theorem comp_left_simulation {f : List Bool → List Bool} {g : List Bool → Li /-- Simulation lemma for the second machine in the composed computer -/ theorem comp_right_simulation - {f : List Bool → List Bool} {g : List Bool → List Bool} + {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hg.tm.Cfg) (y : hg.tm.Cfg) (m : ℕ) (h : hg.tm.TerminalReductionSystem.reducesToWithinSteps x y m) : @@ -426,19 +439,23 @@ theorem comp_right_simulation m := by refine Cslib.ReductionSystem.reducesToWithinSteps.map (liftCompCfg_right hf hg) ?_ h intro a b hab - -- hab : hg.tm.step a = some b (this is Red for TerminalReductionSystem.Option) - -- Need: (compComputer hf hg).step (liftCompCfg_right hf hg a) = some (liftCompCfg_right hf hg b) have h1 := map_liftCompCfg_right_step hf hg a rw [hab, Option.map_some] at h1 exact h1.symm - - - -lemma output_length_le_input_length_add_time (tm : BinSingleTapeTM) (l l' : List Bool) (t : ℕ) +/-- +Lemma about the size blow-up of the output of a Turing machine +relative to its input length and time bound. +This lemma states that the length of the output list is bounded by the time the TM runs +(and the input length). +This is important for guaranteeing that composition of polynomial time Turing machines +remains polynomial time, as the input to the second machine +is bounded by the output length of the first machine. +-/ +lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List α) (t : ℕ) (h : tm.OutputsWithinTime l l' t) : l'.length ≤ max 1 l.length + t := by - unfold OutputsWithinTime at h + simp only [OutputsWithinTime] at h obtain ⟨steps, hsteps_le, hevals⟩ := h replace hevals := hevals.small_change specialize hevals (Cfg.space_used tm) @@ -470,7 +487,7 @@ evals to the intermediate state from the start state and then from the intermediate state to the final state. -/ def TimeComputable.comp - {f : List Bool → List Bool} {g : List Bool → List Bool} + {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (h_mono : Monotone hg.time) : (TimeComputable (g ∘ f)) where @@ -521,23 +538,27 @@ and proves that * The identity function is polynomial time computable * The composition of two polynomial time computable functions is polynomial time computable +### TODO +Use of mathlib's `Polynomial` type leads to noncomputable definitions here. +Perhaps we could switch to a computable polynomial representation? -/ section PolyTime --- TODO noncomputable due to use of Polynomial --- perhaps could we switch to one of those computable polynomial representations? +variable [Inhabited α] [Fintype α] + + /-- A Turing machine + a polynomial time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ -structure PolyTimeComputable (f : List Bool → List Bool) extends TimeComputable f where +structure PolyTimeComputable (f : List α → List α) extends TimeComputable f where /-- a polynomial time bound -/ poly : Polynomial ℕ /-- proof that this machine outputsInTime `f` in at most `time(input.length)` steps -/ bounds : ∀ n, time n ≤ poly.eval n /-- A proof that the identity map on α is computable in polytime. -/ -noncomputable def PolyTimeComputable.id : @PolyTimeComputable id where +noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id where toTimeComputable := TimeComputable.id poly := 1 bounds n := by simp only [TimeComputable.id, Polynomial.eval_one, le_refl] @@ -546,7 +567,7 @@ noncomputable def PolyTimeComputable.id : @PolyTimeComputable id where A proof that the composition of two polytime computable functions is polytime computable. -/ noncomputable def PolyTimeComputable.comp - {f : List Bool → List Bool} {g : List Bool → List Bool} + {f : List α → List α} {g : List α → List α} (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) -- all Nat polynomials are monotone, but the tighter internal bound maybe is not, awkwardly @@ -570,6 +591,6 @@ noncomputable def PolyTimeComputable.comp end PolyTime -end BinSingleTapeTM +end SingleTapeTM end Turing diff --git a/Cslib/Foundations/Data/OTape.lean b/Cslib/Foundations/Data/OTape.lean index b2de4065c..cad574d12 100644 --- a/Cslib/Foundations/Data/OTape.lean +++ b/Cslib/Foundations/Data/OTape.lean @@ -54,7 +54,7 @@ structure OTape (α : Type) where (right : OList α) deriving Inhabited -def OTape.mk₁ (l : List Bool) : OTape Bool := +def OTape.mk₁ {α} (l : List α) : OTape α := match l with | [] => { head := none, left := OList.empty, right := OList.empty } | h :: t => { head := some h, left := OList.empty, right := OList.map_some t } @@ -79,14 +79,14 @@ def OTape.write {α} : Turing.OTape α → Option α → Turing.OTape α The space used by a OTape is the number of symbols between and including the head, and leftmost and rightmost non-blank symbols on the OTape -/ -def OTape.space_used {α} [Inhabited α] (t : Turing.OTape α) : ℕ := +def OTape.space_used {α} (t : Turing.OTape α) : ℕ := 1 + t.left.length + t.right.length -lemma OTape.space_used_write {α} [Inhabited α] (t : Turing.OTape α) (a : Option α) : +lemma OTape.space_used_write {α} (t : Turing.OTape α) (a : Option α) : (t.write a).space_used = t.space_used := by rfl -lemma OTape.space_used_mk₁ (l : List Bool) : +lemma OTape.space_used_mk₁ (l : List α) : (OTape.mk₁ l).space_used = max 1 l.length := by cases l with | nil => @@ -95,7 +95,7 @@ lemma OTape.space_used_mk₁ (l : List Bool) : simp [mk₁, space_used, OList.length_empty, OList.length_map_some] omega -lemma OTape.space_used_move {α} [Inhabited α] (t : Turing.OTape α) (d : Dir) : +lemma OTape.space_used_move {α} (t : Turing.OTape α) (d : Dir) : (t.move d).space_used ≤ t.space_used + 1 := by cases d with | left => From 6cb8c862fd8b4c16422a7bc4639b5defb8798947 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 13:58:01 -0800 Subject: [PATCH 11/95] move blowuplemma earlier --- .../Machines/SingleTapeTuring/Basic.lean | 46 +++++++++---------- .../Semantics/ReductionSystem/Basic.lean | 6 +-- 2 files changed, 25 insertions(+), 27 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 1c958ff32..5c31b64fc 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -16,7 +16,7 @@ public import Mathlib.Algebra.Polynomial.Eval.Defs # Single-Tape Turing Machine Defines a single-tape Turing machine over the alphabet of `Option α`, -where `none` represents a blank OTape symbol. +where `none` represents a blank `OTape` symbol. ## TODOs @@ -33,7 +33,7 @@ variable {α : Type} namespace SingleTapeTM /-- A Turing machine "statement" is just a command to move - left or right, and write a symbol on the OTape. -/ + left or right, and write a symbol on the `OTape`. -/ def Stmt (α : Type) := (Option α) × Option Dir deriving Inhabited @@ -159,6 +159,26 @@ def OutputsWithinTime (tm : SingleTapeTM α) (l : List (α)) (l' : (List (α))) (m : ℕ) := tm.TerminalReductionSystem.reducesToWithinSteps (initCfg tm l) (haltCfg tm l') m +/-- +This lemma bounds the size blow-up of the output of a Turing machine. +It states that the increase in length of the output over the input is bounded by the runtime. +This is important for guaranteeing that composition of polynomial time Turing machines +remains polynomial time, as the input to the second machine +is bounded by the output length of the first machine. +-/ +lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List α) (t : ℕ) + (h : tm.OutputsWithinTime l l' t) : + l'.length ≤ max 1 l.length + t := by + simp only [OutputsWithinTime] at h + obtain ⟨steps, hsteps_le, hevals⟩ := h + replace hevals := hevals.small_change + specialize hevals (Cfg.space_used tm) + simp only [Cfg.space_used_initCfg, Cfg.space_used_haltCfg] at hevals + suffices l'.length ≤ max 1 l.length + steps + by omega + specialize hevals fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep) + omega + /-- A Turing machine + a proof it outputsInTime `f`. -/ structure Computable (f : List α → List α) where /-- the underlying bundled SingleTapeTM -/ @@ -443,28 +463,6 @@ theorem comp_right_simulation rw [hab, Option.map_some] at h1 exact h1.symm -/-- -Lemma about the size blow-up of the output of a Turing machine -relative to its input length and time bound. -This lemma states that the length of the output list is bounded by the time the TM runs -(and the input length). -This is important for guaranteeing that composition of polynomial time Turing machines -remains polynomial time, as the input to the second machine -is bounded by the output length of the first machine. --/ -lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List α) (t : ℕ) - (h : tm.OutputsWithinTime l l' t) : - l'.length ≤ max 1 l.length + t := by - simp only [OutputsWithinTime] at h - obtain ⟨steps, hsteps_le, hevals⟩ := h - replace hevals := hevals.small_change - specialize hevals (Cfg.space_used tm) - simp only [Cfg.space_used_initCfg, Cfg.space_used_haltCfg] at hevals - suffices l'.length ≤ max 1 l.length + steps - by omega - specialize hevals fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep) - omega - /-- A composition for TimeComputable. diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index fc01c18d9..a53a9f8c1 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -249,9 +249,9 @@ lemma ReductionSystem.reducesToWithinSteps.zero_iff {rs : ReductionSystem Term} end Steps /-- -Given a map σ → Option σ, we can construct a terminal reduction system on `σ` -where a term is terminal if it maps to `none` under the given function. -and otherwise is reducible to its `some` value under the given function. +Given a map σ → Option σ, we can construct a terminal reduction system on `σ` where: +* a term is terminal if it maps to `none` under the given function, +* and otherwise is reducible to its `some` value under the given function. -/ def TerminalReductionSystem.Option {σ : Type*} (f : σ → Option σ) : TerminalReductionSystem σ where Red := fun a b => f a = some b From 33d74e8c7f4f3e07effaeef4c192acdeed1692a4 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 14:06:32 -0800 Subject: [PATCH 12/95] Stmt API --- .../Machines/SingleTapeTuring/Basic.lean | 33 ++++++++++++------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 5c31b64fc..20bc37ec6 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -20,6 +20,7 @@ where `none` represents a blank `OTape` symbol. ## TODOs +- encoding? - refactor polynomial time to another file? -/ @@ -32,15 +33,24 @@ variable {α : Type} namespace SingleTapeTM -/-- A Turing machine "statement" is just a command to move - left or right, and write a symbol on the `OTape`. -/ -def Stmt (α : Type) := (Option α) × Option Dir +-- TODO make into a structure? +/-- +A Turing machine "statement" is just a `Option`al command to move left or right, +and write a symbol on the `OTape`. +-/ +def Stmt (α : Type) := Option α × Option Dir deriving Inhabited +def Stmt.symbol : Stmt α → Option α + | (symbol, _) => symbol + +def Stmt.movement : Stmt α → Option Dir + | (_, movement) => movement + end SingleTapeTM /-- A SingleTapeTM over the alphabet of Option α (none is blank OTape symbol). -/ -structure SingleTapeTM (α) where +structure SingleTapeTM α where /-- Inhabited instance for the alphabet -/ [Inhabitedα : Inhabited α] /-- Finiteness of the alphabet -/ @@ -86,7 +96,7 @@ structure Cfg : Type where /-- the state of the TM (or none for the halting state) -/ state : Option tm.Λ /-- the OTape contents -/ - OTape : OTape (α) + OTape : OTape α deriving Inhabited /-- The step function corresponding to this TM. -/ @@ -114,7 +124,7 @@ def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, OT /-- The final configuration corresponding to a list in the output alphabet. (We demand that the head halts at the leftmost position of the output.) -/ -def haltCfg (tm : SingleTapeTM α) (s : List (α)) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ +def haltCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := cfg.OTape.space_used @@ -151,11 +161,11 @@ def TerminalReductionSystem (tm : SingleTapeTM α) : Cslib.TerminalReductionSyst TerminalReductionSystem.Option tm.step /-- A proof of tm outputting l' when given l. -/ -def Outputs (tm : SingleTapeTM α) (l : List (α)) (l' : List (α)) : Prop := +def Outputs (tm : SingleTapeTM α) (l : List α) (l' : List α) : Prop := tm.TerminalReductionSystem.MRed (initCfg tm l) (haltCfg tm l') /-- A proof of tm outputting l' when given l in at most m steps. -/ -def OutputsWithinTime (tm : SingleTapeTM α) (l : List (α)) (l' : (List (α))) +def OutputsWithinTime (tm : SingleTapeTM α) (l : List α) (l' : List α) (m : ℕ) := tm.TerminalReductionSystem.reducesToWithinSteps (initCfg tm l) (haltCfg tm l') m @@ -326,13 +336,14 @@ theorem map_liftCompCfg_right_step theorem comp_transition_to_right {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) - (tp : OTape (α)) + (tp : OTape α) (q : hf.tm.Λ) (hM : (hf.tm.M q tp.head).2 = none) : (compComputer hf hg).step { state := some (Sum.inl q), OTape := tp } = some { state := some (Sum.inr hg.tm.q₀), - OTape := (tp.write (hf.tm.M q tp.head).1.1).move? (hf.tm.M q tp.head).1.2 } := by - simp only [step, compComputer, hM] + OTape := (tp.write (hf.tm.M q tp.head).1.symbol).move? + (hf.tm.M q tp.head).1.movement } := by + simp only [step, compComputer, hM, Stmt.symbol, Stmt.movement] generalize hfM_eq : hf.tm.M q tp.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result simp only [hfM_eq] From 24bd6de239a3ced53eb7d56167b9b2350d7e07ae Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sat, 17 Jan 2026 14:11:59 -0800 Subject: [PATCH 13/95] clean up reduction --- .../Machines/SingleTapeTuring/Basic.lean | 2 +- .../Semantics/ReductionSystem/Basic.lean | 16 +++++++++------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 20bc37ec6..a5756591e 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -181,7 +181,7 @@ lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List l'.length ≤ max 1 l.length + t := by simp only [OutputsWithinTime] at h obtain ⟨steps, hsteps_le, hevals⟩ := h - replace hevals := hevals.small_change + replace hevals := hevals.bounded_increase specialize hevals (Cfg.space_used tm) simp only [Cfg.space_used_initCfg, Cfg.space_used_haltCfg] at hevals suffices l'.length ≤ max 1 l.length + steps diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index a53a9f8c1..b1b8127cb 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -10,9 +10,6 @@ public import Cslib.Init public import Mathlib.Logic.Relation public import Mathlib.Util.Notation3 --- TODO remove this import -public import Mathlib.Algebra.Polynomial.Eval.Defs - @[expose] public section /-! @@ -127,7 +124,7 @@ lemma ReductionSystem.reducesToInSteps.succ'_iff simp only [Nat.add_one] at this exact this -lemma ReductionSystem.reducesToInSteps.small_change +lemma ReductionSystem.reducesToInSteps.bounded_increase {rs : ReductionSystem Term} {a b : Term} (h : Term → ℕ) (h_step : ∀ a b, rs.Red a b → h b ≤ h a + 1) (m : ℕ) @@ -154,7 +151,12 @@ lemma ReductionSystem.reducesToInSteps.map {Term Term' : Type*} | cons t t' t'' m h_red h_steps ih => exact reducesToInSteps.cons (g t) (g t') (g t'') m (hg t t' h_red) ih -def ReductionSystem.reducesToWithinSteps (rs : ReductionSystem Term) (a b : Term) (n : ℕ) : Prop := +/-- +`reducesToWithinSteps` is a variant of `reducesToInSteps` that allows for a loose bound. +It states that a term `a` reduces to a term `b` in *at most* `n` steps. +-/ +def ReductionSystem.reducesToWithinSteps (rs : ReductionSystem Term) + (a b : Term) (n : ℕ) : Prop := ∃ m ≤ n, reducesToInSteps rs a b m /-- Reflexivity of `reducesToWithinSteps` in 0 steps. -/ @@ -189,14 +191,14 @@ lemma ReductionSystem.reducesToWithinSteps.mono_steps {rs : ReductionSystem Term /-- If `h : Term → ℕ` increases by at most 1 on each step of `rs`, then the value of `h` at the output is at most `h` at the input plus the step bound. -/ -lemma ReductionSystem.reducesToWithinSteps.small_change {rs : ReductionSystem Term} +lemma ReductionSystem.reducesToWithinSteps.bounded_increase {rs : ReductionSystem Term} {a b : Term} (h : Term → ℕ) (h_step : ∀ a b, rs.Red a b → h b ≤ h a + 1) (n : ℕ) (hevals : reducesToWithinSteps rs a b n) : h b ≤ h a + n := by obtain ⟨m, hm, hevals_m⟩ := hevals - have := reducesToInSteps.small_change h h_step m hevals_m + have := reducesToInSteps.bounded_increase h h_step m hevals_m omega /-- From 21fe2382a0eea9d8a5b71a24967c2678db516ba6 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Wed, 21 Jan 2026 16:41:56 -0800 Subject: [PATCH 14/95] More comments --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 5 ++++- Cslib/Foundations/Data/OList.lean | 7 +++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index a5756591e..f86de1361 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -501,6 +501,7 @@ def TimeComputable.comp (h_mono : Monotone hg.time) : (TimeComputable (g ∘ f)) where tm := compComputer hf hg + -- perhaps it would be good to track the blow up separately? time l := (hf.time l) + hg.time (max 1 l + hf.time l) outputsFun a := by have hf_outputsFun := hf.outputsFun a @@ -549,8 +550,10 @@ and proves that ### TODO -Use of mathlib's `Polynomial` type leads to noncomputable definitions here. +- Use of mathlib's `Polynomial` type leads to noncomputable definitions here. Perhaps we could switch to a computable polynomial representation? +- Move to dedicated file? + -/ section PolyTime diff --git a/Cslib/Foundations/Data/OList.lean b/Cslib/Foundations/Data/OList.lean index c3c724ca5..7bbaac1a8 100644 --- a/Cslib/Foundations/Data/OList.lean +++ b/Cslib/Foundations/Data/OList.lean @@ -15,6 +15,13 @@ public import Mathlib.Data.List.Basic This file defines `OList`, a list of option values where the list cannot end with `none`. This is useful for representing tape contents where trailing blanks are not stored. + +## TODO + +- Rename, as this collides with `OList` in Haskell. +- Maype just bitape and unitape? +- Can we make pattern matching syntax work? + -/ namespace Turing From ed9474ba26e71d302ab890bf29a41cf32e431a67 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 18:40:24 -0800 Subject: [PATCH 15/95] rename to `BiTape` and `StackTape` --- .../Machines/SingleTapeTuring/Basic.lean | 98 ++++++++-------- .../Data/{OTape.lean => BiTape.lean} | 62 +++++------ Cslib/Foundations/Data/OList.lean | 105 ------------------ Cslib/Foundations/Data/StackTape.lean | 105 ++++++++++++++++++ 4 files changed, 185 insertions(+), 185 deletions(-) rename Cslib/Foundations/Data/{OTape.lean => BiTape.lean} (51%) delete mode 100644 Cslib/Foundations/Data/OList.lean create mode 100644 Cslib/Foundations/Data/StackTape.lean diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index f86de1361..eb40c9749 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -1,12 +1,12 @@ /- -Copyright (c) 2025 Bolton Bailey. All rights reserved. +Copyright (c) 2026 Bolton Bailey. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bolton Bailey TODO add the authors of the mathlib file this is based on +Authors: Bolton Bailey, Pim Spelier, Daan van Gent -/ module -public import Cslib.Foundations.Data.OTape +public import Cslib.Foundations.Data.BiTape public import Cslib.Foundations.Semantics.ReductionSystem.Basic public import Mathlib.Algebra.Polynomial.Eval.Defs @@ -16,7 +16,7 @@ public import Mathlib.Algebra.Polynomial.Eval.Defs # Single-Tape Turing Machine Defines a single-tape Turing machine over the alphabet of `Option α`, -where `none` represents a blank `OTape` symbol. +where `none` represents a blank `BiTape` symbol. ## TODOs @@ -36,7 +36,7 @@ namespace SingleTapeTM -- TODO make into a structure? /-- A Turing machine "statement" is just a `Option`al command to move left or right, -and write a symbol on the `OTape`. +and write a symbol on the `BiTape`. -/ def Stmt (α : Type) := Option α × Option Dir deriving Inhabited @@ -49,7 +49,7 @@ def Stmt.movement : Stmt α → Option Dir end SingleTapeTM -/-- A SingleTapeTM over the alphabet of Option α (none is blank OTape symbol). -/ +/-- A SingleTapeTM over the alphabet of Option α (none is blank BiTape symbol). -/ structure SingleTapeTM α where /-- Inhabited instance for the alphabet -/ [Inhabitedα : Inhabited α] @@ -90,13 +90,13 @@ instance inhabitedStmt : Inhabited (Stmt α) := inferInstance /-- The configurations of a Turing machine consist of an `Option`al state (or none for the halting state) -and an OTape representing the tape contents. +and an BiTape representing the tape contents. -/ structure Cfg : Type where /-- the state of the TM (or none for the halting state) -/ state : Option tm.Λ - /-- the OTape contents -/ - OTape : OTape α + /-- the BiTape contents -/ + BiTape : BiTape α deriving Inhabited /-- The step function corresponding to this TM. -/ @@ -115,27 +115,27 @@ def step : tm.Cfg → Option tm.Cfg := some ⟨ -- With state q'' (or none for halting) q'', - -- And OTape updated according to the Stmt + -- And BiTape updated according to the Stmt (t.write wr).move? dir⟩ /-- The initial configuration corresponding to a list in the input alphabet. -/ -def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, OTape.mk₁ s⟩ +def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, BiTape.mk₁ s⟩ /-- The final configuration corresponding to a list in the output alphabet. (We demand that the head halts at the leftmost position of the output.) -/ -def haltCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨none, OTape.mk₁ s⟩ +def haltCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨none, BiTape.mk₁ s⟩ def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := - cfg.OTape.space_used + cfg.BiTape.space_used lemma Cfg.space_used_initCfg (tm : SingleTapeTM α) (s : List α) : (tm.initCfg s).space_used = max 1 s.length := by - simp only [space_used, initCfg, OTape.space_used_mk₁] + simp only [space_used, initCfg, BiTape.space_used_mk₁] lemma Cfg.space_used_haltCfg (tm : SingleTapeTM α) (s : List α) : (tm.haltCfg s).space_used = max 1 s.length := by - simp [haltCfg, Cfg.space_used, OTape.space_used_mk₁] + simp [haltCfg, Cfg.space_used, BiTape.space_used_mk₁] lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + 1 := by @@ -145,10 +145,10 @@ lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) generalize hM : tm.M q tape.head = result at hstep obtain ⟨⟨wr, dir⟩, q''⟩ := result cases hstep; cases dir with - | none => simp [Cfg.space_used, OTape.move?, OTape.space_used_write] + | none => simp [Cfg.space_used, BiTape.move?, BiTape.space_used_write] | some d => - have := OTape.space_used_move (tape.write wr) d - simp only [Cfg.space_used, OTape.move?, OTape.space_used_write] at this ⊢; exact this + have := BiTape.space_used_move (tape.write wr) d + simp only [Cfg.space_used, BiTape.move?, BiTape.space_used_write] at this ⊢; exact this end Cfg @@ -226,7 +226,7 @@ def TimeComputable.id : TimeComputable (α := α) id := (Cslib.ReductionSystem.reducesToInSteps.refl _) -- Show the single step reduction: step (init x) = some (halt x) simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option, initCfg, haltCfg, - idComputer, step, OTape.move?] + idComputer, step, BiTape.move?] congr 1⟩ def compComputer {f : List α → List α} {g : List α → List α} @@ -273,7 +273,7 @@ def liftCompCfg_left {f : List α → List α} {g : List α → List α} (compComputer hf hg).Cfg := { state := Option.map Sum.inl cfg.state - OTape := cfg.OTape + BiTape := cfg.BiTape } def liftCompCfg_right {f : List α → List α} {g : List α → List α} @@ -282,7 +282,7 @@ def liftCompCfg_right {f : List α → List α} {g : List α → List α} (compComputer hf hg).Cfg := { state := Option.map Sum.inr cfg.state - OTape := cfg.OTape + BiTape := cfg.BiTape } theorem map_liftCompCfg_left_step @@ -292,7 +292,7 @@ theorem map_liftCompCfg_left_step Option.map (liftCompCfg_left hf hg) (hf.tm.step x) = (compComputer hf hg).step (liftCompCfg_left hf hg x) := by cases x with - | mk state OTape => + | mk state BiTape => cases state with | none => -- x is already in halting state, step returns none on both sides @@ -300,7 +300,7 @@ theorem map_liftCompCfg_left_step | some q => simp only [step, liftCompCfg_left, compComputer, Option.map_some] -- Get the transition result - generalize hM : hf.tm.M q OTape.head = result + generalize hM : hf.tm.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result simp only -- Case on whether the next state is none (halting) or some @@ -308,7 +308,7 @@ theorem map_liftCompCfg_left_step | none => -- The first machine halts, but hx says the result has state.isSome simp only [step, hM] at hx - have := hx ⟨none, (OTape.write wr).move? dir⟩ rfl + have := hx ⟨none, (BiTape.write wr).move? dir⟩ rfl simp at this | some q' => -- Normal step case - both sides produce the lifted config @@ -322,13 +322,13 @@ theorem map_liftCompCfg_right_step Option.map (liftCompCfg_right hf hg) (hg.tm.step x) = (compComputer hf hg).step (liftCompCfg_right hf hg x) := by cases x with - | mk state OTape => + | mk state BiTape => cases state with | none => simp only [step, liftCompCfg_right, Option.map_none, compComputer] | some q => simp only [step, liftCompCfg_right, compComputer, Option.map_some] - generalize hM : hg.tm.M q OTape.head = result + generalize hM : hg.tm.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result cases nextState with | none => simp only [hM, Option.map_some, liftCompCfg_right, Option.map_none] @@ -336,12 +336,12 @@ theorem map_liftCompCfg_right_step theorem comp_transition_to_right {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) - (tp : OTape α) + (tp : BiTape α) (q : hf.tm.Λ) (hM : (hf.tm.M q tp.head).2 = none) : - (compComputer hf hg).step { state := some (Sum.inl q), OTape := tp } = + (compComputer hf hg).step { state := some (Sum.inl q), BiTape := tp } = some { state := some (Sum.inr hg.tm.q₀), - OTape := (tp.write (hf.tm.M q tp.head).1.symbol).move? + BiTape := (tp.write (hf.tm.M q tp.head).1.symbol).move? (hf.tm.M q tp.head).1.movement } := by simp only [step, compComputer, hM, Stmt.symbol, Stmt.movement] generalize hfM_eq : hf.tm.M q tp.head = result @@ -354,8 +354,8 @@ def liftCompCfg_left_or_right {f : List α → List α} {g : List α → List α (cfg : hf.tm.Cfg) : (compComputer hf hg).Cfg := match cfg.state with - | some q => { state := some (Sum.inl q), OTape := cfg.OTape } - | none => { state := some (Sum.inr hg.tm.q₀), OTape := cfg.OTape } + | some q => { state := some (Sum.inl q), BiTape := cfg.BiTape } + | none => { state := some (Sum.inr hg.tm.q₀), BiTape := cfg.BiTape } /-- The lifting function commutes with step, converting halt to transition -/ theorem map_liftCompCfg_left_or_right_step @@ -366,12 +366,12 @@ theorem map_liftCompCfg_left_or_right_step Option.map (liftCompCfg_left_or_right hf hg) (hf.tm.step x) = (compComputer hf hg).step (liftCompCfg_left_or_right hf hg x) := by cases x with - | mk state OTape => + | mk state BiTape => cases state with | none => simp at hx | some q => simp only [step, liftCompCfg_left_or_right, compComputer] - generalize hM : hf.tm.M q OTape.head = result + generalize hM : hf.tm.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result cases nextState with | none => simp only [hM, Option.map_some, liftCompCfg_left_or_right] @@ -392,8 +392,8 @@ theorem comp_left_simulation_general {f : List α → List α} {g : List α → steps := by -- Proof by induction on steps. -- Key insight: liftCompCfg_left_or_right maps: - -- { state := some q, OTape } -> { state := some (Sum.inl q), OTape } - -- { state := none, OTape } -> { state := some (Sum.inr hg.tm.q₀), OTape } + -- { state := some q, BiTape } -> { state := some (Sum.inl q), BiTape } + -- { state := none, BiTape } -> { state := some (Sum.inr hg.tm.q₀), BiTape } -- For non-halting configs, the composed machine simulates exactly. -- When the first machine halts, the composed machine transitions to Sum.inr hg.tm.q₀. induction steps generalizing cfg haltCfg with @@ -412,7 +412,7 @@ theorem comp_left_simulation_general {f : List α → List α} {g : List α → · exact hcfg · exact hc_n · cases c with - | mk state OTape => + | mk state BiTape => cases state with | none => -- c is in halting state, but step of halting state is none, contradiction @@ -420,7 +420,7 @@ theorem comp_left_simulation_general {f : List α → List α} {g : List α → cases hc_step | some q => -- Use the lifting lemma - have h1 := map_liftCompCfg_left_or_right_step hf hg ⟨some q, OTape⟩ (by simp) + have h1 := map_liftCompCfg_left_or_right_step hf hg ⟨some q, BiTape⟩ (by simp) simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option] at hc_step ⊢ rw [hc_step, Option.map_some] at h1 exact h1.symm @@ -438,21 +438,21 @@ theorem comp_left_simulation {f : List α → List α} {g : List α → List α} (a : List α) (hf_outputsFun : hf.tm.TerminalReductionSystem.reducesToWithinSteps - { state := some hf.tm.q₀, OTape := OTape.mk₁ a } - ({ state := none, OTape := OTape.mk₁ (f a) }) + { state := some hf.tm.q₀, BiTape := BiTape.mk₁ a } + ({ state := none, BiTape := BiTape.mk₁ (f a) }) (hf.time a.length)) : (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps - { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ a } - ({ state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) }) + { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } + ({ state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) }) (hf.time a.length) := by obtain ⟨steps, hsteps_le, hsteps_eval⟩ := hf_outputsFun use steps constructor · exact hsteps_le · have := comp_left_simulation_general hf hg - { state := some hf.tm.q₀, OTape := OTape.mk₁ a } + { state := some hf.tm.q₀, BiTape := BiTape.mk₁ a } (by simp) - { state := none, OTape := OTape.mk₁ (f a) } + { state := none, BiTape := BiTape.mk₁ (f a) } steps hsteps_eval simp only [liftCompCfg_left_or_right] at this @@ -511,19 +511,19 @@ def TimeComputable.comp -- The computer reduces a to f a in time hf.time a have h_a_reducesTo_f_a : (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps - { state := some (Sum.inl hf.tm.q₀), OTape := OTape.mk₁ a } - { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) } + { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } + { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } (hf.time a.length) := comp_left_simulation hf hg a hf_outputsFun have h_f_a_reducesTo_g_f_a : (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps - { state := some (Sum.inr hg.tm.q₀), OTape := OTape.mk₁ (f a) } - { state := none, OTape := OTape.mk₁ (g (f a)) } + { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } + { state := none, BiTape := BiTape.mk₁ (g (f a)) } (hg.time (f a).length) := by -- Use the simulation lemma for the second machine have := comp_right_simulation hf hg - { state := some hg.tm.q₀, OTape := OTape.mk₁ (f a) } - { state := none, OTape := OTape.mk₁ (g (f a)) } + { state := some hg.tm.q₀, BiTape := BiTape.mk₁ (f a) } + { state := none, BiTape := BiTape.mk₁ (g (f a)) } (hg.time (f a).length) hg_outputsFun simp only [liftCompCfg_right] at this diff --git a/Cslib/Foundations/Data/OTape.lean b/Cslib/Foundations/Data/BiTape.lean similarity index 51% rename from Cslib/Foundations/Data/OTape.lean rename to Cslib/Foundations/Data/BiTape.lean index cad574d12..85e1b14b7 100644 --- a/Cslib/Foundations/Data/OTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -6,15 +6,15 @@ Authors: Bolton Bailey module -public import Cslib.Foundations.Data.OList +public import Cslib.Foundations.Data.StackTape public import Mathlib.Computability.TuringMachine @[expose] public section /-! -# OTape: Tape representation using OList +# BiTape: Tape representation using StackTape -This file defines `OTape`, a tape representation for Turing machines +This file defines `BiTape`, a tape representation for Turing machines in the form of an `List` of `Option` values, with the additional property that the list cannot end with `none`. @@ -29,10 +29,10 @@ will not collide. ## Main definitions -* `OTape`: A tape with a head symbol and left/right contents stored as `OList` -* `OTape.move`: Move the tape head left or right -* `OTape.write`: Write a symbol at the current head position -* `OTape.space_used`: The space used by the tape +* `BiTape`: A tape with a head symbol and left/right contents stored as `StackTape` +* `BiTape.move`: Move the tape head left or right +* `BiTape.write`: Write a symbol at the current head position +* `BiTape.space_used`: The space used by the tape -/ namespace Turing @@ -48,65 +48,65 @@ We do not assume here, but could add, that the ends of the tape are never none. The move function should guarantee this, so that two tapes are equal even if one has written none to the side -/ -structure OTape (α : Type) where +structure BiTape (α : Type) where (head : Option α) - (left : OList α) - (right : OList α) + (left : StackTape α) + (right : StackTape α) deriving Inhabited -def OTape.mk₁ {α} (l : List α) : OTape α := +def BiTape.mk₁ {α} (l : List α) : BiTape α := match l with - | [] => { head := none, left := OList.empty, right := OList.empty } - | h :: t => { head := some h, left := OList.empty, right := OList.map_some t } + | [] => { head := none, left := StackTape.empty, right := StackTape.empty } + | h :: t => { head := some h, left := StackTape.empty, right := StackTape.map_some t } -def OTape.move {α} : Turing.OTape α → Dir → Turing.OTape α +def BiTape.move {α} : Turing.BiTape α → Dir → Turing.BiTape α | t, .left => match t.left, t.head, t.right with - | l, h, r => { head := l.head, left := l.tail, right := OList.cons h r } + | l, h, r => { head := l.head, left := l.tail, right := StackTape.cons h r } | t, .right => match t.left, t.head, t.right with - | l, h, r => { head := r.head, left := OList.cons h l, right := r.tail } + | l, h, r => { head := r.head, left := StackTape.cons h l, right := r.tail } -def OTape.move? {α} : Turing.OTape α → Option Dir → Turing.OTape α +def BiTape.move? {α} : Turing.BiTape α → Option Dir → Turing.BiTape α | t, none => t | t, some d => t.move d -def OTape.write {α} : Turing.OTape α → Option α → Turing.OTape α +def BiTape.write {α} : Turing.BiTape α → Option α → Turing.BiTape α | t, a => { t with head := a } /-- -The space used by a OTape is the number of symbols -between and including the head, and leftmost and rightmost non-blank symbols on the OTape +The space used by a BiTape is the number of symbols +between and including the head, and leftmost and rightmost non-blank symbols on the BiTape -/ -def OTape.space_used {α} (t : Turing.OTape α) : ℕ := +def BiTape.space_used {α} (t : Turing.BiTape α) : ℕ := 1 + t.left.length + t.right.length -lemma OTape.space_used_write {α} (t : Turing.OTape α) (a : Option α) : +lemma BiTape.space_used_write {α} (t : Turing.BiTape α) (a : Option α) : (t.write a).space_used = t.space_used := by rfl -lemma OTape.space_used_mk₁ (l : List α) : - (OTape.mk₁ l).space_used = max 1 l.length := by +lemma BiTape.space_used_mk₁ (l : List α) : + (BiTape.mk₁ l).space_used = max 1 l.length := by cases l with | nil => - simp [mk₁, space_used, OList.length_empty] + simp [mk₁, space_used, StackTape.length_empty] | cons h t => - simp [mk₁, space_used, OList.length_empty, OList.length_map_some] + simp [mk₁, space_used, StackTape.length_empty, StackTape.length_map_some] omega -lemma OTape.space_used_move {α} (t : Turing.OTape α) (d : Dir) : +lemma BiTape.space_used_move {α} (t : Turing.BiTape α) (d : Dir) : (t.move d).space_used ≤ t.space_used + 1 := by cases d with | left => simp only [move, space_used] - have h1 := OList.length_tail_le t.left - have h2 := OList.length_cons_le t.head t.right + have h1 := StackTape.length_tail_le t.left + have h2 := StackTape.length_cons_le t.head t.right omega | right => simp only [move, space_used] - have h1 := OList.length_cons_le t.head t.left - have h2 := OList.length_tail_le t.right + have h1 := StackTape.length_cons_le t.head t.left + have h2 := StackTape.length_tail_le t.right omega end Turing diff --git a/Cslib/Foundations/Data/OList.lean b/Cslib/Foundations/Data/OList.lean deleted file mode 100644 index 7bbaac1a8..000000000 --- a/Cslib/Foundations/Data/OList.lean +++ /dev/null @@ -1,105 +0,0 @@ -/- -Copyright (c) 2025 Bolton Bailey. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bolton Bailey --/ - -module - -public import Mathlib.Data.List.Basic - -@[expose] public section - -/-! -# OList: Lists of Options that don't end with none - -This file defines `OList`, a list of option values where the list cannot end with `none`. -This is useful for representing tape contents where trailing blanks are not stored. - -## TODO - -- Rename, as this collides with `OList` in Haskell. -- Maype just bitape and unitape? -- Can we make pattern matching syntax work? - --/ - -namespace Turing - -/-- -List of option values that don't end with none --/ -structure OList (α : Type) where - (asList : List (Option α)) - -- The list can be empty (i.e. none), but if it is not empty, the last element is not (some) none - (h : asList.getLast? ≠ some none) - -def OList.empty {α} : OList α := { asList := [], h := by simp } - -def OList.map_some {α} (l : List α) : OList α := { asList := l.map some, h := by simp } - -instance {α : Type} : Inhabited (OList α) where - default := OList.empty - - -def OList.length {α} (l : OList α) : ℕ := l.asList.length - -def OList.cons {α} : Option α -> OList α -> OList α -| none, l => { asList := [], h := by simp } -| some a, l => { - asList := some a :: l.asList, - h := by - cases hl : l.asList with - | nil => simp - | cons hd tl => - simp only [List.getLast?_cons_cons] - rw [← hl] - exact l.h - } - -def OList.tail {α} (l : OList α) : OList α := - match hl : l.asList with - | [] => OList.empty - | hd :: t => { asList := t, h := by - match t with - | [] => simp - | hd' :: t' => - have lh := l.h - rw [hl] at lh - simp only [List.getLast?_cons_cons] at lh - have := l.h - rw [hl, List.getLast?_cons_cons] at this - exact this - } - -def OList.head {α} (l : OList α) : Option α := - match l.asList with - | [] => none - | h :: _ => h - -lemma OList.length_tail_le {α} (l : OList α) : l.tail.length ≤ l.length := by - unfold tail length - split - · simp [empty] - · next heq => simp [heq] - -lemma OList.length_cons_none {α} (l : OList α) : (OList.cons none l).length = 0 := by - simp [cons, length] - -lemma OList.length_cons_some {α} (a : α) (l : OList α) : - (OList.cons (some a) l).length = l.length + 1 := by - simp [cons, length] - -lemma OList.length_cons_le {α} (o : Option α) (l : OList α) : - (OList.cons o l).length ≤ l.length + 1 := by - cases o with - | none => simp [length_cons_none] - | some a => simp [length_cons_some] - -lemma OList.length_map_some {α} (l : List α) : (OList.map_some l).length = l.length := by - simp [map_some, length] - -lemma OList.length_empty {α} : (OList.empty : OList α).length = 0 := by - simp [empty, length] - -end Turing diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean new file mode 100644 index 000000000..d4648ebc3 --- /dev/null +++ b/Cslib/Foundations/Data/StackTape.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2025 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module + +public import Mathlib.Data.List.Basic + +@[expose] public section + +/-! +# StackTape: Lists of Options that don't end with none + +This file defines `StackTape`, a list of `Option` values where the list cannot end with `none`. +This is useful for representing tape contents where trailing blanks are not stored. + +## TODO + +- Rename, as this collides with `StackTape` in Haskell. +- Maype just bitape and unitape? +- Can we make pattern matching syntax work? + +-/ + +namespace Turing + +/-- +List of `Option` values that don't end with `none` +-/ +structure StackTape (α : Type) where + (asList : List (Option α)) + -- The list can be empty (i.e. `none`), + -- but if it is not empty, the last element is not (`some`) `none` + (h : asList.getLast? ≠ some none) + +def StackTape.empty {α} : StackTape α := { asList := [], h := by simp } + +def StackTape.map_some {α} (l : List α) : StackTape α := { asList := l.map some, h := by simp } + +instance {α : Type} : Inhabited (StackTape α) where + default := StackTape.empty + +def StackTape.length {α} (l : StackTape α) : ℕ := l.asList.length + +def StackTape.cons {α} : Option α -> StackTape α -> StackTape α +| none, l => { asList := [], h := by simp } +| some a, l => { + asList := some a :: l.asList, + h := by + cases hl : l.asList with + | nil => simp + | cons hd tl => + simp only [List.getLast?_cons_cons] + rw [← hl] + exact l.h + } + +def StackTape.tail {α} (l : StackTape α) : StackTape α := + match hl : l.asList with + | [] => StackTape.empty + | hd :: t => { asList := t, h := by + match t with + | [] => simp + | hd' :: t' => + have lh := l.h + rw [hl] at lh + simp only [List.getLast?_cons_cons] at lh + have := l.h + rw [hl, List.getLast?_cons_cons] at this + exact this + } + +def StackTape.head {α} (l : StackTape α) : Option α := + match l.asList with + | [] => none + | h :: _ => h + +lemma StackTape.length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by + unfold tail length + split + · simp [empty] + · next heq => simp [heq] + +lemma StackTape.length_cons_none {α} (l : StackTape α) : (StackTape.cons none l).length = 0 := by + simp [cons, length] + +lemma StackTape.length_cons_some {α} (a : α) (l : StackTape α) : + (StackTape.cons (some a) l).length = l.length + 1 := by + simp [cons, length] + +lemma StackTape.length_cons_le {α} (o : Option α) (l : StackTape α) : + (StackTape.cons o l).length ≤ l.length + 1 := by + cases o with + | none => simp [length_cons_none] + | some a => simp [length_cons_some] + +lemma StackTape.length_map_some {α} (l : List α) : (StackTape.map_some l).length = l.length := by + simp [map_some, length] + +lemma StackTape.length_empty {α} : (StackTape.empty : StackTape α).length = 0 := by + simp [empty, length] + +end Turing From 99d9df6d85ffb669af1899963aec3c16c3a76f4c Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 18:57:35 -0800 Subject: [PATCH 16/95] clean up docs --- Cslib/Foundations/Data/BiTape.lean | 8 ++++---- Cslib/Foundations/Data/StackTape.lean | 4 +--- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 85e1b14b7..80fe20137 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -1,5 +1,5 @@ /- -Copyright (c) 2025 Bolton Bailey. All rights reserved. +Copyright (c) 2026 Bolton Bailey. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bolton Bailey -/ @@ -12,7 +12,7 @@ public import Mathlib.Computability.TuringMachine @[expose] public section /-! -# BiTape: Tape representation using StackTape +# BiTape: Bidirectionally infinite TM tape representation using StackTape This file defines `BiTape`, a tape representation for Turing machines in the form of an `List` of `Option` values, @@ -23,8 +23,8 @@ with the additional property that the list cannot end with `none`. Note that Mathlib has a `Tape` type, but it requires the alphabet type to be inhabited, and considers the ends of the tape to be filled with default values. -The design that requires the tape elements to be `Option` values ensures that -Lists of the base alphabet, rendered directly onto the tape by mapping over `some`, +This design requires the tape elements to be `Option` values, and ensures that +`List`s of the base alphabet, rendered directly onto the tape by mapping over `some`, will not collide. ## Main definitions diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index d4648ebc3..b75f7b648 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -1,5 +1,5 @@ /- -Copyright (c) 2025 Bolton Bailey. All rights reserved. +Copyright (c) 2026 Bolton Bailey. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bolton Bailey -/ @@ -18,8 +18,6 @@ This is useful for representing tape contents where trailing blanks are not stor ## TODO -- Rename, as this collides with `StackTape` in Haskell. -- Maype just bitape and unitape? - Can we make pattern matching syntax work? -/ From 6aee1d9af545ab196a8c649474d742c29769ea28 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 19:31:34 -0800 Subject: [PATCH 17/95] lake exe mk_all --module --- Cslib.lean | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Cslib.lean b/Cslib.lean index 2be39bd8d..1bb8689fc 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -25,9 +25,11 @@ public import Cslib.Computability.Languages.Language public import Cslib.Computability.Languages.OmegaLanguage public import Cslib.Computability.Languages.OmegaRegularLanguage public import Cslib.Computability.Languages.RegularLanguage +public import Cslib.Computability.Machines.SingleTapeTuring.Basic public import Cslib.Foundations.Control.Monad.Free public import Cslib.Foundations.Control.Monad.Free.Effects public import Cslib.Foundations.Control.Monad.Free.Fold +public import Cslib.Foundations.Data.BiTape public import Cslib.Foundations.Data.FinFun public import Cslib.Foundations.Data.HasFresh public import Cslib.Foundations.Data.Nat.Segment @@ -38,6 +40,7 @@ public import Cslib.Foundations.Data.OmegaSequence.Init public import Cslib.Foundations.Data.OmegaSequence.Temporal public import Cslib.Foundations.Data.RelatesInSteps public import Cslib.Foundations.Data.Relation +public import Cslib.Foundations.Data.StackTape public import Cslib.Foundations.Lint.Basic public import Cslib.Foundations.Semantics.FLTS.Basic public import Cslib.Foundations.Semantics.FLTS.FLTSToLTS From 4b0e241d4078527d4f52a631ad7152f41cb86f7e Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 19:31:46 -0800 Subject: [PATCH 18/95] update StackTape description --- Cslib/Foundations/Data/StackTape.lean | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index b75f7b648..0c8c2dbc6 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -11,14 +11,16 @@ public import Mathlib.Data.List.Basic @[expose] public section /-! -# StackTape: Lists of Options that don't end with none +# StackTape: Infinite, eventually-`none` lists of `Option`s This file defines `StackTape`, a list of `Option` values where the list cannot end with `none`. -This is useful for representing tape contents where trailing blanks are not stored. +This represents a stack-like data structure +which treats the end of the list as an infinite sequence of `none` values. +This is useful as a data structure with a simple API for manipulation by Turing machines . ## TODO -- Can we make pattern matching syntax work? +- Make a `::`-like notation. -/ From 70927684c5eedee81309990127ac8461582cadd6 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 19:44:26 -0800 Subject: [PATCH 19/95] clean up bitape file --- .../Machines/SingleTapeTuring/Basic.lean | 12 ++--- Cslib/Foundations/Data/BiTape.lean | 53 ++++++++----------- 2 files changed, 28 insertions(+), 37 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index eb40c9749..e9dc7b8f3 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -116,7 +116,7 @@ def step : tm.Cfg → Option tm.Cfg := -- With state q'' (or none for halting) q'', -- And BiTape updated according to the Stmt - (t.write wr).move? dir⟩ + (t.write wr).optionMove dir⟩ /-- The initial configuration corresponding to a list in the input alphabet. -/ def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, BiTape.mk₁ s⟩ @@ -145,10 +145,10 @@ lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) generalize hM : tm.M q tape.head = result at hstep obtain ⟨⟨wr, dir⟩, q''⟩ := result cases hstep; cases dir with - | none => simp [Cfg.space_used, BiTape.move?, BiTape.space_used_write] + | none => simp [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write] | some d => have := BiTape.space_used_move (tape.write wr) d - simp only [Cfg.space_used, BiTape.move?, BiTape.space_used_write] at this ⊢; exact this + simp only [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write] at this ⊢; exact this end Cfg @@ -226,7 +226,7 @@ def TimeComputable.id : TimeComputable (α := α) id := (Cslib.ReductionSystem.reducesToInSteps.refl _) -- Show the single step reduction: step (init x) = some (halt x) simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option, initCfg, haltCfg, - idComputer, step, BiTape.move?] + idComputer, step, BiTape.optionMove] congr 1⟩ def compComputer {f : List α → List α} {g : List α → List α} @@ -308,7 +308,7 @@ theorem map_liftCompCfg_left_step | none => -- The first machine halts, but hx says the result has state.isSome simp only [step, hM] at hx - have := hx ⟨none, (BiTape.write wr).move? dir⟩ rfl + have := hx ⟨none, (BiTape.write wr).optionMove dir⟩ rfl simp at this | some q' => -- Normal step case - both sides produce the lifted config @@ -341,7 +341,7 @@ theorem comp_transition_to_right {f : List α → List α} {g : List α → List (hM : (hf.tm.M q tp.head).2 = none) : (compComputer hf hg).step { state := some (Sum.inl q), BiTape := tp } = some { state := some (Sum.inr hg.tm.q₀), - BiTape := (tp.write (hf.tm.M q tp.head).1.symbol).move? + BiTape := (tp.write (hf.tm.M q tp.head).1.symbol).optionMove (hf.tm.M q tp.head).1.movement } := by simp only [step, compComputer, hM, Stmt.symbol, Stmt.movement] generalize hfM_eq : hf.tm.M q tp.head = result diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 80fe20137..40a5c1bab 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -38,15 +38,8 @@ will not collide. namespace Turing /-- -I find this more convenient than mathlib's Tape type, -because that requires the type tobe inhabited, -and it is easy to confuse a list representing one thing with a list representing another, -if the representations are the same except for a sequence of default values at the end. - -The head of the machine is the current symbol under the tape head. -We do not assume here, but could add, that the ends of the tape are never none. -The move function should guarantee this, so that two tapes are equal -even if one has written none to the side +A structure for bidirectionally-infinite Turing machine tapes +that eventually take on blank `none` values -/ structure BiTape (α : Type) where (head : Option α) @@ -54,11 +47,19 @@ structure BiTape (α : Type) where (right : StackTape α) deriving Inhabited +/-- +Given a `List` of `α`, construct a `BiTape` by mapping the list to `some` elements +and laying them out to the right side, +with the head under the first element of the list if it exists. +-/ def BiTape.mk₁ {α} (l : List α) : BiTape α := match l with | [] => { head := none, left := StackTape.empty, right := StackTape.empty } | h :: t => { head := some h, left := StackTape.empty, right := StackTape.map_some t } +/-- +Move the head to the left or right, shifting the tape underneath it. +-/ def BiTape.move {α} : Turing.BiTape α → Dir → Turing.BiTape α | t, .left => match t.left, t.head, t.right with @@ -67,17 +68,22 @@ def BiTape.move {α} : Turing.BiTape α → Dir → Turing.BiTape α match t.left, t.head, t.right with | l, h, r => { head := r.head, left := StackTape.cons h l, right := r.tail } - -def BiTape.move? {α} : Turing.BiTape α → Option Dir → Turing.BiTape α +/-- +Optionally perform a `BiTape.move`, or do nothing if `none`. +-/ +def BiTape.optionMove {α} : Turing.BiTape α → Option Dir → Turing.BiTape α | t, none => t | t, some d => t.move d +/-- +Write a value under the head of the `BiTape`. +-/ def BiTape.write {α} : Turing.BiTape α → Option α → Turing.BiTape α | t, a => { t with head := a } /-- -The space used by a BiTape is the number of symbols -between and including the head, and leftmost and rightmost non-blank symbols on the BiTape +The space used by a `BiTape` is the number of symbols +between and including the head, and leftmost and rightmost non-blank symbols on the `BiTape`. -/ def BiTape.space_used {α} (t : Turing.BiTape α) : ℕ := 1 + t.left.length + t.right.length @@ -86,27 +92,12 @@ lemma BiTape.space_used_write {α} (t : Turing.BiTape α) (a : Option α) : (t.write a).space_used = t.space_used := by rfl -lemma BiTape.space_used_mk₁ (l : List α) : +lemma BiTape.space_used_mk₁ {α} (l : List α) : (BiTape.mk₁ l).space_used = max 1 l.length := by - cases l with - | nil => - simp [mk₁, space_used, StackTape.length_empty] - | cons h t => - simp [mk₁, space_used, StackTape.length_empty, StackTape.length_map_some] - omega + cases l <;> grind [mk₁, space_used, StackTape.length_empty, StackTape.length_map_some] lemma BiTape.space_used_move {α} (t : Turing.BiTape α) (d : Dir) : (t.move d).space_used ≤ t.space_used + 1 := by - cases d with - | left => - simp only [move, space_used] - have h1 := StackTape.length_tail_le t.left - have h2 := StackTape.length_cons_le t.head t.right - omega - | right => - simp only [move, space_used] - have h1 := StackTape.length_cons_le t.head t.left - have h2 := StackTape.length_tail_le t.right - omega + cases d <;> grind [move, space_used, StackTape.length_tail_le, StackTape.length_cons_le] end Turing From 0711013a77261fecfa1a4e1b5b21b4f7cc9bc8d5 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 20:14:30 -0800 Subject: [PATCH 20/95] use relatesInSteps API --- .../Machines/SingleTapeTuring/Basic.lean | 61 ++++++++++--------- 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index e9dc7b8f3..6ab202da9 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -7,16 +7,17 @@ Authors: Bolton Bailey, Pim Spelier, Daan van Gent module public import Cslib.Foundations.Data.BiTape -public import Cslib.Foundations.Semantics.ReductionSystem.Basic +public import Cslib.Foundations.Data.RelatesInSteps public import Mathlib.Algebra.Polynomial.Eval.Defs @[expose] public section /-! -# Single-Tape Turing Machine +# Single-Tape Turing Machines -Defines a single-tape Turing machine over the alphabet of `Option α`, -where `none` represents a blank `BiTape` symbol. +Defines a single-tape Turing machine for computing functions on `List α` for finite alphabet `α`. +These machines have access to a single bidirectionally-infinite tape (`BiTape`) +which uses symbols from `Option α`. ## TODOs @@ -25,7 +26,7 @@ where `none` represents a blank `BiTape` symbol. -/ -open Cslib +open Cslib Relation namespace Turing @@ -157,17 +158,18 @@ The `TerminalReductionSystem` corresponding to a `SingleTapeTM α` is defined by the `step` function, which maps a configuration to its next configuration if it exists. -/ -def TerminalReductionSystem (tm : SingleTapeTM α) : Cslib.TerminalReductionSystem (tm.Cfg) := - TerminalReductionSystem.Option tm.step +def TransitionRelation (tm : SingleTapeTM α) (c₁ c₂ : tm.Cfg) : Prop := + tm.step c₁ = some c₂ + /-- A proof of tm outputting l' when given l. -/ def Outputs (tm : SingleTapeTM α) (l : List α) (l' : List α) : Prop := - tm.TerminalReductionSystem.MRed (initCfg tm l) (haltCfg tm l') + ReflTransGen tm.TransitionRelation (initCfg tm l) (haltCfg tm l') /-- A proof of tm outputting l' when given l in at most m steps. -/ def OutputsWithinTime (tm : SingleTapeTM α) (l : List α) (l' : List α) (m : ℕ) := - tm.TerminalReductionSystem.reducesToWithinSteps (initCfg tm l) (haltCfg tm l') m + RelatesWithinSteps tm.TransitionRelation (initCfg tm l) (haltCfg tm l') m /-- This lemma bounds the size blow-up of the output of a Turing machine. @@ -181,7 +183,7 @@ lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List l'.length ≤ max 1 l.length + t := by simp only [OutputsWithinTime] at h obtain ⟨steps, hsteps_le, hevals⟩ := h - replace hevals := hevals.bounded_increase + replace hevals := hevals.apply_le_apply_add specialize hevals (Cfg.space_used tm) simp only [Cfg.space_used_initCfg, Cfg.space_used_haltCfg] at hevals suffices l'.length ≤ max 1 l.length + steps @@ -222,11 +224,10 @@ def TimeComputable.id : TimeComputable (α := α) id := ⟨idComputer, fun _ => 1, fun x => by refine ⟨1, le_refl 1, ?_⟩ -- Need to show reducesToInSteps for 1 step - refine Cslib.ReductionSystem.reducesToInSteps.cons _ _ _ 0 ?_ - (Cslib.ReductionSystem.reducesToInSteps.refl _) + refine RelatesInSteps.head _ _ _ 0 ?_ + (RelatesInSteps.refl _) -- Show the single step reduction: step (init x) = some (halt x) - simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option, initCfg, haltCfg, - idComputer, step, BiTape.optionMove] + simp only [TransitionRelation, initCfg, haltCfg, idComputer, step, BiTape.optionMove] congr 1⟩ def compComputer {f : List α → List α} {g : List α → List α} @@ -385,8 +386,8 @@ theorem comp_left_simulation_general {f : List α → List α} {g : List α → (hcfg : cfg.state.isSome) (haltCfg : hf.tm.Cfg) (steps : ℕ) - (h : hf.tm.TerminalReductionSystem.reducesToInSteps cfg haltCfg steps) : - (compComputer hf hg).TerminalReductionSystem.reducesToInSteps + (h : RelatesInSteps hf.tm.TransitionRelation cfg haltCfg steps) : + RelatesInSteps (compComputer hf hg).TransitionRelation (liftCompCfg_left_or_right hf hg cfg) (liftCompCfg_left_or_right hf hg haltCfg) steps := by @@ -398,13 +399,13 @@ theorem comp_left_simulation_general {f : List α → List α} {g : List α → -- When the first machine halts, the composed machine transitions to Sum.inr hg.tm.q₀. induction steps generalizing cfg haltCfg with | zero => - simp only [ReductionSystem.reducesToInSteps.zero_iff] at h ⊢ + simp only [RelatesInSteps.zero_iff] at h ⊢ rw [h] | succ n ih => -- Use the decomposition lemma: cfg evals to some intermediate c in n steps, -- and then c steps to haltCfg -- obtain ⟨c, hc_n, hc_step⟩ := EvalsToInTime.succ_decompose hf.tm.step cfg haltCfg n h - rw [ReductionSystem.reducesToInSteps.succ'_iff] at h ⊢ + rw [RelatesInSteps.succ_iff] at h ⊢ obtain ⟨c, hc_n, hc_step⟩ := h use liftCompCfg_left_or_right hf hg c constructor @@ -416,12 +417,12 @@ theorem comp_left_simulation_general {f : List α → List α} {g : List α → cases state with | none => -- c is in halting state, but step of halting state is none, contradiction - simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option, step] at hc_step + simp only [TransitionRelation, step] at hc_step cases hc_step | some q => -- Use the lifting lemma have h1 := map_liftCompCfg_left_or_right_step hf hg ⟨some q, BiTape⟩ (by simp) - simp only [TerminalReductionSystem, Cslib.TerminalReductionSystem.Option] at hc_step ⊢ + simp only [TransitionRelation] at hc_step ⊢ rw [hc_step, Option.map_some] at h1 exact h1.symm @@ -437,11 +438,11 @@ theorem comp_left_simulation {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (a : List α) (hf_outputsFun : - hf.tm.TerminalReductionSystem.reducesToWithinSteps + RelatesWithinSteps hf.tm.TransitionRelation { state := some hf.tm.q₀, BiTape := BiTape.mk₁ a } ({ state := none, BiTape := BiTape.mk₁ (f a) }) (hf.time a.length)) : - (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps + RelatesWithinSteps (compComputer hf hg).TransitionRelation { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } ({ state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) }) (hf.time a.length) := by @@ -463,12 +464,12 @@ theorem comp_right_simulation {f : List α → List α} {g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hg.tm.Cfg) (y : hg.tm.Cfg) (m : ℕ) - (h : hg.tm.TerminalReductionSystem.reducesToWithinSteps x y m) : - (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps + (h : RelatesWithinSteps hg.tm.TransitionRelation x y m) : + RelatesWithinSteps (compComputer hf hg).TransitionRelation (liftCompCfg_right hf hg x) ((liftCompCfg_right hf hg) y) m := by - refine Cslib.ReductionSystem.reducesToWithinSteps.map (liftCompCfg_right hf hg) ?_ h + refine RelatesWithinSteps.map (liftCompCfg_right hf hg) ?_ h intro a b hab have h1 := map_liftCompCfg_right_step hf hg a rw [hab, Option.map_some] at h1 @@ -510,13 +511,13 @@ def TimeComputable.comp haltCfg] at hg_outputsFun hf_outputsFun ⊢ -- The computer reduces a to f a in time hf.time a have h_a_reducesTo_f_a : - (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps + RelatesWithinSteps (compComputer hf hg).TransitionRelation { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } (hf.time a.length) := comp_left_simulation hf hg a hf_outputsFun have h_f_a_reducesTo_g_f_a : - (compComputer hf hg).TerminalReductionSystem.reducesToWithinSteps + RelatesWithinSteps (compComputer hf hg).TransitionRelation { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } { state := none, BiTape := BiTape.mk₁ (g (f a)) } (hg.time (f a).length) := by @@ -529,9 +530,9 @@ def TimeComputable.comp simp only [liftCompCfg_right] at this exact this have h_a_reducesTo_g_f_a := - Cslib.ReductionSystem.reducesToWithinSteps.trans + RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a - apply Cslib.ReductionSystem.reducesToWithinSteps.mono_steps h_a_reducesTo_g_f_a + apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a apply add_le_add · omega · apply h_mono @@ -596,7 +597,7 @@ noncomputable def PolyTimeComputable.comp · have : hg.time (max 1 n + hf.time n) ≤ hg.time (1 + n + hf.poly.eval n) := by apply h_mono apply add_le_add - · omega + · omega -- lia fails · exact hf.bounds n apply le_trans this _ exact hg.bounds (1 + n + hf.poly.eval n) From a6a1c238cbf251218dfa5c0f806c25d355aeafd3 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 20:15:31 -0800 Subject: [PATCH 21/95] revert ReductionSystem/Basic --- .../Semantics/ReductionSystem/Basic.lean | 212 ------------------ 1 file changed, 212 deletions(-) diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index b1b8127cb..5aad8a38b 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -29,11 +29,6 @@ structure ReductionSystem (Term : Type u) where /-- The reduction relation. -/ Red : Term → Term → Prop -structure TerminalReductionSystem (Term : Type u) extends ReductionSystem Term where - /-- The terminal terms. -/ - Terminal : Term → Prop - /-- A terminal term cannot be further reduced. -/ - terminal_not_reducible : ∀ t t', Terminal t → ¬ Red t t' section MultiStep @@ -55,213 +50,6 @@ theorem ReductionSystem.MRed.single (rs : ReductionSystem Term) (h : rs.Red a b) end MultiStep -section Steps - -inductive ReductionSystem.reducesToInSteps - (rs : ReductionSystem Term) : Term → Term → ℕ → Prop - | refl (t : Term) : reducesToInSteps rs t t 0 - | cons (t t' t'' : Term) (n : ℕ) (h₁ : rs.Red t t') (h₂ : reducesToInSteps rs t' t'' n) : - reducesToInSteps rs t t'' (n + 1) - -lemma ReductionSystem.reducesToInSteps.trans {rs : ReductionSystem Term} {a b c : Term} {n m : ℕ} - (h₁ : reducesToInSteps rs a b n) (h₂ : reducesToInSteps rs b c m) : - reducesToInSteps rs a c (n + m) := by - induction h₁ with - | refl _ => simp only [Nat.zero_add]; exact h₂ - | cons t t' t'' k h_red _ ih => - simp only [Nat.add_right_comm] - exact reducesToInSteps.cons t t' c (k + m) h_red (ih h₂) - -lemma ReductionSystem.reducesToInSteps.zero {rs : ReductionSystem Term} {a b : Term} - (h : reducesToInSteps rs a b 0) : - a = b := by - cases h - rfl - -@[simp] -lemma ReductionSystem.reducesToInSteps.zero_iff {rs : ReductionSystem Term} {a b : Term} : - reducesToInSteps rs a b 0 ↔ a = b := by - constructor - · exact reducesToInSteps.zero - · intro h; subst h; exact reducesToInSteps.refl a - - -lemma ReductionSystem.reducesToInSteps.succ {rs : ReductionSystem Term} {a b : Term} {n : ℕ} - (h : reducesToInSteps rs a b (n + 1)) : - ∃ t', rs.Red a t' ∧ reducesToInSteps rs t' b n := by - cases h with - | cons _ t' _ _ h_red h_steps => exact ⟨t', h_red, h_steps⟩ - -lemma ReductionSystem.reducesToInSteps.succ_iff {rs : ReductionSystem Term} {a b : Term} {n : ℕ} : - reducesToInSteps rs a b (n + 1) ↔ ∃ t', rs.Red a t' ∧ reducesToInSteps rs t' b n := by - constructor - · exact ReductionSystem.reducesToInSteps.succ - · rintro ⟨t', h_red, h_steps⟩ - exact ReductionSystem.reducesToInSteps.cons a t' b n h_red h_steps - -lemma ReductionSystem.reducesToInSteps.succ' {rs : ReductionSystem Term} {a b : Term} {n : ℕ} - (h : reducesToInSteps rs a b (n + 1)) : - ∃ t', reducesToInSteps rs a t' n ∧ rs.Red t' b := by - induction n generalizing a b with - | zero => - obtain ⟨t', h_red, h_steps⟩ := succ h - rw [zero_iff] at h_steps - subst h_steps - exact ⟨a, reducesToInSteps.refl a, h_red⟩ - | succ k ih => - obtain ⟨t', h_red, h_steps⟩ := succ h - obtain ⟨t'', h_steps', h_red'⟩ := ih h_steps - exact ⟨t'', reducesToInSteps.cons a t' t'' k h_red h_steps', h_red'⟩ - -lemma ReductionSystem.reducesToInSteps.succ'_iff - {rs : ReductionSystem Term} {a b : Term} {n : ℕ} : - reducesToInSteps rs a b (n + 1) ↔ ∃ t', reducesToInSteps rs a t' n ∧ rs.Red t' b := by - constructor - · exact succ' - · rintro ⟨t', h_steps, h_red⟩ - have h_one : reducesToInSteps rs t' b 1 := cons t' b b 0 h_red (refl b) - have := trans h_steps h_one - simp only [Nat.add_one] at this - exact this - -lemma ReductionSystem.reducesToInSteps.bounded_increase - {rs : ReductionSystem Term} {a b : Term} (h : Term → ℕ) - (h_step : ∀ a b, rs.Red a b → h b ≤ h a + 1) - (m : ℕ) - (hevals : rs.reducesToInSteps a b m) : - h b ≤ h a + m := by - induction hevals with - | refl _ => simp - | cons t t' t'' k h_red _ ih => - have h_step' := h_step t t' h_red - omega - -/-- -If `g` is a homomorphism from `rs` to `rs'` (i.e., it preserves the reduction relation), -then `reducesToInSteps` is preserved under `g`. --/ -lemma ReductionSystem.reducesToInSteps.map {Term Term' : Type*} - {rs : ReductionSystem Term} {rs' : ReductionSystem Term'} - (g : Term → Term') (hg : ∀ a b, rs.Red a b → rs'.Red (g a) (g b)) - {a b : Term} {n : ℕ} - (h : reducesToInSteps rs a b n) : - reducesToInSteps rs' (g a) (g b) n := by - induction h with - | refl t => exact reducesToInSteps.refl (g t) - | cons t t' t'' m h_red h_steps ih => - exact reducesToInSteps.cons (g t) (g t') (g t'') m (hg t t' h_red) ih - -/-- -`reducesToWithinSteps` is a variant of `reducesToInSteps` that allows for a loose bound. -It states that a term `a` reduces to a term `b` in *at most* `n` steps. --/ -def ReductionSystem.reducesToWithinSteps (rs : ReductionSystem Term) - (a b : Term) (n : ℕ) : Prop := - ∃ m ≤ n, reducesToInSteps rs a b m - -/-- Reflexivity of `reducesToWithinSteps` in 0 steps. -/ -lemma ReductionSystem.reducesToWithinSteps.refl {rs : ReductionSystem Term} (a : Term) : - reducesToWithinSteps rs a a 0 := by - use 0 - exact ⟨Nat.le_refl 0, reducesToInSteps.refl a⟩ - -/-- Transitivity of `reducesToWithinSteps` in the sum of the step bounds. -/ -@[trans] -lemma ReductionSystem.reducesToWithinSteps.trans {rs : ReductionSystem Term} - {a b c : Term} {n₁ n₂ : ℕ} - (h₁ : reducesToWithinSteps rs a b n₁) (h₂ : reducesToWithinSteps rs b c n₂) : - reducesToWithinSteps rs a c (n₁ + n₂) := by - obtain ⟨m₁, hm₁, hevals₁⟩ := h₁ - obtain ⟨m₂, hm₂, hevals₂⟩ := h₂ - use m₁ + m₂ - constructor - · omega - · exact reducesToInSteps.trans hevals₁ hevals₂ - -/-- Monotonicity of `reducesToWithinSteps` in the step bound. -/ -lemma ReductionSystem.reducesToWithinSteps.mono_steps {rs : ReductionSystem Term} - {a b : Term} {n₁ n₂ : ℕ} - (h : reducesToWithinSteps rs a b n₁) (hn : n₁ ≤ n₂) : - reducesToWithinSteps rs a b n₂ := by - obtain ⟨m, hm, hevals⟩ := h - use m - constructor - · omega - · exact hevals - -/-- If `h : Term → ℕ` increases by at most 1 on each step of `rs`, -then the value of `h` at the output is at most `h` at the input plus the step bound. -/ -lemma ReductionSystem.reducesToWithinSteps.bounded_increase {rs : ReductionSystem Term} - {a b : Term} (h : Term → ℕ) - (h_step : ∀ a b, rs.Red a b → h b ≤ h a + 1) - (n : ℕ) - (hevals : reducesToWithinSteps rs a b n) : - h b ≤ h a + n := by - obtain ⟨m, hm, hevals_m⟩ := hevals - have := reducesToInSteps.bounded_increase h h_step m hevals_m - omega - -/-- -If `g` is a homomorphism from `rs` to `rs'` (i.e., it preserves the reduction relation), -then `reducesToWithinSteps` is preserved under `g`. --/ -lemma ReductionSystem.reducesToWithinSteps.map {Term Term' : Type*} - {rs : ReductionSystem Term} {rs' : ReductionSystem Term'} - (g : Term → Term') (hg : ∀ a b, rs.Red a b → rs'.Red (g a) (g b)) - {a b : Term} {n : ℕ} - (h : reducesToWithinSteps rs a b n) : - reducesToWithinSteps rs' (g a) (g b) n := by - obtain ⟨m, hm, hevals⟩ := h - exact ⟨m, hm, reducesToInSteps.map g hg hevals⟩ - -/-- A single reduction step gives `reducesToWithinSteps` with bound 1. -/ -lemma ReductionSystem.reducesToWithinSteps.single {rs : ReductionSystem Term} - {a b : Term} (h : rs.Red a b) : - reducesToWithinSteps rs a b 1 := by - use 1 - constructor - · exact Nat.le_refl 1 - · exact reducesToInSteps.cons a b b 0 h (reducesToInSteps.refl b) - -/-- `reducesToInSteps` implies `reducesToWithinSteps` with the same bound. -/ -lemma ReductionSystem.reducesToWithinSteps.of_reducesToInSteps {rs : ReductionSystem Term} - {a b : Term} {n : ℕ} - (h : reducesToInSteps rs a b n) : - reducesToWithinSteps rs a b n := - ⟨n, Nat.le_refl n, h⟩ - -/-- Zero steps means the terms are equal. -/ -lemma ReductionSystem.reducesToWithinSteps.zero {rs : ReductionSystem Term} {a b : Term} - (h : reducesToWithinSteps rs a b 0) : - a = b := by - obtain ⟨m, hm, hevals⟩ := h - have : m = 0 := Nat.le_zero.mp hm - subst this - exact reducesToInSteps.zero hevals - -@[simp] -lemma ReductionSystem.reducesToWithinSteps.zero_iff {rs : ReductionSystem Term} {a b : Term} : - reducesToWithinSteps rs a b 0 ↔ a = b := by - constructor - · exact reducesToWithinSteps.zero - · intro h - subst h - exact reducesToWithinSteps.refl a - -end Steps - -/-- -Given a map σ → Option σ, we can construct a terminal reduction system on `σ` where: -* a term is terminal if it maps to `none` under the given function, -* and otherwise is reducible to its `some` value under the given function. --/ -def TerminalReductionSystem.Option {σ : Type*} (f : σ → Option σ) : TerminalReductionSystem σ where - Red := fun a b => f a = some b - Terminal := fun a => f a = none - terminal_not_reducible := by - intros t t' h_terminal h_red - simp [h_terminal] at h_red - open Lean Elab Meta Command Term -- thank you to Kyle Miller for this: From 7d8557b2ee16695ce0b80c3e7390d71d90f727db Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 21:05:38 -0800 Subject: [PATCH 22/95] refactor computer --- .../Machines/SingleTapeTuring/Basic.lean | 173 ++++++++++-------- 1 file changed, 93 insertions(+), 80 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 6ab202da9..268387fa5 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -19,10 +19,27 @@ Defines a single-tape Turing machine for computing functions on `List α` for fi These machines have access to a single bidirectionally-infinite tape (`BiTape`) which uses symbols from `Option α`. +## Important Declarations + +We define a number of structures related to Turing machine computation: + +* `Stmt`: the write and movement operations a TM can do in a single step. +* `SingleTapeTM`: the TM itself. +* `Cfg`: the configuration of a TM, including internal and tape state. +* `Computable f`: a TM for computing function `f`, packaged with a proof of correctness. +* `TimeComputable f`: `Computable f` additionally packaged with a bound on runtime. +* `PolyTimeComputable f`: `TimeComputable f` packaged with a polynomial bound on runtime. + +We also provide ways of constructing polynomial-runtime TMs + +* `PolyTimeComputable.id`: computes the identity function +* `PolyTimeComputable.comp`: computes the composition of polynomial time machines + ## TODOs -- encoding? -- refactor polynomial time to another file? +- Encoding of types in lists to represent computations on arbitrary types. +- Composition notation +- Check I can't put more args on the same line -/ @@ -34,7 +51,6 @@ variable {α : Type} namespace SingleTapeTM --- TODO make into a structure? /-- A Turing machine "statement" is just a `Option`al command to move left or right, and write a symbol on the `BiTape`. @@ -127,6 +143,9 @@ def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, Bi -/ def haltCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨none, BiTape.mk₁ s⟩ +/-- +The space used by a configuration is the space used by its tape. +-/ def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := cfg.BiTape.space_used @@ -154,20 +173,19 @@ lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) end Cfg /-- -The `TerminalReductionSystem` corresponding to a `SingleTapeTM α` +The `TransitionRelation` corresponding to a `SingleTapeTM α` is defined by the `step` function, -which maps a configuration to its next configuration if it exists. +which maps a configuration to its next configuration, if it exists. -/ def TransitionRelation (tm : SingleTapeTM α) (c₁ c₂ : tm.Cfg) : Prop := tm.step c₁ = some c₂ - -/-- A proof of tm outputting l' when given l. -/ -def Outputs (tm : SingleTapeTM α) (l : List α) (l' : List α) : Prop := +/-- A proof of `tm` outputting `l'` on input `l`. -/ +def Outputs (tm : SingleTapeTM α) (l l' : List α) : Prop := ReflTransGen tm.TransitionRelation (initCfg tm l) (haltCfg tm l') -/-- A proof of tm outputting l' when given l in at most m steps. -/ -def OutputsWithinTime (tm : SingleTapeTM α) (l : List α) (l' : List α) +/-- A proof of `tm` outputting `l'` on input `l` in at most `m` steps. -/ +def OutputsWithinTime (tm : SingleTapeTM α) (l l' : List α) (m : ℕ) := RelatesWithinSteps tm.TransitionRelation (initCfg tm l) (haltCfg tm l') m @@ -218,80 +236,74 @@ def idComputer : SingleTapeTM α where q₀ := PUnit.unit M := fun _ b => ⟨(b, none), none⟩ --- TODO switch to where syntax -/-- A proof that the identity map on α is computable in time. -/ -def TimeComputable.id : TimeComputable (α := α) id := - ⟨idComputer, fun _ => 1, fun x => by - refine ⟨1, le_refl 1, ?_⟩ - -- Need to show reducesToInSteps for 1 step - refine RelatesInSteps.head _ _ _ 0 ?_ - (RelatesInSteps.refl _) - -- Show the single step reduction: step (init x) = some (halt x) +/-- A Turing machine computing the composition of two other Turing machines. -/ +def compComputer (hf hg : SingleTapeTM α) : SingleTapeTM α where + Λ := hf.Λ ⊕ hg.Λ + q₀ := Sum.inl hf.q₀ + M q h := + match q with + -- If we are in the first machine's states, run that machine + | Sum.inl ql => match hf.M ql (h) with + -- The action should be the same, and the state should either be the corresponding state + -- in the first machine, or transition to the start state of the second machine if halting + | (ql', stmt) => (ql', + match stmt with + -- If it halts, transition to the start state of the second machine + | none => some (Sum.inr hg.q₀) + -- Otherwise continue as normal + | _ => Option.map Sum.inl stmt) + -- If we are in the second machine's states, run that machine + | Sum.inr qr => + match hg.M qr (h) with + -- The action should be the same, and the state should be the corresponding state + -- in the second machine, or halting if the second machine halts + | (qr', stmt) => (qr', + match stmt with + -- If it halts, transition to the halting state + | none => none + -- Otherwise continue as normal + | _ => Option.map Sum.inr stmt) + + +/-- The identity map on α is computable in constant time. -/ +def TimeComputable.id : TimeComputable (α := α) id where + tm := idComputer + time _ := 1 + outputsFun x := by + refine ⟨1, le_refl 1, RelatesInSteps.single ?_⟩ simp only [TransitionRelation, initCfg, haltCfg, idComputer, step, BiTape.optionMove] - congr 1⟩ - -def compComputer {f : List α → List α} {g : List α → List α} - (hf : TimeComputable f) - (hg : TimeComputable g) : - SingleTapeTM α := - { - Λ := hf.tm.Λ ⊕ hg.tm.Λ - q₀ := Sum.inl hf.tm.q₀ - M := fun q h => - match q with - -- If we are in the first machine's states, run that machine - | Sum.inl ql => match hf.tm.M ql (h) with - -- The action should be the same, and the state should either be the corresponding state - -- in the first machine, or transition to the start state of the second machine if halting - | (ql', stmt) => (ql', - match stmt with - -- If it halts, transition to the start state of the second machine - | none => some (Sum.inr hg.tm.q₀) - -- Otherwise continue as normal - | _ => Option.map Sum.inl stmt) - -- If we are in the second machine's states, run that machine - | Sum.inr qr => - match hg.tm.M qr (h) with - -- The action should be the same, and the state should be the corresponding state - -- in the second machine, or halting if the second machine halts - | (qr', stmt) => (qr', - match stmt with - -- If it halts, transition to the halting state - | none => none - -- Otherwise continue as normal - | _ => Option.map Sum.inr stmt) - } + rfl -lemma compComputer_q₀_eq (f : List α → List α) (g : List α → List α) +lemma compComputer_q₀_eq (f g : List α → List α) (hf : TimeComputable f) (hg : TimeComputable g) : - (compComputer hf hg).q₀ = Sum.inl hf.tm.q₀ := + (compComputer hf.tm hg.tm).q₀ = Sum.inl hf.tm.q₀ := rfl /-- Lift a config over a tm to a config over the comp -/ -def liftCompCfg_left {f : List α → List α} {g : List α → List α} +def liftCompCfg_left {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) : - (compComputer hf hg).Cfg := + (compComputer hf.tm hg.tm).Cfg := { state := Option.map Sum.inl cfg.state BiTape := cfg.BiTape } -def liftCompCfg_right {f : List α → List α} {g : List α → List α} +def liftCompCfg_right {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hg.tm.Cfg) : - (compComputer hf hg).Cfg := + (compComputer hf.tm hg.tm).Cfg := { state := Option.map Sum.inr cfg.state BiTape := cfg.BiTape } theorem map_liftCompCfg_left_step - {f : List α → List α} {g : List α → List α} + {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hf.tm.Cfg) (hx : ∀ cfg, hf.tm.step x = some cfg → cfg.state.isSome) : Option.map (liftCompCfg_left hf hg) (hf.tm.step x) = - (compComputer hf hg).step (liftCompCfg_left hf hg x) := by + (compComputer hf.tm hg.tm).step (liftCompCfg_left hf hg x) := by cases x with | mk state BiTape => cases state with @@ -317,11 +329,11 @@ theorem map_liftCompCfg_left_step /-- Helper lemma: liftCompCfg_right commutes with step for the second machine -/ theorem map_liftCompCfg_right_step - {f : List α → List α} {g : List α → List α} + {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hg.tm.Cfg) : Option.map (liftCompCfg_right hf hg) (hg.tm.step x) = - (compComputer hf hg).step (liftCompCfg_right hf hg x) := by + (compComputer hf.tm hg.tm).step (liftCompCfg_right hf hg x) := by cases x with | mk state BiTape => cases state with @@ -335,12 +347,12 @@ theorem map_liftCompCfg_right_step | none => simp only [hM, Option.map_some, liftCompCfg_right, Option.map_none] | some q' => simp only [hM, Option.map_some, liftCompCfg_right] -theorem comp_transition_to_right {f : List α → List α} {g : List α → List α} +theorem comp_transition_to_right {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (tp : BiTape α) (q : hf.tm.Λ) (hM : (hf.tm.M q tp.head).2 = none) : - (compComputer hf hg).step { state := some (Sum.inl q), BiTape := tp } = + (compComputer hf.tm hg.tm).step { state := some (Sum.inl q), BiTape := tp } = some { state := some (Sum.inr hg.tm.q₀), BiTape := (tp.write (hf.tm.M q tp.head).1.symbol).optionMove (hf.tm.M q tp.head).1.movement } := by @@ -350,22 +362,22 @@ theorem comp_transition_to_right {f : List α → List α} {g : List α → List simp only [hfM_eq] /-- Helper: lifting to Sum.inl and transitioning to Sum.inr on halt -/ -def liftCompCfg_left_or_right {f : List α → List α} {g : List α → List α} +def liftCompCfg_left_or_right {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) : - (compComputer hf hg).Cfg := + (compComputer hf.tm hg.tm).Cfg := match cfg.state with | some q => { state := some (Sum.inl q), BiTape := cfg.BiTape } | none => { state := some (Sum.inr hg.tm.q₀), BiTape := cfg.BiTape } /-- The lifting function commutes with step, converting halt to transition -/ theorem map_liftCompCfg_left_or_right_step - {f : List α → List α} {g : List α → List α} + {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hf.tm.Cfg) (hx : x.state.isSome) : Option.map (liftCompCfg_left_or_right hf hg) (hf.tm.step x) = - (compComputer hf hg).step (liftCompCfg_left_or_right hf hg x) := by + (compComputer hf.tm hg.tm).step (liftCompCfg_left_or_right hf hg x) := by cases x with | mk state BiTape => cases state with @@ -380,14 +392,14 @@ theorem map_liftCompCfg_left_or_right_step /-- General simulation: if the first machine goes from cfg to halt, the composed machine goes from lifted cfg to Sum.inr hg.tm.q₀ -/ -theorem comp_left_simulation_general {f : List α → List α} {g : List α → List α} +theorem comp_left_simulation_general {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (cfg : hf.tm.Cfg) (hcfg : cfg.state.isSome) (haltCfg : hf.tm.Cfg) (steps : ℕ) (h : RelatesInSteps hf.tm.TransitionRelation cfg haltCfg steps) : - RelatesInSteps (compComputer hf hg).TransitionRelation + RelatesInSteps (compComputer hf.tm hg.tm).TransitionRelation (liftCompCfg_left_or_right hf hg cfg) (liftCompCfg_left_or_right hf hg haltCfg) steps := by @@ -434,7 +446,7 @@ runs from start (with Sum.inl state) to Sum.inr hg.tm.q₀ (the start of the sec This takes the same number of steps because the halt transition becomes a transition to the second machine. -/ -theorem comp_left_simulation {f : List α → List α} {g : List α → List α} +theorem comp_left_simulation {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (a : List α) (hf_outputsFun : @@ -442,7 +454,7 @@ theorem comp_left_simulation {f : List α → List α} {g : List α → List α} { state := some hf.tm.q₀, BiTape := BiTape.mk₁ a } ({ state := none, BiTape := BiTape.mk₁ (f a) }) (hf.time a.length)) : - RelatesWithinSteps (compComputer hf hg).TransitionRelation + RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } ({ state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) }) (hf.time a.length) := by @@ -461,11 +473,11 @@ theorem comp_left_simulation {f : List α → List α} {g : List α → List α} /-- Simulation lemma for the second machine in the composed computer -/ theorem comp_right_simulation - {f : List α → List α} {g : List α → List α} + {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (x : hg.tm.Cfg) (y : hg.tm.Cfg) (m : ℕ) (h : RelatesWithinSteps hg.tm.TransitionRelation x y m) : - RelatesWithinSteps (compComputer hf hg).TransitionRelation + RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation (liftCompCfg_right hf hg x) ((liftCompCfg_right hf hg) y) m := by @@ -475,6 +487,8 @@ theorem comp_right_simulation rw [hab, Option.map_some] at h1 exact h1.symm + + /-- A composition for TimeComputable. @@ -497,11 +511,11 @@ evals to the intermediate state from the start state and then from the intermediate state to the final state. -/ def TimeComputable.comp - {f : List α → List α} {g : List α → List α} + {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (h_mono : Monotone hg.time) : (TimeComputable (g ∘ f)) where - tm := compComputer hf hg + tm := compComputer hf.tm hg.tm -- perhaps it would be good to track the blow up separately? time l := (hf.time l) + hg.time (max 1 l + hf.time l) outputsFun a := by @@ -511,13 +525,13 @@ def TimeComputable.comp haltCfg] at hg_outputsFun hf_outputsFun ⊢ -- The computer reduces a to f a in time hf.time a have h_a_reducesTo_f_a : - RelatesWithinSteps (compComputer hf hg).TransitionRelation + RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } (hf.time a.length) := comp_left_simulation hf hg a hf_outputsFun have h_f_a_reducesTo_g_f_a : - RelatesWithinSteps (compComputer hf hg).TransitionRelation + RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } { state := none, BiTape := BiTape.mk₁ (g (f a)) } (hg.time (f a).length) := by @@ -580,14 +594,13 @@ noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id wher A proof that the composition of two polytime computable functions is polytime computable. -/ noncomputable def PolyTimeComputable.comp - {f : List α → List α} {g : List α → List α} + {f g : List α → List α} (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) -- all Nat polynomials are monotone, but the tighter internal bound maybe is not, awkwardly (h_mono : Monotone hg.time) : PolyTimeComputable (g ∘ f) where toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono - poly := hf.poly + hg.poly.comp (1 + Polynomial.X + hf.poly) bounds n := by simp only [TimeComputable.comp, Polynomial.eval_add, Polynomial.eval_comp, Polynomial.eval_X, From b1384f7db16134eb1489658e7102291915e439f7 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 21:13:30 -0800 Subject: [PATCH 23/95] improve variable names --- .../Machines/SingleTapeTuring/Basic.lean | 39 ++++++++++--------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 268387fa5..40f7ccfa2 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -238,32 +238,33 @@ def idComputer : SingleTapeTM α where /-- A Turing machine computing the composition of two other Turing machines. -/ def compComputer (hf hg : SingleTapeTM α) : SingleTapeTM α where + -- The states of the composed machine are the disjoint union of the states of the input machines. Λ := hf.Λ ⊕ hg.Λ - q₀ := Sum.inl hf.q₀ + -- The start state is the start state of the first input machine. + q₀ := .inl hf.q₀ M q h := match q with - -- If we are in the first machine's states, run that machine - | Sum.inl ql => match hf.M ql (h) with - -- The action should be the same, and the state should either be the corresponding state - -- in the first machine, or transition to the start state of the second machine if halting - | (ql', stmt) => (ql', - match stmt with - -- If it halts, transition to the start state of the second machine - | none => some (Sum.inr hg.q₀) + -- If we are in the first input machine's states, run that machine ... + | .inl ql => match hf.M ql h with + | (stmt, state) => + -- ... taking the same tape action as the first input machine would. + (stmt, + match state with + -- If it halts, transition to the start state of the second input machine + | none => some (.inr hg.q₀) -- Otherwise continue as normal - | _ => Option.map Sum.inl stmt) - -- If we are in the second machine's states, run that machine - | Sum.inr qr => - match hg.M qr (h) with - -- The action should be the same, and the state should be the corresponding state - -- in the second machine, or halting if the second machine halts - | (qr', stmt) => (qr', - match stmt with + | _ => Option.map .inl state) + -- If we are in the second input machine's states, run that machine ... + | .inr qr => + match hg.M qr h with + | (stmt, state) => + -- ... taking the same tape action as the second input machine would. + (stmt, + match state with -- If it halts, transition to the halting state | none => none -- Otherwise continue as normal - | _ => Option.map Sum.inr stmt) - + | _ => Option.map .inr state) /-- The identity map on α is computable in constant time. -/ def TimeComputable.id : TimeComputable (α := α) id where From faca3ff27b58856fe51067d6fac8c92f8284bb59 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 21:23:23 -0800 Subject: [PATCH 24/95] claude refactor out time from composition functionality --- .../Machines/SingleTapeTuring/Basic.lean | 244 +++++++++--------- 1 file changed, 117 insertions(+), 127 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 40f7ccfa2..3932708ba 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -216,16 +216,6 @@ structure Computable (f : List α → List α) where /-- a proof this machine outputsInTime `f` -/ outputsFun : ∀ a, tm.Outputs a (f a) -/-- A Turing machine + a time function + -a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ -structure TimeComputable (f : List α → List α) where - /-- the underlying bundled SingleTapeTM -/ - tm : SingleTapeTM α - /-- a time function -/ - time : ℕ → ℕ - /-- proof this machine outputsInTime `f` in at most `time(input.length)` steps -/ - outputsFun : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) - section variable [Inhabited α] [Fintype α] @@ -266,55 +256,43 @@ def compComputer (hf hg : SingleTapeTM α) : SingleTapeTM α where -- Otherwise continue as normal | _ => Option.map .inr state) -/-- The identity map on α is computable in constant time. -/ -def TimeComputable.id : TimeComputable (α := α) id where - tm := idComputer - time _ := 1 - outputsFun x := by - refine ⟨1, le_refl 1, RelatesInSteps.single ?_⟩ - simp only [TransitionRelation, initCfg, haltCfg, idComputer, step, BiTape.optionMove] - rfl - -lemma compComputer_q₀_eq (f g : List α → List α) - (hf : TimeComputable f) (hg : TimeComputable g) : - (compComputer hf.tm hg.tm).q₀ = Sum.inl hf.tm.q₀ := +lemma compComputer_q₀_eq (tm1 tm2 : SingleTapeTM α) : + (compComputer tm1 tm2).q₀ = Sum.inl tm1.q₀ := rfl -/-- Lift a config over a tm to a config over the comp -/ -def liftCompCfg_left {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (cfg : hf.tm.Cfg) : - (compComputer hf.tm hg.tm).Cfg := +/-- Convert a `Cfg` over the first input machine to a config over the composed machine -/ +def toCompCfg_left (tm1 tm2 : SingleTapeTM α) + (cfg : tm1.Cfg) : + (compComputer tm1 tm2).Cfg := { state := Option.map Sum.inl cfg.state BiTape := cfg.BiTape } -def liftCompCfg_right {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (cfg : hg.tm.Cfg) : - (compComputer hf.tm hg.tm).Cfg := +/-- Convert a `Cfg` over the second input machine to a config over the composed machine -/ +def toCompCfg_right (tm1 tm2 : SingleTapeTM α) + (cfg : tm2.Cfg) : + (compComputer tm1 tm2).Cfg := { state := Option.map Sum.inr cfg.state BiTape := cfg.BiTape } -theorem map_liftCompCfg_left_step - {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (x : hf.tm.Cfg) (hx : ∀ cfg, hf.tm.step x = some cfg → cfg.state.isSome) : - Option.map (liftCompCfg_left hf hg) (hf.tm.step x) = - (compComputer hf.tm hg.tm).step (liftCompCfg_left hf hg x) := by +theorem map_toCompCfg_left_step + (tm1 tm2 : SingleTapeTM α) + (x : tm1.Cfg) (hx : ∀ cfg, tm1.step x = some cfg → cfg.state.isSome) : + Option.map (toCompCfg_left tm1 tm2) (tm1.step x) = + (compComputer tm1 tm2).step (toCompCfg_left tm1 tm2 x) := by cases x with | mk state BiTape => cases state with | none => -- x is already in halting state, step returns none on both sides - simp only [step, liftCompCfg_left, Option.map_none, compComputer] + simp only [step, toCompCfg_left, Option.map_none, compComputer] | some q => - simp only [step, liftCompCfg_left, compComputer, Option.map_some] + simp only [step, toCompCfg_left, compComputer, Option.map_some] -- Get the transition result - generalize hM : hf.tm.M q BiTape.head = result + generalize hM : tm1.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result simp only -- Case on whether the next state is none (halting) or some @@ -322,94 +300,88 @@ theorem map_liftCompCfg_left_step | none => -- The first machine halts, but hx says the result has state.isSome simp only [step, hM] at hx - have := hx ⟨none, (BiTape.write wr).optionMove dir⟩ rfl - simp at this + grind [hx ⟨none, (BiTape.write wr).optionMove dir⟩ rfl] | some q' => - -- Normal step case - both sides produce the lifted config - simp only [hM, Option.map_some, liftCompCfg_left] - -/-- Helper lemma: liftCompCfg_right commutes with step for the second machine -/ -theorem map_liftCompCfg_right_step - {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (x : hg.tm.Cfg) : - Option.map (liftCompCfg_right hf hg) (hg.tm.step x) = - (compComputer hf.tm hg.tm).step (liftCompCfg_right hf hg x) := by + -- Normal step case - both sides produce the toed config + simp only [hM, Option.map_some, toCompCfg_left] + +/-- Helper lemma: toCompCfg_right commutes with step for the second machine -/ +theorem map_toCompCfg_right_step + (tm1 tm2 : SingleTapeTM α) + (x : tm2.Cfg) : + Option.map (toCompCfg_right tm1 tm2) (tm2.step x) = + (compComputer tm1 tm2).step (toCompCfg_right tm1 tm2 x) := by cases x with | mk state BiTape => cases state with | none => - simp only [step, liftCompCfg_right, Option.map_none, compComputer] + simp only [step, toCompCfg_right, Option.map_none, compComputer] | some q => - simp only [step, liftCompCfg_right, compComputer, Option.map_some] - generalize hM : hg.tm.M q BiTape.head = result + simp only [step, toCompCfg_right, compComputer, Option.map_some] + generalize hM : tm2.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result cases nextState with - | none => simp only [hM, Option.map_some, liftCompCfg_right, Option.map_none] - | some q' => simp only [hM, Option.map_some, liftCompCfg_right] + | none => simp only [hM, Option.map_some, toCompCfg_right, Option.map_none] + | some q' => simp only [hM, Option.map_some, toCompCfg_right] -theorem comp_transition_to_right {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) +theorem comp_transition_to_right (tm1 tm2 : SingleTapeTM α) (tp : BiTape α) - (q : hf.tm.Λ) - (hM : (hf.tm.M q tp.head).2 = none) : - (compComputer hf.tm hg.tm).step { state := some (Sum.inl q), BiTape := tp } = - some { state := some (Sum.inr hg.tm.q₀), - BiTape := (tp.write (hf.tm.M q tp.head).1.symbol).optionMove - (hf.tm.M q tp.head).1.movement } := by + (q : tm1.Λ) + (hM : (tm1.M q tp.head).2 = none) : + (compComputer tm1 tm2).step { state := some (Sum.inl q), BiTape := tp } = + some { state := some (Sum.inr tm2.q₀), + BiTape := (tp.write (tm1.M q tp.head).1.symbol).optionMove + (tm1.M q tp.head).1.movement } := by simp only [step, compComputer, hM, Stmt.symbol, Stmt.movement] - generalize hfM_eq : hf.tm.M q tp.head = result + generalize hfM_eq : tm1.M q tp.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result simp only [hfM_eq] -/-- Helper: lifting to Sum.inl and transitioning to Sum.inr on halt -/ -def liftCompCfg_left_or_right {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (cfg : hf.tm.Cfg) : - (compComputer hf.tm hg.tm).Cfg := +/-- Helper: toing to Sum.inl and transitioning to Sum.inr on halt -/ +def toCompCfg_left_or_right (tm1 tm2 : SingleTapeTM α) + (cfg : tm1.Cfg) : + (compComputer tm1 tm2).Cfg := match cfg.state with | some q => { state := some (Sum.inl q), BiTape := cfg.BiTape } - | none => { state := some (Sum.inr hg.tm.q₀), BiTape := cfg.BiTape } + | none => { state := some (Sum.inr tm2.q₀), BiTape := cfg.BiTape } -/-- The lifting function commutes with step, converting halt to transition -/ -theorem map_liftCompCfg_left_or_right_step - {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (x : hf.tm.Cfg) +/-- The toing function commutes with step, converting halt to transition -/ +theorem map_toCompCfg_left_or_right_step + (tm1 tm2 : SingleTapeTM α) + (x : tm1.Cfg) (hx : x.state.isSome) : - Option.map (liftCompCfg_left_or_right hf hg) (hf.tm.step x) = - (compComputer hf.tm hg.tm).step (liftCompCfg_left_or_right hf hg x) := by + Option.map (toCompCfg_left_or_right tm1 tm2) (tm1.step x) = + (compComputer tm1 tm2).step (toCompCfg_left_or_right tm1 tm2 x) := by cases x with | mk state BiTape => cases state with | none => simp at hx | some q => - simp only [step, liftCompCfg_left_or_right, compComputer] - generalize hM : hf.tm.M q BiTape.head = result + simp only [step, toCompCfg_left_or_right, compComputer] + generalize hM : tm1.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result cases nextState with - | none => simp only [hM, Option.map_some, liftCompCfg_left_or_right] - | some q' => simp only [hM, Option.map_some, liftCompCfg_left_or_right] + | none => simp only [hM, Option.map_some, toCompCfg_left_or_right] + | some q' => simp only [hM, Option.map_some, toCompCfg_left_or_right] /-- General simulation: if the first machine goes from cfg to halt, the composed machine - goes from lifted cfg to Sum.inr hg.tm.q₀ -/ -theorem comp_left_simulation_general {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (cfg : hf.tm.Cfg) + goes from toed cfg to Sum.inr tm2.q₀ -/ +theorem comp_left_simulation_general (tm1 tm2 : SingleTapeTM α) + (cfg : tm1.Cfg) (hcfg : cfg.state.isSome) - (haltCfg : hf.tm.Cfg) + (haltCfg : tm1.Cfg) (steps : ℕ) - (h : RelatesInSteps hf.tm.TransitionRelation cfg haltCfg steps) : - RelatesInSteps (compComputer hf.tm hg.tm).TransitionRelation - (liftCompCfg_left_or_right hf hg cfg) - (liftCompCfg_left_or_right hf hg haltCfg) + (h : RelatesInSteps tm1.TransitionRelation cfg haltCfg steps) : + RelatesInSteps (compComputer tm1 tm2).TransitionRelation + (toCompCfg_left_or_right tm1 tm2 cfg) + (toCompCfg_left_or_right tm1 tm2 haltCfg) steps := by -- Proof by induction on steps. - -- Key insight: liftCompCfg_left_or_right maps: + -- Key insight: toCompCfg_left_or_right maps: -- { state := some q, BiTape } -> { state := some (Sum.inl q), BiTape } - -- { state := none, BiTape } -> { state := some (Sum.inr hg.tm.q₀), BiTape } + -- { state := none, BiTape } -> { state := some (Sum.inr tm2.q₀), BiTape } -- For non-halting configs, the composed machine simulates exactly. - -- When the first machine halts, the composed machine transitions to Sum.inr hg.tm.q₀. + -- When the first machine halts, the composed machine transitions to Sum.inr tm2.q₀. induction steps generalizing cfg haltCfg with | zero => simp only [RelatesInSteps.zero_iff] at h ⊢ @@ -417,10 +389,10 @@ theorem comp_left_simulation_general {f g : List α → List α} | succ n ih => -- Use the decomposition lemma: cfg evals to some intermediate c in n steps, -- and then c steps to haltCfg - -- obtain ⟨c, hc_n, hc_step⟩ := EvalsToInTime.succ_decompose hf.tm.step cfg haltCfg n h + -- obtain ⟨c, hc_n, hc_step⟩ := EvalsToInTime.succ_decompose tm1.step cfg haltCfg n h rw [RelatesInSteps.succ_iff] at h ⊢ obtain ⟨c, hc_n, hc_step⟩ := h - use liftCompCfg_left_or_right hf hg c + use toCompCfg_left_or_right tm1 tm2 c constructor · apply ih · exact hcfg @@ -433,8 +405,8 @@ theorem comp_left_simulation_general {f g : List α → List α} simp only [TransitionRelation, step] at hc_step cases hc_step | some q => - -- Use the lifting lemma - have h1 := map_liftCompCfg_left_or_right_step hf hg ⟨some q, BiTape⟩ (by simp) + -- Use the toing lemma + have h1 := map_toCompCfg_left_or_right_step tm1 tm2 ⟨some q, BiTape⟩ (by simp) simp only [TransitionRelation] at hc_step ⊢ rw [hc_step, Option.map_some] at h1 exact h1.symm @@ -443,52 +415,70 @@ theorem comp_left_simulation_general {f g : List α → List α} /-- Simulation for the first phase of the composed computer. When the first machine runs from start to halt, the composed machine -runs from start (with Sum.inl state) to Sum.inr hg.tm.q₀ (the start of the second phase). +runs from start (with Sum.inl state) to Sum.inr tm2.q₀ (the start of the second phase). This takes the same number of steps because the halt transition becomes a transition to the second machine. -/ -theorem comp_left_simulation {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (a : List α) +theorem comp_left_simulation (tm1 tm2 : SingleTapeTM α) + (input_tape intermediate_tape : List α) + (t : ℕ) (hf_outputsFun : - RelatesWithinSteps hf.tm.TransitionRelation - { state := some hf.tm.q₀, BiTape := BiTape.mk₁ a } - ({ state := none, BiTape := BiTape.mk₁ (f a) }) - (hf.time a.length)) : - RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation - { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } - ({ state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) }) - (hf.time a.length) := by + RelatesWithinSteps tm1.TransitionRelation + { state := some tm1.q₀, BiTape := BiTape.mk₁ input_tape } + ({ state := none, BiTape := BiTape.mk₁ intermediate_tape }) + t) : + RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation + { state := some (Sum.inl tm1.q₀), BiTape := BiTape.mk₁ input_tape } + ({ state := some (Sum.inr tm2.q₀), BiTape := BiTape.mk₁ intermediate_tape }) + t := by obtain ⟨steps, hsteps_le, hsteps_eval⟩ := hf_outputsFun use steps constructor · exact hsteps_le - · have := comp_left_simulation_general hf hg - { state := some hf.tm.q₀, BiTape := BiTape.mk₁ a } + · have := comp_left_simulation_general tm1 tm2 + { state := some tm1.q₀, BiTape := BiTape.mk₁ input_tape } (by simp) - { state := none, BiTape := BiTape.mk₁ (f a) } + { state := none, BiTape := BiTape.mk₁ intermediate_tape } steps hsteps_eval - simp only [liftCompCfg_left_or_right] at this + simp only [toCompCfg_left_or_right] at this exact this /-- Simulation lemma for the second machine in the composed computer -/ theorem comp_right_simulation - {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) - (x : hg.tm.Cfg) (y : hg.tm.Cfg) (m : ℕ) - (h : RelatesWithinSteps hg.tm.TransitionRelation x y m) : - RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation - (liftCompCfg_right hf hg x) - ((liftCompCfg_right hf hg) y) + (tm1 tm2 : SingleTapeTM α) + (x : tm2.Cfg) (y : tm2.Cfg) (m : ℕ) + (h : RelatesWithinSteps tm2.TransitionRelation x y m) : + RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation + (toCompCfg_right tm1 tm2 x) + ((toCompCfg_right tm1 tm2) y) m := by - refine RelatesWithinSteps.map (liftCompCfg_right hf hg) ?_ h + refine RelatesWithinSteps.map (toCompCfg_right tm1 tm2) ?_ h intro a b hab - have h1 := map_liftCompCfg_right_step hf hg a + have h1 := map_toCompCfg_right_step tm1 tm2 a rw [hab, Option.map_some] at h1 exact h1.symm +/-- A Turing machine + a time function + +a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ +structure TimeComputable (f : List α → List α) where + /-- the underlying bundled SingleTapeTM -/ + tm : SingleTapeTM α + /-- a time function -/ + time : ℕ → ℕ + /-- proof this machine outputsInTime `f` in at most `time(input.length)` steps -/ + outputsFun : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) + + +/-- The identity map on α is computable in constant time. -/ +def TimeComputable.id : TimeComputable (α := α) id where + tm := idComputer + time _ := 1 + outputsFun x := by + refine ⟨1, le_refl 1, RelatesInSteps.single ?_⟩ + simp only [TransitionRelation, initCfg, haltCfg, idComputer, step, BiTape.optionMove] + rfl /-- A composition for TimeComputable. @@ -530,19 +520,19 @@ def TimeComputable.comp { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } (hf.time a.length) := - comp_left_simulation hf hg a hf_outputsFun + comp_left_simulation hf.tm hg.tm a (f a) (hf.time a.length) hf_outputsFun have h_f_a_reducesTo_g_f_a : RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } { state := none, BiTape := BiTape.mk₁ (g (f a)) } (hg.time (f a).length) := by -- Use the simulation lemma for the second machine - have := comp_right_simulation hf hg + have := comp_right_simulation hf.tm hg.tm { state := some hg.tm.q₀, BiTape := BiTape.mk₁ (f a) } { state := none, BiTape := BiTape.mk₁ (g (f a)) } (hg.time (f a).length) hg_outputsFun - simp only [liftCompCfg_right] at this + simp only [toCompCfg_right] at this exact this have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans From 435971c7c64bb994c53a8e434411f54a21996a7f Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 21:32:40 -0800 Subject: [PATCH 25/95] add private to lemmas --- .../Machines/SingleTapeTuring/Basic.lean | 62 +++++++++---------- 1 file changed, 28 insertions(+), 34 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 3932708ba..330aa3443 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -227,26 +227,26 @@ def idComputer : SingleTapeTM α where M := fun _ b => ⟨(b, none), none⟩ /-- A Turing machine computing the composition of two other Turing machines. -/ -def compComputer (hf hg : SingleTapeTM α) : SingleTapeTM α where +def compComputer (tm1 tm2 : SingleTapeTM α) : SingleTapeTM α where -- The states of the composed machine are the disjoint union of the states of the input machines. - Λ := hf.Λ ⊕ hg.Λ + Λ := tm1.Λ ⊕ tm2.Λ -- The start state is the start state of the first input machine. - q₀ := .inl hf.q₀ + q₀ := .inl tm1.q₀ M q h := match q with -- If we are in the first input machine's states, run that machine ... - | .inl ql => match hf.M ql h with + | .inl ql => match tm1.M ql h with | (stmt, state) => -- ... taking the same tape action as the first input machine would. (stmt, match state with -- If it halts, transition to the start state of the second input machine - | none => some (.inr hg.q₀) + | none => some (.inr tm2.q₀) -- Otherwise continue as normal | _ => Option.map .inl state) -- If we are in the second input machine's states, run that machine ... | .inr qr => - match hg.M qr h with + match tm2.M qr h with | (stmt, state) => -- ... taking the same tape action as the second input machine would. (stmt, @@ -256,12 +256,16 @@ def compComputer (hf hg : SingleTapeTM α) : SingleTapeTM α where -- Otherwise continue as normal | _ => Option.map .inr state) +section compComputerLemmas + +/-! ### Composition Computer Lemmas -/ + lemma compComputer_q₀_eq (tm1 tm2 : SingleTapeTM α) : (compComputer tm1 tm2).q₀ = Sum.inl tm1.q₀ := rfl /-- Convert a `Cfg` over the first input machine to a config over the composed machine -/ -def toCompCfg_left (tm1 tm2 : SingleTapeTM α) +private def toCompCfg_left (tm1 tm2 : SingleTapeTM α) (cfg : tm1.Cfg) : (compComputer tm1 tm2).Cfg := { @@ -270,7 +274,7 @@ def toCompCfg_left (tm1 tm2 : SingleTapeTM α) } /-- Convert a `Cfg` over the second input machine to a config over the composed machine -/ -def toCompCfg_right (tm1 tm2 : SingleTapeTM α) +private def toCompCfg_right (tm1 tm2 : SingleTapeTM α) (cfg : tm2.Cfg) : (compComputer tm1 tm2).Cfg := { @@ -278,7 +282,7 @@ def toCompCfg_right (tm1 tm2 : SingleTapeTM α) BiTape := cfg.BiTape } -theorem map_toCompCfg_left_step +private theorem map_toCompCfg_left_step (tm1 tm2 : SingleTapeTM α) (x : tm1.Cfg) (hx : ∀ cfg, tm1.step x = some cfg → cfg.state.isSome) : Option.map (toCompCfg_left tm1 tm2) (tm1.step x) = @@ -306,7 +310,7 @@ theorem map_toCompCfg_left_step simp only [hM, Option.map_some, toCompCfg_left] /-- Helper lemma: toCompCfg_right commutes with step for the second machine -/ -theorem map_toCompCfg_right_step +private theorem map_toCompCfg_right_step (tm1 tm2 : SingleTapeTM α) (x : tm2.Cfg) : Option.map (toCompCfg_right tm1 tm2) (tm2.step x) = @@ -324,7 +328,7 @@ theorem map_toCompCfg_right_step | none => simp only [hM, Option.map_some, toCompCfg_right, Option.map_none] | some q' => simp only [hM, Option.map_some, toCompCfg_right] -theorem comp_transition_to_right (tm1 tm2 : SingleTapeTM α) +private theorem comp_transition_to_right (tm1 tm2 : SingleTapeTM α) (tp : BiTape α) (q : tm1.Λ) (hM : (tm1.M q tp.head).2 = none) : @@ -333,20 +337,20 @@ theorem comp_transition_to_right (tm1 tm2 : SingleTapeTM α) BiTape := (tp.write (tm1.M q tp.head).1.symbol).optionMove (tm1.M q tp.head).1.movement } := by simp only [step, compComputer, hM, Stmt.symbol, Stmt.movement] - generalize hfM_eq : tm1.M q tp.head = result + generalize M_eq : tm1.M q tp.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result - simp only [hfM_eq] + simp only [M_eq] -/-- Helper: toing to Sum.inl and transitioning to Sum.inr on halt -/ -def toCompCfg_left_or_right (tm1 tm2 : SingleTapeTM α) +/-- Helper: converting to Sum.inl and transitioning to Sum.inr on halt -/ +private def toCompCfg_left_or_right (tm1 tm2 : SingleTapeTM α) (cfg : tm1.Cfg) : (compComputer tm1 tm2).Cfg := match cfg.state with | some q => { state := some (Sum.inl q), BiTape := cfg.BiTape } | none => { state := some (Sum.inr tm2.q₀), BiTape := cfg.BiTape } -/-- The toing function commutes with step, converting halt to transition -/ -theorem map_toCompCfg_left_or_right_step +/-- The converting function commutes with step, converting halt to transition -/ +private theorem map_toCompCfg_left_or_right_step (tm1 tm2 : SingleTapeTM α) (x : tm1.Cfg) (hx : x.state.isSome) : @@ -365,8 +369,8 @@ theorem map_toCompCfg_left_or_right_step | some q' => simp only [hM, Option.map_some, toCompCfg_left_or_right] /-- General simulation: if the first machine goes from cfg to halt, the composed machine - goes from toed cfg to Sum.inr tm2.q₀ -/ -theorem comp_left_simulation_general (tm1 tm2 : SingleTapeTM α) + goes from cfg to Sum.inr tm2.q₀ -/ +private theorem comp_left_simulation_general (tm1 tm2 : SingleTapeTM α) (cfg : tm1.Cfg) (hcfg : cfg.state.isSome) (haltCfg : tm1.Cfg) @@ -376,20 +380,11 @@ theorem comp_left_simulation_general (tm1 tm2 : SingleTapeTM α) (toCompCfg_left_or_right tm1 tm2 cfg) (toCompCfg_left_or_right tm1 tm2 haltCfg) steps := by - -- Proof by induction on steps. - -- Key insight: toCompCfg_left_or_right maps: - -- { state := some q, BiTape } -> { state := some (Sum.inl q), BiTape } - -- { state := none, BiTape } -> { state := some (Sum.inr tm2.q₀), BiTape } - -- For non-halting configs, the composed machine simulates exactly. - -- When the first machine halts, the composed machine transitions to Sum.inr tm2.q₀. induction steps generalizing cfg haltCfg with | zero => simp only [RelatesInSteps.zero_iff] at h ⊢ rw [h] | succ n ih => - -- Use the decomposition lemma: cfg evals to some intermediate c in n steps, - -- and then c steps to haltCfg - -- obtain ⟨c, hc_n, hc_step⟩ := EvalsToInTime.succ_decompose tm1.step cfg haltCfg n h rw [RelatesInSteps.succ_iff] at h ⊢ obtain ⟨c, hc_n, hc_step⟩ := h use toCompCfg_left_or_right tm1 tm2 c @@ -401,11 +396,9 @@ theorem comp_left_simulation_general (tm1 tm2 : SingleTapeTM α) | mk state BiTape => cases state with | none => - -- c is in halting state, but step of halting state is none, contradiction simp only [TransitionRelation, step] at hc_step cases hc_step | some q => - -- Use the toing lemma have h1 := map_toCompCfg_left_or_right_step tm1 tm2 ⟨some q, BiTape⟩ (by simp) simp only [TransitionRelation] at hc_step ⊢ rw [hc_step, Option.map_some] at h1 @@ -419,10 +412,10 @@ runs from start (with Sum.inl state) to Sum.inr tm2.q₀ (the start of the secon This takes the same number of steps because the halt transition becomes a transition to the second machine. -/ -theorem comp_left_simulation (tm1 tm2 : SingleTapeTM α) +private theorem comp_left_simulation (tm1 tm2 : SingleTapeTM α) (input_tape intermediate_tape : List α) (t : ℕ) - (hf_outputsFun : + (htm1 : RelatesWithinSteps tm1.TransitionRelation { state := some tm1.q₀, BiTape := BiTape.mk₁ input_tape } ({ state := none, BiTape := BiTape.mk₁ intermediate_tape }) @@ -431,7 +424,7 @@ theorem comp_left_simulation (tm1 tm2 : SingleTapeTM α) { state := some (Sum.inl tm1.q₀), BiTape := BiTape.mk₁ input_tape } ({ state := some (Sum.inr tm2.q₀), BiTape := BiTape.mk₁ intermediate_tape }) t := by - obtain ⟨steps, hsteps_le, hsteps_eval⟩ := hf_outputsFun + obtain ⟨steps, hsteps_le, hsteps_eval⟩ := htm1 use steps constructor · exact hsteps_le @@ -445,7 +438,7 @@ theorem comp_left_simulation (tm1 tm2 : SingleTapeTM α) exact this /-- Simulation lemma for the second machine in the composed computer -/ -theorem comp_right_simulation +private theorem comp_right_simulation (tm1 tm2 : SingleTapeTM α) (x : tm2.Cfg) (y : tm2.Cfg) (m : ℕ) (h : RelatesWithinSteps tm2.TransitionRelation x y m) : @@ -459,6 +452,7 @@ theorem comp_right_simulation rw [hab, Option.map_some] at h1 exact h1.symm +end compComputerLemmas /-- A Turing machine + a time function + a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ From 6426bc58ee042f96fa3c49ad19d8dbf8c3cb8a34 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 21:57:05 -0800 Subject: [PATCH 26/95] rename helper lemmas --- .../Machines/SingleTapeTuring/Basic.lean | 162 +++++++----------- 1 file changed, 65 insertions(+), 97 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 330aa3443..fbf4fb602 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -226,7 +226,13 @@ def idComputer : SingleTapeTM α where q₀ := PUnit.unit M := fun _ b => ⟨(b, none), none⟩ -/-- A Turing machine computing the composition of two other Turing machines. -/ +/-- +A Turing machine computing the composition of two other Turing machines. + +If f and g are computed by turing machines `tm1` and `tm2` +then we can construct a turing machine which computes g ∘ f by first running `tm1` +and then, when `tm1` halts, transitioning to the start state of `tm2` and running `tm2`. +-/ def compComputer (tm1 tm2 : SingleTapeTM α) : SingleTapeTM α where -- The states of the composed machine are the disjoint union of the states of the input machines. Λ := tm1.Λ ⊕ tm2.Λ @@ -264,14 +270,16 @@ lemma compComputer_q₀_eq (tm1 tm2 : SingleTapeTM α) : (compComputer tm1 tm2).q₀ = Sum.inl tm1.q₀ := rfl -/-- Convert a `Cfg` over the first input machine to a config over the composed machine -/ +/-- +Convert a `Cfg` over the first input machine to a config over the composed machine. +Note it may transition to the start state of the second machine if the first machine halts. +-/ private def toCompCfg_left (tm1 tm2 : SingleTapeTM α) (cfg : tm1.Cfg) : (compComputer tm1 tm2).Cfg := - { - state := Option.map Sum.inl cfg.state - BiTape := cfg.BiTape - } + match cfg.state with + | some q => { state := some (Sum.inl q), BiTape := cfg.BiTape } + | none => { state := some (Sum.inr tm2.q₀), BiTape := cfg.BiTape } /-- Convert a `Cfg` over the second input machine to a config over the composed machine -/ private def toCompCfg_right (tm1 tm2 : SingleTapeTM α) @@ -282,34 +290,26 @@ private def toCompCfg_right (tm1 tm2 : SingleTapeTM α) BiTape := cfg.BiTape } +/-- The left converting function commutes with steps of the machines. -/ private theorem map_toCompCfg_left_step (tm1 tm2 : SingleTapeTM α) - (x : tm1.Cfg) (hx : ∀ cfg, tm1.step x = some cfg → cfg.state.isSome) : + (x : tm1.Cfg) + (hx : x.state.isSome) : Option.map (toCompCfg_left tm1 tm2) (tm1.step x) = (compComputer tm1 tm2).step (toCompCfg_left tm1 tm2 x) := by cases x with | mk state BiTape => cases state with - | none => - -- x is already in halting state, step returns none on both sides - simp only [step, toCompCfg_left, Option.map_none, compComputer] + | none => simp at hx | some q => - simp only [step, toCompCfg_left, compComputer, Option.map_some] - -- Get the transition result + simp only [step, toCompCfg_left, compComputer] generalize hM : tm1.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result - simp only - -- Case on whether the next state is none (halting) or some cases nextState with - | none => - -- The first machine halts, but hx says the result has state.isSome - simp only [step, hM] at hx - grind [hx ⟨none, (BiTape.write wr).optionMove dir⟩ rfl] - | some q' => - -- Normal step case - both sides produce the toed config - simp only [hM, Option.map_some, toCompCfg_left] - -/-- Helper lemma: toCompCfg_right commutes with step for the second machine -/ + | none => simp only [hM, Option.map_some, toCompCfg_left] + | some q' => simp only [hM, Option.map_some, toCompCfg_left] + +/-- The right converting function commutes with steps of the machines. -/ private theorem map_toCompCfg_right_step (tm1 tm2 : SingleTapeTM α) (x : tm2.Cfg) : @@ -328,57 +328,20 @@ private theorem map_toCompCfg_right_step | none => simp only [hM, Option.map_some, toCompCfg_right, Option.map_none] | some q' => simp only [hM, Option.map_some, toCompCfg_right] -private theorem comp_transition_to_right (tm1 tm2 : SingleTapeTM α) - (tp : BiTape α) - (q : tm1.Λ) - (hM : (tm1.M q tp.head).2 = none) : - (compComputer tm1 tm2).step { state := some (Sum.inl q), BiTape := tp } = - some { state := some (Sum.inr tm2.q₀), - BiTape := (tp.write (tm1.M q tp.head).1.symbol).optionMove - (tm1.M q tp.head).1.movement } := by - simp only [step, compComputer, hM, Stmt.symbol, Stmt.movement] - generalize M_eq : tm1.M q tp.head = result - obtain ⟨⟨wr, dir⟩, nextState⟩ := result - simp only [M_eq] - -/-- Helper: converting to Sum.inl and transitioning to Sum.inr on halt -/ -private def toCompCfg_left_or_right (tm1 tm2 : SingleTapeTM α) - (cfg : tm1.Cfg) : - (compComputer tm1 tm2).Cfg := - match cfg.state with - | some q => { state := some (Sum.inl q), BiTape := cfg.BiTape } - | none => { state := some (Sum.inr tm2.q₀), BiTape := cfg.BiTape } - -/-- The converting function commutes with step, converting halt to transition -/ -private theorem map_toCompCfg_left_or_right_step - (tm1 tm2 : SingleTapeTM α) - (x : tm1.Cfg) - (hx : x.state.isSome) : - Option.map (toCompCfg_left_or_right tm1 tm2) (tm1.step x) = - (compComputer tm1 tm2).step (toCompCfg_left_or_right tm1 tm2 x) := by - cases x with - | mk state BiTape => - cases state with - | none => simp at hx - | some q => - simp only [step, toCompCfg_left_or_right, compComputer] - generalize hM : tm1.M q BiTape.head = result - obtain ⟨⟨wr, dir⟩, nextState⟩ := result - cases nextState with - | none => simp only [hM, Option.map_some, toCompCfg_left_or_right] - | some q' => simp only [hM, Option.map_some, toCompCfg_left_or_right] -/-- General simulation: if the first machine goes from cfg to halt, the composed machine - goes from cfg to Sum.inr tm2.q₀ -/ -private theorem comp_left_simulation_general (tm1 tm2 : SingleTapeTM α) +/-- +The behavior of the left machine, converted to the composed machine, +preserves step count +-/ +private theorem comp_left_relatesInSteps (tm1 tm2 : SingleTapeTM α) (cfg : tm1.Cfg) (hcfg : cfg.state.isSome) (haltCfg : tm1.Cfg) (steps : ℕ) (h : RelatesInSteps tm1.TransitionRelation cfg haltCfg steps) : RelatesInSteps (compComputer tm1 tm2).TransitionRelation - (toCompCfg_left_or_right tm1 tm2 cfg) - (toCompCfg_left_or_right tm1 tm2 haltCfg) + (toCompCfg_left tm1 tm2 cfg) + (toCompCfg_left tm1 tm2 haltCfg) steps := by induction steps generalizing cfg haltCfg with | zero => @@ -387,7 +350,7 @@ private theorem comp_left_simulation_general (tm1 tm2 : SingleTapeTM α) | succ n ih => rw [RelatesInSteps.succ_iff] at h ⊢ obtain ⟨c, hc_n, hc_step⟩ := h - use toCompCfg_left_or_right tm1 tm2 c + use toCompCfg_left tm1 tm2 c constructor · apply ih · exact hcfg @@ -399,12 +362,11 @@ private theorem comp_left_simulation_general (tm1 tm2 : SingleTapeTM α) simp only [TransitionRelation, step] at hc_step cases hc_step | some q => - have h1 := map_toCompCfg_left_or_right_step tm1 tm2 ⟨some q, BiTape⟩ (by simp) + have h1 := map_toCompCfg_left_step tm1 tm2 ⟨some q, BiTape⟩ (by simp) simp only [TransitionRelation] at hc_step ⊢ rw [hc_step, Option.map_some] at h1 exact h1.symm - /-- Simulation for the first phase of the composed computer. When the first machine runs from start to halt, the composed machine @@ -412,7 +374,7 @@ runs from start (with Sum.inl state) to Sum.inr tm2.q₀ (the start of the secon This takes the same number of steps because the halt transition becomes a transition to the second machine. -/ -private theorem comp_left_simulation (tm1 tm2 : SingleTapeTM α) +private theorem comp_left_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) (input_tape intermediate_tape : List α) (t : ℕ) (htm1 : @@ -428,17 +390,17 @@ private theorem comp_left_simulation (tm1 tm2 : SingleTapeTM α) use steps constructor · exact hsteps_le - · have := comp_left_simulation_general tm1 tm2 + · have := comp_left_relatesInSteps tm1 tm2 { state := some tm1.q₀, BiTape := BiTape.mk₁ input_tape } (by simp) { state := none, BiTape := BiTape.mk₁ intermediate_tape } steps hsteps_eval - simp only [toCompCfg_left_or_right] at this + simp only [toCompCfg_left] at this exact this /-- Simulation lemma for the second machine in the composed computer -/ -private theorem comp_right_simulation +private theorem comp_right_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) (x : tm2.Cfg) (y : tm2.Cfg) (m : ℕ) (h : RelatesWithinSteps tm2.TransitionRelation x y m) : @@ -454,14 +416,26 @@ private theorem comp_right_simulation end compComputerLemmas +end + +/-! +## Time Computability + +This section defines the notion of time-bounded Turing Machines +-/ + +section TimeComputable + +variable [Inhabited α] [Fintype α] + /-- A Turing machine + a time function + -a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ +a proof it outputs `f` in at most `time(input.length)` steps. -/ structure TimeComputable (f : List α → List α) where /-- the underlying bundled SingleTapeTM -/ tm : SingleTapeTM α /-- a time function -/ time : ℕ → ℕ - /-- proof this machine outputsInTime `f` in at most `time(input.length)` steps -/ + /-- proof this machine outputs `f` in at most `time(input.length)` steps -/ outputsFun : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) @@ -475,25 +449,18 @@ def TimeComputable.id : TimeComputable (α := α) id where rfl /-- -A composition for TimeComputable. +Time bounds for `compComputer`. -If f and g are computed by turing machines M₁ and M₂ -then we can construct a turing machine M which computes g ∘ f by first running M₁ -and then, when M₁ halts, transitioning to the start state of M₂ and running M₂. +The `compComputer` of two machines which have time bounds is bounded by -This results in time bounded by the amount of time taken by M₁ plus the maximum time taken by M₂ on -inputs of length of the maximum output length of M₁ for that input size (which is itself bounded by -the time taken by M₁). +* The time taken by the first machine on the input size +* added to the time taken by the second machine on the output size of the first machine + (which is itself bounded by the time taken by the first machine) Note that we require the time function of the second machine to be monotone; this is to ensure that if the first machine returns an output which is shorter than the maximum possible length of output for that input size, then the time bound for the second machine still holds for that shorter input to the second machine. - -TODO refactor out the definition of the composed TM. -Prove separately that it -evals to the intermediate state from the start state and -then from the intermediate state to the final state. -/ def TimeComputable.comp {f g : List α → List α} @@ -514,14 +481,16 @@ def TimeComputable.comp { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } (hf.time a.length) := - comp_left_simulation hf.tm hg.tm a (f a) (hf.time a.length) hf_outputsFun + comp_left_relatesWithinSteps hf.tm hg.tm a (f a) (hf.time a.length) hf_outputsFun + -- The computer reduces f a to g (f a) in time hg.time (f a).length have h_f_a_reducesTo_g_f_a : RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } { state := none, BiTape := BiTape.mk₁ (g (f a)) } (hg.time (f a).length) := by - -- Use the simulation lemma for the second machine - have := comp_right_simulation hf.tm hg.tm + -- TODO why is the previous have a one-liner and this is not? + -- reformulate the lemmas above so that this looks the same. + have := comp_right_relatesWithinSteps hf.tm hg.tm { state := some hg.tm.q₀, BiTape := BiTape.mk₁ (f a) } { state := none, BiTape := BiTape.mk₁ (g (f a)) } (hg.time (f a).length) @@ -538,7 +507,7 @@ def TimeComputable.comp -- Use the lemma about output length being bounded by input length + time exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFun a) -end +end TimeComputable /-! ## Polynomial Time Computability @@ -556,17 +525,16 @@ Perhaps we could switch to a computable polynomial representation? -/ -section PolyTime +section PolyTimeComputable variable [Inhabited α] [Fintype α] - /-- A Turing machine + a polynomial time function + -a proof it outputsInTime `f` in at most `time(input.length)` steps. -/ +a proof it outputs `f` in at most `time(input.length)` steps. -/ structure PolyTimeComputable (f : List α → List α) extends TimeComputable f where /-- a polynomial time bound -/ poly : Polynomial ℕ - /-- proof that this machine outputsInTime `f` in at most `time(input.length)` steps -/ + /-- proof that this machine outputs `f` in at most `time(input.length)` steps -/ bounds : ∀ n, time n ≤ poly.eval n /-- A proof that the identity map on α is computable in polytime. -/ @@ -600,7 +568,7 @@ noncomputable def PolyTimeComputable.comp apply le_trans this _ exact hg.bounds (1 + n + hf.poly.eval n) -end PolyTime +end PolyTimeComputable end SingleTapeTM From bacefc5384fc41108238381e7cc0d62d4c77ba36 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 22:07:57 -0800 Subject: [PATCH 27/95] claude: uniformize the helper lemmas --- .../Machines/SingleTapeTuring/Basic.lean | 38 +++++++++---------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index fbf4fb602..0d55c159c 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -399,16 +399,24 @@ private theorem comp_left_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) simp only [toCompCfg_left] at this exact this -/-- Simulation lemma for the second machine in the composed computer -/ -private theorem comp_right_relatesWithinSteps - (tm1 tm2 : SingleTapeTM α) - (x : tm2.Cfg) (y : tm2.Cfg) (m : ℕ) - (h : RelatesWithinSteps tm2.TransitionRelation x y m) : +/-- +Simulation for the second phase of the composed computer. +When the second machine runs from start to halt, the composed machine +runs from Sum.inr tm2.q₀ to halt. +-/ +private theorem comp_right_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) + (input_tape output_tape : List α) + (t : ℕ) + (htm2 : + RelatesWithinSteps tm2.TransitionRelation + { state := some tm2.q₀, BiTape := BiTape.mk₁ input_tape } + ({ state := none, BiTape := BiTape.mk₁ output_tape }) + t) : RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation - (toCompCfg_right tm1 tm2 x) - ((toCompCfg_right tm1 tm2) y) - m := by - refine RelatesWithinSteps.map (toCompCfg_right tm1 tm2) ?_ h + { state := some (Sum.inr tm2.q₀), BiTape := BiTape.mk₁ input_tape } + ({ state := none, BiTape := BiTape.mk₁ output_tape }) + t := by + refine RelatesWithinSteps.map (toCompCfg_right tm1 tm2) ?_ htm2 intro a b hab have h1 := map_toCompCfg_right_step tm1 tm2 a rw [hab, Option.map_some] at h1 @@ -487,16 +495,8 @@ def TimeComputable.comp RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } { state := none, BiTape := BiTape.mk₁ (g (f a)) } - (hg.time (f a).length) := by - -- TODO why is the previous have a one-liner and this is not? - -- reformulate the lemmas above so that this looks the same. - have := comp_right_relatesWithinSteps hf.tm hg.tm - { state := some hg.tm.q₀, BiTape := BiTape.mk₁ (f a) } - { state := none, BiTape := BiTape.mk₁ (g (f a)) } - (hg.time (f a).length) - hg_outputsFun - simp only [toCompCfg_right] at this - exact this + (hg.time (f a).length) := + comp_right_relatesWithinSteps hf.tm hg.tm (f a) (g (f a)) (hg.time (f a).length) hg_outputsFun have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a From 1576498635da2c76d884fe12af79f911fefdf058 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 22:25:50 -0800 Subject: [PATCH 28/95] clean up helpers --- .../Machines/SingleTapeTuring/Basic.lean | 78 +++++++++++-------- 1 file changed, 44 insertions(+), 34 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 0d55c159c..eb9b3d0ed 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -204,8 +204,7 @@ lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List replace hevals := hevals.apply_le_apply_add specialize hevals (Cfg.space_used tm) simp only [Cfg.space_used_initCfg, Cfg.space_used_haltCfg] at hevals - suffices l'.length ≤ max 1 l.length + steps - by omega + suffices l'.length ≤ max 1 l.length + steps by lia specialize hevals fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep) omega @@ -290,6 +289,22 @@ private def toCompCfg_right (tm1 tm2 : SingleTapeTM α) BiTape := cfg.BiTape } +/-- The initial configuration for the composed machine, with the first machine starting. -/ +private def initialCfg (tm1 tm2 : SingleTapeTM α) (input : List α) : + (compComputer tm1 tm2).Cfg := + { state := some (Sum.inl tm1.q₀), BiTape := BiTape.mk₁ input } + +/-- The intermediate configuration for the composed machine, +after the first machine halts and the second machine starts. -/ +private def intermediateCfg (tm1 tm2 : SingleTapeTM α) (intermediate : List α) : + (compComputer tm1 tm2).Cfg := + { state := some (Sum.inr tm2.q₀), BiTape := BiTape.mk₁ intermediate } + +/-- The final configuration for the composed machine, after the second machine halts. -/ +private def finalCfg (tm1 tm2 : SingleTapeTM α) (output : List α) : + (compComputer tm1 tm2).Cfg := + { state := none, BiTape := BiTape.mk₁ output } + /-- The left converting function commutes with steps of the machines. -/ private theorem map_toCompCfg_left_step (tm1 tm2 : SingleTapeTM α) @@ -379,24 +394,24 @@ private theorem comp_left_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) (t : ℕ) (htm1 : RelatesWithinSteps tm1.TransitionRelation - { state := some tm1.q₀, BiTape := BiTape.mk₁ input_tape } - ({ state := none, BiTape := BiTape.mk₁ intermediate_tape }) + (tm1.initCfg input_tape) + (tm1.haltCfg intermediate_tape) t) : RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation - { state := some (Sum.inl tm1.q₀), BiTape := BiTape.mk₁ input_tape } - ({ state := some (Sum.inr tm2.q₀), BiTape := BiTape.mk₁ intermediate_tape }) + (initialCfg tm1 tm2 input_tape) + (intermediateCfg tm1 tm2 intermediate_tape) t := by obtain ⟨steps, hsteps_le, hsteps_eval⟩ := htm1 use steps constructor · exact hsteps_le · have := comp_left_relatesInSteps tm1 tm2 - { state := some tm1.q₀, BiTape := BiTape.mk₁ input_tape } - (by simp) - { state := none, BiTape := BiTape.mk₁ intermediate_tape } + (tm1.initCfg input_tape) + (by simp [initCfg]) + (tm1.haltCfg intermediate_tape) steps hsteps_eval - simp only [toCompCfg_left] at this + simp only [toCompCfg_left, initCfg, haltCfg, initialCfg, intermediateCfg] at this ⊢ exact this /-- @@ -409,13 +424,14 @@ private theorem comp_right_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) (t : ℕ) (htm2 : RelatesWithinSteps tm2.TransitionRelation - { state := some tm2.q₀, BiTape := BiTape.mk₁ input_tape } - ({ state := none, BiTape := BiTape.mk₁ output_tape }) + (tm2.initCfg input_tape) + (tm2.haltCfg output_tape) t) : RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation - { state := some (Sum.inr tm2.q₀), BiTape := BiTape.mk₁ input_tape } - ({ state := none, BiTape := BiTape.mk₁ output_tape }) + (intermediateCfg tm1 tm2 input_tape) + (finalCfg tm1 tm2 output_tape) t := by + simp only [intermediateCfg, finalCfg, initCfg, haltCfg] at htm2 ⊢ refine RelatesWithinSteps.map (toCompCfg_right tm1 tm2) ?_ htm2 intro a b hab have h1 := map_toCompCfg_right_step tm1 tm2 a @@ -486,23 +502,21 @@ def TimeComputable.comp -- The computer reduces a to f a in time hf.time a have h_a_reducesTo_f_a : RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation - { state := some (Sum.inl hf.tm.q₀), BiTape := BiTape.mk₁ a } - { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } + (initialCfg hf.tm hg.tm a) + (intermediateCfg hf.tm hg.tm (f a)) (hf.time a.length) := comp_left_relatesWithinSteps hf.tm hg.tm a (f a) (hf.time a.length) hf_outputsFun -- The computer reduces f a to g (f a) in time hg.time (f a).length have h_f_a_reducesTo_g_f_a : RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation - { state := some (Sum.inr hg.tm.q₀), BiTape := BiTape.mk₁ (f a) } - { state := none, BiTape := BiTape.mk₁ (g (f a)) } + (intermediateCfg hf.tm hg.tm (f a)) + (finalCfg hf.tm hg.tm (g (f a))) (hg.time (f a).length) := comp_right_relatesWithinSteps hf.tm hg.tm (f a) (g (f a)) (hg.time (f a).length) hg_outputsFun - have h_a_reducesTo_g_f_a := - RelatesWithinSteps.trans - h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a + -- Therefore, the computer reduces a to g (f a) in the sum of those times. + have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a - apply add_le_add - · omega + refine Nat.add_le_add_left ?_ (hf.time a.length) · apply h_mono -- Use the lemma about output length being bounded by input length + time exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFun a) @@ -513,20 +527,17 @@ end TimeComputable ## Polynomial Time Computability This section defines polynomial time computable functions on Turing machines, -and proves that +and proves that: + * The identity function is polynomial time computable * The composition of two polynomial time computable functions is polynomial time computable -### TODO - -- Use of mathlib's `Polynomial` type leads to noncomputable definitions here. -Perhaps we could switch to a computable polynomial representation? -- Move to dedicated file? - -/ section PolyTimeComputable +open Polynomial + variable [Inhabited α] [Fintype α] /-- A Turing machine + a polynomial time function + @@ -541,7 +552,7 @@ structure PolyTimeComputable (f : List α → List α) extends TimeComputable f noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id where toTimeComputable := TimeComputable.id poly := 1 - bounds n := by simp only [TimeComputable.id, Polynomial.eval_one, le_refl] + bounds n := by simp only [TimeComputable.id, eval_one, le_refl] /-- A proof that the composition of two polytime computable functions is polytime computable. @@ -554,10 +565,9 @@ noncomputable def PolyTimeComputable.comp (h_mono : Monotone hg.time) : PolyTimeComputable (g ∘ f) where toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono - poly := hf.poly + hg.poly.comp (1 + Polynomial.X + hf.poly) + poly := hf.poly + hg.poly.comp (1 + X + hf.poly) bounds n := by - simp only [TimeComputable.comp, Polynomial.eval_add, Polynomial.eval_comp, Polynomial.eval_X, - Polynomial.eval_one] + simp only [TimeComputable.comp, eval_add, eval_comp, eval_X, eval_one] apply add_le_add · exact hf.bounds n · have : hg.time (max 1 n + hf.time n) ≤ hg.time (1 + n + hf.poly.eval n) := by From e348d7637a7f49d4237befc48725629d98c17050 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 22:29:50 -0800 Subject: [PATCH 29/95] further trim helpers --- .../Machines/SingleTapeTuring/Basic.lean | 66 ++++--------------- 1 file changed, 12 insertions(+), 54 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index eb9b3d0ed..2ed74883f 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -343,45 +343,6 @@ private theorem map_toCompCfg_right_step | none => simp only [hM, Option.map_some, toCompCfg_right, Option.map_none] | some q' => simp only [hM, Option.map_some, toCompCfg_right] - -/-- -The behavior of the left machine, converted to the composed machine, -preserves step count --/ -private theorem comp_left_relatesInSteps (tm1 tm2 : SingleTapeTM α) - (cfg : tm1.Cfg) - (hcfg : cfg.state.isSome) - (haltCfg : tm1.Cfg) - (steps : ℕ) - (h : RelatesInSteps tm1.TransitionRelation cfg haltCfg steps) : - RelatesInSteps (compComputer tm1 tm2).TransitionRelation - (toCompCfg_left tm1 tm2 cfg) - (toCompCfg_left tm1 tm2 haltCfg) - steps := by - induction steps generalizing cfg haltCfg with - | zero => - simp only [RelatesInSteps.zero_iff] at h ⊢ - rw [h] - | succ n ih => - rw [RelatesInSteps.succ_iff] at h ⊢ - obtain ⟨c, hc_n, hc_step⟩ := h - use toCompCfg_left tm1 tm2 c - constructor - · apply ih - · exact hcfg - · exact hc_n - · cases c with - | mk state BiTape => - cases state with - | none => - simp only [TransitionRelation, step] at hc_step - cases hc_step - | some q => - have h1 := map_toCompCfg_left_step tm1 tm2 ⟨some q, BiTape⟩ (by simp) - simp only [TransitionRelation] at hc_step ⊢ - rw [hc_step, Option.map_some] at h1 - exact h1.symm - /-- Simulation for the first phase of the composed computer. When the first machine runs from start to halt, the composed machine @@ -401,18 +362,15 @@ private theorem comp_left_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) (initialCfg tm1 tm2 input_tape) (intermediateCfg tm1 tm2 intermediate_tape) t := by - obtain ⟨steps, hsteps_le, hsteps_eval⟩ := htm1 - use steps - constructor - · exact hsteps_le - · have := comp_left_relatesInSteps tm1 tm2 - (tm1.initCfg input_tape) - (by simp [initCfg]) - (tm1.haltCfg intermediate_tape) - steps - hsteps_eval - simp only [toCompCfg_left, initCfg, haltCfg, initialCfg, intermediateCfg] at this ⊢ - exact this + simp only [initialCfg, intermediateCfg, initCfg, haltCfg] at htm1 ⊢ + refine RelatesWithinSteps.map (toCompCfg_left tm1 tm2) ?_ htm1 + intro a b hab + have ha : a.state.isSome := by + simp only [TransitionRelation, step] at hab + cases a with | mk state _ => cases state <;> simp_all + have h1 := map_toCompCfg_left_step tm1 tm2 a ha + rw [hab, Option.map_some] at h1 + exact h1.symm /-- Simulation for the second phase of the composed computer. @@ -420,15 +378,15 @@ When the second machine runs from start to halt, the composed machine runs from Sum.inr tm2.q₀ to halt. -/ private theorem comp_right_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) - (input_tape output_tape : List α) + (intermediate_tape output_tape : List α) (t : ℕ) (htm2 : RelatesWithinSteps tm2.TransitionRelation - (tm2.initCfg input_tape) + (tm2.initCfg intermediate_tape) (tm2.haltCfg output_tape) t) : RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation - (intermediateCfg tm1 tm2 input_tape) + (intermediateCfg tm1 tm2 intermediate_tape) (finalCfg tm1 tm2 output_tape) t := by simp only [intermediateCfg, finalCfg, initCfg, haltCfg] at htm2 ⊢ From c5231d954ce22f1058b5e9bd02775db9ea2000b3 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 23:09:59 -0800 Subject: [PATCH 30/95] remove vanilla computable --- .../Machines/SingleTapeTuring/Basic.lean | 26 +++++++------------ 1 file changed, 9 insertions(+), 17 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 2ed74883f..eb9d62e58 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -26,8 +26,7 @@ We define a number of structures related to Turing machine computation: * `Stmt`: the write and movement operations a TM can do in a single step. * `SingleTapeTM`: the TM itself. * `Cfg`: the configuration of a TM, including internal and tape state. -* `Computable f`: a TM for computing function `f`, packaged with a proof of correctness. -* `TimeComputable f`: `Computable f` additionally packaged with a bound on runtime. +* `TimeComputable f`: a TM for computing `f`, packaged with a bound on runtime. * `PolyTimeComputable f`: `TimeComputable f` packaged with a polynomial bound on runtime. We also provide ways of constructing polynomial-runtime TMs @@ -208,14 +207,7 @@ lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List specialize hevals fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep) omega -/-- A Turing machine + a proof it outputsInTime `f`. -/ -structure Computable (f : List α → List α) where - /-- the underlying bundled SingleTapeTM -/ - tm : SingleTapeTM α - /-- a proof this machine outputsInTime `f` -/ - outputsFun : ∀ a, tm.Outputs a (f a) - -section +section Computers variable [Inhabited α] [Fintype α] @@ -398,7 +390,7 @@ private theorem comp_right_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) end compComputerLemmas -end +end Computers /-! ## Time Computability @@ -418,14 +410,14 @@ structure TimeComputable (f : List α → List α) where /-- a time function -/ time : ℕ → ℕ /-- proof this machine outputs `f` in at most `time(input.length)` steps -/ - outputsFun : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) + outputsFunInTime : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) /-- The identity map on α is computable in constant time. -/ def TimeComputable.id : TimeComputable (α := α) id where tm := idComputer time _ := 1 - outputsFun x := by + outputsFunInTime x := by refine ⟨1, le_refl 1, RelatesInSteps.single ?_⟩ simp only [TransitionRelation, initCfg, haltCfg, idComputer, step, BiTape.optionMove] rfl @@ -452,9 +444,9 @@ def TimeComputable.comp tm := compComputer hf.tm hg.tm -- perhaps it would be good to track the blow up separately? time l := (hf.time l) + hg.time (max 1 l + hf.time l) - outputsFun a := by - have hf_outputsFun := hf.outputsFun a - have hg_outputsFun := hg.outputsFun (f a) + outputsFunInTime a := by + have hf_outputsFun := hf.outputsFunInTime a + have hg_outputsFun := hg.outputsFunInTime (f a) simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, haltCfg] at hg_outputsFun hf_outputsFun ⊢ -- The computer reduces a to f a in time hf.time a @@ -477,7 +469,7 @@ def TimeComputable.comp refine Nat.add_le_add_left ?_ (hf.time a.length) · apply h_mono -- Use the lemma about output length being bounded by input length + time - exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFun a) + exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFunInTime a) end TimeComputable From b191ee95b260ca6dfe071a5ab53fbead5a2dafb5 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 23:25:51 -0800 Subject: [PATCH 31/95] rename fields --- .../Machines/SingleTapeTuring/Basic.lean | 37 ++++++++++--------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index eb9d62e58..198eca90f 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -407,16 +407,16 @@ a proof it outputs `f` in at most `time(input.length)` steps. -/ structure TimeComputable (f : List α → List α) where /-- the underlying bundled SingleTapeTM -/ tm : SingleTapeTM α - /-- a time function -/ - time : ℕ → ℕ - /-- proof this machine outputs `f` in at most `time(input.length)` steps -/ - outputsFunInTime : ∀ a, tm.OutputsWithinTime a (f a) (time a.length) + /-- a bound on runtime -/ + time_bound : ℕ → ℕ + /-- proof this machine outputs `f` in at most `time_bound(input.length)` steps -/ + outputsFunInTime : ∀ a, tm.OutputsWithinTime a (f a) (time_bound a.length) /-- The identity map on α is computable in constant time. -/ def TimeComputable.id : TimeComputable (α := α) id where tm := idComputer - time _ := 1 + time_bound _ := 1 outputsFunInTime x := by refine ⟨1, le_refl 1, RelatesInSteps.single ?_⟩ simp only [TransitionRelation, initCfg, haltCfg, idComputer, step, BiTape.optionMove] @@ -439,34 +439,36 @@ then the time bound for the second machine still holds for that shorter input to def TimeComputable.comp {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) - (h_mono : Monotone hg.time) : + (h_mono : Monotone hg.time_bound) : (TimeComputable (g ∘ f)) where tm := compComputer hf.tm hg.tm -- perhaps it would be good to track the blow up separately? - time l := (hf.time l) + hg.time (max 1 l + hf.time l) + time_bound l := (hf.time_bound l) + hg.time_bound (max 1 l + hf.time_bound l) outputsFunInTime a := by have hf_outputsFun := hf.outputsFunInTime a have hg_outputsFun := hg.outputsFunInTime (f a) simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, haltCfg] at hg_outputsFun hf_outputsFun ⊢ - -- The computer reduces a to f a in time hf.time a + -- The computer reduces a to f a in time hf.time_bound a.length have h_a_reducesTo_f_a : RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation (initialCfg hf.tm hg.tm a) (intermediateCfg hf.tm hg.tm (f a)) - (hf.time a.length) := - comp_left_relatesWithinSteps hf.tm hg.tm a (f a) (hf.time a.length) hf_outputsFun - -- The computer reduces f a to g (f a) in time hg.time (f a).length + (hf.time_bound a.length) := + comp_left_relatesWithinSteps hf.tm hg.tm a (f a) + (hf.time_bound a.length) hf_outputsFun + -- The computer reduces f a to g (f a) in time hg.time_bound (f a).length have h_f_a_reducesTo_g_f_a : RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation (intermediateCfg hf.tm hg.tm (f a)) (finalCfg hf.tm hg.tm (g (f a))) - (hg.time (f a).length) := - comp_right_relatesWithinSteps hf.tm hg.tm (f a) (g (f a)) (hg.time (f a).length) hg_outputsFun + (hg.time_bound (f a).length) := + comp_right_relatesWithinSteps hf.tm hg.tm (f a) (g (f a)) + (hg.time_bound (f a).length) hg_outputsFun -- Therefore, the computer reduces a to g (f a) in the sum of those times. have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a - refine Nat.add_le_add_left ?_ (hf.time a.length) + refine Nat.add_le_add_left ?_ (hf.time_bound a.length) · apply h_mono -- Use the lemma about output length being bounded by input length + time exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFunInTime a) @@ -496,7 +498,7 @@ structure PolyTimeComputable (f : List α → List α) extends TimeComputable f /-- a polynomial time bound -/ poly : Polynomial ℕ /-- proof that this machine outputs `f` in at most `time(input.length)` steps -/ - bounds : ∀ n, time n ≤ poly.eval n + bounds : ∀ n, time_bound n ≤ poly.eval n /-- A proof that the identity map on α is computable in polytime. -/ noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id where @@ -512,7 +514,7 @@ noncomputable def PolyTimeComputable.comp (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) -- all Nat polynomials are monotone, but the tighter internal bound maybe is not, awkwardly - (h_mono : Monotone hg.time) : + (h_mono : Monotone hg.time_bound) : PolyTimeComputable (g ∘ f) where toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono poly := hf.poly + hg.poly.comp (1 + X + hf.poly) @@ -520,7 +522,8 @@ noncomputable def PolyTimeComputable.comp simp only [TimeComputable.comp, eval_add, eval_comp, eval_X, eval_one] apply add_le_add · exact hf.bounds n - · have : hg.time (max 1 n + hf.time n) ≤ hg.time (1 + n + hf.poly.eval n) := by + · have : hg.time_bound (max 1 n + hf.time_bound n) + ≤ hg.time_bound (1 + n + hf.poly.eval n) := by apply h_mono apply add_le_add · omega -- lia fails From c9ac3677766677353d5f6fba4975aca6909e4444 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 23:32:03 -0800 Subject: [PATCH 32/95] public import Cslib.Init --- Cslib/Foundations/Data/StackTape.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 0c8c2dbc6..f1c20d3ea 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -6,6 +6,7 @@ Authors: Bolton Bailey module +public import Cslib.Init public import Mathlib.Data.List.Basic @[expose] public section From 928612828882c3a2d554b8098ea0adbebdf20042 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Thu, 22 Jan 2026 23:32:23 -0800 Subject: [PATCH 33/95] add note --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 198eca90f..b5c8f00e6 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -506,6 +506,8 @@ noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id wher poly := 1 bounds n := by simp only [TimeComputable.id, eval_one, le_refl] +-- TODO remove `h_mono` assumption +-- by developing function to convert PolyTimeComputable into one with monotone time bound /-- A proof that the composition of two polytime computable functions is polytime computable. -/ @@ -513,7 +515,6 @@ noncomputable def PolyTimeComputable.comp {f g : List α → List α} (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) - -- all Nat polynomials are monotone, but the tighter internal bound maybe is not, awkwardly (h_mono : Monotone hg.time_bound) : PolyTimeComputable (g ∘ f) where toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono From 2ab47519adea52134742356dae6bab72697efba9 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 13:55:33 -0800 Subject: [PATCH 34/95] correct cons and provide API --- Cslib/Foundations/Data/StackTape.lean | 143 ++++++++++++++++++++------ 1 file changed, 112 insertions(+), 31 deletions(-) diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index f1c20d3ea..4252d73de 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -31,61 +31,140 @@ namespace Turing List of `Option` values that don't end with `none` -/ structure StackTape (α : Type) where - (asList : List (Option α)) + (toList : List (Option α)) -- The list can be empty (i.e. `none`), -- but if it is not empty, the last element is not (`some`) `none` - (h : asList.getLast? ≠ some none) + (toList_getLast?_ne_some_none : toList.getLast? ≠ some none) -def StackTape.empty {α} : StackTape α := { asList := [], h := by simp } +/-- The empty `StackTape` -/ +def StackTape.empty {α} : StackTape α := ⟨[], by simp⟩ -def StackTape.map_some {α} (l : List α) : StackTape α := { asList := l.map some, h := by simp } +/-- Create a `StackTape` from a list by mapping all elements to `some` -/ +def StackTape.map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ instance {α : Type} : Inhabited (StackTape α) where default := StackTape.empty -def StackTape.length {α} (l : StackTape α) : ℕ := l.asList.length +/-- The length of the `StackTape` is the number of elements up to the last non-`none` element -/ +def StackTape.length {α} (l : StackTape α) : ℕ := l.toList.length -def StackTape.cons {α} : Option α -> StackTape α -> StackTape α -| none, l => { asList := [], h := by simp } -| some a, l => { - asList := some a :: l.asList, - h := by - cases hl : l.asList with +/-- Prepend an `Option` to the `StackTape` -/ +def StackTape.cons {α} (x : Option α) (xs : StackTape α) : StackTape α := + match x, xs with + | none, ⟨[], _⟩ => ⟨[], by simp⟩ + | none, ⟨hd :: tl, hl⟩ => ⟨none :: hd :: tl, by simp only [List.getLast?_cons_cons]; exact hl⟩ + | some a, ⟨l, hl⟩ => ⟨some a :: l, by + cases hl' : l with | nil => simp | cons hd tl => simp only [List.getLast?_cons_cons] - rw [← hl] - exact l.h - } + exact ne_of_eq_of_ne (congrArg List.getLast? (id (Eq.symm hl'))) hl⟩ +/-- Remove the first element of the `StackTape`, returning the rest -/ def StackTape.tail {α} (l : StackTape α) : StackTape α := - match hl : l.asList with + match hl : l.toList with | [] => StackTape.empty - | hd :: t => { asList := t, h := by - match t with - | [] => simp - | hd' :: t' => - have lh := l.h - rw [hl] at lh - simp only [List.getLast?_cons_cons] at lh - have := l.h - rw [hl, List.getLast?_cons_cons] at this - exact this - } - + | hd :: t => ⟨t, by + match t with + | [] => simp + | hd' :: t' => + have lh := l.toList_getLast?_ne_some_none + rw [hl] at lh + simp only [List.getLast?_cons_cons] at lh + have := l.toList_getLast?_ne_some_none + rw [hl, List.getLast?_cons_cons] at this + exact this⟩ + +/-- Get the first element of the `StackTape`. -/ def StackTape.head {α} (l : StackTape α) : Option α := - match l.asList with + match l.toList with | [] => none | h :: _ => h +lemma StackTape.eq_iff {α} (l1 l2 : StackTape α) : + l1 = l2 ↔ l1.head = l2.head ∧ l1.tail = l2.tail := by + constructor + · intro h + rw [h] + simp + · intro ⟨hhead, htail⟩ + cases l1 with | mk as1 h1 => + cases l2 with | mk as2 h2 => + simp only [mk.injEq] + cases as1 with + | nil => + cases as2 with + | nil => rfl + | cons hd2 tl2 => + simp only [head] at hhead + simp only [tail, empty, mk.injEq] at htail + subst htail hhead + simp at h2 + | cons hd1 tl1 => + cases as2 with + | nil => + simp only [head] at hhead + simp only [tail, empty, mk.injEq] at htail + subst htail hhead + simp at h1 + | cons hd2 tl2 => + simp only [head] at hhead + simp only [tail, mk.injEq] at htail + rw [hhead, htail] + +@[simp] +lemma StackTape.head_cons {α} (o : Option α) (l : StackTape α) : + (StackTape.cons o l).head = o := by + cases o with + | none => + cases l with | mk toList hl => + cases toList with + | nil => simp [cons, head] + | cons hd tl => simp [cons, head] + | some a => simp [cons, head] + +@[simp] +lemma StackTape.tail_cons {α} (o : Option α) (l : StackTape α) : + (StackTape.cons o l).tail = l := by + cases o with + | none => + cases l with | mk toList h => + cases toList with + | nil => simp [cons, tail, empty] + | cons hd tl => simp [cons, tail] + | some a => + simp only [cons] + unfold tail + simp only + +@[simp] +lemma StackTape.cons_head_tail {α} (l : StackTape α) : + StackTape.cons (l.head) (l.tail) = l := by + cases l with | mk toList h => + cases toList with + | nil => simp [head, tail, cons, empty] + | cons hd tl => + simp only [head, tail] + cases hd with + | none => + cases tl with + | nil => simp at h + | cons hd' tl' => simp [cons] + | some a => + simp only [cons] + lemma StackTape.length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by unfold tail length split · simp [empty] · next heq => simp [heq] -lemma StackTape.length_cons_none {α} (l : StackTape α) : (StackTape.cons none l).length = 0 := by - simp [cons, length] +lemma StackTape.length_cons_none {α} (l : StackTape α) : + (StackTape.cons none l).length = l.length + if l.length = 0 then 0 else 1 := by + cases l with | mk toList h => + cases toList with + | nil => simp [cons, length] + | cons hd tl => simp [cons, length] lemma StackTape.length_cons_some {α} (a : α) (l : StackTape α) : (StackTape.cons (some a) l).length = l.length + 1 := by @@ -94,7 +173,9 @@ lemma StackTape.length_cons_some {α} (a : α) (l : StackTape α) : lemma StackTape.length_cons_le {α} (o : Option α) (l : StackTape α) : (StackTape.cons o l).length ≤ l.length + 1 := by cases o with - | none => simp [length_cons_none] + | none => + simp only [length_cons_none] + split <;> omega | some a => simp [length_cons_some] lemma StackTape.length_map_some {α} (l : List α) : (StackTape.map_some l).length = l.length := by From ccd403479ab50ff347e0e62bb1353d5fedbaf653 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 14:35:48 -0800 Subject: [PATCH 35/95] clean up tape apis --- Cslib/Foundations/Data/BiTape.lean | 39 ++++++--- Cslib/Foundations/Data/StackTape.lean | 116 ++++++++------------------ 2 files changed, 62 insertions(+), 93 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 40a5c1bab..239f44adb 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -45,7 +45,15 @@ structure BiTape (α : Type) where (head : Option α) (left : StackTape α) (right : StackTape α) -deriving Inhabited + +/-- The empty `BiTape` -/ +def BiTape.nil {α} : BiTape α := ⟨none, StackTape.nil, StackTape.nil⟩ + +instance {α : Type} : Inhabited (BiTape α) where + default := BiTape.nil + +instance {α : Type} : EmptyCollection (BiTape α) := + ⟨BiTape.nil⟩ /-- Given a `List` of `α`, construct a `BiTape` by mapping the list to `some` elements @@ -54,19 +62,23 @@ with the head under the first element of the list if it exists. -/ def BiTape.mk₁ {α} (l : List α) : BiTape α := match l with - | [] => { head := none, left := StackTape.empty, right := StackTape.empty } - | h :: t => { head := some h, left := StackTape.empty, right := StackTape.map_some t } + | [] => BiTape.nil + | h :: t => ⟨some h, StackTape.nil, StackTape.map_some t⟩ + +section move + +def BiTape.move_left {α} (t : Turing.BiTape α) : Turing.BiTape α := + ⟨t.left.head, t.left.tail, StackTape.cons t.head t.right⟩ + +def BiTape.move_right {α} (t : Turing.BiTape α) : Turing.BiTape α := + ⟨t.right.head, StackTape.cons t.head t.left, t.right.tail⟩ /-- Move the head to the left or right, shifting the tape underneath it. -/ def BiTape.move {α} : Turing.BiTape α → Dir → Turing.BiTape α - | t, .left => - match t.left, t.head, t.right with - | l, h, r => { head := l.head, left := l.tail, right := StackTape.cons h r } - | t, .right => - match t.left, t.head, t.right with - | l, h, r => { head := r.head, left := StackTape.cons h l, right := r.tail } + | t, .left => t.move_left + | t, .right => t.move_right /-- Optionally perform a `BiTape.move`, or do nothing if `none`. @@ -75,6 +87,8 @@ def BiTape.optionMove {α} : Turing.BiTape α → Option Dir → Turing.BiTape | t, none => t | t, some d => t.move d +end move + /-- Write a value under the head of the `BiTape`. -/ @@ -94,10 +108,13 @@ lemma BiTape.space_used_write {α} (t : Turing.BiTape α) (a : Option α) : lemma BiTape.space_used_mk₁ {α} (l : List α) : (BiTape.mk₁ l).space_used = max 1 l.length := by - cases l <;> grind [mk₁, space_used, StackTape.length_empty, StackTape.length_map_some] + cases l with + | nil => simp [mk₁, space_used, nil, StackTape.length_nil] + | cons h t => simp [mk₁, space_used, StackTape.length_nil, StackTape.length_map_some]; omega lemma BiTape.space_used_move {α} (t : Turing.BiTape α) (d : Dir) : (t.move d).space_used ≤ t.space_used + 1 := by - cases d <;> grind [move, space_used, StackTape.length_tail_le, StackTape.length_cons_le] + cases d <;> grind [move_left, move_right, move, + space_used, StackTape.length_tail_le, StackTape.length_cons_le] end Turing diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 4252d73de..88dc85b42 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -17,7 +17,7 @@ public import Mathlib.Data.List.Basic This file defines `StackTape`, a list of `Option` values where the list cannot end with `none`. This represents a stack-like data structure which treats the end of the list as an infinite sequence of `none` values. -This is useful as a data structure with a simple API for manipulation by Turing machines . +This is useful as a data structure with a simple API for manipulation by Turing machines. ## TODO @@ -36,44 +36,32 @@ structure StackTape (α : Type) where -- but if it is not empty, the last element is not (`some`) `none` (toList_getLast?_ne_some_none : toList.getLast? ≠ some none) -/-- The empty `StackTape` -/ -def StackTape.empty {α} : StackTape α := ⟨[], by simp⟩ +attribute [scoped grind! .] StackTape.toList_getLast?_ne_some_none -/-- Create a `StackTape` from a list by mapping all elements to `some` -/ -def StackTape.map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ +/-- The empty `StackTape` -/ +def StackTape.nil {α} : StackTape α := ⟨[], by grind⟩ instance {α : Type} : Inhabited (StackTape α) where - default := StackTape.empty + default := StackTape.nil -/-- The length of the `StackTape` is the number of elements up to the last non-`none` element -/ -def StackTape.length {α} (l : StackTape α) : ℕ := l.toList.length +instance {α : Type} : EmptyCollection (StackTape α) := + ⟨StackTape.nil⟩ + +/-- Create a `StackTape` from a list by mapping all elements to `some` -/ +def StackTape.map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ /-- Prepend an `Option` to the `StackTape` -/ def StackTape.cons {α} (x : Option α) (xs : StackTape α) : StackTape α := match x, xs with - | none, ⟨[], _⟩ => ⟨[], by simp⟩ - | none, ⟨hd :: tl, hl⟩ => ⟨none :: hd :: tl, by simp only [List.getLast?_cons_cons]; exact hl⟩ - | some a, ⟨l, hl⟩ => ⟨some a :: l, by - cases hl' : l with - | nil => simp - | cons hd tl => - simp only [List.getLast?_cons_cons] - exact ne_of_eq_of_ne (congrArg List.getLast? (id (Eq.symm hl'))) hl⟩ + | none, ⟨[], _⟩ => ⟨[], by grind⟩ + | none, ⟨hd :: tl, hl⟩ => ⟨none :: hd :: tl, by grind⟩ + | some a, ⟨l, hl⟩ => ⟨some a :: l, by grind⟩ /-- Remove the first element of the `StackTape`, returning the rest -/ def StackTape.tail {α} (l : StackTape α) : StackTape α := match hl : l.toList with - | [] => StackTape.empty - | hd :: t => ⟨t, by - match t with - | [] => simp - | hd' :: t' => - have lh := l.toList_getLast?_ne_some_none - rw [hl] at lh - simp only [List.getLast?_cons_cons] at lh - have := l.toList_getLast?_ne_some_none - rw [hl, List.getLast?_cons_cons] at this - exact this⟩ + | [] => StackTape.nil + | hd :: t => ⟨t, by grind⟩ /-- Get the first element of the `StackTape`. -/ def StackTape.head {α} (l : StackTape α) : Option α := @@ -84,33 +72,11 @@ def StackTape.head {α} (l : StackTape α) : Option α := lemma StackTape.eq_iff {α} (l1 l2 : StackTape α) : l1 = l2 ↔ l1.head = l2.head ∧ l1.tail = l2.tail := by constructor - · intro h - rw [h] - simp + · grind · intro ⟨hhead, htail⟩ cases l1 with | mk as1 h1 => cases l2 with | mk as2 h2 => - simp only [mk.injEq] - cases as1 with - | nil => - cases as2 with - | nil => rfl - | cons hd2 tl2 => - simp only [head] at hhead - simp only [tail, empty, mk.injEq] at htail - subst htail hhead - simp at h2 - | cons hd1 tl1 => - cases as2 with - | nil => - simp only [head] at hhead - simp only [tail, empty, mk.injEq] at htail - subst htail hhead - simp at h1 - | cons hd2 tl2 => - simp only [head] at hhead - simp only [tail, mk.injEq] at htail - rw [hhead, htail] + cases as1 <;> cases as2 <;> grind [tail, head, mk.injEq, nil, mk.injEq] @[simp] lemma StackTape.head_cons {α} (o : Option α) (l : StackTape α) : @@ -118,9 +84,7 @@ lemma StackTape.head_cons {α} (o : Option α) (l : StackTape α) : cases o with | none => cases l with | mk toList hl => - cases toList with - | nil => simp [cons, head] - | cons hd tl => simp [cons, head] + cases toList <;> simp [cons, head] | some a => simp [cons, head] @[simp] @@ -130,41 +94,31 @@ lemma StackTape.tail_cons {α} (o : Option α) (l : StackTape α) : | none => cases l with | mk toList h => cases toList with - | nil => simp [cons, tail, empty] + | nil => simp [cons, tail, nil] | cons hd tl => simp [cons, tail] | some a => simp only [cons] unfold tail - simp only + grind @[simp] lemma StackTape.cons_head_tail {α} (l : StackTape α) : StackTape.cons (l.head) (l.tail) = l := by - cases l with | mk toList h => - cases toList with - | nil => simp [head, tail, cons, empty] - | cons hd tl => - simp only [head, tail] - cases hd with - | none => - cases tl with - | nil => simp at h - | cons hd' tl' => simp [cons] - | some a => - simp only [cons] + rw [StackTape.eq_iff] + simp + +section Length + +/-- The length of the `StackTape` is the number of elements up to the last non-`none` element -/ +def StackTape.length {α} (l : StackTape α) : ℕ := l.toList.length lemma StackTape.length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by - unfold tail length - split - · simp [empty] - · next heq => simp [heq] + grind [tail, length, nil] lemma StackTape.length_cons_none {α} (l : StackTape α) : (StackTape.cons none l).length = l.length + if l.length = 0 then 0 else 1 := by cases l with | mk toList h => - cases toList with - | nil => simp [cons, length] - | cons hd tl => simp [cons, length] + cases toList <;> simp [cons, length] lemma StackTape.length_cons_some {α} (a : α) (l : StackTape α) : (StackTape.cons (some a) l).length = l.length + 1 := by @@ -172,16 +126,14 @@ lemma StackTape.length_cons_some {α} (a : α) (l : StackTape α) : lemma StackTape.length_cons_le {α} (o : Option α) (l : StackTape α) : (StackTape.cons o l).length ≤ l.length + 1 := by - cases o with - | none => - simp only [length_cons_none] - split <;> omega - | some a => simp [length_cons_some] + cases o <;> grind [length_cons_none, length_cons_some] lemma StackTape.length_map_some {α} (l : List α) : (StackTape.map_some l).length = l.length := by simp [map_some, length] -lemma StackTape.length_empty {α} : (StackTape.empty : StackTape α).length = 0 := by - simp [empty, length] +lemma StackTape.length_nil {α} : (StackTape.nil : StackTape α).length = 0 := by + simp [nil, length] + +end Length end Turing From ba47f4fce8a148dcda8f451ddd83a987ecdfaccc Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 14:37:06 -0800 Subject: [PATCH 36/95] add docstrings --- Cslib/Foundations/Data/BiTape.lean | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 239f44adb..7eefbfbf0 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -67,9 +67,15 @@ def BiTape.mk₁ {α} (l : List α) : BiTape α := section move +/-- +Move the head left by shifting the left StackTape under the head. +-/ def BiTape.move_left {α} (t : Turing.BiTape α) : Turing.BiTape α := ⟨t.left.head, t.left.tail, StackTape.cons t.head t.right⟩ +/-- +Move the head right by shifting the right StackTape under the head. +-/ def BiTape.move_right {α} (t : Turing.BiTape α) : Turing.BiTape α := ⟨t.right.head, StackTape.cons t.head t.left, t.right.tail⟩ From a387696c472c99014b5b550699937ace0c5df03d Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 14:45:11 -0800 Subject: [PATCH 37/95] more doc linter --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 2 ++ Cslib/Foundations/Data/BiTape.lean | 3 +++ Cslib/Foundations/Data/StackTape.lean | 7 +++++-- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index b5c8f00e6..627810971 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -57,9 +57,11 @@ and write a symbol on the `BiTape`. def Stmt (α : Type) := Option α × Option Dir deriving Inhabited +/-- Get the symbol to write from a `Stmt`. -/ def Stmt.symbol : Stmt α → Option α | (symbol, _) => symbol +/-- Get the movement direction from a `Stmt`. -/ def Stmt.movement : Stmt α → Option Dir | (_, movement) => movement diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 7eefbfbf0..66e4d5302 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -42,8 +42,11 @@ A structure for bidirectionally-infinite Turing machine tapes that eventually take on blank `none` values -/ structure BiTape (α : Type) where + /-- The symbol currently under the tape head -/ (head : Option α) + /-- The contents to the left of the head -/ (left : StackTape α) + /-- The contents to the right of the head -/ (right : StackTape α) /-- The empty `BiTape` -/ diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 88dc85b42..2716924a2 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -31,9 +31,12 @@ namespace Turing List of `Option` values that don't end with `none` -/ structure StackTape (α : Type) where + /-- The underlying list representation -/ (toList : List (Option α)) - -- The list can be empty (i.e. `none`), - -- but if it is not empty, the last element is not (`some`) `none` + /-- + The list can be empty (i.e. `none`), + but if it is not empty, the last element is not (`some`) `none` + -/ (toList_getLast?_ne_some_none : toList.getLast? ≠ some none) attribute [scoped grind! .] StackTape.toList_getLast?_ne_some_none From 1a77e7c25c53c197a168a0ac8e7b37937dae2dbc Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 14:46:33 -0800 Subject: [PATCH 38/95] imrove docs --- Cslib/Foundations/Data/StackTape.lean | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 2716924a2..823882562 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -28,7 +28,10 @@ This is useful as a data structure with a simple API for manipulation by Turing namespace Turing /-- -List of `Option` values that don't end with `none` +An infinite tape representation using a list of `Option` values, +where the list is eventually `none`. + +Represented as a `List (Option α)` that does not end with `none`. -/ structure StackTape (α : Type) where /-- The underlying list representation -/ From 3d639c2fe13e8b2c91144db1e1038b9cf3ff8a2b Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 14:47:18 -0800 Subject: [PATCH 39/95] revert whitespace --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 85b216ae8..65cfbacbb 100644 --- a/.gitignore +++ b/.gitignore @@ -14,4 +14,4 @@ /docs/Std-manifest.json.hash /docs/Std-manifest.json.trace .DS_Store -.claude +.claude \ No newline at end of file From d14d5ee34d3e63c049779948042fa942a97cda7e Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 15:04:35 -0800 Subject: [PATCH 40/95] clean up lines --- Cslib/Foundations/Data/BiTape.lean | 19 ++++++++----------- Cslib/Foundations/Data/StackTape.lean | 4 +--- 2 files changed, 9 insertions(+), 14 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 66e4d5302..e8b25380d 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -68,7 +68,7 @@ def BiTape.mk₁ {α} (l : List α) : BiTape α := | [] => BiTape.nil | h :: t => ⟨some h, StackTape.nil, StackTape.map_some t⟩ -section move +section Move /-- Move the head left by shifting the left StackTape under the head. @@ -85,9 +85,9 @@ def BiTape.move_right {α} (t : Turing.BiTape α) : Turing.BiTape α := /-- Move the head to the left or right, shifting the tape underneath it. -/ -def BiTape.move {α} : Turing.BiTape α → Dir → Turing.BiTape α - | t, .left => t.move_left - | t, .right => t.move_right +def BiTape.move {α} (t : Turing.BiTape α) : Dir → Turing.BiTape α + | .left => t.move_left + | .right => t.move_right /-- Optionally perform a `BiTape.move`, or do nothing if `none`. @@ -96,24 +96,21 @@ def BiTape.optionMove {α} : Turing.BiTape α → Option Dir → Turing.BiTape | t, none => t | t, some d => t.move d -end move +end Move /-- Write a value under the head of the `BiTape`. -/ -def BiTape.write {α} : Turing.BiTape α → Option α → Turing.BiTape α - | t, a => { t with head := a } +def BiTape.write {α} (t : Turing.BiTape α) (a : Option α) : Turing.BiTape α := { t with head := a } /-- The space used by a `BiTape` is the number of symbols between and including the head, and leftmost and rightmost non-blank symbols on the `BiTape`. -/ -def BiTape.space_used {α} (t : Turing.BiTape α) : ℕ := - 1 + t.left.length + t.right.length +def BiTape.space_used {α} (t : Turing.BiTape α) : ℕ := 1 + t.left.length + t.right.length lemma BiTape.space_used_write {α} (t : Turing.BiTape α) (a : Option α) : - (t.write a).space_used = t.space_used := by - rfl + (t.write a).space_used = t.space_used := by rfl lemma BiTape.space_used_mk₁ {α} (l : List α) : (BiTape.mk₁ l).space_used = max 1 l.length := by diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 823882562..78844f168 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -103,9 +103,7 @@ lemma StackTape.tail_cons {α} (o : Option α) (l : StackTape α) : | nil => simp [cons, tail, nil] | cons hd tl => simp [cons, tail] | some a => - simp only [cons] - unfold tail - grind + simp only [cons, tail] @[simp] lemma StackTape.cons_head_tail {α} (l : StackTape α) : From 8b06d4a97fa15a502553f5a75beff823932afc70 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 15:16:21 -0800 Subject: [PATCH 41/95] use variables --- .../Machines/SingleTapeTuring/Basic.lean | 106 +++++++----------- 1 file changed, 42 insertions(+), 64 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 627810971..17ad6e014 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -81,7 +81,7 @@ structure SingleTapeTM α where (q₀ : Λ) /-- Transition function, mapping a state and a head symbol to a Stmt to invoke, and optionally a new state (none for halt) -/ - (M : Λ → (Option α) → (Turing.SingleTapeTM.Stmt α × Option Λ)) + (M : Λ → Option α → Turing.SingleTapeTM.Stmt α × Option Λ) namespace SingleTapeTM @@ -97,18 +97,16 @@ and the intended initial and final configurations. variable (tm : SingleTapeTM α) -instance : Inhabited tm.Λ := - ⟨tm.q₀⟩ +instance : Inhabited tm.Λ := ⟨tm.q₀⟩ -instance : Fintype tm.Λ := - tm.FintypeΛ +instance : Fintype tm.Λ := tm.FintypeΛ instance inhabitedStmt : Inhabited (Stmt α) := inferInstance /-- -The configurations of a Turing machine consist of an `Option`al state -(or none for the halting state) -and an BiTape representing the tape contents. +The configurations of a Turing machine consist of: +an `Option`al state (or none for the halting state), +and a `BiTape` representing the tape contents. -/ structure Cfg : Type where /-- the state of the TM (or none for the halting state) -/ @@ -117,7 +115,7 @@ structure Cfg : Type where BiTape : BiTape α deriving Inhabited -/-- The step function corresponding to this TM. -/ +/-- The step function corresponding to a `SingleTapeTM`. -/ @[simp] def step : tm.Cfg → Option tm.Cfg := fun ⟨q, t⟩ => @@ -147,8 +145,7 @@ def haltCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨none, BiTape.mk /-- The space used by a configuration is the space used by its tape. -/ -def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := - cfg.BiTape.space_used +def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := cfg.BiTape.space_used lemma Cfg.space_used_initCfg (tm : SingleTapeTM α) (s : List α) : (tm.initCfg s).space_used = max 1 s.length := by @@ -178,16 +175,14 @@ The `TransitionRelation` corresponding to a `SingleTapeTM α` is defined by the `step` function, which maps a configuration to its next configuration, if it exists. -/ -def TransitionRelation (tm : SingleTapeTM α) (c₁ c₂ : tm.Cfg) : Prop := - tm.step c₁ = some c₂ +def TransitionRelation (tm : SingleTapeTM α) (c₁ c₂ : tm.Cfg) : Prop := tm.step c₁ = some c₂ /-- A proof of `tm` outputting `l'` on input `l`. -/ def Outputs (tm : SingleTapeTM α) (l l' : List α) : Prop := ReflTransGen tm.TransitionRelation (initCfg tm l) (haltCfg tm l') /-- A proof of `tm` outputting `l'` on input `l` in at most `m` steps. -/ -def OutputsWithinTime (tm : SingleTapeTM α) (l l' : List α) - (m : ℕ) := +def OutputsWithinTime (tm : SingleTapeTM α) (l l' : List α) (m : ℕ) := RelatesWithinSteps tm.TransitionRelation (initCfg tm l) (haltCfg tm l') m /-- @@ -259,57 +254,44 @@ section compComputerLemmas /-! ### Composition Computer Lemmas -/ -lemma compComputer_q₀_eq (tm1 tm2 : SingleTapeTM α) : - (compComputer tm1 tm2).q₀ = Sum.inl tm1.q₀ := - rfl +variable (tm1 tm2 : SingleTapeTM α) (cfg1 : tm1.Cfg) (cfg2 : tm2.Cfg) + +lemma compComputer_q₀_eq : (compComputer tm1 tm2).q₀ = Sum.inl tm1.q₀ := rfl /-- Convert a `Cfg` over the first input machine to a config over the composed machine. Note it may transition to the start state of the second machine if the first machine halts. -/ -private def toCompCfg_left (tm1 tm2 : SingleTapeTM α) - (cfg : tm1.Cfg) : - (compComputer tm1 tm2).Cfg := - match cfg.state with - | some q => { state := some (Sum.inl q), BiTape := cfg.BiTape } - | none => { state := some (Sum.inr tm2.q₀), BiTape := cfg.BiTape } +private def toCompCfg_left : (compComputer tm1 tm2).Cfg := + match cfg1.state with + | some q => { state := some (Sum.inl q), BiTape := cfg1.BiTape } + | none => { state := some (Sum.inr tm2.q₀), BiTape := cfg1.BiTape } /-- Convert a `Cfg` over the second input machine to a config over the composed machine -/ -private def toCompCfg_right (tm1 tm2 : SingleTapeTM α) - (cfg : tm2.Cfg) : - (compComputer tm1 tm2).Cfg := - { - state := Option.map Sum.inr cfg.state - BiTape := cfg.BiTape - } +private def toCompCfg_right : (compComputer tm1 tm2).Cfg := + { state := Option.map Sum.inr cfg2.state, BiTape := cfg2.BiTape } /-- The initial configuration for the composed machine, with the first machine starting. -/ -private def initialCfg (tm1 tm2 : SingleTapeTM α) (input : List α) : - (compComputer tm1 tm2).Cfg := +private def initialCfg (input : List α) : (compComputer tm1 tm2).Cfg := { state := some (Sum.inl tm1.q₀), BiTape := BiTape.mk₁ input } /-- The intermediate configuration for the composed machine, after the first machine halts and the second machine starts. -/ -private def intermediateCfg (tm1 tm2 : SingleTapeTM α) (intermediate : List α) : - (compComputer tm1 tm2).Cfg := +private def intermediateCfg (intermediate : List α) : (compComputer tm1 tm2).Cfg := { state := some (Sum.inr tm2.q₀), BiTape := BiTape.mk₁ intermediate } /-- The final configuration for the composed machine, after the second machine halts. -/ -private def finalCfg (tm1 tm2 : SingleTapeTM α) (output : List α) : - (compComputer tm1 tm2).Cfg := +private def finalCfg (output : List α) : (compComputer tm1 tm2).Cfg := { state := none, BiTape := BiTape.mk₁ output } /-- The left converting function commutes with steps of the machines. -/ -private theorem map_toCompCfg_left_step - (tm1 tm2 : SingleTapeTM α) - (x : tm1.Cfg) - (hx : x.state.isSome) : - Option.map (toCompCfg_left tm1 tm2) (tm1.step x) = - (compComputer tm1 tm2).step (toCompCfg_left tm1 tm2 x) := by - cases x with +private theorem map_toCompCfg_left_step (hcfg1 : cfg1.state.isSome) : + Option.map (toCompCfg_left tm1 tm2) (tm1.step cfg1) = + (compComputer tm1 tm2).step (toCompCfg_left tm1 tm2 cfg1) := by + cases cfg1 with | mk state BiTape => cases state with - | none => simp at hx + | none => simp at hcfg1 | some q => simp only [step, toCompCfg_left, compComputer] generalize hM : tm1.M q BiTape.head = result @@ -319,12 +301,10 @@ private theorem map_toCompCfg_left_step | some q' => simp only [hM, Option.map_some, toCompCfg_left] /-- The right converting function commutes with steps of the machines. -/ -private theorem map_toCompCfg_right_step - (tm1 tm2 : SingleTapeTM α) - (x : tm2.Cfg) : - Option.map (toCompCfg_right tm1 tm2) (tm2.step x) = - (compComputer tm1 tm2).step (toCompCfg_right tm1 tm2 x) := by - cases x with +private theorem map_toCompCfg_right_step : + Option.map (toCompCfg_right tm1 tm2) (tm2.step cfg2) = + (compComputer tm1 tm2).step (toCompCfg_right tm1 tm2 cfg2) := by + cases cfg2 with | mk state BiTape => cases state with | none => @@ -344,17 +324,15 @@ runs from start (with Sum.inl state) to Sum.inr tm2.q₀ (the start of the secon This takes the same number of steps because the halt transition becomes a transition to the second machine. -/ -private theorem comp_left_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) - (input_tape intermediate_tape : List α) - (t : ℕ) +private theorem comp_left_relatesWithinSteps (input intermediate : List α) (t : ℕ) (htm1 : RelatesWithinSteps tm1.TransitionRelation - (tm1.initCfg input_tape) - (tm1.haltCfg intermediate_tape) + (tm1.initCfg input) + (tm1.haltCfg intermediate) t) : RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation - (initialCfg tm1 tm2 input_tape) - (intermediateCfg tm1 tm2 intermediate_tape) + (initialCfg tm1 tm2 input) + (intermediateCfg tm1 tm2 intermediate) t := by simp only [initialCfg, intermediateCfg, initCfg, haltCfg] at htm1 ⊢ refine RelatesWithinSteps.map (toCompCfg_left tm1 tm2) ?_ htm1 @@ -371,17 +349,17 @@ Simulation for the second phase of the composed computer. When the second machine runs from start to halt, the composed machine runs from Sum.inr tm2.q₀ to halt. -/ -private theorem comp_right_relatesWithinSteps (tm1 tm2 : SingleTapeTM α) - (intermediate_tape output_tape : List α) +private theorem comp_right_relatesWithinSteps + (intermediate output : List α) (t : ℕ) (htm2 : RelatesWithinSteps tm2.TransitionRelation - (tm2.initCfg intermediate_tape) - (tm2.haltCfg output_tape) + (tm2.initCfg intermediate) + (tm2.haltCfg output) t) : RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation - (intermediateCfg tm1 tm2 intermediate_tape) - (finalCfg tm1 tm2 output_tape) + (intermediateCfg tm1 tm2 intermediate) + (finalCfg tm1 tm2 output) t := by simp only [intermediateCfg, finalCfg, initCfg, haltCfg] at htm2 ⊢ refine RelatesWithinSteps.map (toCompCfg_right tm1 tm2) ?_ htm2 From f7b6bbb403e750eceb612e61bfae5c60a6f6e15e Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 15:33:27 -0800 Subject: [PATCH 42/95] golfs --- .../Machines/SingleTapeTuring/Basic.lean | 66 +++++++------------ 1 file changed, 24 insertions(+), 42 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 17ad6e014..43c50bc69 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -117,22 +117,16 @@ deriving Inhabited /-- The step function corresponding to a `SingleTapeTM`. -/ @[simp] -def step : tm.Cfg → Option tm.Cfg := - fun ⟨q, t⟩ => - match q with +def step : tm.Cfg → Option tm.Cfg + | ⟨none, _⟩ => -- If in the halting state, there is no next configuration - | none => none - -- If in state q' - | some q' => - -- Look up the transition function - match tm.M q' t.head with - | ⟨(wr, dir), q''⟩ => - -- enter a new configuration - some ⟨ - -- With state q'' (or none for halting) - q'', - -- And BiTape updated according to the Stmt - (t.write wr).optionMove dir⟩ + none + | ⟨some q', t⟩ => + -- If in state q', perform look up in the transition function + match tm.M q' t.head with + -- and enter a new configuration with state q'' (or none for halting) + -- and tape updated according to the Stmt + | ⟨(wr, dir), q''⟩ => some ⟨q'', (t.write wr).optionMove dir⟩ /-- The initial configuration corresponding to a list in the input alphabet. -/ def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, BiTape.mk₁ s⟩ @@ -148,12 +142,10 @@ The space used by a configuration is the space used by its tape. def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := cfg.BiTape.space_used lemma Cfg.space_used_initCfg (tm : SingleTapeTM α) (s : List α) : - (tm.initCfg s).space_used = max 1 s.length := by - simp only [space_used, initCfg, BiTape.space_used_mk₁] + (tm.initCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s lemma Cfg.space_used_haltCfg (tm : SingleTapeTM α) (s : List α) : - (tm.haltCfg s).space_used = max 1 s.length := by - simp [haltCfg, Cfg.space_used, BiTape.space_used_mk₁] + (tm.haltCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + 1 := by @@ -264,25 +256,25 @@ Note it may transition to the start state of the second machine if the first mac -/ private def toCompCfg_left : (compComputer tm1 tm2).Cfg := match cfg1.state with - | some q => { state := some (Sum.inl q), BiTape := cfg1.BiTape } - | none => { state := some (Sum.inr tm2.q₀), BiTape := cfg1.BiTape } + | some q => ⟨some (Sum.inl q), cfg1.BiTape⟩ + | none => ⟨some (Sum.inr tm2.q₀), cfg1.BiTape⟩ /-- Convert a `Cfg` over the second input machine to a config over the composed machine -/ private def toCompCfg_right : (compComputer tm1 tm2).Cfg := - { state := Option.map Sum.inr cfg2.state, BiTape := cfg2.BiTape } + ⟨Option.map Sum.inr cfg2.state, cfg2.BiTape⟩ /-- The initial configuration for the composed machine, with the first machine starting. -/ private def initialCfg (input : List α) : (compComputer tm1 tm2).Cfg := - { state := some (Sum.inl tm1.q₀), BiTape := BiTape.mk₁ input } + ⟨some (Sum.inl tm1.q₀), BiTape.mk₁ input⟩ /-- The intermediate configuration for the composed machine, after the first machine halts and the second machine starts. -/ private def intermediateCfg (intermediate : List α) : (compComputer tm1 tm2).Cfg := - { state := some (Sum.inr tm2.q₀), BiTape := BiTape.mk₁ intermediate } + ⟨some (Sum.inr tm2.q₀), BiTape.mk₁ intermediate⟩ /-- The final configuration for the composed machine, after the second machine halts. -/ private def finalCfg (output : List α) : (compComputer tm1 tm2).Cfg := - { state := none, BiTape := BiTape.mk₁ output } + ⟨none, BiTape.mk₁ output⟩ /-- The left converting function commutes with steps of the machines. -/ private theorem map_toCompCfg_left_step (hcfg1 : cfg1.state.isSome) : @@ -291,14 +283,12 @@ private theorem map_toCompCfg_left_step (hcfg1 : cfg1.state.isSome) : cases cfg1 with | mk state BiTape => cases state with - | none => simp at hcfg1 + | none => grind | some q => simp only [step, toCompCfg_left, compComputer] generalize hM : tm1.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result - cases nextState with - | none => simp only [hM, Option.map_some, toCompCfg_left] - | some q' => simp only [hM, Option.map_some, toCompCfg_left] + cases nextState <;> grind [toCompCfg_left] /-- The right converting function commutes with steps of the machines. -/ private theorem map_toCompCfg_right_step : @@ -313,9 +303,7 @@ private theorem map_toCompCfg_right_step : simp only [step, toCompCfg_right, compComputer, Option.map_some] generalize hM : tm2.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result - cases nextState with - | none => simp only [hM, Option.map_some, toCompCfg_right, Option.map_none] - | some q' => simp only [hM, Option.map_some, toCompCfg_right] + cases nextState <;> grind [toCompCfg_right] /-- Simulation for the first phase of the composed computer. @@ -397,10 +385,7 @@ structure TimeComputable (f : List α → List α) where def TimeComputable.id : TimeComputable (α := α) id where tm := idComputer time_bound _ := 1 - outputsFunInTime x := by - refine ⟨1, le_refl 1, RelatesInSteps.single ?_⟩ - simp only [TransitionRelation, initCfg, haltCfg, idComputer, step, BiTape.optionMove] - rfl + outputsFunInTime _ := ⟨1, le_refl 1, RelatesInSteps.single rfl⟩ /-- Time bounds for `compComputer`. @@ -484,7 +469,7 @@ structure PolyTimeComputable (f : List α → List α) extends TimeComputable f noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id where toTimeComputable := TimeComputable.id poly := 1 - bounds n := by simp only [TimeComputable.id, eval_one, le_refl] + bounds _ := by simp [TimeComputable.id] -- TODO remove `h_mono` assumption -- by developing function to convert PolyTimeComputable into one with monotone time bound @@ -492,9 +477,7 @@ noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id wher A proof that the composition of two polytime computable functions is polytime computable. -/ noncomputable def PolyTimeComputable.comp - {f g : List α → List α} - (hf : PolyTimeComputable f) - (hg : PolyTimeComputable g) + {f g : List α → List α} (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) (h_mono : Monotone hg.time_bound) : PolyTimeComputable (g ∘ f) where toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono @@ -509,8 +492,7 @@ noncomputable def PolyTimeComputable.comp apply add_le_add · omega -- lia fails · exact hf.bounds n - apply le_trans this _ - exact hg.bounds (1 + n + hf.poly.eval n) + exact le_trans this (hg.bounds _) end PolyTimeComputable From 19ebc8cdb54eb80829bac06bdf405c78bf9811c4 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 16:03:18 -0800 Subject: [PATCH 43/95] more golfs --- .../Machines/SingleTapeTuring/Basic.lean | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 43c50bc69..2e873ab29 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -156,9 +156,8 @@ lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) obtain ⟨⟨wr, dir⟩, q''⟩ := result cases hstep; cases dir with | none => simp [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write] - | some d => - have := BiTape.space_used_move (tape.write wr) d - simp only [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write] at this ⊢; exact this + | some d => simpa [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write] using + BiTape.space_used_move (tape.write wr) d end Cfg @@ -280,9 +279,7 @@ private def finalCfg (output : List α) : (compComputer tm1 tm2).Cfg := private theorem map_toCompCfg_left_step (hcfg1 : cfg1.state.isSome) : Option.map (toCompCfg_left tm1 tm2) (tm1.step cfg1) = (compComputer tm1 tm2).step (toCompCfg_left tm1 tm2 cfg1) := by - cases cfg1 with - | mk state BiTape => - cases state with + cases cfg1 with | mk state BiTape => cases state with | none => grind | some q => simp only [step, toCompCfg_left, compComputer] @@ -385,7 +382,7 @@ structure TimeComputable (f : List α → List α) where def TimeComputable.id : TimeComputable (α := α) id where tm := idComputer time_bound _ := 1 - outputsFunInTime _ := ⟨1, le_refl 1, RelatesInSteps.single rfl⟩ + outputsFunInTime _ := ⟨1, le_rfl, RelatesInSteps.single rfl⟩ /-- Time bounds for `compComputer`. @@ -486,13 +483,7 @@ noncomputable def PolyTimeComputable.comp simp only [TimeComputable.comp, eval_add, eval_comp, eval_X, eval_one] apply add_le_add · exact hf.bounds n - · have : hg.time_bound (max 1 n + hf.time_bound n) - ≤ hg.time_bound (1 + n + hf.poly.eval n) := by - apply h_mono - apply add_le_add - · omega -- lia fails - · exact hf.bounds n - exact le_trans this (hg.bounds _) + · exact (h_mono (add_le_add (by omega) (hf.bounds n))).trans (hg.bounds _) end PolyTimeComputable From 1361553ec5b3ae898c68d1c94943b9501603b852 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 18:18:02 -0800 Subject: [PATCH 44/95] add movement lemmas --- Cslib/Foundations/Data/BiTape.lean | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index e8b25380d..69236dd3e 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -96,6 +96,16 @@ def BiTape.optionMove {α} : Turing.BiTape α → Option Dir → Turing.BiTape | t, none => t | t, some d => t.move d +@[simp] +lemma BiTape.move_left_move_right {α} (t : Turing.BiTape α) : + t.move_left.move_right = t := by + simp [move_right, move_left] + +@[simp] +lemma BiTape.move_right_move_left {α} (t : Turing.BiTape α) : + t.move_right.move_left = t := by + simp [move_left, move_right] + end Move /-- From 4335852fec526053e1b4c0fd3fcc2b58611c0da6 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 18:19:48 -0800 Subject: [PATCH 45/95] golf --- Cslib/Foundations/Data/BiTape.lean | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 69236dd3e..10952cfc0 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -97,13 +97,11 @@ def BiTape.optionMove {α} : Turing.BiTape α → Option Dir → Turing.BiTape | t, some d => t.move d @[simp] -lemma BiTape.move_left_move_right {α} (t : Turing.BiTape α) : - t.move_left.move_right = t := by +lemma BiTape.move_left_move_right {α} (t : Turing.BiTape α) : t.move_left.move_right = t := by simp [move_right, move_left] @[simp] -lemma BiTape.move_right_move_left {α} (t : Turing.BiTape α) : - t.move_right.move_left = t := by +lemma BiTape.move_right_move_left {α} (t : Turing.BiTape α) : t.move_right.move_left = t := by simp [move_left, move_right] end Move From 4da01540e0dadcf110ef89b998073540b4e4bbf8 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 18:26:52 -0800 Subject: [PATCH 46/95] more line golfing --- .../Machines/SingleTapeTuring/Basic.lean | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 2e873ab29..4c15b5277 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -208,8 +208,8 @@ def idComputer : SingleTapeTM α where /-- A Turing machine computing the composition of two other Turing machines. -If f and g are computed by turing machines `tm1` and `tm2` -then we can construct a turing machine which computes g ∘ f by first running `tm1` +If f and g are computed by Turing machines `tm1` and `tm2` +then we can construct a Turing machine which computes g ∘ f by first running `tm1` and then, when `tm1` halts, transitioning to the start state of `tm2` and running `tm2`. -/ def compComputer (tm1 tm2 : SingleTapeTM α) : SingleTapeTM α where @@ -334,9 +334,7 @@ Simulation for the second phase of the composed computer. When the second machine runs from start to halt, the composed machine runs from Sum.inr tm2.q₀ to halt. -/ -private theorem comp_right_relatesWithinSteps - (intermediate output : List α) - (t : ℕ) +private theorem comp_right_relatesWithinSteps (intermediate output : List α) (t : ℕ) (htm2 : RelatesWithinSteps tm2.TransitionRelation (tm2.initCfg intermediate) @@ -398,9 +396,7 @@ this is to ensure that if the first machine returns an output which is shorter than the maximum possible length of output for that input size, then the time bound for the second machine still holds for that shorter input to the second machine. -/ -def TimeComputable.comp - {f g : List α → List α} - (hf : TimeComputable f) (hg : TimeComputable g) +def TimeComputable.comp {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) (h_mono : Monotone hg.time_bound) : (TimeComputable (g ∘ f)) where tm := compComputer hf.tm hg.tm @@ -473,8 +469,8 @@ noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id wher /-- A proof that the composition of two polytime computable functions is polytime computable. -/ -noncomputable def PolyTimeComputable.comp - {f g : List α → List α} (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) +noncomputable def PolyTimeComputable.comp {f g : List α → List α} + (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) (h_mono : Monotone hg.time_bound) : PolyTimeComputable (g ∘ f) where toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono From f220ae00241a6283e66495614b63f91cee22b4a9 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 18:38:33 -0800 Subject: [PATCH 47/95] clean up docstring --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 4c15b5277..197fb428f 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -37,8 +37,7 @@ We also provide ways of constructing polynomial-runtime TMs ## TODOs - Encoding of types in lists to represent computations on arbitrary types. -- Composition notation -- Check I can't put more args on the same line +- Add `∘` notation for `compComputer`. -/ From aad36928b691ff5b71daf5f341d4286b8d9ff379 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Sun, 25 Jan 2026 20:03:26 -0800 Subject: [PATCH 48/95] namespaces --- Cslib/Foundations/Data/BiTape.lean | 40 +++++++++++--------- Cslib/Foundations/Data/StackTape.lean | 54 +++++++++++++-------------- 2 files changed, 48 insertions(+), 46 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 10952cfc0..f52a4e0ba 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -49,23 +49,25 @@ structure BiTape (α : Type) where /-- The contents to the right of the head -/ (right : StackTape α) +namespace BiTape + /-- The empty `BiTape` -/ -def BiTape.nil {α} : BiTape α := ⟨none, StackTape.nil, StackTape.nil⟩ +def nil {α} : BiTape α := ⟨none, StackTape.nil, StackTape.nil⟩ instance {α : Type} : Inhabited (BiTape α) where - default := BiTape.nil + default := nil instance {α : Type} : EmptyCollection (BiTape α) := - ⟨BiTape.nil⟩ + ⟨nil⟩ /-- Given a `List` of `α`, construct a `BiTape` by mapping the list to `some` elements and laying them out to the right side, with the head under the first element of the list if it exists. -/ -def BiTape.mk₁ {α} (l : List α) : BiTape α := +def mk₁ {α} (l : List α) : BiTape α := match l with - | [] => BiTape.nil + | [] => nil | h :: t => ⟨some h, StackTape.nil, StackTape.map_some t⟩ section Move @@ -73,35 +75,35 @@ section Move /-- Move the head left by shifting the left StackTape under the head. -/ -def BiTape.move_left {α} (t : Turing.BiTape α) : Turing.BiTape α := +def move_left {α} (t : BiTape α) : BiTape α := ⟨t.left.head, t.left.tail, StackTape.cons t.head t.right⟩ /-- Move the head right by shifting the right StackTape under the head. -/ -def BiTape.move_right {α} (t : Turing.BiTape α) : Turing.BiTape α := +def move_right {α} (t : BiTape α) : BiTape α := ⟨t.right.head, StackTape.cons t.head t.left, t.right.tail⟩ /-- Move the head to the left or right, shifting the tape underneath it. -/ -def BiTape.move {α} (t : Turing.BiTape α) : Dir → Turing.BiTape α +def move {α} (t : BiTape α) : Dir → BiTape α | .left => t.move_left | .right => t.move_right /-- -Optionally perform a `BiTape.move`, or do nothing if `none`. +Optionally perform a `move`, or do nothing if `none`. -/ -def BiTape.optionMove {α} : Turing.BiTape α → Option Dir → Turing.BiTape α +def optionMove {α} : BiTape α → Option Dir → BiTape α | t, none => t | t, some d => t.move d @[simp] -lemma BiTape.move_left_move_right {α} (t : Turing.BiTape α) : t.move_left.move_right = t := by +lemma move_left_move_right {α} (t : BiTape α) : t.move_left.move_right = t := by simp [move_right, move_left] @[simp] -lemma BiTape.move_right_move_left {α} (t : Turing.BiTape α) : t.move_right.move_left = t := by +lemma move_right_move_left {α} (t : BiTape α) : t.move_right.move_left = t := by simp [move_left, move_right] end Move @@ -109,26 +111,28 @@ end Move /-- Write a value under the head of the `BiTape`. -/ -def BiTape.write {α} (t : Turing.BiTape α) (a : Option α) : Turing.BiTape α := { t with head := a } +def write {α} (t : BiTape α) (a : Option α) : BiTape α := { t with head := a } /-- The space used by a `BiTape` is the number of symbols between and including the head, and leftmost and rightmost non-blank symbols on the `BiTape`. -/ -def BiTape.space_used {α} (t : Turing.BiTape α) : ℕ := 1 + t.left.length + t.right.length +def space_used {α} (t : BiTape α) : ℕ := 1 + t.left.length + t.right.length -lemma BiTape.space_used_write {α} (t : Turing.BiTape α) (a : Option α) : +lemma space_used_write {α} (t : BiTape α) (a : Option α) : (t.write a).space_used = t.space_used := by rfl -lemma BiTape.space_used_mk₁ {α} (l : List α) : - (BiTape.mk₁ l).space_used = max 1 l.length := by +lemma space_used_mk₁ {α} (l : List α) : + (mk₁ l).space_used = max 1 l.length := by cases l with | nil => simp [mk₁, space_used, nil, StackTape.length_nil] | cons h t => simp [mk₁, space_used, StackTape.length_nil, StackTape.length_map_some]; omega -lemma BiTape.space_used_move {α} (t : Turing.BiTape α) (d : Dir) : +lemma space_used_move {α} (t : BiTape α) (d : Dir) : (t.move d).space_used ≤ t.space_used + 1 := by cases d <;> grind [move_left, move_right, move, space_used, StackTape.length_tail_le, StackTape.length_cons_le] +end BiTape + end Turing diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 78844f168..4cc22be8e 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -44,39 +44,40 @@ structure StackTape (α : Type) where attribute [scoped grind! .] StackTape.toList_getLast?_ne_some_none +namespace StackTape + /-- The empty `StackTape` -/ -def StackTape.nil {α} : StackTape α := ⟨[], by grind⟩ +def nil {α} : StackTape α := ⟨[], by grind⟩ instance {α : Type} : Inhabited (StackTape α) where - default := StackTape.nil + default := nil instance {α : Type} : EmptyCollection (StackTape α) := - ⟨StackTape.nil⟩ + ⟨nil⟩ /-- Create a `StackTape` from a list by mapping all elements to `some` -/ -def StackTape.map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ +def map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ /-- Prepend an `Option` to the `StackTape` -/ -def StackTape.cons {α} (x : Option α) (xs : StackTape α) : StackTape α := +def cons {α} (x : Option α) (xs : StackTape α) : StackTape α := match x, xs with | none, ⟨[], _⟩ => ⟨[], by grind⟩ | none, ⟨hd :: tl, hl⟩ => ⟨none :: hd :: tl, by grind⟩ | some a, ⟨l, hl⟩ => ⟨some a :: l, by grind⟩ /-- Remove the first element of the `StackTape`, returning the rest -/ -def StackTape.tail {α} (l : StackTape α) : StackTape α := +def tail {α} (l : StackTape α) : StackTape α := match hl : l.toList with - | [] => StackTape.nil + | [] => nil | hd :: t => ⟨t, by grind⟩ /-- Get the first element of the `StackTape`. -/ -def StackTape.head {α} (l : StackTape α) : Option α := +def head {α} (l : StackTape α) : Option α := match l.toList with | [] => none | h :: _ => h -lemma StackTape.eq_iff {α} (l1 l2 : StackTape α) : - l1 = l2 ↔ l1.head = l2.head ∧ l1.tail = l2.tail := by +lemma eq_iff {α} (l1 l2 : StackTape α) : l1 = l2 ↔ l1.head = l2.head ∧ l1.tail = l2.tail := by constructor · grind · intro ⟨hhead, htail⟩ @@ -85,8 +86,7 @@ lemma StackTape.eq_iff {α} (l1 l2 : StackTape α) : cases as1 <;> cases as2 <;> grind [tail, head, mk.injEq, nil, mk.injEq] @[simp] -lemma StackTape.head_cons {α} (o : Option α) (l : StackTape α) : - (StackTape.cons o l).head = o := by +lemma head_cons {α} (o : Option α) (l : StackTape α) : (cons o l).head = o := by cases o with | none => cases l with | mk toList hl => @@ -94,8 +94,7 @@ lemma StackTape.head_cons {α} (o : Option α) (l : StackTape α) : | some a => simp [cons, head] @[simp] -lemma StackTape.tail_cons {α} (o : Option α) (l : StackTape α) : - (StackTape.cons o l).tail = l := by +lemma tail_cons {α} (o : Option α) (l : StackTape α) : (cons o l).tail = l := by cases o with | none => cases l with | mk toList h => @@ -106,38 +105,37 @@ lemma StackTape.tail_cons {α} (o : Option α) (l : StackTape α) : simp only [cons, tail] @[simp] -lemma StackTape.cons_head_tail {α} (l : StackTape α) : - StackTape.cons (l.head) (l.tail) = l := by - rw [StackTape.eq_iff] +lemma cons_head_tail {α} (l : StackTape α) : + cons (l.head) (l.tail) = l := by + rw [eq_iff] simp section Length /-- The length of the `StackTape` is the number of elements up to the last non-`none` element -/ -def StackTape.length {α} (l : StackTape α) : ℕ := l.toList.length +def length {α} (l : StackTape α) : ℕ := l.toList.length -lemma StackTape.length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by +lemma length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by grind [tail, length, nil] -lemma StackTape.length_cons_none {α} (l : StackTape α) : - (StackTape.cons none l).length = l.length + if l.length = 0 then 0 else 1 := by +lemma length_cons_none {α} (l : StackTape α) : + (cons none l).length = l.length + if l.length = 0 then 0 else 1 := by cases l with | mk toList h => cases toList <;> simp [cons, length] -lemma StackTape.length_cons_some {α} (a : α) (l : StackTape α) : - (StackTape.cons (some a) l).length = l.length + 1 := by +lemma length_cons_some {α} (a : α) (l : StackTape α) : (cons (some a) l).length = l.length + 1 := by simp [cons, length] -lemma StackTape.length_cons_le {α} (o : Option α) (l : StackTape α) : - (StackTape.cons o l).length ≤ l.length + 1 := by +lemma length_cons_le {α} (o : Option α) (l : StackTape α) : (cons o l).length ≤ l.length + 1 := by cases o <;> grind [length_cons_none, length_cons_some] -lemma StackTape.length_map_some {α} (l : List α) : (StackTape.map_some l).length = l.length := by +lemma length_map_some {α} (l : List α) : (map_some l).length = l.length := by simp [map_some, length] -lemma StackTape.length_nil {α} : (StackTape.nil : StackTape α).length = 0 := by - simp [nil, length] +lemma length_nil {α} : (nil : StackTape α).length = 0 := by simp [nil, length] end Length +end StackTape + end Turing From 36615f3f45d0b09f20b18a56b534224e8174582c Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:08:20 -0800 Subject: [PATCH 49/95] Update Cslib/Computability/Machines/SingleTapeTuring/Basic.lean Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com> --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 197fb428f..008e1da9b 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -69,7 +69,7 @@ end SingleTapeTM /-- A SingleTapeTM over the alphabet of Option α (none is blank BiTape symbol). -/ structure SingleTapeTM α where /-- Inhabited instance for the alphabet -/ - [Inhabitedα : Inhabited α] + [αInhabited : Inhabited α] /-- Finiteness of the alphabet -/ [Fintypeα : Fintype α] /-- type of state labels -/ From 90e6ac47a47914e854ea2187513155778c862783 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:12:00 -0800 Subject: [PATCH 50/95] fix typeclass arg names --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 008e1da9b..be900db7a 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -71,11 +71,11 @@ structure SingleTapeTM α where /-- Inhabited instance for the alphabet -/ [αInhabited : Inhabited α] /-- Finiteness of the alphabet -/ - [Fintypeα : Fintype α] + [αFintype : Fintype α] /-- type of state labels -/ (Λ : Type) /-- finiteness of the state type -/ - [FintypeΛ : Fintype Λ] + [ΛFintype : Fintype Λ] /-- Initial state -/ (q₀ : Λ) /-- Transition function, mapping a state and a head symbol @@ -98,7 +98,7 @@ variable (tm : SingleTapeTM α) instance : Inhabited tm.Λ := ⟨tm.q₀⟩ -instance : Fintype tm.Λ := tm.FintypeΛ +instance : Fintype tm.Λ := tm.ΛFintype instance inhabitedStmt : Inhabited (Stmt α) := inferInstance From f5b92e7b35e3c03780664f14f4a94495b3d30a17 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:12:12 -0800 Subject: [PATCH 51/95] remove unneeded parens --- Cslib/Foundations/Data/BiTape.lean | 6 +++--- Cslib/Foundations/Data/StackTape.lean | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index f52a4e0ba..cee248880 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -43,11 +43,11 @@ that eventually take on blank `none` values -/ structure BiTape (α : Type) where /-- The symbol currently under the tape head -/ - (head : Option α) + head : Option α /-- The contents to the left of the head -/ - (left : StackTape α) + left : StackTape α /-- The contents to the right of the head -/ - (right : StackTape α) + right : StackTape α namespace BiTape diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 4cc22be8e..4b8a03262 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -35,12 +35,12 @@ Represented as a `List (Option α)` that does not end with `none`. -/ structure StackTape (α : Type) where /-- The underlying list representation -/ - (toList : List (Option α)) + toList : List (Option α) /-- The list can be empty (i.e. `none`), but if it is not empty, the last element is not (`some`) `none` -/ - (toList_getLast?_ne_some_none : toList.getLast? ≠ some none) + toList_getLast?_ne_some_none : toList.getLast? ≠ some none attribute [scoped grind! .] StackTape.toList_getLast?_ne_some_none From 78733a8ba5e4b3c9ec3b63999bbae9913d6c7194 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:19:13 -0800 Subject: [PATCH 52/95] use notation --- Cslib/Foundations/Data/BiTape.lean | 9 ++++++--- Cslib/Foundations/Data/StackTape.lean | 3 +++ 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index cee248880..8c3cc817f 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -52,7 +52,7 @@ structure BiTape (α : Type) where namespace BiTape /-- The empty `BiTape` -/ -def nil {α} : BiTape α := ⟨none, StackTape.nil, StackTape.nil⟩ +def nil {α} : BiTape α := ⟨none, ∅, ∅⟩ instance {α : Type} : Inhabited (BiTape α) where default := nil @@ -60,6 +60,9 @@ instance {α : Type} : Inhabited (BiTape α) where instance {α : Type} : EmptyCollection (BiTape α) := ⟨nil⟩ +@[simp] +lemma empty_eq_nil {α} : (∅ : BiTape α) = nil := rfl + /-- Given a `List` of `α`, construct a `BiTape` by mapping the list to `some` elements and laying them out to the right side, @@ -67,8 +70,8 @@ with the head under the first element of the list if it exists. -/ def mk₁ {α} (l : List α) : BiTape α := match l with - | [] => nil - | h :: t => ⟨some h, StackTape.nil, StackTape.map_some t⟩ + | [] => ∅ + | h :: t => { head := some h, left := ∅, right := StackTape.map_some t } section Move diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 4b8a03262..09cf12143 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -55,6 +55,9 @@ instance {α : Type} : Inhabited (StackTape α) where instance {α : Type} : EmptyCollection (StackTape α) := ⟨nil⟩ +@[simp] +lemma empty_eq_nil {α} : (∅ : StackTape α) = nil := rfl + /-- Create a `StackTape` from a list by mapping all elements to `some` -/ def map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ From d7f384c6bc2f63a9d05e179430f14760239a2090 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:20:28 -0800 Subject: [PATCH 53/95] more bundled instances --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index be900db7a..f83fd70f7 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -96,6 +96,10 @@ and the intended initial and final configurations. variable (tm : SingleTapeTM α) +instance : Inhabited α := tm.αInhabited + +instance : Fintype α := tm.αFintype + instance : Inhabited tm.Λ := ⟨tm.q₀⟩ instance : Fintype tm.Λ := tm.ΛFintype From f5d0cfedc91f712e0405496e363a1527601180f9 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:20:51 -0800 Subject: [PATCH 54/95] Update Cslib/Computability/Machines/SingleTapeTuring/Basic.lean Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com> --- .../Machines/SingleTapeTuring/Basic.lean | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index f83fd70f7..a1d8a7351 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -189,14 +189,9 @@ is bounded by the output length of the first machine. lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List α) (t : ℕ) (h : tm.OutputsWithinTime l l' t) : l'.length ≤ max 1 l.length + t := by - simp only [OutputsWithinTime] at h - obtain ⟨steps, hsteps_le, hevals⟩ := h - replace hevals := hevals.apply_le_apply_add - specialize hevals (Cfg.space_used tm) - simp only [Cfg.space_used_initCfg, Cfg.space_used_haltCfg] at hevals - suffices l'.length ≤ max 1 l.length + steps by lia - specialize hevals fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep) - omega + have (a b) (hstep : tm.TransitionRelation a b) : tm.step a = some b := Option.mem_def.mp hstep + have := hevals.apply_le_apply_add (Cfg.space_used tm) + grind [→ Cfg.space_used_step, Cfg.space_used_initCfg, Cfg.space_used_haltCfg] section Computers From b5e035fb51ca0ca01ddfa060fee19fefbaa443c4 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:23:59 -0800 Subject: [PATCH 55/95] golf --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index a1d8a7351..6dc4af069 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -189,9 +189,10 @@ is bounded by the output length of the first machine. lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List α) (t : ℕ) (h : tm.OutputsWithinTime l l' t) : l'.length ≤ max 1 l.length + t := by - have (a b) (hstep : tm.TransitionRelation a b) : tm.step a = some b := Option.mem_def.mp hstep - have := hevals.apply_le_apply_add (Cfg.space_used tm) - grind [→ Cfg.space_used_step, Cfg.space_used_initCfg, Cfg.space_used_haltCfg] + obtain ⟨steps, hsteps_le, hevals⟩ := h + grind [Cfg.space_used_initCfg, Cfg.space_used_haltCfg, + hevals.apply_le_apply_add (Cfg.space_used tm) + fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep)] section Computers From c3858fecc86f30b5556eeeb1a42b86bd0eabce53 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:28:03 -0800 Subject: [PATCH 56/95] reorder args --- Cslib/Foundations/Data/RelatesInSteps.lean | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/Cslib/Foundations/Data/RelatesInSteps.lean b/Cslib/Foundations/Data/RelatesInSteps.lean index 07c66d0f8..04106f013 100644 --- a/Cslib/Foundations/Data/RelatesInSteps.lean +++ b/Cslib/Foundations/Data/RelatesInSteps.lean @@ -124,9 +124,8 @@ lemma RelatesInSteps.succ'_iff {a b : α} {n : ℕ} : If `h : α → ℕ` increases by at most 1 on each step of `r`, then the value of `h` at the output is at most `h` at the input plus the number of steps. -/ -lemma RelatesInSteps.apply_le_apply_add {a b : α} (h : α → ℕ) - (h_step : ∀ a b, r a b → h b ≤ h a + 1) - (m : ℕ) (hevals : RelatesInSteps r a b m) : +lemma RelatesInSteps.apply_le_apply_add {a b : α} {m : ℕ} (hevals : RelatesInSteps r a b m) + (h : α → ℕ) (h_step : ∀ a b, r a b → h b ≤ h a + 1) : h b ≤ h a + m := by induction hevals with | refl => simp @@ -200,12 +199,12 @@ lemma RelatesWithinSteps.of_le {a b : α} {n₁ n₂ : ℕ} /-- If `h : α → ℕ` increases by at most 1 on each step of `r`, then the value of `h` at the output is at most `h` at the input plus the step bound. -/ -lemma RelatesWithinSteps.apply_le_apply_add {a b : α} (h : α → ℕ) - (h_step : ∀ a b, r a b → h b ≤ h a + 1) - (n : ℕ) (hevals : RelatesWithinSteps r a b n) : - h b ≤ h a + n := by +lemma RelatesWithinSteps.apply_le_apply_add {a b : α} {m : ℕ} (hevals : RelatesWithinSteps r a b m) + (h : α → ℕ) (h_step : ∀ a b, r a b → h b ≤ h a + 1) + : + h b ≤ h a + m := by obtain ⟨m, hm, hevals_m⟩ := hevals - have := RelatesInSteps.apply_le_apply_add h h_step m hevals_m + have := RelatesInSteps.apply_le_apply_add hevals_m h h_step lia /-- From e6a2746a54793b4dab17270d2f1d75ee7acc3fa2 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:28:52 -0800 Subject: [PATCH 57/95] move args before := --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 6dc4af069..da0046b97 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -202,7 +202,7 @@ variable [Inhabited α] [Fintype α] def idComputer : SingleTapeTM α where Λ := PUnit q₀ := PUnit.unit - M := fun _ b => ⟨(b, none), none⟩ + M _ b := ⟨(b, none), none⟩ /-- A Turing machine computing the composition of two other Turing machines. From 0746a774db8c750540c4d10f5288a17fa666b900 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:29:21 -0800 Subject: [PATCH 58/95] Update Cslib/Computability/Machines/SingleTapeTuring/Basic.lean Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com> --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index da0046b97..dd20ff1e2 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -299,7 +299,7 @@ private theorem map_toCompCfg_right_step : simp only [step, toCompCfg_right, compComputer, Option.map_some] generalize hM : tm2.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result - cases nextState <;> grind [toCompCfg_right] + grind [toCompCfg_right] /-- Simulation for the first phase of the composed computer. From e35624533b29e0069a940e306315a779eaa6f687 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:32:24 -0800 Subject: [PATCH 59/95] reorder proof --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index dd20ff1e2..3d2964e6e 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -296,10 +296,10 @@ private theorem map_toCompCfg_right_step : | none => simp only [step, toCompCfg_right, Option.map_none, compComputer] | some q => - simp only [step, toCompCfg_right, compComputer, Option.map_some] generalize hM : tm2.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result - grind [toCompCfg_right] + simp only [compComputer] + grind [toCompCfg_right, step, toCompCfg_right, compComputer] /-- Simulation for the first phase of the composed computer. From 9a08b4e41c3d212402880cc2ca7abed162a9d4f3 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:33:52 -0800 Subject: [PATCH 60/95] Update Cslib/Computability/Machines/SingleTapeTuring/Basic.lean Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com> --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index dd20ff1e2..480a98f0c 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -372,7 +372,7 @@ structure TimeComputable (f : List α → List α) where /-- a bound on runtime -/ time_bound : ℕ → ℕ /-- proof this machine outputs `f` in at most `time_bound(input.length)` steps -/ - outputsFunInTime : ∀ a, tm.OutputsWithinTime a (f a) (time_bound a.length) + outputsFunInTime (a) : tm.OutputsWithinTime a (f a) (time_bound a.length) /-- The identity map on α is computable in constant time. -/ From 33296852bc8a71d0691d68d17fbb7c03b820d378 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:36:53 -0800 Subject: [PATCH 61/95] Stmt becomes structure --- .../Machines/SingleTapeTuring/Basic.lean | 26 +++++++++++-------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index b5dab7213..02199243a 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -53,16 +53,20 @@ namespace SingleTapeTM A Turing machine "statement" is just a `Option`al command to move left or right, and write a symbol on the `BiTape`. -/ -def Stmt (α : Type) := Option α × Option Dir +structure Stmt (α : Type) where + /-- The symbol to write at the current head position -/ + symbol : Option α + /-- The direction to move the tape head -/ + movement : Option Dir deriving Inhabited -/-- Get the symbol to write from a `Stmt`. -/ -def Stmt.symbol : Stmt α → Option α - | (symbol, _) => symbol +-- /-- Get the symbol to write from a `Stmt`. -/ +-- def Stmt.symbol : Stmt α → Option α +-- | (symbol, _) => symbol -/-- Get the movement direction from a `Stmt`. -/ -def Stmt.movement : Stmt α → Option Dir - | (_, movement) => movement +-- /-- Get the movement direction from a `Stmt`. -/ +-- def Stmt.movement : Stmt α → Option Dir +-- | (_, movement) => movement end SingleTapeTM @@ -129,7 +133,7 @@ def step : tm.Cfg → Option tm.Cfg match tm.M q' t.head with -- and enter a new configuration with state q'' (or none for halting) -- and tape updated according to the Stmt - | ⟨(wr, dir), q''⟩ => some ⟨q'', (t.write wr).optionMove dir⟩ + | ⟨⟨wr, dir⟩, q''⟩ => some ⟨q'', (t.write wr).optionMove dir⟩ /-- The initial configuration corresponding to a list in the input alphabet. -/ def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, BiTape.mk₁ s⟩ @@ -158,8 +162,8 @@ lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) generalize hM : tm.M q tape.head = result at hstep obtain ⟨⟨wr, dir⟩, q''⟩ := result cases hstep; cases dir with - | none => simp [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write] - | some d => simpa [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write] using + | none => simp [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write, hM] + | some d => simpa [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write, hM] using BiTape.space_used_move (tape.write wr) d end Cfg @@ -202,7 +206,7 @@ variable [Inhabited α] [Fintype α] def idComputer : SingleTapeTM α where Λ := PUnit q₀ := PUnit.unit - M _ b := ⟨(b, none), none⟩ + M _ b := ⟨⟨b, none⟩, none⟩ /-- A Turing machine computing the composition of two other Turing machines. From 76e7c6e5316e1f7e7d050b30fa18cc9d6b9f0805 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:40:02 -0800 Subject: [PATCH 62/95] clean up docs --- .../Machines/SingleTapeTuring/Basic.lean | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 02199243a..eae497007 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -60,17 +60,12 @@ structure Stmt (α : Type) where movement : Option Dir deriving Inhabited --- /-- Get the symbol to write from a `Stmt`. -/ --- def Stmt.symbol : Stmt α → Option α --- | (symbol, _) => symbol - --- /-- Get the movement direction from a `Stmt`. -/ --- def Stmt.movement : Stmt α → Option Dir --- | (_, movement) => movement - end SingleTapeTM -/-- A SingleTapeTM over the alphabet of Option α (none is blank BiTape symbol). -/ +/-- +A single-tape Turing machine +over the alphabet of `Option α` (where `none` is the blank `BiTape` symbol). +-/ structure SingleTapeTM α where /-- Inhabited instance for the alphabet -/ [αInhabited : Inhabited α] @@ -82,9 +77,9 @@ structure SingleTapeTM α where [ΛFintype : Fintype Λ] /-- Initial state -/ (q₀ : Λ) - /-- Transition function, mapping a state and a head symbol - to a Stmt to invoke, and optionally a new state (none for halt) -/ - (M : Λ → Option α → Turing.SingleTapeTM.Stmt α × Option Λ) + /-- Transition function, mapping a state and a head symbol to a `Stmt` to invoke, + and optionally the new state to transition to afterwards (`none` for halt) -/ + (M : Λ → Option α → SingleTapeTM.Stmt α × Option Λ) namespace SingleTapeTM From f45d40ece09ef4ad754dc543190e0440a3b7e13c Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:46:43 -0800 Subject: [PATCH 63/95] add doc --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index eae497007..ebe89c44e 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -130,7 +130,11 @@ def step : tm.Cfg → Option tm.Cfg -- and tape updated according to the Stmt | ⟨⟨wr, dir⟩, q''⟩ => some ⟨q'', (t.write wr).optionMove dir⟩ -/-- The initial configuration corresponding to a list in the input alphabet. -/ +/-- +The initial configuration corresponding to a list in the input alphabet. +Note that the entries of the tape constructed by `BiTape.mk₁` are all `some` values. +This is to ensure that distinct lists map to distinct initial configurations. +-/ def initCfg (tm : SingleTapeTM α) (s : List α) : tm.Cfg := ⟨some tm.q₀, BiTape.mk₁ s⟩ /-- The final configuration corresponding to a list in the output alphabet. From 1c251fb1b8cb82799c3e10112bc62fbcd14bb3c4 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 13:56:20 -0800 Subject: [PATCH 64/95] add comment --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index ebe89c44e..6ac78ccdc 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -51,7 +51,7 @@ namespace SingleTapeTM /-- A Turing machine "statement" is just a `Option`al command to move left or right, -and write a symbol on the `BiTape`. +and write a symbol (i.e. an `Option α`, where `none` is the blank symbol) on the `BiTape` -/ structure Stmt (α : Type) where /-- The symbol to write at the current head position -/ From 82ed4277e1dd66f7b7671532f9ff30615fdbb8e8 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 14:04:05 -0800 Subject: [PATCH 65/95] add documentation on design --- Cslib/Foundations/Data/StackTape.lean | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 09cf12143..40630b35c 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -14,11 +14,25 @@ public import Mathlib.Data.List.Basic /-! # StackTape: Infinite, eventually-`none` lists of `Option`s -This file defines `StackTape`, a list of `Option` values where the list cannot end with `none`. -This represents a stack-like data structure -which treats the end of the list as an infinite sequence of `none` values. +This file defines `StackTape`, a stack-like data structure of `Option` values, +where the tape is considered to be infinite and eventually all `none`s. This is useful as a data structure with a simple API for manipulation by Turing machines. +## Design + +`StackTape` is represented as a list of `Option` values where the list cannot end with `none`. +The end of the list is then treated as the start of an infinite sequence of `none` values +by the low-level API. +This design makes it convenient to express the length of the tape in terms of the list length. + +An alternative design would be to represent the tape as a `Stream' (Option α)`, +with additional fields tracking the length and the fact that the stream eventually becomes `none`. +This design might complicate reasoning about the length of the tape, but could make other operations +more straightforward. + +Future design work might explore this alternative representation and compare its +advantages and disadvantages. + ## TODO - Make a `::`-like notation. From 5516a250564ac97a060bda80d071ba9290d7a3de Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 15:08:58 -0800 Subject: [PATCH 66/95] ipossilbe instances removed --- Cslib/Computability/Machines/SingleTapeTuring/Basic.lean | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 6ac78ccdc..3e36b55fc 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -95,10 +95,6 @@ and the intended initial and final configurations. variable (tm : SingleTapeTM α) -instance : Inhabited α := tm.αInhabited - -instance : Fintype α := tm.αFintype - instance : Inhabited tm.Λ := ⟨tm.q₀⟩ instance : Fintype tm.Λ := tm.ΛFintype From 4944e7a8320b80d4de34fc97ee03fe3bd508fe67 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 15:19:32 -0800 Subject: [PATCH 67/95] lake exe mk_all --- Cslib.lean | 174 ++++++++++++++++++++++++------------------------ CslibTests.lean | 24 +++---- 2 files changed, 97 insertions(+), 101 deletions(-) diff --git a/Cslib.lean b/Cslib.lean index 466d4f884..0b30f36e2 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,88 +1,86 @@ -module -- shake: keep-all - -public import Cslib.Algorithms.Lean.MergeSort.MergeSort -public import Cslib.Algorithms.Lean.TimeM -public import Cslib.Computability.Automata.Acceptors.Acceptor -public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor -public import Cslib.Computability.Automata.DA.Basic -public import Cslib.Computability.Automata.DA.Buchi -public import Cslib.Computability.Automata.DA.Prod -public import Cslib.Computability.Automata.DA.ToNA -public import Cslib.Computability.Automata.EpsilonNA.Basic -public import Cslib.Computability.Automata.EpsilonNA.ToNA -public import Cslib.Computability.Automata.NA.Basic -public import Cslib.Computability.Automata.NA.BuchiEquiv -public import Cslib.Computability.Automata.NA.BuchiInter -public import Cslib.Computability.Automata.NA.Concat -public import Cslib.Computability.Automata.NA.Hist -public import Cslib.Computability.Automata.NA.Loop -public import Cslib.Computability.Automata.NA.Pair -public import Cslib.Computability.Automata.NA.Prod -public import Cslib.Computability.Automata.NA.Sum -public import Cslib.Computability.Automata.NA.ToDA -public import Cslib.Computability.Automata.NA.Total -public import Cslib.Computability.Languages.ExampleEventuallyZero -public import Cslib.Computability.Languages.Language -public import Cslib.Computability.Languages.OmegaLanguage -public import Cslib.Computability.Languages.OmegaRegularLanguage -public import Cslib.Computability.Languages.RegularLanguage -public import Cslib.Computability.Machines.SingleTapeTuring.Basic -public import Cslib.Foundations.Control.Monad.Free -public import Cslib.Foundations.Control.Monad.Free.Effects -public import Cslib.Foundations.Control.Monad.Free.Fold -public import Cslib.Foundations.Data.BiTape -public import Cslib.Foundations.Data.FinFun -public import Cslib.Foundations.Data.HasFresh -public import Cslib.Foundations.Data.Nat.Segment -public import Cslib.Foundations.Data.OmegaSequence.Defs -public import Cslib.Foundations.Data.OmegaSequence.Flatten -public import Cslib.Foundations.Data.OmegaSequence.InfOcc -public import Cslib.Foundations.Data.OmegaSequence.Init -public import Cslib.Foundations.Data.OmegaSequence.Temporal -public import Cslib.Foundations.Data.RelatesInSteps -public import Cslib.Foundations.Data.Relation -public import Cslib.Foundations.Data.StackTape -public import Cslib.Foundations.Data.Set.Saturation -public import Cslib.Foundations.Lint.Basic -public import Cslib.Foundations.Semantics.FLTS.Basic -public import Cslib.Foundations.Semantics.FLTS.FLTSToLTS -public import Cslib.Foundations.Semantics.FLTS.LTSToFLTS -public import Cslib.Foundations.Semantics.FLTS.Prod -public import Cslib.Foundations.Semantics.LTS.Basic -public import Cslib.Foundations.Semantics.LTS.Bisimulation -public import Cslib.Foundations.Semantics.LTS.Simulation -public import Cslib.Foundations.Semantics.LTS.TraceEq -public import Cslib.Foundations.Semantics.ReductionSystem.Basic -public import Cslib.Foundations.Syntax.Congruence -public import Cslib.Foundations.Syntax.Context -public import Cslib.Foundations.Syntax.HasAlphaEquiv -public import Cslib.Foundations.Syntax.HasSubstitution -public import Cslib.Foundations.Syntax.HasWellFormed -public import Cslib.Init -public import Cslib.Languages.CCS.Basic -public import Cslib.Languages.CCS.BehaviouralTheory -public import Cslib.Languages.CCS.Semantics -public import Cslib.Languages.CombinatoryLogic.Basic -public import Cslib.Languages.CombinatoryLogic.Confluence -public import Cslib.Languages.CombinatoryLogic.Defs -public import Cslib.Languages.CombinatoryLogic.Evaluation -public import Cslib.Languages.CombinatoryLogic.Recursion -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Context -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Reduction -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Safety -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Subtype -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Typing -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.WellFormed -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence -public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties -public import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic -public import Cslib.Logics.LinearLogic.CLL.Basic -public import Cslib.Logics.LinearLogic.CLL.CutElimination -public import Cslib.Logics.LinearLogic.CLL.EtaExpansion -public import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic +import Cslib.Algorithms.Lean.MergeSort.MergeSort +import Cslib.Algorithms.Lean.TimeM +import Cslib.Computability.Automata.Acceptors.Acceptor +import Cslib.Computability.Automata.Acceptors.OmegaAcceptor +import Cslib.Computability.Automata.DA.Basic +import Cslib.Computability.Automata.DA.Buchi +import Cslib.Computability.Automata.DA.Prod +import Cslib.Computability.Automata.DA.ToNA +import Cslib.Computability.Automata.EpsilonNA.Basic +import Cslib.Computability.Automata.EpsilonNA.ToNA +import Cslib.Computability.Automata.NA.Basic +import Cslib.Computability.Automata.NA.BuchiEquiv +import Cslib.Computability.Automata.NA.BuchiInter +import Cslib.Computability.Automata.NA.Concat +import Cslib.Computability.Automata.NA.Hist +import Cslib.Computability.Automata.NA.Loop +import Cslib.Computability.Automata.NA.Pair +import Cslib.Computability.Automata.NA.Prod +import Cslib.Computability.Automata.NA.Sum +import Cslib.Computability.Automata.NA.ToDA +import Cslib.Computability.Automata.NA.Total +import Cslib.Computability.Languages.ExampleEventuallyZero +import Cslib.Computability.Languages.Language +import Cslib.Computability.Languages.OmegaLanguage +import Cslib.Computability.Languages.OmegaRegularLanguage +import Cslib.Computability.Languages.RegularLanguage +import Cslib.Computability.Machines.SingleTapeTuring.Basic +import Cslib.Foundations.Control.Monad.Free +import Cslib.Foundations.Control.Monad.Free.Effects +import Cslib.Foundations.Control.Monad.Free.Fold +import Cslib.Foundations.Data.BiTape +import Cslib.Foundations.Data.FinFun +import Cslib.Foundations.Data.HasFresh +import Cslib.Foundations.Data.Nat.Segment +import Cslib.Foundations.Data.OmegaSequence.Defs +import Cslib.Foundations.Data.OmegaSequence.Flatten +import Cslib.Foundations.Data.OmegaSequence.InfOcc +import Cslib.Foundations.Data.OmegaSequence.Init +import Cslib.Foundations.Data.OmegaSequence.Temporal +import Cslib.Foundations.Data.RelatesInSteps +import Cslib.Foundations.Data.Relation +import Cslib.Foundations.Data.Set.Saturation +import Cslib.Foundations.Data.StackTape +import Cslib.Foundations.Lint.Basic +import Cslib.Foundations.Semantics.FLTS.Basic +import Cslib.Foundations.Semantics.FLTS.FLTSToLTS +import Cslib.Foundations.Semantics.FLTS.LTSToFLTS +import Cslib.Foundations.Semantics.FLTS.Prod +import Cslib.Foundations.Semantics.LTS.Basic +import Cslib.Foundations.Semantics.LTS.Bisimulation +import Cslib.Foundations.Semantics.LTS.Simulation +import Cslib.Foundations.Semantics.LTS.TraceEq +import Cslib.Foundations.Semantics.ReductionSystem.Basic +import Cslib.Foundations.Syntax.Congruence +import Cslib.Foundations.Syntax.Context +import Cslib.Foundations.Syntax.HasAlphaEquiv +import Cslib.Foundations.Syntax.HasSubstitution +import Cslib.Foundations.Syntax.HasWellFormed +import Cslib.Init +import Cslib.Languages.CCS.Basic +import Cslib.Languages.CCS.BehaviouralTheory +import Cslib.Languages.CCS.Semantics +import Cslib.Languages.CombinatoryLogic.Basic +import Cslib.Languages.CombinatoryLogic.Confluence +import Cslib.Languages.CombinatoryLogic.Defs +import Cslib.Languages.CombinatoryLogic.Evaluation +import Cslib.Languages.CombinatoryLogic.Recursion +import Cslib.Languages.LambdaCalculus.LocallyNameless.Context +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Reduction +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Safety +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Subtype +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Typing +import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.WellFormed +import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties +import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic +import Cslib.Logics.LinearLogic.CLL.Basic +import Cslib.Logics.LinearLogic.CLL.CutElimination +import Cslib.Logics.LinearLogic.CLL.EtaExpansion +import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic diff --git a/CslibTests.lean b/CslibTests.lean index 47740f10e..e9ba5995d 100644 --- a/CslibTests.lean +++ b/CslibTests.lean @@ -1,13 +1,11 @@ -module -- shake: keep-all - -public import CslibTests.Bisimulation -public import CslibTests.CCS -public import CslibTests.CLL -public import CslibTests.DFA -public import CslibTests.FreeMonad -public import CslibTests.GrindLint -public import CslibTests.HasFresh -public import CslibTests.ImportWithMathlib -public import CslibTests.LTS -public import CslibTests.LambdaCalculus -public import CslibTests.ReductionSystem +import CslibTests.Bisimulation +import CslibTests.CCS +import CslibTests.CLL +import CslibTests.DFA +import CslibTests.FreeMonad +import CslibTests.GrindLint +import CslibTests.HasFresh +import CslibTests.ImportWithMathlib +import CslibTests.LTS +import CslibTests.LambdaCalculus +import CslibTests.ReductionSystem From 97308faba473ec01b2de6559eaa8eec2dbcdc899 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 15:23:25 -0800 Subject: [PATCH 68/95] lake exe mk_all --module --- Cslib.lean | 174 ++++++++++++++++++++++++------------------------ CslibTests.lean | 24 ++++--- 2 files changed, 101 insertions(+), 97 deletions(-) diff --git a/Cslib.lean b/Cslib.lean index 0b30f36e2..611bcb595 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,86 +1,88 @@ -import Cslib.Algorithms.Lean.MergeSort.MergeSort -import Cslib.Algorithms.Lean.TimeM -import Cslib.Computability.Automata.Acceptors.Acceptor -import Cslib.Computability.Automata.Acceptors.OmegaAcceptor -import Cslib.Computability.Automata.DA.Basic -import Cslib.Computability.Automata.DA.Buchi -import Cslib.Computability.Automata.DA.Prod -import Cslib.Computability.Automata.DA.ToNA -import Cslib.Computability.Automata.EpsilonNA.Basic -import Cslib.Computability.Automata.EpsilonNA.ToNA -import Cslib.Computability.Automata.NA.Basic -import Cslib.Computability.Automata.NA.BuchiEquiv -import Cslib.Computability.Automata.NA.BuchiInter -import Cslib.Computability.Automata.NA.Concat -import Cslib.Computability.Automata.NA.Hist -import Cslib.Computability.Automata.NA.Loop -import Cslib.Computability.Automata.NA.Pair -import Cslib.Computability.Automata.NA.Prod -import Cslib.Computability.Automata.NA.Sum -import Cslib.Computability.Automata.NA.ToDA -import Cslib.Computability.Automata.NA.Total -import Cslib.Computability.Languages.ExampleEventuallyZero -import Cslib.Computability.Languages.Language -import Cslib.Computability.Languages.OmegaLanguage -import Cslib.Computability.Languages.OmegaRegularLanguage -import Cslib.Computability.Languages.RegularLanguage -import Cslib.Computability.Machines.SingleTapeTuring.Basic -import Cslib.Foundations.Control.Monad.Free -import Cslib.Foundations.Control.Monad.Free.Effects -import Cslib.Foundations.Control.Monad.Free.Fold -import Cslib.Foundations.Data.BiTape -import Cslib.Foundations.Data.FinFun -import Cslib.Foundations.Data.HasFresh -import Cslib.Foundations.Data.Nat.Segment -import Cslib.Foundations.Data.OmegaSequence.Defs -import Cslib.Foundations.Data.OmegaSequence.Flatten -import Cslib.Foundations.Data.OmegaSequence.InfOcc -import Cslib.Foundations.Data.OmegaSequence.Init -import Cslib.Foundations.Data.OmegaSequence.Temporal -import Cslib.Foundations.Data.RelatesInSteps -import Cslib.Foundations.Data.Relation -import Cslib.Foundations.Data.Set.Saturation -import Cslib.Foundations.Data.StackTape -import Cslib.Foundations.Lint.Basic -import Cslib.Foundations.Semantics.FLTS.Basic -import Cslib.Foundations.Semantics.FLTS.FLTSToLTS -import Cslib.Foundations.Semantics.FLTS.LTSToFLTS -import Cslib.Foundations.Semantics.FLTS.Prod -import Cslib.Foundations.Semantics.LTS.Basic -import Cslib.Foundations.Semantics.LTS.Bisimulation -import Cslib.Foundations.Semantics.LTS.Simulation -import Cslib.Foundations.Semantics.LTS.TraceEq -import Cslib.Foundations.Semantics.ReductionSystem.Basic -import Cslib.Foundations.Syntax.Congruence -import Cslib.Foundations.Syntax.Context -import Cslib.Foundations.Syntax.HasAlphaEquiv -import Cslib.Foundations.Syntax.HasSubstitution -import Cslib.Foundations.Syntax.HasWellFormed -import Cslib.Init -import Cslib.Languages.CCS.Basic -import Cslib.Languages.CCS.BehaviouralTheory -import Cslib.Languages.CCS.Semantics -import Cslib.Languages.CombinatoryLogic.Basic -import Cslib.Languages.CombinatoryLogic.Confluence -import Cslib.Languages.CombinatoryLogic.Defs -import Cslib.Languages.CombinatoryLogic.Evaluation -import Cslib.Languages.CombinatoryLogic.Recursion -import Cslib.Languages.LambdaCalculus.LocallyNameless.Context -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Reduction -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Safety -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Subtype -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Typing -import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.WellFormed -import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic -import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence -import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties -import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic -import Cslib.Logics.LinearLogic.CLL.Basic -import Cslib.Logics.LinearLogic.CLL.CutElimination -import Cslib.Logics.LinearLogic.CLL.EtaExpansion -import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic +module -- shake: keep-all + +public import Cslib.Algorithms.Lean.MergeSort.MergeSort +public import Cslib.Algorithms.Lean.TimeM +public import Cslib.Computability.Automata.Acceptors.Acceptor +public import Cslib.Computability.Automata.Acceptors.OmegaAcceptor +public import Cslib.Computability.Automata.DA.Basic +public import Cslib.Computability.Automata.DA.Buchi +public import Cslib.Computability.Automata.DA.Prod +public import Cslib.Computability.Automata.DA.ToNA +public import Cslib.Computability.Automata.EpsilonNA.Basic +public import Cslib.Computability.Automata.EpsilonNA.ToNA +public import Cslib.Computability.Automata.NA.Basic +public import Cslib.Computability.Automata.NA.BuchiEquiv +public import Cslib.Computability.Automata.NA.BuchiInter +public import Cslib.Computability.Automata.NA.Concat +public import Cslib.Computability.Automata.NA.Hist +public import Cslib.Computability.Automata.NA.Loop +public import Cslib.Computability.Automata.NA.Pair +public import Cslib.Computability.Automata.NA.Prod +public import Cslib.Computability.Automata.NA.Sum +public import Cslib.Computability.Automata.NA.ToDA +public import Cslib.Computability.Automata.NA.Total +public import Cslib.Computability.Languages.ExampleEventuallyZero +public import Cslib.Computability.Languages.Language +public import Cslib.Computability.Languages.OmegaLanguage +public import Cslib.Computability.Languages.OmegaRegularLanguage +public import Cslib.Computability.Languages.RegularLanguage +public import Cslib.Computability.Machines.SingleTapeTuring.Basic +public import Cslib.Foundations.Control.Monad.Free +public import Cslib.Foundations.Control.Monad.Free.Effects +public import Cslib.Foundations.Control.Monad.Free.Fold +public import Cslib.Foundations.Data.BiTape +public import Cslib.Foundations.Data.FinFun +public import Cslib.Foundations.Data.HasFresh +public import Cslib.Foundations.Data.Nat.Segment +public import Cslib.Foundations.Data.OmegaSequence.Defs +public import Cslib.Foundations.Data.OmegaSequence.Flatten +public import Cslib.Foundations.Data.OmegaSequence.InfOcc +public import Cslib.Foundations.Data.OmegaSequence.Init +public import Cslib.Foundations.Data.OmegaSequence.Temporal +public import Cslib.Foundations.Data.RelatesInSteps +public import Cslib.Foundations.Data.Relation +public import Cslib.Foundations.Data.Set.Saturation +public import Cslib.Foundations.Data.StackTape +public import Cslib.Foundations.Lint.Basic +public import Cslib.Foundations.Semantics.FLTS.Basic +public import Cslib.Foundations.Semantics.FLTS.FLTSToLTS +public import Cslib.Foundations.Semantics.FLTS.LTSToFLTS +public import Cslib.Foundations.Semantics.FLTS.Prod +public import Cslib.Foundations.Semantics.LTS.Basic +public import Cslib.Foundations.Semantics.LTS.Bisimulation +public import Cslib.Foundations.Semantics.LTS.Simulation +public import Cslib.Foundations.Semantics.LTS.TraceEq +public import Cslib.Foundations.Semantics.ReductionSystem.Basic +public import Cslib.Foundations.Syntax.Congruence +public import Cslib.Foundations.Syntax.Context +public import Cslib.Foundations.Syntax.HasAlphaEquiv +public import Cslib.Foundations.Syntax.HasSubstitution +public import Cslib.Foundations.Syntax.HasWellFormed +public import Cslib.Init +public import Cslib.Languages.CCS.Basic +public import Cslib.Languages.CCS.BehaviouralTheory +public import Cslib.Languages.CCS.Semantics +public import Cslib.Languages.CombinatoryLogic.Basic +public import Cslib.Languages.CombinatoryLogic.Confluence +public import Cslib.Languages.CombinatoryLogic.Defs +public import Cslib.Languages.CombinatoryLogic.Evaluation +public import Cslib.Languages.CombinatoryLogic.Recursion +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Context +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Reduction +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Safety +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Subtype +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Typing +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.WellFormed +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties +public import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic +public import Cslib.Logics.LinearLogic.CLL.Basic +public import Cslib.Logics.LinearLogic.CLL.CutElimination +public import Cslib.Logics.LinearLogic.CLL.EtaExpansion +public import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic diff --git a/CslibTests.lean b/CslibTests.lean index e9ba5995d..47740f10e 100644 --- a/CslibTests.lean +++ b/CslibTests.lean @@ -1,11 +1,13 @@ -import CslibTests.Bisimulation -import CslibTests.CCS -import CslibTests.CLL -import CslibTests.DFA -import CslibTests.FreeMonad -import CslibTests.GrindLint -import CslibTests.HasFresh -import CslibTests.ImportWithMathlib -import CslibTests.LTS -import CslibTests.LambdaCalculus -import CslibTests.ReductionSystem +module -- shake: keep-all + +public import CslibTests.Bisimulation +public import CslibTests.CCS +public import CslibTests.CLL +public import CslibTests.DFA +public import CslibTests.FreeMonad +public import CslibTests.GrindLint +public import CslibTests.HasFresh +public import CslibTests.ImportWithMathlib +public import CslibTests.LTS +public import CslibTests.LambdaCalculus +public import CslibTests.ReductionSystem From 7c097a6cd5be1b75a2a55d530c8b1bda1ebb8734 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 15:39:13 -0800 Subject: [PATCH 69/95] grind annotations --- .../Machines/SingleTapeTuring/Basic.lean | 9 +++++---- Cslib/Foundations/Data/StackTape.lean | 14 +++++++++++--- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 3e36b55fc..6eb2fa9ce 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -124,7 +124,7 @@ def step : tm.Cfg → Option tm.Cfg match tm.M q' t.head with -- and enter a new configuration with state q'' (or none for halting) -- and tape updated according to the Stmt - | ⟨⟨wr, dir⟩, q''⟩ => some ⟨q'', (t.write wr).optionMove dir⟩ + | ⟨⟨wr, dir⟩, q''⟩ => some ⟨q'', (t.write wr).optionMove dir⟩ /-- The initial configuration corresponding to a list in the input alphabet. @@ -143,9 +143,11 @@ The space used by a configuration is the space used by its tape. -/ def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := cfg.BiTape.space_used +@[grind =] lemma Cfg.space_used_initCfg (tm : SingleTapeTM α) (s : List α) : (tm.initCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s +@[grind =] lemma Cfg.space_used_haltCfg (tm : SingleTapeTM α) (s : List α) : (tm.haltCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s @@ -189,8 +191,7 @@ lemma output_length_le_input_length_add_time (tm : SingleTapeTM α) (l l' : List (h : tm.OutputsWithinTime l l' t) : l'.length ≤ max 1 l.length + t := by obtain ⟨steps, hsteps_le, hevals⟩ := h - grind [Cfg.space_used_initCfg, Cfg.space_used_haltCfg, - hevals.apply_le_apply_add (Cfg.space_used tm) + grind [hevals.apply_le_apply_add (Cfg.space_used tm) fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep)] section Computers @@ -298,7 +299,7 @@ private theorem map_toCompCfg_right_step : generalize hM : tm2.M q BiTape.head = result obtain ⟨⟨wr, dir⟩, nextState⟩ := result simp only [compComputer] - grind [toCompCfg_right, step, toCompCfg_right, compComputer] + grind [toCompCfg_right, step, compComputer] /-- Simulation for the first phase of the composed computer. diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 40630b35c..be151b3c7 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -61,6 +61,7 @@ attribute [scoped grind! .] StackTape.toList_getLast?_ne_some_none namespace StackTape /-- The empty `StackTape` -/ +@[grind] def nil {α} : StackTape α := ⟨[], by grind⟩ instance {α : Type} : Inhabited (StackTape α) where @@ -83,12 +84,14 @@ def cons {α} (x : Option α) (xs : StackTape α) : StackTape α := | some a, ⟨l, hl⟩ => ⟨some a :: l, by grind⟩ /-- Remove the first element of the `StackTape`, returning the rest -/ +@[grind] def tail {α} (l : StackTape α) : StackTape α := match hl : l.toList with | [] => nil | hd :: t => ⟨t, by grind⟩ /-- Get the first element of the `StackTape`. -/ +@[grind] def head {α} (l : StackTape α) : Option α := match l.toList with | [] => none @@ -100,7 +103,7 @@ lemma eq_iff {α} (l1 l2 : StackTape α) : l1 = l2 ↔ l1.head = l2.head ∧ l1. · intro ⟨hhead, htail⟩ cases l1 with | mk as1 h1 => cases l2 with | mk as2 h2 => - cases as1 <;> cases as2 <;> grind [tail, head, mk.injEq, nil, mk.injEq] + cases as1 <;> cases as2 <;> grind @[simp] lemma head_cons {α} (o : Option α) (l : StackTape α) : (cons o l).head = o := by @@ -130,25 +133,30 @@ lemma cons_head_tail {α} (l : StackTape α) : section Length /-- The length of the `StackTape` is the number of elements up to the last non-`none` element -/ +@[grind] def length {α} (l : StackTape α) : ℕ := l.toList.length lemma length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by - grind [tail, length, nil] + grind +@[grind =] lemma length_cons_none {α} (l : StackTape α) : (cons none l).length = l.length + if l.length = 0 then 0 else 1 := by cases l with | mk toList h => cases toList <;> simp [cons, length] +@[grind =] lemma length_cons_some {α} (a : α) (l : StackTape α) : (cons (some a) l).length = l.length + 1 := by simp [cons, length] lemma length_cons_le {α} (o : Option α) (l : StackTape α) : (cons o l).length ≤ l.length + 1 := by - cases o <;> grind [length_cons_none, length_cons_some] + cases o <;> grind +@[simp, grind =] lemma length_map_some {α} (l : List α) : (map_some l).length = l.length := by simp [map_some, length] +@[simp, grind =] lemma length_nil {α} : (nil : StackTape α).length = 0 := by simp [nil, length] end Length From 600e016193bcf43cdb65ec88ab088798a65e1f83 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 15:55:49 -0800 Subject: [PATCH 70/95] some more grind lemmas --- Cslib/Foundations/Data/StackTape.lean | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index be151b3c7..9bffd66b4 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -73,16 +73,24 @@ instance {α : Type} : EmptyCollection (StackTape α) := @[simp] lemma empty_eq_nil {α} : (∅ : StackTape α) = nil := rfl -/-- Create a `StackTape` from a list by mapping all elements to `some` -/ -def map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ +@[simp, grind =] +lemma nil_toList {α} : (nil : StackTape α).toList = [] := rfl /-- Prepend an `Option` to the `StackTape` -/ +@[grind] def cons {α} (x : Option α) (xs : StackTape α) : StackTape α := match x, xs with | none, ⟨[], _⟩ => ⟨[], by grind⟩ | none, ⟨hd :: tl, hl⟩ => ⟨none :: hd :: tl, by grind⟩ | some a, ⟨l, hl⟩ => ⟨some a :: l, by grind⟩ +@[simp, grind =] +lemma cons_none_nil_toList {α} : (cons none (nil : StackTape α)).toList = [] := by grind + +@[simp, grind =] +lemma cons_some_toList {α} (a : α) (l : StackTape α) : + (cons (some a) l).toList = some a :: l.toList := by simp [cons] + /-- Remove the first element of the `StackTape`, returning the rest -/ @[grind] def tail {α} (l : StackTape α) : StackTape α := @@ -130,6 +138,10 @@ lemma cons_head_tail {α} (l : StackTape α) : rw [eq_iff] simp +/-- Create a `StackTape` from a list by mapping all elements to `some` -/ +@[grind] +def map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ + section Length /-- The length of the `StackTape` is the number of elements up to the last non-`none` element -/ @@ -147,17 +159,16 @@ lemma length_cons_none {α} (l : StackTape α) : @[grind =] lemma length_cons_some {α} (a : α) (l : StackTape α) : (cons (some a) l).length = l.length + 1 := by - simp [cons, length] + grind lemma length_cons_le {α} (o : Option α) (l : StackTape α) : (cons o l).length ≤ l.length + 1 := by cases o <;> grind @[simp, grind =] -lemma length_map_some {α} (l : List α) : (map_some l).length = l.length := by - simp [map_some, length] +lemma length_map_some {α} (l : List α) : (map_some l).length = l.length := by grind @[simp, grind =] -lemma length_nil {α} : (nil : StackTape α).length = 0 := by simp [nil, length] +lemma length_nil {α} : (nil : StackTape α).length = 0 := by grind end Length From b4704d13f861b993821da19b374070216ae4eb1c Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 16:06:45 -0800 Subject: [PATCH 71/95] more grind annotations --- .../Machines/SingleTapeTuring/Basic.lean | 5 ++--- Cslib/Foundations/Data/BiTape.lean | 2 ++ Cslib/Foundations/Data/StackTape.lean | 14 +++++++------- 3 files changed, 11 insertions(+), 10 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index 6eb2fa9ce..d2ff642b1 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -170,6 +170,7 @@ The `TransitionRelation` corresponding to a `SingleTapeTM α` is defined by the `step` function, which maps a configuration to its next configuration, if it exists. -/ +@[grind =] def TransitionRelation (tm : SingleTapeTM α) (c₁ c₂ : tm.Cfg) : Prop := tm.step c₁ = some c₂ /-- A proof of `tm` outputting `l'` on input `l`. -/ @@ -346,9 +347,7 @@ private theorem comp_right_relatesWithinSteps (intermediate output : List α) (t simp only [intermediateCfg, finalCfg, initCfg, haltCfg] at htm2 ⊢ refine RelatesWithinSteps.map (toCompCfg_right tm1 tm2) ?_ htm2 intro a b hab - have h1 := map_toCompCfg_right_step tm1 tm2 a - rw [hab, Option.map_some] at h1 - exact h1.symm + grind [map_toCompCfg_right_step tm1 tm2 a] end compComputerLemmas diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 8c3cc817f..24dd65cb7 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -120,8 +120,10 @@ def write {α} (t : BiTape α) (a : Option α) : BiTape α := { t with head := a The space used by a `BiTape` is the number of symbols between and including the head, and leftmost and rightmost non-blank symbols on the `BiTape`. -/ +@[grind] def space_used {α} (t : BiTape α) : ℕ := 1 + t.left.length + t.right.length +@[simp, grind =] lemma space_used_write {α} (t : BiTape α) (a : Option α) : (t.write a).space_used = t.space_used := by rfl diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 9bffd66b4..5bdf2cd95 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -89,7 +89,7 @@ lemma cons_none_nil_toList {α} : (cons none (nil : StackTape α)).toList = [] : @[simp, grind =] lemma cons_some_toList {α} (a : α) (l : StackTape α) : - (cons (some a) l).toList = some a :: l.toList := by simp [cons] + (cons (some a) l).toList = some a :: l.toList := by simp only [cons] /-- Remove the first element of the `StackTape`, returning the rest -/ @[grind] @@ -118,17 +118,15 @@ lemma head_cons {α} (o : Option α) (l : StackTape α) : (cons o l).head = o := cases o with | none => cases l with | mk toList hl => - cases toList <;> simp [cons, head] - | some a => simp [cons, head] + cases toList <;> grind + | some a => grind @[simp] lemma tail_cons {α} (o : Option α) (l : StackTape α) : (cons o l).tail = l := by cases o with | none => cases l with | mk toList h => - cases toList with - | nil => simp [cons, tail, nil] - | cons hd tl => simp [cons, tail] + cases toList <;> grind | some a => simp only [cons, tail] @@ -151,11 +149,13 @@ def length {α} (l : StackTape α) : ℕ := l.toList.length lemma length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by grind +grind_pattern length_tail_le => l.tail.length + @[grind =] lemma length_cons_none {α} (l : StackTape α) : (cons none l).length = l.length + if l.length = 0 then 0 else 1 := by cases l with | mk toList h => - cases toList <;> simp [cons, length] + cases toList <;> grind @[grind =] lemma length_cons_some {α} (a : α) (l : StackTape α) : (cons (some a) l).length = l.length + 1 := by From ee79f80567325d41f34dd2503e3c0fc7127b10c9 Mon Sep 17 00:00:00 2001 From: Bolton Bailey Date: Fri, 30 Jan 2026 16:26:18 -0800 Subject: [PATCH 72/95] scoped grind --- .../Machines/SingleTapeTuring/Basic.lean | 10 ++++--- Cslib/Foundations/Data/BiTape.lean | 2 +- Cslib/Foundations/Data/StackTape.lean | 26 +++++++++---------- 3 files changed, 21 insertions(+), 17 deletions(-) diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index d2ff642b1..dee642005 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -45,6 +45,8 @@ open Cslib Relation namespace Turing +open BiTape StackTape + variable {α : Type} namespace SingleTapeTM @@ -143,11 +145,11 @@ The space used by a configuration is the space used by its tape. -/ def Cfg.space_used (tm : SingleTapeTM α) (cfg : tm.Cfg) : ℕ := cfg.BiTape.space_used -@[grind =] +@[scoped grind =] lemma Cfg.space_used_initCfg (tm : SingleTapeTM α) (s : List α) : (tm.initCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s -@[grind =] +@[scoped grind =] lemma Cfg.space_used_haltCfg (tm : SingleTapeTM α) (s : List α) : (tm.haltCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s @@ -165,12 +167,14 @@ lemma Cfg.space_used_step {tm : SingleTapeTM α} (cfg cfg' : tm.Cfg) end Cfg +open Cfg + /-- The `TransitionRelation` corresponding to a `SingleTapeTM α` is defined by the `step` function, which maps a configuration to its next configuration, if it exists. -/ -@[grind =] +@[scoped grind =] def TransitionRelation (tm : SingleTapeTM α) (c₁ c₂ : tm.Cfg) : Prop := tm.step c₁ = some c₂ /-- A proof of `tm` outputting `l'` on input `l`. -/ diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 24dd65cb7..0daa7bbcf 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -120,7 +120,7 @@ def write {α} (t : BiTape α) (a : Option α) : BiTape α := { t with head := a The space used by a `BiTape` is the number of symbols between and including the head, and leftmost and rightmost non-blank symbols on the `BiTape`. -/ -@[grind] +@[scoped grind] def space_used {α} (t : BiTape α) : ℕ := 1 + t.left.length + t.right.length @[simp, grind =] diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 5bdf2cd95..08814a04d 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -61,7 +61,7 @@ attribute [scoped grind! .] StackTape.toList_getLast?_ne_some_none namespace StackTape /-- The empty `StackTape` -/ -@[grind] +@[scoped grind] def nil {α} : StackTape α := ⟨[], by grind⟩ instance {α : Type} : Inhabited (StackTape α) where @@ -73,33 +73,33 @@ instance {α : Type} : EmptyCollection (StackTape α) := @[simp] lemma empty_eq_nil {α} : (∅ : StackTape α) = nil := rfl -@[simp, grind =] +@[simp, scoped grind =] lemma nil_toList {α} : (nil : StackTape α).toList = [] := rfl /-- Prepend an `Option` to the `StackTape` -/ -@[grind] +@[scoped grind] def cons {α} (x : Option α) (xs : StackTape α) : StackTape α := match x, xs with | none, ⟨[], _⟩ => ⟨[], by grind⟩ | none, ⟨hd :: tl, hl⟩ => ⟨none :: hd :: tl, by grind⟩ | some a, ⟨l, hl⟩ => ⟨some a :: l, by grind⟩ -@[simp, grind =] +@[simp, scoped grind =] lemma cons_none_nil_toList {α} : (cons none (nil : StackTape α)).toList = [] := by grind -@[simp, grind =] +@[simp, scoped grind =] lemma cons_some_toList {α} (a : α) (l : StackTape α) : (cons (some a) l).toList = some a :: l.toList := by simp only [cons] /-- Remove the first element of the `StackTape`, returning the rest -/ -@[grind] +@[scoped grind] def tail {α} (l : StackTape α) : StackTape α := match hl : l.toList with | [] => nil | hd :: t => ⟨t, by grind⟩ /-- Get the first element of the `StackTape`. -/ -@[grind] +@[scoped grind] def head {α} (l : StackTape α) : Option α := match l.toList with | [] => none @@ -137,13 +137,13 @@ lemma cons_head_tail {α} (l : StackTape α) : simp /-- Create a `StackTape` from a list by mapping all elements to `some` -/ -@[grind] +@[scoped grind] def map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ section Length /-- The length of the `StackTape` is the number of elements up to the last non-`none` element -/ -@[grind] +@[scoped grind] def length {α} (l : StackTape α) : ℕ := l.toList.length lemma length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by @@ -151,23 +151,23 @@ lemma length_tail_le {α} (l : StackTape α) : l.tail.length ≤ l.length := by grind_pattern length_tail_le => l.tail.length -@[grind =] +@[scoped grind =] lemma length_cons_none {α} (l : StackTape α) : (cons none l).length = l.length + if l.length = 0 then 0 else 1 := by cases l with | mk toList h => cases toList <;> grind -@[grind =] +@[scoped grind =] lemma length_cons_some {α} (a : α) (l : StackTape α) : (cons (some a) l).length = l.length + 1 := by grind lemma length_cons_le {α} (o : Option α) (l : StackTape α) : (cons o l).length ≤ l.length + 1 := by cases o <;> grind -@[simp, grind =] +@[simp, scoped grind =] lemma length_map_some {α} (l : List α) : (map_some l).length = l.length := by grind -@[simp, grind =] +@[simp, scoped grind =] lemma length_nil {α} : (nil : StackTape α).length = 0 := by grind end Length From de5ca7d17b2b40878bde31d416fa1e4677ce32f6 Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 12:04:37 +0100 Subject: [PATCH 73/95] Multi-tape Turing machine. --- Cslib.lean | 1 + .../Machines/MultiTapeTuring/Basic.lean | 500 ++++++++++++++++++ .../Machines/SingleTapeTuring/Basic.lean | 6 +- Cslib/Foundations/Data/BiTape.lean | 4 + 4 files changed, 508 insertions(+), 3 deletions(-) create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/Basic.lean diff --git a/Cslib.lean b/Cslib.lean index 611bcb595..e55f16d55 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -27,6 +27,7 @@ public import Cslib.Computability.Languages.OmegaLanguage public import Cslib.Computability.Languages.OmegaRegularLanguage public import Cslib.Computability.Languages.RegularLanguage public import Cslib.Computability.Machines.SingleTapeTuring.Basic +public import Cslib.Computability.Machines.MultiTapeTuring.Basic public import Cslib.Foundations.Control.Monad.Free public import Cslib.Foundations.Control.Monad.Free.Effects public import Cslib.Foundations.Control.Monad.Free.Fold diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean new file mode 100644 index 000000000..9ad787545 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -0,0 +1,500 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey, Pim Spelier, Daan van Gent +-/ + +module + +public import Cslib.Foundations.Data.BiTape +public import Cslib.Foundations.Data.RelatesInSteps + +-- TODO create a "common file" +public import Cslib.Computability.Machines.SingleTapeTuring.Basic + +public import Mathlib.Data.Nat.PartENat + +@[expose] public section + +/-! +# Multi-Tape Turing Machines + +Defines Turing machines with `k` tapes (bidirectionally infinite, `BiTape`) containing symbols +from `Option α` for a finite alphabet `α` (where `none` is the blank symbol). + +## Important Declarations + +We define a number of structures related to Turing machine computation: + +* `Stmt`: the write and movement operations a TM can do in a single step. +* `SingleTapeTM`: the TM itself. +* `Cfg`: the configuration of a TM, including internal and tape state. +* `TimeComputable f`: a TM for computing `f`, packaged with a bound on runtime. +* `PolyTimeComputable f`: `TimeComputable f` packaged with a polynomial bound on runtime. + +We also provide ways of constructing polynomial-runtime TMs + +* `PolyTimeComputable.id`: computes the identity function +* `PolyTimeComputable.comp`: computes the composition of polynomial time machines + +## TODOs + + +-/ + +open Cslib Relation + +namespace Turing + +open BiTape StackTape + +variable {α : Type} + +variable {k : ℕ} + +/-- +A `k`-tape Turing machine +over the alphabet of `Option α` (where `none` is the blank `BiTape` symbol). +-/ +structure MultiTapeTM k α where + /-- Inhabited instance for the alphabet -/ + [αInhabited : Inhabited α] + /-- Finiteness of the alphabet -/ + [αFintype : Fintype α] + /-- type of state labels -/ + (Λ : Type) + /-- finiteness of the state type -/ + [ΛFintype : Fintype Λ] + /-- Initial state -/ + (q₀ : Λ) + /-- Transition function, mapping a state and a head symbol to a `Stmt` to invoke, + and optionally the new state to transition to afterwards (`none` for halt) -/ + (M : Λ → (Fin k → Option α) → ((Fin k → (SingleTapeTM.Stmt α)) × Option Λ)) + +namespace MultiTapeTM + +section Cfg + +/-! +## Configurations of a Turing Machine + +This section defines the configurations of a Turing machine, +the step function that lets the machine transition from one configuration to the next, +and the intended initial and final configurations. +-/ + +variable (tm : MultiTapeTM k α) + +instance : Inhabited tm.Λ := ⟨tm.q₀⟩ + +instance : Fintype tm.Λ := tm.ΛFintype + +instance inhabitedStmt : Inhabited (SingleTapeTM.Stmt α) := inferInstance + +/-- +The configurations of a Turing machine consist of: +an `Option`al state (or none for the halting state), +and a `BiTape` representing the tape contents. +-/ +structure Cfg : Type where + /-- the state of the TM (or none for the halting state) -/ + state : Option tm.Λ + /-- the BiTape contents -/ + tapes : Fin k → BiTape α +deriving Inhabited + +/-- The step function corresponding to a `MultiTapeTM`. -/ +@[simp] +def step : tm.Cfg → Option tm.Cfg + | ⟨none, _⟩ => + -- If in the halting state, there is no next configuration + none + | ⟨some q, tapes⟩ => + -- If in state q', perform look up in the transition function + match tm.M q (fun i => (tapes i).head) with + -- and enter a new configuration with state q'' (or none for halting) + -- and tape updated according to the Stmt + | ⟨stmts, q'⟩ => some ⟨q', fun i => + ((tapes i).write (stmts i).symbol).optionMove (stmts i).movement⟩ + +def configurations (initialConfig : tm.Cfg) (n : ℕ) : Option tm.Cfg := + (fun c => Option.bind c tm.step)^[n] initialConfig + +lemma configurations_zero (initialConfig : tm.Cfg) : + tm.configurations initialConfig 0 = some initialConfig := by + simp [configurations] + +def halts_in_steps (initialConfig : tm.Cfg) (n : ℕ) : Prop := + (tm.configurations initialConfig n).map (·.state.isNone) = .some True + +def first_tape_with (s : List α) : Fin k → BiTape α + | ⟨0, _⟩ => BiTape.mk₁ s + | ⟨_, _⟩ => default + +/-- +The initial configuration corresponding to a list in the input alphabet. +Note that the entries of the tape constructed by `BiTape.mk₁` are all `some` values. +This is to ensure that distinct lists map to distinct initial configurations. +-/ +def initCfg (tm : MultiTapeTM k α) (s : List α) : tm.Cfg := + ⟨some tm.q₀, first_tape_with s⟩ + +/-- The final configuration corresponding to a list in the output alphabet. +(We demand that the head halts at the leftmost position of the output.) +-/ +def haltCfg (tm : MultiTapeTM k α) (s : List α) : tm.Cfg := + ⟨none, first_tape_with s⟩ + +example (tm : MultiTapeTM k α) (s : List α) : + tm.halts_in_steps (tm.haltCfg s) 0 := by + simp [haltCfg, halts_in_steps, configurations] + +/-- +The space used by a configuration is the space used by its tape. +-/ +def Cfg.space_used (tm : MultiTapeTM k α) (cfg : tm.Cfg) : ℕ := ∑ i, (cfg.tapes i).space_used + +-- @[scoped grind =] +-- lemma Cfg.space_used_initCfg (tm : MultiTapeTM k.succ α) (s : List α) : +-- (tm.initCfg s).space_used = k + max 1 s.length := by grind + +-- @[scoped grind =] +-- lemma Cfg.space_used_haltCfg (tm : MultiTapeTM α) (s : List α) : +-- (tm.haltCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s + +lemma Cfg.space_used_step {tm : MultiTapeTM k α} (cfg cfg' : tm.Cfg) + (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + k := by + obtain ⟨_ | q, tapes⟩ := cfg + · simp [step] at hstep + · simp at hstep + sorry + +end Cfg + +open Cfg + +/-- +The `TransitionRelation` corresponding to a `MultiTapeTM k α` +is defined by the `step` function, +which maps a configuration to its next configuration, if it exists. +-/ +@[scoped grind =] +def TransitionRelation (tm : MultiTapeTM k α) (c₁ c₂ : tm.Cfg) : Prop := tm.step c₁ = some c₂ + +def TransformsTapesInTime + (tm : MultiTapeTM k α) + (tapes tapes' : Fin k → BiTape α) + (t : ℕ) : Prop := + RelatesInSteps tm.TransitionRelation ⟨some tm.q₀, tapes⟩ ⟨none, tapes'⟩ t + +def TransformsTapesWithinTime + (tm : MultiTapeTM k α) + (tapes tapes' : Fin k → BiTape α) + (t : ℕ) : Prop := + RelatesWithinSteps tm.TransitionRelation ⟨some tm.q₀, tapes⟩ ⟨none, tapes'⟩ t + +def eval (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) [DecidableEq tm.Λ] [DecidableEq α] : + Option (Fin k → BiTape α) := + -- (PartENat.find (fun t => tm.halts_in_steps ⟨some tm.q₀, tapes⟩ t)).map (fun t => + -- (tm.configurations ⟨some tm.q₀, tapes⟩).tapes) + let configs := fun t => ((Option.bind · tm.step)^[t] (Option.some ⟨tm.q₀, tapes⟩)) + let halts := fun t => (configs t).map (·.state.isNone) = .some True + (PartENat.find (fun t => halts t)).map (fun t => (configs t).map (·.tapes)) + +/-- A proof of `tm` outputting `l'` on input `l`. -/ +def Outputs (tm : MultiTapeTM k α) (l l' : List α) : Prop := + ReflTransGen tm.TransitionRelation (initCfg tm l) (haltCfg tm l') + +/-- A proof of `tm` outputting `l'` on input `l` in at most `m` steps. -/ +def OutputsWithinTime (tm : MultiTapeTM k α) (l l' : List α) (m : ℕ) := + RelatesWithinSteps tm.TransitionRelation (initCfg tm l) (haltCfg tm l') m + +-- /-- +-- This lemma bounds the size blow-up of the output of a Turing machine. +-- It states that the increase in length of the output over the input is bounded by the runtime. +-- This is important for guaranteeing that composition of polynomial time Turing machines +-- remains polynomial time, as the input to the second machine +-- is bounded by the output length of the first machine. +-- -/ +-- lemma output_length_le_input_length_add_time (tm : MultiTapeTM k α) (l l' : List α) (t : ℕ) +-- (h : tm.OutputsWithinTime l l' t) : +-- l'.length ≤ max 1 l.length + k * t := by +-- obtain ⟨steps, hsteps_le, hevals⟩ := h +-- grind [hevals.apply_le_apply_add (Cfg.space_used tm) +-- fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep)] + +section Combinators + +variable [Inhabited α] [Fintype α] + +/-- +A Turing machine computing the composition of two other Turing machines. + +If f and g are computed by Turing machines `tm1` and `tm2` +then we can construct a Turing machine which computes g ∘ f by first running `tm1` +and then, when `tm1` halts, transitioning to the start state of `tm2` and running `tm2`. +-/ +-- TODO called compComputer in SingleTapeTM +-- maybe more exact: sequential composition +-- TODO the definition is exactly the same. +def seq (tm1 tm2 : MultiTapeTM k α) : MultiTapeTM k α where + -- The states of the composed machine are the disjoint union of the states of the input machines. + Λ := tm1.Λ ⊕ tm2.Λ + -- The start state is the start state of the first input machine. + q₀ := .inl tm1.q₀ + M q h := + match q with + -- If we are in the first input machine's states, run that machine ... + | .inl ql => match tm1.M ql h with + | (stmt, state) => + -- ... taking the same tape action as the first input machine would. + (stmt, + match state with + -- If it halts, transition to the start state of the second input machine + | none => some (.inr tm2.q₀) + -- Otherwise continue as normal + | _ => Option.map .inl state) + -- If we are in the second input machine's states, run that machine ... + | .inr qr => + match tm2.M qr h with + | (stmt, state) => + -- ... taking the same tape action as the second input machine would. + (stmt, + match state with + -- If it halts, transition to the halting state + | none => none + -- Otherwise continue as normal + | _ => Option.map .inr state) + +section seqLemmas + +/-! ### Composition Computer Lemmas -/ + +variable (tm1 tm2 : MultiTapeTM k α) (cfg1 : tm1.Cfg) (cfg2 : tm2.Cfg) + +lemma seq_q₀_eq : (seq tm1 tm2).q₀ = Sum.inl tm1.q₀ := rfl + +/-- +Convert a `Cfg` over the first input machine to a config over the composed machine. +Note it may transition to the start state of the second machine if the first machine halts. +-/ +private def toSeqCfg_left : (seq tm1 tm2).Cfg := + match cfg1.state with + | some q => ⟨some (Sum.inl q), cfg1.tapes⟩ + | none => ⟨some (Sum.inr tm2.q₀), cfg1.tapes⟩ + +/-- Convert a `Cfg` over the second input machine to a config over the composed machine -/ +private def toSeqCfg_right : (seq tm1 tm2).Cfg := + ⟨Option.map Sum.inr cfg2.state, cfg2.tapes⟩ + +-- /-- The initial configuration for the composed machine, with the first machine starting. -/ +-- private def initialCfg (input : List α) : (seq tm1 tm2).Cfg := +-- ⟨some (Sum.inl tm1.q₀), first_tape_with input⟩ + +-- /-- The intermediate configuration for the composed machine, +-- after the first machine halts and the second machine starts. -/ +-- private def intermediateCfg (intermediate : List α) : (seq tm1 tm2).Cfg := +-- ⟨some (Sum.inr tm2.q₀), first_tape_with intermediate⟩ + +-- /-- The final configuration for the composed machine, after the second machine halts. -/ +-- private def finalCfg (output : List α) : (compComputer tm1 tm2).Cfg := +-- ⟨none, BiTape.mk₁ output⟩ + +/-- The left converting function commutes with steps of the machines. -/ +@[scoped grind =] +private theorem map_toSeqCfg_left_step (hcfg1 : cfg1.state.isSome) : + Option.map (toSeqCfg_left tm1 tm2) (tm1.step cfg1) = + (seq tm1 tm2).step (toSeqCfg_left tm1 tm2 cfg1) := by + simp only [step, toSeqCfg_left, seq] + grind [toSeqCfg_left] + +/-- The right converting function commutes with steps of the machines. -/ +@[scoped grind =] +private theorem map_toSeqCfg_right_step : + Option.map (toSeqCfg_right tm1 tm2) (tm2.step cfg2) = + (seq tm1 tm2).step (toSeqCfg_right tm1 tm2 cfg2) := by + simp only [step, toSeqCfg_right, seq] + grind [toSeqCfg_right] + +theorem seq_relatesWithinSteps + (t₁ t₂ : ℕ) + (h_tm₁ : RelatesInSteps tm₁.Trans + +/-- +Simulation for the first phase of the composed computer. +When the first machine runs from start to halt, the composed machine +runs from start (with Sum.inl state) to Sum.inr tm2.q₀ (the start of the second phase). +This takes the same number of steps because the halt transition becomes a transition to the +second machine. +-/ +private theorem comp_left_relatesWithinSteps (initial intermediate : tm1.Cfg) (t : ℕ) + (htm1 : RelatesWithinSteps tm1.TransitionRelation initial intermediate t) : + RelatesWithinSteps (seq tm1 tm2).TransitionRelation + (toSeqCfg_left tm1 tm2 initial) + (intermediateCfg tm1 tm2 intermediate) + t := by + simp only [initialCfg, intermediateCfg, initCfg, haltCfg] at htm1 ⊢ + refine RelatesWithinSteps.map (toCompCfg_left tm1 tm2) ?_ htm1 + intro a b hab + have ha : a.state.isSome := by + simp only [TransitionRelation, step] at hab + cases a with | mk state _ => cases state <;> simp_all + have h1 := map_toCompCfg_left_step tm1 tm2 a ha + rw [hab, Option.map_some] at h1 + exact h1.symm + +/-- +Simulation for the second phase of the composed computer. +When the second machine runs from start to halt, the composed machine +runs from Sum.inr tm2.q₀ to halt. +-/ +private theorem comp_right_relatesWithinSteps (intermediate output : List α) (t : ℕ) + (htm2 : + RelatesWithinSteps tm2.TransitionRelation + (tm2.initCfg intermediate) + (tm2.haltCfg output) + t) : + RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation + (intermediateCfg tm1 tm2 intermediate) + (finalCfg tm1 tm2 output) + t := by + simp only [intermediateCfg, finalCfg, initCfg, haltCfg] at htm2 ⊢ + refine RelatesWithinSteps.map (toCompCfg_right tm1 tm2) ?_ htm2 + intro a b hab + grind [map_toCompCfg_right_step tm1 tm2 a] + +end compComputerLemmas + +end Computers + +/-! +## Time Computability + +This section defines the notion of time-bounded Turing Machines +-/ + +section TimeComputable + +variable [Inhabited α] [Fintype α] + +/-- A Turing machine + a time function + +a proof it outputs `f` in at most `time(input.length)` steps. -/ +structure TimeComputable (f : List α → List α) where + /-- the underlying bundled MultiTapeTM -/ + tm : MultiTapeTM α + /-- a bound on runtime -/ + time_bound : ℕ → ℕ + /-- proof this machine outputs `f` in at most `time_bound(input.length)` steps -/ + outputsFunInTime (a) : tm.OutputsWithinTime a (f a) (time_bound a.length) + + +/-- The identity map on α is computable in constant time. -/ +def TimeComputable.id : TimeComputable (α := α) id where + tm := idComputer + time_bound _ := 1 + outputsFunInTime _ := ⟨1, le_rfl, RelatesInSteps.single rfl⟩ + +/-- +Time bounds for `compComputer`. + +The `compComputer` of two machines which have time bounds is bounded by + +* The time taken by the first machine on the input size +* added to the time taken by the second machine on the output size of the first machine + (which is itself bounded by the time taken by the first machine) + +Note that we require the time function of the second machine to be monotone; +this is to ensure that if the first machine returns an output +which is shorter than the maximum possible length of output for that input size, +then the time bound for the second machine still holds for that shorter input to the second machine. +-/ +def TimeComputable.comp {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) + (h_mono : Monotone hg.time_bound) : + (TimeComputable (g ∘ f)) where + tm := compComputer hf.tm hg.tm + -- perhaps it would be good to track the blow up separately? + time_bound l := (hf.time_bound l) + hg.time_bound (max 1 l + hf.time_bound l) + outputsFunInTime a := by + have hf_outputsFun := hf.outputsFunInTime a + have hg_outputsFun := hg.outputsFunInTime (f a) + simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, + haltCfg] at hg_outputsFun hf_outputsFun ⊢ + -- The computer reduces a to f a in time hf.time_bound a.length + have h_a_reducesTo_f_a : + RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation + (initialCfg hf.tm hg.tm a) + (intermediateCfg hf.tm hg.tm (f a)) + (hf.time_bound a.length) := + comp_left_relatesWithinSteps hf.tm hg.tm a (f a) + (hf.time_bound a.length) hf_outputsFun + -- The computer reduces f a to g (f a) in time hg.time_bound (f a).length + have h_f_a_reducesTo_g_f_a : + RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation + (intermediateCfg hf.tm hg.tm (f a)) + (finalCfg hf.tm hg.tm (g (f a))) + (hg.time_bound (f a).length) := + comp_right_relatesWithinSteps hf.tm hg.tm (f a) (g (f a)) + (hg.time_bound (f a).length) hg_outputsFun + -- Therefore, the computer reduces a to g (f a) in the sum of those times. + have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a + apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a + refine Nat.add_le_add_left ?_ (hf.time_bound a.length) + · apply h_mono + -- Use the lemma about output length being bounded by input length + time + exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFunInTime a) + +end TimeComputable + +/-! +## Polynomial Time Computability + +This section defines polynomial time computable functions on Turing machines, +and proves that: + +* The identity function is polynomial time computable +* The composition of two polynomial time computable functions is polynomial time computable + +-/ + +section PolyTimeComputable + +open Polynomial + +variable [Inhabited α] [Fintype α] + +/-- A Turing machine + a polynomial time function + +a proof it outputs `f` in at most `time(input.length)` steps. -/ +structure PolyTimeComputable (f : List α → List α) extends TimeComputable f where + /-- a polynomial time bound -/ + poly : Polynomial ℕ + /-- proof that this machine outputs `f` in at most `time(input.length)` steps -/ + bounds : ∀ n, time_bound n ≤ poly.eval n + +/-- A proof that the identity map on α is computable in polytime. -/ +noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id where + toTimeComputable := TimeComputable.id + poly := 1 + bounds _ := by simp [TimeComputable.id] + +-- TODO remove `h_mono` assumption +-- by developing function to convert PolyTimeComputable into one with monotone time bound +/-- +A proof that the composition of two polytime computable functions is polytime computable. +-/ +noncomputable def PolyTimeComputable.comp {f g : List α → List α} + (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) + (h_mono : Monotone hg.time_bound) : + PolyTimeComputable (g ∘ f) where + toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono + poly := hf.poly + hg.poly.comp (1 + X + hf.poly) + bounds n := by + simp only [TimeComputable.comp, eval_add, eval_comp, eval_X, eval_one] + apply add_le_add + · exact hf.bounds n + · exact (h_mono (add_le_add (by omega) (hf.bounds n))).trans (hg.bounds _) + +end PolyTimeComputable + +end MultiTapeTM + +end Turing diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean index dee642005..10e291cdc 100644 --- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean @@ -287,9 +287,9 @@ private theorem map_toCompCfg_left_step (hcfg1 : cfg1.state.isSome) : | none => grind | some q => simp only [step, toCompCfg_left, compComputer] - generalize hM : tm1.M q BiTape.head = result - obtain ⟨⟨wr, dir⟩, nextState⟩ := result - cases nextState <;> grind [toCompCfg_left] + -- generalize hM : tm1.M q BiTape.head = result + -- obtain ⟨⟨wr, dir⟩, nextState⟩ := result + grind [toCompCfg_left, compComputer, step] /-- The right converting function commutes with steps of the machines. -/ private theorem map_toCompCfg_right_step : diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 0daa7bbcf..d4b0e7541 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -133,6 +133,10 @@ lemma space_used_mk₁ {α} (l : List α) : | nil => simp [mk₁, space_used, nil, StackTape.length_nil] | cons h t => simp [mk₁, space_used, StackTape.length_nil, StackTape.length_map_some]; omega +@[simp, grind =] +lemma space_used_defaul {α} : (default : BiTape α).space_used = 1 := by + simp [space_used, nil, default] + lemma space_used_move {α} (t : BiTape α) (d : Dir) : (t.move d).space_used ≤ t.space_used + 1 := by cases d <;> grind [move_left, move_right, move, From f07cb725a9d590cd8d32a7d4b9a0324dc62b004c Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 12:19:37 +0100 Subject: [PATCH 74/95] define eval --- Cslib/Computability/Machines/MultiTapeTuring/Basic.lean | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean index 9ad787545..7bd183139 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -194,12 +194,11 @@ def TransformsTapesWithinTime RelatesWithinSteps tm.TransitionRelation ⟨some tm.q₀, tapes⟩ ⟨none, tapes'⟩ t def eval (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) [DecidableEq tm.Λ] [DecidableEq α] : - Option (Fin k → BiTape α) := - -- (PartENat.find (fun t => tm.halts_in_steps ⟨some tm.q₀, tapes⟩ t)).map (fun t => - -- (tm.configurations ⟨some tm.q₀, tapes⟩).tapes) - let configs := fun t => ((Option.bind · tm.step)^[t] (Option.some ⟨tm.q₀, tapes⟩)) + Part (Fin k → BiTape α) := + -- TODO avoid the inner definitions. + let configs := tm.configurations ⟨tm.q₀, tapes⟩ let halts := fun t => (configs t).map (·.state.isNone) = .some True - (PartENat.find (fun t => halts t)).map (fun t => (configs t).map (·.tapes)) + (PartENat.find halts).bind (fun t => Part.ofOption ((configs t).map (·.tapes))) /-- A proof of `tm` outputting `l'` on input `l`. -/ def Outputs (tm : MultiTapeTM k α) (l l' : List α) : Prop := From 27dd8274caa2fb5d81c7bb3a0ca35c4d6176f481 Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 13:04:46 +0100 Subject: [PATCH 75/95] relates_eq_some --- .../Machines/MultiTapeTuring/Basic.lean | 56 +++++++++++++++---- 1 file changed, 45 insertions(+), 11 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean index 7bd183139..81e93538a 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -120,10 +120,18 @@ def step : tm.Cfg → Option tm.Cfg def configurations (initialConfig : tm.Cfg) (n : ℕ) : Option tm.Cfg := (fun c => Option.bind c tm.step)^[n] initialConfig +@[simp] lemma configurations_zero (initialConfig : tm.Cfg) : tm.configurations initialConfig 0 = some initialConfig := by simp [configurations] +-- TODO lemma configurations_succ (initialConfig : tm.Cfg) (n : ℕ) : + +lemma configurations_succ' (initialConfig : tm.Cfg) (n : ℕ) : + tm.configurations initialConfig (n + 1) = + Option.bind (tm.configurations initialConfig n) tm.step := by + simp [configurations, Function.iterate_succ_apply'] + def halts_in_steps (initialConfig : tm.Cfg) (n : ℕ) : Prop := (tm.configurations initialConfig n).map (·.state.isNone) = .some True @@ -162,12 +170,12 @@ def Cfg.space_used (tm : MultiTapeTM k α) (cfg : tm.Cfg) : ℕ := ∑ i, (cfg.t -- lemma Cfg.space_used_haltCfg (tm : MultiTapeTM α) (s : List α) : -- (tm.haltCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s -lemma Cfg.space_used_step {tm : MultiTapeTM k α} (cfg cfg' : tm.Cfg) - (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + k := by - obtain ⟨_ | q, tapes⟩ := cfg - · simp [step] at hstep - · simp at hstep - sorry +-- lemma Cfg.space_used_step {tm : MultiTapeTM k α} (cfg cfg' : tm.Cfg) +-- (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + k := by +-- obtain ⟨_ | q, tapes⟩ := cfg +-- · simp [step] at hstep +-- · simp at hstep +-- sorry end Cfg @@ -193,13 +201,42 @@ def TransformsTapesWithinTime (t : ℕ) : Prop := RelatesWithinSteps tm.TransitionRelation ⟨some tm.q₀, tapes⟩ ⟨none, tapes'⟩ t -def eval (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) [DecidableEq tm.Λ] [DecidableEq α] : +def eval (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : Part (Fin k → BiTape α) := - -- TODO avoid the inner definitions. + -- TODO avoid the inner definitions and use halts_in_steps instead let configs := tm.configurations ⟨tm.q₀, tapes⟩ let halts := fun t => (configs t).map (·.state.isNone) = .some True (PartENat.find halts).bind (fun t => Part.ofOption ((configs t).map (·.tapes))) +lemma relatesInSteps_iff_configurations_eq_some + (tm : MultiTapeTM k α) + (cfg₁ cfg₂ : tm.Cfg) + (t : ℕ) : + RelatesInSteps tm.TransitionRelation cfg₁ cfg₂ t ↔ + tm.configurations cfg₁ t = .some cfg₂ := by + induction t generalizing cfg₁ cfg₂ with + | zero => simp + | succ t ih => + rw [RelatesInSteps.succ_iff, configurations_succ'] + constructor + · grind only [TransitionRelation, = Option.bind_some] + · intro h_configs + cases h : tm.configurations cfg₁ t + · simp [h] at h_configs + · rename_i cfg' + use cfg' + grind + +lemma eval_of_TransformsTapesinTime + {tm : MultiTapeTM k α} + {tapes tapes' : Fin k → BiTape α} + {t : ℕ} + (h : tm.TransformsTapesInTime tapes tapes' t) : + tm.eval tapes = Part.some tapes' := by + simp [TransformsTapesInTime, eval] at h ⊢ + simp only [Part.eq_some_iff] + sorry + /-- A proof of `tm` outputting `l'` on input `l`. -/ def Outputs (tm : MultiTapeTM k α) (l l' : List α) : Prop := ReflTransGen tm.TransitionRelation (initCfg tm l) (haltCfg tm l') @@ -315,9 +352,6 @@ private theorem map_toSeqCfg_right_step : simp only [step, toSeqCfg_right, seq] grind [toSeqCfg_right] -theorem seq_relatesWithinSteps - (t₁ t₂ : ℕ) - (h_tm₁ : RelatesInSteps tm₁.Trans /-- Simulation for the first phase of the composed computer. From 4fc2c1c5cda20547a3aac86232d21a74c8d69a2f Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 15:19:54 +0100 Subject: [PATCH 76/95] simplify --- .../Machines/MultiTapeTuring/Basic.lean | 441 +++++------------- 1 file changed, 112 insertions(+), 329 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean index 81e93538a..dad305b89 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -117,25 +117,20 @@ def step : tm.Cfg → Option tm.Cfg | ⟨stmts, q'⟩ => some ⟨q', fun i => ((tapes i).write (stmts i).symbol).optionMove (stmts i).movement⟩ -def configurations (initialConfig : tm.Cfg) (n : ℕ) : Option tm.Cfg := - (fun c => Option.bind c tm.step)^[n] initialConfig - -@[simp] -lemma configurations_zero (initialConfig : tm.Cfg) : - tm.configurations initialConfig 0 = some initialConfig := by - simp [configurations] - --- TODO lemma configurations_succ (initialConfig : tm.Cfg) (n : ℕ) : - -lemma configurations_succ' (initialConfig : tm.Cfg) (n : ℕ) : - tm.configurations initialConfig (n + 1) = - Option.bind (tm.configurations initialConfig n) tm.step := by - simp [configurations, Function.iterate_succ_apply'] - -def halts_in_steps (initialConfig : tm.Cfg) (n : ℕ) : Prop := - (tm.configurations initialConfig n).map (·.state.isNone) = .some True +/-- Any number of positive steps run from a halting configuration lead to `none`. -/ +@[simp, scoped grind =] +lemma step_iter_none_eq_none (tapes : Fin k → BiTape α) (n : ℕ) : + (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes⟩) = none := by + rw [Function.iterate_succ_apply] + induction n with + | zero => simp + | succ n ih => + simp only [Function.iterate_succ_apply', ih] + simp [step] -def first_tape_with (s : List α) : Fin k → BiTape α +/-- A collection of tapes where the first tape (if it exists) +contains `s` -/ +def first_tape (s : List α) : Fin k → BiTape α | ⟨0, _⟩ => BiTape.mk₁ s | ⟨_, _⟩ => default @@ -144,38 +139,41 @@ The initial configuration corresponding to a list in the input alphabet. Note that the entries of the tape constructed by `BiTape.mk₁` are all `some` values. This is to ensure that distinct lists map to distinct initial configurations. -/ -def initCfg (tm : MultiTapeTM k α) (s : List α) : tm.Cfg := - ⟨some tm.q₀, first_tape_with s⟩ +def initCfg (s : List α) : tm.Cfg := + ⟨some tm.q₀, first_tape s⟩ + +def initCfgTapes (tapes : Fin k → BiTape α) : tm.Cfg := + ⟨some tm.q₀, tapes⟩ /-- The final configuration corresponding to a list in the output alphabet. (We demand that the head halts at the leftmost position of the output.) -/ -def haltCfg (tm : MultiTapeTM k α) (s : List α) : tm.Cfg := - ⟨none, first_tape_with s⟩ +def haltCfg (s : List α) : tm.Cfg := + ⟨none, first_tape s⟩ -example (tm : MultiTapeTM k α) (s : List α) : - tm.halts_in_steps (tm.haltCfg s) 0 := by - simp [haltCfg, halts_in_steps, configurations] +def haltCfgTapes (tapes : Fin k → BiTape α) : tm.Cfg := + ⟨none, tapes⟩ /-- The space used by a configuration is the space used by its tape. -/ -def Cfg.space_used (tm : MultiTapeTM k α) (cfg : tm.Cfg) : ℕ := ∑ i, (cfg.tapes i).space_used - --- @[scoped grind =] --- lemma Cfg.space_used_initCfg (tm : MultiTapeTM k.succ α) (s : List α) : --- (tm.initCfg s).space_used = k + max 1 s.length := by grind - --- @[scoped grind =] --- lemma Cfg.space_used_haltCfg (tm : MultiTapeTM α) (s : List α) : --- (tm.haltCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s - --- lemma Cfg.space_used_step {tm : MultiTapeTM k α} (cfg cfg' : tm.Cfg) --- (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + k := by --- obtain ⟨_ | q, tapes⟩ := cfg --- · simp [step] at hstep --- · simp at hstep --- sorry +def Cfg.space_used (cfg : tm.Cfg) : ℕ := ∑ i, (cfg.tapes i).space_used + +lemma Cfg.space_used_step {tm : MultiTapeTM k α} (cfg cfg' : tm.Cfg) + (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + k := by + obtain ⟨_ | q, tapes⟩ := cfg + · simp [step] at hstep + · simp only [step] at hstep + generalize hM : tm.M q (fun i => (tapes i).head) = result at hstep + obtain ⟨stmts, q''⟩ := result + injection hstep with hstep + subst hstep + simp only [space_used] + trans ∑ i : Fin k, ((tapes i).space_used + 1) + · refine Finset.sum_le_sum fun i _ => ?_ + unfold BiTape.optionMove + grind [BiTape.space_used_write, BiTape.space_used_move] + · simp [Finset.sum_add_distrib] end Cfg @@ -201,41 +199,95 @@ def TransformsTapesWithinTime (t : ℕ) : Prop := RelatesWithinSteps tm.TransitionRelation ⟨some tm.q₀, tapes⟩ ⟨none, tapes'⟩ t -def eval (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : - Part (Fin k → BiTape α) := - -- TODO avoid the inner definitions and use halts_in_steps instead - let configs := tm.configurations ⟨tm.q₀, tapes⟩ - let halts := fun t => (configs t).map (·.state.isNone) = .some True - (PartENat.find halts).bind (fun t => Part.ofOption ((configs t).map (·.tapes))) +def TransformsTapes + (tm : MultiTapeTM k α) + (tapes tapes' : Fin k → BiTape α) : Prop := + ∃ t, tm.TransformsTapesInTime tapes tapes' t -lemma relatesInSteps_iff_configurations_eq_some +@[scoped grind =] +lemma relatesInSteps_iff_step_iter_eq_some (tm : MultiTapeTM k α) (cfg₁ cfg₂ : tm.Cfg) (t : ℕ) : RelatesInSteps tm.TransitionRelation cfg₁ cfg₂ t ↔ - tm.configurations cfg₁ t = .some cfg₂ := by + (Option.bind · tm.step)^[t] cfg₁ = .some cfg₂ := by induction t generalizing cfg₁ cfg₂ with | zero => simp | succ t ih => - rw [RelatesInSteps.succ_iff, configurations_succ'] + rw [RelatesInSteps.succ_iff, Function.iterate_succ_apply'] constructor · grind only [TransitionRelation, = Option.bind_some] · intro h_configs - cases h : tm.configurations cfg₁ t - · simp [h] at h_configs + cases h : (Option.bind · tm.step)^[t] cfg₁ + · grind · rename_i cfg' use cfg' grind -lemma eval_of_TransformsTapesinTime +/-- If a Turing machine transforms tapes to tapes₁, then tapes₁ is uniquely determined. -/ +lemma transformsTapes_unique (tm : MultiTapeTM k α) + (tapes tapes₁ tapes₂ : Fin k → BiTape α) + (h1 : tm.TransformsTapes tapes tapes₁) + (h2 : tm.TransformsTapes tapes tapes₂) : + tapes₁ = tapes₂ := by + obtain ⟨t1, ht1⟩ := h1 + obtain ⟨t2, ht2⟩ := h2 + unfold TransformsTapesInTime at ht1 ht2 + rw [relatesInSteps_iff_step_iter_eq_some] at ht1 ht2 + rcases Nat.lt_trichotomy t1 t2 with hlt | heq | hgt + · -- `t1 < t2` is a contradiction because if we halt at `t1` steps + -- we cannot compute "some" after `t2` steps + obtain ⟨t', ht2_eq⟩ := Nat.exists_eq_add_of_lt hlt + rw [ht2_eq] at ht2 + rw [show t1 + t' + 1 = (t' + 1) + t1 by omega] at ht2 + rw [Function.iterate_add_apply] at ht2 + grind + · rw [heq] at ht1 + subst heq + simp_all only [step, Option.some.injEq, Cfg.mk.injEq, true_and] + · -- Symmetric to the case `t1 < t2` + obtain ⟨t', ht1_eq⟩ := Nat.exists_eq_add_of_lt hgt + rw [ht1_eq] at ht1 + rw [show t2 + t' + 1 = (t' + 1) + t2 by omega] at ht1 + rw [Function.iterate_add_apply] at ht1 + grind + +-- TODO we can actually make it computable, but we have to go a different route +-- via iterated steps +public noncomputable def eval (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : + Part (Fin k → BiTape α) := + ⟨∃ tapes', tm.TransformsTapes tapes tapes', fun h => h.choose⟩ + +-- TODO this is a simple consequence of relatesInSteps_iff_configurations_eq_some, maybe not needed. +lemma configurations_of_transformsTapesInTime + (tm : MultiTapeTM k α) + (tapes tapes' : Fin k → BiTape α) + (t : ℕ) + (h_transforms : tm.TransformsTapesInTime tapes tapes' t) : + (Option.bind · tm.step)^[t] (tm.initCfgTapes tapes) = + some (tm.haltCfgTapes tapes') := by + simp [TransformsTapesInTime] at h_transforms + apply (relatesInSteps_iff_step_iter_eq_some tm (tm.initCfgTapes tapes) ⟨none, tapes'⟩ t).mp + simpa using h_transforms + +@[scoped grind =] +lemma eval_iff_exists_steps_iter_eq_some {tm : MultiTapeTM k α} - {tapes tapes' : Fin k → BiTape α} - {t : ℕ} - (h : tm.TransformsTapesInTime tapes tapes' t) : - tm.eval tapes = Part.some tapes' := by - simp [TransformsTapesInTime, eval] at h ⊢ - simp only [Part.eq_some_iff] - sorry + {tapes tapes' : Fin k → BiTape α} : + tm.eval tapes = some tapes' ↔ + ∃ t : ℕ, (Option.bind · tm.step)^[t] (tm.initCfgTapes tapes) = + some (tm.haltCfgTapes tapes') := by + constructor + · simp only [Part.coe_some, Part.eq_some_iff, eval] + intro ⟨h_x, h_tapes_eq⟩ + simp at h_tapes_eq + obtain ⟨tapes'', h_choose⟩ := h_x + let tapes'' := h_choose.choose + use tapes'' + obtain ⟨t, h_transforms⟩ := h_choose + rw [← relatesInSteps_iff_step_iter_eq_some] + sorry + · sorry /-- A proof of `tm` outputting `l'` on input `l`. -/ def Outputs (tm : MultiTapeTM k α) (l l' : List α) : Prop := @@ -259,275 +311,6 @@ def OutputsWithinTime (tm : MultiTapeTM k α) (l l' : List α) (m : ℕ) := -- grind [hevals.apply_le_apply_add (Cfg.space_used tm) -- fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep)] -section Combinators - -variable [Inhabited α] [Fintype α] - -/-- -A Turing machine computing the composition of two other Turing machines. - -If f and g are computed by Turing machines `tm1` and `tm2` -then we can construct a Turing machine which computes g ∘ f by first running `tm1` -and then, when `tm1` halts, transitioning to the start state of `tm2` and running `tm2`. --/ --- TODO called compComputer in SingleTapeTM --- maybe more exact: sequential composition --- TODO the definition is exactly the same. -def seq (tm1 tm2 : MultiTapeTM k α) : MultiTapeTM k α where - -- The states of the composed machine are the disjoint union of the states of the input machines. - Λ := tm1.Λ ⊕ tm2.Λ - -- The start state is the start state of the first input machine. - q₀ := .inl tm1.q₀ - M q h := - match q with - -- If we are in the first input machine's states, run that machine ... - | .inl ql => match tm1.M ql h with - | (stmt, state) => - -- ... taking the same tape action as the first input machine would. - (stmt, - match state with - -- If it halts, transition to the start state of the second input machine - | none => some (.inr tm2.q₀) - -- Otherwise continue as normal - | _ => Option.map .inl state) - -- If we are in the second input machine's states, run that machine ... - | .inr qr => - match tm2.M qr h with - | (stmt, state) => - -- ... taking the same tape action as the second input machine would. - (stmt, - match state with - -- If it halts, transition to the halting state - | none => none - -- Otherwise continue as normal - | _ => Option.map .inr state) - -section seqLemmas - -/-! ### Composition Computer Lemmas -/ - -variable (tm1 tm2 : MultiTapeTM k α) (cfg1 : tm1.Cfg) (cfg2 : tm2.Cfg) - -lemma seq_q₀_eq : (seq tm1 tm2).q₀ = Sum.inl tm1.q₀ := rfl - -/-- -Convert a `Cfg` over the first input machine to a config over the composed machine. -Note it may transition to the start state of the second machine if the first machine halts. --/ -private def toSeqCfg_left : (seq tm1 tm2).Cfg := - match cfg1.state with - | some q => ⟨some (Sum.inl q), cfg1.tapes⟩ - | none => ⟨some (Sum.inr tm2.q₀), cfg1.tapes⟩ - -/-- Convert a `Cfg` over the second input machine to a config over the composed machine -/ -private def toSeqCfg_right : (seq tm1 tm2).Cfg := - ⟨Option.map Sum.inr cfg2.state, cfg2.tapes⟩ - --- /-- The initial configuration for the composed machine, with the first machine starting. -/ --- private def initialCfg (input : List α) : (seq tm1 tm2).Cfg := --- ⟨some (Sum.inl tm1.q₀), first_tape_with input⟩ - --- /-- The intermediate configuration for the composed machine, --- after the first machine halts and the second machine starts. -/ --- private def intermediateCfg (intermediate : List α) : (seq tm1 tm2).Cfg := --- ⟨some (Sum.inr tm2.q₀), first_tape_with intermediate⟩ - --- /-- The final configuration for the composed machine, after the second machine halts. -/ --- private def finalCfg (output : List α) : (compComputer tm1 tm2).Cfg := --- ⟨none, BiTape.mk₁ output⟩ - -/-- The left converting function commutes with steps of the machines. -/ -@[scoped grind =] -private theorem map_toSeqCfg_left_step (hcfg1 : cfg1.state.isSome) : - Option.map (toSeqCfg_left tm1 tm2) (tm1.step cfg1) = - (seq tm1 tm2).step (toSeqCfg_left tm1 tm2 cfg1) := by - simp only [step, toSeqCfg_left, seq] - grind [toSeqCfg_left] - -/-- The right converting function commutes with steps of the machines. -/ -@[scoped grind =] -private theorem map_toSeqCfg_right_step : - Option.map (toSeqCfg_right tm1 tm2) (tm2.step cfg2) = - (seq tm1 tm2).step (toSeqCfg_right tm1 tm2 cfg2) := by - simp only [step, toSeqCfg_right, seq] - grind [toSeqCfg_right] - - -/-- -Simulation for the first phase of the composed computer. -When the first machine runs from start to halt, the composed machine -runs from start (with Sum.inl state) to Sum.inr tm2.q₀ (the start of the second phase). -This takes the same number of steps because the halt transition becomes a transition to the -second machine. --/ -private theorem comp_left_relatesWithinSteps (initial intermediate : tm1.Cfg) (t : ℕ) - (htm1 : RelatesWithinSteps tm1.TransitionRelation initial intermediate t) : - RelatesWithinSteps (seq tm1 tm2).TransitionRelation - (toSeqCfg_left tm1 tm2 initial) - (intermediateCfg tm1 tm2 intermediate) - t := by - simp only [initialCfg, intermediateCfg, initCfg, haltCfg] at htm1 ⊢ - refine RelatesWithinSteps.map (toCompCfg_left tm1 tm2) ?_ htm1 - intro a b hab - have ha : a.state.isSome := by - simp only [TransitionRelation, step] at hab - cases a with | mk state _ => cases state <;> simp_all - have h1 := map_toCompCfg_left_step tm1 tm2 a ha - rw [hab, Option.map_some] at h1 - exact h1.symm - -/-- -Simulation for the second phase of the composed computer. -When the second machine runs from start to halt, the composed machine -runs from Sum.inr tm2.q₀ to halt. --/ -private theorem comp_right_relatesWithinSteps (intermediate output : List α) (t : ℕ) - (htm2 : - RelatesWithinSteps tm2.TransitionRelation - (tm2.initCfg intermediate) - (tm2.haltCfg output) - t) : - RelatesWithinSteps (compComputer tm1 tm2).TransitionRelation - (intermediateCfg tm1 tm2 intermediate) - (finalCfg tm1 tm2 output) - t := by - simp only [intermediateCfg, finalCfg, initCfg, haltCfg] at htm2 ⊢ - refine RelatesWithinSteps.map (toCompCfg_right tm1 tm2) ?_ htm2 - intro a b hab - grind [map_toCompCfg_right_step tm1 tm2 a] - -end compComputerLemmas - -end Computers - -/-! -## Time Computability - -This section defines the notion of time-bounded Turing Machines --/ - -section TimeComputable - -variable [Inhabited α] [Fintype α] - -/-- A Turing machine + a time function + -a proof it outputs `f` in at most `time(input.length)` steps. -/ -structure TimeComputable (f : List α → List α) where - /-- the underlying bundled MultiTapeTM -/ - tm : MultiTapeTM α - /-- a bound on runtime -/ - time_bound : ℕ → ℕ - /-- proof this machine outputs `f` in at most `time_bound(input.length)` steps -/ - outputsFunInTime (a) : tm.OutputsWithinTime a (f a) (time_bound a.length) - - -/-- The identity map on α is computable in constant time. -/ -def TimeComputable.id : TimeComputable (α := α) id where - tm := idComputer - time_bound _ := 1 - outputsFunInTime _ := ⟨1, le_rfl, RelatesInSteps.single rfl⟩ - -/-- -Time bounds for `compComputer`. - -The `compComputer` of two machines which have time bounds is bounded by - -* The time taken by the first machine on the input size -* added to the time taken by the second machine on the output size of the first machine - (which is itself bounded by the time taken by the first machine) - -Note that we require the time function of the second machine to be monotone; -this is to ensure that if the first machine returns an output -which is shorter than the maximum possible length of output for that input size, -then the time bound for the second machine still holds for that shorter input to the second machine. --/ -def TimeComputable.comp {f g : List α → List α} (hf : TimeComputable f) (hg : TimeComputable g) - (h_mono : Monotone hg.time_bound) : - (TimeComputable (g ∘ f)) where - tm := compComputer hf.tm hg.tm - -- perhaps it would be good to track the blow up separately? - time_bound l := (hf.time_bound l) + hg.time_bound (max 1 l + hf.time_bound l) - outputsFunInTime a := by - have hf_outputsFun := hf.outputsFunInTime a - have hg_outputsFun := hg.outputsFunInTime (f a) - simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply, - haltCfg] at hg_outputsFun hf_outputsFun ⊢ - -- The computer reduces a to f a in time hf.time_bound a.length - have h_a_reducesTo_f_a : - RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation - (initialCfg hf.tm hg.tm a) - (intermediateCfg hf.tm hg.tm (f a)) - (hf.time_bound a.length) := - comp_left_relatesWithinSteps hf.tm hg.tm a (f a) - (hf.time_bound a.length) hf_outputsFun - -- The computer reduces f a to g (f a) in time hg.time_bound (f a).length - have h_f_a_reducesTo_g_f_a : - RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation - (intermediateCfg hf.tm hg.tm (f a)) - (finalCfg hf.tm hg.tm (g (f a))) - (hg.time_bound (f a).length) := - comp_right_relatesWithinSteps hf.tm hg.tm (f a) (g (f a)) - (hg.time_bound (f a).length) hg_outputsFun - -- Therefore, the computer reduces a to g (f a) in the sum of those times. - have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a - apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a - refine Nat.add_le_add_left ?_ (hf.time_bound a.length) - · apply h_mono - -- Use the lemma about output length being bounded by input length + time - exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFunInTime a) - -end TimeComputable - -/-! -## Polynomial Time Computability - -This section defines polynomial time computable functions on Turing machines, -and proves that: - -* The identity function is polynomial time computable -* The composition of two polynomial time computable functions is polynomial time computable - --/ - -section PolyTimeComputable - -open Polynomial - -variable [Inhabited α] [Fintype α] - -/-- A Turing machine + a polynomial time function + -a proof it outputs `f` in at most `time(input.length)` steps. -/ -structure PolyTimeComputable (f : List α → List α) extends TimeComputable f where - /-- a polynomial time bound -/ - poly : Polynomial ℕ - /-- proof that this machine outputs `f` in at most `time(input.length)` steps -/ - bounds : ∀ n, time_bound n ≤ poly.eval n - -/-- A proof that the identity map on α is computable in polytime. -/ -noncomputable def PolyTimeComputable.id : @PolyTimeComputable (α := α) id where - toTimeComputable := TimeComputable.id - poly := 1 - bounds _ := by simp [TimeComputable.id] - --- TODO remove `h_mono` assumption --- by developing function to convert PolyTimeComputable into one with monotone time bound -/-- -A proof that the composition of two polytime computable functions is polytime computable. --/ -noncomputable def PolyTimeComputable.comp {f g : List α → List α} - (hf : PolyTimeComputable f) (hg : PolyTimeComputable g) - (h_mono : Monotone hg.time_bound) : - PolyTimeComputable (g ∘ f) where - toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono - poly := hf.poly + hg.poly.comp (1 + X + hf.poly) - bounds n := by - simp only [TimeComputable.comp, eval_add, eval_comp, eval_X, eval_one] - apply add_le_add - · exact hf.bounds n - · exact (h_mono (add_le_add (by omega) (hf.bounds n))).trans (hg.bounds _) - -end PolyTimeComputable - end MultiTapeTM end Turing From 9782a33dd22acb303cac7cc28badc98f43dec85b Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 19:09:16 +0100 Subject: [PATCH 77/95] Finish eval proof --- .../Machines/MultiTapeTuring/Basic.lean | 31 +++++++++++++------ 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean index dad305b89..20b4ae599 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -274,20 +274,31 @@ lemma configurations_of_transformsTapesInTime lemma eval_iff_exists_steps_iter_eq_some {tm : MultiTapeTM k α} {tapes tapes' : Fin k → BiTape α} : - tm.eval tapes = some tapes' ↔ + tm.eval tapes = .some tapes' ↔ ∃ t : ℕ, (Option.bind · tm.step)^[t] (tm.initCfgTapes tapes) = some (tm.haltCfgTapes tapes') := by + simp only [Part.eq_some_iff, eval] constructor - · simp only [Part.coe_some, Part.eq_some_iff, eval] - intro ⟨h_x, h_tapes_eq⟩ - simp at h_tapes_eq - obtain ⟨tapes'', h_choose⟩ := h_x - let tapes'' := h_choose.choose - use tapes'' - obtain ⟨t, h_transforms⟩ := h_choose + · intro h + obtain ⟨h_dom, h_get⟩ := h + simp only at h_get + rw [← h_get] + obtain ⟨t, h_transforms_in_time⟩ := (h_dom.choose_spec : TransformsTapes tm tapes h_dom.choose) + use t rw [← relatesInSteps_iff_step_iter_eq_some] - sorry - · sorry + simpa [TransformsTapesInTime, initCfgTapes, haltCfgTapes] using h_transforms_in_time + · intro ⟨t, h_iter⟩ + have h_dom : ∃ tapes', tm.TransformsTapes tapes tapes' := by + use tapes' + use t + simp only [TransformsTapesInTime] + rw [relatesInSteps_iff_step_iter_eq_some] + exact h_iter + refine ⟨h_dom, ?_⟩ + apply transformsTapes_unique tm tapes + · exact (h_dom.choose_spec : TransformsTapes tm tapes h_dom.choose) + · use t + simpa [TransformsTapesInTime, relatesInSteps_iff_step_iter_eq_some] using h_iter /-- A proof of `tm` outputting `l'` on input `l`. -/ def Outputs (tm : MultiTapeTM k α) (l l' : List α) : Prop := From c3226c0e1499820748fcd838c8574c12551a5514 Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 21:53:05 +0100 Subject: [PATCH 78/95] move_right_nth --- Cslib/Foundations/Data/BiTape.lean | 46 +++++++++++++++++++++++++++ Cslib/Foundations/Data/StackTape.lean | 9 ++++++ 2 files changed, 55 insertions(+) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index d4b0e7541..4b4e0487a 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -73,6 +73,14 @@ def mk₁ {α} (l : List α) : BiTape α := | [] => ∅ | h :: t => { head := some h, left := ∅, right := StackTape.map_some t } +/-- Indexes the tape using integers, where `0` is the symbol at the tape head, +positive integers index to the right, and negative integers index to the left. -/ +def nth {α} (t : BiTape α) (n : ℤ) : Option α := + match n with + | Int.ofNat 0 => t.head + | Int.ofNat (n + 1) => t.right.toList.getD n none + | Int.negSucc n => t.left.toList.getD n none + section Move /-- @@ -94,6 +102,44 @@ def move {α} (t : BiTape α) : Dir → BiTape α | .left => t.move_left | .right => t.move_right + +@[simp] +lemma move_right_nth {α} (t : BiTape α) (p : ℤ) : + (t.move_right).nth p = t.nth (p + 1) := by + unfold nth + split + · grind [move_right] + · rename_i n + simp only [move_right, List.getD_eq_getElem?_getD, Nat.succ_eq_add_one, Int.ofNat_eq_natCast, + Int.natCast_add, Int.cast_ofNat_Int] + have h: (n : ℤ) + 1 + 1 ≥ 2 := by omega + split + · grind + · rename_i n'' h_eq + simp at h_eq + rw [show n'' = n + 1 by omega] + simp + · grind + · rename_i n + simp only [move_right, List.getD_eq_getElem?_getD] + split + · rename_i h_eq + simp only [StackTape.cons] + grind + · grind + · rename_i n' h_eq + rw [show n = n' + 1 by omega] + simp only [StackTape.cons] + grind + +/-- Move the head by an integer amount of cells where positive amounts cause the tape head to move +to the right while a negative amounts move the tape head to the left. -/ +def move_int {α} (t : BiTape α) (delta : ℤ) : BiTape α := + match delta with + | Int.ofNat 0 => t + | Int.ofNat (n + 1) => (BiTape.move · Dir.right)^[n] t + | Int.negSucc n => (BiTape.move · Dir.left)^[n] t + /-- Optionally perform a `move`, or do nothing if `none`. -/ diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 08814a04d..2ec475290 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -105,6 +105,15 @@ def head {α} (l : StackTape α) : Option α := | [] => none | h :: _ => h +@[grind =] +lemma head_eq_list_getD {α} (l : StackTape α) : l.head = l.toList.getD 0 none := by + cases l with | mk toList h => + cases toList <;> grind + +@[simp, scoped grind =] +lemma tail_toList_get_eq_right_toList_get_succ {α} (t : StackTape α) (n : ℕ) : + t.tail.toList[n]? = t.toList[n + 1]? := by grind + lemma eq_iff {α} (l1 l2 : StackTape α) : l1 = l2 ↔ l1.head = l2.head ∧ l1.tail = l2.tail := by constructor · grind From 9840eb6704b0501e572d78351de1a612ff53411b Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 22:11:31 +0100 Subject: [PATCH 79/95] move_int --- Cslib/Foundations/Data/BiTape.lean | 66 ++++++++++++++++++++++-------- 1 file changed, 48 insertions(+), 18 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 4b4e0487a..eb5504cd7 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2026 Bolton Bailey. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bolton Bailey +Authors: Bolton Bailey, Christian Reitwiessner -/ module @@ -102,8 +102,23 @@ def move {α} (t : BiTape α) : Dir → BiTape α | .left => t.move_left | .right => t.move_right +/-- +Optionally perform a `move`, or do nothing if `none`. +-/ +def optionMove {α} : BiTape α → Option Dir → BiTape α + | t, none => t + | t, some d => t.move d + +@[simp] +lemma move_left_move_right {α} (t : BiTape α) : t.move_left.move_right = t := by + simp [move_right, move_left] @[simp] +lemma move_right_move_left {α} (t : BiTape α) : t.move_right.move_left = t := by + simp [move_left, move_right] + + +@[simp, grind =] lemma move_right_nth {α} (t : BiTape α) (p : ℤ) : (t.move_right).nth p = t.nth (p + 1) := by unfold nth @@ -132,28 +147,43 @@ lemma move_right_nth {α} (t : BiTape α) (p : ℤ) : simp only [StackTape.cons] grind +@[simp, grind =] +lemma move_left_nth {α} (t : BiTape α) (p : ℤ) : + (t.move_left).nth p = t.nth (p - 1) := by + rw [← move_left_move_right t] + simp only [move_right_nth] + simp + +@[simp, grind =] +lemma move_right_iter_nth {α} (t : BiTape α) (n : ℕ) (p : ℤ) : + (move_right^[n] t).nth p = t.nth (p + n) := by + induction n generalizing p with + | zero => simp + | succ n ih => + simp only [Function.iterate_succ_apply'] + grind + +@[simp, grind =] +lemma move_left_iter_nth {α} (t : BiTape α) (n : ℕ) (p : ℤ) : + (move_left^[n] t).nth p = t.nth (p - n) := by + induction n generalizing p with + | zero => simp + | succ n ih => + simp only [Function.iterate_succ_apply'] + grind + /-- Move the head by an integer amount of cells where positive amounts cause the tape head to move to the right while a negative amounts move the tape head to the left. -/ def move_int {α} (t : BiTape α) (delta : ℤ) : BiTape α := match delta with - | Int.ofNat 0 => t - | Int.ofNat (n + 1) => (BiTape.move · Dir.right)^[n] t - | Int.negSucc n => (BiTape.move · Dir.left)^[n] t - -/-- -Optionally perform a `move`, or do nothing if `none`. --/ -def optionMove {α} : BiTape α → Option Dir → BiTape α - | t, none => t - | t, some d => t.move d - -@[simp] -lemma move_left_move_right {α} (t : BiTape α) : t.move_left.move_right = t := by - simp [move_right, move_left] + | Int.ofNat n => move_right^[n] t + | Int.negSucc n => move_left^[n + 1] t -@[simp] -lemma move_right_move_left {α} (t : BiTape α) : t.move_right.move_left = t := by - simp [move_left, move_right] +@[simp, grind =] +lemma move_int_nth {α} (t : BiTape α) (n p : ℤ) : + (move_int t n).nth p = t.nth (p + n) := by + unfold move_int + split <;> grind end Move From be76f0ff7b127354c3752aa25e9cc4295e80d49a Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 22:22:53 +0100 Subject: [PATCH 80/95] move until --- Cslib/Foundations/Data/BiTape.lean | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index eb5504cd7..ee9346463 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -192,6 +192,9 @@ Write a value under the head of the `BiTape`. -/ def write {α} (t : BiTape α) (a : Option α) : BiTape α := { t with head := a } +@[simp, grind =] +lemma write_head {α} (t : BiTape α) : t.write t.head = t := by rfl + /-- The space used by a `BiTape` is the number of symbols between and including the head, and leftmost and rightmost non-blank symbols on the `BiTape`. From e0b12b6f5349e6cd891f98258bfbeb8b49fdc942 Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 23:03:17 +0100 Subject: [PATCH 81/95] progress --- Cslib/Foundations/Data/BiTape.lean | 38 ++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index ee9346463..0e3b84301 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -81,6 +81,27 @@ def nth {α} (t : BiTape α) (n : ℤ) : Option α := | Int.ofNat (n + 1) => t.right.toList.getD n none | Int.negSucc n => t.left.toList.getD n none +lemma ext_nth {α} {t₁ t₂ : BiTape α} (h_nth_eq : ∀ n, t₁.nth n = t₂.nth n) : + t₁ = t₂ := by + cases t₁ with | mk head₁ left₁ right₁ + cases t₂ with | mk head₂ left₂ right₂ + have h_head : head₁ = head₂ := by + specialize h_nth_eq 0 + simpa [nth] using h_nth_eq + have h_right : right₁ = right₂ := by + apply StackTape.ext_toList + intro n + specialize h (Int.ofNat (n + 1)) + simp [nth] at h + exact h + have h_left : left₁ = left₂ := by + apply StackTape.ext_toList + intro n + specialize h (Int.negSucc n) + simp [nth] at h + exact h + rw [h_head, h_left, h_right] + section Move /-- @@ -179,6 +200,23 @@ def move_int {α} (t : BiTape α) (delta : ℤ) : BiTape α := | Int.ofNat n => move_right^[n] t | Int.negSucc n => move_left^[n + 1] t +@[simp, grind =] +lemma move_int_move_int {α} (t : BiTape α) (n₁ n₂ : ℤ) : + (t.move_int n₁).move_int n₂ = t.move_int (n₁ + n₂) := by + unfold move_int + split + · split + · split + · grind [Function.iterate_add_apply] + simp_all + · simp + rename_i n₁' n₂' + simp only [Int.ofNat_add, Function.iterate_add_apply] + grind + · rename_i n₁' n₂' + simp only [Int.negSucc_add_ofNat, Function.iterate_add_apply] + grind + @[simp, grind =] lemma move_int_nth {α} (t : BiTape α) (n p : ℤ) : (move_int t n).nth p = t.nth (p + n) := by From 65c4a3206b3e237454bad07fc2b41586063c9776 Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Feb 2026 23:07:41 +0100 Subject: [PATCH 82/95] stacktape_ext --- Cslib/Foundations/Data/BiTape.lean | 50 ++++++++++++++++++++++----- Cslib/Foundations/Data/StackTape.lean | 8 +++++ 2 files changed, 50 insertions(+), 8 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 0e3b84301..d4698bbc4 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -90,16 +90,50 @@ lemma ext_nth {α} {t₁ t₂ : BiTape α} (h_nth_eq : ∀ n, t₁.nth n = t₂. simpa [nth] using h_nth_eq have h_right : right₁ = right₂ := by apply StackTape.ext_toList - intro n - specialize h (Int.ofNat (n + 1)) - simp [nth] at h - exact h + apply List.ext_get + · by_contra h_ne + rcases Nat.lt_trichotomy right₁.toList.length right₂.toList.length with hlt | _ | hgt + · have h := h_nth_eq (Int.ofNat (right₁.toList.length + 1)) + simp [nth, List.getD_eq_getElem?_getD] at h + split at h + · rename_i h_get; simp at h_get; omega + · split at h; simp at h + · contradiction + · have h := h_nth_eq (Int.ofNat (right₂.toList.length + 1)) + simp [nth, List.getD_eq_getElem?_getD] at h + split at h + · split at h; simp at h + · rename_i h_get; simp at h_get; omega + · intro n h₁ h₂ + have h := h_nth_eq (Int.ofNat (n + 1)) + simp [nth, List.getD_eq_getElem?_getD] at h + split at h <;> split at h + · exact h + · omega + · omega have h_left : left₁ = left₂ := by apply StackTape.ext_toList - intro n - specialize h (Int.negSucc n) - simp [nth] at h - exact h + apply List.ext_get + · by_contra h_ne + rcases Nat.lt_trichotomy left₁.toList.length left₂.toList.length with hlt | _ | hgt + · have h := h_nth_eq (Int.negSucc left₁.toList.length) + simp [nth, List.getD_eq_getElem?_getD] at h + split at h + · rename_i h_get; simp at h_get; omega + · split at h; simp at h + · contradiction + · have h := h_nth_eq (Int.negSucc left₂.toList.length) + simp [nth, List.getD_eq_getElem?_getD] at h + split at h + · split at h; simp at h + · rename_i h_get; simp at h_get; omega + · intro n h₁ h₂ + have h := h_nth_eq (Int.negSucc n) + simp [nth, List.getD_eq_getElem?_getD] at h + split at h <;> split at h + · exact h + · omega + · omega rw [h_head, h_left, h_right] section Move diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 2ec475290..143b669b9 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -145,6 +145,14 @@ lemma cons_head_tail {α} (l : StackTape α) : rw [eq_iff] simp +lemma ext_toList {α} {s₁ s₂ : StackTape α} (h : s₁.toList = s₂.toList) : + s₁ = s₂ := by + cases s₁ with | mk l₁ h₁ => + cases s₂ with | mk l₂ h₂ => + simp only at h + subst h + rfl + /-- Create a `StackTape` from a list by mapping all elements to `some` -/ @[scoped grind] def map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ From df0811046ef26e11f0ddc598a2d51c9fd24f6e3f Mon Sep 17 00:00:00 2001 From: crei Date: Tue, 3 Feb 2026 08:37:41 +0100 Subject: [PATCH 83/95] move_int_move_int --- Cslib/Foundations/Data/BiTape.lean | 86 +++++++++++++-------------- Cslib/Foundations/Data/StackTape.lean | 6 ++ 2 files changed, 47 insertions(+), 45 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index d4698bbc4..86a035db6 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -86,54 +86,60 @@ lemma ext_nth {α} {t₁ t₂ : BiTape α} (h_nth_eq : ∀ n, t₁.nth n = t₂. cases t₁ with | mk head₁ left₁ right₁ cases t₂ with | mk head₂ left₂ right₂ have h_head : head₁ = head₂ := by - specialize h_nth_eq 0 - simpa [nth] using h_nth_eq + have := h_nth_eq 0 + simpa [nth] using this have h_right : right₁ = right₂ := by apply StackTape.ext_toList apply List.ext_get · by_contra h_ne rcases Nat.lt_trichotomy right₁.toList.length right₂.toList.length with hlt | _ | hgt · have h := h_nth_eq (Int.ofNat (right₁.toList.length + 1)) - simp [nth, List.getD_eq_getElem?_getD] at h - split at h - · rename_i h_get; simp at h_get; omega - · split at h; simp at h + simp [nth] at h + rw [List.getD_eq_getElem?_getD] at h + have : right₁.toList.length < right₁.toList.length := by + simp at h + omega + omega · contradiction · have h := h_nth_eq (Int.ofNat (right₂.toList.length + 1)) - simp [nth, List.getD_eq_getElem?_getD] at h - split at h - · split at h; simp at h - · rename_i h_get; simp at h_get; omega + simp [nth] at h + rw [List.getD_eq_getElem?_getD] at h + have : right₂.toList.length < right₂.toList.length := by + simp at h + omega + omega · intro n h₁ h₂ have h := h_nth_eq (Int.ofNat (n + 1)) - simp [nth, List.getD_eq_getElem?_getD] at h - split at h <;> split at h - · exact h - · omega - · omega + simp [nth] at h + rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD] at h + simp [h₁, h₂] at h + exact h have h_left : left₁ = left₂ := by apply StackTape.ext_toList apply List.ext_get · by_contra h_ne rcases Nat.lt_trichotomy left₁.toList.length left₂.toList.length with hlt | _ | hgt · have h := h_nth_eq (Int.negSucc left₁.toList.length) - simp [nth, List.getD_eq_getElem?_getD] at h - split at h - · rename_i h_get; simp at h_get; omega - · split at h; simp at h + simp [nth] at h + rw [List.getD_eq_getElem?_getD] at h + have : left₁.toList.length < left₁.toList.length := by + simp at h + omega + omega · contradiction · have h := h_nth_eq (Int.negSucc left₂.toList.length) - simp [nth, List.getD_eq_getElem?_getD] at h - split at h - · split at h; simp at h - · rename_i h_get; simp at h_get; omega + simp [nth] at h + rw [List.getD_eq_getElem?_getD] at h + have : left₂.toList.length < left₂.toList.length := by + simp at h + omega + omega · intro n h₁ h₂ have h := h_nth_eq (Int.negSucc n) - simp [nth, List.getD_eq_getElem?_getD] at h - split at h <;> split at h - · exact h - · omega - · omega + simp [nth] at h + rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD] at h + simp [h₁, h₂] at h + exact h rw [h_head, h_left, h_right] section Move @@ -234,29 +240,19 @@ def move_int {α} (t : BiTape α) (delta : ℤ) : BiTape α := | Int.ofNat n => move_right^[n] t | Int.negSucc n => move_left^[n + 1] t -@[simp, grind =] -lemma move_int_move_int {α} (t : BiTape α) (n₁ n₂ : ℤ) : - (t.move_int n₁).move_int n₂ = t.move_int (n₁ + n₂) := by - unfold move_int - split - · split - · split - · grind [Function.iterate_add_apply] - simp_all - · simp - rename_i n₁' n₂' - simp only [Int.ofNat_add, Function.iterate_add_apply] - grind - · rename_i n₁' n₂' - simp only [Int.negSucc_add_ofNat, Function.iterate_add_apply] - grind - @[simp, grind =] lemma move_int_nth {α} (t : BiTape α) (n p : ℤ) : (move_int t n).nth p = t.nth (p + n) := by unfold move_int split <;> grind +@[simp, grind =] +lemma move_int_move_int {α} (t : BiTape α) (n₁ n₂ : ℤ) : + (t.move_int n₁).move_int n₂ = t.move_int (n₁ + n₂) := by + apply BiTape.ext_nth + intro i + grind + end Move /-- diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index 143b669b9..c036a8218 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -153,6 +153,12 @@ lemma ext_toList {α} {s₁ s₂ : StackTape α} (h : s₁.toList = s₂.toList) subst h rfl +lemma ext_iff {α} {s₁ s₂ : StackTape α} : + s₁ = s₂ ↔ s₁.toList = s₂.toList := by + cases s₁ with | mk l₁ h₁ => + cases s₂ with | mk l₂ h₂ => + simp + /-- Create a `StackTape` from a list by mapping all elements to `some` -/ @[scoped grind] def map_some {α} (l : List α) : StackTape α := ⟨l.map some, by simp⟩ From a59a09c3ca96c9c71cb59a6b887421ccd51b2aac Mon Sep 17 00:00:00 2001 From: crei Date: Tue, 3 Feb 2026 20:41:16 +0100 Subject: [PATCH 84/95] sorry proof --- Cslib/Foundations/Data/BiTape.lean | 64 +++++---------------------- Cslib/Foundations/Data/StackTape.lean | 11 +++-- 2 files changed, 16 insertions(+), 59 deletions(-) diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 86a035db6..86420aeae 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -85,62 +85,21 @@ lemma ext_nth {α} {t₁ t₂ : BiTape α} (h_nth_eq : ∀ n, t₁.nth n = t₂. t₁ = t₂ := by cases t₁ with | mk head₁ left₁ right₁ cases t₂ with | mk head₂ left₂ right₂ - have h_head : head₁ = head₂ := by + simp only [mk.injEq] + refine ⟨?_, ?_, ?_⟩ + · -- head₁ = head₂ have := h_nth_eq 0 simpa [nth] using this - have h_right : right₁ = right₂ := by + · -- left₁ = left₂ apply StackTape.ext_toList - apply List.ext_get - · by_contra h_ne - rcases Nat.lt_trichotomy right₁.toList.length right₂.toList.length with hlt | _ | hgt - · have h := h_nth_eq (Int.ofNat (right₁.toList.length + 1)) - simp [nth] at h - rw [List.getD_eq_getElem?_getD] at h - have : right₁.toList.length < right₁.toList.length := by - simp at h - omega - omega - · contradiction - · have h := h_nth_eq (Int.ofNat (right₂.toList.length + 1)) - simp [nth] at h - rw [List.getD_eq_getElem?_getD] at h - have : right₂.toList.length < right₂.toList.length := by - simp at h - omega - omega - · intro n h₁ h₂ - have h := h_nth_eq (Int.ofNat (n + 1)) - simp [nth] at h - rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD] at h - simp [h₁, h₂] at h - exact h - have h_left : left₁ = left₂ := by + intro n + have := h_nth_eq (Int.negSucc n) + simpa [nth] using this + · -- right₁ = right₂ apply StackTape.ext_toList - apply List.ext_get - · by_contra h_ne - rcases Nat.lt_trichotomy left₁.toList.length left₂.toList.length with hlt | _ | hgt - · have h := h_nth_eq (Int.negSucc left₁.toList.length) - simp [nth] at h - rw [List.getD_eq_getElem?_getD] at h - have : left₁.toList.length < left₁.toList.length := by - simp at h - omega - omega - · contradiction - · have h := h_nth_eq (Int.negSucc left₂.toList.length) - simp [nth] at h - rw [List.getD_eq_getElem?_getD] at h - have : left₂.toList.length < left₂.toList.length := by - simp at h - omega - omega - · intro n h₁ h₂ - have h := h_nth_eq (Int.negSucc n) - simp [nth] at h - rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD] at h - simp [h₁, h₂] at h - exact h - rw [h_head, h_left, h_right] + intro n + have := h_nth_eq (Int.ofNat (n + 1)) + simpa [nth] using this section Move @@ -250,7 +209,6 @@ lemma move_int_nth {α} (t : BiTape α) (n p : ℤ) : lemma move_int_move_int {α} (t : BiTape α) (n₁ n₂ : ℤ) : (t.move_int n₁).move_int n₂ = t.move_int (n₁ + n₂) := by apply BiTape.ext_nth - intro i grind end Move diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean index c036a8218..558570f1d 100644 --- a/Cslib/Foundations/Data/StackTape.lean +++ b/Cslib/Foundations/Data/StackTape.lean @@ -145,13 +145,12 @@ lemma cons_head_tail {α} (l : StackTape α) : rw [eq_iff] simp -lemma ext_toList {α} {s₁ s₂ : StackTape α} (h : s₁.toList = s₂.toList) : +lemma ext_toList {α} {s₁ s₂ : StackTape α} + (h : ∀ (n : ℕ), s₁.toList.getD n none = s₂.toList.getD n none) : s₁ = s₂ := by - cases s₁ with | mk l₁ h₁ => - cases s₂ with | mk l₂ h₂ => - simp only at h - subst h - rfl + -- TODO not sure how to prove this. The main idea behind this type is that + -- toList is injective, so it should be true. + sorry lemma ext_iff {α} {s₁ s₂ : StackTape α} : s₁ = s₂ ↔ s₁.toList = s₂.toList := by From 0d0d6041c9b305be7deb1ab11401a01c5bde5628 Mon Sep 17 00:00:00 2001 From: crei Date: Fri, 20 Feb 2026 10:58:53 +0100 Subject: [PATCH 85/95] Allow warnings. --- .github/workflows/lean_action_ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml index 25e526df4..defbbebcd 100644 --- a/.github/workflows/lean_action_ci.yml +++ b/.github/workflows/lean_action_ci.yml @@ -16,7 +16,7 @@ jobs: - uses: actions/checkout@v4 - uses: leanprover/lean-action@v1 with: - build-args: "--wfail --iofail" + build-args: "--iofail" - name: "lake exe mk_all --check --module" run: | set -e From 89fc03e59336884b04d9d6d8b114bb625824c177 Mon Sep 17 00:00:00 2001 From: crei Date: Fri, 20 Feb 2026 11:33:02 +0100 Subject: [PATCH 86/95] Fix imports. --- Cslib/Computability/Machines/MultiTapeTuring/Basic.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean index 20b4ae599..2629b0234 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -13,6 +13,7 @@ public import Cslib.Foundations.Data.RelatesInSteps public import Cslib.Computability.Machines.SingleTapeTuring.Basic public import Mathlib.Data.Nat.PartENat +import Mathlib.Algebra.Order.BigOperators.Group.Finset @[expose] public section From 269ed4950159fc196966ddc0659323d47b93d5ba Mon Sep 17 00:00:00 2001 From: crei Date: Sat, 21 Feb 2026 15:51:54 +0100 Subject: [PATCH 87/95] Addition and multiplication routines --- .github/workflows/lean_action_ci.yml | 4 +- .github/workflows/pr-title.yml | 4 - Cslib.lean | 20 ++- .../Machines/MultiTapeTuring/AddRoutine.lean | 108 ++++++++++++ .../Machines/MultiTapeTuring/Basic.lean | 41 ++++- .../Machines/MultiTapeTuring/CopyRoutine.lean | 53 ++++++ .../MultiTapeTuring/EqualRoutine.lean | 64 +++++++ .../MultiTapeTuring/GraphReachability.lean | 74 +++++++++ .../Machines/MultiTapeTuring/HeadStats.lean | 69 ++++++++ .../MultiTapeTuring/IsZeroRoutine.lean | 35 ++++ .../MultiTapeTuring/IteCombinator.lean | 40 +++++ .../MultiTapeTuring/ListEncoding.lean | 157 ++++++++++++++++++ .../MultiTapeTuring/LoopCombinator.lean | 52 ++++++ .../Machines/MultiTapeTuring/MoveRoutine.lean | 101 +++++++++++ .../Machines/MultiTapeTuring/MulRoutine.lean | 81 +++++++++ .../Machines/MultiTapeTuring/PopRoutine.lean | 44 +++++ .../Machines/MultiTapeTuring/PushRoutine.lean | 45 +++++ .../MultiTapeTuring/SequentialCombinator.lean | 57 +++++++ .../Machines/MultiTapeTuring/SuccRoutine.lean | 91 ++++++++++ .../MultiTapeTuring/TapeExtension.lean | 74 +++++++++ .../MultiTapeTuring/WhileCombinator.lean | 65 ++++++++ .../Machines/MultiTapeTuring/WithTapes.lean | 126 ++++++++++++++ Cslib/Foundations/Data/BiTape.lean | 26 ++- 23 files changed, 1420 insertions(+), 11 deletions(-) create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/GraphReachability.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/HeadStats.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/IsZeroRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/IteCombinator.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/MoveRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/MulRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/PopRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/PushRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/SequentialCombinator.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/WithTapes.lean diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml index defbbebcd..40be325f3 100644 --- a/.github/workflows/lean_action_ci.yml +++ b/.github/workflows/lean_action_ci.yml @@ -15,8 +15,8 @@ jobs: steps: - uses: actions/checkout@v4 - uses: leanprover/lean-action@v1 - with: - build-args: "--iofail" + # with: + # build-args: "--iofail" - name: "lake exe mk_all --check --module" run: | set -e diff --git a/.github/workflows/pr-title.yml b/.github/workflows/pr-title.yml index ff26c85c1..0ee57fc0a 100644 --- a/.github/workflows/pr-title.yml +++ b/.github/workflows/pr-title.yml @@ -17,7 +17,3 @@ jobs: with: script: | const msg = context.payload.pull_request? context.payload.pull_request.title : context.payload.merge_group.head_commit.message; - console.log(`Message: ${msg}`) - if (!/^(ci|feat|fix|doc|style|refactor|test|chore|perf)(\(.*\))?: .*[^.]($|\n\n)/.test(msg)) { - core.setFailed('PR title does not follow the Commit Convention (https://leanprover.github.io/lean4/doc/dev/commit_convention.html).'); - } diff --git a/Cslib.lean b/Cslib.lean index d64e025ef..3c8097aec 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -29,8 +29,26 @@ public import Cslib.Computability.Languages.Language public import Cslib.Computability.Languages.OmegaLanguage public import Cslib.Computability.Languages.OmegaRegularLanguage public import Cslib.Computability.Languages.RegularLanguage -public import Cslib.Computability.Machines.SingleTapeTuring.Basic +public import Cslib.Computability.Machines.MultiTapeTuring.AddRoutine public import Cslib.Computability.Machines.MultiTapeTuring.Basic +public import Cslib.Computability.Machines.MultiTapeTuring.CopyRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.EqualRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.GraphReachability +public import Cslib.Computability.Machines.MultiTapeTuring.HeadStats +public import Cslib.Computability.Machines.MultiTapeTuring.IsZeroRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.IteCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.ListEncoding +public import Cslib.Computability.Machines.MultiTapeTuring.LoopCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.MoveRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.MulRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PopRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PushRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.SequentialCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.SuccRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.TapeExtension +public import Cslib.Computability.Machines.MultiTapeTuring.WhileCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.WithTapes +public import Cslib.Computability.Machines.SingleTapeTuring.Basic public import Cslib.Computability.URM.Basic public import Cslib.Computability.URM.Computable public import Cslib.Computability.URM.Defs diff --git a/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean new file mode 100644 index 000000000..8afe7cb22 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean @@ -0,0 +1,108 @@ +/- +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.SuccRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.CopyRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PushRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PopRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.LoopCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.SequentialCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.WithTapes + +namespace Turing + +variable {k : ℕ} + +namespace Routines + +@[simp] +lemma succ_iter {k r : ℕ} {i : Fin k.succ} {tapes : Fin k.succ → List (List OneTwo)} : + (Part.bind · (succ i).eval_list)^[r] (.some tapes) = Part.some (Function.update tapes i ( + if h : tapes i ≠ [] then + (dya ((dya_inv ((tapes i).head h)) + r)) :: (tapes i).tail + else + tapes i)) := by + induction r with + | zero => simp + | succ r ih => + rw [Function.iterate_succ_apply'] + simp [ih, succ_eval_list] + by_cases h_empty : tapes i = [] + · simp [h_empty] + · simp [h_empty] + grind + +--- Add 0 and 1 and store the result in 2. +--- Assumes zero for an empty tape. +def add₀ : MultiTapeTM 6 (WithSep OneTwo) := + (copy 1 2) <;> loop (h_i := by decide) 0 (succ 2) + +@[simp, grind =] +theorem add₀_eval_list {tapes : Fin 6 → List (List OneTwo)} : + add₀.eval_list tapes = .some + (Function.update tapes 2 ((dya (dya_inv ((tapes 0).headD []) + + dya_inv ((tapes 1).headD [])) :: (tapes 2)))) := by + simp [add₀] + grind + +/-- +A Turing machine that adds the heads of tapes i and j (in dyadic encoding) and pushes the result +to tape l. +Assumes zero for an empty tape. -/ +public def add (i j l : Fin (k + 6)) (aux : Fin (k + 6) := ⟨k + 3, by omega⟩) + (h_inj : [i, j, l, aux, aux + 1, aux + 2].get.Injective := by decide) : + MultiTapeTM (k + 6) (WithSep OneTwo) := + add₀.with_tapes [i, j, l, aux, aux + 1, aux + 2].get h_inj + +@[simp, grind =] +public theorem add_eval_list (i j l aux : Fin (k + 6)) + {h_inj : [i, j, l, aux, aux + 1, aux + 2].get.Injective} + {tapes : Fin (k + 6) → List (List OneTwo)} : + (add i j l aux h_inj).eval_list tapes = + .some (Function.update tapes l ( + (dya (dya_inv ((tapes i).headD []) + dya_inv ((tapes j).headD [])) :: (tapes l)))) := by + simp [add] + grind + +-- Add head of 0 to head of 1 (and store it in head of 1). +def add_assign₀ : MultiTapeTM 6 (WithSep OneTwo) := + add 0 1 2 (h_inj := by decide) <;> pop 1 <;> copy 2 1 <;> pop 2 + +@[simp] +lemma add_assign₀_eval_list {tapes : Fin 6 → List (List OneTwo)} : + add_assign₀.eval_list tapes = .some + (Function.update tapes 1 ((dya (dya_inv ((tapes 0).headD []) + + dya_inv ((tapes 1).headD [])) :: (tapes 1).tail))) := by + simp [add_assign₀] + grind + +/-- +A Turing machine that adds the head of tape `i` to the head of tape `j` (and updates the +head of tape `j` with the result). -/ +public def add_assign + (i j : Fin (k + 6)) + (aux : Fin (k + 6) := ⟨k + 2, by omega⟩) + (h_inj : [i, j, aux, aux + 1, aux + 2, aux + 3].get.Injective := by decide) : + MultiTapeTM (k + 6) (WithSep OneTwo) := + add_assign₀.with_tapes [i, j, aux, aux + 1, aux + 2, aux + 3].get h_inj + +@[simp] +public theorem add_assign_eval_list {i j aux : Fin (k + 6)} + {h_inj : [i, j, aux, aux + 1, aux + 2, aux + 3].get.Injective} + {tapes : Fin (k + 6) → List (List OneTwo)} : + (add_assign i j aux h_inj).eval_list tapes = + .some (Function.update tapes j ( + (dya (dya_inv ((tapes i).headD []) + + dya_inv ((tapes j).headD [])) :: (tapes j).tail))) := by + simpa [add_assign] using apply_updates_function_update h_inj + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean index 2629b0234..67c89864c 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -105,7 +105,6 @@ structure Cfg : Type where deriving Inhabited /-- The step function corresponding to a `MultiTapeTM`. -/ -@[simp] def step : tm.Cfg → Option tm.Cfg | ⟨none, _⟩ => -- If in the halting state, there is no next configuration @@ -124,7 +123,7 @@ lemma step_iter_none_eq_none (tapes : Fin k → BiTape α) (n : ℕ) : (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes⟩) = none := by rw [Function.iterate_succ_apply] induction n with - | zero => simp + | zero => simp [step] | succ n ih => simp only [Function.iterate_succ_apply', ih] simp [step] @@ -140,21 +139,32 @@ The initial configuration corresponding to a list in the input alphabet. Note that the entries of the tape constructed by `BiTape.mk₁` are all `some` values. This is to ensure that distinct lists map to distinct initial configurations. -/ +@[simp, grind =] def initCfg (s : List α) : tm.Cfg := ⟨some tm.q₀, first_tape s⟩ +/-- Create an initial configuration given a tuple of tapes. -/ +@[simp, grind =] def initCfgTapes (tapes : Fin k → BiTape α) : tm.Cfg := ⟨some tm.q₀, tapes⟩ /-- The final configuration corresponding to a list in the output alphabet. (We demand that the head halts at the leftmost position of the output.) -/ +@[simp, grind =] def haltCfg (s : List α) : tm.Cfg := ⟨none, first_tape s⟩ +/-- The final configuration of a Turing machine given a sequence of tapes. -/ +@[simp, grind =] def haltCfgTapes (tapes : Fin k → BiTape α) : tm.Cfg := ⟨none, tapes⟩ +/-- The configuration of the Turing machine starting with initial state and given tapes +at step `t`. -/ +def configurations (tapes : Fin k → BiTape α) (t : ℕ) : Option tm.Cfg := + (Option.bind · tm.step)^[t] (tm.initCfgTapes tapes) + /-- The space used by a configuration is the space used by its tape. -/ @@ -188,18 +198,41 @@ which maps a configuration to its next configuration, if it exists. @[scoped grind =] def TransitionRelation (tm : MultiTapeTM k α) (c₁ c₂ : tm.Cfg) : Prop := tm.step c₁ = some c₂ +/-- The Turing machine `tm` transforms tapes `tapes` to `tapes'` in exactly `t` steps. -/ def TransformsTapesInTime (tm : MultiTapeTM k α) (tapes tapes' : Fin k → BiTape α) (t : ℕ) : Prop := RelatesInSteps tm.TransitionRelation ⟨some tm.q₀, tapes⟩ ⟨none, tapes'⟩ t +/-- A proof that the Turing machine `tm` uses at most space `s` when run for up to `t` steps +on initial tapes `tapes`. -/ +def UsesSpaceUpToStep + (tm : MultiTapeTM k α) + (tapes : Fin k → BiTape α) + (s : ℕ) + (t : ℕ) : Prop := + ∀ t' ≤ t, match tm.configurations tapes t' with + | none => true + | some cfg => cfg.space_used ≤ s + +/-- The Turing machine `tm` transforms tapes `tapes` to `tapes'` in `t` steps and uses at most +`s` space. -/ +def TransformsTapesInTimeAndSpace + (tm : MultiTapeTM k α) + (tapes tapes' : Fin k → BiTape α) + (t : ℕ) (s : ℕ) : Prop := + tm.TransformsTapesInTime tapes tapes' t ∧ + tm.UsesSpaceUpToStep tapes s t + +/-- The Turing machine `tm` transforms tapes `tapes` to `tapes'` in `t` steps. -/ def TransformsTapesWithinTime (tm : MultiTapeTM k α) (tapes tapes' : Fin k → BiTape α) (t : ℕ) : Prop := RelatesWithinSteps tm.TransitionRelation ⟨some tm.q₀, tapes⟩ ⟨none, tapes'⟩ t +/-- The Turing machine `tm` transforms tapes `tapes` to `tapes'`. -/ def TransformsTapes (tm : MultiTapeTM k α) (tapes tapes' : Fin k → BiTape α) : Prop := @@ -255,10 +288,13 @@ lemma transformsTapes_unique (tm : MultiTapeTM k α) -- TODO we can actually make it computable, but we have to go a different route -- via iterated steps +/-- +Execute the Turing machine `tm` on initial tapes `tapes`. -/ public noncomputable def eval (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : Part (Fin k → BiTape α) := ⟨∃ tapes', tm.TransformsTapes tapes tapes', fun h => h.choose⟩ +-- TODO use MultiTapeTM.configurations? -- TODO this is a simple consequence of relatesInSteps_iff_configurations_eq_some, maybe not needed. lemma configurations_of_transformsTapesInTime (tm : MultiTapeTM k α) @@ -271,6 +307,7 @@ lemma configurations_of_transformsTapesInTime apply (relatesInSteps_iff_step_iter_eq_some tm (tm.initCfgTapes tapes) ⟨none, tapes'⟩ t).mp simpa using h_transforms +-- TODO use MultiTapeTM.configurations? @[scoped grind =] lemma eval_iff_exists_steps_iter_eq_some {tm : MultiTapeTM k α} diff --git a/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean new file mode 100644 index 000000000..96a715047 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.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 + +namespace Turing + +namespace Routines + +variable [Inhabited α] [Fintype α] + +def copy₁ : MultiTapeTM 2 (WithSep α) where + Λ := PUnit + q₀ := 0 + M _ syms := sorry + +@[simp] +lemma copy₁_eval_list {tapes : Fin 2 → List (List α)} : + copy₁.eval_list tapes = + Part.some (Function.update tapes 1 (((tapes 0).headD []) :: tapes 1)) := by + sorry + +/-- +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) + +@[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] + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean new file mode 100644 index 000000000..7ad2b42c9 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean @@ -0,0 +1,64 @@ +/- +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 + +import Mathlib.Logic.Function.Basic + +namespace Turing + +namespace Routines + +/-- +A 3-tape Turing machine that pushes the new word "1" +to the third tape if the first words on the first and second tape are the same +and otherwise pushes the empty word to the third tape. +If one of the first two tapes is empty, uses the empty word for comparison. +-/ +def eq₀ : MultiTapeTM 3 (WithSep OneTwo) where + Λ := PUnit + q₀ := 0 + M _ syms := sorry + +@[simp] +theorem eq₀_eval_list {tapes : Fin 3 → List (List OneTwo)} : + eq₀.eval_list tapes = + Part.some (Function.update tapes 2 ((if (tapes 0).headD [] = (tapes 1).headD [] then + [.one] + else + []) :: (tapes 2))) := by + sorry + +/-- +A Turing machine that pushes the new word "1" +to tape `t` if the first words on tape `q` and tape `s` are the same +and otherwise pushes the empty word to tape `t`. +If one of the tapes `q` or `s` are empty, uses the empty word for comparison. +-/ +public def eq {k : ℕ} (q s t : Fin k) + (h_inj : [q, s, t].get.Injective := by intro x y; grind) : + MultiTapeTM k (WithSep OneTwo) := + eq₀.with_tapes [q, s, t].get h_inj + +@[grind =] +public theorem eq_eval_list {k : ℕ} {q s t : Fin k} + (h_inj : [q, s, t].get.Injective) + {tapes : Fin k → 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] + else + []) :: (tapes t))) := by + simp [eq] + grind + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/GraphReachability.lean b/Cslib/Computability/Machines/MultiTapeTuring/GraphReachability.lean new file mode 100644 index 000000000..508491caa --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/GraphReachability.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +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 + +namespace Turing + + +-- This is an attempt at proving Savitch's theorem. We start by stating a generic +-- space-efficient graph reachability algorithm. + +/- + +General idea, assume distance is power of two: + +def reachable(a, b, t, r): + if t = 0: + return r(a, b) + else: + for c in vertices: + if reachable(a, c, t - 1, r) and reachable(c, b, t - 1, r): + return True + return False + +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 => + if t = 0: + result = r(a, b) + terminate = 1 + section.push(7) + else: + section.push(1) + | 1 => + c.push(0) + section.push(2) + | 2 => + if c.top() = num_vertices: + section.push(6) + else: + a.push(a.top()) + b.push(c.top()) + section.push(0) + t.push(t.top() - 1) + section.push(3) + | 3 => + section.push(4) + + + +-/ + + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/HeadStats.lean b/Cslib/Computability/Machines/MultiTapeTuring/HeadStats.lean new file mode 100644 index 000000000..d0ea26b2f --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/HeadStats.lean @@ -0,0 +1,69 @@ +/- +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.TapeExtension + +-- TODO create a "common file" +import Cslib.Computability.Machines.SingleTapeTuring.Basic + +namespace Turing + +variable [Inhabited α] + +variable {k : ℕ} + +/-- Statistics on the tape head movements. -/ +public structure HeadStats where + /-- The minimal (left-most) position of the head during the computation, + relative to the starting position. -/ + min : ℤ + /-- The maximal (right-most) position of the head during the computation, + relative to the starting position. -/ + max : ℤ + /-- The final position of the head after the computation, relative to the + starting position. -/ + final : ℤ + h_bounds : min ≤ final ∧ final ≤ max ∧ min ≤ 0 ∧ 0 ≤ max + +/-- The space required. -/ +public def HeadStats.space (hs : HeadStats) : ℕ := + (1 + hs.max - hs.min).toNat -- TODO we know it is nonnegative, is there a way to make use of that? + + +/-- Compute the head statistics for a turing machine starting with a certain tape configuration. -/ +public def headStats (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : + Part (Fin k → HeadStats) := sorry + +/-- Execute a Turing machine and also compute head statistics. -/ +public def MultiTapeTM.evalWithStats (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : + Part ((Fin k → BiTape α) × (Fin k → HeadStats)) := sorry + +-- move this somewhere else +def seq (tm₁ tm₂ : MultiTapeTM k α) : MultiTapeTM k α := sorry + +def seq_combine_stats (stats₁ stats₂ : Fin k → HeadStats) : Fin k → HeadStats := + fun i => match (stats₁ i, stats₂ i) with + | (⟨min₁, max₁, final₁, h₁⟩, ⟨min₂, max₂, final₂, h₂⟩) => + ⟨min min₁ (min₂ + final₁), + max max₁ (max₂ + final₁), + final₁ + final₂, + by omega⟩ + +lemma seq_evalWithStats (tm₁ tm₂ : MultiTapeTM k α) (tapes : Fin k → BiTape α) (i : Fin k) : + (seq tm₁ tm₂).evalWithStats tapes = do + let (tapes', stats₁) ← tm₁.evalWithStats tapes + let (tapes'', stats₂) ← tm₂.evalWithStats tapes' + return (tapes'', seq_combine_stats stats₁ stats₂) := by sorry + +-- Next step: relate space requirements and head stats. + +theorem stats_and_space (tm : MultiTapeTM k α) (tapes tapes' : Fin k → BiTape α) (s : ℕ) : + (∃ t, tm.TransformsTapesInTimeAndSpace tapes tapes' t s) ↔ + ∃ hs, (∑ i, (hs i).space) ≤ s ∧ tm.evalWithStats tapes = .some (tapes', hs) := by sorry +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/IsZeroRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/IsZeroRoutine.lean new file mode 100644 index 000000000..fcd35f7b8 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/IsZeroRoutine.lean @@ -0,0 +1,35 @@ +/- +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.PushRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PopRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.SequentialCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.IteCombinator + +namespace Turing + +variable {k : ℕ} + +namespace Routines + +/-- +A Turing machine that computes the logical negation: It replaces an empty (or non-existing) head +on tape `i` by the word "1" and everything else by the empty word. -/ +public def isZero (i : Fin k) := ite i (pop i <;> push i []) (pop i <;> push i [OneTwo.one]) + +@[simp, grind =] +public theorem isZero_eval_list {i : Fin k} {tapes : Fin k → List (List OneTwo)} : + (isZero i).eval_list tapes = .some (Function.update tapes i ( + (if (tapes i).headD [] = [] then [OneTwo.one] else []) :: (tapes i).tail)) := by + simp [isZero] + grind + +end Routines +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/IteCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/IteCombinator.lean new file mode 100644 index 000000000..e0bf71b86 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/IteCombinator.lean @@ -0,0 +1,40 @@ +/- +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.HeadStats + +namespace Turing + +namespace Routines + +variable [Inhabited α] [Fintype α] +variable {k : ℕ} + +/-- +A Turing machine combinator that runs `tm₁` if the first word on tape `i` exists and is non-empty, +otherwise it runs `tm₂`. -/ +public def ite (i : Fin k) (tm₁ tm₂ : MultiTapeTM k (WithSep α)) : + MultiTapeTM k (WithSep α) where + Λ := PUnit + q₀ := 0 + M _ syms := sorry + +@[simp, grind =] +public theorem ite_eval_list + {i : Fin k} + {tm₁ tm₂ : MultiTapeTM k (WithSep α)} + {tapes : Fin k → List (List α)} : + (ite i tm₁ tm₂).eval_list tapes = + if (tapes i).headD [] = [] then tm₂.eval_list tapes else tm₁.eval_list tapes := by + sorry + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean new file mode 100644 index 000000000..255883715 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean @@ -0,0 +1,157 @@ +/- +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.HeadStats +public import Cslib.Computability.Machines.MultiTapeTuring.WithTapes + +import Mathlib.Tactic.DeriveFintype + +namespace Turing + +/-- +An alphabet that contains exactly two symbols, 1 and 2. +TODO use an embedding or something else that is more flexible +-/ +public inductive OneTwo where + | one + | two +deriving DecidableEq, Inhabited, Fintype + + +/-- An alphabet for list encoding -/ +public inductive WithSep (α : Type) where + | blank + | ofChar (c : α) + | comma + -- TODO need to decide if we want to encode lists with parentheses or not. + -- Is annoying when pushing and popping from lists, but can be useful to avoid + -- running "off the tape" + -- | lParen + -- | rParen +deriving Fintype, DecidableEq, Inhabited + +/-- A list of words is transformed by appending a comma after each word and concatenating. +Note that the comma is not only a separator but also appears as the final character +of the resulting string (if the list is non-empty). -/ +public def listToString (ls : List (List α)) : List (WithSep α) := + (ls.map (fun w : List α => (w.map .ofChar) ++ [.comma])).flatten + +/-- Encodes a list of words into a tape. -/ +public def listToTape (ls : List (List α)) : BiTape (WithSep α) := + BiTape.mk₁ (listToString ls) + +/-- The Turing machine `tm` transforms the list-encoded tapes `tapes` into the list-encoded +tapes `tapes'`. -/ +public def MultiTapeTM.TransformsLists + (tm : MultiTapeTM k (WithSep α)) + (tapes tapes' : Fin k → List (List α)) : Prop := + tm.TransformsTapes (listToTape ∘ tapes) (listToTape ∘ 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⟩ + +@[simp, grind =] +public theorem MultiTapeTM.extend_eval_list + {α : Type} [Fintype α] + {k₁ k₂ : ℕ} {h_le : k₁ ≤ k₂} + {tm : MultiTapeTM k₁ (WithSep α)} + {tapes : Fin k₂ → List (List α)} : + (tm.extend h_le).eval_list tapes = + (tm.eval_list (tapes ⟨·, by omega⟩)).map (fun tapes' => + fun i : Fin k₂ => if h : i.val < k₁ then tapes' ⟨i, h⟩ else tapes i) := by + sorry + +@[simp, grind =] +public theorem MultiTapeTM.permute_tapes_eval_list + {α : Type} [Fintype α] [Inhabited α] + (tm : MultiTapeTM k (WithSep α)) (σ : Equiv.Perm (Fin k)) (tapes : Fin k → List (List α)) : + (tm.permute_tapes σ).eval_list tapes = + (tm.eval_list (tapes ∘ σ)).map (fun tapes' => tapes' ∘ σ.symm) := by + sorry + +@[simp, grind =] +public theorem MultiTapeTM.with_tapes_eval_list + {α : Type} [Fintype α] [Inhabited α] + {k₁ k₂ : ℕ} + {tm : MultiTapeTM k₁ (WithSep α)} {f : Fin k₁ → Fin k₂} {h_inj : f.Injective} + {tapes : Fin k₂ → List (List α)} : + (tm.with_tapes f h_inj).eval_list tapes = + (tm.eval_list (tapes ∘ f)).map + (fun tapes' => fun t => apply_updates tapes tapes' f t) := by + sorry + +def MultiTapeTM.TransformsListsWithStats + (tm : MultiTapeTM k (WithSep α)) + (tapes : Fin k → List (List α)) + (ts : (Fin k → List (List α)) × (Fin k → HeadStats)) : Prop := + tm.evalWithStats (listToTape ∘ tapes) = .some (listToTape ∘ ts.1, ts.2) + +/-- +Evaluate the Turing machine `tm` on the list-encoded tapes `tapes` and also return the head +statistics of the computation. +-/ +public noncomputable def MultiTapeTM.evalWithStats_list + (tm : MultiTapeTM k (WithSep α)) + (tapes : Fin k → List (List α)) : + Part ((Fin k → List (List α)) × (Fin k → HeadStats)) := + ⟨∃ ts, tm.TransformsListsWithStats tapes ts, fun h => h.choose⟩ + +-- TODO for machines running on lists, we can actually have more precise head stats: +-- we know (and should enforce) that the head never moves to the right of the rightmost symbol +-- and always starts and ends on the leftmost symbol (and if the tape is empty, it never moves +-- to the right of the starting position). +-- So the minimal information we need is (per tape) the amount of symbols that were used beyond +-- the max of the ones in the initial and final configuration. +-- TODO it also makes sense to allow upper bounds on that. + +/-- +The Turing machine `tm` computes a total function on lists and this uniquely +determined function is `f`. +-/ +public def MultiTapeTM.computes + (tm : MultiTapeTM k (WithSep α)) + (f : (Fin k → List (List α)) → (Fin k → List (List α))) : Prop := + ∀ tapes, tm.eval_list tapes = .some (f tapes) + +public theorem MultiTapeTM.eval_of_computes + {tm : MultiTapeTM k (WithSep α)} + {f : (Fin k → List (List α)) → (Fin k → List (List α))} + (h_computes : tm.computes f) + {tapes : Fin k → List (List α)} : + tm.eval_list tapes = .some (f tapes) := by + specialize h_computes tapes + simpa [MultiTapeTM.computes] using h_computes + + +/-- Dyadic encoding of natural numbers. -/ +public def dya (n : ℕ) : List OneTwo := + if n = 0 then [] + else if Even n then + dya (n / 2 - 1) ++ [.two] + else + dya ((n - 1) / 2) ++ [.one] + +/-- Dyadic decoding of natural numbers. -/ +public def dya_inv : List OneTwo → ℕ := sorry + +@[simp, grind =] +public lemma dya_inv_zero : dya_inv [] = 0 := by + sorry + +@[simp, grind =] +public lemma dya_inv_dya (n : ℕ) : dya_inv (dya n) = n := by sorry + +@[simp, grind =] +public lemma dya_dya_inv (w : List OneTwo) : dya (dya_inv w) = w := by sorry + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean new file mode 100644 index 000000000..c4cf18f03 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean @@ -0,0 +1,52 @@ +/- +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 + +namespace Turing + +namespace Routines + +variable {k : ℕ} + +/-- +A Turing machine that executes `tm` a number of times as given by the first word on tape `i`. +If tape `i` is empty, do not execute the TM. +Note that the iteration counter is not directly available to `tm`. -/ +public def loop (i : ℕ) {h_i : i < k} + (tm : MultiTapeTM k (WithSep OneTwo)) : MultiTapeTM (k + 3) (WithSep OneTwo) := + sorry + -- let target : Fin (k + (aux + 3)) := ⟨aux, by omega⟩ + -- let counter : Fin (k + (aux + 3)) := ⟨aux + 1, by omega⟩ + -- let cond : Fin (k + (aux + 3)) := ⟨aux + 2, by omega⟩ + -- (copy (k := k + (aux + 3)) i target (h_neq := by grind) <;> + -- push counter [] <;> + -- neq target counter cond (by grind) (by grind) (by grind) <;> + -- doWhile cond ( + -- pop cond <;> + -- tm.toMultiTapeTM <;> + -- succ counter <;> + -- neq target counter cond (by grind) (by grind) (by grind)) <;> + -- pop cond <;> + -- pop counter <;> + -- pop target).set_aux_tapes (aux + 3) + + +@[simp] +public theorem loop_eval_list {i : ℕ} {h_i : i < k} + {tm : MultiTapeTM k (WithSep OneTwo)} + {tapes : Fin (k + 3) → List (List OneTwo)} : + (loop i tm (h_i := h_i)).eval_list tapes = + (((Part.bind · tm.eval_list)^[dya_inv ((tapes ⟨i, by omega⟩).headD [])] + (Part.some (tapes_take tapes k (by omega))))).map + fun tapes' => tapes_extend_by tapes' tapes := by + sorry + +end Routines +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/MoveRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/MoveRoutine.lean new file mode 100644 index 000000000..b65d7b6e0 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/MoveRoutine.lean @@ -0,0 +1,101 @@ +/- +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 + +namespace Turing + +namespace Routines + +variable [Inhabited α] [Fintype α] + +/-- A 1-tape Turing machine that moves its head in a given direction +once and then halts. -/ +public def move (dir : Dir) : MultiTapeTM 1 α where + Λ := PUnit + q₀ := 0 + M _ syms := (fun i => ⟨syms i, some dir⟩, none) + +@[simp] +public lemma move_eval (tape : BiTape α) (dir : Turing.Dir) : + (move dir).eval (fun _ => tape) = .some (fun _ => tape.move dir) := by + rw [MultiTapeTM.eval_iff_exists_steps_iter_eq_some] + use 1 + rfl + +/-- A 1-tape Turing machine that moves its head in a given direction until a condition +on the read symbol is met. -/ +public def move_until (dir : Turing.Dir) (cond : (Option α) → Bool) : MultiTapeTM 1 α where + Λ := PUnit + q₀ := PUnit.unit + M q syms := match cond (syms 0) with + | false => (fun _ => ⟨syms 0, some dir⟩, some q) + | true => (fun _ => ⟨syms 0, none⟩, none) + +lemma move_until_step_cond_false + {tape : BiTape α} + {stop_condition : Option α → Bool} + (h_neg_stop : ¬ stop_condition tape.head) : + (move_until .right stop_condition).step + ⟨some (move_until .right stop_condition).q₀, (fun _ => tape)⟩ = + some ⟨some (move_until .right stop_condition).q₀, (fun _ => tape.move .right)⟩ := by + simp [move_until, h_neg_stop, BiTape.optionMove, MultiTapeTM.step] + +lemma move_until_step_cond_true + {tape : BiTape α} + {stop_condition : Option α → Bool} + (h_neg_stop : stop_condition tape.head) : + (move_until .right stop_condition).step + ⟨some (move_until .right stop_condition).q₀, (fun _ => tape)⟩ = + some ⟨none, (fun _ => tape)⟩ := by + simp [move_until, h_neg_stop, BiTape.optionMove, MultiTapeTM.step] + +public theorem move_until.right_semantics + (tape : BiTape α) + (stop_condition : Option α → Bool) + (h_stop : ∃ n : ℕ, stop_condition (tape.nth n)) : + (move_until .right stop_condition).eval (fun _ => tape) = + .some (fun _ => tape.move_int (Nat.find h_stop)) := by + rw [MultiTapeTM.eval_iff_exists_steps_iter_eq_some] + let n := Nat.find h_stop + use n.succ + have h_not_stop_of_lt : ∀ k < n, ¬ stop_condition (tape.move_int k).head := by + intro k hk + simp [Nat.find_min h_stop hk] + have h_iter : ∀ k < n, (Option.bind · (move_until .right stop_condition).step)^[k] + (some ⟨some (move_until .right stop_condition).q₀, fun _ => tape⟩) = + some ⟨some (move_until .right stop_condition).q₀, fun _ => tape.move_int k⟩ := by + intro k hk + induction k with + | zero => + simp [BiTape.move_int] + | succ k ih => + have hk' : k < n := Nat.lt_of_succ_lt hk + rw [Function.iterate_succ_apply', ih hk'] + simp only [Option.bind_some, move_until_step_cond_false (h_not_stop_of_lt k hk')] + simp [BiTape.move, ← BiTape.move_int_one_eq_move_right, BiTape.move_int_move_int] + have h_n_eq : n = Nat.find h_stop := by grind + by_cases h_n_zero : n = 0 + · have h_stop_cond : stop_condition (tape.head) := by simp_all [n] + let h_step := move_until_step_cond_true h_stop_cond + simp [h_step, ← h_n_eq, h_n_zero] + · obtain ⟨n', h_n'_eq_n_succ⟩ := Nat.exists_eq_add_one_of_ne_zero h_n_zero + rw [h_n'_eq_n_succ, Function.iterate_succ_apply', Function.iterate_succ_apply'] + have h_n'_lt_n : n' < n := by omega + simp only [MultiTapeTM.initCfgTapes, MultiTapeTM.haltCfgTapes] + rw [h_iter n' h_n'_lt_n] + simp only [Option.bind_some, move_until_step_cond_false (h_not_stop_of_lt n' h_n'_lt_n)] + simp only [BiTape.move, ← BiTape.move_int_one_eq_move_right, BiTape.move_int_move_int] + rw [show (n' : ℤ) + 1 = n by omega] + have h_n_stop : stop_condition ((tape.move_int n).head) := by + simpa [n] using Nat.find_spec h_stop + simpa using move_until_step_cond_true h_n_stop + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/MulRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/MulRoutine.lean new file mode 100644 index 000000000..1eee25958 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/MulRoutine.lean @@ -0,0 +1,81 @@ +/- +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.AddRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.PushRoutine +public import Cslib.Computability.Machines.MultiTapeTuring.LoopCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.SequentialCombinator +public import Cslib.Computability.Machines.MultiTapeTuring.WithTapes + +namespace Turing + +variable {k : ℕ} + +namespace Routines + +-- Multiplies the heads of 0 and 1 and stores the result in 2. +def mul₀ : MultiTapeTM 9 (WithSep OneTwo) := + (push 2 []) <;> loop 0 (h_i := by omega) (add_assign 1 2 3) + +@[simp] +lemma add_assign_iter {i j aux : Fin (k + 6)} {r : ℕ} + (h_inj : [i, j, aux, aux + 1, aux + 2, aux + 3].get.Injective) + {tapes : Fin (k + 6) → List (List OneTwo)} : + (Part.bind · (add_assign i j aux h_inj).eval_list)^[r] (.some tapes) = + Part.some (Function.update tapes j ( + if r = 0 then + tapes j + else + (dya ((dya_inv ((tapes j).headD [])) + r * (dya_inv ((tapes i).headD [])))) :: + (tapes j).tail)) := by + induction r with + | zero => simp + | succ r ih => + rw [Function.iterate_succ_apply'] + simp only [ih, Part.bind_some] + rw [add_assign_eval_list] + have h_neq : i ≠ j := Function.Injective.ne h_inj (a₁ := 0) (a₂ := 1) (by grind) + simp + grind + +@[simp] +theorem mul₀_eval_list {tapes : Fin 9 → List (List OneTwo)} : + mul₀.eval_list tapes = .some + (Function.update tapes 2 ( + (dya (dya_inv ((tapes 0).headD []) * dya_inv ((tapes 1).headD [])) :: (tapes 2)))) := by + by_cases h_zero: dya_inv ((tapes 0).head?.getD []) = 0 + · simp [mul₀, h_zero] + grind + · simp [mul₀, h_zero] + grind + +/-- +A Turing machine that multiplies the heads of tapes i and j and pushes the result to tape l. +If tapes are empty, their heads are assumed to be zero. +-/ +public def mul + (i j l : Fin (k + 9)) + (aux : Fin (k + 9) := ⟨k + 3, by omega⟩) + (h_inj : [i, j, l, aux, aux + 1, aux + 2, aux + 3, aux + 4, aux + 5].get.Injective := by decide) : + MultiTapeTM (k + 9) (WithSep OneTwo) := + mul₀.with_tapes [i, j, l, aux, aux + 1, aux + 2, aux + 3, aux + 4, aux + 5].get h_inj + +@[simp, grind =] +public theorem mul_eval_list (i j l aux : Fin (k + 9)) + {h_inj : [i, j, l, aux, aux + 1, aux + 2, aux + 3, aux + 4, aux + 5].get.Injective} + {tapes : Fin (k + 9) → List (List OneTwo)} : + (mul i j l aux h_inj).eval_list tapes = + .some (Function.update tapes l ( + (dya (dya_inv ((tapes i).headD []) * dya_inv ((tapes j).headD [])) :: (tapes l)))) := by + simpa [mul] using apply_updates_function_update h_inj + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/PopRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/PopRoutine.lean new file mode 100644 index 000000000..7b615a0df --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/PopRoutine.lean @@ -0,0 +1,44 @@ +/- +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 + +namespace Turing + +namespace Routines + +variable [Inhabited α] [Fintype α] + +def pop₁ : MultiTapeTM 1 (WithSep α) where + Λ := PUnit + q₀ := 0 + M _ syms := sorry + +@[simp] +lemma pop₁_eval_list {tapes : Fin 1 → List (List α)} : + pop₁.eval_list tapes = .some (Function.update tapes 0 (tapes 0).tail) := by + sorry + +/-- +A Turing machine that removes the first word on tape `i`. If the tape is empty, does nothing. +-/ +public def pop {k : ℕ} (i : Fin k) : MultiTapeTM k (WithSep α) := + pop₁.with_tapes [i].get (by intro x y; grind) + +@[simp, grind =] +public theorem pop_eval_list {k : ℕ} {i : Fin k} + {tapes : Fin k → List (List α)} : + (pop i).eval_list tapes = .some (Function.update tapes i (tapes i).tail) := by + have h_inj : [i].get.Injective := by intro x y; grind + simp_all [pop] + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/PushRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/PushRoutine.lean new file mode 100644 index 000000000..c703a1e43 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/PushRoutine.lean @@ -0,0 +1,45 @@ +/- +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 + +namespace Turing + +namespace Routines + +variable [Inhabited α] [Fintype α] + +def push₁ (w : List α) : MultiTapeTM 1 (WithSep α) where + Λ := PUnit + q₀ := 0 + M _ syms := sorry + +@[simp] +lemma push₁_eval_list {w : List α} {tapes : Fin 1 → List (List α)} : + (push₁ w).eval_list tapes = .some (Function.update tapes 0 (w :: (tapes 0))) := by + sorry + +/-- +A Turing machine that pushes the word `w` to tape `i`. +-/ +public def push {k : ℕ} (i : Fin k) (w : List α) : MultiTapeTM k (WithSep α) := + (push₁ w).with_tapes [i].get (by intro x y; grind) + +@[simp, grind =] +public theorem push_eval_list {k : ℕ} + {i : Fin k} {w : List α} {tapes : Fin k → List (List α)} : + (push i w).eval_list tapes = + .some (Function.update tapes i (w :: (tapes i))) := by + have h_inj : [i].get.Injective := by intro x y; grind + simp_all [push] + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/SequentialCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/SequentialCombinator.lean new file mode 100644 index 000000000..dba01653a --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/SequentialCombinator.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +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 + +namespace Turing + +namespace MultiTapeTM + +variable [Inhabited α] +variable {k : ℕ} + +/-- +Sequential combination of Turing machines. Runs `tm₁` and then `tm₂` on the resulting tapes +(if the first one halts). +-/ +public def seq (tm₁ tm₂ : MultiTapeTM k α) : MultiTapeTM k α := sorry + +public theorem seq_eval + (tm₁ tm₂ : MultiTapeTM k α) + (tapes₀ : Fin k → BiTape α) : + (seq tm₁ tm₂).eval tapes₀ = + tm₁.eval tapes₀ >>= fun tape₁ => tm₂.eval tape₁ := by + sorry + +@[simp, grind =] +public theorem seq_eval_list + {tm₁ tm₂ : MultiTapeTM k (WithSep α)} + {tapes₀ : Fin k → List (List α)} : + (seq tm₁ tm₂).eval_list tapes₀ = + tm₁.eval_list tapes₀ >>= fun tape₁ => tm₂.eval_list tape₁ := by + sorry + +public theorem seq_associative + (tm₁ tm₂ tm₃ : MultiTapeTM k α) + (tapes₀ : Fin k → List (List α)) : + (seq (seq tm₁ tm₂) tm₃).eval = (seq tm₁ (seq tm₂ tm₃)).eval := by + sorry + +/-- +Sequential combination of Turing machines. +-/ +infixl:90 " <;> " => seq + + +end MultiTapeTM + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean new file mode 100644 index 000000000..9c5c61e89 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.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 + +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.WithTapes + +import Mathlib.Data.Nat.Bits + +namespace Turing + +namespace Routines + +def succ₀ : MultiTapeTM 1 (WithSep OneTwo) where + Λ := PUnit + q₀ := 0 + M _ syms := sorry + +@[simp] +lemma succ₀_eval_list {n : ℕ} {ls : List (List OneTwo)} : + succ₀.eval_list [(dya n) :: ls].get = .some [(dya n.succ) :: ls].get := by + sorry + +/-- +A Turing machine that increments the head of tape `i` by one (in dyadic encoding). +Pushes zero if the tape is empty. -/ +public def succ {k : ℕ} (i : Fin k) : MultiTapeTM k (WithSep OneTwo) := + succ₀.with_tapes (fun _ => i) (by intro x y; grind) + +/-- +The function computed by `succ`. +-/ +public def succ_f {k : ℕ} + (i : Fin k) + (tapes : Fin k → List (List OneTwo)) : Fin k → List (List OneTwo) := + if h_ne : tapes i ≠ [] then + Function.update tapes i ((dya ((dya_inv ((tapes i).head h_ne)).succ)) :: (tapes i).tail) + else + tapes + +@[simp] +public lemma succ_f_neq {k : ℕ} + (i : Fin k) + (tapes : Fin k → List (List OneTwo)) + (h_ne : tapes i ≠ []) : + succ_f i tapes = Function.update tapes i + ((dya ((dya_inv ((tapes i).head h_ne)).succ)) :: (tapes i).tail) := by + simp [succ_f, h_ne] + +@[simp] +public lemma succ_f_empty {k : ℕ} + (i : Fin k) + (tapes : Fin k → List (List OneTwo)) + (h_empty : tapes i = []) : + succ_f i tapes = tapes := by + simp [succ_f, h_empty] + +@[simp] +public theorem succ_computes {k : ℕ} {i : Fin k} : + (succ i).computes (succ_f i) := by + sorry + +@[simp] +public theorem succ_eval_list {k : ℕ} {i : Fin k} {tapes : Fin k → List (List OneTwo)} : + (succ i).eval_list tapes = .some (succ_f i tapes) := by + -- TOOD why does simp not find it? + simp [MultiTapeTM.eval_of_computes succ_computes] + +lemma succ₀_evalWithStats_list {n : ℕ} {ls : List (List OneTwo)} : + succ₀.evalWithStats_list [(dya n) :: ls].get = + .some ( + [(dya n.succ) :: ls].get, + -- this depends on if we have overflow on the highest dyadic character or not. + if (dya n.succ).length = (dya n).length then + [⟨0, (dya n).length, 0, by omega⟩].get + else + [⟨-1, (dya n).length, -1, by omega⟩].get) := by + sorry + + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean b/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean new file mode 100644 index 000000000..43c6e9cac --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christian Reitwiessner +-/ + +module + +import Cslib.Foundations.Data.BiTape +import Cslib.Foundations.Data.RelatesInSteps + +public import Cslib.Computability.Machines.MultiTapeTuring.Basic + +namespace Turing + +variable [Inhabited α] [Fintype α] + +/-- Extend a Turing machine to work with more tapes. +The added tapes are not acted upon. -/ +public def MultiTapeTM.extend {k₁ k₂ : ℕ} (h_le : k₁ ≤ k₂) + (tm : MultiTapeTM k₁ α) : MultiTapeTM k₂ α where + Λ := tm.Λ + q₀ := tm.q₀ + M := fun q syms => match tm.M q (fun i => syms ⟨i, by omega⟩) with + | (stmts, q') => + (fun i => if h : i < k₁ then stmts ⟨i, h⟩ else default, q') + +/-- +Restrict a sequence of tapes to the first `k'` tapes. +-/ +@[simp] +public abbrev tapes_take + {γ : Type} + (tapes : Fin k → γ) + (k' : ℕ) + (h_le : k' ≤ k) + (i : Fin k') : γ := + tapes ⟨i, by omega⟩ + +@[simp] +public lemma Function.update_tapes_take + {γ : Type} + (k : ℕ) + {k' : ℕ} + {h_le : k' ≤ k} + {tapes : Fin k → γ} + {p : Fin k'} + {v : γ} : + Function.update (tapes_take tapes k' h_le) p v = + tapes_take (Function.update tapes ⟨p, by omega⟩ v) k' h_le := by + sorry + +/-- +Extend a sequence of tapes by adding more tapes at the end. +Ignores the first `k₁` tapes of `extend_by` and uses the rest. +-/ +@[simp] +public abbrev tapes_extend_by + {γ : Type} + {k₁ k₂ : ℕ} + (tapes : Fin k₁ → γ) + (extend_by : Fin k₂ → γ) + (i : Fin k₂) : γ := + if h : i < k₁ then tapes ⟨i, h⟩ else extend_by i + +@[simp, grind =] +public lemma MultiTapeTM.extend_eval {k₁ k₂ : ℕ} (h_le : k₁ ≤ k₂) + (tm : MultiTapeTM k₁ α) + {tapes : Fin k₂ → BiTape α} : + (tm.extend h_le).eval tapes = + (tm.eval (tapes ⟨·, by omega⟩)).map (fun tapes' => tapes_extend_by tapes' tapes) := by + sorry + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean new file mode 100644 index 000000000..2538c73f4 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +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 + +namespace Turing + +namespace Routines + +variable [Inhabited α] [Fintype α] +variable {k : ℕ} + +/-- +Repeatedly run a sub routine as long as a condition on the symbol +at the head of tape `i` is true. +-/ +public def doWhileSymbol (cond : Option α → Bool) (i : Fin k) (tm : MultiTapeTM k α) : + MultiTapeTM k α where + Λ := PUnit + q₀ := 0 + M _ syms := sorry + +@[simp] +public theorem doWhileSymbol_eval + (cond : Option α → Bool) + (i : Fin k) + (tm : MultiTapeTM k α) + (tapes_seq : ℕ → Fin k → BiTape α) + (h_transform : ∀ j, tm.eval (tapes_seq j) = .some (tapes_seq j.succ)) + (h_stops : ∃ m, cond (tapes_seq m i).head = false) : + (doWhileSymbol cond i tm).eval (tapes_seq 0) = .some (tapes_seq (Nat.find h_stops)) := by + sorry + +/-- Repeatedly run a sub routine as long as the first word on tape `i` is non-empty. +-/ +public def doWhile (i : Fin k) (tm : MultiTapeTM k (WithSep α)) : + MultiTapeTM k (WithSep α) where + Λ := PUnit + q₀ := 0 + 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 + sorry + +end Routines + +end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/WithTapes.lean b/Cslib/Computability/Machines/MultiTapeTuring/WithTapes.lean new file mode 100644 index 000000000..a4d97db5a --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/WithTapes.lean @@ -0,0 +1,126 @@ +/- +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.TapeExtension + +public import Mathlib.Logic.Equiv.Fintype +public import Mathlib.Data.Finset.Sort + +namespace Turing + +variable [Inhabited α] [Fintype α] + +variable {k : ℕ} + +/-- +Permute tapes according to a bijection. +-/ +public def MultiTapeTM.permute_tapes + (tm : MultiTapeTM k α) (σ : Equiv.Perm (Fin k)) : MultiTapeTM k α where + Λ := tm.Λ + q₀ := tm.q₀ + M := fun q syms => match tm.M q (syms ∘ σ) with + | (stmts, q') => (stmts ∘ σ.symm, q') + +--- General theorem: permuting tapes commutes with evaluation +@[simp, grind =] +public theorem MultiTapeTM.permute_tapes_eval + (tm : MultiTapeTM k α) (σ : Equiv.Perm (Fin k)) (tapes : Fin k → BiTape α) : + (tm.permute_tapes σ).eval tapes = + (tm.eval (tapes ∘ σ)).map (fun tapes' => tapes' ∘ σ.symm) := by + sorry + +private def findFin {k : ℕ} (p : Fin k → Prop) [DecidablePred p] (h : ∃ i, p i) : Fin k := + (Finset.univ.filter p).min' (by + simp only [Finset.Nonempty, Finset.mem_filter, Finset.mem_univ, true_and] + exact h) + +def inj_to_perm {k₁ k₂ : ℕ} (f : Fin k₁ → Fin k₂) (h_inj : f.Injective) : + Equiv.Perm (Fin k₂) + -- non-computable version + -- let f' : {i : Fin k₂ // i < k₁} → Fin k₂ := fun ⟨i, _⟩ => f ⟨i, by omega⟩ + -- have h_f'_inj : f'.Injective := by intro a b h; grind + -- (Equiv.ofInjective f' h_f'_inj).extendSubtype + where + toFun := sorry + invFun := sorry + left_inv := by sorry + right_inv := by sorry + +/-- +Change the order of the tapes of a Turing machine. +Example: For a 2-tape Turing machine tm, +`tm.with_tapes [2, 4].get (by grind)` is a 5-tape Turing machine whose tape 2 is +the original machine's tape 0 and whose tape 4 is the original +machine's tape 1 +Note that `f` is a function to `Fin k₂`, which means that integer literals +automatically wrap. You have to be careful to make sure that the target machine +has the right amount of tapes. +-/ +public def MultiTapeTM.with_tapes {k₁ k₂ : ℕ} +-- TODO use embedding instead? + (tm : MultiTapeTM k₁ α) (f : Fin k₁ → Fin k₂) (h_inj : f.Injective) : MultiTapeTM k₂ α := + (tm.extend + (by simpa using Fintype.card_le_of_injective f h_inj)).permute_tapes (inj_to_perm f h_inj) + +-- TODO do not use `h.choose` here but rather assume that `f` is injective. + +/-- +Updates `tapes` by choosing elements from `tapes'` according to (the partial inverse of) `f`. +-/ +public noncomputable def apply_updates + {γ : Type} + {k₁ k₂ : ℕ} + (tapes : Fin k₂ → γ) + (tapes' : Fin k₁ → γ) + (f : Fin k₁ → Fin k₂) + (i : Fin k₂) : γ := + if h : ∃ j, f j = i then tapes' h.choose else tapes i + +@[simp, grind =] +public lemma apply_updates_function_update_apply + {γ : Type} + {k₁ k₂ : ℕ} + {tapes : Fin k₂ → γ} + {f : Fin k₁ → Fin k₂} + (h_inj : f.Injective) + {t : Fin k₁} + {new_val : γ} + {i : Fin k₂} : + apply_updates tapes (Function.update (tapes ∘ f) t new_val) f i = + Function.update tapes (f t) new_val i := by + sorry + +@[simp, grind =] +public lemma apply_updates_function_update + {γ : Type} + {k₁ k₂ : ℕ} + {tapes : Fin k₂ → γ} + {f : Fin k₁ → Fin k₂} + (h_inj : f.Injective) + {t : Fin k₁} + {new_val : γ} : + apply_updates tapes (Function.update (tapes ∘ f) t new_val) f = + Function.update tapes (f t) new_val := by + funext i + apply apply_updates_function_update_apply h_inj + +@[simp, grind =] +public theorem MultiTapeTM.with_tapes_eval + {k₁ k₂ : ℕ} + {tm : MultiTapeTM k₁ α} {f : Fin k₁ → Fin k₂} {h_inj : f.Injective} + {tapes : Fin k₂ → BiTape α} : + (tm.with_tapes f h_inj).eval tapes = + (tm.eval (tapes ∘ f)).map + (fun tapes' => fun t => apply_updates tapes tapes' f t) := by + simp [with_tapes] + sorry + + +end Turing diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean index 86420aeae..e8ef4809d 100644 --- a/Cslib/Foundations/Data/BiTape.lean +++ b/Cslib/Foundations/Data/BiTape.lean @@ -81,6 +81,10 @@ def nth {α} (t : BiTape α) (n : ℤ) : Option α := | Int.ofNat (n + 1) => t.right.toList.getD n none | Int.negSucc n => t.left.toList.getD n none +@[simp, grind =] +lemma nth_zero {α} (t : BiTape α) : + t.nth 0 = t.head := by rfl + lemma ext_nth {α} {t₁ t₂ : BiTape α} (h_nth_eq : ∀ n, t₁.nth n = t₂.nth n) : t₁ = t₂ := by cases t₁ with | mk head₁ left₁ right₁ @@ -94,12 +98,13 @@ lemma ext_nth {α} {t₁ t₂ : BiTape α} (h_nth_eq : ∀ n, t₁.nth n = t₂. apply StackTape.ext_toList intro n have := h_nth_eq (Int.negSucc n) - simpa [nth] using this + sorry -- simpa [nth] using this + · -- right₁ = right₂ apply StackTape.ext_toList intro n have := h_nth_eq (Int.ofNat (n + 1)) - simpa [nth] using this + sorry -- simpa [nth] using this section Move @@ -199,12 +204,29 @@ def move_int {α} (t : BiTape α) (delta : ℤ) : BiTape α := | Int.ofNat n => move_right^[n] t | Int.negSucc n => move_left^[n + 1] t +@[simp, grind =] +lemma move_int_zero_eq_id {α} (t : BiTape α) : + t.move_int 0 = t := by rfl + +@[simp, grind =] +lemma move_int_one_eq_move_right {α} (t : BiTape α) : + t.move_int 1 = move_right t := by rfl + +@[simp, grind =] +lemma move_int_neg_one_eq_move_left {α} (t : BiTape α) : + t.move_int (-1) = move_left t := by rfl + @[simp, grind =] lemma move_int_nth {α} (t : BiTape α) (n p : ℤ) : (move_int t n).nth p = t.nth (p + n) := by unfold move_int split <;> grind +@[simp, grind =] +lemma move_int_head {α} (t : BiTape α) (n : ℤ) : + (move_int t n).head = t.nth n := by + simp [← nth_zero, move_int_nth] + @[simp, grind =] lemma move_int_move_int {α} (t : BiTape α) (n₁ n₂ : ℤ) : (t.move_int n₁).move_int n₂ = t.move_int (n₁ + n₂) := by From 949a0ef61e8d3137631927bd938298ec418e9576 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Fri, 20 Feb 2026 19:33:53 +0100 Subject: [PATCH 88/95] feat: add background and orientation information on how to contribute to CSLib (#358) This PR adds more references and details on the structure of CSLib. --- CONTRIBUTING.md | 252 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 251 insertions(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 736ed0d8c..e2591bcb7 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,3 +1,46 @@ +**Table of Contents** + +- [Contributing to CSLib](#contributing-to-cslib) +- [Contribution model](#contribution-model) +- [Style and documentation](#style-and-documentation) + - [Variable names](#variable-names) + - [Proof style and golfing :golf:](#proof-style-and-golfing-golf) + - [Notation](#notation) + - [Documentation](#documentation) +- [Design principles](#design-principles) + - [Reuse](#reuse) +- [Continuous Integration](#continuous-integration) + - [Pull Request Titles](#pull-request-titles) + - [Testing](#testing) + - [Linting](#linting) + - [Imports](#imports) +- [Getting started](#getting-started) + - [Before you start: coordination to avoid rework](#before-you-start-coordination-to-avoid-rework) + - [Finding tasks](#finding-tasks) + - [Working groups](#working-groups) + - [Proposing a new working group](#proposing-a-new-working-group) + - [Examples of welcome contributions](#examples-of-welcome-contributions) + - [Pillar 1: Formalising Computer Science in Lean](#pillar-1-formalising-computer-science-in-lean) + - [Algorithms and Data Structures](#algorithms-and-data-structures) + - [Verified data structures with time complexity (Batteries + Time Monad)](#verified-data-structures-with-time-complexity-batteries--time-monad) + - [Graph algorithms and graph foundations](#graph-algorithms-and-graph-foundations) + - [APIs for algorithmic paradigms](#apis-for-algorithmic-paradigms) + - [Programming Languages, Models of Computation and Interaction](#programming-languages-models-of-computation-and-interaction) + - [Logics](#logics) + - [Semantics and program equivalences](#semantics-and-program-equivalences) + - [Semantic frameworks](#semantic-frameworks) + - [Program equivalences](#program-equivalences) + - [Pillar 2: Code reasoning](#pillar-2-code-reasoning) + - [Contributing Boole examples](#contributing-boole-examples) + - [Boole specifications](#boole-specifications) + - [Issue labels for Boole](#issue-labels-for-boole) + - [Front ends for Boole](#front-ends-for-boole) + - [Back ends for Boole](#back-ends-for-boole) + - [Implementing verification paradigms](#implementing-verification-paradigms) + - [Lean automation](#lean-automation) + - [The role of AI](#the-role-of-ai) + + # Contributing to CSLib It's great that you're interested in contributing to CSLib! :tada: @@ -12,9 +55,11 @@ Each PR needs to be approved by at least one relevant maintainer. You can read t If you are adding something new to CSLib and are in doubt about it, you are very welcome to contact us on the [Lean prover Zulip chat](https://leanprover.zulipchat.com/). +If you are unfamiliar with CSLib as a whole and want to understand how to get started, please see [Getting started](#getting-started). + # Style and documentation -We generally follow the [mathlib style for coding and documentation](https://leanprover-community.github.io/contribute/style.html), so please read that as well. Some things worth mentioning and conventions specific to this library are explained next. +We generally follow the [mathlib style for coding and documentation](https://leanprover-community.github.io/contribute/style.html), so please read that as well. Some things worth mentioning and conventions specific to CSLib are explained next. ## Variable names @@ -79,3 +124,208 @@ CSLib uses a number of linters, mostly inherited from Batteries and Mathlib. The There is a also a test that [Cslib.lean](/Cslib.lean) imports all files. You can ensure this by running `lake exe mk_all --module` locally, which will make the required changes. + +# Getting started + +CSLib is a community effort. To understand its scope and vision, please read the [CSLib whitepaper](https://arxiv.org/abs/2602.04846). +For an overview of its technical approach to reuse, continuous integration, and proof automation, please read the [Computer Science as Infrastructure paper](https://arxiv.org/abs/2602.15078). + +Key project links include: + +- Website: https://www.cslib.io/ +- GitHub issues + PRs: https://github.com/leanprover/cslib +- Open contribution board: https://github.com/leanprover/cslib/projects?query=is%3Aopen +- Community discussion (Lean Community Zulip): https://leanprover.zulipchat.com/ + - CSLib channels are the recommended place to coordinate and ask questions. + +## Before you start: coordination to avoid rework + +Most contributions are welcome as straightforward PRs. However, **for any major development**, it is strongly recommended to discuss first on Zulip (or via a GitHub issue) so that the scope, dependencies, and placement in the library are aligned. + +Examples of work that should be discussed first: + +- New cross-cutting abstractions / typeclasses / notation schemes. +- New foundational frameworks. +- Major refactorings. +- New frontend or backend components for CSLib's verification infrastructure. +- Proposals for new working groups (see below). + +## Finding tasks + +If you are looking for a concrete starting point, please look at: + +- The CSLib Zulip channels. +- Our [GitHub issues](https://github.com/leanprover/cslib/issues). + + +## Working groups + +CSLib is structured to support multiple topic-focused efforts. We organise sustained work via **working groups** (informal or formal), which typically have a topic scope and a Zulip topic/channel for coordination. + +If you want to **join** a working group, start by posting on the relevant CSLib Zulip channel describing your background and what you want to contribute. + +### Proposing a new working group + +If you want to propose a new working group, write a short proposal (Zulip message or GitHub issue is fine) that includes: + +- **Topic**: What do you want to do? +- **Execution plan**: What is your execution plan? +- **Collaborators**: If some group or people are already planning to work on the topic, write them. + +The goal is to keep proposals lightweight while ensuring CSLib remains coherent and reusable. + +## Examples of welcome contributions + +Here you can find some (non-exhaustive) examples of topics looking for contributions. + +### Pillar 1: Formalising Computer Science in Lean + +Pillar 1 is about the formalisation of Computer Science as reusable infrastructure. This includes, but is not limited to, models of computation, semantics, logics, algorithms, data structures, metatheory, and supporting mathematics. + +#### Algorithms and Data Structures + +##### Verified data structures with time complexity (Batteries + Time Monad) + +A concrete and high-impact track is to verify implementations and time complexity bounds for [data structures from Batteries](https://github.com/leanprover-community/batteries/tree/main/Batteries/Data). + +Examples of candidate targets: + +- List and Array developments +- Binary heap +- Binomial heap +- Union find +- Red-black trees + +##### Graph algorithms and graph foundations + +- Foundational definitions (directed/undirected simple graphs, etc.) +- Core algorithms and their correctness proofs: + - DFS, topological sorting, SCC + - shortest paths, APSP + - max-flow + - minimum spanning tree + - spanners + - Gomory–Hu trees + +##### APIs for algorithmic paradigms + +Reusable APIs that support many concrete algorithms. + +- Divide-and-conquer + - Master theorem +- Dynamic programming + - generic DP API patterns + - quadrangle inequality (Yao ’80) + - SMAWK algorithm + +#### Programming Languages, Models of Computation and Interaction + +- Automata (on finite and infinite words) +- Choreographic languages +- Lambda calculi +- Petri Nets +- Process calculi, like CCS and pi-calculus +- Frameworks for language encodings (compilers, etc.). +- Proof techniques for the correctness of encodings. + +#### Logics + +We aim at formalising a number of logics of different kinds, including linear logic, modal logics, etc. + +We welcome proofs of logical equivalences and metatheoretical results such as identity expansion, cut elimiation, etc. + +Examples of interesting logics include: +- Linear logic +- Temporal logic +- Separation logic + +#### Semantics and program equivalences + +##### Semantic frameworks +- Denotational semantics +- Operational semantics, including results on labelled transition systems and reduction systems + +##### Program equivalences + +- Bisimulation +- May/Must testing +- Trace equivalence + +### Pillar 2: Code reasoning + +Pillar 2 is about infrastructure for reasoning about code in mainstream programming languages via intermediate representations, VC generation, and automation. + +We are interested in collecting a large number of programs in Boole (see the [CSLib whitepaper](https://arxiv.org/abs/2602.04846) for Boole's vision). + +You can try the Boole sandbox examples at . + +#### Contributing Boole examples + +We are interested in collecting a large number of programs in Boole. + +If you'd like to contribute examples, please propose and coordinate on the [Zulip channel for code reasoning](https://leanprover.zulipchat.com/#narrow/channel/563135-CSLib.3A-Code-Reasoning) first (especially if the example requires new features). + +We separate Boole examples into two directories: + +- examples that work with the current Boole back end +- examples that are broken or contain features not yet implemented + +Contributions to both sets are valuable: working examples demonstrate capabilities; 'broken' examples identify missing features and bottlenecks. + +#### Boole specifications + +Currently, Boole specifications are based on Strata Core: + +A key long-term goal is to support specifications that reference arbitrary Lean concepts, especially those formalised as part of CSLib Pillar 1. Designing this cleanly within the Strata framework is a challenging and valuable project. + +#### Issue labels for Boole + +If you have feature requests for Boole, file an issue with title `feat(Boole): `. + +For bugs, errors, or other issues, file an issue with label `Boole`. + +#### Front ends for Boole + +We are interested in developing translations from real-world programming languages to Boole. + +- Prototype translations are welcome to explore feasibility and identify design constraints. +- If you want to propose a translation for inclusion in CSLib, coordinate on Zulip. + +We expect initial translations will be ad hoc and trusted. The eventual goal is to formalize the semantics of front ends and prove (as a Lean metatheorem) that translations preserve semantics. + +#### Back ends for Boole + +We are interested in building Boole back ends that take as input Boole programs with formal specifications and construct proof obligations in Lean, which, if proved, ensure that the program meets its specification. + +- A prototype translation based on a deep embedding in Strata exists, but is not fully foundational. +- A major long-term goal is to prove Lean meta-theorems showing that proving the verification conditions ensures correctness of the Boole program. + +Alternative directions are welcome, e.g.: + +- Exploring a shallow embedding approach +- Leveraging Loom for more foundational pipelines + +A back end for **time complexity analysis** is also of interest. + +#### Implementing verification paradigms + +The formal methods community has a wide range of verification techniques that could be valuable in the Boole ecosystem, e.g.: + +- proof by refinement +- techniques for program equivalence +- other deductive verification paradigms + +#### Lean automation + +Since Boole back ends reduce correctness questions to Lean conjectures, automation is central. + +We already rely on key techniques such as `grind` and `lean-smt`. Additional work on automation for conjectures generated from Boole is welcome, including domain-specific automation that remains performant and readable. + +#### The role of AI + +There are two primary areas where generative AI can help: + +- generating/refining specifications (at the front-end or Boole level) +- helping to prove Lean conjectures + +Other creative uses of AI are welcome, but contributions should remain reviewable and maintainable. \ No newline at end of file From 6fc3949f0755546158459493ff3e557c83c58263 Mon Sep 17 00:00:00 2001 From: Eric Wieser Date: Sat, 21 Feb 2026 00:46:12 -0800 Subject: [PATCH 89/95] feat: generalize `TimeM` to arbitrary cost types providing `AddZero` (#357) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This also fixes some insufficiently-general `simp` lemmas about `seqLeft`, `seqRight`, and `seq`. Discussed in [#CSLib > Lightweight algorithms in CSLib :Cslib#275 @ 💬](https://leanprover.zulipchat.com/#narrow/channel/513188-CSLib/topic/Lightweight.20algorithms.20in.20CSLib.20.3ACslib.23275/near/574964064); whatever we end up doing with #275, this change is a natural generalization and can be used to experiment with cleanups in #275. If we ultimately converge on dropping `TimeM`, then we can drop this generalization along with the rest of `TimeM` at that time. --- .../Algorithms/Lean/MergeSort/MergeSort.lean | 10 +-- Cslib/Algorithms/Lean/TimeM.lean | 90 +++++++++++++------ 2 files changed, 66 insertions(+), 34 deletions(-) diff --git a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean b/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean index bacd41e7d..31f051032 100644 --- a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean +++ b/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean @@ -17,7 +17,7 @@ public import Mathlib.Data.Nat.Log # MergeSort on a list In this file we introduce `merge` and `mergeSort` algorithms that returns a time monad -over the list `TimeM (List α)`. The time complexity of `mergeSort` is the number of comparisons. +over the list `TimeM ℕ (List α)`. The time complexity of `mergeSort` is the number of comparisons. -- ## Main results @@ -34,8 +34,8 @@ namespace Cslib.Algorithms.Lean.TimeM variable {α : Type} [LinearOrder α] /-- Merges two lists into a single list, counting comparisons as time cost. -Returns a `TimeM (List α)` where the time represents the number of comparisons performed. -/ -def merge : List α → List α → TimeM (List α) +Returns a `TimeM ℕ (List α)` where the time represents the number of comparisons performed. -/ +def merge : List α → List α → TimeM ℕ (List α) | [], ys => return ys | xs, [] => return xs | x::xs', y::ys' => do @@ -48,8 +48,8 @@ def merge : List α → List α → TimeM (List α) return (y :: rest) /-- Sorts a list using the merge sort algorithm, counting comparisons as time cost. -Returns a `TimeM (List α)` where the time represents the total number of comparisons. -/ -def mergeSort (xs : List α) : TimeM (List α) := do +Returns a `TimeM ℕ (List α)` where the time represents the total number of comparisons. -/ +def mergeSort (xs : List α) : TimeM ℕ (List α) := do if xs.length < 2 then return xs else let half := xs.length / 2 diff --git a/Cslib/Algorithms/Lean/TimeM.lean b/Cslib/Algorithms/Lean/TimeM.lean index d890bd9a1..2509e175c 100644 --- a/Cslib/Algorithms/Lean/TimeM.lean +++ b/Cslib/Algorithms/Lean/TimeM.lean @@ -7,13 +7,17 @@ Authors: Sorrachai Yingchareonthawornhcai, Eric Wieser module import Cslib.Init +public import Mathlib.Algebra.Group.Defs @[expose] public section /-! # TimeM: Time Complexity Monad -`TimeM α` represents a computation that produces a value of type `α` and tracks its time cost. +`TimeM T α` represents a computation that produces a value of type `α` and tracks its time cost. + +`T` is usually instantiated as `ℕ` to count operations, but can be instantiated as `ℝ` to count +actual wall time, or as more complex types in order to model more general costs. ## Design Principles 1. **Pure inputs, timed outputs**: Functions take plain values and return `TimeM` results @@ -38,60 +42,88 @@ See [Danielsson2008] for the discussion. namespace Cslib.Algorithms.Lean /-- A monad for tracking time complexity of computations. -`TimeM α` represents a computation that returns a value of type `α` -and accumulates a time cost (represented as a natural number). -/ +`TimeM T α` represents a computation that returns a value of type `α` +and accumulates a time cost (represented as a type `T`, typically `ℕ`). -/ @[ext] -structure TimeM (α : Type*) where +structure TimeM (T : Type*) (α : Type*) where /-- The return value of the computation -/ ret : α /-- The accumulated time cost of the computation -/ - time : ℕ + time : T namespace TimeM /-- Lifts a pure value into a `TimeM` computation with zero time cost. Prefer to use `pure` instead of `TimeM.pure`. -/ -protected def pure {α} (a : α) : TimeM α := +protected def pure [Zero T] {α} (a : α) : TimeM T α := ⟨a, 0⟩ +instance [Zero T] : Pure (TimeM T) where + pure := TimeM.pure + /-- Sequentially composes two `TimeM` computations, summing their time costs. Prefer to use the `>>=` notation. -/ -protected def bind {α β} (m : TimeM α) (f : α → TimeM β) : TimeM β := +protected def bind {α β} [Add T] (m : TimeM T α) (f : α → TimeM T β) : TimeM T β := let r := f m.ret ⟨r.ret, m.time + r.time⟩ -instance : Monad TimeM where - pure := TimeM.pure +instance [Add T] : Bind (TimeM T) where bind := TimeM.bind -@[simp, grind =] theorem ret_pure {α} (a : α) : (pure a : TimeM α).ret = a := rfl -@[simp, grind =] theorem ret_bind {α β} (m : TimeM α) (f : α → TimeM β) : - (m >>= f).ret = (f m.ret).ret := rfl -@[simp, grind =] theorem ret_map {α β} (f : α → β) (x : TimeM α) : (f <$> x).ret = f x.ret := rfl -@[simp] theorem ret_seqRight {α} (x y : TimeM α) : (x *> y).ret = y.ret := rfl -@[simp] theorem ret_seqLeft {α} (x y : TimeM α) : (x <* y).ret = x.ret := rfl -@[simp] theorem ret_seq {α β} (f : TimeM (α → β)) (x : TimeM α) : (f <*> x).ret = f.ret x.ret := rfl +instance : Functor (TimeM T) where + map f x := ⟨f x.ret, x.time⟩ -@[simp, grind =] theorem time_bind {α β} (m : TimeM α) (f : α → TimeM β) : - (m >>= f).time = m.time + (f m.ret).time := rfl -@[simp, grind =] theorem time_pure {α} (a : α) : (pure a : TimeM α).time = 0 := rfl -@[simp, grind =] theorem time_map {α β} (f : α → β) (x : TimeM α) : (f <$> x).time = x.time := rfl -@[simp] theorem time_seqRight {α} (x y : TimeM α) : (x *> y).time = x.time + y.time := rfl -@[simp] theorem time_seqLeft {α} (x y : TimeM α) : (x <* y).time = x.time + y.time := rfl -@[simp] theorem time_seq {α β} (f : TimeM (α → β)) (x : TimeM α) : - (f <*> x).time = f.time + x.time := rfl +instance [Add T] : Seq (TimeM T) where + seq f x := ⟨f.ret (x ()).ret, f.time + (x ()).time⟩ + +instance [Add T] : SeqLeft (TimeM T) where + seqLeft x y := ⟨x.ret, x.time + (y ()).time⟩ + +instance [Add T] : SeqRight (TimeM T) where + seqRight x y := ⟨(y ()).ret, x.time + (y ()).time⟩ +instance [AddZero T] : Monad (TimeM T) where + pure := Pure.pure + bind := Bind.bind + map := Functor.map + seq := Seq.seq + seqLeft := SeqLeft.seqLeft + seqRight := SeqRight.seqRight -instance : LawfulMonad TimeM := .mk' +@[simp, grind =] theorem ret_pure {α} [Zero T] (a : α) : (pure a : TimeM T α).ret = a := rfl +@[simp, grind =] theorem ret_bind {α β} [Add T] (m : TimeM T α) (f : α → TimeM T β) : + (m >>= f).ret = (f m.ret).ret := rfl +@[simp, grind =] theorem ret_map {α β} (f : α → β) (x : TimeM T α) : (f <$> x).ret = f x.ret := rfl +@[simp] theorem ret_seqRight {α} (x : TimeM T α) (y : Unit → TimeM T β) [Add T] : + (SeqRight.seqRight x y).ret = (y ()).ret := rfl +@[simp] theorem ret_seqLeft {α} [Add T] (x : TimeM T α) (y : Unit → TimeM T β) : + (SeqLeft.seqLeft x y).ret = x.ret := rfl +@[simp] theorem ret_seq {α β} [Add T] (f : TimeM T (α → β)) (x : Unit → TimeM T α) : + (Seq.seq f x).ret = f.ret (x ()).ret := rfl + +@[simp, grind =] theorem time_bind {α β} [Add T] (m : TimeM T α) (f : α → TimeM T β) : + (m >>= f).time = m.time + (f m.ret).time := rfl +@[simp, grind =] theorem time_pure {α} [Zero T] (a : α) : (pure a : TimeM T α).time = 0 := rfl +@[simp, grind =] theorem time_map {α β} (f : α → β) (x : TimeM T α) : (f <$> x).time = x.time := rfl +@[simp] theorem time_seqRight {α} [Add T] (x : TimeM T α) (y : Unit → TimeM T β) : + (SeqRight.seqRight x y).time = x.time + (y ()).time := rfl +@[simp] theorem time_seqLeft {α} [Add T] (x : TimeM T α) (y : Unit → TimeM T β) : + (SeqLeft.seqLeft x y).time = x.time + (y ()).time := rfl +@[simp] theorem time_seq {α β} [Add T] (f : TimeM T (α → β)) (x : Unit → TimeM T α) : + (Seq.seq f x).time = f.time + (x ()).time := rfl + +/-- `TimeM` is lawful so long as addition in the cost is associative and absorbs zero. -/ +instance [AddMonoid T] : LawfulMonad (TimeM T) := .mk' (id_map := fun x => rfl) (pure_bind := fun _ _ => by ext <;> simp) - (bind_assoc := fun _ _ _ => by ext <;> simp [Nat.add_assoc]) + (bind_assoc := fun _ _ _ => by ext <;> simp [add_assoc]) + (seqLeft_eq := fun _ _ => by ext <;> simp) + (bind_pure_comp := fun _ _ => by ext <;> simp) -/-- Creates a `TimeM` computation with a time cost. -The time cost defaults to 1 if not provided. -/ -def tick (c : ℕ := 1) : TimeM PUnit := ⟨.unit, c⟩ +/-- Creates a `TimeM` computation with a time cost. -/ +def tick (c : T) : TimeM T PUnit := ⟨.unit, c⟩ @[simp, grind =] theorem ret_tick (c : ℕ) : (tick c).ret = () := rfl @[simp, grind =] theorem time_tick (c : ℕ) : (tick c).time = c := rfl From e4c2347bdb2f734eac5e0fb3e4d698f4d6e4a1e7 Mon Sep 17 00:00:00 2001 From: crei Date: Tue, 24 Feb 2026 15:26:55 +0100 Subject: [PATCH 90/95] Simplify semantics of succ. --- .../Machines/MultiTapeTuring/AddRoutine.lean | 15 +++--- .../Machines/MultiTapeTuring/SuccRoutine.lean | 46 +++---------------- 2 files changed, 14 insertions(+), 47 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean index 8afe7cb22..3cc0737f8 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean @@ -25,19 +25,16 @@ namespace Routines @[simp] lemma succ_iter {k r : ℕ} {i : Fin k.succ} {tapes : Fin k.succ → List (List OneTwo)} : (Part.bind · (succ i).eval_list)^[r] (.some tapes) = Part.some (Function.update tapes i ( - if h : tapes i ≠ [] then - (dya ((dya_inv ((tapes i).head h)) + r)) :: (tapes i).tail + if r ≠ 0 then + (dya ((dya_inv ((tapes i).headD [])) + r)) :: (tapes i).tail else tapes i)) := by induction r with | zero => simp | succ r ih => rw [Function.iterate_succ_apply'] - simp [ih, succ_eval_list] - by_cases h_empty : tapes i = [] - · simp [h_empty] - · simp [h_empty] - grind + simp [ih] + grind --- Add 0 and 1 and store the result in 2. --- Assumes zero for an empty tape. @@ -50,7 +47,9 @@ theorem add₀_eval_list {tapes : Fin 6 → List (List OneTwo)} : (Function.update tapes 2 ((dya (dya_inv ((tapes 0).headD []) + dya_inv ((tapes 1).headD [])) :: (tapes 2)))) := by simp [add₀] - grind + by_cases h : dya_inv ((tapes 0).head?.getD []) = 0 + · simp [h]; grind + · grind /-- A Turing machine that adds the heads of tapes i and j (in dyadic encoding) and pushes the result diff --git a/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean index 9c5c61e89..8c4f6bb93 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean @@ -25,54 +25,22 @@ def succ₀ : MultiTapeTM 1 (WithSep OneTwo) where M _ syms := sorry @[simp] -lemma succ₀_eval_list {n : ℕ} {ls : List (List OneTwo)} : - succ₀.eval_list [(dya n) :: ls].get = .some [(dya n.succ) :: ls].get := by +lemma succ₀_eval_list {tapes : Fin 1 → List (List OneTwo)} : + succ₀.eval_list tapes = .some (Function.update tapes 0 + ((dya (dya_inv ((tapes 0).headD [])).succ) :: (tapes 0).tail)) := by sorry /-- A Turing machine that increments the head of tape `i` by one (in dyadic encoding). Pushes zero if the tape is empty. -/ public def succ {k : ℕ} (i : Fin k) : MultiTapeTM k (WithSep OneTwo) := - succ₀.with_tapes (fun _ => i) (by intro x y; grind) - -/-- -The function computed by `succ`. --/ -public def succ_f {k : ℕ} - (i : Fin k) - (tapes : Fin k → List (List OneTwo)) : Fin k → List (List OneTwo) := - if h_ne : tapes i ≠ [] then - Function.update tapes i ((dya ((dya_inv ((tapes i).head h_ne)).succ)) :: (tapes i).tail) - else - tapes - -@[simp] -public lemma succ_f_neq {k : ℕ} - (i : Fin k) - (tapes : Fin k → List (List OneTwo)) - (h_ne : tapes i ≠ []) : - succ_f i tapes = Function.update tapes i - ((dya ((dya_inv ((tapes i).head h_ne)).succ)) :: (tapes i).tail) := by - simp [succ_f, h_ne] - -@[simp] -public lemma succ_f_empty {k : ℕ} - (i : Fin k) - (tapes : Fin k → List (List OneTwo)) - (h_empty : tapes i = []) : - succ_f i tapes = tapes := by - simp [succ_f, h_empty] - -@[simp] -public theorem succ_computes {k : ℕ} {i : Fin k} : - (succ i).computes (succ_f i) := by - sorry + succ₀.with_tapes [i].get (by intro x y; grind) @[simp] public theorem succ_eval_list {k : ℕ} {i : Fin k} {tapes : Fin k → List (List OneTwo)} : - (succ i).eval_list tapes = .some (succ_f i tapes) := by - -- TOOD why does simp not find it? - simp [MultiTapeTM.eval_of_computes succ_computes] + (succ i).eval_list tapes = .some (Function.update tapes i + ((dya (dya_inv ((tapes i).headD [])).succ) :: (tapes i).tail)) := by + simpa [succ] using apply_updates_function_update (by intro x y; grind) lemma succ₀_evalWithStats_list {n : ℕ} {ls : List (List OneTwo)} : succ₀.evalWithStats_list [(dya n) :: ls].get = From d693e99df0f9199ba3e2124e3d6feac3226cb517 Mon Sep 17 00:00:00 2001 From: crei Date: Tue, 24 Feb 2026 21:12:51 +0100 Subject: [PATCH 91/95] Always-halting Turing machines. --- .../Machines/MultiTapeTuring/Basic.lean | 11 +++++++++ .../MultiTapeTuring/ListEncoding.lean | 24 ++++++++++++++++++- .../MultiTapeTuring/WhileCombinator.lean | 16 ++++++------- 3 files changed, 42 insertions(+), 9 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean index 67c89864c..5d1f04646 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/ListEncoding.lean b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean index 255883715..7e44e4d3b 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean @@ -53,12 +53,34 @@ 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, grind =] public theorem MultiTapeTM.extend_eval_list diff --git a/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean index 2538c73f4..dbc787219 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 From dce94e87eb4a98e1535ac5ac21410ef67c199e47 Mon Sep 17 00:00:00 2001 From: crei Date: Mon, 2 Mar 2026 10:37:42 +0100 Subject: [PATCH 92/95] Multi-tape Turing machine. --- Cslib.lean | 1 + .../Machines/MultiTapeTuring/Basic.lean | 364 ++++++++++++++++++ 2 files changed, 365 insertions(+) create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/Basic.lean diff --git a/Cslib.lean b/Cslib.lean index a9d5ffc3e..d64e025ef 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -30,6 +30,7 @@ public import Cslib.Computability.Languages.OmegaLanguage public import Cslib.Computability.Languages.OmegaRegularLanguage public import Cslib.Computability.Languages.RegularLanguage public import Cslib.Computability.Machines.SingleTapeTuring.Basic +public import Cslib.Computability.Machines.MultiTapeTuring.Basic public import Cslib.Computability.URM.Basic public import Cslib.Computability.URM.Computable public import Cslib.Computability.URM.Defs diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean new file mode 100644 index 000000000..6bf325db8 --- /dev/null +++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean @@ -0,0 +1,364 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christian Reitwiessner +-/ + +module + +-- TODO create a "common file"? +public import Cslib.Computability.Machines.SingleTapeTuring.Basic + +public import Mathlib.Data.Part + +import Mathlib.Algebra.Order.BigOperators.Group.Finset + +/-! +# Multi-Tape Turing Machines + +Defines Turing machines with `k` tapes (bidirectionally infinite, `BiTape`) containing symbols +from `Option Symbol` for a finite alphabet `Symbol` (where `none` is the blank symbol). + +## Design + +The design of the multi-tape Turing machine follows the one for single-tape Turing machines. +With multiple tapes, it is not immediatly clear how to define the function computed by a Turing +machine. For a single-tape Turing machine, function composition follows easily from composition +of configurations. For multi-tape machines, we focus on composition of tape configurations +(cf. `MultiTapeTM.eval`) and defer the decision of how to define the function computed by a +Turing machine to a later stage. + +Since these Turing machines are deterministic, we base the definition of semantics on the sequence +of configurations instead of reachability in a configuration relation, although equivalence +between these two notions is proven. + +## Important Declarations + +We define a number of structures related to multi-tape Turing machine computation: + +* `MultiTapeTM`: the TM itself +* `Cfg`: the configuration of a TM, including internal state and the state of the tapes +* `UsesSpaceUntilStep`: a TM uses at most space `s` when run for up to `t` steps +* `TrasformsTapesInExactTime`: a TM transforms tapes `tapes` to `tapes'` in exactly `t` steps +* `TransformsTapesInTime`: a TM transforms tapes `tapes` to `tapes'` in up to `t` steps +* `TransformsTapes`: a TM transforms tapes `tapes` to `tapes'` in some number of steps +* `TransformsTapesInTimeAndSpace`: a TM transforms tapes `tapes` to `tapes'` in up to `t` steps + and uses at most `s` space + +There are multiple ways to talk about the behaviour of a multi-tape Turing machine: + +* `MultiTapeTM.configs`: a sequence of configurations by execution step +* `TransformsTapes`: a TM transforms initial tapes `tapes` and halts with tapes `tapes'` +* `MultiTapeTM.eval`: executes a TM on initial tapes `tapes` and returns the resulting tapes if it + eventually halts + +## TODOs + +* Define sequential composition of multi-tape Turing machines. +* Define different kinds of tapes (input-only, output-only, oracle, etc) and how they influence + how space is counted. +* Define the notion of a multi-tape Turing machine computing a function. + +-/ + +open Cslib Relation + +namespace Turing + +open BiTape StackTape + +variable {Symbol : Type} + +variable {k : ℕ} + +/-- +A `k`-tape Turing machine +over the alphabet of `Option Symbol` (where `none` is the blank `BiTape` symbol). +-/ +public structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where + /-- type of state labels -/ + (State : Type) + /-- finiteness of the state type -/ + [stateFintype : Fintype State] + /-- initial state -/ + (q₀ : State) + /-- transition function, mapping a state and a tuple of head symbols to a `Stmt` to invoke + for each tape and optionally the new state to transition to afterwards (`none` for halt) -/ + (tr : State → (Fin k → Option Symbol) → ((Fin k → (SingleTapeTM.Stmt Symbol)) × Option State)) + +namespace MultiTapeTM + +section Cfg + +/-! +## Configurations of a Turing Machine + +This section defines the configurations of a Turing machine, +the step function that lets the machine transition from one configuration to the next, +and the intended initial and final configurations. +-/ + +variable [Inhabited Symbol] [Fintype Symbol] (tm : MultiTapeTM k Symbol) + +instance : Inhabited tm.State := ⟨tm.q₀⟩ + +instance : Fintype tm.State := tm.stateFintype + +instance inhabitedStmt : Inhabited (SingleTapeTM.Stmt Symbol) := inferInstance + + +/-- +The configurations of a Turing machine consist of: +an `Option`al state (or none for the halting state), +and a `BiTape` representing the tape contents. +-/ +@[ext] +public structure Cfg : Type where + /-- the state of the TM (or none for the halting state) -/ + state : Option tm.State + /-- the BiTape contents -/ + tapes : Fin k → BiTape Symbol +deriving Inhabited + +/-- The step function corresponding to a `MultiTapeTM`. -/ +public def step : tm.Cfg → Option tm.Cfg + | ⟨none, _⟩ => + -- If in the halting state, there is no next configuration + none + | ⟨some q, tapes⟩ => + -- If in state q, perform look up in the transition function + match tm.tr q (fun i => (tapes i).head) with + -- and enter a new configuration with state q' (or none for halting) + -- and tapes updated according to the Stmt + | ⟨stmts, q'⟩ => some ⟨q', fun i => + ((tapes i).write (stmts i).symbol).optionMove (stmts i).movement⟩ + +/-- Any number of positive steps run from a halting configuration lead to `none`. -/ +@[simp, scoped grind =] +public lemma step_iter_none_eq_none (tapes : Fin k → BiTape Symbol) (n : ℕ) : + (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes⟩) = none := by + rw [Function.iterate_succ_apply] + induction n with + | zero => simp [step] + | succ n ih => + simp only [Function.iterate_succ_apply', ih] + simp [step] + +/-- A collection of tapes where the first tape contains `s` -/ +public def firstTape (s : List Symbol) : Fin k → BiTape Symbol + | ⟨0, _⟩ => BiTape.mk₁ s + | ⟨_, _⟩ => default + +/-- +The initial configuration corresponding to a list in the input alphabet. +Note that the entries of the tape constructed by `BiTape.mk₁` are all `some` values. +This is to ensure that distinct lists map to distinct initial configurations. +-/ +@[simp] +public def initCfg (s : List Symbol) : tm.Cfg := + ⟨some tm.q₀, firstTape s⟩ + +/-- Create an initial configuration given a tuple of tapes. -/ +@[simp] +public def initCfgTapes (tapes : Fin k → BiTape Symbol) : tm.Cfg := + ⟨some tm.q₀, tapes⟩ + +/-- The final configuration corresponding to a list in the output alphabet. +(We demand that the head halts at the leftmost position of the output.) +-/ +@[simp] +public def haltCfg (s : List Symbol) : tm.Cfg := + ⟨none, firstTape s⟩ + +/-- The final configuration of a Turing machine given a tuple of tapes. -/ +@[simp] +public def haltCfgTapes (tapes : Fin k → BiTape Symbol) : tm.Cfg := + ⟨none, tapes⟩ + +/-- The sequence of configurations of the Turing machine starting with initial state and +given tapes at step `t`. +If the Turing machine halts, it will eventually get and stay `none` after reaching the halting +configuration. -/ +public def configs (tapes : Fin k → BiTape Symbol) (t : ℕ) : Option tm.Cfg := + (Option.bind · tm.step)^[t] (tm.initCfgTapes tapes) + + + +-- TODO shouldn't this be spaceUsed? (If yes, also change it in SingleTapeTM) + +/-- +The space used by a configuration is the sum of the space used by its tapes. +-/ +public def Cfg.space_used (cfg : tm.Cfg) : ℕ := ∑ i, (cfg.tapes i).space_used + +/-- +The space used by a configuration grows by at most `k` each step. +-/ +public lemma Cfg.space_used_step (cfg cfg' : tm.Cfg) + (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + k := by + obtain ⟨_ | q, tapes⟩ := cfg + · simp [step] at hstep + · simp only [step] at hstep + generalize h_tr : tm.tr q (fun i => (tapes i).head) = result at hstep + obtain ⟨stmts, q''⟩ := result + injection hstep with hstep + subst hstep + simp only [space_used] + trans ∑ i : Fin k, ((tapes i).space_used + 1) + · refine Finset.sum_le_sum fun i _ => ?_ + unfold BiTape.optionMove + grind [BiTape.space_used_write, BiTape.space_used_move] + · simp [Finset.sum_add_distrib] + +end Cfg + +open Cfg + +variable [Inhabited Symbol] [Fintype Symbol] + +/-- +The `TransitionRelation` corresponding to a `MultiTapeTM k Symbol` +is defined by the `step` function, +which maps a configuration to its next configuration, if it exists. +-/ +@[scoped grind =] +public def TransitionRelation (tm : MultiTapeTM k Symbol) (c₁ c₂ : tm.Cfg) : Prop := + tm.step c₁ = some c₂ + +/-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in exactly +`t` steps. -/ +public def TransformsTapesInExactTime + (tm : MultiTapeTM k Symbol) + (tapes tapes' : Fin k → BiTape Symbol) + (t : ℕ) : Prop := + RelatesInSteps tm.TransitionRelation (tm.initCfgTapes tapes) (tm.haltCfgTapes tapes') t + +/-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in up to +`t` steps. -/ +public def TransformsTapesInTime + (tm : MultiTapeTM k Symbol) + (tapes tapes' : Fin k → BiTape Symbol) + (t : ℕ) : Prop := + RelatesWithinSteps tm.TransitionRelation (tm.initCfgTapes tapes) (tm.haltCfgTapes tapes') t + +/-- The Turing machine `tm` transforms tapes `tapes` to `tapes'`. -/ +public def TransformsTapes + (tm : MultiTapeTM k Symbol) + (tapes tapes' : Fin k → BiTape Symbol) : Prop := + ∃ t, tm.TransformsTapesInExactTime tapes tapes' t + +/-- A proof that the Turing machine `tm` uses at most space `s` when run for up to `t` steps +on initial tapes `tapes`. -/ +public def UsesSpaceUntilStep + (tm : MultiTapeTM k Symbol) + (tapes : Fin k → BiTape Symbol) + (s t : ℕ) : Prop := + ∀ t' ≤ t, match tm.configs tapes t' with + | none => true + | some cfg => cfg.space_used ≤ s + +/-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in exactly `t` steps +and uses at most `s` space. -/ +public def TransformsTapesInTimeAndSpace + (tm : MultiTapeTM k Symbol) + (tapes tapes' : Fin k → BiTape Symbol) + (t s : ℕ) : Prop := + tm.TransformsTapesInExactTime tapes tapes' t ∧ + tm.UsesSpaceUntilStep tapes s t + +/-- This lemma translates between the relational notion and the iterated step notion. The latter +can be more convenient especially for deterministic machines as we have here. -/ +@[scoped grind =] +public lemma relatesInSteps_iff_step_iter_eq_some + (tm : MultiTapeTM k Symbol) + (cfg₁ cfg₂ : tm.Cfg) + (t : ℕ) : + RelatesInSteps tm.TransitionRelation cfg₁ cfg₂ t ↔ + (Option.bind · tm.step)^[t] cfg₁ = .some cfg₂ := by + induction t generalizing cfg₁ cfg₂ with + | zero => simp + | succ t ih => + rw [RelatesInSteps.succ_iff, Function.iterate_succ_apply'] + constructor + · grind only [TransitionRelation, = Option.bind_some] + · intro h_configs + cases h : (Option.bind · tm.step)^[t] cfg₁ with + | none => grind + | some cfg' => + use cfg' + grind + +/-- The Turing machine `tm` halts after exactly `t` steps on initial tapes `tapes`. -/ +public def haltsAtStep + (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) (t : ℕ) : Bool := + match (tm.configs tapes t) with + | some ⟨none, _⟩ => true + | _ => false + +/-- If a Turing machine halts, the time step is uniquely determined. -/ +public lemma halting_step_unique + {tm : MultiTapeTM k Symbol} + {tapes : Fin k → BiTape Symbol} + {t₁ t₂ : ℕ} + (h_halts₁ : tm.haltsAtStep tapes t₁) + (h_halts₂ : tm.haltsAtStep tapes t₂) : + t₁ = t₂ := by + wlog h : t₁ ≤ t₂ + · exact (this h_halts₂ h_halts₁ (Nat.le_of_not_le h)).symm + obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le h + cases d with + | zero => rfl + | succ d => + -- this is a contradiction. + unfold haltsAtStep configs at h_halts₁ h_halts₂ + split at h_halts₁ <;> try contradiction + next tapes' h_iter_t₁ => + rw [Nat.add_comm t₁ (d + 1), Function.iterate_add_apply, h_iter_t₁, + step_iter_none_eq_none (tm := tm) tapes' d] at h_halts₂ + simp at h_halts₂ + +/-- At the halting step, the configuration sequence of a Turing machine is still `some`. -/ +public lemma configs_isSome_of_haltsAtStep + {tm : MultiTapeTM k Symbol} {tapes : Fin k → BiTape Symbol} {t : ℕ} + (h_halts : tm.haltsAtStep tapes t) : + (tm.configs tapes t).isSome := by + grind [haltsAtStep] + +/-- Execute the Turing machine `tm` on initial tapes `tapes` and return the resulting tapes +if it eventually halts. -/ +public def eval (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) : + Part (Fin k → BiTape Symbol) := + ⟨∃ t, tm.haltsAtStep tapes t, + fun h => ((tm.configs tapes (Nat.find h)).get + (configs_isSome_of_haltsAtStep (Nat.find_spec h))).tapes⟩ + +/-- Evaluating a Turing machine on a tuple of tapes `tapes` has a value `tapes'` if and only if +it transforms `tapes` into `tapes'`. -/ +@[scoped grind =] +public lemma eval_eq_some_iff_transformsTapes + {tm : MultiTapeTM k Symbol} + {tapes tapes' : Fin k → BiTape Symbol} : + tm.eval tapes = .some tapes' ↔ tm.TransformsTapes tapes tapes' := by + simp only [eval, Part.eq_some_iff, Part.mem_mk_iff] + constructor + · intro ⟨h_dom, h_get⟩ + use Nat.find h_dom + rw [TransformsTapesInExactTime, relatesInSteps_iff_step_iter_eq_some] + rw [← configs, Option.eq_some_iff_get_eq] + use configs_isSome_of_haltsAtStep (Nat.find_spec h_dom) + ext1 + · simp + grind [haltsAtStep, Nat.find_spec h_dom] + · exact h_get + · intro ⟨t, h_iter⟩ + rw [TransformsTapesInExactTime, relatesInSteps_iff_step_iter_eq_some] at h_iter + rw [← configs] at h_iter + have h_halts_at_t : tm.haltsAtStep tapes t := by simp [haltsAtStep, h_iter] + let h_halts : ∃ t, tm.haltsAtStep tapes t := ⟨t, h_halts_at_t⟩ + use h_halts + have h_eq : Nat.find h_halts = t := halting_step_unique (Nat.find_spec h_halts) h_halts_at_t + simp [h_eq, h_iter] + +end MultiTapeTM + +end Turing From 11fcde88e152cce1be75396991bd1cb1693950d8 Mon Sep 17 00:00:00 2001 From: crei Date: Wed, 4 Mar 2026 22:33:14 +0100 Subject: [PATCH 93/95] Fix some files post-merge. --- .../MultiTapeTuring/ListEncoding.lean | 136 +++++++++------- .../Machines/MultiTapeTuring/MoveRoutine.lean | 153 +++++++++--------- .../MultiTapeTuring/TapeExtension.lean | 16 +- .../Machines/MultiTapeTuring/WithTapes.lean | 5 +- 4 files changed, 167 insertions(+), 143 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean index 7e44e4d3b..acbca4fde 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean @@ -7,13 +7,15 @@ Authors: Christian Reitwiessner module public import Cslib.Computability.Machines.MultiTapeTuring.Basic -public import Cslib.Computability.Machines.MultiTapeTuring.HeadStats public import Cslib.Computability.Machines.MultiTapeTuring.WithTapes import Mathlib.Tactic.DeriveFintype namespace Turing +variable {Symbol : Type} +variable [Inhabited Symbol] [Fintype Symbol] + /-- An alphabet that contains exactly two symbols, 1 and 2. TODO use an embedding or something else that is more flexible @@ -25,9 +27,8 @@ deriving DecidableEq, Inhabited, Fintype /-- An alphabet for list encoding -/ -public inductive WithSep (α : Type) where - | blank - | ofChar (c : α) +public inductive WithSep (Symbol : Type) where + | ofChar (c : Symbol) | comma -- TODO need to decide if we want to encode lists with parentheses or not. -- Is annoying when pushing and popping from lists, but can be useful to avoid @@ -39,55 +40,79 @@ deriving Fintype, DecidableEq, Inhabited /-- A list of words is transformed by appending a comma after each word and concatenating. Note that the comma is not only a separator but also appears as the final character of the resulting string (if the list is non-empty). -/ -public def listToString (ls : List (List α)) : List (WithSep α) := - (ls.map (fun w : List α => (w.map .ofChar) ++ [.comma])).flatten +public def listToString (ls : List (List Symbol)) : List (WithSep Symbol) := + (ls.map (fun w : List Symbol => (w.map .ofChar) ++ [.comma])).flatten + +public def stringToList (s : List (Option (WithSep Symbol))) : Option (List (List Symbol)) := + s.foldr (fun c acc => + match c with + | none => none + | some .comma => acc.map ([] :: ·) + | some (.ofChar c) => acc.bind (fun ws => + match ws with + | [] => none + | w :: rest => some ((c :: w) :: rest))) + (some []) /-- Encodes a list of words into a tape. -/ -public def listToTape (ls : List (List α)) : BiTape (WithSep α) := +public def listToTape (ls : List (List Symbol)) : BiTape (WithSep Symbol) := BiTape.mk₁ (listToString ls) +/-- Only tapes where the head is at the left end are accepted. -/ +public def tapeToList (tape : BiTape (WithSep Symbol)) : Option (List (List Symbol)) := + match (tape.left.toList, tape.head) with + | ([], c) => stringToList (c :: tape.right.toList) + | _ => none + +public def tapesToLists (tapes : Fin k → BiTape (WithSep Symbol)) : + Option (Fin k → List (List Symbol)) := + if h : ∀ i, (tapeToList (tapes i)).isSome then + some (fun i => (tapeToList (tapes i)).get (h i)) + else + none + /-- The Turing machine `tm` transforms the list-encoded tapes `tapes` into the list-encoded tapes `tapes'`. -/ public def MultiTapeTM.TransformsLists - (tm : MultiTapeTM k (WithSep α)) - (tapes tapes' : Fin k → List (List α)) : Prop := + (tm : MultiTapeTM k (WithSep Symbol)) + (tapes tapes' : Fin k → List (List Symbol)) : Prop := tm.TransformsTapes (listToTape ∘ tapes) (listToTape ∘ tapes') -/-- The Turing machine `tm` halts starting with list-encoded tapes `tapes`. -/ +/-- The Turing machine `tm` halts starting with list-encoded tapes `tapes` +and also always outputs properly list-encoded tapes. -/ public def MultiTapeTM.HaltsOnLists - (tm : MultiTapeTM k (WithSep α)) - (tapes : Fin k → List (List α)) : Prop := + (tm : MultiTapeTM k (WithSep Symbol)) + (tapes : Fin k → List (List Symbol)) : 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 α)) := - ⟨tm.HaltsOnLists tapes, fun h => h.choose⟩ +public def MultiTapeTM.eval_list + (tm : MultiTapeTM k (WithSep Symbol)) + (tapes : Fin k → List (List Symbol)) : + Part (Fin k → List (List Symbol)) := + (tm.eval (listToTape ∘ tapes)).bind fun tapes => tapesToLists tapes public theorem MultiTapeTM.HaltsOnLists_of_eval_list - {tm : MultiTapeTM k (WithSep α)} - {tapes : Fin k → List (List α)} + {tm : MultiTapeTM k (WithSep Symbol)} + {tapes : Fin k → List (List Symbol)} (h_dom : (tm.eval_list tapes).Dom) : tm.HaltsOnLists tapes := by - simpa using h_dom + sorry -/-- 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) +-- /-- Execute the Turing machine `tm` knowing that it always halts, thus yielding a total function +-- on the tapes. -/ +-- public def MultiTapeTM.eval_list_tot +-- (tm : MultiTapeTM k (WithSep Symbol)) +-- (h_alwaysHalts : ∀ tapes, tm.HaltsOnLists tapes) +-- (tapes : Fin k → List (List Symbol)) : +-- Fin k → List (List Symbol) := +-- (tm.eval_list tapes).get (h_alwaysHalts tapes) @[simp, grind =] public theorem MultiTapeTM.extend_eval_list - {α : Type} [Fintype α] {k₁ k₂ : ℕ} {h_le : k₁ ≤ k₂} - {tm : MultiTapeTM k₁ (WithSep α)} - {tapes : Fin k₂ → List (List α)} : + {tm : MultiTapeTM k₁ (WithSep Symbol)} + {tapes : Fin k₂ → List (List Symbol)} : (tm.extend h_le).eval_list tapes = (tm.eval_list (tapes ⟨·, by omega⟩)).map (fun tapes' => fun i : Fin k₂ => if h : i.val < k₁ then tapes' ⟨i, h⟩ else tapes i) := by @@ -95,38 +120,37 @@ public theorem MultiTapeTM.extend_eval_list @[simp, grind =] public theorem MultiTapeTM.permute_tapes_eval_list - {α : Type} [Fintype α] [Inhabited α] - (tm : MultiTapeTM k (WithSep α)) (σ : Equiv.Perm (Fin k)) (tapes : Fin k → List (List α)) : + (tm : MultiTapeTM k (WithSep Symbol)) (σ : Equiv.Perm (Fin k)) + (tapes : Fin k → List (List Symbol)) : (tm.permute_tapes σ).eval_list tapes = (tm.eval_list (tapes ∘ σ)).map (fun tapes' => tapes' ∘ σ.symm) := by sorry @[simp, grind =] public theorem MultiTapeTM.with_tapes_eval_list - {α : Type} [Fintype α] [Inhabited α] {k₁ k₂ : ℕ} - {tm : MultiTapeTM k₁ (WithSep α)} {f : Fin k₁ → Fin k₂} {h_inj : f.Injective} - {tapes : Fin k₂ → List (List α)} : + {tm : MultiTapeTM k₁ (WithSep Symbol)} {f : Fin k₁ → Fin k₂} {h_inj : f.Injective} + {tapes : Fin k₂ → List (List Symbol)} : (tm.with_tapes f h_inj).eval_list tapes = (tm.eval_list (tapes ∘ f)).map (fun tapes' => fun t => apply_updates tapes tapes' f t) := by sorry -def MultiTapeTM.TransformsListsWithStats - (tm : MultiTapeTM k (WithSep α)) - (tapes : Fin k → List (List α)) - (ts : (Fin k → List (List α)) × (Fin k → HeadStats)) : Prop := - tm.evalWithStats (listToTape ∘ tapes) = .some (listToTape ∘ ts.1, ts.2) - -/-- -Evaluate the Turing machine `tm` on the list-encoded tapes `tapes` and also return the head -statistics of the computation. --/ -public noncomputable def MultiTapeTM.evalWithStats_list - (tm : MultiTapeTM k (WithSep α)) - (tapes : Fin k → List (List α)) : - Part ((Fin k → List (List α)) × (Fin k → HeadStats)) := - ⟨∃ ts, tm.TransformsListsWithStats tapes ts, fun h => h.choose⟩ +-- def MultiTapeTM.TransformsListsWithStats +-- (tm : MultiTapeTM k (WithSep Symbol)) +-- (tapes : Fin k → List (List Symbol)) +-- (ts : (Fin k → List (List Symbol)) × (Fin k → HeadStats)) : Prop := +-- tm.evalWithStats (listToTape ∘ tapes) = .some (listToTape ∘ ts.1, ts.2) + +-- /-- +-- Evaluate the Turing machine `tm` on the list-encoded tapes `tapes` and also return the head +-- statistics of the computation. +-- -/ +-- public noncomputable def MultiTapeTM.evalWithStats_list +-- (tm : MultiTapeTM k (WithSep Symbol)) +-- (tapes : Fin k → List (List Symbol)) : +-- Part ((Fin k → List (List Symbol)) × (Fin k → HeadStats)) := +-- ⟨∃ ts, tm.TransformsListsWithStats tapes ts, fun h => h.choose⟩ -- TODO for machines running on lists, we can actually have more precise head stats: -- we know (and should enforce) that the head never moves to the right of the rightmost symbol @@ -141,15 +165,15 @@ The Turing machine `tm` computes a total function on lists and this uniquely determined function is `f`. -/ public def MultiTapeTM.computes - (tm : MultiTapeTM k (WithSep α)) - (f : (Fin k → List (List α)) → (Fin k → List (List α))) : Prop := + (tm : MultiTapeTM k (WithSep Symbol)) + (f : (Fin k → List (List Symbol)) → (Fin k → List (List Symbol))) : Prop := ∀ tapes, tm.eval_list tapes = .some (f tapes) public theorem MultiTapeTM.eval_of_computes - {tm : MultiTapeTM k (WithSep α)} - {f : (Fin k → List (List α)) → (Fin k → List (List α))} + {tm : MultiTapeTM k (WithSep Symbol)} + {f : (Fin k → List (List Symbol)) → (Fin k → List (List Symbol))} (h_computes : tm.computes f) - {tapes : Fin k → List (List α)} : + {tapes : Fin k → List (List Symbol)} : tm.eval_list tapes = .some (f tapes) := by specialize h_computes tapes simpa [MultiTapeTM.computes] using h_computes diff --git a/Cslib/Computability/Machines/MultiTapeTuring/MoveRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/MoveRoutine.lean index b65d7b6e0..443eb44a5 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/MoveRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/MoveRoutine.lean @@ -14,87 +14,88 @@ namespace Routines variable [Inhabited α] [Fintype α] -/-- A 1-tape Turing machine that moves its head in a given direction -once and then halts. -/ -public def move (dir : Dir) : MultiTapeTM 1 α where - Λ := PUnit - q₀ := 0 - M _ syms := (fun i => ⟨syms i, some dir⟩, none) +-- /-- A 1-tape Turing machine that moves its head in a given direction +-- once and then halts. -/ +-- public def move (dir : Dir) : MultiTapeTM 1 α where +-- Λ := PUnit +-- q₀ := 0 +-- M _ syms := (fun i => ⟨syms i, some dir⟩, none) -@[simp] -public lemma move_eval (tape : BiTape α) (dir : Turing.Dir) : - (move dir).eval (fun _ => tape) = .some (fun _ => tape.move dir) := by - rw [MultiTapeTM.eval_iff_exists_steps_iter_eq_some] - use 1 - rfl +-- @[simp] +-- public lemma move_eval (tape : BiTape α) (dir : Turing.Dir) : +-- (move dir).eval (fun _ => tape) = .some (fun _ => tape.move dir) := by +-- sorry +-- rw [MultiTapeTM.eval_iff_exists_steps_iter_eq_some] +-- use 1 +-- rfl -/-- A 1-tape Turing machine that moves its head in a given direction until a condition -on the read symbol is met. -/ -public def move_until (dir : Turing.Dir) (cond : (Option α) → Bool) : MultiTapeTM 1 α where - Λ := PUnit - q₀ := PUnit.unit - M q syms := match cond (syms 0) with - | false => (fun _ => ⟨syms 0, some dir⟩, some q) - | true => (fun _ => ⟨syms 0, none⟩, none) +-- /-- A 1-tape Turing machine that moves its head in a given direction until a condition +-- on the read symbol is met. -/ +-- public def move_until (dir : Turing.Dir) (cond : (Option α) → Bool) : MultiTapeTM 1 α where +-- Λ := PUnit +-- q₀ := PUnit.unit +-- M q syms := match cond (syms 0) with +-- | false => (fun _ => ⟨syms 0, some dir⟩, some q) +-- | true => (fun _ => ⟨syms 0, none⟩, none) -lemma move_until_step_cond_false - {tape : BiTape α} - {stop_condition : Option α → Bool} - (h_neg_stop : ¬ stop_condition tape.head) : - (move_until .right stop_condition).step - ⟨some (move_until .right stop_condition).q₀, (fun _ => tape)⟩ = - some ⟨some (move_until .right stop_condition).q₀, (fun _ => tape.move .right)⟩ := by - simp [move_until, h_neg_stop, BiTape.optionMove, MultiTapeTM.step] +-- lemma move_until_step_cond_false +-- {tape : BiTape α} +-- {stop_condition : Option α → Bool} +-- (h_neg_stop : ¬ stop_condition tape.head) : +-- (move_until .right stop_condition).step +-- ⟨some (move_until .right stop_condition).q₀, (fun _ => tape)⟩ = +-- some ⟨some (move_until .right stop_condition).q₀, (fun _ => tape.move .right)⟩ := by +-- simp [move_until, h_neg_stop, BiTape.optionMove, MultiTapeTM.step] -lemma move_until_step_cond_true - {tape : BiTape α} - {stop_condition : Option α → Bool} - (h_neg_stop : stop_condition tape.head) : - (move_until .right stop_condition).step - ⟨some (move_until .right stop_condition).q₀, (fun _ => tape)⟩ = - some ⟨none, (fun _ => tape)⟩ := by - simp [move_until, h_neg_stop, BiTape.optionMove, MultiTapeTM.step] +-- lemma move_until_step_cond_true +-- {tape : BiTape α} +-- {stop_condition : Option α → Bool} +-- (h_neg_stop : stop_condition tape.head) : +-- (move_until .right stop_condition).step +-- ⟨some (move_until .right stop_condition).q₀, (fun _ => tape)⟩ = +-- some ⟨none, (fun _ => tape)⟩ := by +-- simp [move_until, h_neg_stop, BiTape.optionMove, MultiTapeTM.step] -public theorem move_until.right_semantics - (tape : BiTape α) - (stop_condition : Option α → Bool) - (h_stop : ∃ n : ℕ, stop_condition (tape.nth n)) : - (move_until .right stop_condition).eval (fun _ => tape) = - .some (fun _ => tape.move_int (Nat.find h_stop)) := by - rw [MultiTapeTM.eval_iff_exists_steps_iter_eq_some] - let n := Nat.find h_stop - use n.succ - have h_not_stop_of_lt : ∀ k < n, ¬ stop_condition (tape.move_int k).head := by - intro k hk - simp [Nat.find_min h_stop hk] - have h_iter : ∀ k < n, (Option.bind · (move_until .right stop_condition).step)^[k] - (some ⟨some (move_until .right stop_condition).q₀, fun _ => tape⟩) = - some ⟨some (move_until .right stop_condition).q₀, fun _ => tape.move_int k⟩ := by - intro k hk - induction k with - | zero => - simp [BiTape.move_int] - | succ k ih => - have hk' : k < n := Nat.lt_of_succ_lt hk - rw [Function.iterate_succ_apply', ih hk'] - simp only [Option.bind_some, move_until_step_cond_false (h_not_stop_of_lt k hk')] - simp [BiTape.move, ← BiTape.move_int_one_eq_move_right, BiTape.move_int_move_int] - have h_n_eq : n = Nat.find h_stop := by grind - by_cases h_n_zero : n = 0 - · have h_stop_cond : stop_condition (tape.head) := by simp_all [n] - let h_step := move_until_step_cond_true h_stop_cond - simp [h_step, ← h_n_eq, h_n_zero] - · obtain ⟨n', h_n'_eq_n_succ⟩ := Nat.exists_eq_add_one_of_ne_zero h_n_zero - rw [h_n'_eq_n_succ, Function.iterate_succ_apply', Function.iterate_succ_apply'] - have h_n'_lt_n : n' < n := by omega - simp only [MultiTapeTM.initCfgTapes, MultiTapeTM.haltCfgTapes] - rw [h_iter n' h_n'_lt_n] - simp only [Option.bind_some, move_until_step_cond_false (h_not_stop_of_lt n' h_n'_lt_n)] - simp only [BiTape.move, ← BiTape.move_int_one_eq_move_right, BiTape.move_int_move_int] - rw [show (n' : ℤ) + 1 = n by omega] - have h_n_stop : stop_condition ((tape.move_int n).head) := by - simpa [n] using Nat.find_spec h_stop - simpa using move_until_step_cond_true h_n_stop +-- public theorem move_until.right_semantics +-- (tape : BiTape α) +-- (stop_condition : Option α → Bool) +-- (h_stop : ∃ n : ℕ, stop_condition (tape.nth n)) : +-- (move_until .right stop_condition).eval (fun _ => tape) = +-- .some (fun _ => tape.move_int (Nat.find h_stop)) := by +-- rw [MultiTapeTM.eval_iff_exists_steps_iter_eq_some] +-- let n := Nat.find h_stop +-- use n.succ +-- have h_not_stop_of_lt : ∀ k < n, ¬ stop_condition (tape.move_int k).head := by +-- intro k hk +-- simp [Nat.find_min h_stop hk] +-- have h_iter : ∀ k < n, (Option.bind · (move_until .right stop_condition).step)^[k] +-- (some ⟨some (move_until .right stop_condition).q₀, fun _ => tape⟩) = +-- some ⟨some (move_until .right stop_condition).q₀, fun _ => tape.move_int k⟩ := by +-- intro k hk +-- induction k with +-- | zero => +-- simp [BiTape.move_int] +-- | succ k ih => +-- have hk' : k < n := Nat.lt_of_succ_lt hk +-- rw [Function.iterate_succ_apply', ih hk'] +-- simp only [Option.bind_some, move_until_step_cond_false (h_not_stop_of_lt k hk')] +-- simp [BiTape.move, ← BiTape.move_int_one_eq_move_right, BiTape.move_int_move_int] +-- have h_n_eq : n = Nat.find h_stop := by grind +-- by_cases h_n_zero : n = 0 +-- · have h_stop_cond : stop_condition (tape.head) := by simp_all [n] +-- let h_step := move_until_step_cond_true h_stop_cond +-- simp [h_step, ← h_n_eq, h_n_zero] +-- · obtain ⟨n', h_n'_eq_n_succ⟩ := Nat.exists_eq_add_one_of_ne_zero h_n_zero +-- rw [h_n'_eq_n_succ, Function.iterate_succ_apply', Function.iterate_succ_apply'] +-- have h_n'_lt_n : n' < n := by omega +-- simp only [MultiTapeTM.initCfgTapes, MultiTapeTM.haltCfgTapes] +-- rw [h_iter n' h_n'_lt_n] +-- simp only [Option.bind_some, move_until_step_cond_false (h_not_stop_of_lt n' h_n'_lt_n)] +-- simp only [BiTape.move, ← BiTape.move_int_one_eq_move_right, BiTape.move_int_move_int] +-- rw [show (n' : ℤ) + 1 = n by omega] +-- have h_n_stop : stop_condition ((tape.move_int n).head) := by +-- simpa [n] using Nat.find_spec h_stop +-- simpa using move_until_step_cond_true h_n_stop end Routines diff --git a/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean b/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean index 43c6e9cac..7e414cdb7 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/TapeExtension.lean @@ -6,22 +6,20 @@ Authors: Christian Reitwiessner module -import Cslib.Foundations.Data.BiTape -import Cslib.Foundations.Data.RelatesInSteps - public import Cslib.Computability.Machines.MultiTapeTuring.Basic namespace Turing -variable [Inhabited α] [Fintype α] +variable [Inhabited Symbol] [Fintype Symbol] /-- Extend a Turing machine to work with more tapes. The added tapes are not acted upon. -/ public def MultiTapeTM.extend {k₁ k₂ : ℕ} (h_le : k₁ ≤ k₂) - (tm : MultiTapeTM k₁ α) : MultiTapeTM k₂ α where - Λ := tm.Λ + (tm : MultiTapeTM k₁ Symbol) : MultiTapeTM k₂ Symbol where + State := tm.State + stateFintype := tm.stateFintype q₀ := tm.q₀ - M := fun q syms => match tm.M q (fun i => syms ⟨i, by omega⟩) with + tr := fun q syms => match tm.tr q (fun i => syms ⟨i, by omega⟩) with | (stmts, q') => (fun i => if h : i < k₁ then stmts ⟨i, h⟩ else default, q') @@ -65,8 +63,8 @@ public abbrev tapes_extend_by @[simp, grind =] public lemma MultiTapeTM.extend_eval {k₁ k₂ : ℕ} (h_le : k₁ ≤ k₂) - (tm : MultiTapeTM k₁ α) - {tapes : Fin k₂ → BiTape α} : + (tm : MultiTapeTM k₁ Symbol) + {tapes : Fin k₂ → BiTape Symbol} : (tm.extend h_le).eval tapes = (tm.eval (tapes ⟨·, by omega⟩)).map (fun tapes' => tapes_extend_by tapes' tapes) := by sorry diff --git a/Cslib/Computability/Machines/MultiTapeTuring/WithTapes.lean b/Cslib/Computability/Machines/MultiTapeTuring/WithTapes.lean index a4d97db5a..209179db9 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/WithTapes.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/WithTapes.lean @@ -23,9 +23,10 @@ Permute tapes according to a bijection. -/ public def MultiTapeTM.permute_tapes (tm : MultiTapeTM k α) (σ : Equiv.Perm (Fin k)) : MultiTapeTM k α where - Λ := tm.Λ + State := tm.State + stateFintype := tm.stateFintype q₀ := tm.q₀ - M := fun q syms => match tm.M q (syms ∘ σ) with + tr := fun q syms => match tm.tr q (syms ∘ σ) with | (stmts, q') => (stmts ∘ σ.symm, q') --- General theorem: permuting tapes commutes with evaluation From 372830295e04260b8da6063f842c16d91cf359ae Mon Sep 17 00:00:00 2001 From: crei Date: Wed, 4 Mar 2026 22:52:59 +0100 Subject: [PATCH 94/95] Update files. --- .../Machines/MultiTapeTuring/AddRoutine.lean | 4 +-- .../Machines/MultiTapeTuring/CopyRoutine.lean | 28 +++++++++---------- .../MultiTapeTuring/EqualRoutine.lean | 7 +++-- .../Machines/MultiTapeTuring/HeadStats.lean | 16 +++++------ .../MultiTapeTuring/IsZeroRoutine.lean | 2 +- .../MultiTapeTuring/IteCombinator.lean | 8 +++--- .../MultiTapeTuring/ListEncoding.lean | 16 +++++------ .../MultiTapeTuring/LoopCombinator.lean | 18 ++++++++++-- .../Machines/MultiTapeTuring/MulRoutine.lean | 7 ++--- .../Machines/MultiTapeTuring/PopRoutine.lean | 7 +++-- .../Machines/MultiTapeTuring/PushRoutine.lean | 7 +++-- .../MultiTapeTuring/SequentialCombinator.lean | 18 ++++++------ .../Machines/MultiTapeTuring/SuccRoutine.lean | 27 +++++++++--------- .../MultiTapeTuring/WhileCombinator.lean | 16 ++++++----- 14 files changed, 97 insertions(+), 84 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean index 3cc0737f8..3985e270a 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/AddRoutine.lean @@ -39,7 +39,7 @@ lemma succ_iter {k r : ℕ} {i : Fin k.succ} {tapes : Fin k.succ → List (List --- Add 0 and 1 and store the result in 2. --- Assumes zero for an empty tape. def add₀ : MultiTapeTM 6 (WithSep OneTwo) := - (copy 1 2) <;> loop (h_i := by decide) 0 (succ 2) + (copy 1 2) ;ₜ loop 0 (succ 2) @[simp, grind =] theorem add₀_eval_list {tapes : Fin 6 → List (List OneTwo)} : @@ -72,7 +72,7 @@ public theorem add_eval_list (i j l aux : Fin (k + 6)) -- Add head of 0 to head of 1 (and store it in head of 1). def add_assign₀ : MultiTapeTM 6 (WithSep OneTwo) := - add 0 1 2 (h_inj := by decide) <;> pop 1 <;> copy 2 1 <;> pop 2 + add 0 1 2 (h_inj := by decide) ;ₜ pop 1 ;ₜ copy 2 1 ;ₜ pop 2 @[simp] lemma add_assign₀_eval_list {tapes : Fin 6 → List (List OneTwo)} : diff --git a/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean index 96a715047..566a3aef4 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/CopyRoutine.lean @@ -17,9 +17,10 @@ namespace Routines variable [Inhabited α] [Fintype α] def copy₁ : MultiTapeTM 2 (WithSep α) where - Λ := PUnit - q₀ := 0 - M _ syms := sorry + State := PUnit + stateFintype := inferInstance + q₀ := PUnit.unit + tr _ syms := sorry @[simp] lemma copy₁_eval_list {tapes : Fin 2 → List (List α)} : @@ -31,22 +32,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) + (h_inj : [i, j].get.Injective := by intro x y; grind) : + MultiTapeTM k (WithSep α) := + copy₁.with_tapes [i, j].get h_inj @[simp, grind =] public lemma copy_eval_list - {k : ℕ} {i j : ℕ} {h_neq : i ≠ j} {h_i_lt : i < k} {h_j_lt : j < k} + {k : ℕ} + {i j : Fin k} + (h_inj : [i, j].get.Injective) {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 + (copy i j h_inj).eval_list tapes = Part.some + (Function.update tapes j (((tapes i).headD []) :: (tapes j))) := by simp_all [copy] + grind end Routines diff --git a/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean index 7ad2b42c9..b5c3d88b4 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/EqualRoutine.lean @@ -23,9 +23,10 @@ and otherwise pushes the empty word to the third tape. If one of the first two tapes is empty, uses the empty word for comparison. -/ def eq₀ : MultiTapeTM 3 (WithSep OneTwo) where - Λ := PUnit - q₀ := 0 - M _ syms := sorry + State := PUnit + stateFintype := inferInstance + q₀ := PUnit.unit + tr _ syms := sorry @[simp] theorem eq₀_eval_list {tapes : Fin 3 → List (List OneTwo)} : diff --git a/Cslib/Computability/Machines/MultiTapeTuring/HeadStats.lean b/Cslib/Computability/Machines/MultiTapeTuring/HeadStats.lean index d0ea26b2f..3dbba8fb2 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/HeadStats.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/HeadStats.lean @@ -9,12 +9,10 @@ module public import Cslib.Computability.Machines.MultiTapeTuring.Basic public import Cslib.Computability.Machines.MultiTapeTuring.TapeExtension --- TODO create a "common file" -import Cslib.Computability.Machines.SingleTapeTuring.Basic namespace Turing -variable [Inhabited α] +variable [Inhabited Symbol] [Fintype Symbol] variable {k : ℕ} @@ -37,15 +35,15 @@ public def HeadStats.space (hs : HeadStats) : ℕ := /-- Compute the head statistics for a turing machine starting with a certain tape configuration. -/ -public def headStats (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : +public def headStats (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) : Part (Fin k → HeadStats) := sorry /-- Execute a Turing machine and also compute head statistics. -/ -public def MultiTapeTM.evalWithStats (tm : MultiTapeTM k α) (tapes : Fin k → BiTape α) : - Part ((Fin k → BiTape α) × (Fin k → HeadStats)) := sorry +public def MultiTapeTM.evalWithStats (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) : + Part ((Fin k → BiTape Symbol) × (Fin k → HeadStats)) := sorry -- move this somewhere else -def seq (tm₁ tm₂ : MultiTapeTM k α) : MultiTapeTM k α := sorry +def seq (tm₁ tm₂ : MultiTapeTM k Symbol) : MultiTapeTM k Symbol := sorry def seq_combine_stats (stats₁ stats₂ : Fin k → HeadStats) : Fin k → HeadStats := fun i => match (stats₁ i, stats₂ i) with @@ -55,7 +53,7 @@ def seq_combine_stats (stats₁ stats₂ : Fin k → HeadStats) : Fin k → Head final₁ + final₂, by omega⟩ -lemma seq_evalWithStats (tm₁ tm₂ : MultiTapeTM k α) (tapes : Fin k → BiTape α) (i : Fin k) : +lemma seq_evalWithStats (tm₁ tm₂ : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) (i : Fin k) : (seq tm₁ tm₂).evalWithStats tapes = do let (tapes', stats₁) ← tm₁.evalWithStats tapes let (tapes'', stats₂) ← tm₂.evalWithStats tapes' @@ -63,7 +61,7 @@ lemma seq_evalWithStats (tm₁ tm₂ : MultiTapeTM k α) (tapes : Fin k → BiTa -- Next step: relate space requirements and head stats. -theorem stats_and_space (tm : MultiTapeTM k α) (tapes tapes' : Fin k → BiTape α) (s : ℕ) : +theorem stats_and_space (tm : MultiTapeTM k Symbol) (tapes tapes' : Fin k → BiTape Symbol) (s : ℕ) : (∃ t, tm.TransformsTapesInTimeAndSpace tapes tapes' t s) ↔ ∃ hs, (∑ i, (hs i).space) ≤ s ∧ tm.evalWithStats tapes = .some (tapes', hs) := by sorry end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/IsZeroRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/IsZeroRoutine.lean index fcd35f7b8..265f9e42a 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/IsZeroRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/IsZeroRoutine.lean @@ -22,7 +22,7 @@ namespace Routines /-- A Turing machine that computes the logical negation: It replaces an empty (or non-existing) head on tape `i` by the word "1" and everything else by the empty word. -/ -public def isZero (i : Fin k) := ite i (pop i <;> push i []) (pop i <;> push i [OneTwo.one]) +public def isZero (i : Fin k) := ite i (pop i ;ₜ push i []) (pop i ;ₜ push i [OneTwo.one]) @[simp, grind =] public theorem isZero_eval_list {i : Fin k} {tapes : Fin k → List (List OneTwo)} : diff --git a/Cslib/Computability/Machines/MultiTapeTuring/IteCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/IteCombinator.lean index e0bf71b86..9d9d41b9e 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/IteCombinator.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/IteCombinator.lean @@ -8,7 +8,6 @@ module public import Cslib.Computability.Machines.MultiTapeTuring.Basic public import Cslib.Computability.Machines.MultiTapeTuring.ListEncoding -public import Cslib.Computability.Machines.MultiTapeTuring.HeadStats namespace Turing @@ -22,9 +21,10 @@ A Turing machine combinator that runs `tm₁` if the first word on tape `i` exis otherwise it runs `tm₂`. -/ public def ite (i : Fin k) (tm₁ tm₂ : MultiTapeTM k (WithSep α)) : MultiTapeTM k (WithSep α) where - Λ := PUnit - q₀ := 0 - M _ syms := sorry + State := PUnit + stateFintype := inferInstance + q₀ := PUnit.unit + tr _ syms := sorry @[simp, grind =] public theorem ite_eval_list diff --git a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean index acbca4fde..e3831a7aa 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean @@ -99,14 +99,14 @@ public theorem MultiTapeTM.HaltsOnLists_of_eval_list tm.HaltsOnLists tapes := by sorry --- /-- Execute the Turing machine `tm` knowing that it always halts, thus yielding a total function --- on the tapes. -/ --- public def MultiTapeTM.eval_list_tot --- (tm : MultiTapeTM k (WithSep Symbol)) --- (h_alwaysHalts : ∀ tapes, tm.HaltsOnLists tapes) --- (tapes : Fin k → List (List Symbol)) : --- Fin k → List (List Symbol) := --- (tm.eval_list tapes).get (h_alwaysHalts tapes) +/-- Execute the Turing machine `tm` knowing that it always halts, thus yielding a total function +on the tapes. -/ +public def MultiTapeTM.eval_list_tot + (tm : MultiTapeTM k (WithSep Symbol)) + (h_alwaysHalts : ∀ tapes, (tm.eval_list tapes).Dom) + (tapes : Fin k → List (List Symbol)) : + Fin k → List (List Symbol) := + (tm.eval_list tapes).get (h_alwaysHalts tapes) @[simp, grind =] public theorem MultiTapeTM.extend_eval_list diff --git a/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean index c4cf18f03..c7c741e04 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean @@ -19,7 +19,7 @@ variable {k : ℕ} A Turing machine that executes `tm` a number of times as given by the first word on tape `i`. If tape `i` is empty, do not execute the TM. Note that the iteration counter is not directly available to `tm`. -/ -public def loop (i : ℕ) {h_i : i < k} +public def loop (i : Fin k) (tm : MultiTapeTM k (WithSep OneTwo)) : MultiTapeTM (k + 3) (WithSep OneTwo) := sorry -- let target : Fin (k + (aux + 3)) := ⟨aux, by omega⟩ @@ -39,14 +39,26 @@ public def loop (i : ℕ) {h_i : i < k} @[simp] -public theorem loop_eval_list {i : ℕ} {h_i : i < k} +public theorem loop_eval_list {i : Fin k} {tm : MultiTapeTM k (WithSep OneTwo)} {tapes : Fin (k + 3) → List (List OneTwo)} : - (loop i tm (h_i := h_i)).eval_list tapes = + (loop i tm).eval_list tapes = (((Part.bind · tm.eval_list)^[dya_inv ((tapes ⟨i, by omega⟩).headD [])] (Part.some (tapes_take tapes k (by omega))))).map fun tapes' => tapes_extend_by tapes' tapes := by sorry +@[simp] +public theorem loop_halts_of_halts {i : Fin k} + {tm : MultiTapeTM k (WithSep OneTwo)} + (h_halts : ∀ tapes, (tm.eval_list tapes).Dom) : + ∀ tapes, ((loop i tm).eval_list tapes).Dom := by + intro tapes + simp only [loop_eval_list] + induction n : dya_inv ((tapes ⟨i, by omega⟩).headD []) generalizing tapes with + | zero => simp + | succ n' ih => + sorry + end Routines end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/MulRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/MulRoutine.lean index 1eee25958..a5e4f72dd 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/MulRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/MulRoutine.lean @@ -22,7 +22,7 @@ namespace Routines -- Multiplies the heads of 0 and 1 and stores the result in 2. def mul₀ : MultiTapeTM 9 (WithSep OneTwo) := - (push 2 []) <;> loop 0 (h_i := by omega) (add_assign 1 2 3) + push 2 [] ;ₜ loop 0 (add_assign 1 2 3) @[simp] lemma add_assign_iter {i j aux : Fin (k + 6)} {r : ℕ} @@ -51,10 +51,7 @@ theorem mul₀_eval_list {tapes : Fin 9 → List (List OneTwo)} : (Function.update tapes 2 ( (dya (dya_inv ((tapes 0).headD []) * dya_inv ((tapes 1).headD [])) :: (tapes 2)))) := by by_cases h_zero: dya_inv ((tapes 0).head?.getD []) = 0 - · simp [mul₀, h_zero] - grind - · simp [mul₀, h_zero] - grind + <;> simp [mul₀, h_zero] <;> grind /-- A Turing machine that multiplies the heads of tapes i and j and pushes the result to tape l. diff --git a/Cslib/Computability/Machines/MultiTapeTuring/PopRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/PopRoutine.lean index 7b615a0df..a18b72b96 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/PopRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/PopRoutine.lean @@ -17,9 +17,10 @@ namespace Routines variable [Inhabited α] [Fintype α] def pop₁ : MultiTapeTM 1 (WithSep α) where - Λ := PUnit - q₀ := 0 - M _ syms := sorry + State := PUnit + stateFintype := inferInstance + q₀ := PUnit.unit + tr _ syms := sorry @[simp] lemma pop₁_eval_list {tapes : Fin 1 → List (List α)} : diff --git a/Cslib/Computability/Machines/MultiTapeTuring/PushRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/PushRoutine.lean index c703a1e43..d6c0bac78 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/PushRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/PushRoutine.lean @@ -17,9 +17,10 @@ namespace Routines variable [Inhabited α] [Fintype α] def push₁ (w : List α) : MultiTapeTM 1 (WithSep α) where - Λ := PUnit - q₀ := 0 - M _ syms := sorry + State := PUnit + stateFintype := inferInstance + q₀ := PUnit.unit + tr _ syms := sorry @[simp] lemma push₁_eval_list {w : List α} {tapes : Fin 1 → List (List α)} : diff --git a/Cslib/Computability/Machines/MultiTapeTuring/SequentialCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/SequentialCombinator.lean index dba01653a..e39726df1 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/SequentialCombinator.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/SequentialCombinator.lean @@ -16,40 +16,40 @@ namespace Turing namespace MultiTapeTM -variable [Inhabited α] +variable [Inhabited Symbol] [Fintype Symbol] variable {k : ℕ} /-- Sequential combination of Turing machines. Runs `tm₁` and then `tm₂` on the resulting tapes (if the first one halts). -/ -public def seq (tm₁ tm₂ : MultiTapeTM k α) : MultiTapeTM k α := sorry +public def seq (tm₁ tm₂ : MultiTapeTM k Symbol) : MultiTapeTM k Symbol := sorry public theorem seq_eval - (tm₁ tm₂ : MultiTapeTM k α) - (tapes₀ : Fin k → BiTape α) : + (tm₁ tm₂ : MultiTapeTM k Symbol) + (tapes₀ : Fin k → BiTape Symbol) : (seq tm₁ tm₂).eval tapes₀ = tm₁.eval tapes₀ >>= fun tape₁ => tm₂.eval tape₁ := by sorry @[simp, grind =] public theorem seq_eval_list - {tm₁ tm₂ : MultiTapeTM k (WithSep α)} - {tapes₀ : Fin k → List (List α)} : + {tm₁ tm₂ : MultiTapeTM k (WithSep Symbol)} + {tapes₀ : Fin k → List (List Symbol)} : (seq tm₁ tm₂).eval_list tapes₀ = tm₁.eval_list tapes₀ >>= fun tape₁ => tm₂.eval_list tape₁ := by sorry public theorem seq_associative - (tm₁ tm₂ tm₃ : MultiTapeTM k α) - (tapes₀ : Fin k → List (List α)) : + (tm₁ tm₂ tm₃ : MultiTapeTM k Symbol) + (tapes₀ : Fin k → List (List Symbol)) : (seq (seq tm₁ tm₂) tm₃).eval = (seq tm₁ (seq tm₂ tm₃)).eval := by sorry /-- Sequential combination of Turing machines. -/ -infixl:90 " <;> " => seq +infixl:90 " ;ₜ " => seq end MultiTapeTM diff --git a/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean b/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean index 8c4f6bb93..0ed3fc41c 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/SuccRoutine.lean @@ -20,9 +20,10 @@ namespace Turing namespace Routines def succ₀ : MultiTapeTM 1 (WithSep OneTwo) where - Λ := PUnit - q₀ := 0 - M _ syms := sorry + State := PUnit + stateFintype := inferInstance + q₀ := PUnit.unit + tr _ syms := sorry @[simp] lemma succ₀_eval_list {tapes : Fin 1 → List (List OneTwo)} : @@ -42,16 +43,16 @@ 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) -lemma succ₀_evalWithStats_list {n : ℕ} {ls : List (List OneTwo)} : - succ₀.evalWithStats_list [(dya n) :: ls].get = - .some ( - [(dya n.succ) :: ls].get, - -- this depends on if we have overflow on the highest dyadic character or not. - if (dya n.succ).length = (dya n).length then - [⟨0, (dya n).length, 0, by omega⟩].get - else - [⟨-1, (dya n).length, -1, by omega⟩].get) := by - sorry +-- lemma succ₀_evalWithStats_list {n : ℕ} {ls : List (List OneTwo)} : +-- succ₀.evalWithStats_list [(dya n) :: ls].get = +-- .some ( +-- [(dya n.succ) :: ls].get, +-- -- this depends on if we have overflow on the highest dyadic character or not. +-- if (dya n.succ).length = (dya n).length then +-- [⟨0, (dya n).length, 0, by omega⟩].get +-- else +-- [⟨-1, (dya n).length, -1, by omega⟩].get) := by +-- sorry end Routines diff --git a/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean index dbc787219..9c03aeb45 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean @@ -26,9 +26,10 @@ at the head of tape `i` is true. -/ public def doWhileSymbol (cond : Option α → Bool) (i : Fin k) (tm : MultiTapeTM k α) : MultiTapeTM k α where - Λ := PUnit - q₀ := 0 - M _ syms := sorry + State := PUnit + stateFintype := inferInstance + q₀ := PUnit.unit + tr _ syms := sorry @[simp] public theorem doWhileSymbol_eval @@ -45,16 +46,17 @@ public theorem doWhileSymbol_eval -/ public def doWhile (i : Fin k) (tm : MultiTapeTM k (WithSep α)) : MultiTapeTM k (WithSep α) where - Λ := PUnit - q₀ := 0 - M _ syms := sorry + State := PUnit + stateFintype := inferInstance + q₀ := PUnit.unit + tr _ syms := sorry @[simp] public theorem doWhile_eval_list {i : Fin k} {tm : MultiTapeTM k (WithSep α)} {tapes : Fin k → List (List α)} - (h_halts : ∀ tapes', tm.HaltsOnLists tapes') : + (h_halts : ∀ tapes', (tm.eval_list tapes').Dom) : (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 From 19e8c126ec94485d3dd46a307b220e33521047b1 Mon Sep 17 00:00:00 2001 From: crei Date: Wed, 4 Mar 2026 23:02:51 +0100 Subject: [PATCH 95/95] lint --- .../Machines/MultiTapeTuring/ListEncoding.lean | 16 ++++++++++++++-- .../Machines/MultiTapeTuring/LoopCombinator.lean | 11 +++-------- .../MultiTapeTuring/WhileCombinator.lean | 2 +- 3 files changed, 18 insertions(+), 11 deletions(-) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean index e3831a7aa..f16a1984a 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/ListEncoding.lean @@ -92,6 +92,7 @@ public def MultiTapeTM.eval_list Part (Fin k → List (List Symbol)) := (tm.eval (listToTape ∘ tapes)).bind fun tapes => tapesToLists tapes +@[simp] public theorem MultiTapeTM.HaltsOnLists_of_eval_list {tm : MultiTapeTM k (WithSep Symbol)} {tapes : Fin k → List (List Symbol)} @@ -99,14 +100,23 @@ public theorem MultiTapeTM.HaltsOnLists_of_eval_list tm.HaltsOnLists tapes := by sorry +@[simp] +public lemma MultiTapeTM.eval_list_dom_of_halts_on_lists + {tm : MultiTapeTM k (WithSep Symbol)} + {tapes : Fin k → List (List Symbol)} + (h_halts : tm.HaltsOnLists tapes) : + (tm.eval_list tapes).Dom := by + sorry + /-- Execute the Turing machine `tm` knowing that it always halts, thus yielding a total function on the tapes. -/ +@[simp] public def MultiTapeTM.eval_list_tot (tm : MultiTapeTM k (WithSep Symbol)) - (h_alwaysHalts : ∀ tapes, (tm.eval_list tapes).Dom) + (h_alwaysHalts : ∀ tapes, tm.HaltsOnLists tapes) (tapes : Fin k → List (List Symbol)) : Fin k → List (List Symbol) := - (tm.eval_list tapes).get (h_alwaysHalts tapes) + (tm.eval_list tapes).get (tm.eval_list_dom_of_halts_on_lists (h_alwaysHalts tapes)) @[simp, grind =] public theorem MultiTapeTM.extend_eval_list @@ -170,6 +180,8 @@ public def MultiTapeTM.computes ∀ tapes, tm.eval_list tapes = .some (f tapes) public theorem MultiTapeTM.eval_of_computes + {Symbol : Type} + [Fintype Symbol] {tm : MultiTapeTM k (WithSep Symbol)} {f : (Fin k → List (List Symbol)) → (Fin k → List (List Symbol))} (h_computes : tm.computes f) diff --git a/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean index c7c741e04..217f62a3a 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/LoopCombinator.lean @@ -51,14 +51,9 @@ public theorem loop_eval_list {i : Fin k} @[simp] public theorem loop_halts_of_halts {i : Fin k} {tm : MultiTapeTM k (WithSep OneTwo)} - (h_halts : ∀ tapes, (tm.eval_list tapes).Dom) : - ∀ tapes, ((loop i tm).eval_list tapes).Dom := by - intro tapes - simp only [loop_eval_list] - induction n : dya_inv ((tapes ⟨i, by omega⟩).headD []) generalizing tapes with - | zero => simp - | succ n' ih => - sorry + (h_halts : ∀ tapes, tm.HaltsOnLists tapes) : + ∀ tapes, (loop i tm).HaltsOnLists tapes := by + sorry end Routines end Turing diff --git a/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean index 9c03aeb45..97d46133c 100644 --- a/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean +++ b/Cslib/Computability/Machines/MultiTapeTuring/WhileCombinator.lean @@ -56,7 +56,7 @@ public theorem doWhile_eval_list {i : Fin k} {tm : MultiTapeTM k (WithSep α)} {tapes : Fin k → List (List α)} - (h_halts : ∀ tapes', (tm.eval_list tapes').Dom) : + (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